]> code.delx.au - gnu-emacs/blob - lisp/ibuf-ext.el
Ibuffer: Mark locked buffers
[gnu-emacs] / lisp / ibuf-ext.el
1 ;;; ibuf-ext.el --- extensions for ibuffer -*- lexical-binding:t -*-
2
3 ;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
4
5 ;; Author: Colin Walters <walters@verbum.org>
6 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
7 ;; Created: 2 Dec 2001
8 ;; Keywords: buffer, convenience
9 ;; Package: ibuffer
10
11 ;; This file is part of GNU Emacs.
12
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.
17
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.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27
28 ;; These functions should be automatically loaded when called, but you
29 ;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them
30 ;; preloaded.
31
32 ;;; Code:
33
34 (require 'ibuffer)
35
36 (eval-when-compile
37 (require 'ibuf-macs)
38 (require 'cl-lib))
39
40 ;;; Utility functions
41 (defun ibuffer-delete-alist (key alist)
42 "Delete all entries in ALIST that have a key equal to KEY."
43 (let (entry)
44 (while (setq entry (assoc key alist))
45 (setq alist (delete entry alist)))
46 alist))
47
48 ;; borrowed from Gnus
49 (defun ibuffer-remove-duplicates (list)
50 "Return a copy of LIST with duplicate elements removed."
51 (let ((new nil)
52 (tail list))
53 (while tail
54 (or (member (car tail) new)
55 (setq new (cons (car tail) new)))
56 (setq tail (cdr tail)))
57 (nreverse new)))
58
59 (defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
60 (let ((hip-crowd nil)
61 (lamers nil))
62 (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
63 (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
64 (push ibuffer-split-list-elt hip-crowd)
65 (push ibuffer-split-list-elt lamers)))
66 ;; Too bad Emacs Lisp doesn't have multiple values.
67 (list (nreverse hip-crowd) (nreverse lamers))))
68
69 (defcustom ibuffer-never-show-predicates nil
70 "A list of predicates (a regexp or function) for buffers not to display.
71 If a regexp, then it will be matched against the buffer's name.
72 If a function, it will be called with the buffer as an argument, and
73 should return non-nil if this buffer should not be shown."
74 :type '(repeat (choice regexp function))
75 :require 'ibuf-ext
76 :group 'ibuffer)
77
78 (defcustom ibuffer-always-show-predicates nil
79 "A list of predicates (a regexp or function) for buffers to always display.
80 If a regexp, then it will be matched against the buffer's name.
81 If a function, it will be called with the buffer as an argument, and
82 should return non-nil if this buffer should be shown.
83 Note that buffers matching one of these predicates will be shown
84 regardless of any active filters in this buffer."
85 :type '(repeat (choice regexp function))
86 :group 'ibuffer)
87
88 (defcustom ibuffer-never-search-content-name
89 (let* ((names '("Completions" "Help" "Messages" "Pp Eval Output"
90 "CompileLog" "Info" "Buffer List" "Ibuffer" "Apropos"))
91 (partial '("Customize Option: " "Async Shell Command\\*"
92 "Shell Command Output\\*" "ediff "))
93 (beg "\\`\\*")
94 (end "\\*\\'")
95 (excluded (mapcar (lambda (x)
96 (format "%s%s" beg x)) partial)))
97 (dolist (str names (nreverse excluded))
98 (push (format "%s%s%s" beg str end) excluded)))
99 "A list of regexps for buffers ignored by `ibuffer-mark-by-content-regexp'.
100 Buffers whose name matches a regexp in this list, are not searched."
101 :version "25.2"
102 :type '(repeat regexp)
103 :require 'ibuf-ext
104 :group 'ibuffer)
105
106 (defcustom ibuffer-never-search-content-mode '(dired-mode)
107 "A list of major modes ignored by `ibuffer-mark-by-content-regexp'.
108 Buffers whose major mode is in this list, are not searched."
109 :version "25.2"
110 :type '(repeat regexp)
111 :require 'ibuf-ext
112 :group 'ibuffer)
113
114 (defvar ibuffer-tmp-hide-regexps nil
115 "A list of regexps which should match buffer names to not show.")
116
117 (defvar ibuffer-tmp-show-regexps nil
118 "A list of regexps which should match buffer names to always show.")
119
120 (defvar ibuffer-auto-buffers-changed nil)
121
122 (defcustom ibuffer-saved-filters '(("gnus"
123 ((or (mode . message-mode)
124 (mode . mail-mode)
125 (mode . gnus-group-mode)
126 (mode . gnus-summary-mode)
127 (mode . gnus-article-mode))))
128 ("programming"
129 ((or (mode . emacs-lisp-mode)
130 (mode . cperl-mode)
131 (mode . c-mode)
132 (mode . java-mode)
133 (mode . idl-mode)
134 (mode . lisp-mode)))))
135
136 "An alist of filter qualifiers to switch between.
137
138 This variable should look like ((\"STRING\" QUALIFIERS)
139 (\"STRING\" QUALIFIERS) ...), where
140 QUALIFIERS is a list of the same form as
141 `ibuffer-filtering-qualifiers'.
142 See also the variables `ibuffer-filtering-qualifiers',
143 `ibuffer-filtering-alist', and the functions
144 `ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
145 :type '(repeat sexp)
146 :group 'ibuffer)
147
148 (defvar ibuffer-filtering-qualifiers nil
149 "A list like (SYMBOL . QUALIFIER) which filters the current buffer list.
150 See also `ibuffer-filtering-alist'.")
151
152 ;; This is now frobbed by `define-ibuffer-filter'.
153 (defvar ibuffer-filtering-alist nil
154 "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
155
156 You most likely do not want to modify this variable directly; see
157 `define-ibuffer-filter'.
158
159 SYMBOL is the symbolic name of the filter. DESCRIPTION is used when
160 displaying information to the user. FUNCTION is given a buffer and
161 the value of the qualifier, and returns non-nil if and only if the
162 buffer should be displayed.")
163
164 (defcustom ibuffer-filter-format-alist nil
165 "An alist which has special formats used when a filter is active.
166 The contents of this variable should look like:
167 ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
168
169 For example, suppose that when you add a filter for buffers whose
170 major mode is `emacs-lisp-mode', you only want to see the mark and the
171 name of the buffer. You could accomplish that by adding:
172 (mode ((mark \" \" name)))
173 to this variable."
174 :type '(repeat (list :tag "Association" (symbol :tag "Filter")
175 (list :tag "Formats" (repeat (sexp :tag "Format")))))
176 :group 'ibuffer)
177
178 (defvar ibuffer-cached-filter-formats nil)
179 (defvar ibuffer-compiled-filter-formats nil)
180
181 (defvar ibuffer-filter-groups nil
182 "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.
183 The SYMBOL should be one from `ibuffer-filtering-alist'.
184 The QUALIFIER should be the same as QUALIFIER in
185 `ibuffer-filtering-qualifiers'.")
186
187 (defcustom ibuffer-show-empty-filter-groups t
188 "If non-nil, then show the names of filter groups which are empty."
189 :type 'boolean
190 :group 'ibuffer)
191
192 (defcustom ibuffer-saved-filter-groups nil
193 "An alist of filtering groups to switch between.
194
195 This variable should look like ((\"STRING\" QUALIFIERS)
196 (\"STRING\" QUALIFIERS) ...), where
197 QUALIFIERS is a list of the same form as
198 `ibuffer-filtering-qualifiers'.
199
200 See also the variables `ibuffer-filter-groups',
201 `ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the
202 functions `ibuffer-switch-to-saved-filter-groups',
203 `ibuffer-save-filter-groups'."
204 :type '(repeat sexp)
205 :group 'ibuffer)
206
207 (defvar ibuffer-hidden-filter-groups nil
208 "A list of filtering groups which are currently hidden.")
209
210 (defvar ibuffer-filter-group-kill-ring nil)
211
212 (defcustom ibuffer-old-time 72
213 "The number of hours before a buffer is considered \"old\"."
214 :type '(choice (const :tag "72 hours (3 days)" 72)
215 (const :tag "48 hours (2 days)" 48)
216 (const :tag "24 hours (1 day)" 24)
217 (integer :tag "hours"))
218 :group 'ibuffer)
219
220 (defcustom ibuffer-save-with-custom t
221 "If non-nil, then use Custom to save interactively changed variables.
222 Currently, this only applies to `ibuffer-saved-filters' and
223 `ibuffer-saved-filter-groups'."
224 :type 'boolean
225 :group 'ibuffer)
226
227 (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
228 (or
229 (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
230 (and (not
231 (or
232 (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
233 (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
234 (or all
235 (not
236 (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
237 (or ibuffer-view-ibuffer
238 (and ibuffer-buf
239 (not (eq ibuffer-buf buf))))
240 (or
241 (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
242 (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
243
244 ;;;###autoload
245 (define-minor-mode ibuffer-auto-mode
246 "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode).
247 With a prefix argument ARG, enable Ibuffer Auto mode if ARG is
248 positive, and disable it otherwise. If called from Lisp, enable
249 the mode if ARG is omitted or nil."
250 nil nil nil
251 (unless (derived-mode-p 'ibuffer-mode)
252 (error "This buffer is not in Ibuffer mode"))
253 (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
254 (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
255
256 (defun ibuffer-auto-update-changed ()
257 (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
258 (dolist (buf (buffer-list))
259 (ignore-errors
260 (with-current-buffer buf
261 (when (and ibuffer-auto-mode
262 (derived-mode-p 'ibuffer-mode))
263 (ibuffer-update nil t)))))))
264
265 ;;;###autoload
266 (defun ibuffer-mouse-filter-by-mode (event)
267 "Enable or disable filtering by the major mode chosen via mouse."
268 (interactive "e")
269 (ibuffer-interactive-filter-by-mode event))
270
271 ;;;###autoload
272 (defun ibuffer-interactive-filter-by-mode (event-or-point)
273 "Enable or disable filtering by the major mode at point."
274 (interactive "d")
275 (if (eventp event-or-point)
276 (posn-set-point (event-end event-or-point))
277 (goto-char event-or-point))
278 (let ((buf (ibuffer-current-buffer)))
279 (if (assq 'mode ibuffer-filtering-qualifiers)
280 (setq ibuffer-filtering-qualifiers
281 (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))
282 (ibuffer-push-filter (cons 'mode (buffer-local-value 'major-mode buf)))))
283 (ibuffer-update nil t))
284
285 ;;;###autoload
286 (defun ibuffer-mouse-toggle-filter-group (event)
287 "Toggle the display status of the filter group chosen with the mouse."
288 (interactive "e")
289 (ibuffer-toggle-filter-group-1 (save-excursion
290 (mouse-set-point event)
291 (point))))
292
293 ;;;###autoload
294 (defun ibuffer-toggle-filter-group ()
295 "Toggle the display status of the filter group on this line."
296 (interactive)
297 (ibuffer-toggle-filter-group-1 (point)))
298
299 (defun ibuffer-toggle-filter-group-1 (posn)
300 (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
301 (unless (stringp name)
302 (error "No filtering group name present"))
303 (if (member name ibuffer-hidden-filter-groups)
304 (setq ibuffer-hidden-filter-groups
305 (delete name ibuffer-hidden-filter-groups))
306 (push name ibuffer-hidden-filter-groups))
307 (ibuffer-update nil t)))
308
309 ;;;###autoload
310 (defun ibuffer-forward-filter-group (&optional count)
311 "Move point forwards by COUNT filtering groups."
312 (interactive "P")
313 (unless count
314 (setq count 1))
315 (when (> count 0)
316 (when (get-text-property (point) 'ibuffer-filter-group-name)
317 (goto-char (next-single-property-change
318 (point) 'ibuffer-filter-group-name
319 nil (point-max))))
320 (goto-char (next-single-property-change
321 (point) 'ibuffer-filter-group-name
322 nil (point-max)))
323 (ibuffer-forward-filter-group (1- count)))
324 (ibuffer-forward-line 0))
325
326 ;;;###autoload
327 (defun ibuffer-backward-filter-group (&optional count)
328 "Move point backwards by COUNT filtering groups."
329 (interactive "P")
330 (unless count
331 (setq count 1))
332 (when (> count 0)
333 (when (get-text-property (point) 'ibuffer-filter-group-name)
334 (goto-char (previous-single-property-change
335 (point) 'ibuffer-filter-group-name
336 nil (point-min))))
337 (goto-char (previous-single-property-change
338 (point) 'ibuffer-filter-group-name
339 nil (point-min)))
340 (ibuffer-backward-filter-group (1- count)))
341 (when (= (point) (point-min))
342 (goto-char (point-max))
343 (ibuffer-backward-filter-group 1))
344 (ibuffer-forward-line 0))
345
346 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
347 (define-ibuffer-op shell-command-pipe (command)
348 "Pipe the contents of each marked buffer to shell command COMMAND."
349 (:interactive "sPipe to shell command: "
350 :opstring "Shell command executed on"
351 :modifier-p nil)
352 (shell-command-on-region
353 (point-min) (point-max) command
354 (get-buffer-create "* ibuffer-shell-output*")))
355
356 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
357 (define-ibuffer-op shell-command-pipe-replace (command)
358 "Replace the contents of marked buffers with output of pipe to COMMAND."
359 (:interactive "sPipe to shell command (replace): "
360 :opstring "Buffer contents replaced in"
361 :active-opstring "replace buffer contents in"
362 :dangerous t
363 :modifier-p t)
364 (with-current-buffer buf
365 (shell-command-on-region (point-min) (point-max)
366 command nil t)))
367
368 ;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
369 (define-ibuffer-op shell-command-file (command)
370 "Run shell command COMMAND separately on files of marked buffers."
371 (:interactive "sShell command on buffer's file: "
372 :opstring "Shell command executed on"
373 :modifier-p nil)
374 (shell-command (concat command " "
375 (shell-quote-argument
376 (or buffer-file-name
377 (let ((file
378 (make-temp-file
379 (substring
380 (buffer-name) 0
381 (min 10 (length (buffer-name)))))))
382 (write-region nil nil file nil 0)
383 file))))))
384
385 ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
386 (define-ibuffer-op eval (form)
387 "Evaluate FORM in each of the buffers.
388 Does not display the buffer during evaluation. See
389 `ibuffer-do-view-and-eval' for that."
390 (:interactive
391 (list
392 (read-from-minibuffer
393 "Eval in buffers (form): "
394 nil read-expression-map t 'read-expression-history))
395 :opstring "evaluated in"
396 :modifier-p :maybe)
397 (eval form))
398
399 ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
400 (define-ibuffer-op view-and-eval (form)
401 "Evaluate FORM while displaying each of the marked buffers.
402 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
403 (:interactive
404 (list
405 (read-from-minibuffer
406 "Eval viewing in buffers (form): "
407 nil read-expression-map t 'read-expression-history))
408 :opstring "evaluated in"
409 :complex t
410 :modifier-p :maybe)
411 (let ((ibuffer-buf (current-buffer)))
412 (unwind-protect
413 (progn
414 (switch-to-buffer buf)
415 (eval form))
416 (switch-to-buffer ibuffer-buf))))
417
418 ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
419 (define-ibuffer-op rename-uniquely ()
420 "Rename marked buffers as with `rename-uniquely'."
421 (:opstring "renamed"
422 :modifier-p t)
423 (rename-uniquely))
424
425 ;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
426 (define-ibuffer-op revert ()
427 "Revert marked buffers as with `revert-buffer'."
428 (:dangerous t
429 :opstring "reverted"
430 :active-opstring "revert"
431 :modifier-p :maybe)
432 (revert-buffer t t))
433
434 ;;;###autoload (autoload 'ibuffer-do-isearch "ibuf-ext")
435 (define-ibuffer-op ibuffer-do-isearch ()
436 "Perform a `isearch-forward' in marked buffers."
437 (:interactive ()
438 :opstring "searched in"
439 :complex t
440 :modifier-p :maybe)
441 (multi-isearch-buffers (ibuffer-get-marked-buffers)))
442
443 ;;;###autoload (autoload 'ibuffer-do-isearch-regexp "ibuf-ext")
444 (define-ibuffer-op ibuffer-do-isearch-regexp ()
445 "Perform a `isearch-forward-regexp' in marked buffers."
446 (:interactive ()
447 :opstring "searched regexp in"
448 :complex t
449 :modifier-p :maybe)
450 (multi-isearch-buffers-regexp (ibuffer-get-marked-buffers)))
451
452 ;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
453 (define-ibuffer-op replace-regexp (from-str to-str)
454 "Perform a `replace-regexp' in marked buffers."
455 (:interactive
456 (let* ((from-str (read-from-minibuffer "Replace regexp: "))
457 (to-str (read-from-minibuffer (concat "Replace " from-str
458 " with: "))))
459 (list from-str to-str))
460 :opstring "replaced in"
461 :complex t
462 :modifier-p :maybe)
463 (save-window-excursion
464 (switch-to-buffer buf)
465 (save-excursion
466 (goto-char (point-min))
467 (let ((case-fold-search ibuffer-case-fold-search))
468 (while (re-search-forward from-str nil t)
469 (replace-match to-str))))
470 t))
471
472 ;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
473 (define-ibuffer-op query-replace (&rest args)
474 "Perform a `query-replace' in marked buffers."
475 (:interactive
476 (query-replace-read-args "Query replace" t t)
477 :opstring "replaced in"
478 :complex t
479 :modifier-p :maybe)
480 (save-window-excursion
481 (switch-to-buffer buf)
482 (save-excursion
483 (let ((case-fold-search ibuffer-case-fold-search))
484 (goto-char (point-min))
485 (apply #'query-replace args)))
486 t))
487
488 ;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
489 (define-ibuffer-op query-replace-regexp (&rest args)
490 "Perform a `query-replace-regexp' in marked buffers."
491 (:interactive
492 (query-replace-read-args "Query replace regexp" t t)
493 :opstring "replaced in"
494 :complex t
495 :modifier-p :maybe)
496 (save-window-excursion
497 (switch-to-buffer buf)
498 (save-excursion
499 (let ((case-fold-search ibuffer-case-fold-search))
500 (goto-char (point-min))
501 (apply #'query-replace-regexp args)))
502 t))
503
504 ;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
505 (define-ibuffer-op print ()
506 "Print marked buffers as with `print-buffer'."
507 (:opstring "printed"
508 :modifier-p nil)
509 (print-buffer))
510
511 ;;;###autoload
512 (defun ibuffer-included-in-filters-p (buf filters)
513 (not
514 (memq nil ;; a filter will return nil if it failed
515 (mapcar
516 ;; filter should be like (TYPE . QUALIFIER), or
517 ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...)
518 #'(lambda (qual)
519 (ibuffer-included-in-filter-p buf qual))
520 filters))))
521
522 (defun ibuffer-included-in-filter-p (buf filter)
523 (if (eq (car filter) 'not)
524 (not (ibuffer-included-in-filter-p-1 buf (cdr filter)))
525 (ibuffer-included-in-filter-p-1 buf filter)))
526
527 (defun ibuffer-included-in-filter-p-1 (buf filter)
528 (not
529 (not
530 (pcase (car filter)
531 (`or
532 (memq t (mapcar #'(lambda (x)
533 (ibuffer-included-in-filter-p buf x))
534 (cdr filter))))
535 (`saved
536 (let ((data
537 (assoc (cdr filter)
538 ibuffer-saved-filters)))
539 (unless data
540 (ibuffer-filter-disable t)
541 (error "Unknown saved filter %s" (cdr filter)))
542 (ibuffer-included-in-filters-p buf (cadr data))))
543 (_
544 (pcase-let ((`(,_type ,_desc ,func)
545 (assq (car filter) ibuffer-filtering-alist)))
546 (unless func
547 (ibuffer-filter-disable t)
548 (error "Undefined filter %s" (car filter)))
549 (funcall func buf (cdr filter))))))))
550
551 (defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
552 (let ((filter-group-alist (if nodefault
553 ibuffer-filter-groups
554 (append ibuffer-filter-groups
555 (list (cons "Default" nil))))))
556 ;; (dolist (hidden ibuffer-hidden-filter-groups)
557 ;; (setq filter-group-alist (ibuffer-delete-alist
558 ;; hidden filter-group-alist)))
559 (let ((vec (make-vector (length filter-group-alist) nil))
560 (i 0))
561 (dolist (filtergroup filter-group-alist)
562 (let ((filterset (cdr filtergroup)))
563 (cl-multiple-value-bind (hip-crowd lamers)
564 (cl-values-list
565 (ibuffer-split-list (lambda (bufmark)
566 (ibuffer-included-in-filters-p (car bufmark)
567 filterset))
568 bmarklist))
569 (aset vec i hip-crowd)
570 (cl-incf i)
571 (setq bmarklist lamers))))
572 (let (ret)
573 (dotimes (j i)
574 (let ((bufs (aref vec j)))
575 (unless (and noempty (null bufs))
576 (push (cons (car (nth j filter-group-alist))
577 bufs)
578 ret))))
579 ret))))
580
581 ;;;###autoload
582 (defun ibuffer-filters-to-filter-group (name)
583 "Make the current filters into a filtering group."
584 (interactive "sName for filtering group: ")
585 (when (null ibuffer-filtering-qualifiers)
586 (error "No filters in effect"))
587 (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
588 (ibuffer-filter-disable))
589
590 ;;;###autoload
591 (defun ibuffer-set-filter-groups-by-mode ()
592 "Set the current filter groups to filter by mode."
593 (interactive)
594 (setq ibuffer-filter-groups
595 (mapcar (lambda (mode)
596 (cons (format "%s" mode) `((mode . ,mode))))
597 (let ((modes
598 (ibuffer-remove-duplicates
599 (mapcar (lambda (buf)
600 (buffer-local-value 'major-mode buf))
601 (buffer-list)))))
602 (if ibuffer-view-ibuffer
603 modes
604 (delq 'ibuffer-mode modes)))))
605 (ibuffer-update nil t))
606
607 ;;;###autoload
608 (defun ibuffer-pop-filter-group ()
609 "Remove the first filter group."
610 (interactive)
611 (when (null ibuffer-filter-groups)
612 (error "No filter groups active"))
613 (setq ibuffer-hidden-filter-groups
614 (delete (pop ibuffer-filter-groups)
615 ibuffer-hidden-filter-groups))
616 (ibuffer-update nil t))
617
618 (defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
619 (when (and (not noerror) (null ibuffer-filter-groups))
620 (error "No filter groups active"))
621 ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
622 ;; groups, possibly excluding empty groups or Default.
623 ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
624 ;; Default if necessary.
625 (completing-read msg (nconc
626 (ibuffer-generate-filter-groups
627 (ibuffer-current-state-list)
628 (not ibuffer-show-empty-filter-groups)
629 nodefault)
630 (if nodefault
631 (remove "Default" ibuffer-hidden-filter-groups)
632 ibuffer-hidden-filter-groups))
633 nil t))
634
635 ;;;###autoload
636 (defun ibuffer-decompose-filter-group (group)
637 "Decompose the filter group GROUP into active filters."
638 (interactive
639 (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
640 (let ((data (cdr (assoc group ibuffer-filter-groups))))
641 (setq ibuffer-filter-groups (ibuffer-delete-alist
642 group ibuffer-filter-groups)
643 ibuffer-filtering-qualifiers data))
644 (ibuffer-update nil t))
645
646 ;;;###autoload
647 (defun ibuffer-clear-filter-groups ()
648 "Remove all filter groups."
649 (interactive)
650 (setq ibuffer-filter-groups nil
651 ibuffer-hidden-filter-groups nil)
652 (ibuffer-update nil t))
653
654 (defun ibuffer-current-filter-groups-with-position ()
655 (save-excursion
656 (goto-char (point-min))
657 (let ((pos nil)
658 (result nil))
659 (while (and (not (eobp))
660 (setq pos (next-single-property-change
661 (point) 'ibuffer-filter-group-name)))
662 (goto-char pos)
663 (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
664 pos)
665 result)
666 (goto-char (next-single-property-change
667 pos 'ibuffer-filter-group-name)))
668 (nreverse result))))
669
670 ;;;###autoload
671 (defun ibuffer-jump-to-filter-group (name)
672 "Move point to the filter group whose name is NAME."
673 (interactive
674 (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
675 (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
676 (goto-char (cdr it))
677 (error "No filter group with name %s" name)))
678
679 ;;;###autoload
680 (defun ibuffer-kill-filter-group (name)
681 "Kill the filter group named NAME.
682 The group will be added to `ibuffer-filter-group-kill-ring'."
683 (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
684 (when (equal name "Default")
685 (error "Can't kill default filter group"))
686 (ibuffer-aif (assoc name ibuffer-filter-groups)
687 (progn
688 (push (copy-tree it) ibuffer-filter-group-kill-ring)
689 (setq ibuffer-filter-groups (ibuffer-delete-alist
690 name ibuffer-filter-groups))
691 (setq ibuffer-hidden-filter-groups
692 (delete name ibuffer-hidden-filter-groups)))
693 (error "No filter group with name \"%s\"" name))
694 (ibuffer-update nil t))
695
696 ;;;###autoload
697 (defun ibuffer-kill-line (&optional arg interactive-p)
698 "Kill the filter group at point.
699 See also `ibuffer-kill-filter-group'."
700 (interactive "P\np")
701 (ibuffer-aif (save-excursion
702 (ibuffer-forward-line 0)
703 (get-text-property (point) 'ibuffer-filter-group-name))
704 (progn
705 (ibuffer-kill-filter-group it))
706 (funcall (if interactive-p #'call-interactively #'funcall)
707 #'kill-line arg)))
708
709 (defun ibuffer-insert-filter-group-before (newgroup group)
710 (let* ((found nil)
711 (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
712 (res 0))
713 (while groups
714 (if (equal (car groups) group)
715 (setq found t
716 groups nil)
717 (cl-incf res)
718 (setq groups (cdr groups))))
719 res)))
720 (cond ((not found)
721 (setq ibuffer-filter-groups
722 (nconc ibuffer-filter-groups (list newgroup))))
723 ((zerop pos)
724 (push newgroup ibuffer-filter-groups))
725 (t
726 (let ((cell (nthcdr pos ibuffer-filter-groups)))
727 (setf (cdr cell) (cons (car cell) (cdr cell)))
728 (setf (car cell) newgroup))))))
729
730 ;;;###autoload
731 (defun ibuffer-yank ()
732 "Yank the last killed filter group before group at point."
733 (interactive)
734 (ibuffer-yank-filter-group
735 (or (get-text-property (point) 'ibuffer-filter-group-name)
736 (get-text-property (point) 'ibuffer-filter-group)
737 (error "No filter group at point"))))
738
739 ;;;###autoload
740 (defun ibuffer-yank-filter-group (name)
741 "Yank the last killed filter group before group named NAME."
742 (interactive (list (ibuffer-read-filter-group-name
743 "Yank filter group before group: ")))
744 (unless ibuffer-filter-group-kill-ring
745 (error "The Ibuffer filter group kill-ring is empty"))
746 (save-excursion
747 (ibuffer-forward-line 0)
748 (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
749 name))
750 (ibuffer-update nil t))
751
752 ;;;###autoload
753 (defun ibuffer-save-filter-groups (name groups)
754 "Save all active filter groups GROUPS as NAME.
755 They are added to `ibuffer-saved-filter-groups'. Interactively,
756 prompt for NAME, and use the current filters."
757 (interactive
758 (if (null ibuffer-filter-groups)
759 (error "No filter groups active")
760 (list
761 (read-from-minibuffer "Save current filter groups as: ")
762 ibuffer-filter-groups)))
763 (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
764 (setcdr it groups)
765 (push (cons name groups) ibuffer-saved-filter-groups))
766 (ibuffer-maybe-save-stuff))
767
768 ;;;###autoload
769 (defun ibuffer-delete-saved-filter-groups (name)
770 "Delete saved filter groups with NAME.
771 They are removed from `ibuffer-saved-filter-groups'."
772 (interactive
773 (list
774 (if (null ibuffer-saved-filter-groups)
775 (error "No saved filter groups")
776 (completing-read "Delete saved filter group: "
777 ibuffer-saved-filter-groups nil t))))
778 (setq ibuffer-saved-filter-groups
779 (ibuffer-delete-alist name ibuffer-saved-filter-groups))
780 (ibuffer-maybe-save-stuff)
781 (ibuffer-update nil t))
782
783 ;;;###autoload
784 (defun ibuffer-switch-to-saved-filter-groups (name)
785 "Set this buffer's filter groups to saved version with NAME.
786 The value from `ibuffer-saved-filter-groups' is used."
787 (interactive
788 (list
789 (cond ((null ibuffer-saved-filter-groups)
790 (error "No saved filters"))
791 ;; `ibuffer-saved-filter-groups' is a user variable that defaults
792 ;; to nil. We assume that with one element in this list the user
793 ;; knows what she wants. See bug#12331.
794 ((null (cdr ibuffer-saved-filter-groups))
795 (caar ibuffer-saved-filter-groups))
796 (t
797 (completing-read "Switch to saved filter group: "
798 ibuffer-saved-filter-groups nil t)))))
799 (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
800 ibuffer-hidden-filter-groups nil)
801 (ibuffer-update nil t))
802
803 ;;;###autoload
804 (defun ibuffer-filter-disable (&optional delete-filter-groups)
805 "Disable all filters currently in effect in this buffer.
806 With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter
807 group definitions by setting `ibuffer-filter-groups' to nil."
808 (interactive)
809 (setq ibuffer-filtering-qualifiers nil)
810 (if delete-filter-groups
811 (setq ibuffer-filter-groups nil))
812 (let ((buf (ibuffer-current-buffer)))
813 (ibuffer-update nil t)
814 (when buf
815 (ibuffer-jump-to-buffer (buffer-name buf)))))
816
817 ;;;###autoload
818 (defun ibuffer-pop-filter ()
819 "Remove the top filter in this buffer."
820 (interactive)
821 (when (null ibuffer-filtering-qualifiers)
822 (error "No filters in effect"))
823 (pop ibuffer-filtering-qualifiers)
824 (let ((buf (ibuffer-current-buffer)))
825 (ibuffer-update nil t)
826 (when buf
827 (ibuffer-jump-to-buffer (buffer-name buf)))))
828
829 (defun ibuffer-push-filter (qualifier)
830 "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
831 (push qualifier ibuffer-filtering-qualifiers))
832
833 ;;;###autoload
834 (defun ibuffer-decompose-filter ()
835 "Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
836
837 This means that the topmost filter on the filtering stack, which must
838 be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
839 turned into two separate filters [name: foo] and [mode: bar-mode]."
840 (interactive)
841 (when (null ibuffer-filtering-qualifiers)
842 (error "No filters in effect"))
843 (let ((lim (pop ibuffer-filtering-qualifiers)))
844 (pcase (car lim)
845 (`or
846 (setq ibuffer-filtering-qualifiers (append
847 (cdr lim)
848 ibuffer-filtering-qualifiers)))
849 (`saved
850 (let ((data
851 (assoc (cdr lim)
852 ibuffer-saved-filters)))
853 (unless data
854 (ibuffer-filter-disable)
855 (error "Unknown saved filter %s" (cdr lim)))
856 (setq ibuffer-filtering-qualifiers (append
857 (cadr data)
858 ibuffer-filtering-qualifiers))))
859 (`not
860 (push (cdr lim)
861 ibuffer-filtering-qualifiers))
862 (_
863 (error "Filter type %s is not compound" (car lim)))))
864 (ibuffer-update nil t))
865
866 ;;;###autoload
867 (defun ibuffer-exchange-filters ()
868 "Exchange the top two filters on the stack in this buffer."
869 (interactive)
870 (when (< (length ibuffer-filtering-qualifiers)
871 2)
872 (error "Need two filters to exchange"))
873 (let ((first (pop ibuffer-filtering-qualifiers))
874 (second (pop ibuffer-filtering-qualifiers)))
875 (push first ibuffer-filtering-qualifiers)
876 (push second ibuffer-filtering-qualifiers))
877 (ibuffer-update nil t))
878
879 ;;;###autoload
880 (defun ibuffer-negate-filter ()
881 "Negate the sense of the top filter in the current buffer."
882 (interactive)
883 (when (null ibuffer-filtering-qualifiers)
884 (error "No filters in effect"))
885 (let ((lim (pop ibuffer-filtering-qualifiers)))
886 (push (if (eq (car lim) 'not)
887 (cdr lim)
888 (cons 'not lim))
889 ibuffer-filtering-qualifiers))
890 (ibuffer-update nil t))
891
892 ;;;###autoload
893 (defun ibuffer-or-filter (&optional reverse)
894 "Replace the top two filters in this buffer with their logical OR.
895 If optional argument REVERSE is non-nil, instead break the top OR
896 filter into parts."
897 (interactive "P")
898 (if reverse
899 (progn
900 (when (or (null ibuffer-filtering-qualifiers)
901 (not (eq 'or (caar ibuffer-filtering-qualifiers))))
902 (error "Top filter is not an OR"))
903 (let ((lim (pop ibuffer-filtering-qualifiers)))
904 (setq ibuffer-filtering-qualifiers
905 (nconc (cdr lim) ibuffer-filtering-qualifiers))))
906 (when (< (length ibuffer-filtering-qualifiers) 2)
907 (error "Need two filters to OR"))
908 ;; If the second filter is an OR, just add to it.
909 (let ((first (pop ibuffer-filtering-qualifiers))
910 (second (pop ibuffer-filtering-qualifiers)))
911 (if (eq 'or (car second))
912 (push (nconc (list 'or first) (cdr second))
913 ibuffer-filtering-qualifiers)
914 (push (list 'or first second)
915 ibuffer-filtering-qualifiers))))
916 (ibuffer-update nil t))
917
918 (defun ibuffer-maybe-save-stuff ()
919 (when ibuffer-save-with-custom
920 (if (fboundp 'customize-save-variable)
921 (progn
922 (customize-save-variable 'ibuffer-saved-filters
923 ibuffer-saved-filters)
924 (customize-save-variable 'ibuffer-saved-filter-groups
925 ibuffer-saved-filter-groups))
926 (message "Not saved permanently: Customize not available"))))
927
928 ;;;###autoload
929 (defun ibuffer-save-filters (name filters)
930 "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
931 Interactively, prompt for NAME, and use the current filters."
932 (interactive
933 (if (null ibuffer-filtering-qualifiers)
934 (error "No filters currently in effect")
935 (list
936 (read-from-minibuffer "Save current filters as: ")
937 ibuffer-filtering-qualifiers)))
938 (ibuffer-aif (assoc name ibuffer-saved-filters)
939 (setcdr it filters)
940 (push (list name filters) ibuffer-saved-filters))
941 (ibuffer-maybe-save-stuff))
942
943 ;;;###autoload
944 (defun ibuffer-delete-saved-filters (name)
945 "Delete saved filters with NAME from `ibuffer-saved-filters'."
946 (interactive
947 (list
948 (if (null ibuffer-saved-filters)
949 (error "No saved filters")
950 (completing-read "Delete saved filters: "
951 ibuffer-saved-filters nil t))))
952 (setq ibuffer-saved-filters
953 (ibuffer-delete-alist name ibuffer-saved-filters))
954 (ibuffer-maybe-save-stuff)
955 (ibuffer-update nil t))
956
957 ;;;###autoload
958 (defun ibuffer-add-saved-filters (name)
959 "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
960 (interactive
961 (list
962 (if (null ibuffer-saved-filters)
963 (error "No saved filters")
964 (completing-read "Add saved filters: "
965 ibuffer-saved-filters nil t))))
966 (push (cons 'saved name) ibuffer-filtering-qualifiers)
967 (ibuffer-update nil t))
968
969 ;;;###autoload
970 (defun ibuffer-switch-to-saved-filters (name)
971 "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
972 (interactive
973 (list
974 (if (null ibuffer-saved-filters)
975 (error "No saved filters")
976 (completing-read "Switch to saved filters: "
977 ibuffer-saved-filters nil t))))
978 (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
979 (ibuffer-update nil t))
980
981 (defun ibuffer-format-filter-group-data (filter)
982 (if (equal filter "Default")
983 ""
984 (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
985 (cdr (assq filter ibuffer-filter-groups))
986 " "))))
987
988 (defun ibuffer-format-qualifier (qualifier)
989 (if (eq (car-safe qualifier) 'not)
990 (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")
991 (ibuffer-format-qualifier-1 qualifier)))
992
993 (defun ibuffer-format-qualifier-1 (qualifier)
994 (pcase (car qualifier)
995 (`saved
996 (concat " [filter: " (cdr qualifier) "]"))
997 (`or
998 (concat " [OR" (mapconcat #'ibuffer-format-qualifier
999 (cdr qualifier) "") "]"))
1000 (_
1001 (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
1002 (unless qualifier
1003 (error "Ibuffer: bad qualifier %s" qualifier))
1004 (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
1005
1006
1007 (defun ibuffer-list-buffer-modes (&optional include-parents)
1008 "Create a completion table of buffer modes currently in use.
1009 If INCLUDE-PARENTS is non-nil then include parent modes."
1010 (let ((modes))
1011 (dolist (buf (buffer-list))
1012 (let ((this-mode (buffer-local-value 'major-mode buf)))
1013 (while (and this-mode (not (memq this-mode modes)))
1014 (push this-mode modes)
1015 (setq this-mode (and include-parents
1016 (get this-mode 'derived-mode-parent))))))
1017 (mapcar #'symbol-name modes)))
1018
1019
1020 ;;; Extra operation definitions
1021
1022 ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
1023 (define-ibuffer-filter mode
1024 "Toggle current view to buffers with major mode QUALIFIER."
1025 (:description "major mode"
1026 :reader
1027 (let* ((buf (ibuffer-current-buffer))
1028 (default (if (and buf (buffer-live-p buf))
1029 (symbol-name (buffer-local-value
1030 'major-mode buf)))))
1031 (intern
1032 (completing-read
1033 (if default
1034 (format "Filter by major mode (default %s): " default)
1035 "Filter by major mode: ")
1036 obarray
1037 #'(lambda (e)
1038 (string-match "-mode\\'" (symbol-name e)))
1039 t nil nil default))))
1040 (eq qualifier (buffer-local-value 'major-mode buf)))
1041
1042 ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
1043 (define-ibuffer-filter used-mode
1044 "Toggle current view to buffers with major mode QUALIFIER.
1045 Called interactively, this function allows selection of modes
1046 currently used by buffers."
1047 (:description "major mode in use"
1048 :reader
1049 (let* ((buf (ibuffer-current-buffer))
1050 (default (if (and buf (buffer-live-p buf))
1051 (symbol-name (buffer-local-value
1052 'major-mode buf)))))
1053 (intern
1054 (completing-read
1055 (if default
1056 (format "Filter by major mode (default %s): " default)
1057 "Filter by major mode: ")
1058 (ibuffer-list-buffer-modes) nil t nil nil default))))
1059 (eq qualifier (buffer-local-value 'major-mode buf)))
1060
1061 ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
1062 (define-ibuffer-filter derived-mode
1063 "Toggle current view to buffers whose major mode inherits from QUALIFIER."
1064 (:description "derived mode"
1065 :reader
1066 (intern
1067 (completing-read "Filter by derived mode: "
1068 (ibuffer-list-buffer-modes t)
1069 nil t)))
1070 (with-current-buffer buf (derived-mode-p qualifier)))
1071
1072 ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
1073 (define-ibuffer-filter name
1074 "Toggle current view to buffers with name matching QUALIFIER."
1075 (:description "buffer name"
1076 :reader (read-from-minibuffer "Filter by name (regexp): "))
1077 (string-match qualifier (buffer-name buf)))
1078
1079 ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext")
1080 (define-ibuffer-filter filename
1081 "Toggle current view to buffers with filename matching QUALIFIER."
1082 (:description "filename"
1083 :reader (read-from-minibuffer "Filter by filename (regexp): "))
1084 (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1085 (string-match qualifier it)))
1086
1087 ;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
1088 (define-ibuffer-filter size-gt
1089 "Toggle current view to buffers with size greater than QUALIFIER."
1090 (:description "size greater than"
1091 :reader
1092 (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
1093 (> (with-current-buffer buf (buffer-size))
1094 qualifier))
1095
1096 ;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext")
1097 (define-ibuffer-filter size-lt
1098 "Toggle current view to buffers with size less than QUALIFIER."
1099 (:description "size less than"
1100 :reader
1101 (string-to-number (read-from-minibuffer "Filter by size less than: ")))
1102 (< (with-current-buffer buf (buffer-size))
1103 qualifier))
1104
1105 ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext")
1106 (define-ibuffer-filter content
1107 "Toggle current view to buffers whose contents match QUALIFIER."
1108 (:description "content"
1109 :reader (read-from-minibuffer "Filter by content (regexp): "))
1110 (with-current-buffer buf
1111 (save-excursion
1112 (goto-char (point-min))
1113 (re-search-forward qualifier nil t))))
1114
1115 ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext")
1116 (define-ibuffer-filter predicate
1117 "Toggle current view to buffers for which QUALIFIER returns non-nil."
1118 (:description "predicate"
1119 :reader (read-minibuffer "Filter by predicate (form): "))
1120 (with-current-buffer buf
1121 (eval qualifier)))
1122
1123 ;;; Sorting
1124
1125 ;;;###autoload
1126 (defun ibuffer-toggle-sorting-mode ()
1127 "Toggle the current sorting mode.
1128 Default sorting modes are:
1129 Recency - the last time the buffer was viewed
1130 Name - the name of the buffer
1131 Major Mode - the name of the major mode of the buffer
1132 Size - the size of the buffer"
1133 (interactive)
1134 (let ((modes (mapcar #'car ibuffer-sorting-functions-alist)))
1135 (cl-pushnew 'recency modes)
1136 (setq modes (sort modes #'string-lessp))
1137 (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
1138 (car modes))))
1139 (setq ibuffer-sorting-mode next)
1140 (message "Sorting by %s" next)))
1141 (ibuffer-redisplay t))
1142
1143 ;;;###autoload
1144 (defun ibuffer-invert-sorting ()
1145 "Toggle whether or not sorting is in reverse order."
1146 (interactive)
1147 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
1148 (message "Sorting order %s"
1149 (if ibuffer-sorting-reversep
1150 "reversed"
1151 "normal"))
1152 (ibuffer-redisplay t))
1153
1154 ;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext")
1155 (define-ibuffer-sorter major-mode
1156 "Sort the buffers by major modes.
1157 Ordering is lexicographic."
1158 (:description "major mode")
1159 (string-lessp (downcase
1160 (symbol-name (buffer-local-value 'major-mode (car a))))
1161 (downcase
1162 (symbol-name (buffer-local-value 'major-mode (car b))))))
1163
1164 ;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext")
1165 (define-ibuffer-sorter mode-name
1166 "Sort the buffers by their mode name.
1167 Ordering is lexicographic."
1168 (:description "major mode name")
1169 (string-lessp (downcase
1170 (with-current-buffer
1171 (car a)
1172 (format-mode-line mode-name)))
1173 (downcase
1174 (with-current-buffer
1175 (car b)
1176 (format-mode-line mode-name)))))
1177
1178 ;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext")
1179 (define-ibuffer-sorter alphabetic
1180 "Sort the buffers by their names.
1181 Ordering is lexicographic."
1182 (:description "buffer name")
1183 (string-lessp
1184 (buffer-name (car a))
1185 (buffer-name (car b))))
1186
1187 ;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext")
1188 (define-ibuffer-sorter size
1189 "Sort the buffers by their size."
1190 (:description "size")
1191 (< (with-current-buffer (car a)
1192 (buffer-size))
1193 (with-current-buffer (car b)
1194 (buffer-size))))
1195
1196 ;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext")
1197 (define-ibuffer-sorter filename/process
1198 "Sort the buffers by their file name/process name."
1199 (:description "file name")
1200 (string-lessp
1201 ;; FIXME: For now just compare the file name and the process name
1202 ;; (if it exists). Is there a better way to do this?
1203 (or (buffer-file-name (car a))
1204 (let ((pr-a (get-buffer-process (car a))))
1205 (and (processp pr-a) (process-name pr-a))))
1206 (or (buffer-file-name (car b))
1207 (let ((pr-b (get-buffer-process (car b))))
1208 (and (processp pr-b) (process-name pr-b))))))
1209
1210 ;;; Functions to emulate bs.el
1211
1212 ;;;###autoload
1213 (defun ibuffer-bs-show ()
1214 "Emulate `bs-show' from the bs.el package."
1215 (interactive)
1216 (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
1217 (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
1218
1219 (defun ibuffer-bs-toggle-all ()
1220 "Emulate `bs-toggle-show-all' from the bs.el package."
1221 (interactive)
1222 (if ibuffer-filtering-qualifiers
1223 (ibuffer-pop-filter)
1224 (progn (ibuffer-push-filter '(filename . ".*"))
1225 (ibuffer-update nil t))))
1226
1227 ;;; Handy functions
1228
1229 ;;;###autoload
1230 (defun ibuffer-add-to-tmp-hide (regexp)
1231 "Add REGEXP to `ibuffer-tmp-hide-regexps'.
1232 This means that buffers whose name matches REGEXP will not be shown
1233 for this Ibuffer session."
1234 (interactive
1235 (list
1236 (read-from-minibuffer "Never show buffers matching: "
1237 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1238 (push regexp ibuffer-tmp-hide-regexps))
1239
1240 ;;;###autoload
1241 (defun ibuffer-add-to-tmp-show (regexp)
1242 "Add REGEXP to `ibuffer-tmp-show-regexps'.
1243 This means that buffers whose name matches REGEXP will always be shown
1244 for this Ibuffer session."
1245 (interactive
1246 (list
1247 (read-from-minibuffer "Always show buffers matching: "
1248 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1249 (push regexp ibuffer-tmp-show-regexps))
1250
1251 ;;;###autoload
1252 (defun ibuffer-forward-next-marked (&optional count mark direction)
1253 "Move forward by COUNT marked buffers (default 1).
1254
1255 If MARK is non-nil, it should be a character denoting the type of mark
1256 to move by. The default is `ibuffer-marked-char'.
1257
1258 If DIRECTION is non-nil, it should be an integer; negative integers
1259 mean move backwards, non-negative integers mean move forwards."
1260 (interactive "P")
1261 (unless count
1262 (setq count 1))
1263 (unless mark
1264 (setq mark ibuffer-marked-char))
1265 (unless direction
1266 (setq direction 1))
1267 ;; Skip the title
1268 (ibuffer-forward-line 0)
1269 (let ((opos (point)))
1270 (ibuffer-forward-line direction)
1271 (while (not (or (= (point) opos)
1272 (eq (ibuffer-current-mark) mark)))
1273 (ibuffer-forward-line direction))
1274 (when (and (= (point) opos)
1275 (not (eq (ibuffer-current-mark) mark)))
1276 (error "No buffers with mark %c" mark))))
1277
1278 ;;;###autoload
1279 (defun ibuffer-backwards-next-marked (&optional count mark)
1280 "Move backwards by COUNT marked buffers (default 1).
1281
1282 If MARK is non-nil, it should be a character denoting the type of mark
1283 to move by. The default is `ibuffer-marked-char'."
1284 (interactive "P")
1285 (ibuffer-forward-next-marked count mark -1))
1286
1287 ;;;###autoload
1288 (defun ibuffer-do-kill-lines ()
1289 "Hide all of the currently marked lines."
1290 (interactive)
1291 (if (= (ibuffer-count-marked-lines) 0)
1292 (message "No buffers marked; use 'm' to mark a buffer")
1293 (let ((count
1294 (ibuffer-map-marked-lines
1295 #'(lambda (_buf _mark)
1296 'kill))))
1297 (message "Killed %s lines" count))))
1298
1299 ;;;###autoload
1300 (defun ibuffer-jump-to-buffer (name)
1301 "Move point to the buffer whose name is NAME.
1302
1303 If called interactively, prompt for a buffer name and go to the
1304 corresponding line in the Ibuffer buffer. If said buffer is in a
1305 hidden group filter, open it.
1306
1307 If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer
1308 visible buffers in the completion list. Calling the command with
1309 a prefix argument reverses the meaning of that variable."
1310 (interactive (list
1311 (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
1312 (when current-prefix-arg
1313 (setq only-visible (not only-visible)))
1314 (if only-visible
1315 (let ((table (mapcar #'(lambda (x)
1316 (buffer-name (car x)))
1317 (ibuffer-current-state-list))))
1318 (when (null table)
1319 (error "No buffers!"))
1320 (completing-read "Jump to buffer: "
1321 table nil t))
1322 (read-buffer "Jump to buffer: " nil t)))))
1323 (when (not (string= "" name))
1324 (let (buf-point)
1325 ;; Blindly search for our buffer: it is very likely that it is
1326 ;; not in a hidden filter group.
1327 (ibuffer-map-lines #'(lambda (buf _marks)
1328 (when (string= (buffer-name buf) name)
1329 (setq buf-point (point))
1330 nil))
1331 t nil)
1332 (when (and
1333 (null buf-point)
1334 (not (null ibuffer-hidden-filter-groups)))
1335 ;; We did not find our buffer. It must be in a hidden filter
1336 ;; group, so go through all hidden filter groups to find it.
1337 (catch 'found
1338 (dolist (group ibuffer-hidden-filter-groups)
1339 (ibuffer-jump-to-filter-group group)
1340 (ibuffer-toggle-filter-group)
1341 (ibuffer-map-lines #'(lambda (buf _marks)
1342 (when (string= (buffer-name buf) name)
1343 (setq buf-point (point))
1344 nil))
1345 t group)
1346 (if buf-point
1347 (throw 'found nil)
1348 (ibuffer-toggle-filter-group)))))
1349 (if (null buf-point)
1350 ;; Still not found even though we expanded all hidden filter
1351 ;; groups: that must be because it's hidden by predicate:
1352 ;; we won't bother trying to display it.
1353 (error "No buffer with name %s" name)
1354 (goto-char buf-point)))))
1355
1356 (declare-function diff-sentinel "diff"
1357 (code &optional old-temp-file new-temp-file))
1358
1359 (defun ibuffer-diff-buffer-with-file-1 (buffer)
1360 (let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
1361 (tempfile (make-temp-file "buffer-content-")))
1362 (when bufferfile
1363 (unwind-protect
1364 (progn
1365 (with-current-buffer buffer
1366 (write-region nil nil tempfile nil 'nomessage))
1367 (let* ((old (expand-file-name bufferfile))
1368 (new (expand-file-name tempfile))
1369 (oldtmp (file-local-copy old))
1370 (newtmp (file-local-copy new))
1371 (switches diff-switches)
1372 (command
1373 (mapconcat
1374 'identity
1375 `(,diff-command
1376 ;; Use explicitly specified switches
1377 ,@(if (listp switches) switches (list switches))
1378 ,@(if (or old new)
1379 (list "-L" (shell-quote-argument old)
1380 "-L" (shell-quote-argument
1381 (format "Buffer %s" (buffer-name buffer)))))
1382 ,(shell-quote-argument (or oldtmp old))
1383 ,(shell-quote-argument (or newtmp new)))
1384 " ")))
1385 (let ((inhibit-read-only t))
1386 (insert command "\n")
1387 (diff-sentinel
1388 (call-process shell-file-name nil
1389 (current-buffer) nil
1390 shell-command-switch command))
1391 (insert "\n")))))
1392 (sit-for 0)
1393 (when (file-exists-p tempfile)
1394 (delete-file tempfile)))))
1395
1396 ;;;###autoload
1397 (defun ibuffer-diff-with-file ()
1398 "View the differences between marked buffers and their associated files.
1399 If no buffers are marked, use buffer at point.
1400 This requires the external program \"diff\" to be in your `exec-path'."
1401 (interactive)
1402 (require 'diff)
1403 (let ((marked-bufs (ibuffer-get-marked-buffers)))
1404 (when (null marked-bufs)
1405 (setq marked-bufs (list (ibuffer-current-buffer t))))
1406 (with-current-buffer (get-buffer-create "*Ibuffer Diff*")
1407 (setq buffer-read-only nil)
1408 (buffer-disable-undo (current-buffer))
1409 (erase-buffer)
1410 (buffer-enable-undo (current-buffer))
1411 (diff-mode)
1412 (dolist (buf marked-bufs)
1413 (unless (buffer-live-p buf)
1414 (error "Buffer %s has been killed" buf))
1415 (ibuffer-diff-buffer-with-file-1 buf))
1416 (setq buffer-read-only t)))
1417 (switch-to-buffer "*Ibuffer Diff*"))
1418
1419 ;;;###autoload
1420 (defun ibuffer-copy-filename-as-kill (&optional arg)
1421 "Copy filenames of marked buffers into the kill ring.
1422
1423 The names are separated by a space.
1424 If a buffer has no filename, it is ignored.
1425
1426 With no prefix arg, use the filename sans its directory of each marked file.
1427 With a zero prefix arg, use the complete filename of each marked file.
1428 With \\[universal-argument], use the filename of each marked file relative
1429 to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
1430
1431 You can then feed the file name(s) to other commands with \\[yank]."
1432 (interactive "p")
1433 (if (zerop (ibuffer-count-marked-lines))
1434 (message "No buffers marked; use 'm' to mark a buffer")
1435 (let ((result "")
1436 (type (cond ((or (null arg) (zerop arg))
1437 'full)
1438 ((= arg 4)
1439 'relative)
1440 (t
1441 'name))))
1442 (ibuffer-map-marked-lines
1443 #'(lambda (buf _mark)
1444 (setq result
1445 (concat result
1446 (let ((name (buffer-file-name buf)))
1447 (cond (name
1448 (concat
1449 (pcase type
1450 (`full
1451 name)
1452 (`relative
1453 (file-relative-name
1454 name (or ibuffer-default-directory
1455 default-directory)))
1456 (_
1457 (file-name-nondirectory name))) " "))
1458 (t "")))))))
1459 (when (not (zerop (length result)))
1460 (setq result
1461 (substring result 0 -1)))
1462 (kill-new result)
1463 (message "%s" result))))
1464
1465 (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1466 (let ((count
1467 (ibuffer-map-lines
1468 #'(lambda (buf _mark)
1469 (when (funcall func buf)
1470 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1471 ibuffer-marked-char))
1472 t))
1473 nil
1474 group)))
1475 (ibuffer-redisplay t)
1476 (unless (eq ibuffer-mark-on-buffer-mark ?\s)
1477 (message "Marked %s buffers" count))))
1478
1479 ;;;###autoload
1480 (defun ibuffer-mark-by-name-regexp (regexp)
1481 "Mark all buffers whose name matches REGEXP."
1482 (interactive "sMark by name (regexp): ")
1483 (ibuffer-mark-on-buffer
1484 #'(lambda (buf)
1485 (string-match regexp (buffer-name buf)))))
1486
1487 (defun ibuffer-locked-buffer-p (&optional buf)
1488 "Return non-nil if BUF is locked.
1489 When BUF nil, default to the buffer at current line."
1490 (let ((_buffer (or buf (ibuffer-current-buffer)))
1491 char)
1492 (when _buffer
1493 (with-current-buffer _buffer
1494 (and (boundp 'emacs-lock-mode) emacs-lock-mode)))))
1495
1496 ;;;###autoload
1497 (defun ibuffer-mark-by-locked ()
1498 "Mark all locked buffers."
1499 (interactive)
1500 (when (featurep 'emacs-lock)
1501 (ibuffer-mark-on-buffer
1502 (lambda (buf)
1503 (ibuffer-locked-buffer-p buf)))))
1504
1505 ;;;###autoload
1506 (defun ibuffer-mark-by-mode-regexp (regexp)
1507 "Mark all buffers whose major mode matches REGEXP."
1508 (interactive "sMark by major mode (regexp): ")
1509 (ibuffer-mark-on-buffer
1510 #'(lambda (buf)
1511 (with-current-buffer buf
1512 (string-match regexp (format-mode-line mode-name nil nil buf))))))
1513
1514 ;;;###autoload
1515 (defun ibuffer-mark-by-file-name-regexp (regexp)
1516 "Mark all buffers whose file name matches REGEXP."
1517 (interactive "sMark by file name (regexp): ")
1518 (ibuffer-mark-on-buffer
1519 #'(lambda (buf)
1520 (let ((name (or (buffer-file-name buf)
1521 (with-current-buffer buf
1522 (and
1523 (boundp 'dired-directory)
1524 (stringp dired-directory)
1525 dired-directory)))))
1526 (when name
1527 (string-match regexp name))))))
1528
1529 ;;;###autoload
1530 (defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
1531 "Mark all buffers whose content matches REGEXP.
1532 Optional arg ALL-BUFFERS, if non-nil, then search in all buffers.
1533 Otherwise buffers whose name matches an element of
1534 `ibuffer-never-search-content-name' or whose major mode is on
1535 `ibuffer-never-search-content-mode' are excluded."
1536 (interactive (let ((reg (read-string "Mark by content (regexp): ")))
1537 (list reg current-prefix-arg)))
1538 (ibuffer-mark-on-buffer
1539 #'(lambda (buf)
1540 (let ((mode (with-current-buffer buf major-mode))
1541 res)
1542 (cond ((and (not all-buffers)
1543 (or
1544 (memq mode ibuffer-never-search-content-mode)
1545 (cl-some (lambda (x) (string-match x (buffer-name buf)))
1546 ibuffer-never-search-content-name)))
1547 (setq res nil))
1548 (t
1549 (with-current-buffer buf
1550 (save-mark-and-excursion
1551 (goto-char (point-min))
1552 (setq res (re-search-forward regexp nil t)))))) res))))
1553
1554 ;;;###autoload
1555 (defun ibuffer-mark-by-mode (mode)
1556 "Mark all buffers whose major mode equals MODE."
1557 (interactive
1558 (let* ((buf (ibuffer-current-buffer))
1559 (default (if (and buf (buffer-live-p buf))
1560 (symbol-name (buffer-local-value
1561 'major-mode buf)))))
1562 (list (intern
1563 (completing-read
1564 (if default
1565 (format "Mark by major mode (default %s): " default)
1566 "Mark by major mode: ")
1567 (ibuffer-list-buffer-modes) nil t nil nil default)))))
1568 (ibuffer-mark-on-buffer
1569 #'(lambda (buf)
1570 (eq (buffer-local-value 'major-mode buf) mode))))
1571
1572 ;;;###autoload
1573 (defun ibuffer-mark-modified-buffers ()
1574 "Mark all modified buffers."
1575 (interactive)
1576 (ibuffer-mark-on-buffer
1577 #'(lambda (buf) (buffer-modified-p buf))))
1578
1579 ;;;###autoload
1580 (defun ibuffer-mark-unsaved-buffers ()
1581 "Mark all modified buffers that have an associated file."
1582 (interactive)
1583 (ibuffer-mark-on-buffer
1584 #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
1585 (buffer-modified-p buf)))))
1586
1587 ;;;###autoload
1588 (defun ibuffer-mark-dissociated-buffers ()
1589 "Mark all buffers whose associated file does not exist."
1590 (interactive)
1591 (ibuffer-mark-on-buffer
1592 #'(lambda (buf)
1593 (with-current-buffer buf
1594 (or
1595 (and buffer-file-name
1596 (not (file-exists-p buffer-file-name)))
1597 (and (eq major-mode 'dired-mode)
1598 (boundp 'dired-directory)
1599 (stringp dired-directory)
1600 (not (file-exists-p (file-name-directory dired-directory)))))))))
1601
1602 ;;;###autoload
1603 (defun ibuffer-mark-help-buffers ()
1604 "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
1605 (interactive)
1606 (ibuffer-mark-on-buffer
1607 #'(lambda (buf)
1608 (with-current-buffer buf
1609 (memq major-mode ibuffer-help-buffer-modes)))))
1610
1611 ;;;###autoload
1612 (defun ibuffer-mark-compressed-file-buffers ()
1613 "Mark buffers whose associated file is compressed."
1614 (interactive)
1615 (ibuffer-mark-on-buffer
1616 #'(lambda (buf)
1617 (with-current-buffer buf
1618 (and buffer-file-name
1619 (string-match ibuffer-compressed-file-name-regexp
1620 buffer-file-name))))))
1621
1622 ;;;###autoload
1623 (defun ibuffer-mark-old-buffers ()
1624 "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
1625 (interactive)
1626 (ibuffer-mark-on-buffer
1627 #'(lambda (buf)
1628 (with-current-buffer buf
1629 ;; hacked from midnight.el
1630 (when buffer-display-time
1631 (let* ((now (float-time))
1632 (then (float-time buffer-display-time)))
1633 (> (- now then) (* 60 60 ibuffer-old-time))))))))
1634
1635 ;;;###autoload
1636 (defun ibuffer-mark-special-buffers ()
1637 "Mark all buffers whose name begins and ends with `*'."
1638 (interactive)
1639 (ibuffer-mark-on-buffer
1640 #'(lambda (buf) (string-match "^\\*.+\\*$"
1641 (buffer-name buf)))))
1642
1643 ;;;###autoload
1644 (defun ibuffer-mark-read-only-buffers ()
1645 "Mark all read-only buffers."
1646 (interactive)
1647 (ibuffer-mark-on-buffer
1648 #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
1649
1650 ;;;###autoload
1651 (defun ibuffer-mark-dired-buffers ()
1652 "Mark all `dired' buffers."
1653 (interactive)
1654 (ibuffer-mark-on-buffer
1655 #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
1656
1657 ;;;###autoload
1658 (defun ibuffer-do-occur (regexp &optional nlines)
1659 "View lines which match REGEXP in all marked buffers.
1660 Optional argument NLINES says how many lines of context to display: it
1661 defaults to one."
1662 (interactive (occur-read-primary-args))
1663 (if (or (not (integerp nlines))
1664 (< nlines 0))
1665 (setq nlines 0))
1666 (when (zerop (ibuffer-count-marked-lines))
1667 (ibuffer-set-mark ibuffer-marked-char))
1668 (let ((ibuffer-do-occur-bufs nil))
1669 ;; Accumulate a list of marked buffers
1670 (ibuffer-map-marked-lines
1671 #'(lambda (buf _mark)
1672 (push buf ibuffer-do-occur-bufs)))
1673 (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1674
1675 (provide 'ibuf-ext)
1676
1677 ;; Local Variables:
1678 ;; generated-autoload-file: "ibuffer-loaddefs.el"
1679 ;; End:
1680
1681 ;;; ibuf-ext.el ends here