Add new command gnus-article-sort-by-marks
[emacs.git] / lisp / ibuf-ext.el
blob058eaecb3658445fceab552e6238639aae902737
1 ;;; ibuf-ext.el --- extensions for ibuffer -*- lexical-binding:t -*-
3 ;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
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
11 ;; This file is part of GNU Emacs.
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.
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.
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/>.
26 ;;; Commentary:
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.
32 ;; For details on the structure of ibuffer filters and filter groups,
33 ;; see the documentation for variables `ibuffer-filtering-qualifiers',
34 ;; `ibuffer-filter-groups', and `ibuffer-saved-filters' in that order.
35 ;; The variable `ibuffer-filtering-alist' contains names and
36 ;; descriptions of the currently defined filters; also see the macro
37 ;; `define-ibuffer-filter'.
39 ;;; Code:
41 (require 'ibuffer)
43 (eval-when-compile
44 (require 'ibuf-macs)
45 (require 'cl-lib)
46 (require 'subr-x))
48 ;;; Utility functions
49 (defun ibuffer-remove-alist (key alist)
50 "Remove all entries in ALIST that have a key equal to KEY."
51 (while (ibuffer-awhen (assoc key alist)
52 (setq alist (remove it alist)) it))
53 alist)
55 ;; borrowed from Gnus
56 (defun ibuffer-remove-duplicates (list)
57 "Return a copy of LIST with duplicate elements removed."
58 (let ((new nil)
59 (tail list))
60 (while tail
61 (or (member (car tail) new)
62 (setq new (cons (car tail) new)))
63 (setq tail (cdr tail)))
64 (nreverse new)))
66 (defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
67 (let ((hip-crowd nil)
68 (lamers nil))
69 (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
70 (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
71 (push ibuffer-split-list-elt hip-crowd)
72 (push ibuffer-split-list-elt lamers)))
73 ;; Too bad Emacs Lisp doesn't have multiple values.
74 (list (nreverse hip-crowd) (nreverse lamers))))
76 (defcustom ibuffer-never-show-predicates nil
77 "A list of predicates (a regexp or function) for buffers not to display.
78 If a regexp, then it will be matched against the buffer's name.
79 If a function, it will be called with the buffer as an argument, and
80 should return non-nil if this buffer should not be shown."
81 :type '(repeat (choice regexp function))
82 :require 'ibuf-ext
83 :group 'ibuffer)
85 (defcustom ibuffer-always-show-predicates nil
86 "A list of predicates (a regexp or function) for buffers to always display.
87 If a regexp, then it will be matched against the buffer's name.
88 If a function, it will be called with the buffer as an argument, and
89 should return non-nil if this buffer should be shown.
90 Note that buffers matching one of these predicates will be shown
91 regardless of any active filters in this buffer."
92 :type '(repeat (choice regexp function))
93 :group 'ibuffer)
95 (defcustom ibuffer-never-search-content-name
96 (let* ((names '("Completions" "Help" "Messages" "Pp Eval Output"
97 "CompileLog" "Info" "Buffer List" "Ibuffer" "Apropos"))
98 (partial '("Customize Option: " "Async Shell Command\\*"
99 "Shell Command Output\\*" "ediff "))
100 (beg "\\`\\*")
101 (end "\\*\\'")
102 (excluded (mapcar (lambda (x)
103 (format "%s%s" beg x)) partial)))
104 (dolist (str names (nreverse excluded))
105 (push (format "%s%s%s" beg str end) excluded)))
106 "A list of regexps for buffers ignored by `ibuffer-mark-by-content-regexp'.
107 Buffers whose name matches a regexp in this list, are not searched."
108 :version "26.1"
109 :type '(repeat regexp)
110 :require 'ibuf-ext
111 :group 'ibuffer)
113 (defcustom ibuffer-never-search-content-mode '(dired-mode)
114 "A list of major modes ignored by `ibuffer-mark-by-content-regexp'.
115 Buffers whose major mode is in this list, are not searched."
116 :version "26.1"
117 :type '(repeat regexp)
118 :require 'ibuf-ext
119 :group 'ibuffer)
121 (defvar ibuffer-tmp-hide-regexps nil
122 "A list of regexps which should match buffer names to not show.")
124 (defvar ibuffer-tmp-show-regexps nil
125 "A list of regexps which should match buffer names to always show.")
127 (defvar ibuffer-auto-buffers-changed nil)
129 (defun ibuffer-update-saved-filters-format (filters)
130 "Transforms alist from old to new `ibuffer-saved-filters' format.
132 Specifically, converts old-format alist with values of the
133 form (STRING (FILTER-SPECS...)) to alist with values of the
134 form (STRING FILTER-SPECS...), where each filter spec should be a
135 cons cell with a symbol in the car. Any elements in the latter
136 form are kept as is.
138 Returns (OLD-FORMAT-DETECTED . UPDATED-SAVED-FILTERS-LIST)."
139 (when filters
140 (let* ((old-format-detected nil)
141 (fix-filter (lambda (filter-spec)
142 (if (symbolp (car (cadr filter-spec)))
143 filter-spec
144 (setq old-format-detected t) ; side-effect
145 (cons (car filter-spec) (cadr filter-spec)))))
146 (fixed (mapcar fix-filter filters)))
147 (cons old-format-detected fixed))))
149 (defcustom ibuffer-saved-filters '(("programming"
150 (or (derived-mode . prog-mode)
151 (mode . ess-mode)
152 (mode . compilation-mode)))
153 ("text document"
154 (and (derived-mode . text-mode)
155 (not (starred-name))))
156 ("TeX"
157 (or (derived-mode . tex-mode)
158 (mode . latex-mode)
159 (mode . context-mode)
160 (mode . ams-tex-mode)
161 (mode . bibtex-mode)))
162 ("web"
163 (or (derived-mode . sgml-mode)
164 (derived-mode . css-mode)
165 (mode . javascript-mode)
166 (mode . js2-mode)
167 (mode . scss-mode)
168 (derived-mode . haml-mode)
169 (mode . sass-mode)))
170 ("gnus"
171 (or (mode . message-mode)
172 (mode . mail-mode)
173 (mode . gnus-group-mode)
174 (mode . gnus-summary-mode)
175 (mode . gnus-article-mode))))
177 "An alist mapping saved filter names to filter specifications.
179 Each element should look like (\"NAME\" . FILTER-LIST), where
180 FILTER-LIST has the same structure as the variable
181 `ibuffer-filtering-qualifiers', which see. The filters defined
182 here are joined with an implicit logical `and' and associated
183 with NAME. The combined specification can be used by name in
184 other filter specifications via the `saved' qualifier (again, see
185 `ibuffer-filtering-qualifiers'). They can also be switched to by
186 name (see the functions `ibuffer-switch-to-saved-filters' and
187 `ibuffer-save-filters'). The variable `ibuffer-save-with-custom'
188 affects how this information is saved for future sessions. This
189 variable can be set directly from lisp code."
190 :version "26.1"
191 :type '(alist :key-type (string :tag "Filter name")
192 :value-type (repeat :tag "Filter specification" sexp))
193 :set (lambda (symbol value)
194 ;; Just set-default but update legacy old-style format
195 (set-default symbol (cdr (ibuffer-update-saved-filters-format value))))
196 :group 'ibuffer)
198 (defvar ibuffer-old-saved-filters-warning
199 (concat "Deprecated format detected for variable `ibuffer-saved-filters'.
201 The format has been repaired and the variable modified accordingly.
202 You can save the current value through the customize system by
203 either clicking or hitting return "
204 (make-text-button
205 "here" nil
206 'face '(:weight bold :inherit button)
207 'mouse-face '(:weight normal :background "gray50" :inherit button)
208 'follow-link t
209 'help-echo "Click or RET: save new value in customize"
210 'action (lambda (_)
211 (if (not (fboundp 'customize-save-variable))
212 (message "Customize not available; value not saved")
213 (customize-save-variable 'ibuffer-saved-filters
214 ibuffer-saved-filters)
215 (message "Saved updated ibuffer-saved-filters."))))
216 ". See below for
217 an explanation and alternative ways to save the repaired value.
219 Explanation: For the list variable `ibuffer-saved-filters',
220 elements of the form (STRING (FILTER-SPECS...)) are deprecated
221 and should instead have the form (STRING FILTER-SPECS...), where
222 each filter spec is a cons cell with a symbol in the car. See
223 `ibuffer-saved-filters' for details. The repaired value fixes
224 this format without changing the meaning of the saved filters.
226 Alternative ways to save the repaired value:
228 1. Do M-x customize-variable and entering `ibuffer-saved-filters'
229 when prompted.
231 2. Set the updated value manually by copying the
232 following emacs-lisp form to your emacs init file.
237 (defvar ibuffer-filtering-qualifiers nil
238 "A list specifying the filters currently acting on the buffer list.
240 If this list is nil, then no filters are currently in
241 effect. Otherwise, each element of this list specifies a single
242 filter, and all of the specified filters in the list are applied
243 successively to the buffer list.
245 Each filter specification can be of two types: simple or compound.
247 A simple filter specification has the form (SYMBOL . QUALIFIER),
248 where SYMBOL is a key in the alist `ibuffer-filtering-alist' that
249 determines the filter function to use and QUALIFIER is the data
250 passed to that function (along with the buffer being considered).
252 A compound filter specification can have one of four forms:
254 -- (not FILTER-SPEC)
256 Represents the logical complement of FILTER-SPEC, which
257 is any single filter specification, simple or compound.
258 The form (not . FILTER-SPEC) is also accepted here.
260 -- (and FILTER-SPECS...)
262 Represents the logical-and of the filters defined by one or
263 more filter specifications FILTER-SPECS..., where each
264 specification can be simple or compound. Note that and is
265 implicitly applied to the filters in the top-level list.
267 -- (or FILTER-SPECS...)
269 Represents the logical-or of the filters defined by one or
270 more filter specifications FILTER-SPECS..., where each
271 specification can be simple or compound.
273 -- (saved . \"NAME\")
275 Represents the filter saved under the string NAME
276 in the alist `ibuffer-saved-filters'. It is an
277 error to name a filter that has not been saved.
279 This variable is local to each ibuffer buffer.")
281 ;; This is now frobbed by `define-ibuffer-filter'.
282 (defvar ibuffer-filtering-alist nil
283 "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
285 You most likely do not want to modify this variable directly; see
286 `define-ibuffer-filter'.
288 SYMBOL is the symbolic name of the filter. DESCRIPTION is used when
289 displaying information to the user. FUNCTION is given a buffer and
290 the value of the qualifier, and returns non-nil if and only if the
291 buffer should be displayed.")
293 (defcustom ibuffer-filter-format-alist nil
294 "An alist which has special formats used when a filter is active.
295 The contents of this variable should look like:
296 ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
298 For example, suppose that when you add a filter for buffers whose
299 major mode is `emacs-lisp-mode', you only want to see the mark and the
300 name of the buffer. You could accomplish that by adding:
301 (mode ((mark \" \" name)))
302 to this variable."
303 :type '(repeat (list :tag "Association" (symbol :tag "Filter")
304 (list :tag "Formats" (repeat (sexp :tag "Format")))))
305 :group 'ibuffer)
307 (defvar ibuffer-cached-filter-formats nil)
308 (defvar ibuffer-compiled-filter-formats nil)
310 (defvar ibuffer-filter-groups nil
311 "An alist giving this buffer's active filter groups, or nil if none.
313 This alist maps filter group labels to filter specification
314 lists. Each element has the form (\"LABEL\" FILTER-SPECS...),
315 where FILTER-SPECS... represents one or more filter
316 specifications of the same form as allowed as elements of
317 `ibuffer-filtering-qualifiers'.
319 Each filter group is displayed as a separate section in the
320 ibuffer list, headed by LABEL and displaying only the buffers
321 that pass through all the filters associated with NAME in this
322 list.")
324 (defcustom ibuffer-show-empty-filter-groups t
325 "If non-nil, then show the names of filter groups which are empty."
326 :type 'boolean
327 :group 'ibuffer)
329 (defcustom ibuffer-saved-filter-groups nil
330 "An alist of filtering groups to switch between.
332 Each element is of the form (\"NAME\" . FILTER-GROUP-LIST),
333 where NAME is a unique but arbitrary name and FILTER-GROUP-LIST
334 is a list of filter groups with the same structure as
335 allowed for `ibuffer-filter-groups'.
337 See also the functions `ibuffer-save-filter-groups' and
338 `ibuffer-switch-to-saved-filter-groups' for saving and switching
339 between sets of filter groups, and the variable
340 `ibuffer-save-with-custom' that affects how this information is
341 saved."
342 :type '(repeat sexp)
343 :group 'ibuffer)
345 (defvar ibuffer-hidden-filter-groups nil
346 "The list of filter groups that are currently hidden.")
348 (defvar ibuffer-filter-group-kill-ring nil)
350 (defcustom ibuffer-old-time 72
351 "The number of hours before a buffer is considered \"old\"."
352 :type '(choice (const :tag "72 hours (3 days)" 72)
353 (const :tag "48 hours (2 days)" 48)
354 (const :tag "24 hours (1 day)" 24)
355 (integer :tag "hours"))
356 :group 'ibuffer)
358 (defcustom ibuffer-save-with-custom t
359 "If non-nil, then use Custom to save interactively changed variables.
360 Currently, this only applies to `ibuffer-saved-filters' and
361 `ibuffer-saved-filter-groups'."
362 :type 'boolean
363 :group 'ibuffer)
365 (defun ibuffer-repair-saved-filters ()
366 "Updates `ibuffer-saved-filters' to its new-style format, if needed.
368 If this list has any elements of the old-style format, a
369 deprecation warning is raised, with a button allowing persistent
370 update. Any updated filters retain their meaning in the new
371 format. See `ibuffer-update-saved-filters-format' and
372 `ibuffer-saved-filters' for details of the old and new formats."
373 (interactive)
374 (when (and (boundp 'ibuffer-saved-filters) ibuffer-saved-filters)
375 (let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters)))
376 (prog1
377 (setq ibuffer-saved-filters (cdr fixed))
378 (when-let (old-format-detected (car fixed))
379 (let ((warning-series t)
380 (updated-form
381 (with-output-to-string
382 (pp `(setq ibuffer-saved-filters ',ibuffer-saved-filters)))))
383 (display-warning
384 'ibuffer
385 (format ibuffer-old-saved-filters-warning updated-form))))))))
387 (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
389 (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
390 (and (not
392 (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
393 (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
394 (or all
395 (not
396 (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
397 (or ibuffer-view-ibuffer
398 (and ibuffer-buf
399 (not (eq ibuffer-buf buf))))
401 (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
402 (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
404 ;;;###autoload
405 (define-minor-mode ibuffer-auto-mode
406 "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode).
407 With a prefix argument ARG, enable Ibuffer Auto mode if ARG is
408 positive, and disable it otherwise. If called from Lisp, enable
409 the mode if ARG is omitted or nil."
410 nil nil nil
411 (unless (derived-mode-p 'ibuffer-mode)
412 (error "This buffer is not in Ibuffer mode"))
413 (cond (ibuffer-auto-mode
414 (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
415 (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
417 (remove-hook 'post-command-hook 'ibuffer-auto-update-changed))))
419 (defun ibuffer-auto-update-changed ()
420 (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
421 (dolist (buf (buffer-list))
422 (ignore-errors
423 (with-current-buffer buf
424 (when (and ibuffer-auto-mode
425 (derived-mode-p 'ibuffer-mode))
426 (ibuffer-update nil t)))))))
428 ;;;###autoload
429 (defun ibuffer-mouse-filter-by-mode (event)
430 "Enable or disable filtering by the major mode chosen via mouse."
431 (interactive "e")
432 (ibuffer-interactive-filter-by-mode event))
434 ;;;###autoload
435 (defun ibuffer-interactive-filter-by-mode (event-or-point)
436 "Enable or disable filtering by the major mode at point."
437 (interactive "d")
438 (if (eventp event-or-point)
439 (posn-set-point (event-end event-or-point))
440 (goto-char event-or-point))
441 (let ((buf (ibuffer-current-buffer)))
442 (if (assq 'mode ibuffer-filtering-qualifiers)
443 (setq ibuffer-filtering-qualifiers
444 (ibuffer-remove-alist 'mode ibuffer-filtering-qualifiers))
445 (ibuffer-push-filter (cons 'mode (buffer-local-value 'major-mode buf)))))
446 (ibuffer-update nil t))
448 ;;;###autoload
449 (defun ibuffer-mouse-toggle-filter-group (event)
450 "Toggle the display status of the filter group chosen with the mouse."
451 (interactive "e")
452 (ibuffer-toggle-filter-group-1 (save-excursion
453 (mouse-set-point event)
454 (point))))
456 ;;;###autoload
457 (defun ibuffer-toggle-filter-group ()
458 "Toggle the display status of the filter group on this line."
459 (interactive)
460 (ibuffer-toggle-filter-group-1 (point)))
462 (defun ibuffer-toggle-filter-group-1 (posn)
463 (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
464 (unless (stringp name)
465 (error "No filtering group name present"))
466 (if (member name ibuffer-hidden-filter-groups)
467 (setq ibuffer-hidden-filter-groups
468 (delete name ibuffer-hidden-filter-groups))
469 (push name ibuffer-hidden-filter-groups))
470 (ibuffer-update nil t)))
472 ;;;###autoload
473 (defun ibuffer-forward-filter-group (&optional count)
474 "Move point forwards by COUNT filtering groups."
475 (interactive "P")
476 (unless count
477 (setq count 1))
478 (when (> count 0)
479 (when (get-text-property (point) 'ibuffer-filter-group-name)
480 (goto-char (next-single-property-change
481 (point) 'ibuffer-filter-group-name
482 nil (point-max))))
483 (goto-char (next-single-property-change
484 (point) 'ibuffer-filter-group-name
485 nil (point-max)))
486 (ibuffer-forward-filter-group (1- count)))
487 (ibuffer-forward-line 0))
489 ;;;###autoload
490 (defun ibuffer-backward-filter-group (&optional count)
491 "Move point backwards by COUNT filtering groups."
492 (interactive "P")
493 (unless count
494 (setq count 1))
495 (when (> count 0)
496 (when (get-text-property (point) 'ibuffer-filter-group-name)
497 (goto-char (previous-single-property-change
498 (point) 'ibuffer-filter-group-name
499 nil (point-min))))
500 (goto-char (previous-single-property-change
501 (point) 'ibuffer-filter-group-name
502 nil (point-min)))
503 (ibuffer-backward-filter-group (1- count)))
504 (when (= (point) (point-min))
505 (goto-char (point-max))
506 (ibuffer-backward-filter-group 1))
507 (ibuffer-forward-line 0))
509 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
510 (define-ibuffer-op shell-command-pipe (command)
511 "Pipe the contents of each marked buffer to shell command COMMAND."
512 (:interactive "sPipe to shell command: "
513 :opstring "Shell command executed on"
514 :modifier-p nil)
515 (shell-command-on-region
516 (point-min) (point-max) command))
518 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
519 (define-ibuffer-op shell-command-pipe-replace (command)
520 "Replace the contents of marked buffers with output of pipe to COMMAND."
521 (:interactive "sPipe to shell command (replace): "
522 :opstring "Buffer contents replaced in"
523 :active-opstring "replace buffer contents in"
524 :dangerous t
525 :modifier-p t)
526 (with-current-buffer buf
527 (shell-command-on-region (point-min) (point-max)
528 command nil t)))
530 ;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
531 (define-ibuffer-op shell-command-file (command)
532 "Run shell command COMMAND separately on files of marked buffers."
533 (:interactive "sShell command on buffer's file: "
534 :opstring "Shell command executed on"
535 :modifier-p nil)
536 (shell-command (concat command " "
537 (shell-quote-argument
538 (or buffer-file-name
539 (let ((file
540 (make-temp-file
541 (substring
542 (buffer-name) 0
543 (min 10 (length (buffer-name)))))))
544 (write-region nil nil file nil 0)
545 file))))))
547 ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
548 (define-ibuffer-op eval (form)
549 "Evaluate FORM in each of the buffers.
550 Does not display the buffer during evaluation. See
551 `ibuffer-do-view-and-eval' for that."
552 (:interactive
553 (list
554 (read-from-minibuffer
555 "Eval in buffers (form): "
556 nil read-expression-map t 'read-expression-history))
557 :opstring "evaluated in"
558 :modifier-p :maybe)
559 (eval form))
561 ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
562 (define-ibuffer-op view-and-eval (form)
563 "Evaluate FORM while displaying each of the marked buffers.
564 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
565 (:interactive
566 (list
567 (read-from-minibuffer
568 "Eval viewing in buffers (form): "
569 nil read-expression-map t 'read-expression-history))
570 :opstring "evaluated in"
571 :complex t
572 :modifier-p :maybe)
573 (let ((ibuffer-buf (current-buffer)))
574 (unwind-protect
575 (progn
576 (switch-to-buffer buf)
577 (eval form))
578 (switch-to-buffer ibuffer-buf))))
580 ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
581 (define-ibuffer-op rename-uniquely ()
582 "Rename marked buffers as with `rename-uniquely'."
583 (:opstring "renamed"
584 :modifier-p t)
585 (rename-uniquely))
587 ;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
588 (define-ibuffer-op revert ()
589 "Revert marked buffers as with `revert-buffer'."
590 (:dangerous t
591 :opstring "reverted"
592 :active-opstring "revert"
593 :modifier-p :maybe)
594 (revert-buffer t t))
596 ;;;###autoload (autoload 'ibuffer-do-isearch "ibuf-ext")
597 (define-ibuffer-op ibuffer-do-isearch ()
598 "Perform a `isearch-forward' in marked buffers."
599 (:interactive ()
600 :opstring "searched in"
601 :complex t
602 :modifier-p :maybe)
603 (multi-isearch-buffers (ibuffer-get-marked-buffers)))
605 ;;;###autoload (autoload 'ibuffer-do-isearch-regexp "ibuf-ext")
606 (define-ibuffer-op ibuffer-do-isearch-regexp ()
607 "Perform a `isearch-forward-regexp' in marked buffers."
608 (:interactive ()
609 :opstring "searched regexp in"
610 :complex t
611 :modifier-p :maybe)
612 (multi-isearch-buffers-regexp (ibuffer-get-marked-buffers)))
614 ;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
615 (define-ibuffer-op replace-regexp (from-str to-str)
616 "Perform a `replace-regexp' in marked buffers."
617 (:interactive
618 (let* ((from-str (read-from-minibuffer "Replace regexp: "))
619 (to-str (read-from-minibuffer (concat "Replace " from-str
620 " with: "))))
621 (list from-str to-str))
622 :opstring "replaced in"
623 :complex t
624 :modifier-p :maybe)
625 (save-window-excursion
626 (switch-to-buffer buf)
627 (save-excursion
628 (goto-char (point-min))
629 (let ((case-fold-search ibuffer-case-fold-search))
630 (while (re-search-forward from-str nil t)
631 (replace-match to-str))))
634 ;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
635 (define-ibuffer-op query-replace (&rest args)
636 "Perform a `query-replace' in marked buffers."
637 (:interactive
638 (query-replace-read-args "Query replace" t t)
639 :opstring "replaced in"
640 :complex t
641 :modifier-p :maybe)
642 (save-window-excursion
643 (switch-to-buffer buf)
644 (save-excursion
645 (let ((case-fold-search ibuffer-case-fold-search))
646 (goto-char (point-min))
647 (apply #'query-replace args)))
650 ;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
651 (define-ibuffer-op query-replace-regexp (&rest args)
652 "Perform a `query-replace-regexp' in marked buffers."
653 (:interactive
654 (query-replace-read-args "Query replace regexp" t t)
655 :opstring "replaced in"
656 :complex t
657 :modifier-p :maybe)
658 (save-window-excursion
659 (switch-to-buffer buf)
660 (save-excursion
661 (let ((case-fold-search ibuffer-case-fold-search))
662 (goto-char (point-min))
663 (apply #'query-replace-regexp args)))
666 ;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
667 (define-ibuffer-op print ()
668 "Print marked buffers as with `print-buffer'."
669 (:opstring "printed"
670 :modifier-p nil)
671 (print-buffer))
673 ;;;###autoload
674 (defun ibuffer-included-in-filters-p (buf filters)
675 "Return non-nil if BUF passes all FILTERS.
677 BUF is a lisp buffer object, and FILTERS is a list of filter
678 specifications with the same structure as
679 `ibuffer-filtering-qualifiers'."
680 (not
681 (memq nil ;; a filter will return nil if it failed
682 (mapcar #'(lambda (filter)
683 (ibuffer-included-in-filter-p buf filter))
684 filters))))
686 (defun ibuffer-unary-operand (filter)
687 "Extracts operand from a unary compound FILTER specification.
689 FILTER should be a cons cell of either form (f . d) or (f d),
690 where operand d is itself a cons cell, or nil. Returns d."
691 (let* ((tail (cdr filter))
692 (maybe-q (car-safe tail)))
693 (if (consp maybe-q) maybe-q tail)))
695 (defun ibuffer-included-in-filter-p (buf filter)
696 "Return non-nil if BUF pass FILTER.
698 BUF is a lisp buffer object, and FILTER is a filter
699 specification, with the same structure as an element of the list
700 `ibuffer-filtering-qualifiers'."
701 (if (eq (car filter) 'not)
702 (let ((inner (ibuffer-unary-operand filter)))
703 ;; Allows (not (not ...)) etc, which may be overkill
704 (if (eq (car inner) 'not)
705 (ibuffer-included-in-filter-p buf (ibuffer-unary-operand inner))
706 (not (ibuffer-included-in-filter-p-1 buf inner))))
707 (ibuffer-included-in-filter-p-1 buf filter)))
709 (defun ibuffer-included-in-filter-p-1 (buf filter)
710 (not
711 (not
712 (pcase (car filter)
713 (`or
714 ;;; ATTN: Short-circuiting alternative with parallel structure w/`and
715 ;;(catch 'has-match
716 ;; (dolist (filter-spec (cdr filter) nil)
717 ;; (when (ibuffer-included-in-filter-p buf filter-spec)
718 ;; (throw 'has-match t))))
719 (memq t (mapcar #'(lambda (x)
720 (ibuffer-included-in-filter-p buf x))
721 (cdr filter))))
722 (`and
723 (catch 'no-match
724 (dolist (filter-spec (cdr filter) t)
725 (unless (ibuffer-included-in-filter-p buf filter-spec)
726 (throw 'no-match nil)))))
727 (`saved
728 (let ((data (assoc (cdr filter) ibuffer-saved-filters)))
729 (unless data
730 (ibuffer-filter-disable t)
731 (error "Unknown saved filter %s" (cdr filter)))
732 (ibuffer-included-in-filters-p buf (cdr data))))
734 (pcase-let ((`(,_type ,_desc ,func)
735 (assq (car filter) ibuffer-filtering-alist)))
736 (unless func
737 (ibuffer-filter-disable t)
738 (error "Undefined filter %s" (car filter)))
739 (funcall func buf (cdr filter))))))))
741 (defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
742 (let ((filter-group-alist (if nodefault
743 ibuffer-filter-groups
744 (append ibuffer-filter-groups
745 (list (cons "Default" nil))))))
746 ;; (dolist (hidden ibuffer-hidden-filter-groups)
747 ;; (setq filter-group-alist (ibuffer-remove-alist
748 ;; hidden filter-group-alist)))
749 (let ((vec (make-vector (length filter-group-alist) nil))
750 (i 0))
751 (dolist (filtergroup filter-group-alist)
752 (let ((filterset (cdr filtergroup)))
753 (cl-multiple-value-bind (hip-crowd lamers)
754 (cl-values-list
755 (ibuffer-split-list (lambda (bufmark)
756 (ibuffer-included-in-filters-p (car bufmark)
757 filterset))
758 bmarklist))
759 (aset vec i hip-crowd)
760 (cl-incf i)
761 (setq bmarklist lamers))))
762 (let (ret)
763 (dotimes (j i)
764 (let ((bufs (aref vec j)))
765 (unless (and noempty (null bufs))
766 (push (cons (car (nth j filter-group-alist))
767 bufs)
768 ret))))
769 ret))))
771 ;;;###autoload
772 (defun ibuffer-filters-to-filter-group (name)
773 "Make the current filters into a filtering group."
774 (interactive "sName for filtering group: ")
775 (when (null ibuffer-filtering-qualifiers)
776 (error "No filters in effect"))
777 (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
778 (ibuffer-filter-disable))
780 ;;;###autoload
781 (defun ibuffer-set-filter-groups-by-mode ()
782 "Set the current filter groups to filter by mode."
783 (interactive)
784 (setq ibuffer-filter-groups
785 (mapcar (lambda (mode)
786 (cons (format "%s" mode) `((mode . ,mode))))
787 (let ((modes
788 (ibuffer-remove-duplicates
789 (mapcar (lambda (buf)
790 (buffer-local-value 'major-mode buf))
791 (buffer-list)))))
792 (if ibuffer-view-ibuffer
793 modes
794 (delq 'ibuffer-mode modes)))))
795 (ibuffer-update nil t))
797 ;;;###autoload
798 (defun ibuffer-pop-filter-group ()
799 "Remove the first filter group."
800 (interactive)
801 (when (null ibuffer-filter-groups)
802 (error "No filter groups active"))
803 (setq ibuffer-hidden-filter-groups
804 (delete (pop ibuffer-filter-groups)
805 ibuffer-hidden-filter-groups))
806 (ibuffer-update nil t))
808 (defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
809 (when (and (not noerror) (null ibuffer-filter-groups))
810 (error "No filter groups active"))
811 ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
812 ;; groups, possibly excluding empty groups or Default.
813 ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
814 ;; Default if necessary.
815 (completing-read msg (nconc
816 (ibuffer-generate-filter-groups
817 (ibuffer-current-state-list)
818 (not ibuffer-show-empty-filter-groups)
819 nodefault)
820 (if nodefault
821 (remove "Default" ibuffer-hidden-filter-groups)
822 ibuffer-hidden-filter-groups))
823 nil t))
825 ;;;###autoload
826 (defun ibuffer-decompose-filter-group (group)
827 "Decompose the filter group GROUP into active filters."
828 (interactive
829 (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
830 (let ((data (cdr (assoc group ibuffer-filter-groups))))
831 (setq ibuffer-filter-groups (ibuffer-remove-alist
832 group ibuffer-filter-groups)
833 ibuffer-filtering-qualifiers data))
834 (ibuffer-update nil t))
836 ;;;###autoload
837 (defun ibuffer-clear-filter-groups ()
838 "Remove all filter groups."
839 (interactive)
840 (setq ibuffer-filter-groups nil
841 ibuffer-hidden-filter-groups nil)
842 (ibuffer-update nil t))
844 (defun ibuffer-current-filter-groups-with-position ()
845 (save-excursion
846 (goto-char (point-min))
847 (let ((pos nil)
848 (result nil))
849 (while (and (not (eobp))
850 (setq pos (next-single-property-change
851 (point) 'ibuffer-filter-group-name)))
852 (goto-char pos)
853 (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
854 pos)
855 result)
856 (goto-char (next-single-property-change
857 pos 'ibuffer-filter-group-name)))
858 (nreverse result))))
860 ;;;###autoload
861 (defun ibuffer-jump-to-filter-group (name)
862 "Move point to the filter group whose name is NAME."
863 (interactive
864 (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
865 (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
866 (goto-char (cdr it))
867 (error "No filter group with name %s" name)))
869 ;;;###autoload
870 (defun ibuffer-kill-filter-group (name)
871 "Kill the filter group named NAME.
872 The group will be added to `ibuffer-filter-group-kill-ring'."
873 (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
874 (when (equal name "Default")
875 (error "Can't kill default filter group"))
876 (ibuffer-aif (assoc name ibuffer-filter-groups)
877 (progn
878 (push (copy-tree it) ibuffer-filter-group-kill-ring)
879 (setq ibuffer-filter-groups (ibuffer-remove-alist
880 name ibuffer-filter-groups))
881 (setq ibuffer-hidden-filter-groups
882 (delete name ibuffer-hidden-filter-groups)))
883 (error "No filter group with name \"%s\"" name))
884 (ibuffer-update nil t))
886 ;;;###autoload
887 (defun ibuffer-kill-line (&optional arg interactive-p)
888 "Kill the filter group at point.
889 See also `ibuffer-kill-filter-group'."
890 (interactive "P\np")
891 (ibuffer-aif (save-excursion
892 (ibuffer-forward-line 0)
893 (get-text-property (point) 'ibuffer-filter-group-name))
894 (progn
895 (ibuffer-kill-filter-group it))
896 (funcall (if interactive-p #'call-interactively #'funcall)
897 #'kill-line arg)))
899 (defun ibuffer-insert-filter-group-before (newgroup group)
900 (let* ((found nil)
901 (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
902 (res 0))
903 (while groups
904 (if (equal (car groups) group)
905 (setq found t
906 groups nil)
907 (cl-incf res)
908 (setq groups (cdr groups))))
909 res)))
910 (cond ((not found)
911 (setq ibuffer-filter-groups
912 (nconc ibuffer-filter-groups (list newgroup))))
913 ((zerop pos)
914 (push newgroup ibuffer-filter-groups))
916 (let ((cell (nthcdr pos ibuffer-filter-groups)))
917 (setf (cdr cell) (cons (car cell) (cdr cell)))
918 (setf (car cell) newgroup))))))
920 ;;;###autoload
921 (defun ibuffer-yank ()
922 "Yank the last killed filter group before group at point."
923 (interactive)
924 (ibuffer-yank-filter-group
925 (or (get-text-property (point) 'ibuffer-filter-group-name)
926 (get-text-property (point) 'ibuffer-filter-group)
927 (error "No filter group at point"))))
929 ;;;###autoload
930 (defun ibuffer-yank-filter-group (name)
931 "Yank the last killed filter group before group named NAME."
932 (interactive (list (ibuffer-read-filter-group-name
933 "Yank filter group before group: ")))
934 (unless ibuffer-filter-group-kill-ring
935 (error "The Ibuffer filter group kill-ring is empty"))
936 (save-excursion
937 (ibuffer-forward-line 0)
938 (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
939 name))
940 (ibuffer-update nil t))
942 ;;;###autoload
943 (defun ibuffer-save-filter-groups (name groups)
944 "Save all active filter groups GROUPS as NAME.
945 They are added to `ibuffer-saved-filter-groups'. Interactively,
946 prompt for NAME, and use the current filters."
947 (interactive
948 (if (null ibuffer-filter-groups)
949 (error "No filter groups active")
950 (list
951 (read-from-minibuffer "Save current filter groups as: ")
952 ibuffer-filter-groups)))
953 (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
954 (setcdr it groups)
955 (push (cons name groups) ibuffer-saved-filter-groups))
956 (ibuffer-maybe-save-stuff))
958 ;;;###autoload
959 (defun ibuffer-delete-saved-filter-groups (name)
960 "Delete saved filter groups with NAME.
961 They are removed from `ibuffer-saved-filter-groups'."
962 (interactive
963 (list
964 (if (null ibuffer-saved-filter-groups)
965 (error "No saved filter groups")
966 (completing-read "Delete saved filter group: "
967 ibuffer-saved-filter-groups nil t))))
968 (setq ibuffer-saved-filter-groups
969 (ibuffer-remove-alist name ibuffer-saved-filter-groups))
970 (ibuffer-maybe-save-stuff)
971 (ibuffer-update nil t))
973 ;;;###autoload
974 (defun ibuffer-switch-to-saved-filter-groups (name)
975 "Set this buffer's filter groups to saved version with NAME.
976 The value from `ibuffer-saved-filter-groups' is used."
977 (interactive
978 (list
979 (cond ((null ibuffer-saved-filter-groups)
980 (error "No saved filters"))
981 ;; `ibuffer-saved-filter-groups' is a user variable that defaults
982 ;; to nil. We assume that with one element in this list the user
983 ;; knows what she wants. See bug#12331.
984 ((null (cdr ibuffer-saved-filter-groups))
985 (caar ibuffer-saved-filter-groups))
987 (completing-read "Switch to saved filter group: "
988 ibuffer-saved-filter-groups nil t)))))
989 (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
990 ibuffer-hidden-filter-groups nil)
991 (ibuffer-update nil t))
993 ;;;###autoload
994 (defun ibuffer-filter-disable (&optional delete-filter-groups)
995 "Disable all filters currently in effect in this buffer.
996 With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter
997 group definitions by setting `ibuffer-filter-groups' to nil."
998 (interactive)
999 (setq ibuffer-filtering-qualifiers nil)
1000 (if delete-filter-groups
1001 (setq ibuffer-filter-groups nil))
1002 (let ((buf (ibuffer-current-buffer)))
1003 (ibuffer-update nil t)
1004 (when buf
1005 (ibuffer-jump-to-buffer (buffer-name buf)))))
1007 ;;;###autoload
1008 (defun ibuffer-pop-filter ()
1009 "Remove the top filter in this buffer."
1010 (interactive)
1011 (when (null ibuffer-filtering-qualifiers)
1012 (error "No filters in effect"))
1013 (pop ibuffer-filtering-qualifiers)
1014 (let ((buf (ibuffer-current-buffer)))
1015 (ibuffer-update nil t)
1016 (when buf
1017 (ibuffer-jump-to-buffer (buffer-name buf)))))
1019 (defun ibuffer-push-filter (filter-specification)
1020 "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'."
1021 (push filter-specification ibuffer-filtering-qualifiers))
1023 ;;;###autoload
1024 (defun ibuffer-decompose-filter ()
1025 "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED).
1027 This means that the topmost filter on the filtering stack, which must
1028 be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
1029 turned into separate filters, like [name: foo] and [mode: bar-mode]."
1030 (interactive)
1031 (unless ibuffer-filtering-qualifiers
1032 (error "No filters in effect"))
1033 (let* ((filters ibuffer-filtering-qualifiers)
1034 (head (cdar filters))
1035 (tail (cdr filters))
1036 (value
1037 (pcase (caar filters)
1038 ((or `or 'and) (nconc head tail))
1039 (`saved
1040 (let ((data (assoc head ibuffer-saved-filters)))
1041 (unless data
1042 (ibuffer-filter-disable)
1043 (error "Unknown saved filter %s" head))
1044 (append (cdr data) tail)))
1045 (`not (cons (ibuffer-unary-operand (car filters)) tail))
1047 (error "Filter type %s is not compound" (caar filters))))))
1048 (setq ibuffer-filtering-qualifiers value))
1049 (ibuffer-update nil t))
1051 ;;;###autoload
1052 (defun ibuffer-exchange-filters ()
1053 "Exchange the top two filters on the stack in this buffer."
1054 (interactive)
1055 (let ((filters ibuffer-filtering-qualifiers))
1056 (when (< (length filters) 2)
1057 (error "Need two filters to exchange"))
1058 (cl-rotatef (car filters) (cadr filters))
1059 (ibuffer-update nil t)))
1061 ;;;###autoload
1062 (defun ibuffer-negate-filter ()
1063 "Negate the sense of the top filter in the current buffer."
1064 (interactive)
1065 (when (null ibuffer-filtering-qualifiers)
1066 (error "No filters in effect"))
1067 (let ((lim (pop ibuffer-filtering-qualifiers)))
1068 (push (if (eq (car lim) 'not)
1069 (cdr lim)
1070 (cons 'not lim))
1071 ibuffer-filtering-qualifiers))
1072 (ibuffer-update nil t))
1074 (defun ibuffer--or-and-filter (op decompose)
1075 (if decompose
1076 (if (eq op (caar ibuffer-filtering-qualifiers))
1077 (ibuffer-decompose-filter)
1078 (error "Top filter is not an %s" (upcase (symbol-name op))))
1079 (when (< (length ibuffer-filtering-qualifiers) 2)
1080 (error "Need two filters to %s" (upcase (symbol-name op))))
1081 ;; If either filter is an op, eliminate unnecessary nesting.
1082 (let ((first (pop ibuffer-filtering-qualifiers))
1083 (second (pop ibuffer-filtering-qualifiers)))
1084 (push (nconc (if (eq op (car first)) first (list op first))
1085 (if (eq op (car second)) (cdr second) (list second)))
1086 ibuffer-filtering-qualifiers)))
1087 (ibuffer-update nil t))
1089 ;;;###autoload
1090 (defun ibuffer-or-filter (&optional decompose)
1091 "Replace the top two filters in this buffer with their logical OR.
1092 If optional argument DECOMPOSE is non-nil, instead break the top OR
1093 filter into parts."
1094 (interactive "P")
1095 (ibuffer--or-and-filter 'or decompose))
1097 ;;;###autoload
1098 (defun ibuffer-and-filter (&optional decompose)
1099 "Replace the top two filters in this buffer with their logical AND.
1100 If optional argument DECOMPOSE is non-nil, instead break the top AND
1101 filter into parts."
1102 (interactive "P")
1103 (ibuffer--or-and-filter 'and decompose))
1105 (defun ibuffer-maybe-save-stuff ()
1106 (when ibuffer-save-with-custom
1107 (if (fboundp 'customize-save-variable)
1108 (progn
1109 (customize-save-variable 'ibuffer-saved-filters
1110 ibuffer-saved-filters)
1111 (customize-save-variable 'ibuffer-saved-filter-groups
1112 ibuffer-saved-filter-groups))
1113 (message "Not saved permanently: Customize not available"))))
1115 ;;;###autoload
1116 (defun ibuffer-save-filters (name filters)
1117 "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
1118 Interactively, prompt for NAME, and use the current filters."
1119 (interactive
1120 (if (null ibuffer-filtering-qualifiers)
1121 (error "No filters currently in effect")
1122 (list
1123 (read-from-minibuffer "Save current filters as: ")
1124 ibuffer-filtering-qualifiers)))
1125 (ibuffer-aif (assoc name ibuffer-saved-filters)
1126 (setcdr it filters)
1127 (push (cons name filters) ibuffer-saved-filters))
1128 (ibuffer-maybe-save-stuff))
1130 ;;;###autoload
1131 (defun ibuffer-delete-saved-filters (name)
1132 "Delete saved filters with NAME from `ibuffer-saved-filters'."
1133 (interactive
1134 (list
1135 (if (null ibuffer-saved-filters)
1136 (error "No saved filters")
1137 (completing-read "Delete saved filters: "
1138 ibuffer-saved-filters nil t))))
1139 (setq ibuffer-saved-filters
1140 (ibuffer-remove-alist name ibuffer-saved-filters))
1141 (ibuffer-maybe-save-stuff)
1142 (ibuffer-update nil t))
1144 ;;;###autoload
1145 (defun ibuffer-add-saved-filters (name)
1146 "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
1147 (interactive
1148 (list
1149 (if (null ibuffer-saved-filters)
1150 (error "No saved filters")
1151 (completing-read "Add saved filters: "
1152 ibuffer-saved-filters nil t))))
1153 (push (cons 'saved name) ibuffer-filtering-qualifiers)
1154 (ibuffer-update nil t))
1156 ;;;###autoload
1157 (defun ibuffer-switch-to-saved-filters (name)
1158 "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
1159 (interactive
1160 (list
1161 (if (null ibuffer-saved-filters)
1162 (error "No saved filters")
1163 (completing-read "Switch to saved filters: "
1164 ibuffer-saved-filters nil t))))
1165 (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
1166 (ibuffer-update nil t))
1168 (defun ibuffer-format-filter-group-data (filter)
1169 (if (equal filter "Default")
1171 (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
1172 (cdr (assq filter ibuffer-filter-groups))
1173 " "))))
1175 (defun ibuffer-format-qualifier (qualifier)
1176 (if (eq (car-safe qualifier) 'not)
1177 (concat " [NOT"
1178 (ibuffer-format-qualifier-1 (ibuffer-unary-operand qualifier))
1179 "]")
1180 (ibuffer-format-qualifier-1 qualifier)))
1182 (defun ibuffer-format-qualifier-1 (qualifier)
1183 (pcase (car qualifier)
1184 (`saved
1185 (concat " [filter: " (cdr qualifier) "]"))
1186 (`or
1187 (concat " [OR" (mapconcat #'ibuffer-format-qualifier
1188 (cdr qualifier) "") "]"))
1189 (`and
1190 (concat " [AND" (mapconcat #'ibuffer-format-qualifier
1191 (cdr qualifier) "") "]"))
1193 (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
1194 (unless qualifier
1195 (error "Ibuffer: bad qualifier %s" qualifier))
1196 (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
1198 (defun ibuffer-list-buffer-modes (&optional include-parents)
1199 "Create a completion table of buffer modes currently in use.
1200 If INCLUDE-PARENTS is non-nil then include parent modes."
1201 (let ((modes))
1202 (dolist (buf (buffer-list))
1203 (let ((this-mode (buffer-local-value 'major-mode buf)))
1204 (while (and this-mode (not (memq this-mode modes)))
1205 (push this-mode modes)
1206 (setq this-mode (and include-parents
1207 (get this-mode 'derived-mode-parent))))))
1208 (mapcar #'symbol-name modes)))
1211 ;;; Extra operation definitions
1213 ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
1214 (define-ibuffer-filter mode
1215 "Limit current view to buffers with major mode QUALIFIER."
1216 (:description "major mode"
1217 :reader
1218 (let* ((buf (ibuffer-current-buffer))
1219 (default (if (and buf (buffer-live-p buf))
1220 (symbol-name (buffer-local-value
1221 'major-mode buf)))))
1222 (intern
1223 (completing-read
1224 (if default
1225 (format "Filter by major mode (default %s): " default)
1226 "Filter by major mode: ")
1227 obarray
1228 #'(lambda (e)
1229 (string-match "-mode\\'" (symbol-name e)))
1230 t nil nil default))))
1231 (eq qualifier (buffer-local-value 'major-mode buf)))
1233 ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
1234 (define-ibuffer-filter used-mode
1235 "Limit current view to buffers with major mode QUALIFIER.
1236 Called interactively, this function allows selection of modes
1237 currently used by buffers."
1238 (:description "major mode in use"
1239 :reader
1240 (let* ((buf (ibuffer-current-buffer))
1241 (default (if (and buf (buffer-live-p buf))
1242 (symbol-name (buffer-local-value
1243 'major-mode buf)))))
1244 (intern
1245 (completing-read
1246 (if default
1247 (format "Filter by major mode (default %s): " default)
1248 "Filter by major mode: ")
1249 (ibuffer-list-buffer-modes) nil t nil nil default))))
1250 (eq qualifier (buffer-local-value 'major-mode buf)))
1252 ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
1253 (define-ibuffer-filter derived-mode
1254 "Limit current view to buffers whose major mode inherits from QUALIFIER."
1255 (:description "derived mode"
1256 :reader
1257 (intern
1258 (completing-read "Filter by derived mode: "
1259 (ibuffer-list-buffer-modes t)
1260 nil t)))
1261 (with-current-buffer buf (derived-mode-p qualifier)))
1263 ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
1264 (define-ibuffer-filter name
1265 "Limit current view to buffers with name matching QUALIFIER."
1266 (:description "buffer name"
1267 :reader (read-from-minibuffer "Filter by name (regexp): "))
1268 (string-match qualifier (buffer-name buf)))
1270 ;;;###autoload (autoload 'ibuffer-filter-by-starred-name "ibuf-ext")
1271 (define-ibuffer-filter starred-name
1272 "Limit current view to buffers with name beginning and ending
1273 with *, along with an optional suffix of the form digits or
1274 <digits>."
1275 (:description "starred buffer name"
1276 :reader nil)
1277 (string-match "\\`\\*[^*]+\\*\\(?:<[[:digit:]]+>\\)?\\'" (buffer-name buf)))
1279 ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext")
1280 (define-ibuffer-filter filename
1281 "Limit current view to buffers with full file name matching QUALIFIER.
1283 For example, for a buffer associated with file '/a/b/c.d', this
1284 matches against '/a/b/c.d'."
1285 (:description "full file name"
1286 :reader (read-from-minibuffer "Filter by full file name (regexp): "))
1287 (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1288 (string-match qualifier it)))
1290 ;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext")
1291 (define-ibuffer-filter basename
1292 "Limit current view to buffers with file basename matching QUALIFIER.
1294 For example, for a buffer associated with file '/a/b/c.d', this
1295 matches against 'c.d'."
1296 (:description "file basename"
1297 :reader (read-from-minibuffer
1298 "Filter by file name, without directory part (regex): "))
1299 (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1300 (string-match qualifier (file-name-nondirectory it))))
1302 ;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext")
1303 (define-ibuffer-filter file-extension
1304 "Limit current view to buffers with filename extension matching QUALIFIER.
1306 The separator character (typically `.') is not part of the
1307 pattern. For example, for a buffer associated with file
1308 '/a/b/c.d', this matches against 'd'."
1309 (:description "filename extension"
1310 :reader (read-from-minibuffer
1311 "Filter by filename extension without separator (regex): "))
1312 (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1313 (string-match qualifier (or (file-name-extension it) ""))))
1315 ;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext")
1316 (define-ibuffer-filter directory
1317 "Limit current view to buffers with directory matching QUALIFIER.
1319 For a buffer associated with file '/a/b/c.d', this matches
1320 against '/a/b'. For a buffer not associated with a file, this
1321 matches against the value of `default-directory' in that buffer."
1322 (:description "directory name"
1323 :reader (read-from-minibuffer "Filter by directory name (regex): "))
1324 (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name))
1325 (let ((dirname (file-name-directory it)))
1326 (when dirname (string-match qualifier dirname)))
1327 (when default-directory (string-match qualifier default-directory))))
1329 ;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
1330 (define-ibuffer-filter size-gt
1331 "Limit current view to buffers with size greater than QUALIFIER."
1332 (:description "size greater than"
1333 :reader
1334 (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
1335 (> (with-current-buffer buf (buffer-size))
1336 qualifier))
1338 ;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext")
1339 (define-ibuffer-filter size-lt
1340 "Limit current view to buffers with size less than QUALIFIER."
1341 (:description "size less than"
1342 :reader
1343 (string-to-number (read-from-minibuffer "Filter by size less than: ")))
1344 (< (with-current-buffer buf (buffer-size))
1345 qualifier))
1347 ;;;###autoload (autoload 'ibuffer-filter-by-modified "ibuf-ext")
1348 (define-ibuffer-filter modified
1349 "Limit current view to buffers that are marked as modified."
1350 (:description "modified"
1351 :reader nil)
1352 (buffer-modified-p buf))
1354 ;;;###autoload (autoload 'ibuffer-filter-by-visiting-file "ibuf-ext")
1355 (define-ibuffer-filter visiting-file
1356 "Limit current view to buffers that are visiting a file."
1357 (:description "visiting a file"
1358 :reader nil)
1359 (with-current-buffer buf (buffer-file-name)))
1361 ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext")
1362 (define-ibuffer-filter content
1363 "Limit current view to buffers whose contents match QUALIFIER."
1364 (:description "content"
1365 :reader (read-from-minibuffer "Filter by content (regexp): "))
1366 (with-current-buffer buf
1367 (save-excursion
1368 (goto-char (point-min))
1369 (re-search-forward qualifier nil t))))
1371 ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext")
1372 (define-ibuffer-filter predicate
1373 "Limit current view to buffers for which QUALIFIER returns non-nil."
1374 (:description "predicate"
1375 :reader (read-minibuffer "Filter by predicate (form): "))
1376 (with-current-buffer buf
1377 (eval qualifier)))
1379 ;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext")
1380 (defun ibuffer-filter-chosen-by-completion ()
1381 "Select and apply filter chosen by completion against available filters.
1382 Indicates corresponding key sequences in echo area after filtering.
1384 The completion matches against the filter description text of
1385 each filter in `ibuffer-filtering-alist'."
1386 (interactive)
1387 (let* ((filters (mapcar (lambda (x) (cons (cadr x) (car x)))
1388 ibuffer-filtering-alist))
1389 (match (completing-read "Filter by: " filters nil t))
1390 (filter (cdr (assoc match filters)))
1391 (command (intern (concat "ibuffer-filter-by-" (symbol-name filter)))))
1392 (call-interactively command)
1393 (message "%s can be run with key sequences: %s"
1394 command
1395 (mapconcat #'key-description
1396 (where-is-internal command ibuffer-mode-map nil t)
1397 "or "))))
1400 ;;; Sorting
1402 ;;;###autoload
1403 (defun ibuffer-toggle-sorting-mode ()
1404 "Toggle the current sorting mode.
1405 Default sorting modes are:
1406 Recency - the last time the buffer was viewed
1407 Name - the name of the buffer
1408 Major Mode - the name of the major mode of the buffer
1409 Size - the size of the buffer"
1410 (interactive)
1411 (let ((modes (mapcar #'car ibuffer-sorting-functions-alist)))
1412 (cl-pushnew 'recency modes)
1413 (setq modes (sort modes #'string-lessp))
1414 (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
1415 (car modes))))
1416 (setq ibuffer-sorting-mode next)
1417 (message "Sorting by %s" next)))
1418 (ibuffer-redisplay t))
1420 ;;;###autoload
1421 (defun ibuffer-invert-sorting ()
1422 "Toggle whether or not sorting is in reverse order."
1423 (interactive)
1424 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
1425 (message "Sorting order %s"
1426 (if ibuffer-sorting-reversep
1427 "reversed"
1428 "normal"))
1429 (ibuffer-redisplay t))
1431 ;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext")
1432 (define-ibuffer-sorter major-mode
1433 "Sort the buffers by major modes.
1434 Ordering is lexicographic."
1435 (:description "major mode")
1436 (string-lessp (downcase
1437 (symbol-name (buffer-local-value 'major-mode (car a))))
1438 (downcase
1439 (symbol-name (buffer-local-value 'major-mode (car b))))))
1441 ;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext")
1442 (define-ibuffer-sorter mode-name
1443 "Sort the buffers by their mode name.
1444 Ordering is lexicographic."
1445 (:description "major mode name")
1446 (string-lessp (downcase
1447 (with-current-buffer
1448 (car a)
1449 (format-mode-line mode-name)))
1450 (downcase
1451 (with-current-buffer
1452 (car b)
1453 (format-mode-line mode-name)))))
1455 ;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext")
1456 (define-ibuffer-sorter alphabetic
1457 "Sort the buffers by their names.
1458 Ordering is lexicographic."
1459 (:description "buffer name")
1460 (string-lessp
1461 (buffer-name (car a))
1462 (buffer-name (car b))))
1464 ;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext")
1465 (define-ibuffer-sorter size
1466 "Sort the buffers by their size."
1467 (:description "size")
1468 (< (with-current-buffer (car a)
1469 (buffer-size))
1470 (with-current-buffer (car b)
1471 (buffer-size))))
1473 ;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext")
1474 (define-ibuffer-sorter filename/process
1475 "Sort the buffers by their file name/process name."
1476 (:description "file name")
1477 (string-lessp
1478 ;; FIXME: For now just compare the file name and the process name
1479 ;; (if it exists). Is there a better way to do this?
1480 (or (buffer-file-name (car a))
1481 (let ((pr-a (get-buffer-process (car a))))
1482 (and (processp pr-a) (process-name pr-a))))
1483 (or (buffer-file-name (car b))
1484 (let ((pr-b (get-buffer-process (car b))))
1485 (and (processp pr-b) (process-name pr-b))))))
1487 ;;; Functions to emulate bs.el
1489 ;;;###autoload
1490 (defun ibuffer-bs-show ()
1491 "Emulate `bs-show' from the bs.el package."
1492 (interactive)
1493 (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
1494 (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
1496 (defun ibuffer-bs-toggle-all ()
1497 "Emulate `bs-toggle-show-all' from the bs.el package."
1498 (interactive)
1499 (if ibuffer-filtering-qualifiers
1500 (ibuffer-pop-filter)
1501 (progn (ibuffer-push-filter '(filename . ".*"))
1502 (ibuffer-update nil t))))
1504 ;;; Handy functions
1506 ;;;###autoload
1507 (defun ibuffer-add-to-tmp-hide (regexp)
1508 "Add REGEXP to `ibuffer-tmp-hide-regexps'.
1509 This means that buffers whose name matches REGEXP will not be shown
1510 for this Ibuffer session."
1511 (interactive
1512 (list
1513 (read-from-minibuffer "Never show buffers matching: "
1514 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1515 (push regexp ibuffer-tmp-hide-regexps))
1517 ;;;###autoload
1518 (defun ibuffer-add-to-tmp-show (regexp)
1519 "Add REGEXP to `ibuffer-tmp-show-regexps'.
1520 This means that buffers whose name matches REGEXP will always be shown
1521 for this Ibuffer session."
1522 (interactive
1523 (list
1524 (read-from-minibuffer "Always show buffers matching: "
1525 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1526 (push regexp ibuffer-tmp-show-regexps))
1528 ;;;###autoload
1529 (defun ibuffer-forward-next-marked (&optional count mark direction)
1530 "Move forward by COUNT marked buffers (default 1).
1532 If MARK is non-nil, it should be a character denoting the type of mark
1533 to move by. The default is `ibuffer-marked-char'.
1535 If DIRECTION is non-nil, it should be an integer; negative integers
1536 mean move backwards, non-negative integers mean move forwards."
1537 (interactive "P")
1538 (unless count
1539 (setq count 1))
1540 (unless mark
1541 (setq mark ibuffer-marked-char))
1542 (unless direction
1543 (setq direction 1))
1544 ;; Skip the title
1545 (ibuffer-forward-line 0)
1546 (let ((opos (point)))
1547 (ibuffer-forward-line direction)
1548 (while (not (or (= (point) opos)
1549 (eq (ibuffer-current-mark) mark)))
1550 (ibuffer-forward-line direction))
1551 (when (and (= (point) opos)
1552 (not (eq (ibuffer-current-mark) mark)))
1553 (error "No buffers with mark %c" mark))))
1555 ;;;###autoload
1556 (defun ibuffer-backwards-next-marked (&optional count mark)
1557 "Move backwards by COUNT marked buffers (default 1).
1559 If MARK is non-nil, it should be a character denoting the type of mark
1560 to move by. The default is `ibuffer-marked-char'."
1561 (interactive "P")
1562 (ibuffer-forward-next-marked count mark -1))
1564 ;;;###autoload
1565 (defun ibuffer-do-kill-lines ()
1566 "Hide all of the currently marked lines."
1567 (interactive)
1568 (if (= (ibuffer-count-marked-lines) 0)
1569 (message "No buffers marked; use 'm' to mark a buffer")
1570 (let ((count
1571 (ibuffer-map-marked-lines
1572 #'(lambda (_buf _mark)
1573 'kill))))
1574 (message "Killed %s lines" count))))
1576 ;;;###autoload
1577 (defun ibuffer-jump-to-buffer (name)
1578 "Move point to the buffer whose name is NAME.
1580 If called interactively, prompt for a buffer name and go to the
1581 corresponding line in the Ibuffer buffer. If said buffer is in a
1582 hidden group filter, open it.
1584 If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer
1585 visible buffers in the completion list. Calling the command with
1586 a prefix argument reverses the meaning of that variable."
1587 (interactive (list
1588 (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
1589 (when current-prefix-arg
1590 (setq only-visible (not only-visible)))
1591 (if only-visible
1592 (let ((table (mapcar #'(lambda (x)
1593 (buffer-name (car x)))
1594 (ibuffer-current-state-list))))
1595 (when (null table)
1596 (error "No buffers!"))
1597 (completing-read "Jump to buffer: "
1598 table nil t))
1599 (read-buffer "Jump to buffer: " nil t)))))
1600 (when (not (string= "" name))
1601 (let (buf-point)
1602 ;; Blindly search for our buffer: it is very likely that it is
1603 ;; not in a hidden filter group.
1604 (ibuffer-map-lines #'(lambda (buf _marks)
1605 (when (string= (buffer-name buf) name)
1606 (setq buf-point (point))
1607 nil))
1608 t nil)
1609 (when (and
1610 (null buf-point)
1611 (not (null ibuffer-hidden-filter-groups)))
1612 ;; We did not find our buffer. It must be in a hidden filter
1613 ;; group, so go through all hidden filter groups to find it.
1614 (catch 'found
1615 (dolist (group ibuffer-hidden-filter-groups)
1616 (ibuffer-jump-to-filter-group group)
1617 (ibuffer-toggle-filter-group)
1618 (ibuffer-map-lines #'(lambda (buf _marks)
1619 (when (string= (buffer-name buf) name)
1620 (setq buf-point (point))
1621 nil))
1622 t group)
1623 (if buf-point
1624 (throw 'found nil)
1625 (ibuffer-toggle-filter-group)))))
1626 (if (null buf-point)
1627 ;; Still not found even though we expanded all hidden filter
1628 ;; groups: that must be because it's hidden by predicate:
1629 ;; we won't bother trying to display it.
1630 (error "No buffer with name %s" name)
1631 (goto-char buf-point)))))
1633 (declare-function diff-sentinel "diff"
1634 (code &optional old-temp-file new-temp-file))
1636 (defun ibuffer-diff-buffer-with-file-1 (buffer)
1637 (let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
1638 (tempfile (make-temp-file "buffer-content-")))
1639 (when bufferfile
1640 (unwind-protect
1641 (progn
1642 (with-current-buffer buffer
1643 (write-region nil nil tempfile nil 'nomessage))
1644 (let* ((old (expand-file-name bufferfile))
1645 (new (expand-file-name tempfile))
1646 (oldtmp (file-local-copy old))
1647 (newtmp (file-local-copy new))
1648 (switches diff-switches)
1649 (command
1650 (mapconcat
1651 'identity
1652 `(,diff-command
1653 ;; Use explicitly specified switches
1654 ,@(if (listp switches) switches (list switches))
1655 ,@(if (or old new)
1656 (list "-L" (shell-quote-argument old)
1657 "-L" (shell-quote-argument
1658 (format "Buffer %s" (buffer-name buffer)))))
1659 ,(shell-quote-argument (or oldtmp old))
1660 ,(shell-quote-argument (or newtmp new)))
1661 " ")))
1662 (let ((inhibit-read-only t))
1663 (insert command "\n")
1664 (diff-sentinel
1665 (call-process shell-file-name nil
1666 (current-buffer) nil
1667 shell-command-switch command))
1668 (insert "\n")))))
1669 (sit-for 0)
1670 (when (file-exists-p tempfile)
1671 (delete-file tempfile)))))
1673 ;;;###autoload
1674 (defun ibuffer-diff-with-file ()
1675 "View the differences between marked buffers and their associated files.
1676 If no buffers are marked, use buffer at point.
1677 This requires the external program \"diff\" to be in your `exec-path'."
1678 (interactive)
1679 (require 'diff)
1680 (let ((marked-bufs (ibuffer-get-marked-buffers)))
1681 (when (null marked-bufs)
1682 (setq marked-bufs (list (ibuffer-current-buffer t))))
1683 (with-current-buffer (get-buffer-create "*Ibuffer Diff*")
1684 (setq buffer-read-only nil)
1685 (buffer-disable-undo (current-buffer))
1686 (erase-buffer)
1687 (buffer-enable-undo (current-buffer))
1688 (diff-mode)
1689 (dolist (buf marked-bufs)
1690 (unless (buffer-live-p buf)
1691 (error "Buffer %s has been killed" buf))
1692 (ibuffer-diff-buffer-with-file-1 buf))
1693 (setq buffer-read-only t)))
1694 (switch-to-buffer "*Ibuffer Diff*"))
1696 ;;;###autoload
1697 (defun ibuffer-copy-filename-as-kill (&optional arg)
1698 "Copy filenames of marked (or next ARG) buffers into the kill ring.
1700 The names are separated by a space.
1701 If a buffer has no filename, it is ignored.
1703 With no prefix arg, use the filename sans its directory of each marked file.
1704 With a zero prefix arg, use the complete filename of each marked file.
1705 With \\[universal-argument], use the filename of each marked file relative
1706 to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
1708 You can then feed the file name(s) to other commands with \\[yank]."
1709 (interactive "P")
1710 (let* ((buffers (cond ((and (integerp arg) (not (zerop arg)))
1711 (ibuffer--near-buffers arg))
1713 (or (ibuffer-get-marked-buffers)
1714 (list (ibuffer-current-buffer))))))
1715 (file-names
1716 (mapcar
1717 (lambda (buf)
1718 (let ((name (with-current-buffer buf
1719 (ibuffer-buffer-file-name))))
1720 (if (null name)
1722 (cond ((and (integerp arg) (zerop arg)) name)
1723 ((consp arg)
1724 (file-relative-name
1725 name (or ibuffer-default-directory
1726 default-directory)))
1727 (t (file-name-nondirectory name))))))
1728 buffers))
1729 (string
1730 (mapconcat 'identity (delete "" file-names) " ")))
1731 (unless (string= string "")
1732 (if (eq last-command 'kill-region)
1733 (kill-append string nil)
1734 (kill-new string))
1735 (message "%s" string))))
1737 ;;;###autoload
1738 (defun ibuffer-copy-buffername-as-kill (&optional arg)
1739 "Copy buffer names of marked (or next ARG) buffers into the kill ring.
1740 The names are separated by a space.
1741 You can then feed the file name(s) to other commands with \\[yank]."
1742 (interactive "P")
1743 (let* ((buffers (cond ((and (integerp arg) (not (zerop arg)))
1744 (ibuffer--near-buffers arg))
1746 (or (ibuffer-get-marked-buffers)
1747 (list (ibuffer-current-buffer))))))
1748 (string (mapconcat #'buffer-name buffers " ")))
1749 (unless (string= string "")
1750 (if (eq last-command 'kill-region)
1751 (kill-append string nil)
1752 (kill-new string))
1753 (message "%s" string))))
1755 (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1756 (let ((count
1757 (ibuffer-map-lines
1758 #'(lambda (buf _mark)
1759 (when (funcall func buf)
1760 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1761 ibuffer-marked-char))
1764 group)))
1765 (ibuffer-redisplay t)
1766 (unless (eq ibuffer-mark-on-buffer-mark ?\s)
1767 (message "Marked %s buffers" count))))
1769 ;;;###autoload
1770 (defun ibuffer-mark-by-name-regexp (regexp)
1771 "Mark all buffers whose name matches REGEXP."
1772 (interactive "sMark by name (regexp): ")
1773 (ibuffer-mark-on-buffer
1774 #'(lambda (buf)
1775 (string-match regexp (buffer-name buf)))))
1777 (defun ibuffer-locked-buffer-p (&optional buf)
1778 "Return non-nil if BUF is locked.
1779 When BUF nil, default to the buffer at current line."
1780 (let ((cbuffer (or buf (ibuffer-current-buffer))))
1781 (when cbuffer
1782 (with-current-buffer cbuffer
1783 (and (boundp 'emacs-lock-mode) emacs-lock-mode)))))
1785 ;;;###autoload
1786 (defun ibuffer-mark-by-locked ()
1787 "Mark all locked buffers."
1788 (interactive)
1789 (when (featurep 'emacs-lock)
1790 (ibuffer-mark-on-buffer
1791 (lambda (buf)
1792 (ibuffer-locked-buffer-p buf)))))
1794 ;;;###autoload
1795 (defun ibuffer-mark-by-mode-regexp (regexp)
1796 "Mark all buffers whose major mode matches REGEXP."
1797 (interactive "sMark by major mode (regexp): ")
1798 (ibuffer-mark-on-buffer
1799 #'(lambda (buf)
1800 (with-current-buffer buf
1801 (string-match regexp (format-mode-line mode-name nil nil buf))))))
1803 ;;;###autoload
1804 (defun ibuffer-mark-by-file-name-regexp (regexp)
1805 "Mark all buffers whose file name matches REGEXP."
1806 (interactive "sMark by file name (regexp): ")
1807 (ibuffer-mark-on-buffer
1808 #'(lambda (buf)
1809 (let ((name (or (buffer-file-name buf)
1810 (with-current-buffer buf
1811 (and
1812 (boundp 'dired-directory)
1813 (stringp dired-directory)
1814 dired-directory)))))
1815 (when name
1816 (string-match regexp name))))))
1818 ;;;###autoload
1819 (defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
1820 "Mark all buffers whose content matches REGEXP.
1821 Optional arg ALL-BUFFERS, if non-nil, then search in all buffers.
1822 Otherwise buffers whose name matches an element of
1823 `ibuffer-never-search-content-name' or whose major mode is on
1824 `ibuffer-never-search-content-mode' are excluded."
1825 (interactive (let ((reg (read-string "Mark by content (regexp): ")))
1826 (list reg current-prefix-arg)))
1827 (ibuffer-mark-on-buffer
1828 #'(lambda (buf)
1829 (let ((mode (with-current-buffer buf major-mode))
1830 res)
1831 (cond ((and (not all-buffers)
1833 (memq mode ibuffer-never-search-content-mode)
1834 (cl-some (lambda (x) (string-match x (buffer-name buf)))
1835 ibuffer-never-search-content-name)))
1836 (setq res nil))
1838 (with-current-buffer buf
1839 (save-mark-and-excursion
1840 (goto-char (point-min))
1841 (setq res (re-search-forward regexp nil t)))))) res))))
1843 ;;;###autoload
1844 (defun ibuffer-mark-by-mode (mode)
1845 "Mark all buffers whose major mode equals MODE."
1846 (interactive
1847 (let* ((buf (ibuffer-current-buffer))
1848 (default (if (and buf (buffer-live-p buf))
1849 (symbol-name (buffer-local-value
1850 'major-mode buf)))))
1851 (list (intern
1852 (completing-read
1853 (if default
1854 (format "Mark by major mode (default %s): " default)
1855 "Mark by major mode: ")
1856 (ibuffer-list-buffer-modes) nil t nil nil default)))))
1857 (ibuffer-mark-on-buffer
1858 #'(lambda (buf)
1859 (eq (buffer-local-value 'major-mode buf) mode))))
1861 ;;;###autoload
1862 (defun ibuffer-mark-modified-buffers ()
1863 "Mark all modified buffers."
1864 (interactive)
1865 (ibuffer-mark-on-buffer
1866 #'(lambda (buf) (buffer-modified-p buf))))
1868 ;;;###autoload
1869 (defun ibuffer-mark-unsaved-buffers ()
1870 "Mark all modified buffers that have an associated file."
1871 (interactive)
1872 (ibuffer-mark-on-buffer
1873 #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
1874 (buffer-modified-p buf)))))
1876 ;;;###autoload
1877 (defun ibuffer-mark-dissociated-buffers ()
1878 "Mark all buffers whose associated file does not exist."
1879 (interactive)
1880 (ibuffer-mark-on-buffer
1881 #'(lambda (buf)
1882 (with-current-buffer buf
1884 (and buffer-file-name
1885 (not (file-exists-p buffer-file-name)))
1886 (and (eq major-mode 'dired-mode)
1887 (boundp 'dired-directory)
1888 (stringp dired-directory)
1889 (not (file-exists-p (file-name-directory dired-directory)))))))))
1891 ;;;###autoload
1892 (defun ibuffer-mark-help-buffers ()
1893 "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
1894 (interactive)
1895 (ibuffer-mark-on-buffer
1896 #'(lambda (buf)
1897 (with-current-buffer buf
1898 (memq major-mode ibuffer-help-buffer-modes)))))
1900 ;;;###autoload
1901 (defun ibuffer-mark-compressed-file-buffers ()
1902 "Mark buffers whose associated file is compressed."
1903 (interactive)
1904 (ibuffer-mark-on-buffer
1905 #'(lambda (buf)
1906 (with-current-buffer buf
1907 (and buffer-file-name
1908 (string-match ibuffer-compressed-file-name-regexp
1909 buffer-file-name))))))
1911 ;;;###autoload
1912 (defun ibuffer-mark-old-buffers ()
1913 "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
1914 (interactive)
1915 (ibuffer-mark-on-buffer
1916 #'(lambda (buf)
1917 (with-current-buffer buf
1918 ;; hacked from midnight.el
1919 (when buffer-display-time
1920 (let* ((now (float-time))
1921 (then (float-time buffer-display-time)))
1922 (> (- now then) (* 60 60 ibuffer-old-time))))))))
1924 ;;;###autoload
1925 (defun ibuffer-mark-special-buffers ()
1926 "Mark all buffers whose name begins and ends with `*'."
1927 (interactive)
1928 (ibuffer-mark-on-buffer
1929 #'(lambda (buf) (string-match "^\\*.+\\*$"
1930 (buffer-name buf)))))
1932 ;;;###autoload
1933 (defun ibuffer-mark-read-only-buffers ()
1934 "Mark all read-only buffers."
1935 (interactive)
1936 (ibuffer-mark-on-buffer
1937 #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
1939 ;;;###autoload
1940 (defun ibuffer-mark-dired-buffers ()
1941 "Mark all `dired' buffers."
1942 (interactive)
1943 (ibuffer-mark-on-buffer
1944 #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
1946 ;;;###autoload
1947 (defun ibuffer-do-occur (regexp &optional nlines)
1948 "View lines which match REGEXP in all marked buffers.
1949 Optional argument NLINES says how many lines of context to display: it
1950 defaults to one."
1951 (interactive (occur-read-primary-args))
1952 (if (or (not (integerp nlines))
1953 (< nlines 0))
1954 (setq nlines 0))
1955 (when (zerop (ibuffer-count-marked-lines))
1956 (ibuffer-set-mark ibuffer-marked-char))
1957 (let ((ibuffer-do-occur-bufs nil))
1958 ;; Accumulate a list of marked buffers
1959 (ibuffer-map-marked-lines
1960 #'(lambda (buf _mark)
1961 (push buf ibuffer-do-occur-bufs)))
1962 (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1964 (provide 'ibuf-ext)
1966 ;; Local Variables:
1967 ;; generated-autoload-file: "ibuffer-loaddefs.el"
1968 ;; End:
1970 ;;; ibuf-ext.el ends here