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