diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+browse-url.el | 189 | ||||
-rw-r--r-- | lisp/+cape.el | 25 | ||||
-rw-r--r-- | lisp/+emms.el | 38 | ||||
-rw-r--r-- | lisp/+flyspell-correct.el | 24 | ||||
-rw-r--r-- | lisp/+hungry-delete.el | 53 | ||||
-rw-r--r-- | lisp/+isearch.el | 24 | ||||
-rw-r--r-- | lisp/+ispell.el | 97 | ||||
-rw-r--r-- | lisp/+link-hint.el | 144 | ||||
-rw-r--r-- | lisp/+lisp.el | 93 | ||||
-rw-r--r-- | lisp/+message.el | 26 | ||||
-rw-r--r-- | lisp/+notmuch.el | 149 | ||||
-rw-r--r-- | lisp/+org-capture.el | 49 | ||||
-rw-r--r-- | lisp/+org.el | 309 | ||||
-rw-r--r-- | lisp/+paredit.el | 26 | ||||
-rw-r--r-- | lisp/+titlecase.el | 34 | ||||
-rw-r--r-- | lisp/acdw-defaults.el | 295 | ||||
-rw-r--r-- | lisp/acdw-funs.el | 262 | ||||
-rw-r--r-- | lisp/acdw-macs.el | 293 | ||||
-rw-r--r-- | lisp/acdw.el | 79 | ||||
-rw-r--r-- | lisp/graveyard.el | 50 | ||||
-rw-r--r-- | lisp/init-org.el | 144 | ||||
-rw-r--r-- | lisp/upload-junk.el | 47 | ||||
-rw-r--r-- | lisp/yoke.el | 392 |
23 files changed, 0 insertions, 2842 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index b65b6f9..0000000 --- a/lisp/+browse-url.el +++ /dev/null | |||
@@ -1,189 +0,0 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (require 'browse-url) | ||
4 | (require 'cl-lib) | ||
5 | (require 'seq) | ||
6 | (require 'url-util) | ||
7 | |||
8 | (defgroup +browse-url nil | ||
9 | "My `browse-url' extras." | ||
10 | :group 'browse-url) | ||
11 | |||
12 | ;;; External URL handlers | ||
13 | |||
14 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
15 | (viewer | ||
16 | &key | ||
17 | args | ||
18 | (prompt "URL: ") | ||
19 | (program (executable-find (format "%s" viewer))) | ||
20 | (name (intern (format "+browse-url-with-%s" viewer))) | ||
21 | doc | ||
22 | (var (intern (format "%s-args" name))) | ||
23 | vardoc | ||
24 | (custom-group '+browse-url) | ||
25 | (fallback '(function browse-url-generic))) | ||
26 | "Create a `browse-url' handler function calling PROGRAM on the URL. | ||
27 | This macro also creates a `customize' setting in CUSTOM-GROUP for | ||
28 | PROGRAM's command-line arguments. ARGS specifies the | ||
29 | default arguments for this user option. | ||
30 | |||
31 | PROGRAM defaults to the result of calling `executable-find' on VIEWER. | ||
32 | |||
33 | PROMPT is shown to the user in the function's `interactive' spec, as an argument | ||
34 | to `browse-url-interactive-arg'. | ||
35 | |||
36 | The resulting function is named NAME, which defaults to | ||
37 | `+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults | ||
38 | to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of | ||
39 | the function and variable respectively; otherwise a basic default doc-string is | ||
40 | used. | ||
41 | |||
42 | If FALLBACK is non-nil (the default is `browse-url-generic'), the | ||
43 | generated function will call FALLBACK if unable to start PROGRAM | ||
44 | for some reason." | ||
45 | (declare (indent 1)) | ||
46 | `(progn | ||
47 | (defcustom ,var ,args | ||
48 | ,(or vardoc (format "Arguments to pass to %s in `%s'." | ||
49 | viewer name)) | ||
50 | :type '(repeat :tag "Command-line argument" string) | ||
51 | :group ',custom-group) | ||
52 | (defun ,name (url &optional new-window) | ||
53 | ,(or doc (format "Open URL in %s." viewer)) | ||
54 | (interactive (browse-url-interactive-arg ,prompt)) | ||
55 | (let* ((url (browse-url-encode-url url)) | ||
56 | (process-environment (browse-url-process-environment))) | ||
57 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
58 | (unless (ignore-errors (apply #'start-process | ||
59 | (format "%s %s" ',viewer url) | ||
60 | nil | ||
61 | ,program | ||
62 | (append ,var (list url)))) | ||
63 | ,@(cond | ||
64 | (fallback `((funcall ,fallback url new-window))) | ||
65 | (:else `((message "Can't find viewer: %s" ,viewer) | ||
66 | nil)))))))) | ||
67 | |||
68 | ;; Some default handlers | ||
69 | |||
70 | (+browse-url-make-external-viewer-handler mpv | ||
71 | :args '("--cache-pause-wait=15" | ||
72 | "--cache-pause-initial=yes") | ||
73 | :prompt "Video URL: ") | ||
74 | |||
75 | (+browse-url-make-external-viewer-handler mpv-image | ||
76 | :program (executable-find "mpv") | ||
77 | :args '("--image-display-duration=inf") | ||
78 | :prompt "Image URL: ") | ||
79 | |||
80 | ;;; Downloading | ||
81 | |||
82 | (defcustom +browse-url-download-open t | ||
83 | "Whether to open downloaded files after downloading." | ||
84 | :type 'boolean) | ||
85 | |||
86 | (defun +browse-url-download (url &rest _) | ||
87 | "Download URL to `eww-download-directory'." | ||
88 | (interactive "sDownload URL: ") | ||
89 | (let ((dir eww-download-directory)) | ||
90 | (when (functionp dir) (setq dir (funcall dir))) | ||
91 | (make-directory dir :parents) | ||
92 | (url-retrieve url | ||
93 | (lambda (s u d) | ||
94 | (let ((file (+browse-url-download-callback s u d))) | ||
95 | (when +browse-url-download-open | ||
96 | (browse-url-xdg-open file)))) | ||
97 | (list url dir)))) | ||
98 | |||
99 | (defun +browse-url-download-callback (status url dir) | ||
100 | ;; A slight change to `eww-download-callback' that returns the downloaded | ||
101 | ;; filename. | ||
102 | (unless (plist-get status :error) | ||
103 | (let* ((obj (url-generic-parse-url url)) | ||
104 | (path (directory-file-name (car (url-path-and-query obj)))) | ||
105 | (file (eww-make-unique-file-name | ||
106 | (eww-decode-url-file-name (file-name-nondirectory path)) | ||
107 | dir))) | ||
108 | (goto-char (point-min)) | ||
109 | (re-search-forward "\r?\n\r?\n") | ||
110 | (let ((coding-system-for-write 'no-conversion)) | ||
111 | (write-region (point) (point-max) file)) | ||
112 | (message "Saved %s" file) | ||
113 | file))) | ||
114 | |||
115 | ;;; URL matcher generators | ||
116 | |||
117 | (defun +browse-url-matches (&rest regexps) | ||
118 | "Return a lambda that will determine if a url matches REGEXPS. | ||
119 | Each regexp will be tested in turn. The first one that matches | ||
120 | is returned by the lambda. | ||
121 | |||
122 | This is a good function to use in key positions in `browse-url-handlers'." | ||
123 | `(lambda (url &optional new-window) | ||
124 | (cl-loop for regexp in ',regexps | ||
125 | if (string-match-p regexp url) | ||
126 | return regexp))) | ||
127 | |||
128 | ;;; External domains | ||
129 | ;; Some domains just don't open well in `eww'. The following function and user | ||
130 | ;; option define an easy way to automatically open those. | ||
131 | |||
132 | (defcustom +browse-url-external-domains nil | ||
133 | "Domains to open in `browse-url-secondary-browser-function'. | ||
134 | This is just a list of strings. They'll be regexp-escaped and | ||
135 | passed to `+browse-url-external-url-p', which is a good function | ||
136 | to put in `browse-url-handlers'. | ||
137 | |||
138 | If an item in this list is a list itself, it should contain one string, a valid | ||
139 | regexp that will not be regexp-quoted when matching against a url." | ||
140 | :type '(repeat (choice | ||
141 | (list :tag "Regexp" regexp) | ||
142 | (string :tag "Literal string")))) | ||
143 | |||
144 | (defun +browse-url-external-url-p (url) | ||
145 | "Return t if URL is a member of `+browse-url-external-domains'. | ||
146 | This function only tests URL's domain." | ||
147 | (let ((host (url-host (url-generic-parse-url url)))) | ||
148 | (cl-loop for domain in +browse-url-external-domains | ||
149 | if (string-match-p (if (stringp domain) | ||
150 | (regexp-quote domain) | ||
151 | (car domain)) | ||
152 | host) | ||
153 | return t))) | ||
154 | |||
155 | ;;; Switch to an external browser from an Emacs browser | ||
156 | |||
157 | (defmacro +browse-url-switch-external-browser (mode url-fetcher-form) | ||
158 | "Create a function for MODE to open an external browser. | ||
159 | URL-FETCHER-FORM will be used to get the URL of the current visited page." | ||
160 | (declare (indent 1)) | ||
161 | `(defun ,(intern (format "+browse-url-external-from-%s" mode)) | ||
162 | (&optional url) | ||
163 | "Browse URL with `browse-url-secondary-browser-function'. | ||
164 | This will close the current buffer." | ||
165 | (interactive nil ,mode) | ||
166 | (condition-case e | ||
167 | (funcall browse-url-secondary-browser-function | ||
168 | (or url ,url-fetcher-form)) | ||
169 | (:success (when (null url) (quit-window))) ; Interactive use | ||
170 | (t (signal (car e) (cdr e)))))) | ||
171 | |||
172 | ;;; Mark `browse-url-browser-function' as safe | ||
173 | |||
174 | (defcustom +browse-url-other-safe-browser-functions nil | ||
175 | "Other safe browser functions." | ||
176 | :type '(repeat function)) | ||
177 | |||
178 | (defun +browse-url-browser-function-safe-p (f) | ||
179 | "Return t if F is a safe browser function." | ||
180 | (memq f (append +browse-url-other-safe-browser-functions | ||
181 | (mapcar (lambda (i) | ||
182 | (plist-get (cdr i) :value)) | ||
183 | (seq-filter (lambda (i) | ||
184 | (eq (car i) 'function-item)) | ||
185 | (cdr (get 'browse-url-browser-function | ||
186 | 'custom-type))))))) | ||
187 | |||
188 | (provide '+browse-url) | ||
189 | ;;; +browse-url.el ends here | ||
diff --git a/lisp/+cape.el b/lisp/+cape.el deleted file mode 100644 index 37e88fe..0000000 --- a/lisp/+cape.el +++ /dev/null | |||
@@ -1,25 +0,0 @@ | |||
1 | ;;; cape.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cape) | ||
6 | |||
7 | (defmacro +cape-insinuate (hook capes &rest capfs) | ||
8 | "Insinuate CAPES for a mode. | ||
9 | Add a function to HOOK that will add CAPES to the local | ||
10 | `completion-at-point-functions' for that mode's buffer. If CAPFS | ||
11 | are given, mark them all as non-exclusive." | ||
12 | (let ((fn (intern (format "+cape-insinuate@%s" hook)))) | ||
13 | `(prog1 | ||
14 | ,@(when capes | ||
15 | `((defun ,fn () | ||
16 | ,@(cl-loop for cape in capes | ||
17 | collect `(add-hook 'completion-at-point-functions | ||
18 | #',cape 90 :local))) | ||
19 | (add-hook ',hook #',fn))) | ||
20 | ,@(cl-loop for capf in capfs | ||
21 | collect `(advice-add ',capf :around | ||
22 | #'cape-wrap-nonexclusive))))) | ||
23 | |||
24 | (provide '+cape) | ||
25 | ;;; +cape.el ends here | ||
diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index a43daea..0000000 --- a/lisp/+emms.el +++ /dev/null | |||
@@ -1,38 +0,0 @@ | |||
1 | ;;; +emms.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (defun +emms-streams (&optional file) | ||
4 | "Better interface for `emms-streams'. | ||
5 | If FILE is non-nil, use it. Otherwise use `emms-streams-file'. | ||
6 | If `emms-streams-file' is nil or this function is called with | ||
7 | \\[universal-argument], prompt the user." | ||
8 | (interactive | ||
9 | (list (cond | ||
10 | ((or emms-streams-file | ||
11 | (not current-prefix-arg)) | ||
12 | emms-streams-file) | ||
13 | (:else (read-file-name "Stream file: " | ||
14 | emms-source-file-default-directory))))) | ||
15 | (when (and (not (file-exists-p emms-streams-file)) | ||
16 | (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?")) | ||
17 | (emms-streams-install)) | ||
18 | (let ((buf (get-buffer emms-streams-buffer-name))) | ||
19 | (when (not buf) | ||
20 | (with-current-buffer (get-buffer-create emms-streams-buffer-name) | ||
21 | (setq buf (current-buffer)) | ||
22 | (emms-playlist-mode) | ||
23 | (setq emms-playlist-buffer-p t) | ||
24 | (emms-playlist-set-playlist-buffer (current-buffer)) | ||
25 | (with-current-buffer (find-file-noselect emms-streams-file) | ||
26 | (cond | ||
27 | ((emms-source-playlist-native-p) | ||
28 | (emms-add-native-playlist emms-streams-file)) | ||
29 | ((emms-source-playlist-m3u-p) | ||
30 | (emms-add-m3u-playlist emms-streams-file)) | ||
31 | ((emms-source-playlist-pls-p) | ||
32 | (emms-add-pls-playlist emms-streams-file)) | ||
33 | (:else (error "Streams file `%s' isn't in a known format." | ||
34 | emms-streams-file)))))) | ||
35 | (switch-to-buffer buf))) | ||
36 | |||
37 | (provide '+emms) | ||
38 | ;;; +emms.el ends here | ||
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 9a33cc0..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'flyspell-correct) | ||
6 | |||
7 | (defun +flyspell-correct-buffer (&optional prefix) | ||
8 | "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. | ||
9 | With PREFIX, prompt to change the current dictionary." | ||
10 | (interactive "P") | ||
11 | (flyspell-buffer) | ||
12 | (when prefix | ||
13 | (let ((current-prefix-arg nil)) | ||
14 | (call-interactively #'ispell-change-dictionary))) | ||
15 | (with-message "Checking spelling" | ||
16 | (flyspell-correct-move (point-min) :forward :rapid))) | ||
17 | |||
18 | (defun +flyspell-correct-buffer-h (&rest _) | ||
19 | "Run `+flyspell-correct-buffer'. | ||
20 | This is suitable for placement in a hook." | ||
21 | (+flyspell-correct-buffer)) | ||
22 | |||
23 | (provide '+flyspell-correct) | ||
24 | ;;; +flyspell-correct.el ends here | ||
diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el deleted file mode 100644 index 601aecf..0000000 --- a/lisp/+hungry-delete.el +++ /dev/null | |||
@@ -1,53 +0,0 @@ | |||
1 | ;;; +hungry-delete.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'hungry-delete) | ||
8 | |||
9 | (defmacro +hungry-delete-define-alternative (func hd-func &optional direction) | ||
10 | "Define a `hungry-delete' alternative for FUNC. | ||
11 | If the adjacent characters in DIRECTION are one of | ||
12 | `hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call | ||
13 | FUNC. | ||
14 | |||
15 | If DIRECTION is a positive integer or `forward', look forward. | ||
16 | If it's negative or `backward', look backward. If it's absent, | ||
17 | this macro will try to guess based on the names of FUNC and | ||
18 | HD-FUNC. | ||
19 | |||
20 | This macro creates a function taking a prefix argument that's | ||
21 | passed to both of FUNC and HD-FUNC." | ||
22 | (let ((name (intern (format "%s|%s" func hd-func))) | ||
23 | (lookfn (cond | ||
24 | ((or (and (string-match-p "forward" (symbol-name func)) | ||
25 | (string-match-p "forward" (symbol-name hd-func)) | ||
26 | (not direction)) | ||
27 | (and (integerp direction) | ||
28 | (< 0 direction)) | ||
29 | (eq direction 'forward)) | ||
30 | 'looking-at) | ||
31 | ((or (and (string-match-p "backward" (symbol-name func)) | ||
32 | (string-match-p "backward" (symbol-name hd-func)) | ||
33 | (not direction)) | ||
34 | (and (integerp direction) | ||
35 | (> 0 direction)) | ||
36 | (eq direction 'backward)) | ||
37 | 'looking-back) | ||
38 | (:else (error "Bad direction: %S" direction)))) | ||
39 | (arg (gensym))) | ||
40 | `(defun ,name (,arg) | ||
41 | ,(concat (format "Do `%s' or `%s', depending on whitespace.\n" | ||
42 | func hd-func) | ||
43 | (format "Pass prefix argument %s to the underlying functions.\n" | ||
44 | (upcase (symbol-name arg))) | ||
45 | "This function was defined by `define-hungry-delete-alternative'.") | ||
46 | (interactive "*p") ; This is brittle | ||
47 | (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip)) | ||
48 | (,hd-func (or ,arg 1)) | ||
49 | (,func ,arg))))) | ||
50 | |||
51 | (provide '+hungry-delete) | ||
52 | ;;; +hungry-delete.el ends here | ||
53 | |||
diff --git a/lisp/+isearch.el b/lisp/+isearch.el deleted file mode 100644 index 3516ec4..0000000 --- a/lisp/+isearch.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; From https://github.com/astoff/isearch-mb/wiki | ||
4 | |||
5 | (defun +isearch-cancel@add-search-to-history () | ||
6 | "Add search string to history also when canceling. | ||
7 | This should be used as `:before' advice on `isearch-cancel'." | ||
8 | (unless (string-equal "" isearch-string) | ||
9 | (isearch-update-ring isearch-string isearch-regexp))) | ||
10 | |||
11 | (defun +perform-replace-dont-exit-on-anykey (orig &rest args) | ||
12 | "Don't exit replace for anykey that's not in `query-replace-map'. | ||
13 | This should be used as `:around' advice for `perform-replace'." | ||
14 | (save-window-excursion | ||
15 | (cl-letf* ((lookup-key-orig | ||
16 | (symbol-function 'lookup-key)) | ||
17 | ((symbol-function 'lookup-key) | ||
18 | (lambda (map key &optional accept-default) | ||
19 | (or (apply lookup-key-orig map key accept-default) | ||
20 | (when (eq map query-replace-map) 'help))))) | ||
21 | (apply orig args)))) | ||
22 | |||
23 | (provide '+isearch) | ||
24 | ;;; +isearch.el ends here | ||
diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index 10c31b8..0000000 --- a/lisp/+ispell.el +++ /dev/null | |||
@@ -1,97 +0,0 @@ | |||
1 | ;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'cl-lib) | ||
8 | (require 'seq) | ||
9 | |||
10 | ;; Utility function TODO: move elsewhere | ||
11 | (defun +ispell-append-removing-duplicates (&rest lists) | ||
12 | "Append LISTS, removing duplicates from the result. | ||
13 | Any keyword arguments to `cl-remove-duplicates' should come | ||
14 | before the LISTS." | ||
15 | (let (cl-remove-duplicates-args) | ||
16 | (while (keywordp (car lists)) | ||
17 | (push (pop lists) cl-remove-duplicates-args) | ||
18 | (push (pop lists) cl-remove-duplicates-args)) | ||
19 | (apply #'cl-remove-duplicates (apply #'append lists) | ||
20 | (nreverse cl-remove-duplicates-args)))) | ||
21 | |||
22 | ;;; Ispell in .dir-locals | ||
23 | |||
24 | ;; Let Emacs know a list of strings is safe | ||
25 | (defun +ispell-safe-local-p (list) | ||
26 | (and (listp list) | ||
27 | (seq-every-p #'stringp list))) | ||
28 | |||
29 | ;; Can I instruct ispell to insert LocalWords in a different file? | ||
30 | ;; https://emacs.stackexchange.com/q/31396/2264 | ||
31 | |||
32 | ;; How can I move all my file-local LocalWords to .dir-locals.el? | ||
33 | ;; https://emacs.stackexchange.com/q/31419 | ||
34 | |||
35 | ;; Adapted from ispell.el:ispell-buffer-local-words | ||
36 | (defun +ispell-buffer-local-words-list () | ||
37 | (let (words) | ||
38 | (or ispell-buffer-local-name | ||
39 | (setf ispell-buffer-local-name (buffer-name))) | ||
40 | (save-excursion | ||
41 | (goto-char (point-min)) | ||
42 | (while (search-forward ispell-words-keyword nil t) | ||
43 | (let ((end (point-at-eol)) | ||
44 | (ispell-casechars (ispell-get-casechars)) | ||
45 | string) | ||
46 | (while (re-search-forward " *\\([^ ]+\\)" end t) | ||
47 | (setf string (match-string-no-properties 1)) | ||
48 | (if (and (< 1 (length string)) | ||
49 | (equal 0 (string-match ispell-casechars string))) | ||
50 | (push string words)))))) | ||
51 | words)) | ||
52 | |||
53 | ;;;###autoload | ||
54 | (defun +ispell-move-buffer-words-to-dir-locals (&optional arg) | ||
55 | "Move the current buffer-local words to .dir-locals.el. | ||
56 | This function prompts the user to save .dir-locals.el, unless | ||
57 | prefix ARG is non-nil; then it just saves them." | ||
58 | (interactive "P") | ||
59 | (unless (buffer-file-name) | ||
60 | (user-error "Buffer not attached to file")) | ||
61 | (hack-dir-local-variables) | ||
62 | (let ((print-level nil) | ||
63 | (print-length nil)) | ||
64 | (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA | ||
65 | ; where this came from | ||
66 | (+ispell-append-removing-duplicates | ||
67 | :test #'string= | ||
68 | ispell-buffer-session-localwords | ||
69 | (alist-get 'ispell-buffer-session-localwords | ||
70 | dir-local-variables-alist) | ||
71 | (alist-get 'ispell-buffer-session-localwords | ||
72 | file-local-variables-alist) | ||
73 | (+ispell-buffer-local-words-list))))) | ||
74 | (save-excursion | ||
75 | (add-dir-local-variable | ||
76 | major-mode | ||
77 | 'ispell-buffer-session-localwords | ||
78 | (setf ispell-buffer-session-localwords | ||
79 | new-words)) | ||
80 | (when (or arg | ||
81 | (y-or-n-p "Save .dir-locals.el?")) | ||
82 | (save-buffer)) | ||
83 | (bury-buffer)) | ||
84 | (or ispell-buffer-local-name | ||
85 | (setf ispell-buffer-local-name (buffer-name))) | ||
86 | (save-excursion | ||
87 | (goto-char (point-min)) | ||
88 | (while (search-forward ispell-words-keyword nil t) | ||
89 | (delete-region (point-at-bol) (1+ (point-at-eol)))))))) | ||
90 | |||
91 | ;;;###autoload | ||
92 | (defun +ispell-move-buffer-words-to-dir-locals-hook () | ||
93 | "Convenience function for binding to a hook." | ||
94 | (+ispell-move-buffer-words-to-dir-locals t)) | ||
95 | |||
96 | (provide '+ispell) | ||
97 | ;;; +ispell.el ends here | ||
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 926a266..0000000 --- a/lisp/+link-hint.el +++ /dev/null | |||
@@ -1,144 +0,0 @@ | |||
1 | ;;; +link-hint.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'link-hint) | ||
7 | |||
8 | (defgroup +link-hint nil | ||
9 | "Extra customizations for `link-hint'." | ||
10 | :group 'link-hint) | ||
11 | |||
12 | (defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url | ||
13 | gnus-w3m-url | ||
14 | markdown-link | ||
15 | mu4e-attachment | ||
16 | mu4e-url | ||
17 | notmuch-hello | ||
18 | nov-link | ||
19 | org-link | ||
20 | shr-url | ||
21 | text-url | ||
22 | w3m-link | ||
23 | w3m-message-link) | ||
24 | "Link types to define `:open-secondary' for.") | ||
25 | |||
26 | (defvar +link-hint-map (make-sparse-keymap) | ||
27 | "Keymap for `link-hint' functionality.") | ||
28 | |||
29 | (cl-defmacro +link-hint-define-keyword (keyword handler docstring | ||
30 | &optional (types 'link-hint-types) | ||
31 | &rest rest | ||
32 | &key multiple &allow-other-keys) | ||
33 | "Set up a `link-hint' KEYWORD, with optional TYPES. | ||
34 | If TYPES is not present, use `link-hint-types'. | ||
35 | |||
36 | KEYWORD defines the link-hint type. It will be used to create a | ||
37 | function for opening links of the form \"link-hint-openKEYWORD\". | ||
38 | |||
39 | HANDLER is the function to open a link with. | ||
40 | |||
41 | DOCSTRING is the macro's documentation. | ||
42 | |||
43 | Keyword arguments are passed to `link-hint-define-type' prefixed | ||
44 | with the KEYWORD." | ||
45 | (declare (indent 2) | ||
46 | (doc-string 3)) | ||
47 | (let ((types (symbol-value types)) | ||
48 | (func-sym (intern (format "+link-hint-open%s" keyword))) | ||
49 | (mult-sym (intern (format "%s-multiple" keyword))) | ||
50 | (expr)) | ||
51 | ;; Define the type | ||
52 | (push `(dolist (type ',types) | ||
53 | (link-hint-define-type type | ||
54 | ,keyword ,handler | ||
55 | ,@(mapcar (lambda (el) | ||
56 | (if (eq el :multiple) | ||
57 | mult-sym | ||
58 | el)) | ||
59 | rest))) | ||
60 | expr) | ||
61 | ;; Define an opener | ||
62 | (push `(defun ,func-sym () | ||
63 | ,(format "%s\n\nDefined by `+link-hint-define'." docstring) | ||
64 | (interactive) | ||
65 | (avy-with link-hint-open-link | ||
66 | (link-hint--one ,keyword))) | ||
67 | expr) | ||
68 | ;; Handle `:multiple' | ||
69 | (when multiple | ||
70 | (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () | ||
71 | ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." | ||
72 | func-sym) | ||
73 | (avy-with link-hint-open-multiple-links | ||
74 | (link-hint--multiple ,keyword))) | ||
75 | expr) | ||
76 | (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () | ||
77 | ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." | ||
78 | func-sym) | ||
79 | (avy-with link-hint-open-all-links | ||
80 | (link-hint--all ,keyword))) | ||
81 | expr)) | ||
82 | ;; Return the built expression | ||
83 | `(progn ,@(nreverse expr)))) | ||
84 | |||
85 | (+link-hint-define-keyword :secondary browse-url-secondary-browser-function | ||
86 | "Open a link in the secondary browser." | ||
87 | +link-hint-open-secondary-types | ||
88 | :multiple t) | ||
89 | |||
90 | (defun +link-hint-open-secondary-setup (&optional types) | ||
91 | "Define the `:open-secondary' link-hint type for TYPES. | ||
92 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
93 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
94 | (link-hint-define-type type | ||
95 | :open-secondary browse-url-secondary-browser-function | ||
96 | :open-secondary-multiple t))) | ||
97 | |||
98 | (defun +link-hint-open-secondary () | ||
99 | "Open a link in the secondary browser." | ||
100 | (interactive) | ||
101 | (avy-with link-hint-open-link | ||
102 | (link-hint--one :open-secondary))) | ||
103 | |||
104 | (defun +link-hint-open-chrome-setup (&optional types) | ||
105 | "Define the `:open-chrome' link-hint type for TYPES. | ||
106 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
107 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
108 | (link-hint-define-type type | ||
109 | :open-chrome #'browse-url-chrome | ||
110 | :open-chrome-multiple t))) | ||
111 | |||
112 | (defun +link-hint-open-chrome () | ||
113 | "Open a link with chrome." | ||
114 | (interactive) | ||
115 | (avy-with link-hint-open-link | ||
116 | (link-hint--one :open-chrome))) | ||
117 | |||
118 | (defun +link-hint-open-link (prefix) | ||
119 | "Open a link. | ||
120 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
121 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
122 | (interactive "P") | ||
123 | (let ((current-prefix-arg nil)) | ||
124 | (avy-with link-hint-open-link | ||
125 | (link-hint--one (if prefix :open-secondary :open))))) | ||
126 | |||
127 | (defun +link-hint-open-multiple-links (prefix) | ||
128 | "Open multiple links. | ||
129 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
130 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
131 | (interactive "P") | ||
132 | (avy-with link-hint-open-multiple-links | ||
133 | (link-hint--one (if prefix :open-secondary :open)))) | ||
134 | |||
135 | (defun +link-hint-open-all-links (prefix) | ||
136 | "Open all visible links. | ||
137 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
138 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
139 | (interactive "P") | ||
140 | (avy-with link-hint-open-all-links | ||
141 | (link-hint--one (if prefix :open-secondary :open)))) | ||
142 | |||
143 | (provide '+link-hint) | ||
144 | ;;; +link-hint.el ends here | ||
diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index 22450f7..0000000 --- a/lisp/+lisp.el +++ /dev/null | |||
@@ -1,93 +0,0 @@ | |||
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. | ||
78 | If already inside (or before) a comment, uncomment instead. | ||
79 | With 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 deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
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 deleted file mode 100644 index 5df6e5b..0000000 --- a/lisp/+notmuch.el +++ /dev/null | |||
@@ -1,149 +0,0 @@ | |||
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. | ||
31 | Without PREFIX argument, go to the first one in | ||
32 | `notmuch-saved-searches'; with a PREFIX argument, prompt the user | ||
33 | for which saved search to go to; with a double PREFIX | ||
34 | argument (\\[universal-argument] \\[universal-argument]), prompt | ||
35 | for 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. | ||
81 | That is, apply the tag changes in `+notmuch-spam-tags' to it. If | ||
82 | an optional prefix HAM argument is given, the message will be | ||
83 | marked 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. | ||
92 | This adds the tags in `+notmuch-spam-tags' to the message. With | ||
93 | an optional HAM prefix argument, mark the messages as | ||
94 | not-spam (\"ham\"). | ||
95 | |||
96 | This 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 | (defun +notmuch-tree-beginning (&optional arg) | ||
105 | "Move point to beginning of message or tree, depending on ARG." | ||
106 | (interactive "P") | ||
107 | (cond | ||
108 | ((and (window-live-p notmuch-tree-message-window) | ||
109 | (not arg)) | ||
110 | (with-selected-window notmuch-tree-message-window | ||
111 | (beginning-of-buffer))) | ||
112 | (:else (beginning-of-buffer)))) | ||
113 | |||
114 | (defun +notmuch-tree-end (&optional arg) | ||
115 | "Move point to end of message or tree, depending on ARG." | ||
116 | (interactive "P") | ||
117 | (cond | ||
118 | ((and (window-live-p notmuch-tree-message-window) | ||
119 | (not arg)) | ||
120 | (with-selected-window notmuch-tree-message-window | ||
121 | (end-of-buffer))) | ||
122 | (:else (end-of-buffer)))) | ||
123 | |||
124 | (defun +notmuch-make-saved-search (name key search-type &rest queries) | ||
125 | "Wrapper to ease `notmuch-saved-searches' defining. | ||
126 | NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in | ||
127 | `notmuch-saved-searches', which see. QUERIES are all concatenated together with | ||
128 | AND. If QUERIES is prepended with more keyword arguments, those are added to | ||
129 | the saved search as well." | ||
130 | (declare (indent 3)) | ||
131 | (let (extra-keywords) | ||
132 | (while (keywordp (car queries)) | ||
133 | (push (cadr queries) extra-keywords) | ||
134 | (push (car queries) extra-keywords) | ||
135 | (setf queries (cddr queries))) | ||
136 | (add-to-list 'notmuch-saved-searches | ||
137 | (append | ||
138 | (list :name name | ||
139 | :key key | ||
140 | :search-type search-type | ||
141 | :query (apply #'+notmuch-query-concat queries)) | ||
142 | (reverse extra-keywords)) | ||
143 | :append | ||
144 | (lambda (a b) | ||
145 | (equal (plist-get a :name) | ||
146 | (plist-get b :name)))))) | ||
147 | |||
148 | (provide '+notmuch) | ||
149 | ;;; +notmuch.el ends here | ||
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null | |||
@@ -1,49 +0,0 @@ | |||
1 | ;;; +org-capture.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | ;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll | ||
7 | ;; take a minute. Just let the compiler know that this variable exists. | ||
8 | (defvar org-capture-templates nil) | ||
9 | |||
10 | ;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 | ||
11 | (defun +org-capture-template-define (description &rest args) | ||
12 | "Define a capture template. | ||
13 | Creates a list and adds it to `org-capture-templates', if it's | ||
14 | not already there. ARGS is a plist, which in addition to the | ||
15 | additional options `org-capture-templates' accepts (which see), | ||
16 | takes the following and puts them in the right spot: `:keys', | ||
17 | `:description', `:type', `:target', and `:template'." | ||
18 | (declare (indent 1)) | ||
19 | (let* ((keys (plist-get args :keys)) | ||
20 | (type (plist-get args :type)) | ||
21 | (target (plist-get args :target)) | ||
22 | (template (plist-get args :template)) | ||
23 | (template-value (append | ||
24 | (list description) | ||
25 | (when (or type target template) | ||
26 | (list (or type 'entry) target template)) | ||
27 | (cl-loop for i from 0 below (length args) by 2 | ||
28 | unless (member (nth i args) | ||
29 | '(:keys :description :type | ||
30 | :target :template)) | ||
31 | append (list (nth i args) | ||
32 | (plist-get args (nth i | ||
33 | args))))))) | ||
34 | ;; The only way I know how to do this properly (add a value to the end of | ||
35 | ;; the list, if it exists; otherwise update it) is to do this weird if-setf | ||
36 | ;; dance. | ||
37 | (if (seq-find (lambda (el) (equal (car el) keys)) | ||
38 | org-capture-templates) | ||
39 | (setf (alist-get keys org-capture-templates nil nil #'equal) | ||
40 | template-value) | ||
41 | (setf org-capture-templates | ||
42 | (append org-capture-templates | ||
43 | (list (cons keys template-value))))) | ||
44 | ;; Regardless of what we do, return the new value of | ||
45 | ;; `org-capture-templates'. | ||
46 | org-capture-templates)) | ||
47 | |||
48 | (provide '+org-capture) | ||
49 | ;;; +org-capture.el | ||
diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index a148bd8..0000000 --- a/lisp/+org.el +++ /dev/null | |||
@@ -1,309 +0,0 @@ | |||
1 | ;;; +org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'seq) | ||
7 | |||
8 | ;;; Org-return DWIM | ||
9 | ;; https://github.com/alphapapa/unpackaged.el, | ||
10 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
11 | |||
12 | (defun +org-element-descendant-of (type element) | ||
13 | "Return non-nil if ELEMENT is a descendant of TYPE. | ||
14 | TYPE should be an element type, like `item' or `paragraph'. | ||
15 | ELEMENT should be a list like that returned by `org-element-context'." | ||
16 | ;; MAYBE: Use `org-element-lineage'. | ||
17 | (when-let* ((parent (org-element-property :parent element))) | ||
18 | (or (eq type (car parent)) | ||
19 | (+org-element-descendant-of type parent)))) | ||
20 | |||
21 | (defun +org-return-dwim (&optional prefix) | ||
22 | "A helpful replacement for `org-return'. | ||
23 | With PREFIX, call `org-return'." | ||
24 | (interactive "P") | ||
25 | ;; Auto-fill if enabled | ||
26 | (when auto-fill-function | ||
27 | (dolist (func (ensure-list auto-fill-function)) | ||
28 | (funcall func))) | ||
29 | (cond | ||
30 | (prefix ; Handle prefix | ||
31 | (pcase prefix | ||
32 | ('(4) (newline)) | ||
33 | ('(16) (newline 2)) | ||
34 | (_ (newline prefix)))) | ||
35 | ((and org-return-follows-link ; Open link | ||
36 | (eq 'link (car (org-element-context)))) | ||
37 | (org-open-at-point-global)) | ||
38 | ((org-at-heading-p) ; Open a line after a heading | ||
39 | (let ((heading-start (org-entry-beginning-position))) | ||
40 | (goto-char (org-entry-end-position)) | ||
41 | (cond ((and (org-at-heading-p) | ||
42 | (= heading-start (org-entry-beginning-position))) | ||
43 | ;; Entry ends on its heading, so add 2 newlines | ||
44 | (end-of-line) | ||
45 | (newline 2)) | ||
46 | (t | ||
47 | ;; Entry ends after its heading, so back up | ||
48 | (forward-line -1) | ||
49 | (end-of-line) | ||
50 | (when (org-at-heading-p) | ||
51 | (forward-line) | ||
52 | (newline) | ||
53 | (forward-line -1)) | ||
54 | (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) | ||
55 | nil)) | ||
56 | (newline)) | ||
57 | (forward-line -1))))) | ||
58 | ((org-at-item-checkbox-p) ; Insert a new checkbox item | ||
59 | (end-of-line) | ||
60 | (org-insert-todo-heading nil)) | ||
61 | ((org-in-item-p) ; Insert a new list item | ||
62 | (let* ((context (org-element-context)) | ||
63 | (first-item-p (eq 'plain-list (car context))) | ||
64 | (itemp (eq 'item (car context))) | ||
65 | (emptyp (or | ||
66 | ;; This (regular) list item is empty | ||
67 | (eq (org-element-property :contents-begin context) | ||
68 | (org-element-property :contents-end context)) | ||
69 | ;; This (definition) list item is empty | ||
70 | (looking-at " *::"))) | ||
71 | (item-child-p (+org-element-descendant-of 'item context))) | ||
72 | (cond ((and itemp emptyp) | ||
73 | (delete-region (line-beginning-position) (line-end-position)) | ||
74 | (newline)) | ||
75 | ((or first-item-p | ||
76 | (and itemp (not emptyp)) | ||
77 | item-child-p) | ||
78 | (org-end-of-item) | ||
79 | (org-insert-item)) | ||
80 | (t | ||
81 | (delete-region (line-beginning-position) (line-end-position)) | ||
82 | (newline))))) | ||
83 | ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with | ||
84 | (org-inlinetask-in-task-p)) ; inline tasks | ||
85 | (org-return)) | ||
86 | ((org-at-table-p) ; Insert a new org-table row | ||
87 | (cond ((save-excursion | ||
88 | (beginning-of-line) | ||
89 | (cl-loop with end = (line-end-position) | ||
90 | for cell = (org-element-table-cell-parser) | ||
91 | always (equal (org-element-property :contents-begin cell) | ||
92 | (org-element-property :contents-end cell)) | ||
93 | while (re-search-forward "|" end t))) | ||
94 | ;; Empty row: end the table | ||
95 | (delete-region (line-beginning-position) (line-end-position)) | ||
96 | (org-return)) | ||
97 | (t | ||
98 | ;; Non-empty row | ||
99 | (org-return)))) | ||
100 | (t ; Otherwise---just call `org-return'. | ||
101 | (org-return)))) | ||
102 | |||
103 | (defun +org-table-copy-down|+org-return-dwim (&optional n) | ||
104 | "Call `org-table-copy-down' or `+org-return' depending on context." | ||
105 | (interactive "P") | ||
106 | (if (org-table-check-inside-data-field 'noerror) | ||
107 | (org-table-copy-down (or n 1)) | ||
108 | (+org-return-dwim n))) | ||
109 | |||
110 | |||
111 | ;;; A ... different ... `org-open-at-point-dwim' | ||
112 | ;; I honestly don't remember what the difference is between this and the | ||
113 | ;; O.G. one is.. hopefully this one fixes annoying stupid problems. | ||
114 | |||
115 | (defun +org-open-at-point-dwim (&optional arg) | ||
116 | "Open thing at point, or if there isn't something, list things." | ||
117 | (interactive "P") | ||
118 | (save-excursion | ||
119 | (let* ((this-char-type (org-element-type (org-element-context))) | ||
120 | (prev-char-type (ignore-errors | ||
121 | (save-excursion | ||
122 | (backward-char) | ||
123 | (org-element-type (org-element-context))))) | ||
124 | (types '(citation citation-reference clock comment comment-block | ||
125 | footnote-definition footnote-reference headline | ||
126 | inline-src-block inlinetask keyword link | ||
127 | node-property planning src-block timestamp)) | ||
128 | (type this-char-type)) | ||
129 | (when (and (memq this-char-type types) (memq prev-char-type types)) | ||
130 | (backward-char) | ||
131 | (setq type prev-char-type)) ; what the fuckckckckck | ||
132 | ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, | ||
133 | ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since | ||
134 | ;; I really just want to open the list of URLs /most of the time/, I'm | ||
135 | ;; fixing it like this instead. | ||
136 | (unless (and (memq type types) | ||
137 | (ignore-errors (org-open-at-point arg) | ||
138 | t)) | ||
139 | (while (not | ||
140 | (progn | ||
141 | (org-back-to-heading) | ||
142 | (car (org-offer-links-in-entry (current-buffer) (point) 1)))) | ||
143 | (org-up-heading-all 1)) | ||
144 | (org-open-at-point arg))))) | ||
145 | |||
146 | ;;; Faces | ||
147 | ;; see `org-emphasis-alist' | ||
148 | |||
149 | (defface org-bold '((t (:weight bold))) | ||
150 | "Bold face in `org-mode' documents.") | ||
151 | |||
152 | (defface org-italic '((t (:slant italic))) | ||
153 | "Italic face in `org-mode' documents.") | ||
154 | |||
155 | (defface org-underline '((t (:underline t))) | ||
156 | "Underline face in `org-mode' documents.") | ||
157 | |||
158 | (defface org-strikethrough '((t (:strike-through t))) | ||
159 | "Strike-through face for `org-mode' documents.") | ||
160 | |||
161 | ;;; Unsmartify | ||
162 | |||
163 | (defun +org-unsmartify () | ||
164 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
165 | (interactive) | ||
166 | (save-excursion | ||
167 | (goto-char (point-min)) | ||
168 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
169 | (let ((replace (pcase (match-string 0) | ||
170 | ((or "“" "”") "\"") | ||
171 | ((or "‘" "’") "'") | ||
172 | ("–" "--") | ||
173 | ("—" "---")))) | ||
174 | (replace-match replace nil nil))))) | ||
175 | |||
176 | ;;; Copy org trees as HTML | ||
177 | ;; Thanks to Oleh Krehel: | ||
178 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard | ||
179 | |||
180 | (defun +org-export-clip-to-html | ||
181 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
182 | "Export region to HTML, and copy it to the clipboard. | ||
183 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
184 | and POST-PROCESS are passed to `org-export-to-file'." | ||
185 | (interactive) ; XXX: hould this be interactive? | ||
186 | (message "Exporting Org to HTML...") | ||
187 | (let ((org-tmp-file "/tmp/org.html")) | ||
188 | (org-export-to-file 'html org-tmp-file | ||
189 | async subtreep visible-only body-only ext-plist post-process) | ||
190 | ;; XXX: figure out which clipboard to use, or use something in Emacs | ||
191 | (start-process "xclip" "*xclip*" | ||
192 | "xclip" "-verbose" | ||
193 | "-i" org-tmp-file | ||
194 | "-t" "text/html" | ||
195 | "-selection" "clipboard")) | ||
196 | (message "Exporting Org to HTML...done.")) | ||
197 | |||
198 | ;; Specialized functions | ||
199 | (defun +org-export-clip-subtree-to-html () | ||
200 | "Export current subtree to HTML." | ||
201 | (interactive) | ||
202 | (+org-export-clip-to-html nil :subtree)) | ||
203 | |||
204 | ;;; Hide drawers on save, except the currently-expanded one | ||
205 | |||
206 | (defun +org-hide-drawers-except-point () | ||
207 | "Hide all drawers except for the one point is in." | ||
208 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
209 | (let ((pt (point)) | ||
210 | (begin (point-min)) | ||
211 | (end (point-max))) | ||
212 | (save-excursion | ||
213 | (goto-char begin) | ||
214 | (while (and (< (point) end) | ||
215 | (re-search-forward org-drawer-regexp end t)) | ||
216 | (if (org-fold-folded-p nil 'drawer) | ||
217 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
218 | (let* ((drawer (org-element-at-point)) | ||
219 | (type (org-element-type drawer)) | ||
220 | (el-begin (org-element-property :begin drawer)) | ||
221 | (el-end (org-element-property :end drawer))) | ||
222 | (when (memq type '(drawer property-drawer)) | ||
223 | (org-fold-hide-drawer-toggle | ||
224 | (if (< el-begin pt el-end) 'off 'on) | ||
225 | nil drawer) | ||
226 | (goto-char el-end)))))))) | ||
227 | |||
228 | ;;; Define `ol' link types | ||
229 | |||
230 | (defmacro +org-link-define-type (type args &rest body) | ||
231 | "Define an org link TYPE. | ||
232 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
233 | as its arguments and BODY as its body. BODY can be blank, in | ||
234 | which case the user will be messaged (This is a good do-nothing | ||
235 | effect for exporting link types)." | ||
236 | (declare (indent 2) | ||
237 | (doc-string 3) | ||
238 | (debug (sexp sexp def-body))) | ||
239 | (let ((fn (intern (format "+org-link-%s-open" type))) | ||
240 | (body (or body `((message ,(format "%S: %%S" type) | ||
241 | ,(car args))))) | ||
242 | (type-string (format "%S" type))) | ||
243 | `(prog1 | ||
244 | (defun ,fn ,args ,@body) | ||
245 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
246 | |||
247 | ;;; Skip some files in `org-agenda' | ||
248 | |||
249 | (defcustom org-agenda-file-skip-regexp nil | ||
250 | "Files matching this regexp are removed from `org-agenda-files'." | ||
251 | :group 'org-agenda) | ||
252 | |||
253 | (defun org-agenda-files@skip-regexp (files) | ||
254 | "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." | ||
255 | (when org-agenda-file-skip-regexp | ||
256 | (setq files | ||
257 | (seq-remove (lambda (file) | ||
258 | (string-match-p | ||
259 | org-agenda-file-skip-regexp file)) | ||
260 | files))) | ||
261 | files) | ||
262 | |||
263 | ;;; Prompt for stuff | ||
264 | |||
265 | (defun +org-prompt-for-property (property &optional clipboardp insert list) | ||
266 | "Prompt for PROPERTY and return a properly-formatted string. | ||
267 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
268 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
269 | |||
270 | If INSERT is non-nil, insert the property into the property | ||
271 | drawer of the current org tree. | ||
272 | |||
273 | If LIST is non-nil, return the result as a list instead of a string." | ||
274 | (let* ((kill (current-kill 0)) | ||
275 | (value (read-string (concat property ": ") | ||
276 | (when (and clipboardp | ||
277 | (or (eq clipboardp t) | ||
278 | (funcall clipboardp kill))) | ||
279 | kill)))) | ||
280 | (when insert | ||
281 | (org-set-property property value)) | ||
282 | (if list | ||
283 | (list property value) | ||
284 | (format ":%s: %s" property value)))) | ||
285 | |||
286 | (defun +org-prompt-tags (&optional prompt global) | ||
287 | (let* ((buffer (org-capture-get :buffer)) | ||
288 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | ||
289 | (org-last-tags-completion-table | ||
290 | (org-global-tags-completion-table | ||
291 | (if global (org-agenda-files) (list file)))) | ||
292 | (org-add-colon-after-tag-completion t) | ||
293 | (ins (mapconcat | ||
294 | #'identity | ||
295 | (let ((crm-separator "[ \t]*:[ \t]*")) | ||
296 | (completing-read-multiple | ||
297 | (or prompt "Tags: ") | ||
298 | org-last-tags-completion-table nil nil nil | ||
299 | 'org-tags-history)) | ||
300 | ":"))) | ||
301 | (when (org-string-nw-p ins) | ||
302 | (prog1 (concat | ||
303 | (unless (eq (char-before) ?:) ":") | ||
304 | ins | ||
305 | (unless (eq (char-after) ?:) ":")) | ||
306 | (when (org-at-heading-p) (org-align-tags)))))) | ||
307 | |||
308 | (provide '+org) | ||
309 | ;;; +org.el ends here | ||
diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index ab176b8..0000000 --- a/lisp/+paredit.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
1 | ;;; +paredit.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Fixing unquote-splicing behaviour with Paredit | ||
4 | ;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/ | ||
5 | |||
6 | (require 'paredit) | ||
7 | (require 'seq) | ||
8 | |||
9 | (defcustom +paredit-no-space-prefixes '(",@") | ||
10 | "Prefix strings to not insert a space after in `paredit'." | ||
11 | :group 'paredit | ||
12 | :type '(repeat string)) | ||
13 | |||
14 | (defun +paredit-space-for-delimiter (endp delimiter) | ||
15 | (let ((point (point))) | ||
16 | (or endp | ||
17 | (seq-every-p | ||
18 | (lambda (prefix) | ||
19 | (and (> point (length prefix)) | ||
20 | (let ((start (- point (length prefix))) | ||
21 | (end point)) | ||
22 | (not (string= (buffer-substring start end) prefix))))) | ||
23 | +paredit-no-space-prefixes)))) | ||
24 | |||
25 | (provide '+paredit) | ||
26 | ;;; +paredit.el ends here | ||
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 6defda7..0000000 --- a/lisp/+titlecase.el +++ /dev/null | |||
@@ -1,34 +0,0 @@ | |||
1 | ;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'titlecase) | ||
8 | |||
9 | (defun +titlecase-sentence-style-dwim (&optional arg) | ||
10 | "Titlecase a sentence. | ||
11 | With prefix ARG, toggle the value of | ||
12 | `titlecase-downcase-sentences' before sentence-casing." | ||
13 | (interactive "P") | ||
14 | (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) | ||
15 | titlecase-downcase-sentences))) | ||
16 | (titlecase-dwim 'sentence))) | ||
17 | |||
18 | (defun +titlecase-org-headings () | ||
19 | (interactive) | ||
20 | (save-excursion | ||
21 | (goto-char (point-min)) | ||
22 | ;; See also `org-map-tree'. I'm not using that function because I want to | ||
23 | ;; skip the first headline. A better solution would be to patch | ||
24 | ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). | ||
25 | (let ((level (funcall outline-level)) | ||
26 | (org-special-ctrl-a/e t)) | ||
27 | (while (and (progn (outline-next-heading) | ||
28 | (> (funcall outline-level) level)) | ||
29 | (not (eobp))) | ||
30 | (titlecase-region (org-beginning-of-line) | ||
31 | (org-end-of-line)))))) | ||
32 | |||
33 | (provide '+titlecase) | ||
34 | ;;; +titlecase.el ends here | ||
diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el deleted file mode 100644 index e4c9e14..0000000 --- a/lisp/acdw-defaults.el +++ /dev/null | |||
@@ -1,295 +0,0 @@ | |||
1 | ;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- | ||
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | |||
4 | ;;; Commentary: | ||
5 | |||
6 | ;; I find myself copy-pasting a lot of "boilerplate" type code when | ||
7 | ;; bankrupting my Emacs config and starting afresh. Instead of doing | ||
8 | ;; that, I'm putting it here, where it'll be easier to include in my | ||
9 | ;; config. | ||
10 | |||
11 | ;; Of course, some might say I could just ... stop bankrupting my | ||
12 | ;; Emacs. But like, why would I want to? | ||
13 | |||
14 | ;;; Code: | ||
15 | |||
16 | (require 'seq) | ||
17 | |||
18 | (defvar default-ring-max 256 | ||
19 | "Default maximum for ring variables.") | ||
20 | |||
21 | (unless (boundp 'use-short-answers) | ||
22 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
23 | |||
24 | (setc async-shell-command-buffer 'new-buffer | ||
25 | async-shell-command-display-buffer nil | ||
26 | auto-hscroll-mode t | ||
27 | auto-window-vscroll nil | ||
28 | cursor-in-non-selected-windows 'hollow | ||
29 | cursor-type 'bar | ||
30 | echo-keystrokes 0.01 | ||
31 | fast-but-imprecise-scrolling t | ||
32 | fill-column 80 | ||
33 | global-mark-ring-max default-ring-max | ||
34 | hscroll-margin 1 | ||
35 | hscroll-step 1 | ||
36 | inhibit-startup-screen t | ||
37 | initial-buffer-choice t | ||
38 | kill-do-not-save-duplicates t | ||
39 | kill-read-only-ok t | ||
40 | kill-ring-max default-ring-max | ||
41 | kmacro-ring-max default-ring-max | ||
42 | mark-ring-max default-ring-max | ||
43 | read-answer-short t | ||
44 | read-process-output-max (* 10 1024 1024) | ||
45 | ring-bell-function #'ignore | ||
46 | save-interprogram-paste-before-kill t | ||
47 | scroll-conservatively 25 | ||
48 | scroll-margin 0 | ||
49 | scroll-preserve-screen-position 1 | ||
50 | scroll-step 1 | ||
51 | sentence-end-double-space t | ||
52 | set-mark-command-repeat-pop t | ||
53 | tab-width 8 | ||
54 | undo-limit (* 10 1024 1024) | ||
55 | use-dialog-box nil | ||
56 | use-file-dialog nil | ||
57 | use-short-answers t | ||
58 | window-resize-pixelwise t | ||
59 | yank-pop-change-selection t) | ||
60 | |||
61 | ;;; Encodings | ||
62 | |||
63 | ;; Allegedly, this is the only one you need... | ||
64 | (set-language-environment "UTF-8") | ||
65 | ;; But I still set all of these, for fun. | ||
66 | (setq-default buffer-file-coding-system 'utf-8-unix | ||
67 | coding-system-for-read 'utf-8-unix | ||
68 | coding-system-for-write 'utf-8-unix | ||
69 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
70 | locale-coding-system 'utf-8-unix | ||
71 | x-select-request-type '(UTF8_STRING | ||
72 | COMPOUND_TEXT | ||
73 | TEXT | ||
74 | STRING)) | ||
75 | |||
76 | (set-charset-priority 'unicode) | ||
77 | (prefer-coding-system 'utf-8-unix) | ||
78 | (set-default-coding-systems 'utf-8-unix) | ||
79 | (set-terminal-coding-system 'utf-8-unix) | ||
80 | (set-keyboard-coding-system 'utf-8-unix) | ||
81 | |||
82 | (pcase system-type | ||
83 | ((or 'ms-dos 'windows-nt) | ||
84 | (set-clipboard-coding-system 'utf-16-le) | ||
85 | (set-selection-coding-system 'utf-16-le)) | ||
86 | (_ | ||
87 | (set-selection-coding-system 'utf-8) | ||
88 | (set-clipboard-coding-system 'utf-8))) | ||
89 | |||
90 | ;;; Modes | ||
91 | |||
92 | (dolist (enable-mode '(;; Enable these modes on startup | ||
93 | delete-selection-mode | ||
94 | global-so-long-mode | ||
95 | )) | ||
96 | (funcall enable-mode +1)) | ||
97 | |||
98 | (dolist (disable-mode '(;; Disable these modes on startup | ||
99 | horizontal-scroll-bar-mode | ||
100 | menu-bar-mode | ||
101 | scroll-bar-mode | ||
102 | tool-bar-mode | ||
103 | tooltip-mode | ||
104 | )) | ||
105 | (funcall disable-mode -1)) | ||
106 | |||
107 | (deftheme use-package) | ||
108 | (enable-theme 'use-package) | ||
109 | |||
110 | ;;; Internal packages | ||
111 | |||
112 | (when (require 'abbrev nil t) | ||
113 | (custom-theme-set-variables 'use-package | ||
114 | '(abbrev-file-name (sync/ "abbrev.el")) | ||
115 | '(save-abbrevs 'silently))) | ||
116 | |||
117 | (when (require 'autorevert nil t) | ||
118 | (custom-theme-set-variables 'use-package | ||
119 | '(auto-revert-verbose nil) | ||
120 | '(global-auto-revert-non-file-buffers t)) | ||
121 | (global-auto-revert-mode +1)) | ||
122 | |||
123 | (when (require 'comp nil t) | ||
124 | (custom-theme-set-variables 'use-package | ||
125 | '(native-comp-async-report-warnings-errors 'silent) | ||
126 | '(native-comp-deferred-compilation t))) | ||
127 | |||
128 | (when (require 'custom nil t) | ||
129 | (custom-theme-set-variables 'use-package | ||
130 | '(custom-file (etc/ "custom.el")))) | ||
131 | |||
132 | (when (require 'ediff nil t) | ||
133 | (custom-theme-set-variables 'use-package | ||
134 | '(ediff-window-setup-function #'ediff-setup-windows-plain))) | ||
135 | |||
136 | (when (require 'eldoc nil t) | ||
137 | (custom-theme-set-variables 'use-package | ||
138 | '(eldoc-echo-area-use-multiline-p nil) | ||
139 | '(eldoc-idle-delay 0.1))) | ||
140 | |||
141 | (when (require 'executable nil t) | ||
142 | (custom-theme-set-variables 'use-package | ||
143 | '(executable-prefix-env t))) | ||
144 | |||
145 | (when (require 'files nil t) | ||
146 | (custom-theme-set-variables 'use-package | ||
147 | '(auto-save-default nil) | ||
148 | '(auto-save-interval 1) | ||
149 | '(auto-save-no-message t) | ||
150 | '(auto-save-timeout 1) | ||
151 | '(auto-save-visited-interval 1) | ||
152 | '(backup-by-copying t) | ||
153 | '(create-lockfiles nil) | ||
154 | '(delete-old-versions t) | ||
155 | '(find-file-visit-truename t) | ||
156 | '(kept-new-versions 8) | ||
157 | '(kept-old-versions 8) | ||
158 | '(mode-require-final-newline t) | ||
159 | '(version-control t) | ||
160 | '(view-read-only t)) | ||
161 | (dolist (h/f | ||
162 | '((after-save-hook . executable-make-buffer-file-executable-if-script-p) | ||
163 | (find-file-not-found-functions . create-missing-directories) | ||
164 | (find-file-hook . +vc-off@remote))) | ||
165 | (add-hook (car h/f) (cdr h/f))) | ||
166 | (auto-save-visited-mode)) | ||
167 | |||
168 | (when (require 'frame nil t) | ||
169 | (custom-theme-set-variables 'use-package | ||
170 | '(blink-cursor-blinks 1) | ||
171 | '(blink-cursor-interval 0.25) | ||
172 | '(blink-cursor-delay 0.25)) | ||
173 | (blink-cursor-mode)) | ||
174 | |||
175 | (when (require 'goto-addr nil t) | ||
176 | (if (fboundp 'global-goto-address-mode) | ||
177 | (global-goto-address-mode +1) | ||
178 | (add-hook 'after-change-major-mode-hook 'goto-address-mode))) | ||
179 | |||
180 | (when (require 'ibuffer nil t) | ||
181 | (global-set-key (kbd "C-x C-b") #'ibuffer) | ||
182 | (add-hook 'ibuffer-mode-hook #'hl-line-mode)) | ||
183 | |||
184 | (when (require 'image nil t) | ||
185 | (custom-theme-set-variables 'use-package | ||
186 | '(image-use-external-converter | ||
187 | (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) | ||
188 | |||
189 | (when (require 'imenu nil t) | ||
190 | (custom-theme-set-variables 'use-package | ||
191 | '(imenu-auto-rescan t))) | ||
192 | |||
193 | (when (require 'isearch nil t) | ||
194 | (custom-theme-set-variables 'use-package | ||
195 | '(regexp-search-ring-max default-ring-max) | ||
196 | '(search-ring-max default-ring-max))) | ||
197 | |||
198 | (when (require 'minibuffer nil t) | ||
199 | (custom-theme-set-variables 'use-package | ||
200 | '(completion-category-defaults nil) | ||
201 | '(completion-category-overrides '((file (styles partial-completion)))) | ||
202 | '(completion-ignore-case t) | ||
203 | '(completion-styles '(substring partial-completion)) | ||
204 | '(enable-recursive-minibuffers t) | ||
205 | '(file-name-shadow-properties '(invisible t intangible t)) | ||
206 | '(minibuffer-eldef-shorten-default t) | ||
207 | '(minibuffer-prompt-properties '( read-only t | ||
208 | cursor-intangible t | ||
209 | face minibuffer-prompt)) | ||
210 | '(read-buffer-completion-ignore-case t)) | ||
211 | (file-name-shadow-mode) | ||
212 | (minibuffer-electric-default-mode)) | ||
213 | |||
214 | (when (require 'mouse nil t) | ||
215 | (custom-theme-set-variables 'use-package | ||
216 | '(mouse-drag-copy-region t) | ||
217 | '(mouse-wheel-progressive-speed nil) | ||
218 | '(mouse-yank-at-point t))) | ||
219 | |||
220 | (when (require 'paren nil t) | ||
221 | (custom-theme-set-variables 'use-package | ||
222 | '(show-paren-delay 0.01) | ||
223 | '(show-paren-style 'parenthesis) | ||
224 | '(show-paren-when-point-in-periphery t) | ||
225 | '(show-paren-when-point-inside-paren t)) | ||
226 | (show-paren-mode) | ||
227 | (electric-pair-mode)) | ||
228 | |||
229 | (when (require 'recentf nil t) | ||
230 | (custom-theme-set-variables 'use-package | ||
231 | '(recentf-save-file (var/ "recentf.el")) | ||
232 | '(recentf-max-menu-items default-ring-max) | ||
233 | '(recentf-max-saved-items nil) | ||
234 | '(recentf-auto-cleanup 'mode)) | ||
235 | (add-to-list 'recentf-exclude etc/) | ||
236 | (add-to-list 'recentf-exclude var/) | ||
237 | (add-to-list 'recentf-exclude cache/) | ||
238 | (add-to-list 'recentf-exclude "-autoloads.el\\'") | ||
239 | (recentf-mode +1)) | ||
240 | |||
241 | (when (require 'savehist nil t) | ||
242 | (custom-theme-set-variables 'use-package | ||
243 | '(history-length 1024) | ||
244 | '(history-delete-duplicates t) | ||
245 | '(savehist-file (var/ "savehist.el")) | ||
246 | '(savehist-save-minibuffer-history t) | ||
247 | '(savehist-autosave-interval 30) | ||
248 | ;; Other variables --- don't truncate any of these. | ||
249 | ;; `add-to-history' uses the values of these variables unless | ||
250 | ;; they're nil, in which case it falls back to `history-length'. | ||
251 | '(kill-ring-max default-ring-max) | ||
252 | '(mark-ring-max default-ring-max) | ||
253 | '(global-mark-ring-max default-ring-max) | ||
254 | '(regexp-search-ring-max default-ring-max) | ||
255 | '(search-ring-max default-ring-max) | ||
256 | '(kmacro-ring-max default-ring-max) | ||
257 | '(eww-history-limit default-ring-max)) | ||
258 | (dolist (var '(global-mark-ring | ||
259 | mark-ring | ||
260 | kill-ring | ||
261 | kmacro-ring | ||
262 | regexp-search-ring | ||
263 | search-ring)) | ||
264 | (add-to-list 'savehist-additional-variables var)) | ||
265 | (savehist-mode +1)) | ||
266 | |||
267 | (when (require 'saveplace nil t) | ||
268 | (custom-theme-set-variables 'use-package | ||
269 | '(save-place-file (var/ "places.el")) | ||
270 | '(save-place-forget-unreadable-files (eq system-type 'gnu/linux))) | ||
271 | (save-place-mode 1)) | ||
272 | |||
273 | (when (require 'uniquify nil t) | ||
274 | (custom-theme-set-variables 'use-package | ||
275 | '(uniquify-after-kill-buffer-p t) | ||
276 | '(uniquify-buffer-name-style 'forward) | ||
277 | '(uniquify-ignore-buffers-re "^\\*") | ||
278 | '(uniquify-separator path-separator))) | ||
279 | |||
280 | (when (require 'vc nil t) | ||
281 | (custom-theme-set-variables 'use-package | ||
282 | '(vc-follow-symlinks t) | ||
283 | '(vc-make-backup-files t))) | ||
284 | |||
285 | (when (require 'window nil t) | ||
286 | (custom-theme-set-variables 'use-package | ||
287 | '(recenter-positions '(top 2 middle bottom)))) | ||
288 | |||
289 | ;;; New features | ||
290 | |||
291 | (when (fboundp 'pixel-scroll-precision-mode) | ||
292 | (pixel-scroll-precision-mode)) | ||
293 | |||
294 | (provide 'acdw-defaults) | ||
295 | ;;; acdw-defaults.el ends here | ||
diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el deleted file mode 100644 index ed41a61..0000000 --- a/lisp/acdw-funs.el +++ /dev/null | |||
@@ -1,262 +0,0 @@ | |||
1 | ;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*- | ||
2 | |||
3 | |||
4 | ;;; Cribs from CRUX --- Advice | ||
5 | ;; https://github.com/bbatsov/crux | ||
6 | |||
7 | ;; All of these should go `:before' the function they're advising | ||
8 | (defun advise-region-or-buffer (&rest _) | ||
9 | "`:before' advice to work on the active region or whole buffer. | ||
10 | See also `with-region-or-buffer'." | ||
11 | (interactive (if mark-active | ||
12 | (list (region-beginning) (region-end)) | ||
13 | (list (point-min) (point-max))))) | ||
14 | |||
15 | (defun advise-region-or-line (&rest _) | ||
16 | "`:before' advice to work on the active region or whole line. | ||
17 | See also `with-region-or-line'." | ||
18 | (interactive (if mark-active | ||
19 | (list (region-beginning) (region-end)) | ||
20 | (list (line-beginning-position) (line-end-position))))) | ||
21 | |||
22 | (defun advise-region-or-to-eol (&rest _) | ||
23 | "`:before' advice to work on the active region or to end of line. | ||
24 | See also `with-region-or-to-eol'." | ||
25 | (INTERACTIVE (if mark-active | ||
26 | (list (region-beginning) (region-end)) | ||
27 | (list (point) (line-end-position))))) | ||
28 | |||
29 | |||
30 | ;;; Other functions and whatnot | ||
31 | |||
32 | (defun delete2 (list &rest elems) | ||
33 | "Delete each element of ELEMS, and the next item, from LIST." | ||
34 | (let ((r nil)) | ||
35 | (while (consp list) | ||
36 | (if (member (car list) elems) | ||
37 | (setf list (cdr list)) | ||
38 | (setf r (cons (car list) r))) | ||
39 | (setf list (cdr list))) | ||
40 | (reverse r))) | ||
41 | |||
42 | (unless (fboundp 'ensure-list) | ||
43 | (defun ensure-list (object) | ||
44 | "Return OBJECT as a list. | ||
45 | If OBJECT is already a list, return OBJECT itself. If it's | ||
46 | not a list, return a one-element list containing OBJECT." | ||
47 | (if (listp object) | ||
48 | object | ||
49 | (list object)))) | ||
50 | |||
51 | (defun +require (&rest features) | ||
52 | "Require FEATURES, plus my extras. | ||
53 | Each feature can be an atom (the feature name) or a list of the form | ||
54 | (FEATURE &optional FILENAME NOERROR), which is passed directly to | ||
55 | `require'. My extras are in lisp/ and named +FEATURE, so this | ||
56 | function will `require' them too---but not error if they don't | ||
57 | exist." | ||
58 | (dolist (feat features) | ||
59 | (apply #'require (ensure-list feat)) | ||
60 | (require (intern (format "+%s" feat)) nil :noerror))) | ||
61 | |||
62 | ;;; Improvements to default functions | ||
63 | |||
64 | (defun +save-buffers-kill-terminal (arg) | ||
65 | "Delete the current frame, or quit Emacs. | ||
66 | This function is my customization of `save-buffers-kill-terminal'." | ||
67 | (interactive "P") | ||
68 | (cond (arg (delete-frame nil :force)) | ||
69 | ((= 1 (length (frame-list))) | ||
70 | (and (yes-or-no-p "Kill emacs? ") | ||
71 | (save-buffers-kill-emacs t))) | ||
72 | (:else (delete-frame)))) | ||
73 | |||
74 | (defun really-quit-emacs (arg) | ||
75 | "Really, actually quit Emacs." | ||
76 | (interactive "P") | ||
77 | (cond (arg (save-buffers-kill-emacs t)) | ||
78 | (:else (save-buffers-kill-terminal t)))) | ||
79 | |||
80 | (defun +cycle-spacing (&optional n) | ||
81 | ;; `cycle-spacing' is wildly different in 29.1 over 28. | ||
82 | "Negate N argument on `cycle-spacing'. | ||
83 | That is, with a positive N, deletes newlines as well, leaving -N | ||
84 | spaces. If N is negative, it will not delete newlines and leave | ||
85 | N spaces." | ||
86 | (interactive "*p") | ||
87 | (cycle-spacing (- n))) | ||
88 | |||
89 | (defun delete-window|bury-buffer () | ||
90 | "Delete the current window, or bury the current buffer. | ||
91 | If the current window is the only window, bury the buffer." | ||
92 | (interactive) | ||
93 | (condition-case e | ||
94 | (delete-window) | ||
95 | (t (bury-buffer)))) | ||
96 | |||
97 | (defun other-window|switch-buffer (arg) | ||
98 | "Call `other-window' or `switch-buffer' depending on windows. | ||
99 | When called with prefix ARG, unconditionally switch buffer." | ||
100 | (interactive "P") | ||
101 | (if (or arg (one-window-p)) | ||
102 | (switch-to-buffer (other-buffer) nil t) | ||
103 | (other-window 1))) | ||
104 | |||
105 | (defun open-paragraph (&optional arg) | ||
106 | "Open a paragraph after paragraph at point. | ||
107 | A paragraph is defined as continguous non-empty lines of text | ||
108 | surrounded by empty lines, so opening a paragraph means to make | ||
109 | three blank lines, then place the point on the second one. | ||
110 | |||
111 | Called with prefix ARG, open a paragraph before point." | ||
112 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
113 | (interactive "*P") | ||
114 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
115 | ;; that's weird with org, and I'm guessing other modes too. | ||
116 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
117 | (while (and (not (looking-at "^$")) | ||
118 | (= 0 (forward-line (if arg -1 +1))))) | ||
119 | (newline) | ||
120 | (when arg (newline) (forward-line -2)) | ||
121 | (delete-blank-lines) | ||
122 | (newline 2) | ||
123 | (previous-line)) | ||
124 | |||
125 | (defun +initial-buffer () | ||
126 | (if (equal (get-buffer "*Messages*") | ||
127 | (other-buffer)) | ||
128 | (get-buffer "*scratch*") | ||
129 | (other-buffer))) | ||
130 | |||
131 | (defun open-paragraph (&optional arg) | ||
132 | "Open a paragraph after paragraph at point. | ||
133 | A paragraph is defined as continguous non-empty lines of text | ||
134 | surrounded by empty lines, so opening a paragraph means to make | ||
135 | three blank lines, then place the point on the second one. | ||
136 | |||
137 | Called with prefix ARG, open a paragraph before point." | ||
138 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
139 | (interactive "*P") | ||
140 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
141 | ;; that's weird with org, and I'm guessing other modes too. | ||
142 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
143 | (while (and (not (looking-at "^$")) | ||
144 | (= 0 (forward-line (if arg -1 +1))))) | ||
145 | (newline) | ||
146 | (when arg (newline) (forward-line -2)) | ||
147 | (delete-blank-lines) | ||
148 | (newline 2) | ||
149 | (previous-line)) | ||
150 | |||
151 | (defun create-missing-directories () | ||
152 | "Automatically create missing directories when finding a file." | ||
153 | ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ | ||
154 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
155 | (unless (file-exists-p target-dir) | ||
156 | (make-directory target-dir t)))) | ||
157 | |||
158 | (defun +vc-off@remote () | ||
159 | (when (file-remote-p (buffer-file-name)) | ||
160 | (setq-local vc-handled-backends nil))) | ||
161 | |||
162 | (defun +auto-save-some-buffers (&rest _) | ||
163 | "Quietly run `save-some-buffers'." | ||
164 | (let ((inhibit-message t)) | ||
165 | (with-temp-message "" | ||
166 | (save-some-buffers t)))) | ||
167 | |||
168 | (defun comment-lines (str &optional comment-char) | ||
169 | "Comment each line of STR. | ||
170 | Returns the new, commented, string. | ||
171 | |||
172 | If COMMENT-CHAR is missing or nil, use `comment-start'." | ||
173 | (mapconcat (lambda (ln) | ||
174 | (concat (or comment-char comment-start) | ||
175 | ln)) | ||
176 | (string-lines str) | ||
177 | "\n")) | ||
178 | |||
179 | (defun clamp (value min max) | ||
180 | "Clamp VALUE between MIN and MAX." | ||
181 | (min max (max min value))) | ||
182 | |||
183 | (define-minor-mode truncate-lines-local-mode | ||
184 | "Truncate lines locally in a buffer." | ||
185 | :lighter " ..." | ||
186 | :group 'display | ||
187 | (setq-local truncate-lines truncate-lines-local-mode)) | ||
188 | |||
189 | (defun mapc-buffers (func &optional predicate) | ||
190 | "Map FUNC over buffers matching PREDICATE. | ||
191 | Both FUNC and PREDICATE will be executed with no arguments and in | ||
192 | the context of each buffer. | ||
193 | |||
194 | If PREDICATE is nil or not given, map FUNC over all buffers." | ||
195 | (cl-loop for buf being the buffers | ||
196 | do (with-current-buffer buf | ||
197 | (when (and predicate | ||
198 | (funcall predicate)) | ||
199 | (funcall func))))) | ||
200 | |||
201 | (defun mapc-buffers-modes (func &rest modes) | ||
202 | "Map FUNC over buffers derived from MODES. | ||
203 | FUNC will be executed with no arguments and in the context of | ||
204 | each buffer." | ||
205 | (mapc-buffers func | ||
206 | (lambda () | ||
207 | (apply #'derived-mode-p modes)))) | ||
208 | |||
209 | (defun ++concat (func strings) | ||
210 | "Concat STRINGS processed by FUNC. | ||
211 | Each of STRINGS can be a bare string or a list. Strings are | ||
212 | passed through as-is, but lists are passed to FUNC first as | ||
213 | arguments. Finally, all the resulting strings are `mapconcat'-ed | ||
214 | together. | ||
215 | |||
216 | As a special case, if `:separator' is the first of STRINGS, the | ||
217 | string following will be used as a separator. Otherwise, a | ||
218 | newline will be used." | ||
219 | (let (separator) | ||
220 | (when (eq (car strings) :separator) | ||
221 | (setq separator (cadr strings) | ||
222 | strings (cddr strings))) | ||
223 | (mapconcat (lambda (s) | ||
224 | (cond | ||
225 | ((listp s) (apply func s)) | ||
226 | ((stringp s) s) | ||
227 | (t (user-error "Bad argument: %S" s)))) | ||
228 | strings | ||
229 | (or separator "\n")))) | ||
230 | |||
231 | (defun nconcat (&rest strings) | ||
232 | "Concat STRINGS separated by SEPARATOR. | ||
233 | If `:separator' is the first of STRINGS, the next string will be used to | ||
234 | separate the rest of STRINGS." | ||
235 | (++concat #'concat strings)) | ||
236 | |||
237 | (defun format-concat (&rest strings) | ||
238 | "Concatenate formatted STRINGS. | ||
239 | Each of STRINGS can be a bare string or a list. Bare strings are passed as-is | ||
240 | to `mapconcat' for concatenation and separation. Lists, however, are passed to | ||
241 | `format' first. | ||
242 | |||
243 | If `:separator' is the first of STRINGS, the next string will be | ||
244 | used as a separator." | ||
245 | (++concat #'format strings)) | ||
246 | |||
247 | (defun choose-executable (&rest programs) | ||
248 | "Return the first of PROGRAMS that exists in the system's $PATH." | ||
249 | (seq-some #'executable-find programs)) | ||
250 | |||
251 | ;;; Update packages more better-er | ||
252 | |||
253 | (defun +package-update-all () | ||
254 | "Update all packages and vc packages." | ||
255 | (interactive) | ||
256 | (package-update-all) | ||
257 | ;; WTF! | ||
258 | (let ((package-archives-nil)) | ||
259 | (package-vc-update-all))) | ||
260 | |||
261 | (provide 'acdw-funs) | ||
262 | ;;; acdw-funs.el ends here | ||
diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el deleted file mode 100644 index e2258fa..0000000 --- a/lisp/acdw-macs.el +++ /dev/null | |||
@@ -1,293 +0,0 @@ | |||
1 | ;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- | ||
2 | |||
3 | (eval-when-compile | ||
4 | (require 'cl-lib) | ||
5 | (require 'tempo) | ||
6 | (declare-function derived-mode-abbrev-table-name "tempo")) | ||
7 | |||
8 | ;;; Extra functionality for `eval-after-load' | ||
9 | |||
10 | (defun eval-after-init (thunk) | ||
11 | "Evaluate THUNK after Emacs initiation, or now if already initialized." | ||
12 | (if after-init-time | ||
13 | (funcall thunk) | ||
14 | (add-hook 'after-init-hook thunk))) | ||
15 | |||
16 | (defmacro eval-after (prereqs &rest body) | ||
17 | "Evaluate body after PREREQS. | ||
18 | PREREQS can be a feature, a number, `t', or a list of those. | ||
19 | |||
20 | Features are used as arguments to `eval-after-load'. Numbers are | ||
21 | used as arguments to `run-with-idle-timer'. `t' will ensure BODY | ||
22 | runs after Emacs's init time. | ||
23 | |||
24 | When given a list of PREREQS, `eval-after' will nest each one | ||
25 | from left to right." | ||
26 | (declare (indent 1) (debug (form def-body))) | ||
27 | (setf prereqs (ensure-list prereqs)) | ||
28 | (if (null prereqs) | ||
29 | (macroexp-progn body) | ||
30 | (let* ((this (car prereqs)) | ||
31 | (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) | ||
32 | (cond | ||
33 | ((eq this :init) | ||
34 | (append '(eval-after-init) form)) | ||
35 | ((numberp this) | ||
36 | (append `(run-with-idle-timer ,this nil) form)) | ||
37 | ((symbolp this) | ||
38 | (append `(eval-after-load ',this) form)) | ||
39 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) | ||
40 | |||
41 | |||
42 | ;;; Easier customization of options | ||
43 | ;; At some point it might be nice to include more forms in the VAR slots, like | ||
44 | ;; `setup's `:option' macro. | ||
45 | |||
46 | (if (fboundp 'setopt) | ||
47 | ;; Emacs 29 introduces `setopt', which does basically the same thing as the | ||
48 | ;; macro below. Not exactly the same, of course---it uses `setopt--set' | ||
49 | ;; instead of `customize-set-variable'---but I'm going to trust the Emacs | ||
50 | ;; devs on this one. | ||
51 | (defalias 'setc 'setopt) | ||
52 | (defmacro setc (&rest args) | ||
53 | "Customize user options in a `setq'-like way." | ||
54 | (declare (debug setq)) | ||
55 | (unless (zerop (mod (length args) 2)) | ||
56 | (signal 'wrong-number-of-arguments `(evenp ,(length args)))) | ||
57 | (let (form defuns) | ||
58 | (while args | ||
59 | (let* ((var (pop args)) | ||
60 | (val (pop args))) | ||
61 | (when (memq (car-safe val) '(defun defmacro)) | ||
62 | (push val defuns) | ||
63 | (setq val `(function ,(cadr val)))) | ||
64 | (push `(customize-set-variable ',var ,val "Set by `setc'.") | ||
65 | form))) | ||
66 | `(progn ,@(append (nreverse defuns) (nreverse form)))))) | ||
67 | |||
68 | |||
69 | ;;; Extra def- forms | ||
70 | |||
71 | (defmacro defdir (name directory &optional docstring) | ||
72 | "Define a variable and a function NAME expanding to DIRECTORY. | ||
73 | DOCSTRING is applied to the variable; its default is DIRECTORY's | ||
74 | path." | ||
75 | (declare (indent 2) (doc-string 3)) | ||
76 | `(progn | ||
77 | (defvar ,name ,directory | ||
78 | ,(concat (or docstring (format "%s" directory)) "\n" | ||
79 | "Defined by `defdir'.")) | ||
80 | (defun ,name (file &optional mkdir) | ||
81 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | ||
82 | "If MKDIR is non-nil, parent directories are created.\n" | ||
83 | "Defined by `defdir'.") | ||
84 | (let ((file-name (expand-file-name | ||
85 | (convert-standard-filename file) ,name))) | ||
86 | (when mkdir | ||
87 | (make-directory (file-name-directory file-name) :parents)) | ||
88 | file-name)))) | ||
89 | |||
90 | (defmacro defkeys (maps &rest bindings) | ||
91 | "Define key BINDINGS in MAPS. | ||
92 | If MAPS is nil or t, bind to `current-global-map'. Otherwise, | ||
93 | bind each of BINDINGS to the map or list of maps provided. | ||
94 | |||
95 | BINDINGS is a `setq'-style list of pairs of keys and definitions. | ||
96 | The key part of each binding can be a string, in which case it's | ||
97 | passed to `kbd', or a vector or anything else `define-key' | ||
98 | accepts in the KEY position. The definition part, likewise, can | ||
99 | be any form `define-key' accepts in that position, with this | ||
100 | addition: if the form is a `defun' form, it will be defined | ||
101 | before any keys are bound." | ||
102 | (declare (indent 1)) | ||
103 | (unless (cl-evenp (length bindings)) | ||
104 | (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) | ||
105 | `(progn | ||
106 | ,@(cl-loop | ||
107 | for map in (ensure-list maps) | ||
108 | for first-map-p = t then nil | ||
109 | append | ||
110 | (cl-loop | ||
111 | for (keys def) on bindings by #'cddr | ||
112 | for defp = (memq (car-safe def) '(defmap defun defmacro)) | ||
113 | if (and defp first-map-p) collect def into defuns | ||
114 | append | ||
115 | (cl-loop | ||
116 | for key in (ensure-list keys) | ||
117 | collect (list 'define-key | ||
118 | (if (memq map '(t nil)) | ||
119 | '(current-global-map) | ||
120 | (or (car-safe map) map)) | ||
121 | (if (stringp key) | ||
122 | `(kbd ,key) | ||
123 | key) | ||
124 | (if defp | ||
125 | (cl-case (car def) | ||
126 | ((defmap) (cadr def)) | ||
127 | ((defun defmacro) `#',(cadr def)) | ||
128 | (otherwise (error "Bad def type: %S" | ||
129 | (car def)))) | ||
130 | def))) | ||
131 | into keydefs | ||
132 | finally return | ||
133 | (let ((all (append defuns keydefs))) | ||
134 | (if-let ((after (plist-get (cdr-safe map) :after))) | ||
135 | `((eval-after ,after | ||
136 | ,@all)) | ||
137 | all)))))) | ||
138 | |||
139 | (defmacro defmap (name docstring &rest bindings) | ||
140 | "Define a keymap named NAME, with BINDINGS." | ||
141 | (declare (indent 1) (doc-string 2)) | ||
142 | `(,(if (boundp name) 'setq 'defvar) ,name | ||
143 | ;;; ^ probably a terrible hack | ||
144 | (let ((map (make-sparse-keymap))) | ||
145 | (defkeys map ,@bindings) | ||
146 | map) | ||
147 | ,@(unless (boundp name) (list docstring)))) | ||
148 | |||
149 | (defmacro defhook (hooks &rest body) | ||
150 | "Define a function to hook into HOOKS. | ||
151 | NAME and ARGS are passed to the generated `defun' form. | ||
152 | Each hook in HOOKS can be the name of a hook or a list of the form | ||
153 | (HOOK DEPTH LOCAL), where each argument is the same as in | ||
154 | `add-hook'." | ||
155 | (declare (indent 1)) | ||
156 | (let* ((name (or (plist-get body :name) | ||
157 | (intern (format "%s/h" | ||
158 | (mapconcat | ||
159 | (lambda (h) | ||
160 | (string-remove-suffix | ||
161 | "-hook" | ||
162 | (if (and (consp h) | ||
163 | (caddr h)) | ||
164 | (format "%s:local" (car h)) | ||
165 | (format "%s" (or (car-safe h) | ||
166 | h))))) | ||
167 | (ensure-list hooks) | ||
168 | "|"))))) | ||
169 | (args (or (plist-get body :args) nil)) | ||
170 | (doc (or (plist-get body :doc) nil)) | ||
171 | (forms ; (DEFUN . FUNCS) | ||
172 | (cl-loop for form in (delete2 body :name :args :doc) | ||
173 | if (eq (car form) 'function) | ||
174 | collect form into funcs | ||
175 | else collect form into defuns | ||
176 | finally return (cons defuns funcs))) | ||
177 | (defun-forms (car forms)) | ||
178 | (func-forms (cdr forms))) | ||
179 | `(progn | ||
180 | ,@(when defun-forms | ||
181 | `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) | ||
182 | ,@(cl-loop for hook in (ensure-list hooks) | ||
183 | for h = (or (car-safe hook) hook) | ||
184 | for ha = (cdr-safe hook) | ||
185 | if defun-forms | ||
186 | collect `(add-hook ',h #',name ,@ha) | ||
187 | append | ||
188 | (cl-loop for fn in func-forms | ||
189 | collect `(add-hook ',h ,fn ,@ha)))))) | ||
190 | |||
191 | ;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) | ||
192 | (defmacro defautoload (file &rest fns) | ||
193 | "Autoload FNS from FILE. | ||
194 | Each of FNS can be an atom (function name) or a list of the | ||
195 | form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible | ||
196 | keys are `:doc' (docstring), `:interactive', and `:type', which are | ||
197 | used as the optional arguments to `autoload'. | ||
198 | |||
199 | You can also pass `:interactive' and `:type' as keyword arguments | ||
200 | just after FILE, and they'll serve as the default for the | ||
201 | autoloaded FNS." | ||
202 | (declare (indent 1)) | ||
203 | (let ((interactive (plist-get fns :interactive)) | ||
204 | (type (plist-get fns :type)) | ||
205 | (fns (delete2 fns :interactive :type))) | ||
206 | `(progn | ||
207 | ,@(cl-loop for fn in fns | ||
208 | for name = (or (car-safe fn) fn) | ||
209 | for args = (cdr-safe fn) | ||
210 | collect | ||
211 | `(autoload ',name ,(format "%s" file) | ||
212 | ,(plist-get args :doc) | ||
213 | ,(or (plist-get args :interactive) | ||
214 | interactive) | ||
215 | ,(or (plist-get args :type) | ||
216 | type)))))) | ||
217 | |||
218 | |||
219 | ;;; Miscellaneous | ||
220 | |||
221 | (defmacro with-message (message &rest body) | ||
222 | "Display MESSAGE then execute BODY. | ||
223 | If BODY executes without errors, display MESSAGE...done." | ||
224 | (declare (indent 1)) | ||
225 | (let ((msym (gensym)) | ||
226 | (esym (gensym))) | ||
227 | `(let ((,msym ,message)) | ||
228 | (condition-case ,esym | ||
229 | (progn (message "%s..." ,msym) | ||
230 | ,@body) | ||
231 | (:success (message "%s...done" ,msym)) | ||
232 | (t (signal (car ,esym) (cdr ,esym))))))) | ||
233 | |||
234 | (defmacro o (&rest fns) | ||
235 | "Compose FNS into a new function for one argument." | ||
236 | (if (null fns) | ||
237 | `(lambda (&rest args) args) | ||
238 | `(lambda (&rest args) | ||
239 | (apply | ||
240 | #',(car fns) | ||
241 | (ensure-list (apply (o ,@(cdr fns)) args)))))) | ||
242 | |||
243 | (defmacro with-region-or-buffer (&rest funcs) | ||
244 | "Advise FUNCS with `advise-region-or-buffer'." | ||
245 | `(progn | ||
246 | ,@(cl-loop for fn in funcs | ||
247 | collect | ||
248 | `(advice-add ',fn :before #'advise-region-or-buffer)))) | ||
249 | |||
250 | (defmacro with-region-or-line (&rest funcs) | ||
251 | "Advise FUNCS with `advise-region-or-line'." | ||
252 | `(progn | ||
253 | ,@(cl-loop for fn in funcs | ||
254 | collect | ||
255 | `(advice-add ',fn :before #'advise-region-or-line)))) | ||
256 | |||
257 | (defmacro with-region-or-to-eol (&rest funcs) | ||
258 | "Advise FUNCS with `advise-region-or-to-eol'." | ||
259 | `(progn | ||
260 | ,@(cl-loop for fn in funcs | ||
261 | collect | ||
262 | `(advice-add ',fn :before #'advise-region-or-to-eol)))) | ||
263 | |||
264 | (defmacro define-tempo (tag doc &rest elements) | ||
265 | "Define a template and add its tag to MODE's abbrev-table. | ||
266 | TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. | ||
267 | ABBREV, if given, is the abbrev string to use for template expansion | ||
268 | under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." | ||
269 | (declare (indent 1)) | ||
270 | (let* ((template (gensym)) | ||
271 | (tag (cond ((stringp tag) tag) | ||
272 | ((symbolp tag) (symbol-name tag)) | ||
273 | (t (user-error "TAG must be a string or symbol: %S" tag)))) | ||
274 | (mode (or (plist-get elements :mode) nil)) | ||
275 | (abbrev (or (plist-get elements :abbrev) tag)) | ||
276 | (taglist (or (plist-get elements :taglist) nil)) | ||
277 | (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) | ||
278 | (while (and tname (not (memq tname abbrev-table-name-list))) | ||
279 | (setq tname (and (get mode 'derived-mode-parent) | ||
280 | (derived-mode-abbrev-table-name | ||
281 | (get mode 'derived-mode-parent))))) | ||
282 | (or tname 'global-abbrev-table))) | ||
283 | (elements (delete2 elements :mode :abbrev :taglist))) | ||
284 | `(let ((,template (tempo-define-template ,tag | ||
285 | ',elements | ||
286 | ,(or abbrev tag) | ||
287 | ,doc | ||
288 | ,taglist))) | ||
289 | (define-abbrev ,table ,tag "" ,template :system t) | ||
290 | (put ,template 'no-self-insert t)))) | ||
291 | |||
292 | (provide 'acdw-macs) | ||
293 | ;;; acdw-macs.el ends here | ||
diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index 30c4f44..0000000 --- a/lisp/acdw.el +++ /dev/null | |||
@@ -1,79 +0,0 @@ | |||
1 | ;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'acdw-funs) ; Extra functions | ||
6 | (require 'acdw-macs) ; Extra macros | ||
7 | |||
8 | (defdir etc/ (locate-user-emacs-file "etc") | ||
9 | "Directory for package configuration files. | ||
10 | See `no-littering' for examples.") | ||
11 | |||
12 | (defdir var/ etc/ | ||
13 | "Directory for package data file. | ||
14 | See `no-littering' for examples.") | ||
15 | |||
16 | (defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) | ||
17 | (expand-file-name "emacs/" xdg-cache) | ||
18 | etc/) | ||
19 | "Directory for cache files.") | ||
20 | |||
21 | (setq native-compile-target-directory (cache/ "eln" t)) | ||
22 | (when (fboundp 'startup-redirect-eln-cache) | ||
23 | (startup-redirect-eln-cache (cache/ "eln" t))) | ||
24 | |||
25 | (defdir sync/ (expand-file-name "/home/case/Sync") | ||
26 | "My Syncthing directory.") | ||
27 | |||
28 | (defdir private/ (sync/ "emacs/private")) | ||
29 | (add-to-list 'load-path private/) | ||
30 | |||
31 | (require 'acdw-defaults) ; Sane defaults | ||
32 | (require '_acdw) ; Private stuff | ||
33 | (require '+lisp) ; Lispy goodness | ||
34 | |||
35 | (setc enable-recursive-minibuffers t | ||
36 | completions-detailed t | ||
37 | completion-ignore-case t | ||
38 | read-buffer-completion-ignore-case t | ||
39 | read-file-name-completion-ignore-case t | ||
40 | initial-buffer-choice #'+initial-buffer | ||
41 | initial-scratch-message | ||
42 | (format "%s\n\n" | ||
43 | (comment-lines | ||
44 | (shell-command-to-string "fortune") | ||
45 | ";; ")) | ||
46 | sentence-end-double-space nil | ||
47 | save-silently t) | ||
48 | |||
49 | (defkeys t | ||
50 | "M-o" #'other-window|switch-buffer | ||
51 | "C-x 0" #'delete-window|bury-buffer | ||
52 | "C-M-;" #'+lisp-comment-or-uncomment-sexp | ||
53 | "M-SPC" #'+cycle-spacing | ||
54 | "C-x C-k" #'kill-this-buffer) | ||
55 | |||
56 | (defkeys t | ||
57 | "M-u" #'universal-argument) | ||
58 | |||
59 | (defkeys universal-argument-map | ||
60 | "M-u" #'universal-argument-more) | ||
61 | |||
62 | (define-advice switch-to-buffer (:after (&rest _) normal-mode) | ||
63 | "Automatically determine the mode for created non-file buffers." | ||
64 | (when-let ((_ (and (eq major-mode 'fundamental-mode))) | ||
65 | (buffer-file-name (buffer-name))) | ||
66 | (normal-mode))) | ||
67 | |||
68 | (define-advice canonically-space-region | ||
69 | (:around (orig &rest args) double-space-sentences) | ||
70 | (let ((sentence-end-double-space t)) | ||
71 | (apply orig args))) | ||
72 | |||
73 | (with-region-or-buffer indent-region) | ||
74 | |||
75 | (winner-mode) | ||
76 | |||
77 | (provide 'acdw) | ||
78 | |||
79 | ;;; acdw.el ends here | ||
diff --git a/lisp/graveyard.el b/lisp/graveyard.el deleted file mode 100644 index 89a776d..0000000 --- a/lisp/graveyard.el +++ /dev/null | |||
@@ -1,50 +0,0 @@ | |||
1 | ;;; graveyard.el --- stuff i'm not currently using right now | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I spent a long time configuring these packages! And they're misbehaving, | ||
6 | ;; boo. So into the graveyard they go. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (use-package emms | ||
11 | :ensure t | ||
12 | :init | ||
13 | (require 'emms-setup) | ||
14 | (autoload #'+emms-streams "+emms" nil t) | ||
15 | (defkeys t "C-c p s" #'+emms-streams) | ||
16 | (defhook (emms-playlist-mode-hook | ||
17 | emms-browser-mode-hook | ||
18 | emms-show-all-mode-hook) | ||
19 | #'hl-line-mode | ||
20 | #'show-paren-mode) | ||
21 | :config | ||
22 | (require '+emms) | ||
23 | (emms-all) | ||
24 | (emms-default-players) | ||
25 | (emms-browser-make-filter "all" #'ignore) | ||
26 | (emms-browser-make-filter "recent" | ||
27 | (lambda (track) | ||
28 | (< 30 (time-to-number-of-days | ||
29 | (time-subtract (current-time) | ||
30 | (emms-info-track-file-mtime | ||
31 | track)))))) | ||
32 | (emms-browser-set-filter (assoc "all" emms-browser-filters)) | ||
33 | (emms-history-load) | ||
34 | (emms-playing-time-mode -1) | ||
35 | :bind | ||
36 | (("C-c p p" . emms-pause) | ||
37 | ("C-c p b" . emms-browser) | ||
38 | ("C-c p l" . emms-playlist-mode-go)) | ||
39 | :custom | ||
40 | (emms-source-file-default-directory (expand-file-name "~/var/music/")) | ||
41 | (emms-source-playlist-default-format 'm3u) | ||
42 | (emms-playlist-mode-center-when-go t) | ||
43 | (emms-playlist-default-major-mode 'emms-playlist-mode) | ||
44 | (emms-player-mpv-update-metadata t) | ||
45 | (emms-browser-covers #'emms-browser-cache-thumbnail-async) | ||
46 | (emms-browser-thumbnail-small-size 64) | ||
47 | (emms-browser-thumbnail-medium-size 128) | ||
48 | (emms-streams-file (expand-file-name "streams.emms" | ||
49 | emms-source-file-default-directory)) | ||
50 | (emms-mode-line-mode-line-function nil)) | ||
diff --git a/lisp/init-org.el b/lisp/init-org.el deleted file mode 100644 index d2d5e77..0000000 --- a/lisp/init-org.el +++ /dev/null | |||
@@ -1,144 +0,0 @@ | |||
1 | ;;; init-org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (use-package org | ||
4 | :defer t | ||
5 | :custom | ||
6 | (org-adapt-indentation nil) | ||
7 | (org-auto-align-tags t) | ||
8 | (org-archive-mark-done t) | ||
9 | (org-fold-catch-invisible-edits 'show-and-error) | ||
10 | (org-clock-clocked-in-display 'mode-line) | ||
11 | (org-clock-string-limit 7) ; just the clock bit | ||
12 | |||
13 | (org-clock-persist nil) | ||
14 | (org-confirm-babel-evaluate nil) | ||
15 | (org-cycle-separator-lines 0) | ||
16 | (org-directory (sync/ "org/" t)) | ||
17 | (org-fontify-done-headline t) | ||
18 | (org-fontify-quote-and-verse-blocks t) | ||
19 | (org-fontify-whole-heading-line t) | ||
20 | (org-hide-emphasis-markers t) | ||
21 | (org-html-coding-system 'utf-8-unix) | ||
22 | (org-image-actual-width (list (* (window-font-width) | ||
23 | (- fill-column 8)))) | ||
24 | (org-imenu-depth 3) | ||
25 | (org-indent-indentation-per-level 0) | ||
26 | (org-indent-mode-turns-on-hiding-stars nil) | ||
27 | (org-insert-heading-respect-content t) | ||
28 | (org-list-demote-modify-bullet '(("-" . "+") | ||
29 | ("+" . "-"))) | ||
30 | (org-log-done 'time) | ||
31 | (org-log-into-drawer t) | ||
32 | (org-num-skip-commented t) | ||
33 | (org-num-skip-unnumbered t) | ||
34 | (org-num-skip-footnotes t) | ||
35 | (org-outline-path-complete-in-steps nil) | ||
36 | (org-pretty-entities t) | ||
37 | (org-pretty-entities-include-sub-superscripts nil) | ||
38 | (org-refile-targets '((nil . (:maxlevel . 2)) | ||
39 | (org-agenda-files . (:maxlevel . 1)))) | ||
40 | (org-refile-use-outline-path 'file) | ||
41 | (org-special-ctrl-a/e t) | ||
42 | (org-special-ctrl-k t) | ||
43 | (org-src-fontify-natively t) | ||
44 | (org-src-tab-acts-natively t) | ||
45 | (org-src-window-setup 'current-window) | ||
46 | (org-startup-truncated nil) | ||
47 | (org-startup-with-inline-images t) | ||
48 | (org-tags-column 0) | ||
49 | (org-todo-keywords | ||
50 | '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" | ||
51 | "|" "DONE(d!)" "ASSIGNED(a@/!)") | ||
52 | (sequence "|" "CANCELED(k@)") | ||
53 | (sequence "MEETING(m)"))) | ||
54 | (org-use-speed-commands t) | ||
55 | :config | ||
56 | (require '+org) | ||
57 | (defkeys org-mode-map | ||
58 | "C-M-k" #'kill-paragraph | ||
59 | "C-M-t" #'transpose-paragraphs | ||
60 | "RET" #'+org-return-dwim | ||
61 | "S-<return>" #'+org-table-copy-down|+org-return-dwim | ||
62 | "C-c C-o" #'+org-open-at-point-dwim) | ||
63 | (setc org-ellipsis | ||
64 | (or (bound-and-true-p truncate-string-ellipsis) "…") | ||
65 | org-emphasis-alist | ||
66 | '(("*" org-bold) | ||
67 | ("/" org-italic) | ||
68 | ("_" org-underline) | ||
69 | ("=" org-verbatim) | ||
70 | ("~" org-code) | ||
71 | ("+" org-strikethrough))) | ||
72 | (defhook org-mode-hook | ||
73 | #'variable-pitch-mode | ||
74 | #'visual-fill-column-mode | ||
75 | #'turn-off-auto-fill | ||
76 | #'org-indent-mode | ||
77 | #'prettify-symbols-mode | ||
78 | #'abbrev-mode | ||
79 | (defhook ((before-save-hook nil :local)) | ||
80 | :name before-save@org-mode | ||
81 | (+org-hide-drawers-except-point) | ||
82 | (org-align-tags 'all)))) | ||
83 | |||
84 | (use-package org-agenda | ||
85 | :custom | ||
86 | (org-agenda-skip-deadline-if-done t) | ||
87 | (org-agenda-skip-scheduled-if-done t) | ||
88 | (org-agenda-span 10) | ||
89 | (org-agenda-block-separator ?─) | ||
90 | (org-agenda-time-grid | ||
91 | '((daily today require-timed) | ||
92 | (800 1000 1200 1400 1600 1800 2000) | ||
93 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")) | ||
94 | (org-agenda-current-time-string | ||
95 | "← now ─────────────────────────────────────────────────") | ||
96 | (org-agenda-include-diary nil) ; I use the org-diary features | ||
97 | |||
98 | (org-agenda-todo-ignore-deadlines 'near) | ||
99 | (org-agenda-todo-ignore-scheduled 'future) | ||
100 | (org-agenda-include-deadlines t) | ||
101 | (org-deadline-warning-days 0) | ||
102 | (org-agenda-show-future-repeats 'next) | ||
103 | (org-agenda-window-setup 'current-window) | ||
104 | (org-agenda-file-skip-regexp "sync-conflict") | ||
105 | :bind (("C-c a" . org-agenda)) | ||
106 | :config | ||
107 | (require '+org) | ||
108 | (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp) | ||
109 | (defhook org-agenda-mode-hook | ||
110 | (setq-local truncate-lines t) | ||
111 | #'hl-line-mode) | ||
112 | (defhook org-agenda-after-show-hook | ||
113 | #'org-narrow-to-subtree)) | ||
114 | |||
115 | (use-package org-capture | ||
116 | :bind | ||
117 | (("C-c c" . org-capture))) | ||
118 | |||
119 | (use-package ol ; org-link | ||
120 | :after org | ||
121 | :config | ||
122 | (require '+org) | ||
123 | (+org-link-define-type sms (number _)) | ||
124 | (+org-link-define-type tel (number _))) | ||
125 | |||
126 | (use-package ox ; org-export | ||
127 | :defer t | ||
128 | :custom | ||
129 | (org-export-coding-system 'utf-8-unix) | ||
130 | (org-export-headline-levels 8) | ||
131 | (org-export-with-drawers nil) | ||
132 | (org-export-with-section-numbers nil) | ||
133 | (org-export-with-smart-quotes t) | ||
134 | (org-export-with-sub-superscripts t) | ||
135 | (org-export-with-toc nil) | ||
136 | :config | ||
137 | (require 'ox-md)) | ||
138 | |||
139 | (use-package org-word-count | ||
140 | :load-path "~/src/emacs/org-word-count/" | ||
141 | :hook org-mode-hook) | ||
142 | |||
143 | (provide 'init-org) | ||
144 | ;;; init-org.el ends here | ||
diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el deleted file mode 100644 index 5a9da84..0000000 --- a/lisp/upload-junk.el +++ /dev/null | |||
@@ -1,47 +0,0 @@ | |||
1 | ;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'tramp) | ||
6 | |||
7 | (defvar upload-junk-ssh-host "hetzner" | ||
8 | "SSH host to upload to.") | ||
9 | |||
10 | (defvar upload-junk-ssh-root "/junk" | ||
11 | "SSH root folder to upload to.") | ||
12 | |||
13 | (defvar upload-junk-web-host "https://junk.acdw.net" | ||
14 | "Web host to link uploads to.") | ||
15 | |||
16 | (defun upload-junk-file-name (&optional file) | ||
17 | "Return the uploaded filename for FILE." | ||
18 | (let ((file (or file "_.txt"))) | ||
19 | (format "tmp_%s_%x%x.%s" | ||
20 | (file-name-nondirectory (file-name-sans-extension file)) | ||
21 | (time-convert (current-time) 'integer) | ||
22 | (random (* 8 8 8 8)) | ||
23 | (or (file-name-extension file) "txt")))) | ||
24 | |||
25 | (defun upload-junk-region (start end) | ||
26 | "Upload region from START to END to my server." | ||
27 | (interactive "r") | ||
28 | (let* ((s (buffer-substring-no-properties start end)) | ||
29 | (f (upload-junk-file-name (buffer-file-name))) | ||
30 | (w (format "%s/%s" upload-junk-web-host f))) | ||
31 | (with-temp-buffer | ||
32 | (insert s) | ||
33 | (write-file (format "/sshx:%s:%s/%s" | ||
34 | upload-junk-ssh-host | ||
35 | upload-junk-ssh-root | ||
36 | f))) | ||
37 | (kill-new w) | ||
38 | w)) | ||
39 | |||
40 | (defun upload-junk-region-or-buffer () | ||
41 | (interactive) | ||
42 | (if (region-active-p) | ||
43 | (upload-junk-region (region-beginning) (region-end)) | ||
44 | (upload-junk-region (point-min) (point-max)))) | ||
45 | |||
46 | (provide 'upload-junk) | ||
47 | ;;; upload-junk.el ends here | ||
diff --git a/lisp/yoke.el b/lisp/yoke.el deleted file mode 100644 index ec84f56..0000000 --- a/lisp/yoke.el +++ /dev/null | |||
@@ -1,392 +0,0 @@ | |||
1 | ;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience | ||
7 | ;; Package-Version: 0.61803398875 | ||
8 | ;; Homepage: https://junk.acdw.net/yoke.el | ||
9 | ;; Package-Requires: ((emacs "28.1")) | ||
10 | |||
11 | ;; This program is free software; you can redistribute it and/or modify | ||
12 | ;; it under the terms of the GNU General Public License as published by | ||
13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
14 | ;; (at your option) any later version. | ||
15 | |||
16 | ;; This program is distributed in the hope that it will be useful, | ||
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
19 | ;; GNU General Public License for more details. | ||
20 | |||
21 | ;; You should have received a copy of the GNU General Public License | ||
22 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
23 | |||
24 | ;;; Commentary: | ||
25 | |||
26 | ;; THIS IS A WORK IN PROGRESS. DON'T USE IT. | ||
27 | |||
28 | ;;; Code: | ||
29 | |||
30 | (require 'cl-lib) | ||
31 | (require 'package-vc) | ||
32 | |||
33 | ;;; User options | ||
34 | |||
35 | (defgroup yoke nil | ||
36 | "Customizations for `yoke'." | ||
37 | :group 'convenience | ||
38 | :prefix "yoke-") | ||
39 | |||
40 | (defcustom yoke-directory package-user-dir | ||
41 | "Where to put yoked packages." | ||
42 | :type 'file) | ||
43 | |||
44 | (defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" | ||
45 | "~/.yoke-cache") | ||
46 | "Where to put cached yoke files, like downloaded HTTP packages." | ||
47 | :type 'file) | ||
48 | |||
49 | (defcustom yoke-debug-on-error nil | ||
50 | "Whether to throw up the debugger on a yoke error. | ||
51 | If nil, errors will be inserted in the `yoke-message-buffer'.") | ||
52 | |||
53 | ;;; Variables | ||
54 | |||
55 | (defvar yoke-message-buffer " *yoke*" | ||
56 | "The buffer used for yoke messages.") | ||
57 | |||
58 | (defvar yoke-selected-packages nil | ||
59 | "List of packages managed by `yoke'.") | ||
60 | |||
61 | (defvar yoke-backends '(file http package) | ||
62 | "Backends handled by `yoke'.") | ||
63 | |||
64 | ;;; Main functionality | ||
65 | |||
66 | (defmacro yoke (package &rest body) | ||
67 | "Yoke a package into your Emacs session. | ||
68 | PACKAGE is either a symbol, in which case `yoke' expands to | ||
69 | basically a named `progn' (good for grouping configuration), or a | ||
70 | list of the form (NAME . ARGS), where ARGS can be one of the | ||
71 | following: | ||
72 | |||
73 | - nil: install NAME using `package'. | ||
74 | - a property list describing a package specification. Valid | ||
75 | key/value pairs include | ||
76 | |||
77 | `:backend' (symbol) | ||
78 | A symbol of the yoke backend to use for installing the | ||
79 | package. See `yoke-backends' for allowed backends. | ||
80 | |||
81 | `:url' (string) | ||
82 | The URL of the package's repository or source. | ||
83 | |||
84 | `:lisp-dir' (string) | ||
85 | The repository-relative name of the directory to use for | ||
86 | loading lisp sources. If not given, it defaults to the | ||
87 | repo's root directory. | ||
88 | |||
89 | Other pairs may be valid for a given backend; see that | ||
90 | backend's `yoke-install' function for more details. | ||
91 | |||
92 | BODY is executed in a `condition-case' so that errors won't keep | ||
93 | the rest of Emacs from initializing. BODY can also be prepended | ||
94 | by the following keyword arguments: | ||
95 | |||
96 | `:after' (FEATURE...) | ||
97 | |||
98 | `:require' (FEATURE...) | ||
99 | |||
100 | `:depends' (PACKAGE-SPEC...) | ||
101 | |||
102 | `:build' (ACTION...) | ||
103 | |||
104 | `:unless' (PREDICATE) | ||
105 | |||
106 | `:when' (PREDICATE) | ||
107 | |||
108 | Other keywords are ignored. | ||
109 | |||
110 | \(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" | ||
111 | (declare (indent 1)) | ||
112 | (let* ((name (or (car-safe package) package)) | ||
113 | (backend (yoke--pget package :backend)) | ||
114 | ;; Body keyword arguments | ||
115 | (after (plist-get body :after)) | ||
116 | (depends (plist-get body :depends)) | ||
117 | (req (plist-get body :require)) | ||
118 | (buildp (plist-member body :build)) | ||
119 | (build (plist-get body :build)) | ||
120 | (whenp (plist-member body :when)) | ||
121 | (when (if whenp (plist-get body :when) t)) | ||
122 | (unlessp (plist-member body :unless)) | ||
123 | (unless (if unlessp (plist-get body :unless) nil)) | ||
124 | ;; Body | ||
125 | (body (let ((b body) r) | ||
126 | (while (consp b) | ||
127 | (if (keywordp (car b)) | ||
128 | (setf b (cdr b)) | ||
129 | (setf r (cons (car b) r))) | ||
130 | (setf b (cdr b))) | ||
131 | (reverse r))) | ||
132 | (esym (make-symbol "yoke-error"))) | ||
133 | ;; Body modifiers. These are applied in reverse order (that is, the last | ||
134 | ;; one will be on the outside). | ||
135 | ;; --- Require the current package | ||
136 | (when req | ||
137 | (setf body | ||
138 | (append (let (reqs) | ||
139 | (dolist (r (ensure-list req) reqs) | ||
140 | (let* ((feat (if (eq r t) name r)) | ||
141 | (+feat (intern (format "+%s" feat)))) | ||
142 | (push `(require ',feat) reqs) | ||
143 | (push `(require ',+feat nil :noerror) reqs))) | ||
144 | (reverse reqs)) | ||
145 | body))) | ||
146 | ;; --- Install the package | ||
147 | (when (consp package) | ||
148 | (push `(yoke-install ',(car package) ,@(cdr package)) | ||
149 | body)) | ||
150 | ;; --- Dependencies | ||
151 | (when depends | ||
152 | (setf body | ||
153 | (append (cl-loop for dep in (ensure-list depends) | ||
154 | collect `(or (yoke-install ',@(ensure-list dep)) | ||
155 | (error "Dependency (%s): %S" | ||
156 | ',dep ',package))) | ||
157 | body))) | ||
158 | ;; --- Load after | ||
159 | (when after | ||
160 | (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) | ||
161 | ;; --- Conditional expansion | ||
162 | (when (or whenp unlessp) | ||
163 | (setf body | ||
164 | (append (cond | ||
165 | ((and whenp unlessp) | ||
166 | `((when (or (not ,when) ,unless) | ||
167 | (signal 'yoke-predicate | ||
168 | '(:when ,when :unless ,unless))))) | ||
169 | (whenp | ||
170 | `((unless ,when (signal 'yoke-predicate | ||
171 | '(:when ,when))))) | ||
172 | (unlessp | ||
173 | `((when ,unless (signal 'yoke-predicate | ||
174 | '(:unless ,unless)))))) | ||
175 | body))) | ||
176 | ;; Expansion | ||
177 | `(condition-case ,esym | ||
178 | (cl-letf (((symbol-function 'package--save-selected-packages) | ||
179 | #'ignore)) | ||
180 | ;; Body | ||
181 | ,@body) | ||
182 | (:success | ||
183 | ,(unless (atom package) | ||
184 | `(setf (alist-get ',name yoke-selected-packages) | ||
185 | (list ,@(cdr-safe package)))) | ||
186 | ',package) | ||
187 | (t ,(if yoke-debug-on-error | ||
188 | `(signal (car ,esym) (cdr ,esym)) | ||
189 | `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) | ||
190 | |||
191 | ;;; Installing packages | ||
192 | |||
193 | (defun yoke-install (name &rest args) | ||
194 | "Install package NAME, with ARGS." | ||
195 | (let ((custom-file null-device) | ||
196 | (inhibit-message (and (not (plist-member args :update)) | ||
197 | (not debug-on-error))) | ||
198 | (messages-buffer-name yoke-message-buffer)) | ||
199 | (funcall | ||
200 | (intern | ||
201 | (format "yoke-install-%s" | ||
202 | (or (plist-get args :backend) | ||
203 | (yoke--guess-backend (plist-get args :url)) | ||
204 | 'package))) | ||
205 | name args)) | ||
206 | (yoke--clean-load-path) | ||
207 | ;; Don't return nil | ||
208 | t) | ||
209 | |||
210 | (defun yoke-install-package (name args &optional tries) | ||
211 | "Install package NAME with ARGS using `package' machinery. | ||
212 | TRIES is an internal variable." | ||
213 | (let ((package-user-dir yoke-directory) | ||
214 | (url (plist-get args :url)) | ||
215 | (update (plist-get args :update)) | ||
216 | (dirname (expand-file-name (format "%s" name) | ||
217 | yoke-directory)) | ||
218 | (tries (or tries 0)) | ||
219 | load-dir autoloads-file-name) | ||
220 | (unless (file-exists-p dirname) | ||
221 | (setq dirname (or (car-safe (file-expand-wildcards | ||
222 | (concat dirname "*"))) | ||
223 | dirname))) | ||
224 | (setq load-dir | ||
225 | (expand-file-name (or (plist-get args :lisp-dir) "") dirname) | ||
226 | generated-autoload-file | ||
227 | (expand-file-name (format "%s-autoloads.el" name) load-dir)) | ||
228 | (prog1 | ||
229 | (condition-case error | ||
230 | (cond | ||
231 | ;; -- Commented on 2022-12-21 | ||
232 | ;; ((and (file-exists-p dirname) | ||
233 | ;; (not update)) | ||
234 | ;; (add-to-list 'load-path | ||
235 | ;; (expand-file-name | ||
236 | ;; (or (plist-get args :lisp-dir) "") | ||
237 | ;; dirname) | ||
238 | ;; nil #'equal) | ||
239 | ;; (require (intern (format "%s-autoloads" name)))) | ||
240 | ((and url update) | ||
241 | (package-vc-update (cadr (assoc name package-alist)))) | ||
242 | (update | ||
243 | (package-update name)) | ||
244 | (url | ||
245 | ;; I'm going to be honest here, this is extremely cursed. But I | ||
246 | ;; don't want to get asked about installing the packages, and when | ||
247 | ;; the user answers 'no', the function errors. So.. this. | ||
248 | (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) | ||
249 | (ignore-errors (package-vc-install (cons name args))))) | ||
250 | (:else | ||
251 | (package-install name))) | ||
252 | (file-error (if (> tries 1) | ||
253 | (error "(yoke) Can't install `%s'" name) | ||
254 | (package-refresh-contents) | ||
255 | (yoke-install-package name args (1+ tries))))) | ||
256 | (add-to-list 'load-path load-dir nil #'equal) | ||
257 | (loaddefs-generate load-dir generated-autoload-file) | ||
258 | ;; Do it again, if it doesn't actually /generate/ anything | ||
259 | (when (eq 'provide | ||
260 | (with-current-buffer (find-file-noselect generated-autoload-file) | ||
261 | (read (buffer-substring (point-min) (point-max))))) | ||
262 | (loaddefs-generate load-dir generated-autoload-file nil nil nil | ||
263 | :generate-full)) | ||
264 | (load generated-autoload-file :noerror) | ||
265 | (kill-buffer (get-file-buffer generated-autoload-file)) | ||
266 | (package-activate name)))) | ||
267 | |||
268 | (defun yoke-install-http (name args) | ||
269 | "Install a package NAME using ARGS from an http source." | ||
270 | (let* ((url (plist-get args :url)) | ||
271 | (cached (expand-file-name (file-name-nondirectory url) | ||
272 | yoke-cache-directory)) | ||
273 | (update (plist-get args :update))) | ||
274 | (unless url | ||
275 | (error "No URL for HTTP download: %S" (cons name args))) | ||
276 | (when (or (not (file-exists-p cached)) | ||
277 | update) | ||
278 | (make-directory yoke-cache-directory :parents) | ||
279 | (message "Downloading `%s'..." url) | ||
280 | (let* ((url-debug t) | ||
281 | (buf (url-retrieve-synchronously url))) | ||
282 | (with-current-buffer buf | ||
283 | (goto-char (point-min)) | ||
284 | (delete-region (point) (1+ (re-search-forward "^$"))) | ||
285 | (write-file cached 1) | ||
286 | (message "Downloading `%s'...Done." url)))) | ||
287 | (package-install-file cached))) | ||
288 | |||
289 | (defun yoke-install-file (name args) | ||
290 | "Install package NAME using ARGS from a file on-disk." | ||
291 | (let ((url (plist-get args :url)) | ||
292 | (update (plist-get args :update)) | ||
293 | (dirname (expand-file-name (format "%s" name) yoke-directory))) | ||
294 | (if (file-exists-p url) | ||
295 | ;; This takes care of updating too. | ||
296 | (package-install-file url) | ||
297 | (error "(yoke) No such file: `%s'" url)))) | ||
298 | |||
299 | ;;; Other package transactions | ||
300 | |||
301 | (defun yoke--choose-package () | ||
302 | "Choose a package from `yoke-selected-packages'." | ||
303 | (assoc (intern (completing-read "Package: " yoke-selected-packages)) | ||
304 | yoke-selected-packages)) | ||
305 | |||
306 | (defun yoke-update (name &rest args) | ||
307 | (interactive (yoke--choose-package)) | ||
308 | (save-window-excursion | ||
309 | (apply #'yoke-install name (append '(:update t) | ||
310 | args)))) | ||
311 | |||
312 | (defun yoke-update-all () | ||
313 | (interactive) | ||
314 | (dolist (pkg yoke-selected-packages) | ||
315 | (apply #'yoke-update pkg))) | ||
316 | |||
317 | ;;; Emacs integration | ||
318 | |||
319 | (defun yoke-imenu-insinuate () | ||
320 | "Insinuate `yoke' forms for `imenu'." | ||
321 | (require 'imenu) | ||
322 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | ||
323 | (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" | ||
324 | 1)) | ||
325 | (with-eval-after-load 'consult-imenu | ||
326 | (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode | ||
327 | consult-imenu-config) | ||
328 | :types)) | ||
329 | '("Yoke")))) | ||
330 | |||
331 | ;;; Utility functions | ||
332 | |||
333 | (defun yoke--pget (spec prop &optional default) | ||
334 | "Get PROP's value from SPEC, a yoke specification. | ||
335 | If KEY doesn't exist, return DEFAULT." | ||
336 | (let ((pl (or (and (plistp spec) spec) | ||
337 | (cdr-safe spec)))) | ||
338 | (if (plist-member pl prop) | ||
339 | (plist-get pl prop) | ||
340 | default))) | ||
341 | |||
342 | (defun yoke--guess-backend (url) | ||
343 | "Guess the backend to use from URL. | ||
344 | If inconclusive, return nil." | ||
345 | (cond | ||
346 | ((or (string-prefix-p "file:" url t) | ||
347 | (string-prefix-p "~" url) | ||
348 | (string-prefix-p "/" url)) | ||
349 | 'file) | ||
350 | (:else nil))) | ||
351 | |||
352 | (defun yoke--clean-load-path () | ||
353 | (when-let ((first (string-remove-suffix "/" (car load-path))) | ||
354 | (second (string-remove-suffix "/" (cadr load-path))) | ||
355 | (_ (equal first second))) | ||
356 | (setf load-path (cdr load-path)) | ||
357 | (setf (car load-path) second))) | ||
358 | |||
359 | (defun yoke--eval-after-init (fn) | ||
360 | "Evaluate FN after inititation, or now if Emacs is initialized. | ||
361 | FN is called with no arguments." | ||
362 | (if after-init-time | ||
363 | (funcall fn) | ||
364 | (add-hook 'after-init-hook fn))) | ||
365 | |||
366 | (defmacro yoke--eval-after (prereqs &rest body) | ||
367 | "Evaluate body after PREREQS. | ||
368 | PREREQS can be a feature, a number, `:init', or a list of those. | ||
369 | |||
370 | Features are used as arguments to `eval-after-load'. Numbers are | ||
371 | used as arguments to `run-with-idle-timer'. `:init' will ensure BODY | ||
372 | runs after Emacs's init time. | ||
373 | |||
374 | When given a list of PREREQS, `eval-after' will nest each one | ||
375 | from left to right." | ||
376 | (declare (indent 1) (debug (form def-body))) | ||
377 | (setf prereqs (ensure-list prereqs)) | ||
378 | (if (null prereqs) | ||
379 | (macroexp-progn body) | ||
380 | (let* ((this (car prereqs)) | ||
381 | (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) | ||
382 | (cond | ||
383 | ((eq this :init) | ||
384 | (append '(yoke--eval-after-init) form)) | ||
385 | ((numberp this) | ||
386 | (append `(run-with-idle-timer ,this nil) form)) | ||
387 | ((symbolp this) | ||
388 | (append `(eval-after-load ',this) form)) | ||
389 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) | ||
390 | |||
391 | (provide 'yoke) | ||
392 | ;;; yoke.el ends here | ||