about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-10-28 19:43:06 -0500
committerCase Duckworth2022-10-28 19:43:06 -0500
commit296c4d7c09cf66b2a97e8871c5a903fda9d0919e (patch)
tree8bf3359b30cd324d0e14ed1d3d33baae8b4aec27 /lisp
parentyoke (diff)
downloademacs-296c4d7c09cf66b2a97e8871c5a903fda9d0919e.tar.gz
emacs-296c4d7c09cf66b2a97e8871c5a903fda9d0919e.zip
uhhhhh
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+custom.el52
-rw-r--r--lisp/+lisp.el93
-rw-r--r--lisp/+message.el26
-rw-r--r--lisp/+notmuch.el105
-rw-r--r--lisp/+tempo.el3
-rw-r--r--lisp/acdw.el43
-rw-r--r--lisp/pita.el61
7 files changed, 348 insertions, 35 deletions
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 @@
1;;; +custom.el -*- lexical-binding: t -*-
2
3(require 'cl-lib)
4(require 'seq)
5
6(defgroup +custom nil
7 "Group for extra `customize' customizations."
8 :group 'customize)
9
10(defcustom +custom-allowed-variables nil
11 "Variables to load during `+custom-load-some-customizations'."
12 :type '(repeat symbol))
13
14(defcustom +custom-allowed-faces nil
15 "Faces to load during `+custom-load-some-customziations'."
16 :type '(repeat face))
17
18(defun +custom--filter-list (customlist allowlist)
19 "Filter CUSTOMLIST to only include those items in ALLOWLIST.
20Each item in ALLOWLIST will be compared using `eq' to the `car'
21of each item in CUSTOMLIST. Items in CUSTOMLIST not included in
22ALLOWLIST will be removed from the return value."
23 (seq-filter (lambda (el) (memq (car el) allowlist))
24 customlist))
25
26(defcustom +custom-after-load-hook nil
27 "Hook run after loading the custom file."
28 :type 'hook)
29
30(defun +custom-load-some-customizations (&optional noerror
31 nomessage
32 nosuffix
33 must-suffix)
34 "Load `custom-file', ignoring most customizations.
35Only faces included in `+custom-allowed-faces' and variables
36included in `+custom-allowed-variables' will be loaded.
37
38All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX,
39MUST-SUFFIX---are passed to `load', which see."
40 (cl-letf (((symbol-function 'custom-set-faces)
41 (lambda (&rest args)
42 (apply #'custom-theme-set-faces 'user
43 (+custom--filter-list args +custom-allowed-faces))))
44 ((symbol-function 'custom-set-variables)
45 (lambda (&rest args)
46 (apply #'custom-theme-set-variables 'user
47 (+custom--filter-list args +custom-allowed-variables)))))
48 (load custom-file noerror nomessage nosuffix must-suffix))
49 (run-hooks '+custom-after-load-hook))
50
51(provide '+custom)
52;;; +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 @@
1;;; +lisp.el -*- lexical-binding: t -*-
2
3;;; Comment-or-uncomment-sexp
4;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
5
6(defun +lisp-uncomment-sexp (&optional n)
7 "Uncomment N sexps around point."
8 (interactive "P")
9 (let* ((initial-point (point-marker))
10 (inhibit-field-text-motion t)
11 (p)
12 (end (save-excursion
13 (when (elt (syntax-ppss) 4)
14 (re-search-backward comment-start-skip
15 (line-beginning-position)
16 t))
17 (setq p (point-marker))
18 (comment-forward (point-max))
19 (point-marker)))
20 (beg (save-excursion
21 (forward-line 0)
22 (while (and (not (bobp))
23 (= end (save-excursion
24 (comment-forward (point-max))
25 (point))))
26 (forward-line -1))
27 (goto-char (line-end-position))
28 (re-search-backward comment-start-skip
29 (line-beginning-position)
30 t)
31 (ignore-errors
32 (while (looking-at-p comment-start-skip)
33 (forward-char -1)))
34 (point-marker))))
35 (unless (= beg end)
36 (uncomment-region beg end)
37 (goto-char p)
38 ;; Indentify the "top-level" sexp inside the comment.
39 (while (and (ignore-errors (backward-up-list) t)
40 (>= (point) beg))
41 (skip-chars-backward (rx (syntax expression-prefix)))
42 (setq p (point-marker)))
43 ;; Re-comment everything before it.
44 (ignore-errors
45 (comment-region beg p))
46 ;; And everything after it.
47 (goto-char p)
48 (forward-sexp (or n 1))
49 (skip-chars-forward "\r\n[:blank:]")
50 (if (< (point) end)
51 (ignore-errors
52 (comment-region (point) end))
53 ;; If this is a closing delimiter, pull it up.
54 (goto-char end)
55 (skip-chars-forward "\r\n[:blank:]")
56 (when (eq 5 (car (syntax-after (point))))
57 (delete-indentation))))
58 ;; Without a prefix, it's more useful to leave point where
59 ;; it was.
60 (unless n
61 (goto-char initial-point))))
62
63(defun +lisp-comment-sexp--raw ()
64 "Comment the sexp at point or ahead of point."
65 (pcase (or (bounds-of-thing-at-point 'sexp)
66 (save-excursion
67 (skip-chars-forward "\r\n[:blank:]")
68 (bounds-of-thing-at-point 'sexp)))
69 (`(,l . ,r)
70 (goto-char r)
71 (skip-chars-forward "\r\n[:blank:]")
72 (save-excursion
73 (comment-region l r))
74 (skip-chars-forward "\r\n[:blank:]"))))
75
76(defun +lisp-comment-or-uncomment-sexp (&optional n)
77 "Comment the sexp at point and move past it.
78If already inside (or before) a comment, uncomment instead.
79With a prefix argument N, (un)comment that many sexps."
80 (interactive "P")
81 (if (or (elt (syntax-ppss) 4)
82 (< (save-excursion
83 (skip-chars-forward "\r\n[:blank:]")
84 (point))
85 (save-excursion
86 (comment-forward 1)
87 (point))))
88 (+lisp-uncomment-sexp n)
89 (dotimes (_ (or n 1))
90 (+lisp-comment-sexp--raw))))
91
92(provide '+lisp)
93;;; +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 @@
1;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;; Thanks to Alex Schroeder for this!
8;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
9
10(defun +message-check-for-signature-change (&rest ignore)
11 "Check for a change in the To: or Cc: fields"
12 (when (and (message--in-tocc-p)
13 (not (buffer-narrowed-p)))
14 (save-excursion
15 (goto-char (point-max))
16 (let ((end (point)))
17 (when (re-search-backward message-signature-separator nil t)
18 (delete-region (1- (match-beginning 0)) end)))
19 (message-insert-signature))))
20
21(defun +message-signature-setup ()
22 (make-local-variable 'after-change-functions)
23 (push '+message-check-for-signature-change after-change-functions))
24
25(provide '+message)
26;;; +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 @@
1;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't.
6
7;;; Code:
8
9(require 'cl-lib)
10(require 'notmuch)
11
12(defvar +notmuch-send-dispatch-rules nil
13 "Alist of from addresses and variables to set when sending.")
14
15(defun +notmuch-query-concat (&rest queries)
16 "Concatenate notmuch queries."
17 (mapconcat #'identity queries " AND "))
18
19(defun +send-mail-dispatch ()
20 "Dispatch mail sender, depending on account."
21 (let ((from (message-fetch-field "from")))
22 (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules
23 if (string-match-p addr from) return vars))
24 (set (car vars) (cdr vars)))))
25
26(defun +notmuch-correct-tags (args)
27 (list (car args) (mapcar #'string-trim (cadr args))))
28
29(defun +notmuch-goto (&optional prefix)
30 "Go straight to a `notmuch' search.
31Without PREFIX argument, go to the first one in
32`notmuch-saved-searches'; with a PREFIX argument, prompt the user
33for which saved search to go to; with a double PREFIX
34argument (\\[universal-argument] \\[universal-argument]), prompt
35for search."
36 (interactive "P")
37 (pcase prefix
38 ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
39 ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: "
40 (mapcar (lambda (el)
41 (plist-get el :name))
42 notmuch-saved-searches))
43 notmuch-saved-searches
44 :key (lambda (el) (plist-get el :name))
45 :test #'equal)
46 :query)))
47 (_ (notmuch-search))))
48
49;; Don't add an initial input when completing addresses
50(eval-after notmuch
51 (cond ((featurep 'el-patch)
52 (el-patch-feature notmuch)
53 (el-patch-defun notmuch-address-selection-function (prompt collection initial-input)
54 "Call (`completing-read'
55 PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
56 (completing-read
57 prompt collection nil nil
58 (el-patch-swap initial-input
59 nil)
60 'notmuch-address-history)))
61 (:else
62 (defun notmuch-address-selection-function (prompt collection initial-input)
63 "Call (`completing-read'
64 PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
65 (completing-read
66 prompt collection nil nil nil
67 'notmuch-address-history)))))
68
69(defcustom +notmuch-spam-tags '("+spam" "+Spam")
70 "A list of tag changes to apply when marking a thread as spam."
71 :type '(repeat string))
72
73(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end)
74 "Mark the current message as spam and move to the next."
75 (interactive "P")
76 (+notmuch-tree-mark-spam ham)
77 (notmuch-tree-next-matching-message))
78
79(defun +notmuch-tree-mark-spam (&optional ham)
80 "Mark the current message as spam.
81That is, apply the tag changes in `+notmuch-spam-tags' to it. If
82an optional prefix HAM argument is given, the message will be
83marked as not-spam (\"ham\"), i.e., the tag changes in
84`+notmuch-spam-tags' will be reversed."
85 (interactive "P")
86 (when +notmuch-spam-tags
87 (notmuch-tree-tag
88 (notmuch-tag-change-list +notmuch-spam-tags ham))))
89
90(defun +notmuch-search-mark-spam (&optional ham beg end)
91 "Mark the current thread or region as spam.
92This adds the tags in `+notmuch-spam-tags' to the message. With
93an optional HAM prefix argument, mark the messages as
94not-spam (\"ham\").
95
96This function advances the next thread when finished."
97 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
98 (when +notmuch-spam-tags
99 (notmuch-search-tag
100 (notmuch-tag-change-list +notmuch-spam-tags ham) beg end))
101 (when (eq beg end)
102 (notmuch-search-next-thread)))
103
104(provide '+notmuch)
105;;; +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 @@
1;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*- 1;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*-
2 2
3(require 'tempo) 3(require 'tempo)
4(declare-function derived-mode-abbrev-table-name "tempo")
4 5
5;; TODO: I need to figure out where this function goes. 6;; TODO: I need to figure out where this function goes.
6(defun delete2 (list &rest elems) 7(defun delete2 (list &rest elems)
@@ -35,7 +36,7 @@ under MODE's abbrev-table. If ABBREV isn't given, TAG will be used."
35 (elements (delete2 elements :mode :abbrev :taglist))) 36 (elements (delete2 elements :mode :abbrev :taglist)))
36 `(let ((,template (tempo-define-template ,tag 37 `(let ((,template (tempo-define-template ,tag
37 ',elements 38 ',elements
38 ,tag 39 ,(or abbrev tag)
39 ,doc 40 ,doc
40 ,taglist))) 41 ,taglist)))
41 (define-abbrev ,table ,tag "" ,template :system t) 42 (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."
28 (make-directory (file-name-directory file-name) :parents)) 28 (make-directory (file-name-directory file-name) :parents))
29 file-name)))) 29 file-name))))
30 30
31;;; Evaluating things after other things
32
33
34(defun eval-after-init (fn)
35 "Evaluate FN after inititation, or now if Emacs is initialized.
36FN is called with no arguments."
37 (if after-init-time
38 (funcall fn)
39 (add-hook 'after-init-hook fn)))
40
41(defmacro eval-after (features &rest body)
42 "Evaluate BODY, but only after loading FEATURES.
43FEATURES can be an atom or a list; as an atom it works like
44`with-eval-after-load'. The special feature `init' will evaluate
45BODY after Emacs is finished initializing."
46 (declare (indent 1)
47 (debug (form def-body)))
48 (unless (listp features)
49 (setf features (list features)))
50 (if (null features)
51 (macroexp-progn body)
52 (let* ((this (car features))
53 (rest (cdr features)))
54 (cond ((eq this 'init)
55 `(eval-after-init
56 (lambda () (eval-after ,rest ,@body))))
57 (:else
58 `(with-eval-after-load ',this
59 (eval-after ,rest ,@body)))))))
60
31;;; Convenience functions 61;;; Convenience functions
32 62
33(defun define-key* (maps &rest keydefs) 63(defun define-key* (maps &rest keydefs)
@@ -58,7 +88,7 @@ not a list, return a one-element list containing OBJECT."
58(defun add-to-list* (lists &rest things) 88(defun add-to-list* (lists &rest things)
59 "Add THINGS to LISTS. 89 "Add THINGS to LISTS.
60LISTS can be one list variable or a list. Each thing of THINGS 90LISTS can be one list variable or a list. Each thing of THINGS
61can be either a variablel (the thing), or a list of the form 91can be either a variable (the thing), or a list of the form
62(ELEMENT &optional APPEND COMPARE-FN), which is passed to 92(ELEMENT &optional APPEND COMPARE-FN), which is passed to
63`add-to-list'." 93`add-to-list'."
64 (declare (indent 1)) 94 (declare (indent 1))
@@ -180,9 +210,10 @@ When joining, this command deletes whitespace."
180 (delete-indentation 1) 210 (delete-indentation 1)
181 (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) 211 (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
182 212
183(defun other-window|switch-buffer () 213(defun other-window|switch-buffer (arg)
184 "Call `other-window' or `switch-buffer' depending on windows." 214 "Call `other-window' or `switch-buffer' depending on windows.
185 (interactive) 215When called with prefix ARG, unconditionally switch buffer."
186 (if (one-window-p) 216 (interactive "P")
187 (switch-to-buffer nil) 217 (if (or arg (one-window-p))
218 (switch-to-buffer (other-buffer) nil t)
188 (other-window 1))) 219 (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 @@
1;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*- 1;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*-
2;; 🥙 2;; 🥙
3 3
4;;; utils
5
6(defun walk-tree-replace (tree find replace)
7 (let ((r nil))
8 (dolist (form tree)
9 (push (cond ((eq find form) replace)
10 ((listp form)
11 (walk-tree-replace form find replace))
12 (t form))
13 r))
14 (reverse r)))
15
16;;; crux advices
17;; these should all go :before the function they're advising.
18
19(defun with-region-or-buffer (&rest _)
20 (interactive (if mark-active
21 (list (region-beginning) (region-end))
22 (list (point-min) (point-max)))))
23
24(defun with-region-or-line (&rest _)
25 (interactive (if mark-active
26 (list (region-beginning) (region-end))
27 (list (line-beginning-position) (line-end-position)))))
28
29(defun with-region-or-to-eol (&rest _)
30 (interactive (if mark-active
31 (list (region-beginning) (region-end))
32 (list (point) (line-end-position)))))
33
34;;; wrappers
35
4(defmacro with-message (msg &rest body) 36(defmacro with-message (msg &rest body)
5 (declare (indent 1)) 37 (declare (indent 1))
6 (when (listp msg) 38 (when (listp msg)
@@ -16,16 +48,6 @@
16 (:success (message "%s done" ,m) r) 48 (:success (message "%s done" ,m) r)
17 (t (signal (car e) (cdr e))))))) 49 (t (signal (car e) (cdr e)))))))
18 50
19(defun walk-tree-replace (tree find replace)
20 (let ((r nil))
21 (dolist (form tree)
22 (push (cond ((eq find form) replace)
23 ((listp form)
24 (walk-tree-replace form find replace))
25 (t form))
26 r))
27 (reverse r)))
28
29(defmacro with-pr (msg &rest body) 51(defmacro with-pr (msg &rest body)
30 (declare (indent 1)) 52 (declare (indent 1))
31 (when (listp msg) 53 (when (listp msg)
@@ -41,24 +63,7 @@
41 body) 63 body)
42 (and ,pr (progress-reporter-done ,pr))))) 64 (and ,pr (progress-reporter-done ,pr)))))
43 65
44 66;;; wrapper advice
45;;; crux advices
46;; these should all go :before the function they're advising.
47
48(defun with-region-or-buffer (&rest _)
49 (interactive (if mark-active
50 (list (region-beginning) (region-end))
51 (list (point-min) (point-max)))))
52
53(defun with-region-or-line (&rest _)
54 (interactive (if mark-active
55 (list (region-beginning) (region-end))
56 (list (line-beginning-position) (line-end-position)))))
57
58(defun with-region-or-to-eol (&rest _)
59 (interactive (if mark-active
60 (list (region-beginning) (region-end))
61 (list (point) (line-end-position)))))
62 67
63(provide 'pita) 68(provide 'pita)
64;;; pita.el ends here 69;;; pita.el ends here