Bug fix for vc-dispatcher split.
[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,
409cc4a3 4;; 2005, 2006, 2007, 2008 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
b4aa6026 15;; published by the Free Software Foundation; either version 3, or (at
25d2f683
CW
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
f0b31589
DN
78(defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
79 header-mouse-map) &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 92
b641fbd7
DN
93If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
94title of the column.
95
25d2f683
CW
96Note that this macro expands into a `defun' for a function named
97ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
98inlined into the compiled format versions. This means that if you
99change its definition, you should explicitly call
9bb69f45
JB
100`ibuffer-recompile-formats'.
101
102\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
25d2f683
CW
103 (let* ((sym (intern (concat "ibuffer-make-column-"
104 (symbol-name symbol))))
ceb44935 105 (bod-1 `(with-current-buffer buffer
25d2f683
CW
106 ,@body))
107 (bod (if props
108 `(propertize
109 ,bod-1
110 ,@props)
111 bod-1)))
112 `(progn
113 ,(if inline
114 `(push '(,sym ,bod) ibuffer-inline-columns)
d62920ca 115 `(defun ,sym (buffer mark)
25d2f683
CW
116 ,bod))
117 (put (quote ,sym) 'ibuffer-column-name
118 ,(if (stringp name)
119 name
120 (capitalize (symbol-name symbol))))
f0b31589 121 ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
1255dfe6 122 ,(if summarizer
ceb44935 123 ;; Store the name of the summarizing function.
1255dfe6
CW
124 `(put (quote ,sym) 'ibuffer-column-summarizer
125 (quote ,summarizer)))
126 ,(if summarizer
ceb44935
CW
127 ;; This will store the actual values of the column
128 ;; summary.
129 `(put (quote ,sym) 'ibuffer-column-summary nil))
25d2f683
CW
130 :autoload-end)))
131;; (put 'define-ibuffer-column 'lisp-indent-function 'defun)
132
133;;;###autoload
134(defmacro* define-ibuffer-sorter (name documentation
71296446 135 (&key
25d2f683
CW
136 description)
137 &rest body)
138 "Define a method of sorting named NAME.
139DOCUMENTATION is the documentation of the function, which will be called
140`ibuffer-do-sort-by-NAME'.
141DESCRIPTION is a short string describing the sorting method.
142
143For sorting, the forms in BODY will be evaluated with `a' bound to one
144buffer object, and `b' bound to another. BODY should return a non-nil
9bb69f45
JB
145value if and only if `a' is \"less than\" `b'.
146
147\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
25d2f683
CW
148 `(progn
149 (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
150 ,(or documentation "No :documentation specified for this sorting method.")
151 (interactive)
152 (setq ibuffer-sorting-mode ',name)
e3b71439
JPW
153 (when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
154 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
155 (ibuffer-redisplay t)
156 (setq ibuffer-last-sorting-mode ',name))
25d2f683
CW
157 (push (list ',name ,description
158 #'(lambda (a b)
159 ,@body))
160 ibuffer-sorting-functions-alist)
161 :autoload-end))
162;; (put 'define-ibuffer-sorter 'lisp-indent-function 1)
163
164;;;###autoload
165(defmacro* define-ibuffer-op (op args
166 documentation
71296446 167 (&key
25d2f683
CW
168 interactive
169 mark
170 modifier-p
171 dangerous
172 (opstring "operated on")
173 (active-opstring "Operate on")
174 complex)
175 &rest body)
1bb57048
CW
176 "Generate a function which operates on a buffer.
177OP becomes the name of the function; if it doesn't begin with
178`ibuffer-do-', then that is prepended to it.
25d2f683
CW
179When an operation is performed, this function will be called once for
180each marked buffer, with that buffer current.
181
182ARGS becomes the formal parameters of the function.
183DOCUMENTATION becomes the docstring of the function.
184INTERACTIVE becomes the interactive specification of the function.
185MARK describes which type of mark (:deletion, or nil) this operation
186uses. :deletion means the function operates on buffers marked for
187deletion, otherwise it acts on normally marked buffers.
188MODIFIER-P describes how the function modifies buffers. This is used
189to set the modification flag of the Ibuffer buffer itself. Valid
190values 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.
195DANGEROUS is a boolean which should be set if the user should be
196prompted before performing this operation.
197OPSTRING is a string which will be displayed to the user after the
198operation is complete, in the form:
199 \"Operation complete; OPSTRING x buffers\"
200ACTIVE-OPSTRING is a string which will be displayed to the user in a
201confirmation message, in the form:
202 \"Really ACTIVE-OPSTRING x buffers?\"
203COMPLEX means this function is special; see the source code of this
9bb69f45
JB
204macro for exactly what it does.
205
206\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
25d2f683 207 `(progn
1bb57048
CW
208 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
209 "" "ibuffer-do-") (symbol-name op)))
210 ,args
25d2f683
CW
211 ,(if (stringp documentation)
212 documentation
213 (format "%s marked buffers." active-opstring))
214 ,(if (not (null interactive))
215 `(interactive ,interactive)
216 '(interactive))
217 (assert (eq major-mode 'ibuffer-mode))
218 (setq ibuffer-did-modification nil)
219 (let ((marked-names (,(case mark
220 (:deletion
221 'ibuffer-deletion-marked-buffer-names)
222 (t
223 'ibuffer-marked-buffer-names)))))
224 (when (null marked-names)
225 (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
226 (ibuffer-set-mark ,(case mark
227 (:deletion
228 'ibuffer-deletion-char)
229 (t
230 'ibuffer-marked-char))))
231 ,(let* ((finish (append
232 '(progn)
233 (if (eq modifier-p t)
234 '((setq ibuffer-did-modification t))
235 ())
236 `((ibuffer-redisplay t)
237 (message ,(concat "Operation finished; " opstring " %s buffers") count))))
238 (inner-body (if complex
239 `(progn ,@body)
240 `(progn
241 (with-current-buffer buf
242 (save-excursion
243 ,@body))
244 t)))
245 (body `(let ((count
246 (,(case mark
247 (:deletion
248 'ibuffer-map-deletion-lines)
249 (t
250 'ibuffer-map-marked-lines))
bde57911 251 #'(lambda (buf mark)
25d2f683
CW
252 ,(if (eq modifier-p :maybe)
253 `(let ((ibuffer-tmp-previous-buffer-modification
254 (buffer-modified-p buf)))
255 (prog1 ,inner-body
256 (when (not (eq ibuffer-tmp-previous-buffer-modification
257 (buffer-modified-p buf)))
258 (setq ibuffer-did-modification t))))
259 inner-body)))))
260 ,finish)))
261 (if dangerous
262 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
263 ,body)
264 body))))
265 :autoload-end))
266;; (put 'define-ibuffer-op 'lisp-indent-function 2)
267
268;;;###autoload
269(defmacro* define-ibuffer-filter (name documentation
71296446 270 (&key
25d2f683
CW
271 reader
272 description)
273 &rest body)
274 "Define a filter named NAME.
275DOCUMENTATION is the documentation of the function.
276READER is a form which should read a qualifier from the user.
277DESCRIPTION is a short string describing the filter.
278
279BODY should contain forms which will be evaluated to test whether or
280not a particular buffer should be displayed or not. The forms in BODY
281will be evaluated with BUF bound to the buffer object, and QUALIFIER
9bb69f45
JB
282bound to the current value of the filter.
283
284\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
25d2f683 285 (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
71296446 286 `(progn
25d2f683
CW
287 (defun ,fn-name (qualifier)
288 ,(concat (or documentation "This filter is not documented."))
289 (interactive (list ,reader))
290 (ibuffer-push-filter (cons ',name qualifier))
8a26c165 291 (message "%s"
25d2f683
CW
292 (format ,(concat (format "Filter by %s added: " description)
293 " %s")
294 qualifier))
295 (ibuffer-update nil t))
296 (push (list ',name ,description
297 #'(lambda (buf qualifier)
298 ,@body))
299 ibuffer-filtering-alist)
300 :autoload-end)))
301;; (put 'define-ibuffer-filter 'lisp-indent-function 2)
302
303(provide 'ibuf-macs)
304
cbee283d 305;; arch-tag: 2748edce-82c9-4cd9-9d9d-bd73e43c20c5
25d2f683 306;;; ibuf-macs.el ends here