From 296c4d7c09cf66b2a97e8871c5a903fda9d0919e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 28 Oct 2022 19:43:06 -0500 Subject: uhhhhh --- lisp/+custom.el | 52 +++++++++++++++++++++++++++ lisp/+lisp.el | 93 ++++++++++++++++++++++++++++++++++++++++++++++++ lisp/+message.el | 26 ++++++++++++++ lisp/+notmuch.el | 105 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/+tempo.el | 3 +- lisp/acdw.el | 43 +++++++++++++++++++---- lisp/pita.el | 61 +++++++++++++++++--------------- 7 files changed, 348 insertions(+), 35 deletions(-) create mode 100644 lisp/+custom.el create mode 100644 lisp/+lisp.el create mode 100644 lisp/+message.el create mode 100644 lisp/+notmuch.el (limited to 'lisp') diff --git a/lisp/+custom.el b/lisp/+custom.el new file mode 100644 index 0000000..ba4c55d --- /dev/null +++ b/lisp/+custom.el @@ -0,0 +1,52 @@ +;;; +custom.el -*- lexical-binding: t -*- + +(require 'cl-lib) +(require 'seq) + +(defgroup +custom nil + "Group for extra `customize' customizations." + :group 'customize) + +(defcustom +custom-allowed-variables nil + "Variables to load during `+custom-load-some-customizations'." + :type '(repeat symbol)) + +(defcustom +custom-allowed-faces nil + "Faces to load during `+custom-load-some-customziations'." + :type '(repeat face)) + +(defun +custom--filter-list (customlist allowlist) + "Filter CUSTOMLIST to only include those items in ALLOWLIST. +Each item in ALLOWLIST will be compared using `eq' to the `car' +of each item in CUSTOMLIST. Items in CUSTOMLIST not included in +ALLOWLIST will be removed from the return value." + (seq-filter (lambda (el) (memq (car el) allowlist)) + customlist)) + +(defcustom +custom-after-load-hook nil + "Hook run after loading the custom file." + :type 'hook) + +(defun +custom-load-some-customizations (&optional noerror + nomessage + nosuffix + must-suffix) + "Load `custom-file', ignoring most customizations. +Only faces included in `+custom-allowed-faces' and variables +included in `+custom-allowed-variables' will be loaded. + +All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX, +MUST-SUFFIX---are passed to `load', which see." + (cl-letf (((symbol-function 'custom-set-faces) + (lambda (&rest args) + (apply #'custom-theme-set-faces 'user + (+custom--filter-list args +custom-allowed-faces)))) + ((symbol-function 'custom-set-variables) + (lambda (&rest args) + (apply #'custom-theme-set-variables 'user + (+custom--filter-list args +custom-allowed-variables))))) + (load custom-file noerror nomessage nosuffix must-suffix)) + (run-hooks '+custom-after-load-hook)) + +(provide '+custom) +;;; +custom.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el new file mode 100644 index 0000000..22450f7 --- /dev/null +++ b/lisp/+lisp.el @@ -0,0 +1,93 @@ +;;; +lisp.el -*- lexical-binding: t -*- + +;;; Comment-or-uncomment-sexp +;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html + +(defun +lisp-uncomment-sexp (&optional n) + "Uncomment N sexps around point." + (interactive "P") + (let* ((initial-point (point-marker)) + (inhibit-field-text-motion t) + (p) + (end (save-excursion + (when (elt (syntax-ppss) 4) + (re-search-backward comment-start-skip + (line-beginning-position) + t)) + (setq p (point-marker)) + (comment-forward (point-max)) + (point-marker))) + (beg (save-excursion + (forward-line 0) + (while (and (not (bobp)) + (= end (save-excursion + (comment-forward (point-max)) + (point)))) + (forward-line -1)) + (goto-char (line-end-position)) + (re-search-backward comment-start-skip + (line-beginning-position) + t) + (ignore-errors + (while (looking-at-p comment-start-skip) + (forward-char -1))) + (point-marker)))) + (unless (= beg end) + (uncomment-region beg end) + (goto-char p) + ;; Indentify the "top-level" sexp inside the comment. + (while (and (ignore-errors (backward-up-list) t) + (>= (point) beg)) + (skip-chars-backward (rx (syntax expression-prefix))) + (setq p (point-marker))) + ;; Re-comment everything before it. + (ignore-errors + (comment-region beg p)) + ;; And everything after it. + (goto-char p) + (forward-sexp (or n 1)) + (skip-chars-forward "\r\n[:blank:]") + (if (< (point) end) + (ignore-errors + (comment-region (point) end)) + ;; If this is a closing delimiter, pull it up. + (goto-char end) + (skip-chars-forward "\r\n[:blank:]") + (when (eq 5 (car (syntax-after (point)))) + (delete-indentation)))) + ;; Without a prefix, it's more useful to leave point where + ;; it was. + (unless n + (goto-char initial-point)))) + +(defun +lisp-comment-sexp--raw () + "Comment the sexp at point or ahead of point." + (pcase (or (bounds-of-thing-at-point 'sexp) + (save-excursion + (skip-chars-forward "\r\n[:blank:]") + (bounds-of-thing-at-point 'sexp))) + (`(,l . ,r) + (goto-char r) + (skip-chars-forward "\r\n[:blank:]") + (save-excursion + (comment-region l r)) + (skip-chars-forward "\r\n[:blank:]")))) + +(defun +lisp-comment-or-uncomment-sexp (&optional n) + "Comment the sexp at point and move past it. +If already inside (or before) a comment, uncomment instead. +With a prefix argument N, (un)comment that many sexps." + (interactive "P") + (if (or (elt (syntax-ppss) 4) + (< (save-excursion + (skip-chars-forward "\r\n[:blank:]") + (point)) + (save-excursion + (comment-forward 1) + (point)))) + (+lisp-uncomment-sexp n) + (dotimes (_ (or n 1)) + (+lisp-comment-sexp--raw)))) + +(provide '+lisp) +;;; +lisp.el ends here diff --git a/lisp/+message.el b/lisp/+message.el new file mode 100644 index 0000000..b8bc234 --- /dev/null +++ b/lisp/+message.el @@ -0,0 +1,26 @@ +;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +;; Thanks to Alex Schroeder for this! +;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically + +(defun +message-check-for-signature-change (&rest ignore) + "Check for a change in the To: or Cc: fields" + (when (and (message--in-tocc-p) + (not (buffer-narrowed-p))) + (save-excursion + (goto-char (point-max)) + (let ((end (point))) + (when (re-search-backward message-signature-separator nil t) + (delete-region (1- (match-beginning 0)) end))) + (message-insert-signature)))) + +(defun +message-signature-setup () + (make-local-variable 'after-change-functions) + (push '+message-check-for-signature-change after-change-functions)) + +(provide '+message) +;;; +message.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el new file mode 100644 index 0000000..74b9b77 --- /dev/null +++ b/lisp/+notmuch.el @@ -0,0 +1,105 @@ +;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- + +;;; Commentary: + +;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. + +;;; Code: + +(require 'cl-lib) +(require 'notmuch) + +(defvar +notmuch-send-dispatch-rules nil + "Alist of from addresses and variables to set when sending.") + +(defun +notmuch-query-concat (&rest queries) + "Concatenate notmuch queries." + (mapconcat #'identity queries " AND ")) + +(defun +send-mail-dispatch () + "Dispatch mail sender, depending on account." + (let ((from (message-fetch-field "from"))) + (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules + if (string-match-p addr from) return vars)) + (set (car vars) (cdr vars))))) + +(defun +notmuch-correct-tags (args) + (list (car args) (mapcar #'string-trim (cadr args)))) + +(defun +notmuch-goto (&optional prefix) + "Go straight to a `notmuch' search. +Without PREFIX argument, go to the first one in +`notmuch-saved-searches'; with a PREFIX argument, prompt the user +for which saved search to go to; with a double PREFIX +argument (\\[universal-argument] \\[universal-argument]), prompt +for search." + (interactive "P") + (pcase prefix + ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) + ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " + (mapcar (lambda (el) + (plist-get el :name)) + notmuch-saved-searches)) + notmuch-saved-searches + :key (lambda (el) (plist-get el :name)) + :test #'equal) + :query))) + (_ (notmuch-search)))) + +;; Don't add an initial input when completing addresses +(eval-after notmuch + (cond ((featurep 'el-patch) + (el-patch-feature notmuch) + (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) + "Call (`completing-read' + PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" + (completing-read + prompt collection nil nil + (el-patch-swap initial-input + nil) + 'notmuch-address-history))) + (:else + (defun notmuch-address-selection-function (prompt collection initial-input) + "Call (`completing-read' + PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" + (completing-read + prompt collection nil nil nil + 'notmuch-address-history))))) + +(defcustom +notmuch-spam-tags '("+spam" "+Spam") + "A list of tag changes to apply when marking a thread as spam." + :type '(repeat string)) + +(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) + "Mark the current message as spam and move to the next." + (interactive "P") + (+notmuch-tree-mark-spam ham) + (notmuch-tree-next-matching-message)) + +(defun +notmuch-tree-mark-spam (&optional ham) + "Mark the current message as spam. +That is, apply the tag changes in `+notmuch-spam-tags' to it. If +an optional prefix HAM argument is given, the message will be +marked as not-spam (\"ham\"), i.e., the tag changes in +`+notmuch-spam-tags' will be reversed." + (interactive "P") + (when +notmuch-spam-tags + (notmuch-tree-tag + (notmuch-tag-change-list +notmuch-spam-tags ham)))) + +(defun +notmuch-search-mark-spam (&optional ham beg end) + "Mark the current thread or region as spam. +This adds the tags in `+notmuch-spam-tags' to the message. With +an optional HAM prefix argument, mark the messages as +not-spam (\"ham\"). + +This function advances the next thread when finished." + (interactive (cons current-prefix-arg (notmuch-interactive-region))) + (when +notmuch-spam-tags + (notmuch-search-tag + (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) + (when (eq beg end) + (notmuch-search-next-thread))) + +(provide '+notmuch) +;;; +notmuch.el ends here diff --git a/lisp/+tempo.el b/lisp/+tempo.el index 2324665..2c81e54 100644 --- a/lisp/+tempo.el +++ b/lisp/+tempo.el @@ -1,6 +1,7 @@ ;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*- (require 'tempo) +(declare-function derived-mode-abbrev-table-name "tempo") ;; TODO: I need to figure out where this function goes. (defun delete2 (list &rest elems) @@ -35,7 +36,7 @@ under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." (elements (delete2 elements :mode :abbrev :taglist))) `(let ((,template (tempo-define-template ,tag ',elements - ,tag + ,(or abbrev tag) ,doc ,taglist))) (define-abbrev ,table ,tag "" ,template :system t) diff --git a/lisp/acdw.el b/lisp/acdw.el index f039540..6e298b2 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -28,6 +28,36 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." (make-directory (file-name-directory file-name) :parents)) file-name)))) +;;; Evaluating things after other things + + +(defun eval-after-init (fn) + "Evaluate FN after inititation, or now if Emacs is initialized. +FN is called with no arguments." + (if after-init-time + (funcall fn) + (add-hook 'after-init-hook fn))) + +(defmacro eval-after (features &rest body) + "Evaluate BODY, but only after loading FEATURES. +FEATURES can be an atom or a list; as an atom it works like +`with-eval-after-load'. The special feature `init' will evaluate +BODY after Emacs is finished initializing." + (declare (indent 1) + (debug (form def-body))) + (unless (listp features) + (setf features (list features))) + (if (null features) + (macroexp-progn body) + (let* ((this (car features)) + (rest (cdr features))) + (cond ((eq this 'init) + `(eval-after-init + (lambda () (eval-after ,rest ,@body)))) + (:else + `(with-eval-after-load ',this + (eval-after ,rest ,@body))))))) + ;;; Convenience functions (defun define-key* (maps &rest keydefs) @@ -58,7 +88,7 @@ not a list, return a one-element list containing OBJECT." (defun add-to-list* (lists &rest things) "Add THINGS to LISTS. LISTS can be one list variable or a list. Each thing of THINGS -can be either a variablel (the thing), or a list of the form +can be either a variable (the thing), or a list of the form (ELEMENT &optional APPEND COMPARE-FN), which is passed to `add-to-list'." (declare (indent 1)) @@ -180,9 +210,10 @@ When joining, this command deletes whitespace." (delete-indentation 1) (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) -(defun other-window|switch-buffer () - "Call `other-window' or `switch-buffer' depending on windows." - (interactive) - (if (one-window-p) - (switch-to-buffer nil) +(defun other-window|switch-buffer (arg) + "Call `other-window' or `switch-buffer' depending on windows. +When called with prefix ARG, unconditionally switch buffer." + (interactive "P") + (if (or arg (one-window-p)) + (switch-to-buffer (other-buffer) nil t) (other-window 1))) diff --git a/lisp/pita.el b/lisp/pita.el index 92ebf1b..ed67c92 100644 --- a/lisp/pita.el +++ b/lisp/pita.el @@ -1,6 +1,38 @@ ;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*- ;; 🥙 +;;; utils + +(defun walk-tree-replace (tree find replace) + (let ((r nil)) + (dolist (form tree) + (push (cond ((eq find form) replace) + ((listp form) + (walk-tree-replace form find replace)) + (t form)) + r)) + (reverse r))) + +;;; crux advices +;; these should all go :before the function they're advising. + +(defun with-region-or-buffer (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (point-min) (point-max))))) + +(defun with-region-or-line (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (line-beginning-position) (line-end-position))))) + +(defun with-region-or-to-eol (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (point) (line-end-position))))) + +;;; wrappers + (defmacro with-message (msg &rest body) (declare (indent 1)) (when (listp msg) @@ -16,16 +48,6 @@ (:success (message "%s done" ,m) r) (t (signal (car e) (cdr e))))))) -(defun walk-tree-replace (tree find replace) - (let ((r nil)) - (dolist (form tree) - (push (cond ((eq find form) replace) - ((listp form) - (walk-tree-replace form find replace)) - (t form)) - r)) - (reverse r))) - (defmacro with-pr (msg &rest body) (declare (indent 1)) (when (listp msg) @@ -41,24 +63,7 @@ body) (and ,pr (progress-reporter-done ,pr))))) - -;;; crux advices -;; these should all go :before the function they're advising. - -(defun with-region-or-buffer (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (point-min) (point-max))))) - -(defun with-region-or-line (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (line-beginning-position) (line-end-position))))) - -(defun with-region-or-to-eol (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (point) (line-end-position))))) +;;; wrapper advice (provide 'pita) ;;; pita.el ends here -- cgit 1.4.1-21-gabe81