1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
| | ;;; ibuf-macs.el --- macros for ibuffer -*- lexical-binding:t -*-
;; Copyright (C) 2000-2024 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
;; Created: 6 Dec 2001
;; Keywords: buffer, convenience
;; Package: ibuffer
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl-lib))
;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
(defmacro ibuffer-aif (test true-body &rest false-body)
"Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
If TEST returns non-nil, bind `it' to the value, and evaluate
TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
Compare with `if'."
(declare (obsolete if-let "29.1") (indent 2))
(let ((sym (make-symbol "ibuffer-aif-sym")))
`(let ((,sym ,test))
(if ,sym
(let ((it ,sym))
,true-body)
(progn
,@false-body)))))
(defmacro ibuffer-awhen (test &rest body)
"Evaluate BODY if TEST returns non-nil.
During evaluation of body, bind `it' to the value returned by TEST."
(declare (indent 1) (obsolete when-let "29.1"))
`(when-let ((it ,test))
,@body))
(defmacro ibuffer-save-marks (&rest body)
"Save the marked status of the buffers and execute BODY; restore marks."
(declare (indent 0))
(let ((bufsym (make-symbol "bufsym")))
`(let ((,bufsym (current-buffer))
(ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
(unwind-protect
(progn
(save-excursion
,@body))
(with-current-buffer ,bufsym
(ibuffer-redisplay-engine
;; Get rid of dead buffers
(delq nil
(mapcar (lambda (e) (when (buffer-live-p (car e))
e))
ibuffer-save-marks-tmp-mark-list)))
(ibuffer-redisplay t))))))
;;;###autoload
(cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer
header-mouse-map) &rest body)
"Define a column SYMBOL for use with `ibuffer-formats'.
BODY will be called with `buffer' bound to the buffer object, and
`mark' bound to the current mark on the buffer. The original ibuffer
buffer will be bound to `ibuffer-buf'.
If NAME is given, it will be used as a title for the column.
Otherwise, the title will default to a capitalized version of the
SYMBOL's name. PROPS is a plist of additional properties to add to
the text, such as `mouse-face'. And SUMMARIZER, if given, is a
function which will be passed a list of all the strings in its column;
it should return a string to display at the bottom.
If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
title of the column.
Note that this macro expands into a `defun' for a function named
ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
inlined into the compiled format versions. This means that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
(declare (indent defun))
(let* ((sym (intern (concat "ibuffer-make-column-"
(symbol-name symbol))))
(bod-1 `(with-current-buffer buffer
,@body))
(bod (if props
`(propertize
,bod-1
,@props)
bod-1)))
`(progn
,(if inline
`(push '(,sym ,bod) ibuffer-inline-columns)
`(defun ,sym (buffer mark)
(ignore mark) ;Silence byte-compiler if mark is unused.
,bod))
(put (quote ,sym) 'ibuffer-column-name
,(if (stringp name)
name
(capitalize (symbol-name symbol))))
,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
,(if summarizer
;; Store the name of the summarizing function.
`(put (quote ,sym) 'ibuffer-column-summarizer
(quote ,summarizer)))
,(if summarizer
;; This will store the actual values of the column
;; summary.
`(put (quote ,sym) 'ibuffer-column-summary nil))
:autoload-end)))
;;;###autoload
(cl-defmacro define-ibuffer-sorter (name documentation
(&key
description)
&rest body)
"Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
`ibuffer-do-sort-by-NAME'.
DESCRIPTION is a short string describing the sorting method.
For sorting, the forms in BODY will be evaluated with `a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
(declare (indent 1) (doc-string 2))
`(progn
(defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
,(or documentation "No :documentation specified for this sorting method.")
(interactive)
(setq ibuffer-sorting-mode ',name)
(when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
(setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
(ibuffer-redisplay t)
(setq ibuffer-last-sorting-mode ',name))
(push (list ',name ,description
(lambda (a b)
,@body))
ibuffer-sorting-functions-alist)
:autoload-end))
;;;###autoload
(cl-defmacro define-ibuffer-op (op args
documentation
(&key
interactive
mark
modifier-p
dangerous
no-opstring
(opstring "operated on")
(active-opstring "Operate on")
before
after
complex)
&rest body)
"Generate a function which operates on a buffer.
OP becomes the name of the function; if it doesn't begin with
`ibuffer-do-', then that is prepended to it.
When an operation is performed, this function will be called once for
each marked buffer, with that buffer current.
ARGS becomes the formal parameters of the function.
DOCUMENTATION becomes the docstring of the function.
INTERACTIVE becomes the interactive specification of the function.
MARK describes which type of mark (:deletion, or nil) this operation
uses. :deletion means the function operates on buffers marked for
deletion, otherwise it acts on normally marked buffers.
MODIFIER-P describes how the function modifies buffers. This is used
to set the modification flag of the Ibuffer buffer itself. Valid
values are:
nil - the function never modifiers buffers
t - the function it always modifies buffers
:maybe - attempt to discover this information by comparing the
buffer's modification flag.
DANGEROUS is a boolean which should be set if the user should be
prompted before performing this operation.
OPSTRING is a string which will be displayed to the user after the
operation is complete, in the form:
\"Operation complete; OPSTRING x buffers\"
NO-OPSTRING is a boolean which should be set to suppress the message
after the operation is complete.
ACTIVE-OPSTRING is a string which will be displayed to the user in a
confirmation message, in the form:
\"Really ACTIVE-OPSTRING x buffers?\"
BEFORE is a form to evaluate before start the operation.
AFTER is a form to evaluate once the operation is complete.
COMPLEX means this function is special; if COMPLEX is nil BODY
evaluates once for each marked buffer, MBUF, with MBUF current
and saving the point. If COMPLEX is non-nil, BODY evaluates
without requiring MBUF current.
BODY define the operation; they are forms to evaluate per each
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)"
(declare (indent 2) (doc-string 3))
`(progn
(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
"" "ibuffer-do-")
(symbol-name op)))
,args
,(if (stringp documentation)
documentation
(format "%s marked buffers." active-opstring))
,(if (not (null interactive))
`(interactive ,interactive)
'(interactive))
(cl-assert (derived-mode-p 'ibuffer-mode))
(setq ibuffer-did-modification nil)
(let ((marked-names (,(pcase mark
(:deletion
'ibuffer-deletion-marked-buffer-names)
(_
'ibuffer-marked-buffer-names)))))
(when (null marked-names)
(cl-assert (get-text-property (line-beginning-position)
'ibuffer-properties)
nil "No buffer on this line")
(setq marked-names (list (buffer-name (ibuffer-current-buffer))))
(ibuffer-set-mark ,(pcase mark
(:deletion
'ibuffer-deletion-char)
(_
'ibuffer-marked-char))))
,(let* ((finish (append
'(progn)
(if (eq modifier-p t)
'((setq ibuffer-did-modification t))
())
(and after `(,after)) ; post-operation form.
`((ibuffer-redisplay t)
(unless ,no-opstring
(message ,(concat "Operation finished; " opstring
" %s %s")
count (ngettext "buffer" "buffers" count))))))
(inner-body (if complex
`(progn ,@body)
`(progn
(with-current-buffer buf
(save-excursion
,@body))
t)))
(body `(let ((_ ,before) ; pre-operation form.
(count
(,(pcase mark
(:deletion
'ibuffer-map-deletion-lines)
(_
'ibuffer-map-marked-lines))
(lambda (buf mark)
;; Silence warning for code that doesn't
;; use `mark'.
(ignore mark)
,(if (eq modifier-p :maybe)
`(let ((ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(prog1 ,inner-body
(when (not (eq ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(setq ibuffer-did-modification t))))
inner-body)))))
,finish)))
(if dangerous
`(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
,body)
body))))
:autoload-end))
;;;###autoload
(cl-defmacro define-ibuffer-filter (name documentation
(&key
reader
description
accept-list)
&rest body)
"Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
READER is a form which should read a qualifier from the user.
DESCRIPTION is a short string describing the filter.
ACCEPT-LIST is a boolean; if non-nil, the filter accepts either
a single condition or a list of them; in the latter
case the filter is the `or' composition of the conditions.
BODY should contain forms which will be evaluated to test whether or
not a particular buffer should be displayed or not. The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
(declare (indent 2) (doc-string 2))
(let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name))))
(filter (make-symbol "ibuffer-filter"))
(qualifier-str (make-symbol "ibuffer-qualifier-str")))
`(progn
(defun ,fn-name (qualifier)
,(or documentation "This filter is not documented.")
(interactive (list ,reader))
(let ((,filter (cons ',name qualifier))
(,qualifier-str qualifier))
,(when accept-list
`(progn
(setq qualifier (ensure-list qualifier))
;; Reject equivalent filters: (or f1 f2) is same as (or f2 f1).
(setq qualifier (sort (delete-dups qualifier) #'string-lessp))
(setq ,filter (cons ',name (car qualifier)))
(setq ,qualifier-str
(mapconcat (lambda (m) (if (symbolp m) (symbol-name m) m))
qualifier ","))
(when (cdr qualifier) ; Compose individual filters with `or'.
(setq ,filter `(or ,@(mapcar (lambda (m) (cons ',name m)) qualifier))))))
(if (null (ibuffer-push-filter ,filter))
(if ,qualifier-str
(message ,(format "Filter by %s already applied: %%s"
description)
,qualifier-str)
(message ,(format "Filter by %s already applied" description)))
(if ,qualifier-str
(message ,(format "Filter by %s added: %%s" description)
,qualifier-str)
(message ,(format "Filter by %s added" description)))
(ibuffer-update nil t))))
(push (list ',name ,description
(lambda (buf qualifier)
(condition-case nil
(progn ,@body)
(error (ibuffer-pop-filter)
(when (eq ',name 'predicate)
(error "Wrong filter predicate: %S"
qualifier))))))
ibuffer-filtering-alist)
:autoload-end)))
(provide 'ibuf-macs)
;;; ibuf-macs.el ends here
|