comparison lisp/ibuf-macs.el @ 42702:fb0b4579a45d

Initial revision.
author Colin Walters <walters@gnu.org>
date Sun, 13 Jan 2002 05:55:24 +0000
parents
children a7530850a26c
comparison
equal deleted inserted replaced
42701:86000f9347e6 42702:fb0b4579a45d
1 ;;; ibuf-macs.el --- macros for ibuffer
2
3 ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
4
5 ;; Author: Colin Walters <walters@verbum.org>
6 ;; Created: 6 Dec 2001
7 ;; X-RCS: $Id: ibuf-macs.el,v 1.6 2001/12/11 22:47:09 walters Exp $
8 ;; URL: http://cvs.verbum.org/ibuffer
9 ;; Keywords: buffer, convenience
10
11 ;; This file is not currently part of GNU Emacs.
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
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Code:
29
30 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
31 (defmacro ibuffer-aif (test true-body &rest false-body)
32 "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
33 If TEST returns non-nil, bind `it' to the value, and evaluate
34 TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
35 Compare with `if'."
36 (let ((sym (gensym "--ibuffer-aif-")))
37 `(let ((,sym ,test))
38 (if ,sym
39 (let ((it ,sym))
40 ,true-body)
41 (progn
42 ,@false-body)))))
43 ;; (put 'ibuffer-aif 'lisp-indent-function 2)
44
45 (defmacro ibuffer-awhen (test &rest body)
46 "Evaluate BODY if TEST returns non-nil.
47 During evaluation of body, bind `it' to the value returned by TEST."
48 `(ibuffer-aif ,test
49 (progn ,@body)
50 nil))
51 ;; (put 'ibuffer-awhen 'lisp-indent-function 1)
52
53 (defmacro ibuffer-save-marks (&rest body)
54 "Save the marked status of the buffers and execute BODY; restore marks."
55 (let ((bufsym (gensym)))
56 `(let ((,bufsym (current-buffer))
57 (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
58 (unwind-protect
59 (progn
60 (save-excursion
61 ,@body))
62 (with-current-buffer ,bufsym
63 (ibuffer-insert-buffers-and-marks
64 ;; Get rid of dead buffers
65 (delq nil
66 (mapcar #'(lambda (e) (when (buffer-live-p (car e))
67 e))
68 ibuffer-save-marks-tmp-mark-list)))
69 (ibuffer-redisplay t))))))
70 ;; (put 'ibuffer-save-marks 'lisp-indent-function 0)
71
72 ;;;###autoload
73 (defmacro* define-ibuffer-column (symbol (&key name inline props) &rest body)
74 "Define a column SYMBOL for use with `ibuffer-formats'.
75
76 BODY will be called with `buffer' bound to the buffer object, and
77 `mark' bound to the current mark on the buffer. The current buffer
78 will be `buffer'.
79
80 If NAME is given, it will be used as a title for the column.
81 Otherwise, the title will default to a capitalized version of the
82 SYMBOL's name. PROPS is a plist of additional properties to add to
83 the text, such as `mouse-face'.
84
85 Note that this macro expands into a `defun' for a function named
86 ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
87 inlined into the compiled format versions. This means that if you
88 change its definition, you should explicitly call
89 `ibuffer-recompile-formats'."
90 (let* ((sym (intern (concat "ibuffer-make-column-"
91 (symbol-name symbol))))
92 (bod-1 `(with-current-buffer buffer
93 ,@body))
94 (bod (if props
95 `(propertize
96 ,bod-1
97 ,@props)
98 bod-1)))
99 `(progn
100 ,(if inline
101 `(push '(,sym ,bod) ibuffer-inline-columns)
102 `(defun ,sym (buffer mark)
103 ,bod))
104 (put (quote ,sym) 'ibuffer-column-name
105 ,(if (stringp name)
106 name
107 (capitalize (symbol-name symbol))))
108 :autoload-end)))
109 ;; (put 'define-ibuffer-column 'lisp-indent-function 'defun)
110
111 ;;;###autoload
112 (defmacro* define-ibuffer-sorter (name documentation
113 (&key
114 description)
115 &rest body)
116 "Define a method of sorting named NAME.
117 DOCUMENTATION is the documentation of the function, which will be called
118 `ibuffer-do-sort-by-NAME'.
119 DESCRIPTION is a short string describing the sorting method.
120
121 For sorting, the forms in BODY will be evaluated with `a' bound to one
122 buffer object, and `b' bound to another. BODY should return a non-nil
123 value if and only if `a' is \"less than\" `b'."
124 `(progn
125 (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
126 ,(or documentation "No :documentation specified for this sorting method.")
127 (interactive)
128 (setq ibuffer-sorting-mode ',name)
129 (ibuffer-redisplay t))
130 (push (list ',name ,description
131 #'(lambda (a b)
132 ,@body))
133 ibuffer-sorting-functions-alist)
134 :autoload-end))
135 ;; (put 'define-ibuffer-sorter 'lisp-indent-function 1)
136
137 ;;;###autoload
138 (defmacro* define-ibuffer-op (op args
139 documentation
140 (&key
141 interactive
142 mark
143 modifier-p
144 dangerous
145 (opstring "operated on")
146 (active-opstring "Operate on")
147 complex)
148 &rest body)
149 "Generate a function named `ibuffer-do-OP', which operates on a buffer.
150 When an operation is performed, this function will be called once for
151 each marked buffer, with that buffer current.
152
153 ARGS becomes the formal parameters of the function.
154 DOCUMENTATION becomes the docstring of the function.
155 INTERACTIVE becomes the interactive specification of the function.
156 MARK describes which type of mark (:deletion, or nil) this operation
157 uses. :deletion means the function operates on buffers marked for
158 deletion, otherwise it acts on normally marked buffers.
159 MODIFIER-P describes how the function modifies buffers. This is used
160 to set the modification flag of the Ibuffer buffer itself. Valid
161 values are:
162 nil - the function never modifiers buffers
163 t - the function it always modifies buffers
164 :maybe - attempt to discover this information by comparing the
165 buffer's modification flag.
166 DANGEROUS is a boolean which should be set if the user should be
167 prompted before performing this operation.
168 OPSTRING is a string which will be displayed to the user after the
169 operation is complete, in the form:
170 \"Operation complete; OPSTRING x buffers\"
171 ACTIVE-OPSTRING is a string which will be displayed to the user in a
172 confirmation message, in the form:
173 \"Really ACTIVE-OPSTRING x buffers?\"
174 COMPLEX means this function is special; see the source code of this
175 macro for exactly what it does."
176 `(progn
177 (defun ,(intern (concat "ibuffer-do-" (symbol-name op))) ,args
178 ,(if (stringp documentation)
179 documentation
180 (format "%s marked buffers." active-opstring))
181 ,(if (not (null interactive))
182 `(interactive ,interactive)
183 '(interactive))
184 (assert (eq major-mode 'ibuffer-mode))
185 (setq ibuffer-did-modification nil)
186 (let ((marked-names (,(case mark
187 (:deletion
188 'ibuffer-deletion-marked-buffer-names)
189 (t
190 'ibuffer-marked-buffer-names)))))
191 (when (null marked-names)
192 (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
193 (ibuffer-set-mark ,(case mark
194 (:deletion
195 'ibuffer-deletion-char)
196 (t
197 'ibuffer-marked-char))))
198 ,(let* ((finish (append
199 '(progn)
200 (if (eq modifier-p t)
201 '((setq ibuffer-did-modification t))
202 ())
203 `((ibuffer-redisplay t)
204 (message ,(concat "Operation finished; " opstring " %s buffers") count))))
205 (inner-body (if complex
206 `(progn ,@body)
207 `(progn
208 (with-current-buffer buf
209 (save-excursion
210 ,@body))
211 t)))
212 (body `(let ((count
213 (,(case mark
214 (:deletion
215 'ibuffer-map-deletion-lines)
216 (t
217 'ibuffer-map-marked-lines))
218 #'(lambda (buf mark beg end)
219 ,(if (eq modifier-p :maybe)
220 `(let ((ibuffer-tmp-previous-buffer-modification
221 (buffer-modified-p buf)))
222 (prog1 ,inner-body
223 (when (not (eq ibuffer-tmp-previous-buffer-modification
224 (buffer-modified-p buf)))
225 (setq ibuffer-did-modification t))))
226 inner-body)))))
227 ,finish)))
228 (if dangerous
229 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
230 ,body)
231 body))))
232 :autoload-end))
233 ;; (put 'define-ibuffer-op 'lisp-indent-function 2)
234
235 ;;;###autoload
236 (defmacro* define-ibuffer-filter (name documentation
237 (&key
238 reader
239 description)
240 &rest body)
241 "Define a filter named NAME.
242 DOCUMENTATION is the documentation of the function.
243 READER is a form which should read a qualifier from the user.
244 DESCRIPTION is a short string describing the filter.
245
246 BODY should contain forms which will be evaluated to test whether or
247 not a particular buffer should be displayed or not. The forms in BODY
248 will be evaluated with BUF bound to the buffer object, and QUALIFIER
249 bound to the current value of the filter."
250 (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
251 `(progn
252 (defun ,fn-name (qualifier)
253 ,(concat (or documentation "This filter is not documented."))
254 (interactive (list ,reader))
255 (ibuffer-push-filter (cons ',name qualifier))
256 (message
257 (format ,(concat (format "Filter by %s added: " description)
258 " %s")
259 qualifier))
260 (ibuffer-update nil t))
261 (push (list ',name ,description
262 #'(lambda (buf qualifier)
263 ,@body))
264 ibuffer-filtering-alist)
265 :autoload-end)))
266 ;; (put 'define-ibuffer-filter 'lisp-indent-function 2)
267
268 (provide 'ibuf-macs)
269
270 ;;; ibuf-macs.el ends here