diff options
Diffstat (limited to 'lisp/acdw.el')
-rw-r--r-- | lisp/acdw.el | 113 |
1 files changed, 98 insertions, 15 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 444f249..f039540 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -30,20 +30,20 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." | |||
30 | 30 | ||
31 | ;;; Convenience functions | 31 | ;;; Convenience functions |
32 | 32 | ||
33 | (defun define-keys (maps &rest keydefs) | 33 | (defun define-key* (maps &rest keydefs) |
34 | "Define KEYDEFS in MAPS. | 34 | "Define KEYDEFS in MAPS. |
35 | Convenience wrapper around `define-key'." | 35 | Convenience wrapper around `define-key'." |
36 | (unless (zerop (mod (length keydefs) 2)) | 36 | (unless (zerop (mod (length keydefs) 2)) |
37 | (user-error "Wrong number of arguments: %S" (length keydefs))) | 37 | (user-error "Wrong number of arguments: %S" (length keydefs))) |
38 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) | 38 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) |
39 | (list maps) | 39 | (list maps) |
40 | maps)) | 40 | maps)) |
41 | (cl-loop for (key def) on keydefs by #'cddr | 41 | (cl-loop for (key def) on keydefs by #'cddr |
42 | do (let ((key (if (stringp key) (kbd key) key))) | 42 | do (let ((key (if (stringp key) (kbd key) key))) |
43 | (define-key (if (symbolp map) | 43 | (define-key (if (symbolp map) |
44 | (symbol-value map) | 44 | (symbol-value map) |
45 | map) | 45 | map) |
46 | key def))))) | 46 | key def))))) |
47 | 47 | ||
48 | (unless (fboundp 'ensure-list) | 48 | (unless (fboundp 'ensure-list) |
49 | ;; Just in case we're using an old version of Emacs. | 49 | ;; Just in case we're using an old version of Emacs. |
@@ -57,10 +57,11 @@ not a list, return a one-element list containing OBJECT." | |||
57 | 57 | ||
58 | (defun add-to-list* (lists &rest things) | 58 | (defun add-to-list* (lists &rest things) |
59 | "Add THINGS to LISTS. | 59 | "Add THINGS to LISTS. |
60 | LISTS can be one list variable or a list. | 60 | LISTS can be one list variable or a list. Each thing of THINGS |
61 | Each thing of THINGS can be either a variablel (the thing), or a list of the form | 61 | can be either a variablel (the thing), or a list of the form |
62 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to | 62 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to |
63 | `add-to-list'." | 63 | `add-to-list'." |
64 | (declare (indent 1)) | ||
64 | (dolist (l (ensure-list lists)) | 65 | (dolist (l (ensure-list lists)) |
65 | (dolist (thing things) | 66 | (dolist (thing things) |
66 | (apply #'add-to-list l (ensure-list thing))))) | 67 | (apply #'add-to-list l (ensure-list thing))))) |
@@ -69,26 +70,73 @@ Each thing of THINGS can be either a variablel (the thing), or a list of the for | |||
69 | "Add FUNCTIONS to HOOKS. | 70 | "Add FUNCTIONS to HOOKS. |
70 | Each function in FUNCTIONS can be a singleton or a list of the | 71 | Each function in FUNCTIONS can be a singleton or a list of the |
71 | form (FUNCTION &optional DEPTH LOCAL)." | 72 | form (FUNCTION &optional DEPTH LOCAL)." |
73 | (declare (indent 1)) | ||
72 | (dolist (hook (ensure-list hooks)) | 74 | (dolist (hook (ensure-list hooks)) |
73 | (dolist (fn functions) | 75 | (dolist (fn functions) |
74 | (apply #'add-hook hook (ensure-list fn))))) | 76 | (apply #'add-hook hook (ensure-list fn))))) |
75 | 77 | ||
78 | (defun +concat (&rest strings) | ||
79 | "Concat STRINGS separated by SEPARATOR. | ||
80 | SEPARATOR is \"\\n\" unless the keyword argument `:separator' is | ||
81 | given, followed by the separator to use. Each item in STRINGS is | ||
82 | either a string or a list or strings, which is concatenated | ||
83 | without any separator." | ||
84 | (let (ret | ||
85 | ;; I don't know why a `cl-defun' with | ||
86 | ;; (&rest strings &key (separator "\n")) doesn't work | ||
87 | (separator (or (cl-loop for i from 0 upto (length strings) | ||
88 | if (eq (nth i strings) :separator) | ||
89 | return (nth (1+ i) strings)) | ||
90 | "\n"))) | ||
91 | (while strings | ||
92 | (let ((string (pop strings))) | ||
93 | (cond ((eq string :separator) (pop strings)) | ||
94 | ((listp string) (push (apply #'concat string) ret)) | ||
95 | ((stringp string) (push string ret))))) | ||
96 | (mapconcat #'identity (nreverse ret) separator))) | ||
97 | |||
98 | (defun require* (&rest features) | ||
99 | "Require FEATURES in order. | ||
100 | Each feature of FEATURES can also be a list of the arguments to | ||
101 | pass to `require', which see." | ||
102 | (condition-case e | ||
103 | (dolist (feature features) | ||
104 | (apply #'require (ensure-list feature))) | ||
105 | (:success (mapcar (lambda (f) (car (ensure-list f))) features)) | ||
106 | (t (signal (car e) (cdr e))))) | ||
107 | |||
76 | ;;; Convenience macros | 108 | ;;; Convenience macros |
77 | 109 | ||
110 | (defmacro define-local-before-save-hook (mode-or-hook &rest body) | ||
111 | "Add a local `before-save-hook' to MODE-OR-HOOK." | ||
112 | (declare (indent 1)) | ||
113 | (let* ((name (format "%s" mode-or-hook)) | ||
114 | (external-name (intern (format "%s@before-save" name))) | ||
115 | (internal-name (intern (format "before-save@%s" name))) | ||
116 | (hook (if (string-suffix-p "-hook" name) | ||
117 | mode-or-hook | ||
118 | (intern (format "%s-hook" name))))) | ||
119 | `(progn | ||
120 | (defun ,internal-name () | ||
121 | ,@body) | ||
122 | (defun ,external-name () | ||
123 | (add-hook 'before-save-hook #',internal-name nil :local)) | ||
124 | (add-hook ',hook #',external-name)))) | ||
125 | |||
78 | (defmacro setq-local-hook (hook &rest args) | 126 | (defmacro setq-local-hook (hook &rest args) |
79 | "Run `setq-local' on ARGS when running HOOK." | 127 | "Run `setq-local' on ARGS when running HOOK." |
80 | (declare (indent 1)) | 128 | (declare (indent 1)) |
81 | (let ((fn (intern (format "%s-setq-local" hook)))) | 129 | (let ((fn (intern (format "%s-setq-local" hook)))) |
82 | (when (and (fboundp fn) | 130 | (when (and (fboundp fn) |
83 | (functionp fn)) | 131 | (functionp fn)) |
84 | (setq args (append (function-get fn 'setq-local-hook-settings) args))) | 132 | (setf args (append (function-get fn 'setq-local-hook-settings) args))) |
85 | (unless (and (< 0 (length args)) | 133 | (unless (and (< 0 (length args)) |
86 | (zerop (mod (length args) 2))) | 134 | (zerop (mod (length args) 2))) |
87 | (user-error "Wrong number of arguments: %S" (length args))) | 135 | (user-error "Wrong number of arguments: %S" (length args))) |
88 | `(progn | 136 | `(progn |
89 | (defun ,fn () | 137 | (defun ,fn () |
90 | ,(format "Set local variables after `%s'." hook) | 138 | ,(format "Set local variables after `%s'." hook) |
91 | (setq-local ,@args)) | 139 | (setq-local ,@args)) |
92 | (function-put ',fn 'setq-local-hook-settings ',args) | 140 | (function-put ',fn 'setq-local-hook-settings ',args) |
93 | (add-hook ',hook #',fn)))) | 141 | (add-hook ',hook #',fn)))) |
94 | 142 | ||
@@ -103,3 +151,38 @@ If body executes without errors, MESSAGE...Done will be displayed." | |||
103 | ,@body) | 151 | ,@body) |
104 | (:success (message "%s...done" ,msg)) | 152 | (:success (message "%s...done" ,msg)) |
105 | (t (signal (car e) (cdr e))))))) | 153 | (t (signal (car e) (cdr e))))))) |
154 | |||
155 | ;; https://emacs.stackexchange.com/a/39324/37239 | ||
156 | ;; XXX: This shit don't work rn | ||
157 | (defun ignore-invisible-overlays (fn) | ||
158 | "Execute FN, ignoring invisible overlays. | ||
159 | FN should return a point." | ||
160 | (let ((overlay nil) | ||
161 | (point nil)) | ||
162 | (setq point (and (funcall fn) (point))) | ||
163 | (setq overlay (car (overlays-at (point)))) | ||
164 | (while (and overlay (member 'invisible (overlay-properties overlay))) | ||
165 | (goto-char (overlay-end overlay)) | ||
166 | (setq point (and (funcall fn) (point))) | ||
167 | (setq overlay (car (overlays-at (point))))) | ||
168 | point)) | ||
169 | |||
170 | ;;; Extras | ||
171 | ;; Trying to avoid a whole install of crux ... | ||
172 | |||
173 | (defun kill-and-join-forward (&optional arg) | ||
174 | "Kill the line or, if at the end of a line, join with the next. | ||
175 | This command is `visual-line-mode'-aware. If ARG is provided, | ||
176 | it's passed on to kill a line, but not to delete indentation. | ||
177 | When joining, this command deletes whitespace." | ||
178 | (interactive "P") | ||
179 | (if (and (eolp) (not (bolp))) | ||
180 | (delete-indentation 1) | ||
181 | (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) | ||
182 | |||
183 | (defun other-window|switch-buffer () | ||
184 | "Call `other-window' or `switch-buffer' depending on windows." | ||
185 | (interactive) | ||
186 | (if (one-window-p) | ||
187 | (switch-to-buffer nil) | ||
188 | (other-window 1))) | ||