Fix a comment whitespace typo.
[emacs.git] / lisp / ibuf-macs.el
blob2e751cebd6ef466e845358b4f3e8aa6927605faa
1 ;;; ibuf-macs.el --- macros for ibuffer -*- lexical-binding:t -*-
3 ;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
5 ;; Author: Colin Walters <walters@verbum.org>
6 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
7 ;; Created: 6 Dec 2001
8 ;; Keywords: buffer, convenience
9 ;; Package: ibuffer
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;;; Commentary:
28 ;;; Code:
30 (eval-when-compile (require 'cl-lib))
32 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
33 (defmacro ibuffer-aif (test true-body &rest false-body)
34 "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
35 If TEST returns non-nil, bind `it' to the value, and evaluate
36 TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
37 Compare with `if'."
38 (declare (indent 2))
39 (let ((sym (make-symbol "ibuffer-aif-sym")))
40 `(let ((,sym ,test))
41 (if ,sym
42 (let ((it ,sym))
43 ,true-body)
44 (progn
45 ,@false-body)))))
47 (defmacro ibuffer-awhen (test &rest body)
48 "Evaluate BODY if TEST returns non-nil.
49 During evaluation of body, bind `it' to the value returned by TEST."
50 (declare (indent 1))
51 `(ibuffer-aif ,test
52 (progn ,@body)
53 nil))
55 (defmacro ibuffer-save-marks (&rest body)
56 "Save the marked status of the buffers and execute BODY; restore marks."
57 (declare (indent 0))
58 (let ((bufsym (make-symbol "bufsym")))
59 `(let ((,bufsym (current-buffer))
60 (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
61 (unwind-protect
62 (progn
63 (save-excursion
64 ,@body))
65 (with-current-buffer ,bufsym
66 (ibuffer-redisplay-engine
67 ;; Get rid of dead buffers
68 (delq nil
69 (mapcar #'(lambda (e) (when (buffer-live-p (car e))
70 e))
71 ibuffer-save-marks-tmp-mark-list)))
72 (ibuffer-redisplay t))))))
74 ;;;###autoload
75 (cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer
76 header-mouse-map) &rest body)
77 "Define a column SYMBOL for use with `ibuffer-formats'.
79 BODY will be called with `buffer' bound to the buffer object, and
80 `mark' bound to the current mark on the buffer. The original ibuffer
81 buffer will be bound to `ibuffer-buf'.
83 If NAME is given, it will be used as a title for the column.
84 Otherwise, the title will default to a capitalized version of the
85 SYMBOL's name. PROPS is a plist of additional properties to add to
86 the text, such as `mouse-face'. And SUMMARIZER, if given, is a
87 function which will be passed a list of all the strings in its column;
88 it should return a string to display at the bottom.
90 If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
91 title of the column.
93 Note that this macro expands into a `defun' for a function named
94 ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
95 inlined into the compiled format versions. This means that if you
96 change its definition, you should explicitly call
97 `ibuffer-recompile-formats'.
99 \(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
100 (declare (indent defun))
101 (let* ((sym (intern (concat "ibuffer-make-column-"
102 (symbol-name symbol))))
103 (bod-1 `(with-current-buffer buffer
104 ,@body))
105 (bod (if props
106 `(propertize
107 ,bod-1
108 ,@props)
109 bod-1)))
110 `(progn
111 ,(if inline
112 `(push '(,sym ,bod) ibuffer-inline-columns)
113 `(defun ,sym (buffer mark)
114 (ignore mark) ;Silence byte-compiler if mark is unused.
115 ,bod))
116 (put (quote ,sym) 'ibuffer-column-name
117 ,(if (stringp name)
118 name
119 (capitalize (symbol-name symbol))))
120 ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
121 ,(if summarizer
122 ;; Store the name of the summarizing function.
123 `(put (quote ,sym) 'ibuffer-column-summarizer
124 (quote ,summarizer)))
125 ,(if summarizer
126 ;; This will store the actual values of the column
127 ;; summary.
128 `(put (quote ,sym) 'ibuffer-column-summary nil))
129 :autoload-end)))
131 ;;;###autoload
132 (cl-defmacro define-ibuffer-sorter (name documentation
133 (&key
134 description)
135 &rest body)
136 "Define a method of sorting named NAME.
137 DOCUMENTATION is the documentation of the function, which will be called
138 `ibuffer-do-sort-by-NAME'.
139 DESCRIPTION is a short string describing the sorting method.
141 For sorting, the forms in BODY will be evaluated with `a' bound to one
142 buffer object, and `b' bound to another. BODY should return a non-nil
143 value if and only if `a' is \"less than\" `b'.
145 \(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
146 (declare (indent 1) (doc-string 2))
147 `(progn
148 (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
149 ,(or documentation "No :documentation specified for this sorting method.")
150 (interactive)
151 (setq ibuffer-sorting-mode ',name)
152 (when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
153 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
154 (ibuffer-redisplay t)
155 (setq ibuffer-last-sorting-mode ',name))
156 (push (list ',name ,description
157 #'(lambda (a b)
158 ,@body))
159 ibuffer-sorting-functions-alist)
160 :autoload-end))
162 ;;;###autoload
163 (cl-defmacro define-ibuffer-op (op args
164 documentation
165 (&key
166 interactive
167 mark
168 modifier-p
169 dangerous
170 (opstring "operated on")
171 (active-opstring "Operate on")
172 before
173 after
174 complex)
175 &rest body)
176 "Generate a function which operates on a buffer.
177 OP becomes the name of the function; if it doesn't begin with
178 `ibuffer-do-', then that is prepended to it.
179 When an operation is performed, this function will be called once for
180 each marked buffer, with that buffer current.
182 ARGS becomes the formal parameters of the function.
183 DOCUMENTATION becomes the docstring of the function.
184 INTERACTIVE becomes the interactive specification of the function.
185 MARK describes which type of mark (:deletion, or nil) this operation
186 uses. :deletion means the function operates on buffers marked for
187 deletion, otherwise it acts on normally marked buffers.
188 MODIFIER-P describes how the function modifies buffers. This is used
189 to set the modification flag of the Ibuffer buffer itself. Valid
190 values are:
191 nil - the function never modifiers buffers
192 t - the function it always modifies buffers
193 :maybe - attempt to discover this information by comparing the
194 buffer's modification flag.
195 DANGEROUS is a boolean which should be set if the user should be
196 prompted before performing this operation.
197 OPSTRING is a string which will be displayed to the user after the
198 operation is complete, in the form:
199 \"Operation complete; OPSTRING x buffers\"
200 ACTIVE-OPSTRING is a string which will be displayed to the user in a
201 confirmation message, in the form:
202 \"Really ACTIVE-OPSTRING x buffers?\"
203 BEFORE is a form to evaluate before start the operation.
204 AFTER is a form to evaluate once the operation is complete.
205 COMPLEX means this function is special; if COMPLEX is nil BODY
206 evaluates once for each marked buffer, MBUF, with MBUF current
207 and saving the point. If COMPLEX is non-nil, BODY evaluates
208 without requiring MBUF current.
209 BODY define the operation; they are forms to evaluate per each
210 marked buffer. BODY is evaluated with `buf' bound to the
211 buffer object.
213 \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)"
214 (declare (indent 2) (doc-string 3))
215 `(progn
216 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
217 "" "ibuffer-do-")
218 (symbol-name op)))
219 ,args
220 ,(if (stringp documentation)
221 documentation
222 (format "%s marked buffers." active-opstring))
223 ,(if (not (null interactive))
224 `(interactive ,interactive)
225 '(interactive))
226 (cl-assert (derived-mode-p 'ibuffer-mode))
227 (setq ibuffer-did-modification nil)
228 (let ((marked-names (,(pcase mark
229 (:deletion
230 'ibuffer-deletion-marked-buffer-names)
232 'ibuffer-marked-buffer-names)))))
233 (when (null marked-names)
234 (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
235 (ibuffer-set-mark ,(pcase mark
236 (:deletion
237 'ibuffer-deletion-char)
239 'ibuffer-marked-char))))
240 ,(let* ((finish (append
241 '(progn)
242 (if (eq modifier-p t)
243 '((setq ibuffer-did-modification t))
245 (and after `(,after)) ; post-operation form.
246 `((ibuffer-redisplay t)
247 (message ,(concat "Operation finished; " opstring " %s buffers") count))))
248 (inner-body (if complex
249 `(progn ,@body)
250 `(progn
251 (with-current-buffer buf
252 (save-excursion
253 ,@body))
254 t)))
255 (body `(let ((_ ,before) ; pre-operation form.
256 (count
257 (,(pcase mark
258 (:deletion
259 'ibuffer-map-deletion-lines)
261 'ibuffer-map-marked-lines))
262 #'(lambda (buf mark)
263 ;; Silence warning for code that doesn't
264 ;; use `mark'.
265 (ignore mark)
266 ,(if (eq modifier-p :maybe)
267 `(let ((ibuffer-tmp-previous-buffer-modification
268 (buffer-modified-p buf)))
269 (prog1 ,inner-body
270 (when (not (eq ibuffer-tmp-previous-buffer-modification
271 (buffer-modified-p buf)))
272 (setq ibuffer-did-modification t))))
273 inner-body)))))
274 ,finish)))
275 (if dangerous
276 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
277 ,body)
278 body))))
279 :autoload-end))
281 ;;;###autoload
282 (cl-defmacro define-ibuffer-filter (name documentation
283 (&key
284 reader
285 description)
286 &rest body)
287 "Define a filter named NAME.
288 DOCUMENTATION is the documentation of the function.
289 READER is a form which should read a qualifier from the user.
290 DESCRIPTION is a short string describing the filter.
292 BODY should contain forms which will be evaluated to test whether or
293 not a particular buffer should be displayed or not. The forms in BODY
294 will be evaluated with BUF bound to the buffer object, and QUALIFIER
295 bound to the current value of the filter.
297 \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
298 (declare (indent 2) (doc-string 2))
299 (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
300 `(progn
301 (defun ,fn-name (qualifier)
302 ,(or documentation "This filter is not documented.")
303 (interactive (list ,reader))
304 (ibuffer-push-filter (cons ',name qualifier))
305 (message "%s"
306 (format ,(concat (format "Filter by %s added: " description)
307 " %s")
308 qualifier))
309 (ibuffer-update nil t))
310 (push (list ',name ,description
311 (lambda (buf qualifier)
312 (condition-case nil
313 (progn ,@body)
314 (error (ibuffer-pop-filter)
315 (when (eq ',name 'predicate)
316 (error "Wrong filter predicate: %S"
317 qualifier))))))
318 ibuffer-filtering-alist)
319 :autoload-end)))
321 (provide 'ibuf-macs)
323 ;;; ibuf-macs.el ends here