Silence nnir.el compilation.
[emacs.git] / lisp / ibuf-macs.el
blob684cfe8f51b6aee300a0dd6e20fa8bc85294f1b2
1 ;;; ibuf-macs.el --- macros for ibuffer
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Colin Walters <walters@verbum.org>
7 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
8 ;; Created: 6 Dec 2001
9 ;; Keywords: buffer, convenience
10 ;; Package: ibuffer
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Commentary:
29 ;;; Code:
31 (eval-when-compile
32 (require 'cl))
34 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
35 (defmacro ibuffer-aif (test true-body &rest false-body)
36 "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
37 If TEST returns non-nil, bind `it' to the value, and evaluate
38 TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
39 Compare with `if'."
40 (declare (indent 2))
41 (let ((sym (make-symbol "ibuffer-aif-sym")))
42 `(let ((,sym ,test))
43 (if ,sym
44 (let ((it ,sym))
45 ,true-body)
46 (progn
47 ,@false-body)))))
49 (defmacro ibuffer-awhen (test &rest body)
50 "Evaluate BODY if TEST returns non-nil.
51 During evaluation of body, bind `it' to the value returned by TEST."
52 (declare (indent 1))
53 `(ibuffer-aif ,test
54 (progn ,@body)
55 nil))
57 (defmacro ibuffer-save-marks (&rest body)
58 "Save the marked status of the buffers and execute BODY; restore marks."
59 (declare (indent 0))
60 (let ((bufsym (make-symbol "bufsym")))
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
68 (ibuffer-redisplay-engine
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))))))
76 ;;;###autoload
77 (defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
78 header-mouse-map) &rest body)
79 "Define a column SYMBOL for use with `ibuffer-formats'.
81 BODY will be called with `buffer' bound to the buffer object, and
82 `mark' bound to the current mark on the buffer. The original ibuffer
83 buffer will be bound to `ibuffer-buf'.
85 If NAME is given, it will be used as a title for the column.
86 Otherwise, the title will default to a capitalized version of the
87 SYMBOL's name. PROPS is a plist of additional properties to add to
88 the text, such as `mouse-face'. And SUMMARIZER, if given, is a
89 function which will be passed a list of all the strings in its column;
90 it should return a string to display at the bottom.
92 If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
93 title of the column.
95 Note that this macro expands into a `defun' for a function named
96 ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
97 inlined into the compiled format versions. This means that if you
98 change its definition, you should explicitly call
99 `ibuffer-recompile-formats'.
101 \(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
102 (declare (indent defun))
103 (let* ((sym (intern (concat "ibuffer-make-column-"
104 (symbol-name symbol))))
105 (bod-1 `(with-current-buffer buffer
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)
115 `(defun ,sym (buffer mark)
116 ,bod))
117 (put (quote ,sym) 'ibuffer-column-name
118 ,(if (stringp name)
119 name
120 (capitalize (symbol-name symbol))))
121 ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
122 ,(if summarizer
123 ;; Store the name of the summarizing function.
124 `(put (quote ,sym) 'ibuffer-column-summarizer
125 (quote ,summarizer)))
126 ,(if summarizer
127 ;; This will store the actual values of the column
128 ;; summary.
129 `(put (quote ,sym) 'ibuffer-column-summary nil))
130 :autoload-end)))
132 ;;;###autoload
133 (defmacro* define-ibuffer-sorter (name documentation
134 (&key
135 description)
136 &rest body)
137 "Define a method of sorting named NAME.
138 DOCUMENTATION is the documentation of the function, which will be called
139 `ibuffer-do-sort-by-NAME'.
140 DESCRIPTION is a short string describing the sorting method.
142 For sorting, the forms in BODY will be evaluated with `a' bound to one
143 buffer object, and `b' bound to another. BODY should return a non-nil
144 value if and only if `a' is \"less than\" `b'.
146 \(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
147 (declare (indent 1))
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)
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))
157 (push (list ',name ,description
158 #'(lambda (a b)
159 ,@body))
160 ibuffer-sorting-functions-alist)
161 :autoload-end))
163 ;;;###autoload
164 (defmacro* define-ibuffer-op (op args
165 documentation
166 (&key
167 interactive
168 mark
169 modifier-p
170 dangerous
171 (opstring "operated on")
172 (active-opstring "Operate on")
173 complex)
174 &rest body)
175 "Generate a function which operates on a buffer.
176 OP becomes the name of the function; if it doesn't begin with
177 `ibuffer-do-', then that is prepended to it.
178 When an operation is performed, this function will be called once for
179 each marked buffer, with that buffer current.
181 ARGS becomes the formal parameters of the function.
182 DOCUMENTATION becomes the docstring of the function.
183 INTERACTIVE becomes the interactive specification of the function.
184 MARK describes which type of mark (:deletion, or nil) this operation
185 uses. :deletion means the function operates on buffers marked for
186 deletion, otherwise it acts on normally marked buffers.
187 MODIFIER-P describes how the function modifies buffers. This is used
188 to set the modification flag of the Ibuffer buffer itself. Valid
189 values are:
190 nil - the function never modifiers buffers
191 t - the function it always modifies buffers
192 :maybe - attempt to discover this information by comparing the
193 buffer's modification flag.
194 DANGEROUS is a boolean which should be set if the user should be
195 prompted before performing this operation.
196 OPSTRING is a string which will be displayed to the user after the
197 operation is complete, in the form:
198 \"Operation complete; OPSTRING x buffers\"
199 ACTIVE-OPSTRING is a string which will be displayed to the user in a
200 confirmation message, in the form:
201 \"Really ACTIVE-OPSTRING x buffers?\"
202 COMPLEX means this function is special; see the source code of this
203 macro for exactly what it does.
205 \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
206 (declare (indent 2))
207 `(progn
208 (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
209 "" "ibuffer-do-") (symbol-name op)))
210 ,args
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 (derived-mode-p 'ibuffer-mode))
218 (setq ibuffer-did-modification nil)
219 (let ((marked-names (,(case mark
220 (:deletion
221 'ibuffer-deletion-marked-buffer-names)
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)
230 'ibuffer-marked-char))))
231 ,(let* ((finish (append
232 '(progn)
233 (if (eq modifier-p t)
234 '((setq ibuffer-did-modification t))
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)
250 'ibuffer-map-marked-lines))
251 #'(lambda (buf mark)
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))
267 ;;;###autoload
268 (defmacro* define-ibuffer-filter (name documentation
269 (&key
270 reader
271 description)
272 &rest body)
273 "Define a filter named NAME.
274 DOCUMENTATION is the documentation of the function.
275 READER is a form which should read a qualifier from the user.
276 DESCRIPTION is a short string describing the filter.
278 BODY should contain forms which will be evaluated to test whether or
279 not a particular buffer should be displayed or not. The forms in BODY
280 will be evaluated with BUF bound to the buffer object, and QUALIFIER
281 bound to the current value of the filter.
283 \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
284 (declare (indent 2))
285 (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
286 `(progn
287 (defun ,fn-name (qualifier)
288 ,(or documentation "This filter is not documented.")
289 (interactive (list ,reader))
290 (ibuffer-push-filter (cons ',name qualifier))
291 (message "%s"
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)))
302 (provide 'ibuf-macs)
304 ;; arch-tag: 2748edce-82c9-4cd9-9d9d-bd73e43c20c5
305 ;;; ibuf-macs.el ends here