diff options
Diffstat (limited to 'lisp/acdw.el')
-rw-r--r-- | lisp/acdw.el | 129 |
1 files changed, 129 insertions, 0 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 6729759..a05295c 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -85,5 +85,134 @@ If `:separator' is the first of STRINGS, the next string will be | |||
85 | used as a separator." | 85 | used as a separator." |
86 | (++concat #'format strings)) | 86 | (++concat #'format strings)) |
87 | 87 | ||
88 | (defun mapc-buffers (func &optional predicate) | ||
89 | "Map FUNC over buffers matching PREDICATE. | ||
90 | Both FUNC and PREDICATE will be executed with no arguments and in | ||
91 | the context of each buffer. | ||
92 | |||
93 | If PREDICATE is nil or not given, map FUNC over all buffers." | ||
94 | (cl-loop for buf being the buffers | ||
95 | do (with-current-buffer buf | ||
96 | (when (and predicate | ||
97 | (funcall predicate)) | ||
98 | (funcall func))))) | ||
99 | |||
100 | (defun mapc-buffers-modes (func &rest modes) | ||
101 | "Map FUNC over buffers derived from MODES. | ||
102 | FUNC will be executed with no arguments and in the context of | ||
103 | each buffer." | ||
104 | (mapc-buffers func | ||
105 | (lambda () | ||
106 | (apply #'derived-mode-p modes)))) | ||
107 | |||
108 | (defun find-font (&rest fonts) | ||
109 | "Return the first font of FONTS that is installed." | ||
110 | (cl-loop with ffl = (font-family-list) | ||
111 | for font in fonts | ||
112 | if (member font ffl) | ||
113 | return font)) | ||
114 | |||
115 | (defmacro progress@around (fn message &optional name) | ||
116 | "Define :around advice for functions adding a simple progress reporter." | ||
117 | (let ((orig (gensym)) | ||
118 | (args (gensym)) | ||
119 | (prog (gensym))) | ||
120 | `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress)) | ||
121 | ,(format "Add a simple progress reporter to %s." fn) | ||
122 | (let ((,prog (make-progress-reporter | ||
123 | ,(format "%s..." (string-remove-suffix "..." message))))) | ||
124 | (apply ,orig ,args) | ||
125 | (progress-reporter-done ,prog))))) | ||
126 | |||
127 | |||
128 | ;;; Comment-or-uncomment-sexp | ||
129 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | ||
130 | |||
131 | (defun +lisp-uncomment-sexp (&optional n) | ||
132 | "Uncomment N sexps around point." | ||
133 | (interactive "P") | ||
134 | (let* ((initial-point (point-marker)) | ||
135 | (inhibit-field-text-motion t) | ||
136 | (p) | ||
137 | (end (save-excursion | ||
138 | (when (elt (syntax-ppss) 4) | ||
139 | (re-search-backward comment-start-skip | ||
140 | (line-beginning-position) | ||
141 | t)) | ||
142 | (setq p (point-marker)) | ||
143 | (comment-forward (point-max)) | ||
144 | (point-marker))) | ||
145 | (beg (save-excursion | ||
146 | (forward-line 0) | ||
147 | (while (and (not (bobp)) | ||
148 | (= end (save-excursion | ||
149 | (comment-forward (point-max)) | ||
150 | (point)))) | ||
151 | (forward-line -1)) | ||
152 | (goto-char (line-end-position)) | ||
153 | (re-search-backward comment-start-skip | ||
154 | (line-beginning-position) | ||
155 | t) | ||
156 | (ignore-errors | ||
157 | (while (looking-at-p comment-start-skip) | ||
158 | (forward-char -1))) | ||
159 | (point-marker)))) | ||
160 | (unless (= beg end) | ||
161 | (uncomment-region beg end) | ||
162 | (goto-char p) | ||
163 | ;; Indentify the "top-level" sexp inside the comment. | ||
164 | (while (and (ignore-errors (backward-up-list) t) | ||
165 | (>= (point) beg)) | ||
166 | (skip-chars-backward (rx (syntax expression-prefix))) | ||
167 | (setq p (point-marker))) | ||
168 | ;; Re-comment everything before it. | ||
169 | (ignore-errors | ||
170 | (comment-region beg p)) | ||
171 | ;; And everything after it. | ||
172 | (goto-char p) | ||
173 | (forward-sexp (or n 1)) | ||
174 | (skip-chars-forward "\r\n[:blank:]") | ||
175 | (if (< (point) end) | ||
176 | (ignore-errors | ||
177 | (comment-region (point) end)) | ||
178 | ;; If this is a closing delimiter, pull it up. | ||
179 | (goto-char end) | ||
180 | (skip-chars-forward "\r\n[:blank:]") | ||
181 | (when (eq 5 (car (syntax-after (point)))) | ||
182 | (delete-indentation)))) | ||
183 | ;; Without a prefix, it's more useful to leave point where | ||
184 | ;; it was. | ||
185 | (unless n | ||
186 | (goto-char initial-point)))) | ||
187 | |||
188 | (defun +lisp-comment-sexp--raw () | ||
189 | "Comment the sexp at point or ahead of point." | ||
190 | (pcase (or (bounds-of-thing-at-point 'sexp) | ||
191 | (save-excursion | ||
192 | (skip-chars-forward "\r\n[:blank:]") | ||
193 | (bounds-of-thing-at-point 'sexp))) | ||
194 | (`(,l . ,r) | ||
195 | (goto-char r) | ||
196 | (skip-chars-forward "\r\n[:blank:]") | ||
197 | (save-excursion | ||
198 | (comment-region l r)) | ||
199 | (skip-chars-forward "\r\n[:blank:]")))) | ||
200 | |||
201 | (defun +lisp-comment-or-uncomment-sexp (&optional n) | ||
202 | "Comment the sexp at point and move past it. | ||
203 | If already inside (or before) a comment, uncomment instead. | ||
204 | With a prefix argument N, (un)comment that many sexps." | ||
205 | (interactive "P") | ||
206 | (if (or (elt (syntax-ppss) 4) | ||
207 | (< (save-excursion | ||
208 | (skip-chars-forward "\r\n[:blank:]") | ||
209 | (point)) | ||
210 | (save-excursion | ||
211 | (comment-forward 1) | ||
212 | (point)))) | ||
213 | (+lisp-uncomment-sexp n) | ||
214 | (dotimes (_ (or n 1)) | ||
215 | (+lisp-comment-sexp--raw)))) | ||
216 | |||
88 | (provide 'acdw) | 217 | (provide 'acdw) |
89 | ;;; acdw.el ends here | 218 | ;;; acdw.el ends here |