7 files changed, 348 insertions, 35 deletions

@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)
@@ -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)))
@@ -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