diff options
Diffstat (limited to 'lisp/acdw.el')
-rw-r--r-- | lisp/acdw.el | 345 |
1 files changed, 76 insertions, 269 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index a9ef893..30c4f44 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,272 +1,79 @@ | |||
1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- | 1 | ;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- |
2 | ;; by C. Duckworth <acdw@acdw.net> | 2 | |
3 | (require 'cl-lib) | 3 | ;;; Code: |
4 | ;; def.el is here | 4 | |
5 | (require 'def) | 5 | (require 'acdw-funs) ; Extra functions |
6 | 6 | (require 'acdw-macs) ; Extra macros | |
7 | ;;; Define both a directory and a function expanding to a file in that directory | 7 | |
8 | 8 | (defdir etc/ (locate-user-emacs-file "etc") | |
9 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) | 9 | "Directory for package configuration files. |
10 | "Define a variable and function NAME expanding to DIRECTORY. | 10 | See `no-littering' for examples.") |
11 | DOCSTRING is applied to the variable. Ensure DIRECTORY exists in | 11 | |
12 | the filesystem, unless INHIBIT-MKDIR is non-nil." | 12 | (defdir var/ etc/ |
13 | (declare (indent 2) | 13 | "Directory for package data file. |
14 | (doc-string 3)) | 14 | See `no-littering' for examples.") |
15 | (unless inhibit-mkdir | 15 | |
16 | (make-directory (eval directory) :parents)) | 16 | (defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) |
17 | `(progn | 17 | (expand-file-name "emacs/" xdg-cache) |
18 | (defvar ,name ,directory | 18 | etc/) |
19 | ,(concat docstring (when docstring "\n") | 19 | "Directory for cache files.") |
20 | "Defined by `/define-dir'.")) | 20 | |
21 | (defun ,name (file &optional mkdir) | 21 | (setq native-compile-target-directory (cache/ "eln" t)) |
22 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | 22 | (when (fboundp 'startup-redirect-eln-cache) |
23 | "If MKDIR is non-nil, the directory is created.\n" | 23 | (startup-redirect-eln-cache (cache/ "eln" t))) |
24 | "Defined by `/define-dir'.") | 24 | |
25 | (let ((file-name (expand-file-name (convert-standard-filename file) | 25 | (defdir sync/ (expand-file-name "/home/case/Sync") |
26 | ,name))) | 26 | "My Syncthing directory.") |
27 | (when mkdir | 27 | |
28 | (make-directory (file-name-directory file-name) :parents)) | 28 | (defdir private/ (sync/ "emacs/private")) |
29 | file-name)))) | 29 | (add-to-list 'load-path private/) |
30 | 30 | ||
31 | ;;; Evaluating things after other things | 31 | (require 'acdw-defaults) ; Sane defaults |
32 | 32 | (require '_acdw) ; Private stuff | |
33 | (defun eval-after-init (fn) | 33 | (require '+lisp) ; Lispy goodness |
34 | "Evaluate FN after inititation, or now if Emacs is initialized. | 34 | |
35 | FN is called with no arguments." | 35 | (setc enable-recursive-minibuffers t |
36 | (if after-init-time | 36 | completions-detailed t |
37 | (funcall fn) | 37 | completion-ignore-case t |
38 | (add-hook 'after-init-hook fn))) | 38 | read-buffer-completion-ignore-case t |
39 | 39 | read-file-name-completion-ignore-case t | |
40 | (defmacro eval-after (features &rest body) | 40 | initial-buffer-choice #'+initial-buffer |
41 | "Evaluate BODY, but only after loading FEATURES. | 41 | initial-scratch-message |
42 | FEATURES can be an atom or a list; as an atom it works like | 42 | (format "%s\n\n" |
43 | `with-eval-after-load'. The special feature `init' will evaluate | 43 | (comment-lines |
44 | BODY after Emacs is finished initializing." | 44 | (shell-command-to-string "fortune") |
45 | (declare (indent 1) | 45 | ";; ")) |
46 | (debug (form def-body))) | 46 | sentence-end-double-space nil |
47 | (unless (listp features) | 47 | save-silently t) |
48 | (setf features (list features))) | 48 | |
49 | (if (null features) | 49 | (defkeys t |
50 | (macroexp-progn body) | 50 | "M-o" #'other-window|switch-buffer |
51 | (let* ((this (car features)) | 51 | "C-x 0" #'delete-window|bury-buffer |
52 | (rest (cdr features))) | 52 | "C-M-;" #'+lisp-comment-or-uncomment-sexp |
53 | (cond ((eq this 'init) | 53 | "M-SPC" #'+cycle-spacing |
54 | `(eval-after-init | 54 | "C-x C-k" #'kill-this-buffer) |
55 | (lambda () (eval-after ,rest ,@body)))) | 55 | |
56 | (:else | 56 | (defkeys t |
57 | `(with-eval-after-load ',this | 57 | "M-u" #'universal-argument) |
58 | (eval-after ,rest ,@body))))))) | 58 | |
59 | 59 | (defkeys universal-argument-map | |
60 | ;;; Convenience functions | 60 | "M-u" #'universal-argument-more) |
61 | 61 | ||
62 | (defun define-key* (maps &rest keydefs) | 62 | (define-advice switch-to-buffer (:after (&rest _) normal-mode) |
63 | "Define KEYDEFS in MAPS. | 63 | "Automatically determine the mode for created non-file buffers." |
64 | Convenience wrapper around `define-key'." | 64 | (when-let ((_ (and (eq major-mode 'fundamental-mode))) |
65 | (unless (zerop (mod (length keydefs) 2)) | 65 | (buffer-file-name (buffer-name))) |
66 | (user-error "Wrong number of arguments: %S" (length keydefs))) | 66 | (normal-mode))) |
67 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) | 67 | |
68 | (list maps) | 68 | (define-advice canonically-space-region |
69 | maps)) | 69 | (:around (orig &rest args) double-space-sentences) |
70 | (cl-loop for (key def) on keydefs by #'cddr | 70 | (let ((sentence-end-double-space t)) |
71 | do (let ((key (if (stringp key) (kbd key) key))) | 71 | (apply orig args))) |
72 | (define-key (if (symbolp map) | 72 | |
73 | (symbol-value map) | 73 | (with-region-or-buffer indent-region) |
74 | map) | 74 | |
75 | key def))))) | 75 | (winner-mode) |
76 | |||
77 | (unless (fboundp 'ensure-list) | ||
78 | ;; Just in case we're using an old version of Emacs. | ||
79 | (defun ensure-list (object) | ||
80 | "Return OBJECT as a list. | ||
81 | If OBJECT is already a list, return OBJECT itself. If it's | ||
82 | not a list, return a one-element list containing OBJECT." | ||
83 | (if (listp object) | ||
84 | object | ||
85 | (list object)))) | ||
86 | |||
87 | (defun add-to-list* (lists &rest things) | ||
88 | "Add THINGS to LISTS. | ||
89 | LISTS can be one list variable or a list. Each thing of THINGS | ||
90 | can be either a variable (the thing), or a list of the form | ||
91 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to | ||
92 | `add-to-list'." | ||
93 | (declare (indent 1)) | ||
94 | (dolist (l (ensure-list lists)) | ||
95 | (dolist (thing things) | ||
96 | (apply #'add-to-list l (ensure-list thing))))) | ||
97 | |||
98 | (defun add-hook* (hooks &rest functions) | ||
99 | "Add FUNCTIONS to HOOKS. | ||
100 | Each function in FUNCTIONS can be a singleton or a list of the | ||
101 | form (FUNCTION &optional DEPTH LOCAL)." | ||
102 | (declare (indent 1)) | ||
103 | (dolist (hook (ensure-list hooks)) | ||
104 | (dolist (fn functions) | ||
105 | (apply #'add-hook hook (ensure-list fn))))) | ||
106 | |||
107 | (defun +concat (&rest strings) | ||
108 | "Concat STRINGS separated by SEPARATOR. | ||
109 | SEPARATOR is \"\\n\" unless the keyword argument `:separator' is | ||
110 | given, followed by the separator to use. Each item in STRINGS is | ||
111 | either a string or a list or strings, which is concatenated | ||
112 | without any separator." | ||
113 | (let (ret | ||
114 | ;; I don't know why a `cl-defun' with | ||
115 | ;; (&rest strings &key (separator "\n")) doesn't work | ||
116 | (separator (or (cl-loop for i from 0 upto (length strings) | ||
117 | if (eq (nth i strings) :separator) | ||
118 | return (nth (1+ i) strings)) | ||
119 | "\n"))) | ||
120 | (while strings | ||
121 | (let ((string (pop strings))) | ||
122 | (cond ((eq string :separator) (pop strings)) | ||
123 | ((listp string) (push (apply #'concat string) ret)) | ||
124 | ((stringp string) (push string ret))))) | ||
125 | (mapconcat #'identity (nreverse ret) separator))) | ||
126 | |||
127 | (defun require* (&rest features) | ||
128 | "Require FEATURES in order. | ||
129 | Each feature of FEATURES can also be a list of the arguments to | ||
130 | pass to `require', which see." | ||
131 | (condition-case e | ||
132 | (dolist (feature features) | ||
133 | (apply #'require (ensure-list feature))) | ||
134 | (:success (mapcar (lambda (f) (car (ensure-list f))) features)) | ||
135 | (t (signal (car e) (cdr e))))) | ||
136 | |||
137 | ;;; Convenience macros | ||
138 | |||
139 | (defmacro define-local-before-save-hook (mode-or-hook &rest body) | ||
140 | "Add a local `before-save-hook' to MODE-OR-HOOK." | ||
141 | (declare (indent 1)) | ||
142 | (let* ((name (format "%s" mode-or-hook)) | ||
143 | (external-name (intern (format "%s@before-save" name))) | ||
144 | (internal-name (intern (format "before-save@%s" name))) | ||
145 | (hook (if (string-suffix-p "-hook" name) | ||
146 | mode-or-hook | ||
147 | (intern (format "%s-hook" name))))) | ||
148 | `(progn | ||
149 | (defun ,internal-name () | ||
150 | ,@body) | ||
151 | (defun ,external-name () | ||
152 | (add-hook 'before-save-hook #',internal-name nil :local)) | ||
153 | (add-hook ',hook #',external-name)))) | ||
154 | |||
155 | (defmacro setq-local-hook (hooks &rest args) | ||
156 | "Run `setq-local' on ARGS when running HOOKs." | ||
157 | ;; FIXME: this is pretty messy, i think... | ||
158 | ;; The settings should be stored in an alist so that they can be deduplicated | ||
159 | (declare (indent 1)) | ||
160 | `(progn | ||
161 | ,@(cl-loop for hook in (ensure-list hooks) | ||
162 | collect | ||
163 | (let ((fn (intern (format "%s-setq-local" hook)))) | ||
164 | (when (and (fboundp fn) | ||
165 | (functionp fn)) | ||
166 | (setf args (append (function-get fn 'setq-local-hook-settings) args))) | ||
167 | (unless (and (< 0 (length args)) | ||
168 | (zerop (mod (length args) 2))) | ||
169 | (user-error "Wrong number of arguments: %S" (length args))) | ||
170 | `(progn | ||
171 | (defun ,fn () | ||
172 | ,(format "Set local variables after `%s'." hook) | ||
173 | (setq-local ,@args)) | ||
174 | (function-put ',fn 'setq-local-hook-settings ',args) | ||
175 | (dolist (buf (buffer-list)) | ||
176 | (with-current-buffer buf | ||
177 | (when (derived-mode-p | ||
178 | ',(intern (replace-regexp-in-string | ||
179 | "-hook" "" (format "%s" hook)))) | ||
180 | (,fn)))) | ||
181 | (add-hook ',hook #',fn)))))) | ||
182 | |||
183 | (defmacro with-message (message &rest body) | ||
184 | "Execute BODY, with MESSAGE. | ||
185 | If body executes without errors, MESSAGE...Done will be displayed." | ||
186 | (declare (indent 1)) | ||
187 | (let ((msg (gensym))) | ||
188 | `(let ((,msg ,message)) | ||
189 | (condition-case e | ||
190 | (progn (message "%s..." ,msg) | ||
191 | ,@body) | ||
192 | (:success (message "%s...done" ,msg)) | ||
193 | (t (signal (car e) (cdr e))))))) | ||
194 | |||
195 | (defmacro either (&rest clauses) | ||
196 | "Return the first of CLAUSES that returns non-nil." | ||
197 | (let* ((this (gensym "either"))) | ||
198 | (unless (null clauses) | ||
199 | `(let* ((,this ,(car clauses))) | ||
200 | (if ,this ,this (either ,@(cdr clauses))))))) | ||
201 | |||
202 | (defun mapc-buffers (fn &optional pred) | ||
203 | "Perform FN on buffers matching PRED. | ||
204 | If PRED is nil or absent, perform FN on all buffers. Both FN and | ||
205 | PRED are called within a `with-current-buffer' form and without | ||
206 | arguments." | ||
207 | (let ((pred (cond | ||
208 | ((listp pred) | ||
209 | (lambda () (apply #'derived-mode-p pred))) | ||
210 | ((functionp pred) pred) | ||
211 | ((null pred) (lambda () t)) | ||
212 | (:else (user-error "Bad predicate"))))) | ||
213 | (dolist (buf (buffer-list)) | ||
214 | (with-current-buffer buf | ||
215 | (when (funcall pred) | ||
216 | (funcall fn)))))) | ||
217 | |||
218 | ;; https://emacs.stackexchange.com/a/39324/37239 | ||
219 | ;; XXX: This shit don't work rn | ||
220 | (defun ignore-invisible-overlays (fn) | ||
221 | "Execute FN, ignoring invisible overlays. | ||
222 | FN should return a point." | ||
223 | (let ((overlay nil) | ||
224 | (point nil)) | ||
225 | (setq point (and (funcall fn) (point))) | ||
226 | (setq overlay (car (overlays-at (point)))) | ||
227 | (while (and overlay (member 'invisible (overlay-properties overlay))) | ||
228 | (goto-char (overlay-end overlay)) | ||
229 | (setq point (and (funcall fn) (point))) | ||
230 | (setq overlay (car (overlays-at (point))))) | ||
231 | point)) | ||
232 | |||
233 | ;;; Extras | ||
234 | ;; Trying to avoid a whole install of crux ... | ||
235 | |||
236 | (defun kill-and-join-forward (&optional arg) | ||
237 | "Kill the line or, if at the end of a line, join with the next. | ||
238 | This command is `visual-line-mode'-aware. If ARG is provided, | ||
239 | it's passed on to kill a line, but not to delete indentation. | ||
240 | When joining, this command deletes whitespace." | ||
241 | (interactive "P") | ||
242 | (if (and (eolp) (not (bolp))) | ||
243 | (delete-indentation 1) | ||
244 | (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) | ||
245 | |||
246 | (defun other-window|switch-buffer (arg) | ||
247 | "Call `other-window' or `switch-buffer' depending on windows. | ||
248 | When called with prefix ARG, unconditionally switch buffer." | ||
249 | (interactive "P") | ||
250 | (if (or arg (one-window-p)) | ||
251 | (switch-to-buffer (other-buffer) nil t) | ||
252 | (other-window 1))) | ||
253 | |||
254 | ;;; Set variables more better-er | ||
255 | ;; Now this doesn't do `setf'-style stuff. | ||
256 | |||
257 | (defmacro setc (&rest args) | ||
258 | "Customize user options using ARGS like `setq'." | ||
259 | (declare (debug setq)) | ||
260 | (unless (zerop (mod (length args) 2)) | ||
261 | (user-error "Dangling argument: %S" var)) | ||
262 | (let (form) | ||
263 | (while args | ||
264 | (push `(customize-set-variable | ||
265 | ',(pop args) | ||
266 | ,(pop args) | ||
267 | "Set by `setc'.") | ||
268 | form)) | ||
269 | `(progn ,@(nreverse form)))) | ||
270 | 76 | ||
271 | (provide 'acdw) | 77 | (provide 'acdw) |
78 | |||
272 | ;;; acdw.el ends here | 79 | ;;; acdw.el ends here |