Update copyright year to 2014 by running admin/update-copyright.
[bpt/emacs.git] / lisp / ibuf-macs.el
CommitLineData
25d2f683
CW
1;;; ibuf-macs.el --- macros for ibuffer
2
ba318903 3;; Copyright (C) 2000-2014 Free Software Foundation, Inc.
25d2f683
CW
4
5;; Author: Colin Walters <walters@verbum.org>
4e4a724c 6;; Maintainer: John Paul Wallington <jpw@gnu.org>
25d2f683 7;; Created: 6 Dec 2001
25d2f683 8;; Keywords: buffer, convenience
aad4679e 9;; Package: ibuffer
25d2f683 10
76649361 11;; This file is part of GNU Emacs.
25d2f683 12
eb3fa2cf
GM
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.
25d2f683 17
eb3fa2cf
GM
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.
25d2f683
CW
22
23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25d2f683 25
30764597
PJ
26;;; Commentary:
27
25d2f683
CW
28;;; Code:
29
a464a6c7 30(eval-when-compile (require 'cl-lib))
00332656 31
25d2f683
CW
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.
35If TEST returns non-nil, bind `it' to the value, and evaluate
36TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
37Compare with `if'."
4e02f55c 38 (declare (indent 2))
28528604 39 (let ((sym (make-symbol "ibuffer-aif-sym")))
25d2f683
CW
40 `(let ((,sym ,test))
41 (if ,sym
42 (let ((it ,sym))
43 ,true-body)
44 (progn
45 ,@false-body)))))
25d2f683
CW
46
47(defmacro ibuffer-awhen (test &rest body)
48 "Evaluate BODY if TEST returns non-nil.
49During evaluation of body, bind `it' to the value returned by TEST."
4e02f55c 50 (declare (indent 1))
25d2f683
CW
51 `(ibuffer-aif ,test
52 (progn ,@body)
53 nil))
25d2f683
CW
54
55(defmacro ibuffer-save-marks (&rest body)
56 "Save the marked status of the buffers and execute BODY; restore marks."
4e02f55c 57 (declare (indent 0))
28528604 58 (let ((bufsym (make-symbol "bufsym")))
25d2f683
CW
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
76649361 66 (ibuffer-redisplay-engine
25d2f683
CW
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))))))
25d2f683
CW
73
74;;;###autoload
a464a6c7 75(cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer
f0b31589 76 header-mouse-map) &rest body)
25d2f683
CW
77 "Define a column SYMBOL for use with `ibuffer-formats'.
78
79BODY will be called with `buffer' bound to the buffer object, and
1bb57048
CW
80`mark' bound to the current mark on the buffer. The original ibuffer
81buffer will be bound to `ibuffer-buf'.
25d2f683
CW
82
83If NAME is given, it will be used as a title for the column.
84Otherwise, the title will default to a capitalized version of the
85SYMBOL's name. PROPS is a plist of additional properties to add to
1255dfe6
CW
86the text, such as `mouse-face'. And SUMMARIZER, if given, is a
87function which will be passed a list of all the strings in its column;
88it should return a string to display at the bottom.
25d2f683 89
b641fbd7
DN
90If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
91title of the column.
92
25d2f683
CW
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)"
4e02f55c 100 (declare (indent defun))
25d2f683
CW
101 (let* ((sym (intern (concat "ibuffer-make-column-"
102 (symbol-name symbol))))
ceb44935 103 (bod-1 `(with-current-buffer buffer
25d2f683
CW
104 ,@body))
105 (bod (if props
4e02f55c
JPW
106 `(propertize
107 ,bod-1
108 ,@props)
25d2f683
CW
109 bod-1)))
110 `(progn
111 ,(if inline
112 `(push '(,sym ,bod) ibuffer-inline-columns)
d62920ca 113 `(defun ,sym (buffer mark)
25d2f683
CW
114 ,bod))
115 (put (quote ,sym) 'ibuffer-column-name
116 ,(if (stringp name)
117 name
118 (capitalize (symbol-name symbol))))
f0b31589 119 ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
1255dfe6 120 ,(if summarizer
ceb44935 121 ;; Store the name of the summarizing function.
1255dfe6
CW
122 `(put (quote ,sym) 'ibuffer-column-summarizer
123 (quote ,summarizer)))
124 ,(if summarizer
ceb44935
CW
125 ;; This will store the actual values of the column
126 ;; summary.
127 `(put (quote ,sym) 'ibuffer-column-summary nil))
25d2f683 128 :autoload-end)))
25d2f683
CW
129
130;;;###autoload
a464a6c7 131(cl-defmacro define-ibuffer-sorter (name documentation
71296446 132 (&key
25d2f683
CW
133 description)
134 &rest body)
135 "Define a method of sorting named NAME.
136DOCUMENTATION is the documentation of the function, which will be called
137`ibuffer-do-sort-by-NAME'.
138DESCRIPTION is a short string describing the sorting method.
139
140For sorting, the forms in BODY will be evaluated with `a' bound to one
141buffer object, and `b' bound to another. BODY should return a non-nil
9bb69f45
JB
142value if and only if `a' is \"less than\" `b'.
143
144\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
b581bb5c 145 (declare (indent 1) (doc-string 2))
25d2f683
CW
146 `(progn
147 (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
148 ,(or documentation "No :documentation specified for this sorting method.")
149 (interactive)
150 (setq ibuffer-sorting-mode ',name)
e3b71439
JPW
151 (when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
152 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
153 (ibuffer-redisplay t)
154 (setq ibuffer-last-sorting-mode ',name))
25d2f683
CW
155 (push (list ',name ,description
156 #'(lambda (a b)
157 ,@body))
158 ibuffer-sorting-functions-alist)
159 :autoload-end))
25d2f683
CW
160
161;;;###autoload
a464a6c7 162(cl-defmacro define-ibuffer-op (op args
25d2f683 163 documentation
71296446 164 (&key
25d2f683
CW
165 interactive
166 mark
167 modifier-p
168 dangerous
169 (opstring "operated on")
170 (active-opstring "Operate on")
171 complex)
172 &rest body)
1bb57048
CW
173 "Generate a function which operates on a buffer.
174OP becomes the name of the function; if it doesn't begin with
175`ibuffer-do-', then that is prepended to it.
25d2f683
CW
176When an operation is performed, this function will be called once for
177each marked buffer, with that buffer current.
178
179ARGS becomes the formal parameters of the function.
180DOCUMENTATION becomes the docstring of the function.
181INTERACTIVE becomes the interactive specification of the function.
182MARK describes which type of mark (:deletion, or nil) this operation
183uses. :deletion means the function operates on buffers marked for
184deletion, otherwise it acts on normally marked buffers.
185MODIFIER-P describes how the function modifies buffers. This is used
186to set the modification flag of the Ibuffer buffer itself. Valid
187values are:
188 nil - the function never modifiers buffers
189 t - the function it always modifies buffers
190 :maybe - attempt to discover this information by comparing the
191 buffer's modification flag.
192DANGEROUS is a boolean which should be set if the user should be
193prompted before performing this operation.
194OPSTRING is a string which will be displayed to the user after the
195operation is complete, in the form:
196 \"Operation complete; OPSTRING x buffers\"
197ACTIVE-OPSTRING is a string which will be displayed to the user in a
198confirmation message, in the form:
199 \"Really ACTIVE-OPSTRING x buffers?\"
200COMPLEX means this function is special; see the source code of this
9bb69f45
JB
201macro for exactly what it does.
202
203\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
b581bb5c 204 (declare (indent 2) (doc-string 3))
25d2f683 205 `(progn
4e02f55c
JPW
206 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
207 "" "ibuffer-do-") (symbol-name op)))
208 ,args
209 ,(if (stringp documentation)
210 documentation
211 (format "%s marked buffers." active-opstring))
212 ,(if (not (null interactive))
213 `(interactive ,interactive)
214 '(interactive))
a464a6c7 215 (cl-assert (derived-mode-p 'ibuffer-mode))
4e02f55c 216 (setq ibuffer-did-modification nil)
a464a6c7 217 (let ((marked-names (,(pcase mark
4e02f55c
JPW
218 (:deletion
219 'ibuffer-deletion-marked-buffer-names)
a464a6c7 220 (_
4e02f55c
JPW
221 'ibuffer-marked-buffer-names)))))
222 (when (null marked-names)
223 (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
a464a6c7 224 (ibuffer-set-mark ,(pcase mark
4e02f55c
JPW
225 (:deletion
226 'ibuffer-deletion-char)
a464a6c7 227 (_
4e02f55c
JPW
228 'ibuffer-marked-char))))
229 ,(let* ((finish (append
230 '(progn)
231 (if (eq modifier-p t)
232 '((setq ibuffer-did-modification t))
233 ())
234 `((ibuffer-redisplay t)
235 (message ,(concat "Operation finished; " opstring " %s buffers") count))))
236 (inner-body (if complex
237 `(progn ,@body)
238 `(progn
239 (with-current-buffer buf
240 (save-excursion
241 ,@body))
242 t)))
243 (body `(let ((count
a464a6c7 244 (,(pcase mark
4e02f55c
JPW
245 (:deletion
246 'ibuffer-map-deletion-lines)
a464a6c7 247 (_
4e02f55c
JPW
248 'ibuffer-map-marked-lines))
249 #'(lambda (buf mark)
250 ,(if (eq modifier-p :maybe)
251 `(let ((ibuffer-tmp-previous-buffer-modification
252 (buffer-modified-p buf)))
253 (prog1 ,inner-body
254 (when (not (eq ibuffer-tmp-previous-buffer-modification
255 (buffer-modified-p buf)))
256 (setq ibuffer-did-modification t))))
257 inner-body)))))
258 ,finish)))
259 (if dangerous
260 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
261 ,body)
262 body))))
263 :autoload-end))
25d2f683
CW
264
265;;;###autoload
a464a6c7 266(cl-defmacro define-ibuffer-filter (name documentation
71296446 267 (&key
25d2f683
CW
268 reader
269 description)
270 &rest body)
271 "Define a filter named NAME.
272DOCUMENTATION is the documentation of the function.
273READER is a form which should read a qualifier from the user.
274DESCRIPTION is a short string describing the filter.
275
276BODY should contain forms which will be evaluated to test whether or
277not a particular buffer should be displayed or not. The forms in BODY
278will be evaluated with BUF bound to the buffer object, and QUALIFIER
9bb69f45
JB
279bound to the current value of the filter.
280
281\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
b581bb5c 282 (declare (indent 2) (doc-string 2))
25d2f683 283 (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
71296446 284 `(progn
25d2f683 285 (defun ,fn-name (qualifier)
4e02f55c 286 ,(or documentation "This filter is not documented.")
25d2f683
CW
287 (interactive (list ,reader))
288 (ibuffer-push-filter (cons ',name qualifier))
8a26c165 289 (message "%s"
4e02f55c
JPW
290 (format ,(concat (format "Filter by %s added: " description)
291 " %s")
292 qualifier))
25d2f683
CW
293 (ibuffer-update nil t))
294 (push (list ',name ,description
295 #'(lambda (buf qualifier)
296 ,@body))
297 ibuffer-filtering-alist)
298 :autoload-end)))
25d2f683
CW
299
300(provide 'ibuf-macs)
301
302;;; ibuf-macs.el ends here