1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*-
;; by C. Duckworth <acdw@acdw.net>
(provide 'acdw)
(require 'cl-lib)
;;; Define both a directory and a function expanding to a file in that directory
(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
"Define a variable and function NAME expanding to DIRECTORY.
DOCSTRING is applied to the variable. Ensure DIRECTORY exists in
the filesystem, unless INHIBIT-MKDIR is non-nil."
(declare (indent 2)
(doc-string 3))
(unless inhibit-mkdir
(make-directory (eval directory) :parents))
`(progn
(defvar ,name ,directory
,(concat docstring (when docstring "\n")
"Defined by `/define-dir'."))
(defun ,name (file &optional mkdir)
,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
"If MKDIR is non-nil, the directory is created.\n"
"Defined by `/define-dir'.")
(let ((file-name (expand-file-name (convert-standard-filename file)
,name)))
(when mkdir
(make-directory (file-name-directory file-name) :parents))
file-name))))
;;; Evaluating things after other things
(defun eval-after-init (fn)
"Evaluate FN after inititation, or now if Emacs is initialized.
FN is called with no arguments."
(if after-init-time
(funcall fn)
(add-hook 'after-init-hook fn)))
(defmacro eval-after (features &rest body)
"Evaluate BODY, but only after loading FEATURES.
FEATURES can be an atom or a list; as an atom it works like
`with-eval-after-load'. The special feature `init' will evaluate
BODY after Emacs is finished initializing."
(declare (indent 1)
(debug (form def-body)))
(unless (listp features)
(setf features (list features)))
(if (null features)
(macroexp-progn body)
(let* ((this (car features))
(rest (cdr features)))
(cond ((eq this 'init)
`(eval-after-init
(lambda () (eval-after ,rest ,@body))))
(:else
`(with-eval-after-load ',this
(eval-after ,rest ,@body)))))))
;;; Convenience functions
(defun define-key* (maps &rest keydefs)
"Define KEYDEFS in MAPS.
Convenience wrapper around `define-key'."
(unless (zerop (mod (length keydefs) 2))
(user-error "Wrong number of arguments: %S" (length keydefs)))
(dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
(list maps)
maps))
(cl-loop for (key def) on keydefs by #'cddr
do (let ((key (if (stringp key) (kbd key) key)))
(define-key (if (symbolp map)
(symbol-value map)
map)
key def)))))
(unless (fboundp 'ensure-list)
;; Just in case we're using an old version of Emacs.
(defun ensure-list (object)
"Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself. If it's
not a list, return a one-element list containing OBJECT."
(if (listp object)
object
(list object))))
(defun add-to-list* (lists &rest things)
"Add THINGS to LISTS.
LISTS can be one list variable or a list. Each thing of THINGS
can be either a variable (the thing), or a list of the form
(ELEMENT &optional APPEND COMPARE-FN), which is passed to
`add-to-list'."
(declare (indent 1))
(dolist (l (ensure-list lists))
(dolist (thing things)
(apply #'add-to-list l (ensure-list thing)))))
(defun add-hook* (hooks &rest functions)
"Add FUNCTIONS to HOOKS.
Each function in FUNCTIONS can be a singleton or a list of the
form (FUNCTION &optional DEPTH LOCAL)."
(declare (indent 1))
(dolist (hook (ensure-list hooks))
(dolist (fn functions)
(apply #'add-hook hook (ensure-list fn)))))
(defun +concat (&rest strings)
"Concat STRINGS separated by SEPARATOR.
SEPARATOR is \"\\n\" unless the keyword argument `:separator' is
given, followed by the separator to use. Each item in STRINGS is
either a string or a list or strings, which is concatenated
without any separator."
(let (ret
;; I don't know why a `cl-defun' with
;; (&rest strings &key (separator "\n")) doesn't work
(separator (or (cl-loop for i from 0 upto (length strings)
if (eq (nth i strings) :separator)
return (nth (1+ i) strings))
"\n")))
(while strings
(let ((string (pop strings)))
(cond ((eq string :separator) (pop strings))
((listp string) (push (apply #'concat string) ret))
((stringp string) (push string ret)))))
(mapconcat #'identity (nreverse ret) separator)))
(defun require* (&rest features)
"Require FEATURES in order.
Each feature of FEATURES can also be a list of the arguments to
pass to `require', which see."
(condition-case e
(dolist (feature features)
(apply #'require (ensure-list feature)))
(:success (mapcar (lambda (f) (car (ensure-list f))) features))
(t (signal (car e) (cdr e)))))
;;; Convenience macros
(defmacro define-local-before-save-hook (mode-or-hook &rest body)
"Add a local `before-save-hook' to MODE-OR-HOOK."
(declare (indent 1))
(let* ((name (format "%s" mode-or-hook))
(external-name (intern (format "%s@before-save" name)))
(internal-name (intern (format "before-save@%s" name)))
(hook (if (string-suffix-p "-hook" name)
mode-or-hook
(intern (format "%s-hook" name)))))
`(progn
(defun ,internal-name ()
,@body)
(defun ,external-name ()
(add-hook 'before-save-hook #',internal-name nil :local))
(add-hook ',hook #',external-name))))
(defmacro setq-local-hook (hook &rest args)
"Run `setq-local' on ARGS when running HOOK."
(declare (indent 1))
(let ((fn (intern (format "%s-setq-local" hook))))
(when (and (fboundp fn)
(functionp fn))
(setf args (append (function-get fn 'setq-local-hook-settings) args)))
(unless (and (< 0 (length args))
(zerop (mod (length args) 2)))
(user-error "Wrong number of arguments: %S" (length args)))
`(progn
(defun ,fn ()
,(format "Set local variables after `%s'." hook)
(setq-local ,@args))
(function-put ',fn 'setq-local-hook-settings ',args)
(add-hook ',hook #',fn))))
(defmacro with-message (message &rest body)
"Execute BODY, with MESSAGE.
If body executes without errors, MESSAGE...Done will be displayed."
(declare (indent 1))
(let ((msg (gensym)))
`(let ((,msg ,message))
(condition-case e
(progn (message "%s..." ,msg)
,@body)
(:success (message "%s...done" ,msg))
(t (signal (car e) (cdr e)))))))
;; https://emacs.stackexchange.com/a/39324/37239
;; XXX: This shit don't work rn
(defun ignore-invisible-overlays (fn)
"Execute FN, ignoring invisible overlays.
FN should return a point."
(let ((overlay nil)
(point nil))
(setq point (and (funcall fn) (point)))
(setq overlay (car (overlays-at (point))))
(while (and overlay (member 'invisible (overlay-properties overlay)))
(goto-char (overlay-end overlay))
(setq point (and (funcall fn) (point)))
(setq overlay (car (overlays-at (point)))))
point))
;;; Extras
;; Trying to avoid a whole install of crux ...
(defun kill-and-join-forward (&optional arg)
"Kill the line or, if at the end of a line, join with the next.
This command is `visual-line-mode'-aware. If ARG is provided,
it's passed on to kill a line, but not to delete indentation.
When joining, this command deletes whitespace."
(interactive "P")
(if (and (eolp) (not (bolp)))
(delete-indentation 1)
(funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
(defun other-window|switch-buffer (arg)
"Call `other-window' or `switch-buffer' depending on windows.
When called with prefix ARG, unconditionally switch buffer."
(interactive "P")
(if (or arg (one-window-p))
(switch-to-buffer (other-buffer) nil t)
(other-window 1)))
|
