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