diff options
Diffstat (limited to 'lisp/acdw.el')
-rw-r--r-- | lisp/acdw.el | 384 |
1 files changed, 0 insertions, 384 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null | |||
@@ -1,384 +0,0 @@ | |||
1 | ;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'seq) | ||
7 | |||
8 | (defmacro defdir (name directory &optional docstring makedir) | ||
9 | "Define a variable and a function NAME expanding to DIRECTORY. | ||
10 | DOCSTRING is applied to the variable; its default is DIRECTORY's | ||
11 | path. If MAKEDIR is non-nil, the directory and its parents will | ||
12 | be created." | ||
13 | (declare (indent 2) (doc-string 3)) | ||
14 | `(progn | ||
15 | (defvar ,name (expand-file-name ,directory) | ||
16 | ,(concat (or docstring (format "%s" directory)) "\n" | ||
17 | "Defined by `defdir'.")) | ||
18 | (defun ,name (file &optional mkdir) | ||
19 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | ||
20 | "If MKDIR is non-nil, parent directories are created.\n" | ||
21 | "Defined by `defdir'.") | ||
22 | (let ((file-name (expand-file-name | ||
23 | (convert-standard-filename file) ,name))) | ||
24 | (when mkdir | ||
25 | (make-directory (file-name-directory file-name) :parents)) | ||
26 | file-name)) | ||
27 | ,(if makedir | ||
28 | `(make-directory ,directory :parents) | ||
29 | `(unless (file-exists-p ,directory) | ||
30 | (warn "Directory `%s' doesn't exist." ,directory))))) | ||
31 | |||
32 | (defun choose-executable (&rest programs) | ||
33 | "Return the first of PROGRAMS that exists in the system's $PATH. | ||
34 | Each of PROGRAMS can be a single string, or a list. If it's a list then its car | ||
35 | will be tested with `executable-find', and the entire list returned. This | ||
36 | enables passing arguments to a calling function." | ||
37 | (catch 'found | ||
38 | (dolist (prog programs) | ||
39 | (let ((exec (executable-find (car (ensure-list prog)))) | ||
40 | (args (cdr-safe prog))) | ||
41 | (when exec | ||
42 | (throw 'found (if args (cons exec args) exec))))))) | ||
43 | |||
44 | (defun file-string (file) | ||
45 | "Return the contents of FILE as a string." | ||
46 | (with-current-buffer (find-file-noselect file) | ||
47 | (buffer-string))) | ||
48 | |||
49 | (defun unsmartify-region (begin end) | ||
50 | "Replace \"smart\" punctuation with \"dumb\" counterparts." | ||
51 | (interactive "*r") | ||
52 | (save-excursion | ||
53 | (goto-char begin) | ||
54 | (while (re-search-forward "[“”‘’–—]" end t) | ||
55 | (let ((replace (pcase (match-string 0) | ||
56 | ((or "“" "”") "\"") | ||
57 | ((or "‘" "’") "'") | ||
58 | ("–" "--") | ||
59 | ("—" "---")))) | ||
60 | (replace-match replace nil nil))))) | ||
61 | |||
62 | (defun unsmartify-dwim () | ||
63 | "Unsmartify the current region or the entire buffer." | ||
64 | (interactive) | ||
65 | (if (region-active-p) | ||
66 | (unsmartify-region (region-beginning) (region-end)) | ||
67 | (unsmartify-region (point-min) (point-max)))) | ||
68 | |||
69 | (defun ++concat (func strings) | ||
70 | "Concat STRINGS processed by FUNC. | ||
71 | Each of STRINGS can be a bare string or a list. Strings are | ||
72 | passed through as-is, but lists are passed to FUNC first as | ||
73 | arguments. Finally, all the resulting strings are `mapconcat'-ed | ||
74 | together. | ||
75 | |||
76 | As a special case, if `:separator' is the first of STRINGS, the | ||
77 | string following will be used as a separator. Otherwise, a | ||
78 | newline will be used." | ||
79 | (let (separator) | ||
80 | (when (eq (car strings) :separator) | ||
81 | (setq separator (cadr strings) | ||
82 | strings (cddr strings))) | ||
83 | (mapconcat (lambda (s) | ||
84 | (cond | ||
85 | ((listp s) (apply func s)) | ||
86 | ((stringp s) s) | ||
87 | (t (user-error "Bad argument: %S" s)))) | ||
88 | strings | ||
89 | (or separator "\n")))) | ||
90 | |||
91 | (defun format-concat (&rest strings) | ||
92 | "Concatenate formatted STRINGS. | ||
93 | Each of STRINGS can be a bare string or a list. Bare strings are passed as-is | ||
94 | to `mapconcat' for concatenation and separation. Lists, however, are passed to | ||
95 | `format' first. | ||
96 | |||
97 | If `:separator' is the first of STRINGS, the next string will be | ||
98 | used as a separator." | ||
99 | (++concat #'format strings)) | ||
100 | |||
101 | (defun list-append-removing-duplicates (&rest lists) | ||
102 | "Append LISTS, removing duplicates from the result. | ||
103 | Any keyword arguments to `cl-remove-duplicates' should come | ||
104 | before the LISTS." | ||
105 | (let (cl-remove-duplicates-args) | ||
106 | (while (keywordp (car lists)) | ||
107 | (push (pop lists) cl-remove-duplicates-args) | ||
108 | (push (pop lists) cl-remove-duplicates-args)) | ||
109 | (apply #'cl-remove-duplicates (apply #'append lists) | ||
110 | (nreverse cl-remove-duplicates-args)))) | ||
111 | |||
112 | (defun mapc-buffers (func &optional predicate) | ||
113 | "Map FUNC over buffers matching PREDICATE. | ||
114 | Both FUNC and PREDICATE will be executed with no arguments and in | ||
115 | the context of each buffer. | ||
116 | |||
117 | If PREDICATE is nil or not given, map FUNC over all buffers." | ||
118 | (cl-loop for buf being the buffers | ||
119 | do (with-current-buffer buf | ||
120 | (when (and predicate | ||
121 | (funcall predicate)) | ||
122 | (funcall func))))) | ||
123 | |||
124 | (defun mapc-buffers-modes (func &rest modes) | ||
125 | "Map FUNC over buffers derived from MODES. | ||
126 | FUNC will be executed with no arguments and in the context of | ||
127 | each buffer." | ||
128 | (mapc-buffers func | ||
129 | (lambda () | ||
130 | (apply #'derived-mode-p modes)))) | ||
131 | |||
132 | (defun find-font (&rest fonts) | ||
133 | "Return the first font of FONTS that is installed." | ||
134 | (cl-loop with ffl = (font-family-list) | ||
135 | for font in fonts | ||
136 | if (member font ffl) | ||
137 | return font)) | ||
138 | |||
139 | (defmacro progress@around (fn message &optional name) | ||
140 | "Define :around advice for functions adding a simple progress reporter." | ||
141 | (let ((orig (gensym)) | ||
142 | (args (gensym)) | ||
143 | (prog (gensym))) | ||
144 | `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress)) | ||
145 | ,(format "Add a simple progress reporter to %s." fn) | ||
146 | (let ((,prog (make-progress-reporter | ||
147 | ,(format "%s..." (string-remove-suffix "..." message))))) | ||
148 | (apply ,orig ,args) | ||
149 | (progress-reporter-done ,prog))))) | ||
150 | |||
151 | |||
152 | |||
153 | ;;; Ispell in .dir-locals | ||
154 | |||
155 | ;; Let Emacs know a list of strings is safe | ||
156 | (defun +ispell-safe-local-p (list) | ||
157 | (and (listp list) | ||
158 | (seq-every-p #'stringp list))) | ||
159 | |||
160 | ;; Can I instruct ispell to insert LocalWords in a different file? | ||
161 | ;; https://emacs.stackexchange.com/q/31396/2264 | ||
162 | |||
163 | ;; How can I move all my file-local LocalWords to .dir-locals.el? | ||
164 | ;; https://emacs.stackexchange.com/q/31419 | ||
165 | |||
166 | ;; Adapted from ispell.el:ispell-buffer-local-words | ||
167 | (defun +ispell-buffer-local-words-list () | ||
168 | (let (words) | ||
169 | (or ispell-buffer-local-name | ||
170 | (setf ispell-buffer-local-name (buffer-name))) | ||
171 | (save-excursion | ||
172 | (goto-char (point-min)) | ||
173 | (while (search-forward ispell-words-keyword nil t) | ||
174 | (let ((end (point-at-eol)) | ||
175 | (ispell-casechars (ispell-get-casechars)) | ||
176 | string) | ||
177 | (while (re-search-forward " *\\([^ ]+\\)" end t) | ||
178 | (setf string (match-string-no-properties 1)) | ||
179 | (if (and (< 1 (length string)) | ||
180 | (equal 0 (string-match ispell-casechars string))) | ||
181 | (push string words)))))) | ||
182 | words)) | ||
183 | |||
184 | ;;;###autoload | ||
185 | (defun +ispell-move-buffer-words-to-dir-locals (&optional arg) | ||
186 | "Move the current buffer-local words to .dir-locals.el. | ||
187 | This function prompts the user to save .dir-locals.el, unless | ||
188 | prefix ARG is non-nil; then it just saves them." | ||
189 | (interactive "P") | ||
190 | (unless (buffer-file-name) | ||
191 | (user-error "Buffer not attached to file")) | ||
192 | (hack-dir-local-variables) | ||
193 | (let ((print-level nil) | ||
194 | (print-length nil) | ||
195 | (before-save-hook nil) | ||
196 | (after-save-hook nil)) | ||
197 | (when-let ((new-words (cl-remove-if | ||
198 | (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA | ||
199 | ; where this came from | ||
200 | (list-append-removing-duplicates | ||
201 | :test #'string= | ||
202 | ispell-buffer-session-localwords | ||
203 | (alist-get 'ispell-buffer-session-localwords | ||
204 | dir-local-variables-alist) | ||
205 | (alist-get 'ispell-buffer-session-localwords | ||
206 | file-local-variables-alist) | ||
207 | (+ispell-buffer-local-words-list))))) | ||
208 | (save-excursion | ||
209 | (add-dir-local-variable | ||
210 | major-mode | ||
211 | 'ispell-buffer-session-localwords | ||
212 | (setf ispell-buffer-session-localwords | ||
213 | new-words)) | ||
214 | (when (or arg | ||
215 | (y-or-n-p "Save .dir-locals.el?")) | ||
216 | (save-buffer)) | ||
217 | (bury-buffer)) | ||
218 | (or ispell-buffer-local-name | ||
219 | (setf ispell-buffer-local-name (buffer-name))) | ||
220 | (save-excursion | ||
221 | (goto-char (point-min)) | ||
222 | (while (search-forward ispell-words-keyword nil t) | ||
223 | (delete-region (point-at-bol) (1+ (point-at-eol)))))))) | ||
224 | |||
225 | ;;;###autoload | ||
226 | (defun +ispell-move-buffer-words-to-dir-locals-hook () | ||
227 | "Convenience function for binding to a hook." | ||
228 | (+ispell-move-buffer-words-to-dir-locals t)) | ||
229 | |||
230 | |||
231 | ;;; Comment-or-uncomment-sexp | ||
232 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | ||
233 | |||
234 | (defun +lisp-uncomment-sexp (&optional n) | ||
235 | "Uncomment N sexps around point." | ||
236 | (interactive "P") | ||
237 | (let* ((initial-point (point-marker)) | ||
238 | (inhibit-field-text-motion t) | ||
239 | (p) | ||
240 | (end (save-excursion | ||
241 | (when (elt (syntax-ppss) 4) | ||
242 | (re-search-backward comment-start-skip | ||
243 | (line-beginning-position) | ||
244 | t)) | ||
245 | (setq p (point-marker)) | ||
246 | (comment-forward (point-max)) | ||
247 | (point-marker))) | ||
248 | (beg (save-excursion | ||
249 | (forward-line 0) | ||
250 | (while (and (not (bobp)) | ||
251 | (= end (save-excursion | ||
252 | (comment-forward (point-max)) | ||
253 | (point)))) | ||
254 | (forward-line -1)) | ||
255 | (goto-char (line-end-position)) | ||
256 | (re-search-backward comment-start-skip | ||
257 | (line-beginning-position) | ||
258 | t) | ||
259 | (ignore-errors | ||
260 | (while (looking-at-p comment-start-skip) | ||
261 | (forward-char -1))) | ||
262 | (point-marker)))) | ||
263 | (unless (= beg end) | ||
264 | (uncomment-region beg end) | ||
265 | (goto-char p) | ||
266 | ;; Indentify the "top-level" sexp inside the comment. | ||
267 | (while (and (ignore-errors (backward-up-list) t) | ||
268 | (>= (point) beg)) | ||
269 | (skip-chars-backward (rx (syntax expression-prefix))) | ||
270 | (setq p (point-marker))) | ||
271 | ;; Re-comment everything before it. | ||
272 | (ignore-errors | ||
273 | (comment-region beg p)) | ||
274 | ;; And everything after it. | ||
275 | (goto-char p) | ||
276 | (forward-sexp (or n 1)) | ||
277 | (skip-chars-forward "\r\n[:blank:]") | ||
278 | (if (< (point) end) | ||
279 | (ignore-errors | ||
280 | (comment-region (point) end)) | ||
281 | ;; If this is a closing delimiter, pull it up. | ||
282 | (goto-char end) | ||
283 | (skip-chars-forward "\r\n[:blank:]") | ||
284 | (when (eq 5 (car (syntax-after (point)))) | ||
285 | (delete-indentation)))) | ||
286 | ;; Without a prefix, it's more useful to leave point where | ||
287 | ;; it was. | ||
288 | (unless n | ||
289 | (goto-char initial-point)))) | ||
290 | |||
291 | (defun +lisp-comment-sexp--raw () | ||
292 | "Comment the sexp at point or ahead of point." | ||
293 | (pcase (or (bounds-of-thing-at-point 'sexp) | ||
294 | (save-excursion | ||
295 | (skip-chars-forward "\r\n[:blank:]") | ||
296 | (bounds-of-thing-at-point 'sexp))) | ||
297 | (`(,l . ,r) | ||
298 | (goto-char r) | ||
299 | (skip-chars-forward "\r\n[:blank:]") | ||
300 | (save-excursion | ||
301 | (comment-region l r)) | ||
302 | (skip-chars-forward "\r\n[:blank:]")))) | ||
303 | |||
304 | (defun +lisp-comment-or-uncomment-sexp (&optional n) | ||
305 | "Comment the sexp at point and move past it. | ||
306 | If already inside (or before) a comment, uncomment instead. | ||
307 | With a prefix argument N, (un)comment that many sexps." | ||
308 | (interactive "P") | ||
309 | (if (or (elt (syntax-ppss) 4) | ||
310 | (< (save-excursion | ||
311 | (skip-chars-forward "\r\n[:blank:]") | ||
312 | (point)) | ||
313 | (save-excursion | ||
314 | (comment-forward 1) | ||
315 | (point)))) | ||
316 | (+lisp-uncomment-sexp n) | ||
317 | (dotimes (_ (or n 1)) | ||
318 | (+lisp-comment-sexp--raw)))) | ||
319 | |||
320 | |||
321 | ;;; Random shit | ||
322 | |||
323 | (defun insert-iso-date (&optional arg) | ||
324 | "Insert current date formatted ISO-8601 style. | ||
325 | When called with \\[universal-argument] \\[insert-iso-date], | ||
326 | include the time. When called with \\[universal-argument] | ||
327 | \\[universal-argument] \\[insert-iso-date], prompt the user for the | ||
328 | `format-time-string' format to use." | ||
329 | (interactive "P") | ||
330 | (insert (format-time-string (pcase arg | ||
331 | ('nil "%F") | ||
332 | ('(4) "%FT%T%z") | ||
333 | (_ (read-string "Time format: ")))))) | ||
334 | |||
335 | (defun unfill-paragraph () | ||
336 | "Unfill the current paragraph." | ||
337 | (interactive) | ||
338 | (let ((fill-column most-positive-fixnum) | ||
339 | (fill-paragraph-function nil)) | ||
340 | (fill-paragraph))) | ||
341 | |||
342 | (defun fill-with-double-spaced-sentences-dwim (&optional start end) | ||
343 | "Fill paragraph or region, double-spacing sentences." | ||
344 | (interactive) | ||
345 | (let ((sentence-end-double-space t)) | ||
346 | (unless (region-active-p) | ||
347 | (mark-paragraph)) | ||
348 | (repunctuate-sentences :no-query | ||
349 | (region-beginning) | ||
350 | (region-end)) | ||
351 | (fill-region (region-beginning) | ||
352 | (region-end)))) | ||
353 | |||
354 | (defun fill-with-double-spaced-sentences-dwim (&optional start end) | ||
355 | "Fill from START to END, double-spacing sentences. | ||
356 | If START to END aren't given, or if a region isn't in use, fill | ||
357 | the current paragraph." | ||
358 | (interactive "*r") | ||
359 | (let ((sentence-end-double-space t)) | ||
360 | (save-mark-and-excursion | ||
361 | (save-restriction | ||
362 | (unless (region-active-p) | ||
363 | (setq start (progn (start-of-paragraph-text) | ||
364 | (point)) | ||
365 | end (progn (end-of-paragraph-text) | ||
366 | (point)))) | ||
367 | (narrow-to-region start end) | ||
368 | (goto-char (point-min)) | ||
369 | (repunctuate-sentences :no-query) | ||
370 | (fill-region (point-min) | ||
371 | (point-max)))))) | ||
372 | |||
373 | (defun acdw-elisp-package-prepare (&optional file) | ||
374 | "Do all the elisp-package-preparing stuff on FILE. | ||
375 | If FILE is nil or not given, do it on the current buffer." | ||
376 | (with-current-buffer (if file (find-file-noselect file) (current-buffer)) | ||
377 | (check-parens) | ||
378 | (checkdoc) | ||
379 | (package-lint-buffer) | ||
380 | ;; TODO: use `lm-commentary' to write to README.org | ||
381 | )) | ||
382 | |||
383 | (provide 'acdw) | ||
384 | ;;; acdw.el ends here | ||