ibuf-ext.el 72.2 KB
Newer Older
1
;;; ibuf-ext.el --- extensions for ibuffer  -*- lexical-binding:t -*-
Colin Walters's avatar
Colin Walters committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2000-2019 Free Software Foundation, Inc.
Colin Walters's avatar
Colin Walters committed
4 5

;; Author: Colin Walters <walters@verbum.org>
6
;; Maintainer: John Paul Wallington <jpw@gnu.org>
Colin Walters's avatar
Colin Walters committed
7 8
;; Created: 2 Dec 2001
;; Keywords: buffer, convenience
9
;; Package: ibuffer
Colin Walters's avatar
Colin Walters committed
10

11
;; This file is part of GNU Emacs.
Colin Walters's avatar
Colin Walters committed
12

13 14 15 16
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Colin Walters's avatar
Colin Walters committed
17

18 19 20 21
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
Colin Walters's avatar
Colin Walters committed
22 23

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Colin Walters's avatar
Colin Walters committed
25 26 27 28

;;; Commentary:

;; These functions should be automatically loaded when called, but you
Paul Eggert's avatar
Paul Eggert committed
29
;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them
Colin Walters's avatar
Colin Walters committed
30
;; preloaded.
31 32 33 34 35 36 37
;;
;; For details on the structure of ibuffer filters and filter groups,
;; see the documentation for variables `ibuffer-filtering-qualifiers',
;; `ibuffer-filter-groups', and `ibuffer-saved-filters' in that order.
;; The variable `ibuffer-filtering-alist' contains names and
;; descriptions of the currently defined filters; also see the macro
;; `define-ibuffer-filter'.
Colin Walters's avatar
Colin Walters committed
38 39 40 41 42 43 44

;;; Code:

(require 'ibuffer)

(eval-when-compile
  (require 'ibuf-macs)
45 46
  (require 'cl-lib)
  (require 'subr-x))
Colin Walters's avatar
Colin Walters committed
47 48

;;; Utility functions
49 50 51 52 53
(defun ibuffer-remove-alist (key alist)
  "Remove all entries in ALIST that have a key equal to KEY."
  (while (ibuffer-awhen (assoc key alist)
           (setq alist (remove it alist)) it))
  alist)
Colin Walters's avatar
Colin Walters committed
54

55 56 57 58 59 60 61 62 63 64 65
;; borrowed from Gnus
(defun ibuffer-remove-duplicates (list)
  "Return a copy of LIST with duplicate elements removed."
  (let ((new nil)
	(tail list))
    (while tail
      (or (member (car tail) new)
	  (setq new (cons (car tail) new)))
      (setq tail (cdr tail)))
    (nreverse new)))

66 67 68 69
(defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
  (let ((hip-crowd nil)
	(lamers nil))
    (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
70
      (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
71 72 73 74 75
	  (push ibuffer-split-list-elt hip-crowd)
	(push ibuffer-split-list-elt lamers)))
    ;; Too bad Emacs Lisp doesn't have multiple values.
    (list (nreverse hip-crowd) (nreverse lamers))))

Colin Walters's avatar
Colin Walters committed
76 77 78 79 80 81
(defcustom ibuffer-never-show-predicates nil
  "A list of predicates (a regexp or function) for buffers not to display.
If a regexp, then it will be matched against the buffer's name.
If a function, it will be called with the buffer as an argument, and
should return non-nil if this buffer should not be shown."
  :type '(repeat (choice regexp function))
82
  :require 'ibuf-ext
Colin Walters's avatar
Colin Walters committed
83 84 85 86 87 88 89 90 91 92 93 94
  :group 'ibuffer)

(defcustom ibuffer-always-show-predicates nil
  "A list of predicates (a regexp or function) for buffers to always display.
If a regexp, then it will be matched against the buffer's name.
If a function, it will be called with the buffer as an argument, and
should return non-nil if this buffer should be shown.
Note that buffers matching one of these predicates will be shown
regardless of any active filters in this buffer."
  :type '(repeat (choice regexp function))
  :group 'ibuffer)

95 96 97 98 99 100 101 102 103 104 105 106 107
(defcustom ibuffer-never-search-content-name
  (let* ((names    '("Completions" "Help" "Messages" "Pp Eval Output"
                     "CompileLog" "Info" "Buffer List" "Ibuffer" "Apropos"))
         (partial  '("Customize Option: " "Async Shell Command\\*"
                     "Shell Command Output\\*" "ediff "))
         (beg      "\\`\\*")
         (end      "\\*\\'")
         (excluded (mapcar (lambda (x)
                             (format "%s%s" beg x)) partial)))
    (dolist (str names (nreverse excluded))
      (push (format "%s%s%s" beg str end) excluded)))
  "A list of regexps for buffers ignored by `ibuffer-mark-by-content-regexp'.
Buffers whose name matches a regexp in this list, are not searched."
108
  :version "26.1"
109 110 111 112 113 114 115
  :type '(repeat regexp)
  :require 'ibuf-ext
  :group 'ibuffer)

(defcustom ibuffer-never-search-content-mode '(dired-mode)
  "A list of major modes ignored by `ibuffer-mark-by-content-regexp'.
Buffers whose major mode is in this list, are not searched."
116
  :version "26.1"
117
  :type '(repeat (symbol :tag "Major mode"))
118 119 120
  :require 'ibuf-ext
  :group 'ibuffer)

Colin Walters's avatar
Colin Walters committed
121 122
(defvar ibuffer-tmp-hide-regexps nil
  "A list of regexps which should match buffer names to not show.")
123

Colin Walters's avatar
Colin Walters committed
124 125 126 127 128
(defvar ibuffer-tmp-show-regexps nil
  "A list of regexps which should match buffer names to always show.")

(defvar ibuffer-auto-buffers-changed nil)

129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
(defun ibuffer-update-saved-filters-format (filters)
  "Transforms alist from old to new `ibuffer-saved-filters' format.

Specifically, converts old-format alist with values of the
form (STRING (FILTER-SPECS...)) to alist with values of the
form (STRING FILTER-SPECS...), where each filter spec should be a
cons cell with a symbol in the car. Any elements in the latter
form are kept as is.

Returns (OLD-FORMAT-DETECTED . UPDATED-SAVED-FILTERS-LIST)."
  (when filters
    (let* ((old-format-detected nil)
           (fix-filter (lambda (filter-spec)
                         (if (symbolp (car (cadr filter-spec)))
                             filter-spec
                           (setq old-format-detected t) ; side-effect
                           (cons (car filter-spec) (cadr filter-spec)))))
           (fixed (mapcar fix-filter filters)))
      (cons old-format-detected fixed))))
Colin Walters's avatar
Colin Walters committed
148

149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
(defcustom ibuffer-saved-filters '(("programming"
                                    (or (derived-mode . prog-mode)
                                        (mode         . ess-mode)
                                        (mode         . compilation-mode)))
                                   ("text document"
                                    (and (derived-mode . text-mode)
                                         (not (starred-name))))
                                   ("TeX"
                                    (or (derived-mode . tex-mode)
                                        (mode         . latex-mode)
                                        (mode         . context-mode)
                                        (mode         . ams-tex-mode)
                                        (mode         . bibtex-mode)))
                                   ("web"
                                    (or (derived-mode . sgml-mode)
                                        (derived-mode . css-mode)
                                        (mode         . javascript-mode)
                                        (mode         . js2-mode)
                                        (mode         . scss-mode)
                                        (derived-mode . haml-mode)
                                        (mode         . sass-mode)))
                                   ("gnus"
171 172 173 174
                                    (or (mode . message-mode)
                                        (mode . mail-mode)
                                        (mode . gnus-group-mode)
                                        (mode . gnus-summary-mode)
175
                                        (mode . gnus-article-mode))))
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195

  "An alist mapping saved filter names to filter specifications.

Each element should look like (\"NAME\" . FILTER-LIST), where
FILTER-LIST has the same structure as the variable
`ibuffer-filtering-qualifiers', which see. The filters defined
here are joined with an implicit logical `and' and associated
with NAME. The combined specification can be used by name in
other filter specifications via the `saved' qualifier (again, see
`ibuffer-filtering-qualifiers'). They can also be switched to by
name (see the functions `ibuffer-switch-to-saved-filters' and
`ibuffer-save-filters'). The variable `ibuffer-save-with-custom'
affects how this information is saved for future sessions. This
variable can be set directly from lisp code."
  :version "26.1"
  :type '(alist :key-type (string :tag "Filter name")
                :value-type (repeat :tag "Filter specification" sexp))
  :set (lambda (symbol value)
         ;; Just set-default but update legacy old-style format
         (set-default symbol (cdr (ibuffer-update-saved-filters-format value))))
Colin Walters's avatar
Colin Walters committed
196 197
  :group 'ibuffer)

198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
(defvar ibuffer-old-saved-filters-warning
  (concat "Deprecated format detected for variable `ibuffer-saved-filters'.

The format has been repaired and the variable modified accordingly.
You can save the current value through the customize system by
either clicking or hitting return "
          (make-text-button
           "here" nil
           'face '(:weight bold :inherit button)
           'mouse-face '(:weight normal :background "gray50" :inherit button)
           'follow-link t
           'help-echo "Click or RET: save new value in customize"
           'action (lambda (_)
                     (if (not (fboundp 'customize-save-variable))
                         (message "Customize not available; value not saved")
                       (customize-save-variable 'ibuffer-saved-filters
                                                ibuffer-saved-filters)
                       (message "Saved updated ibuffer-saved-filters."))))
          ". See below for
an explanation and alternative ways to save the repaired value.

Explanation: For the list variable `ibuffer-saved-filters',
elements of the form (STRING (FILTER-SPECS...)) are deprecated
and should instead have the form (STRING FILTER-SPECS...), where
each filter spec is a cons cell with a symbol in the car. See
`ibuffer-saved-filters' for details. The repaired value fixes
this format without changing the meaning of the saved filters.

Alternative ways to save the repaired value:

  1. Do M-x customize-variable and entering `ibuffer-saved-filters'
     when prompted.

  2. Set the updated value manually by copying the
     following emacs-lisp form to your emacs init file.

%s
"))

Colin Walters's avatar
Colin Walters committed
237
(defvar ibuffer-filtering-qualifiers nil
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
  "A list specifying the filters currently acting on the buffer list.

If this list is nil, then no filters are currently in
effect. Otherwise, each element of this list specifies a single
filter, and all of the specified filters in the list are applied
successively to the buffer list.

Each filter specification can be of two types: simple or compound.

A simple filter specification has the form (SYMBOL . QUALIFIER),
where SYMBOL is a key in the alist `ibuffer-filtering-alist' that
determines the filter function to use and QUALIFIER is the data
passed to that function (along with the buffer being considered).

A compound filter specification can have one of four forms:

-- (not FILTER-SPEC)

   Represents the logical complement of FILTER-SPEC, which
   is any single filter specification, simple or compound.
   The form (not . FILTER-SPEC) is also accepted here.

-- (and FILTER-SPECS...)

   Represents the logical-and of the filters defined by one or
   more filter specifications FILTER-SPECS..., where each
   specification can be simple or compound.  Note that and is
   implicitly applied to the filters in the top-level list.

-- (or FILTER-SPECS...)

   Represents the logical-or of the filters defined by one or
   more filter specifications FILTER-SPECS..., where each
   specification can be simple or compound.

-- (saved . \"NAME\")

   Represents the filter saved under the string NAME
   in the alist `ibuffer-saved-filters'. It is an
   error to name a filter that has not been saved.

This variable is local to each ibuffer buffer.")
Colin Walters's avatar
Colin Walters committed
280 281 282 283 284 285 286 287 288 289 290 291 292

;; This is now frobbed by `define-ibuffer-filter'.
(defvar ibuffer-filtering-alist nil
  "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.

You most likely do not want to modify this variable directly; see
`define-ibuffer-filter'.

SYMBOL is the symbolic name of the filter.  DESCRIPTION is used when
displaying information to the user.  FUNCTION is given a buffer and
the value of the qualifier, and returns non-nil if and only if the
buffer should be displayed.")

293 294 295 296 297 298 299 300 301
(defcustom ibuffer-filter-format-alist nil
  "An alist which has special formats used when a filter is active.
The contents of this variable should look like:
 ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)

For example, suppose that when you add a filter for buffers whose
major mode is `emacs-lisp-mode', you only want to see the mark and the
name of the buffer.  You could accomplish that by adding:
 (mode ((mark \" \" name)))
302 303 304 305
to this variable."
  :type '(repeat (list :tag "Association" (symbol :tag "Filter")
                       (list :tag "Formats" (repeat (sexp :tag "Format")))))
  :group 'ibuffer)
306 307

(defvar ibuffer-cached-filter-formats nil)
308
(defvar ibuffer-compiled-filter-formats nil)
309

310
(defvar ibuffer-filter-groups nil
311 312 313 314 315 316 317 318 319 320 321 322
  "An alist giving this buffer's active filter groups, or nil if none.

This alist maps filter group labels to filter specification
lists.  Each element has the form (\"LABEL\" FILTER-SPECS...),
where FILTER-SPECS... represents one or more filter
specifications of the same form as allowed as elements of
`ibuffer-filtering-qualifiers'.

Each filter group is displayed as a separate section in the
ibuffer list, headed by LABEL and displaying only the buffers
that pass through all the filters associated with NAME in this
list.")
323 324 325 326 327 328

(defcustom ibuffer-show-empty-filter-groups t
  "If non-nil, then show the names of filter groups which are empty."
  :type 'boolean
  :group 'ibuffer)

329
(defcustom ibuffer-saved-filter-groups nil
330 331
  "An alist of filtering groups to switch between.

332 333 334 335
Each element is of the form (\"NAME\" . FILTER-GROUP-LIST),
where NAME is a unique but arbitrary name and FILTER-GROUP-LIST
is a list of filter groups with the same structure as
allowed for `ibuffer-filter-groups'.
336

337 338 339 340 341
See also the functions `ibuffer-save-filter-groups' and
`ibuffer-switch-to-saved-filter-groups' for saving and switching
between sets of filter groups, and the variable
`ibuffer-save-with-custom' that affects how this information is
saved."
342 343
  :type '(repeat sexp)
  :group 'ibuffer)
344

345
(defvar ibuffer-hidden-filter-groups nil
346
  "The list of filter groups that are currently hidden.")
347

348 349
(defvar ibuffer-filter-group-kill-ring nil)

350 351 352 353 354 355
(defcustom ibuffer-old-time 72
  "The number of hours before a buffer is considered \"old\"."
  :type '(choice (const :tag "72 hours (3 days)" 72)
 		 (const :tag "48 hours (2 days)" 48)
 		 (const :tag "24 hours (1 day)" 24)
		 (integer :tag "hours"))
Colin Walters's avatar
Colin Walters committed
356 357 358 359
  :group 'ibuffer)

(defcustom ibuffer-save-with-custom t
  "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'."
Colin Walters's avatar
Colin Walters committed
362 363 364
  :type 'boolean
  :group 'ibuffer)

365 366 367 368 369 370 371 372 373 374 375 376 377
(defun ibuffer-repair-saved-filters ()
  "Updates `ibuffer-saved-filters' to its new-style format, if needed.

If this list has any elements of the old-style format, a
deprecation warning is raised, with a button allowing persistent
update. Any updated filters retain their meaning in the new
format. See `ibuffer-update-saved-filters-format' and
`ibuffer-saved-filters' for details of the old and new formats."
  (interactive)
  (when (and (boundp 'ibuffer-saved-filters) ibuffer-saved-filters)
    (let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters)))
      (prog1
          (setq ibuffer-saved-filters (cdr fixed))
378
        (when-let* ((old-format-detected (car fixed)))
379 380 381 382 383 384 385 386
          (let ((warning-series t)
                (updated-form
                 (with-output-to-string
                   (pp `(setq ibuffer-saved-filters ',ibuffer-saved-filters)))))
            (display-warning
             'ibuffer
             (format ibuffer-old-saved-filters-warning updated-form))))))))

Colin Walters's avatar
Colin Walters committed
387 388 389 390 391 392 393 394 395 396 397
(defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
  (or
   (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
   (and (not
	 (or
	  (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
	  (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
	(or all
	    (not
	     (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
	(or ibuffer-view-ibuffer
398
	    (and ibuffer-buf
Colin Walters's avatar
Colin Walters committed
399 400 401 402 403
		 (not (eq ibuffer-buf buf))))
	(or
	 (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
	 (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))

404 405
;;;###autoload
(define-minor-mode ibuffer-auto-mode
406
  "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)."
407 408 409
  nil nil nil
  (unless (derived-mode-p 'ibuffer-mode)
    (error "This buffer is not in Ibuffer mode"))
410 411 412 413 414
  (cond (ibuffer-auto-mode
         (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
         (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
        (t
         (remove-hook 'post-command-hook 'ibuffer-auto-update-changed))))
415

Colin Walters's avatar
Colin Walters committed
416
(defun ibuffer-auto-update-changed ()
417
  (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
418 419 420 421
    (dolist (buf (buffer-list))
      (ignore-errors
	(with-current-buffer buf
	  (when (and ibuffer-auto-mode
422
		     (derived-mode-p 'ibuffer-mode))
423
	    (ibuffer-update nil t)))))))
Colin Walters's avatar
Colin Walters committed
424 425 426 427 428 429 430 431 432 433 434 435

;;;###autoload
(defun ibuffer-mouse-filter-by-mode (event)
  "Enable or disable filtering by the major mode chosen via mouse."
  (interactive "e")
  (ibuffer-interactive-filter-by-mode event))

;;;###autoload
(defun ibuffer-interactive-filter-by-mode (event-or-point)
  "Enable or disable filtering by the major mode at point."
  (interactive "d")
  (if (eventp event-or-point)
436
      (posn-set-point (event-end event-or-point))
Colin Walters's avatar
Colin Walters committed
437 438 439 440
    (goto-char event-or-point))
  (let ((buf (ibuffer-current-buffer)))
    (if (assq 'mode ibuffer-filtering-qualifiers)
	(setq ibuffer-filtering-qualifiers
441
	      (ibuffer-remove-alist 'mode ibuffer-filtering-qualifiers))
442
      (ibuffer-push-filter (cons 'mode (buffer-local-value 'major-mode buf)))))
Colin Walters's avatar
Colin Walters committed
443 444
  (ibuffer-update nil t))

445 446 447 448 449 450 451 452 453 454 455
;;;###autoload
(defun ibuffer-mouse-toggle-filter-group (event)
  "Toggle the display status of the filter group chosen with the mouse."
  (interactive "e")
  (ibuffer-toggle-filter-group-1 (save-excursion
				   (mouse-set-point event)
				   (point))))

;;;###autoload
(defun ibuffer-toggle-filter-group ()
  "Toggle the display status of the filter group on this line."
456
  (interactive)
457 458
  (ibuffer-toggle-filter-group-1 (point)))

459
(defun ibuffer-toggle-filter-group-1 (posn)
460 461 462
  (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
    (unless (stringp name)
      (error "No filtering group name present"))
463 464 465 466
    (if (member name ibuffer-hidden-filter-groups)
	(setq ibuffer-hidden-filter-groups
	      (delete name ibuffer-hidden-filter-groups))
      (push name ibuffer-hidden-filter-groups))
467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505
    (ibuffer-update nil t)))

;;;###autoload
(defun ibuffer-forward-filter-group (&optional count)
  "Move point forwards by COUNT filtering groups."
  (interactive "P")
  (unless count
    (setq count 1))
  (when (> count 0)
    (when (get-text-property (point) 'ibuffer-filter-group-name)
      (goto-char (next-single-property-change
		  (point) 'ibuffer-filter-group-name
		  nil (point-max))))
    (goto-char (next-single-property-change
		(point) 'ibuffer-filter-group-name
		nil (point-max)))
    (ibuffer-forward-filter-group (1- count)))
  (ibuffer-forward-line 0))

;;;###autoload
(defun ibuffer-backward-filter-group (&optional count)
  "Move point backwards by COUNT filtering groups."
  (interactive "P")
  (unless count
    (setq count 1))
  (when (> count 0)
    (when (get-text-property (point) 'ibuffer-filter-group-name)
      (goto-char (previous-single-property-change
		  (point) 'ibuffer-filter-group-name
		  nil (point-min))))
    (goto-char (previous-single-property-change
		(point) 'ibuffer-filter-group-name
		nil (point-min)))
    (ibuffer-backward-filter-group (1- count)))
  (when (= (point) (point-min))
    (goto-char (point-max))
    (ibuffer-backward-filter-group 1))
  (ibuffer-forward-line 0))

506 507 508 509 510 511 512
(defun ibuffer--maybe-erase-shell-cmd-output ()
  (let ((buf (get-buffer "*Shell Command Output*")))
    (when (and (buffer-live-p buf)
               (not shell-command-dont-erase-buffer)
               (not (zerop (buffer-size buf))))
      (with-current-buffer buf (erase-buffer)))))

513
;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
514 515 516 517
(define-ibuffer-op shell-command-pipe (command)
  "Pipe the contents of each marked buffer to shell command COMMAND."
  (:interactive "sPipe to shell command: "
   :opstring "Shell command executed on"
518
   :before (ibuffer--maybe-erase-shell-cmd-output)
Colin Walters's avatar
Colin Walters committed
519
   :modifier-p nil)
520 521 522 523
  (let ((out-buf (get-buffer-create "*Shell Command Output*")))
    (with-current-buffer out-buf (goto-char (point-max)))
    (call-shell-region (point-min) (point-max)
                       command nil out-buf)))
Colin Walters's avatar
Colin Walters committed
524

525
;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
526 527 528 529 530 531 532
(define-ibuffer-op shell-command-pipe-replace (command)
  "Replace the contents of marked buffers with output of pipe to COMMAND."
  (:interactive "sPipe to shell command (replace): "
   :opstring "Buffer contents replaced in"
   :active-opstring "replace buffer contents in"
   :dangerous t
   :modifier-p t)
533 534
  (call-shell-region (point-min) (point-max)
                     command 'delete buf))
Colin Walters's avatar
Colin Walters committed
535

536
;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
537 538 539 540
(define-ibuffer-op shell-command-file (command)
  "Run shell command COMMAND separately on files of marked buffers."
  (:interactive "sShell command on buffer's file: "
   :opstring "Shell command executed on"
541
   :before (ibuffer--maybe-erase-shell-cmd-output)
Colin Walters's avatar
Colin Walters committed
542
   :modifier-p nil)
543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
  (let ((file (and (not (buffer-modified-p))
                   buffer-file-name))
        (out-buf (get-buffer-create "*Shell Command Output*")))
    (unless (and file (file-exists-p file))
      (setq file
            (make-temp-file
             (substring
              (buffer-name) 0
              (min 10 (length (buffer-name))))))
      (write-region nil nil file nil 0))
    (with-current-buffer out-buf (goto-char (point-max)))
    (call-process-shell-command
     (format "%s %s"
             command
             (shell-quote-argument file))
     nil out-buf nil)))

560
;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
561 562 563 564
(define-ibuffer-op eval (form)
  "Evaluate FORM in each of the buffers.
Does not display the buffer during evaluation. See
`ibuffer-do-view-and-eval' for that."
565 566 567 568 569
  (:interactive
   (list
    (read-from-minibuffer
     "Eval in buffers (form): "
     nil read-expression-map t 'read-expression-history))
Colin Walters's avatar
Colin Walters committed
570 571 572 573
   :opstring "evaluated in"
   :modifier-p :maybe)
  (eval form))

574
;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
575 576 577
(define-ibuffer-op view-and-eval (form)
  "Evaluate FORM while displaying each of the marked buffers.
To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
578 579 580 581 582
  (:interactive
   (list
    (read-from-minibuffer
     "Eval viewing in buffers (form): "
     nil read-expression-map t 'read-expression-history))
Colin Walters's avatar
Colin Walters committed
583 584 585 586 587 588 589 590 591 592
   :opstring "evaluated in"
   :complex t
   :modifier-p :maybe)
  (let ((ibuffer-buf (current-buffer)))
    (unwind-protect
	(progn
	  (switch-to-buffer buf)
	  (eval form))
      (switch-to-buffer ibuffer-buf))))

593
;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
594 595 596 597 598 599
(define-ibuffer-op rename-uniquely ()
  "Rename marked buffers as with `rename-uniquely'."
  (:opstring "renamed"
   :modifier-p t)
  (rename-uniquely))

600
;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
601 602 603 604 605 606 607 608
(define-ibuffer-op revert ()
  "Revert marked buffers as with `revert-buffer'."
  (:dangerous t
   :opstring "reverted"
   :active-opstring "revert"
   :modifier-p :maybe)
  (revert-buffer t t))

609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626
;;;###autoload (autoload 'ibuffer-do-isearch "ibuf-ext")
(define-ibuffer-op ibuffer-do-isearch ()
  "Perform a `isearch-forward' in marked buffers."
  (:interactive ()
   :opstring "searched in"
   :complex t
   :modifier-p :maybe)
  (multi-isearch-buffers (ibuffer-get-marked-buffers)))

;;;###autoload (autoload 'ibuffer-do-isearch-regexp "ibuf-ext")
(define-ibuffer-op ibuffer-do-isearch-regexp ()
  "Perform a `isearch-forward-regexp' in marked buffers."
  (:interactive ()
   :opstring "searched regexp in"
   :complex t
   :modifier-p :maybe)
  (multi-isearch-buffers-regexp (ibuffer-get-marked-buffers)))

627
;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646
(define-ibuffer-op replace-regexp (from-str to-str)
  "Perform a `replace-regexp' in marked buffers."
  (:interactive
   (let* ((from-str (read-from-minibuffer "Replace regexp: "))
	  (to-str (read-from-minibuffer (concat "Replace " from-str
						" with: "))))
     (list from-str to-str))
   :opstring "replaced in"
   :complex t
   :modifier-p :maybe)
  (save-window-excursion
    (switch-to-buffer buf)
    (save-excursion
      (goto-char (point-min))
      (let ((case-fold-search ibuffer-case-fold-search))
	(while (re-search-forward from-str nil t)
	  (replace-match to-str))))
    t))

647
;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
648 649 650
(define-ibuffer-op query-replace (&rest args)
  "Perform a `query-replace' in marked buffers."
  (:interactive
651
   (query-replace-read-args "Query replace" t t)
Colin Walters's avatar
Colin Walters committed
652 653 654 655 656 657 658 659 660 661 662
   :opstring "replaced in"
   :complex t
   :modifier-p :maybe)
  (save-window-excursion
    (switch-to-buffer buf)
    (save-excursion
      (let ((case-fold-search ibuffer-case-fold-search))
	(goto-char (point-min))
	(apply #'query-replace args)))
    t))

663
;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
664 665 666
(define-ibuffer-op query-replace-regexp (&rest args)
  "Perform a `query-replace-regexp' in marked buffers."
  (:interactive
667
   (query-replace-read-args "Query replace regexp" t t)
Colin Walters's avatar
Colin Walters committed
668 669 670 671 672 673 674 675 676 677 678
   :opstring "replaced in"
   :complex t
   :modifier-p :maybe)
  (save-window-excursion
    (switch-to-buffer buf)
    (save-excursion
      (let ((case-fold-search ibuffer-case-fold-search))
	(goto-char (point-min))
	(apply #'query-replace-regexp args)))
    t))

679
;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
Colin Walters's avatar
Colin Walters committed
680 681 682 683 684 685 686 687
(define-ibuffer-op print ()
  "Print marked buffers as with `print-buffer'."
  (:opstring "printed"
   :modifier-p nil)
  (print-buffer))

;;;###autoload
(defun ibuffer-included-in-filters-p (buf filters)
688 689 690 691 692
  "Return non-nil if BUF passes all FILTERS.

BUF is a lisp buffer object, and FILTERS is a list of filter
specifications with the same structure as
`ibuffer-filtering-qualifiers'."
Colin Walters's avatar
Colin Walters committed
693 694
  (not
   (memq nil ;; a filter will return nil if it failed
695 696 697 698 699 700 701 702 703 704 705 706
	 (mapcar #'(lambda (filter)
                     (ibuffer-included-in-filter-p buf filter))
                 filters))))

(defun ibuffer-unary-operand (filter)
  "Extracts operand from a unary compound FILTER specification.

FILTER should be a cons cell of either form (f . d) or (f d),
where operand d is itself a cons cell, or nil. Returns d."
  (let* ((tail (cdr filter))
         (maybe-q (car-safe tail)))
    (if (consp maybe-q) maybe-q tail)))
Colin Walters's avatar
Colin Walters committed
707 708

(defun ibuffer-included-in-filter-p (buf filter)
709 710 711 712 713
  "Return non-nil if BUF pass FILTER.

BUF is a lisp buffer object, and FILTER is a filter
specification, with the same structure as an element of the list
`ibuffer-filtering-qualifiers'."
Colin Walters's avatar
Colin Walters committed
714
  (if (eq (car filter) 'not)
715 716 717 718 719
      (let ((inner (ibuffer-unary-operand filter)))
        ;; Allows (not (not ...)) etc, which may be overkill
        (if (eq (car inner) 'not)
            (ibuffer-included-in-filter-p buf (ibuffer-unary-operand inner))
          (not (ibuffer-included-in-filter-p-1 buf inner))))
Colin Walters's avatar
Colin Walters committed
720 721 722 723 724
    (ibuffer-included-in-filter-p-1 buf filter)))

(defun ibuffer-included-in-filter-p-1 (buf filter)
  (not
   (not
725
    (pcase (car filter)
726
      ('or
727 728 729 730 731
       ;;; ATTN: Short-circuiting alternative with parallel structure w/`and
       ;;(catch 'has-match
       ;;  (dolist (filter-spec (cdr filter) nil)
       ;;    (when (ibuffer-included-in-filter-p buf filter-spec)
       ;;      (throw 'has-match t))))
Colin Walters's avatar
Colin Walters committed
732
       (memq t (mapcar #'(lambda (x)
733 734
                           (ibuffer-included-in-filter-p buf x))
                       (cdr filter))))
735
      ('and
736 737 738 739
       (catch 'no-match
         (dolist (filter-spec (cdr filter) t)
           (unless (ibuffer-included-in-filter-p buf filter-spec)
             (throw 'no-match nil)))))
740
      ('saved
741
       (let ((data (assoc (cdr filter) ibuffer-saved-filters)))
Colin Walters's avatar
Colin Walters committed
742
	 (unless data
743
	   (ibuffer-filter-disable t)
Colin Walters's avatar
Colin Walters committed
744
	   (error "Unknown saved filter %s" (cdr filter)))
745
	 (ibuffer-included-in-filters-p buf (cdr data))))
746 747 748 749 750 751 752
      (_
       (pcase-let ((`(,_type ,_desc ,func)
                    (assq (car filter) ibuffer-filtering-alist)))
         (unless func
           (ibuffer-filter-disable t)
           (error "Undefined filter %s" (car filter)))
         (funcall func buf (cdr filter))))))))
Colin Walters's avatar
Colin Walters committed
753

754 755 756 757 758
(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
  (let ((filter-group-alist (if nodefault
				ibuffer-filter-groups
			      (append ibuffer-filter-groups
				      (list (cons "Default" nil))))))
759
    ;; (dolist (hidden ibuffer-hidden-filter-groups)
760
    ;;   (setq filter-group-alist (ibuffer-remove-alist
761
    ;;     			   hidden filter-group-alist)))
762
    (let ((vec (make-vector (length filter-group-alist) nil))
763
	  (i 0))
764
      (dolist (filtergroup filter-group-alist)
765
	(let ((filterset (cdr filtergroup)))
766 767
	  (cl-multiple-value-bind (hip-crowd lamers)
	      (cl-values-list
Deepak Goel's avatar
Deepak Goel committed
768 769 770 771
	       (ibuffer-split-list (lambda (bufmark)
				     (ibuffer-included-in-filters-p (car bufmark)
								    filterset))
				   bmarklist))
772
	    (aset vec i hip-crowd)
773
	    (cl-incf i)
774
	    (setq bmarklist lamers))))
775
      (let (ret)
776
	(dotimes (j i)
777 778 779 780
	  (let ((bufs (aref vec j)))
	    (unless (and noempty (null bufs))
	      (push (cons (car (nth j filter-group-alist))
			  bufs)
781 782
		    ret))))
        ret))))
783 784 785 786 787 788 789

;;;###autoload
(defun ibuffer-filters-to-filter-group (name)
  "Make the current filters into a filtering group."
  (interactive "sName for filtering group: ")
  (when (null ibuffer-filtering-qualifiers)
    (error "No filters in effect"))
790
  (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
791 792
  (ibuffer-filter-disable))

793 794 795 796 797
;;;###autoload
(defun ibuffer-set-filter-groups-by-mode ()
  "Set the current filter groups to filter by mode."
  (interactive)
  (setq ibuffer-filter-groups
798 799 800
        (mapcar (lambda (mode)
                  (cons (format "%s" mode) `((mode . ,mode))))
                (let ((modes
801
                       (ibuffer-remove-duplicates
802
                        (mapcar (lambda (buf)
803
				  (buffer-local-value 'major-mode buf))
804 805 806 807
                                (buffer-list)))))
                  (if ibuffer-view-ibuffer
		      modes
		    (delq 'ibuffer-mode modes)))))
808 809
  (ibuffer-update nil t))

810 811
;;;###autoload
(defun ibuffer-pop-filter-group ()
812
  "Remove the first filter group."
813
  (interactive)
814
  (when (null ibuffer-filter-groups)
815
    (error "No filter groups active"))
816 817 818
  (setq ibuffer-hidden-filter-groups
	(delete (pop ibuffer-filter-groups)
		ibuffer-hidden-filter-groups))
819 820
  (ibuffer-update nil t))

821 822 823
(defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
  (when (and (not noerror) (null ibuffer-filter-groups))
    (error "No filter groups active"))
824 825 826 827 828 829 830 831 832 833 834 835 836
  ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
  ;; groups, possibly excluding empty groups or Default.
  ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
  ;; Default if necessary.
  (completing-read msg (nconc
			(ibuffer-generate-filter-groups
			 (ibuffer-current-state-list)
			 (not ibuffer-show-empty-filter-groups)
			 nodefault)
			(if nodefault
			    (remove "Default" ibuffer-hidden-filter-groups)
			  ibuffer-hidden-filter-groups))
		   nil t))
837 838 839 840

;;;###autoload
(defun ibuffer-decompose-filter-group (group)
  "Decompose the filter group GROUP into active filters."
841
  (interactive
842
   (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
843
  (let ((data (cdr (assoc group ibuffer-filter-groups))))
844
    (setq ibuffer-filter-groups (ibuffer-remove-alist
845 846 847 848
				 group ibuffer-filter-groups)
	  ibuffer-filtering-qualifiers data))
  (ibuffer-update nil t))

849 850
;;;###autoload
(defun ibuffer-clear-filter-groups ()
851
  "Remove all filter groups."
852
  (interactive)
853 854
  (setq ibuffer-filter-groups nil
	ibuffer-hidden-filter-groups nil)
855 856
  (ibuffer-update nil t))

857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872
(defun ibuffer-current-filter-groups-with-position ()
  (save-excursion
    (goto-char (point-min))
    (let ((pos nil)
	  (result nil))
      (while (and (not (eobp))
		  (setq pos (next-single-property-change
			     (point) 'ibuffer-filter-group-name)))
	(goto-char pos)
	(push (cons (get-text-property (point) 'ibuffer-filter-group-name)
		    pos)
	      result)
	(goto-char (next-single-property-change
		    pos 'ibuffer-filter-group-name)))
      (nreverse result))))

873 874 875
;;;###autoload
(defun ibuffer-jump-to-filter-group (name)
  "Move point to the filter group whose name is NAME."
876
  (interactive
877
   (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
878 879 880
  (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
      (goto-char (cdr it))
    (error "No filter group with name %s" name)))
881

882 883
;;;###autoload
(defun ibuffer-kill-filter-group (name)
884
  "Kill the filter group named NAME.
885
The group will be added to `ibuffer-filter-group-kill-ring'."
886
  (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
887
  (when (equal name "Default")
888
    (error "Can't kill default filter group"))
889
  (ibuffer-aif (assoc name ibuffer-filter-groups)
890
      (progn
891
	(push (copy-tree it) ibuffer-filter-group-kill-ring)
892
	(setq ibuffer-filter-groups (ibuffer-remove-alist
893 894
				     name ibuffer-filter-groups))
	(setq ibuffer-hidden-filter-groups
895
	      (delete name ibuffer-hidden-filter-groups)))
896 897 898 899
    (error "No filter group with name \"%s\"" name))
  (ibuffer-update nil t))

;;;###autoload
900
(defun ibuffer-kill-line (&optional arg interactive-p)
901
  "Kill the filter group at point.
902
See also `ibuffer-kill-filter-group'."
903
  (interactive "P\np")
904 905 906 907 908
  (ibuffer-aif (save-excursion
		 (ibuffer-forward-line 0)
		 (get-text-property (point) 'ibuffer-filter-group-name))
      (progn
	(ibuffer-kill-filter-group it))
909
      (funcall (if interactive-p #'call-interactively #'funcall)
910 911
	       #'kill-line arg)))

912
(defun ibuffer-insert-filter-group-before (newgroup group)
913 914 915 916 917 918 919
  (let* ((found nil)
	 (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
		    (res 0))
		(while groups
		  (if (equal (car groups) group)
		      (setq found t
			    groups nil)
920
		    (cl-incf res)
921 922 923
		    (setq groups (cdr groups))))
		res)))
    (cond ((not found)
924 925
	   (setq ibuffer-filter-groups
		 (nconc ibuffer-filter-groups (list newgroup))))
926 927
	  ((zerop pos)
	   (push newgroup ibuffer-filter-groups))
928 929 930 931 932
	  (t
	   (let ((cell (nthcdr pos ibuffer-filter-groups)))
	     (setf (cdr cell) (cons (car cell) (cdr cell)))
	     (setf (car cell) newgroup))))))

933
;;;###autoload
934 935 936 937 938 939 940 941 942 943 944
(defun ibuffer-yank ()
  "Yank the last killed filter group before group at point."
  (interactive)
  (ibuffer-yank-filter-group
   (or (get-text-property (point) 'ibuffer-filter-group-name)
       (get-text-property (point) 'ibuffer-filter-group)
       (error "No filter group at point"))))

;;;###autoload
(defun ibuffer-yank-filter-group (name)
  "Yank the last killed filter group before group named NAME."
945 946 947 948
  (interactive (list (ibuffer-read-filter-group-name
			"Yank filter group before group: ")))
  (unless ibuffer-filter-group-kill-ring
    (error "The Ibuffer filter group kill-ring is empty"))
949 950
  (save-excursion
    (ibuffer-forward-line 0)
951 952
    (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
					name))
953 954 955
  (ibuffer-update nil t))

;;;###autoload
956
(defun ibuffer-save-filter-groups (name groups)
957 958 959 960 961 962 963 964 965 966 967
  "Save all active filter groups GROUPS as NAME.
They are added to `ibuffer-saved-filter-groups'.  Interactively,
prompt for NAME, and use the current filters."
  (interactive
   (if (null ibuffer-filter-groups)
       (error "No filter groups active")
     (list
      (read-from-minibuffer "Save current filter groups as: ")
      ibuffer-filter-groups)))
  (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
      (setcdr it groups)
968
    (push (cons name groups) ibuffer-saved-filter-groups))
969
  (ibuffer-maybe-save-stuff))
970 971 972 973 974 975 976 977

;;;###autoload
(defun ibuffer-delete-saved-filter-groups (name)
  "Delete saved filter groups with NAME.
They are removed from `ibuffer-saved-filter-groups'."
  (interactive
   (list
    (if (null ibuffer-saved-filter-groups)
978 979
	(error "No saved filter groups")
      (completing-read "Delete saved filter group: "
980 981
		       ibuffer-saved-filter-groups nil t))))
  (setq ibuffer-saved-filter-groups
982
	(ibuffer-remove-alist name ibuffer-saved-filter-groups))
983 984 985 986 987 988
  (ibuffer-maybe-save-stuff)
  (ibuffer-update nil t))

;;;###autoload
(defun ibuffer-switch-to-saved-filter-groups (name)
  "Set this buffer's filter groups to saved version with NAME.
989
The value from `ibuffer-saved-filter-groups' is used."
990 991
  (interactive
   (list
992 993 994 995 996 997 998 999 1000 1001
    (cond ((null ibuffer-saved-filter-groups)
           (error "No saved filters"))
          ;; `ibuffer-saved-filter-groups' is a user variable that defaults
          ;; to nil.  We assume that with one element in this list the user
          ;; knows what she wants.  See bug#12331.
          ((null (cdr ibuffer-saved-filter-groups))
           (caar ibuffer-saved-filter-groups))
          (t
           (completing-read "Switch to saved filter group: "
                            ibuffer-saved-filter-groups nil t)))))
1002 1003
  (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
	ibuffer-hidden-filter-groups nil)
1004 1005
  (ibuffer-update nil t))

Colin Walters's avatar
Colin Walters committed
1006
;;;###autoload
1007 1008 1009 1010
(defun ibuffer-filter-disable (&optional delete-filter-groups)
  "Disable all filters currently in effect in this buffer.
With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter
group definitions by setting `ibuffer-filter-groups' to nil."
Colin Walters's avatar
Colin Walters committed
1011
  (interactive)
1012 1013 1014
  (setq ibuffer-filtering-qualifiers nil)
  (if delete-filter-groups
      (setq ibuffer-filter-groups nil))
1015 1016 1017 1018
  (let ((buf (ibuffer-current-buffer)))
    (ibuffer-update nil t)
    (when buf
      (ibuffer-jump-to-buffer (buffer-name buf)))))
Colin Walters's avatar
Colin Walters committed
1019 1020 1021 1022 1023 1024 1025 1026

;;;###autoload
(defun ibuffer-pop-filter ()
  "Remove the top filter in this buffer."
  (interactive)
  (when (null ibuffer-filtering-qualifiers)
    (error "No filters in effect"))
  (pop ibuffer-filtering-qualifiers)
1027 1028 1029 1030
  (let ((buf (ibuffer-current-buffer)))
    (ibuffer-update nil t)
    (when buf
      (ibuffer-jump-to-buffer (buffer-name buf)))))
Colin Walters's avatar
Colin Walters committed
1031

1032
(defun ibuffer-push-filter (filter-specification)
1033 1034 1035 1036 1037
  "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'.
If FILTER-SPECIFICATION is already in the list then return nil.  Otherwise,
return the updated list."
  (unless (member filter-specification ibuffer-filtering-qualifiers)
    (push filter-specification ibuffer-filtering-qualifiers)))
Colin Walters's avatar
Colin Walters committed
1038 1039 1040

;;;###autoload
(defun ibuffer-decompose-filter ()
1041
  "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED).
Colin Walters's avatar
Colin Walters committed
1042 1043 1044

This means that the topmost filter on the filtering stack, which must
be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
1045
turned into separate filters, like [name: foo] and [mode: bar-mode]."
Colin Walters's avatar
Colin Walters committed
1046
  (interactive)
1047
  (unless ibuffer-filtering-qualifiers
1048
    (error "No filters in effect"))
1049 1050 1051 1052 1053
  (let* ((filters ibuffer-filtering-qualifiers)
         (head (cdar filters))
         (tail (cdr filters))
         (value
          (pcase (caar filters)
1054 1055
            ((or 'or 'and) (nconc head tail))
            ('saved
1056 1057 1058 1059
             (let ((data (assoc head ibuffer-saved-filters)))
               (unless data
                 (ibuffer-filter-disable)
                 (error "Unknown saved filter %s" head))
1060
               (append (cdr data) tail)))
1061
            ('not (cons (ibuffer-unary-operand (car filters)) tail))
1062 1063 1064
            (_
             (error "Filter type %s is not compound" (caar filters))))))
    (setq ibuffer-filtering-qualifiers value))
Colin Walters's avatar
Colin Walters committed
1065 1066 1067 1068 1069 1070
  (ibuffer-update nil t))

;;;###autoload
(defun ibuffer-exchange-filters ()
  "Exchange the top two filters on the stack in this buffer."
  (interactive)
1071 1072 1073 1074 1075
  (let ((filters ibuffer-filtering-qualifiers))
    (when (< (length filters) 2)
      (error "Need two filters to exchange"))
    (cl-rotatef (car filters) (cadr filters))
    (ibuffer-update nil t)))
Colin Walters's avatar
Colin Walters committed
1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089

;;;###autoload
(defun ibuffer-negate-filter ()
  "Negate the sense of the top filter in the current buffer."
  (interactive)
  (when (null ibuffer-filtering-qualifiers)
    (error "No filters in effect"))
  (let ((lim (pop ibuffer-filtering-qualifiers)))
    (push (if (eq (car lim) 'not)
	      (cdr lim)
	    (cons 'not lim))
	  ibuffer-filtering-qualifiers))
  (ibuffer-update nil t))

1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104
(defun ibuffer--or-and-filter (op decompose)
  (if decompose
      (if (eq op (caar ibuffer-filtering-qualifiers))
          (ibuffer-decompose-filter)
        (error "Top filter is not an %s" (upcase (symbol-name op))))
    (when (< (length ibuffer-filtering-qualifiers) 2)
      (error "Need two filters to %s" (upcase (symbol-name op))))
    ;; If either filter is an op, eliminate unnecessary nesting.
    (let ((first (pop ibuffer-filtering-qualifiers))
          (second (pop ibuffer-filtering-qualifiers)))
      (push (nconc (if (eq op (car first)) first (list op first))
                   (if (eq op (car second)) (cdr second) (list second)))
            ibuffer-filtering-qualifiers)))
  (ibuffer-update nil t))

Colin Walters's avatar
Colin Walters committed
1105
;;;###autoload
1106
(defun ibuffer-or-filter (&optional decompose)
Colin Walters's avatar
Colin Walters committed
1107
  "Replace the top two filters in this buffer with their logical OR.
1108
If optional argument DECOMPOSE is non-nil, instead break the top OR
Colin Walters's avatar
Colin Walters committed
1109 1110
filter into parts."
  (interactive "P")
1111 1112 1113 1114 1115 1116 1117 1118 1119
  (ibuffer--or-and-filter 'or decompose))

;;;###autoload
(defun ibuffer-and-filter (&optional decompose)
  "Replace the top two filters in this buffer with their logical AND.
If optional argument DECOMPOSE is non-nil, instead break the top AND
filter into parts."
  (interactive "P")
  (ibuffer--or-and-filter 'and decompose))
Colin Walters's avatar
Colin Walters committed
1120

1121
(defun ibuffer-maybe-save-stuff ()
Colin Walters's avatar
Colin Walters committed
1122 1123 1124 1125
  (when ibuffer-save-with-custom
    (if (fboundp 'customize-save-variable)
	(progn
	  (customize-save-variable 'ibuffer-saved-filters
1126 1127 1128
				   ibuffer-saved-filters)
	  (customize-save-variable 'ibuffer-saved-filter-groups
				   ibuffer-saved-filter-groups))
Colin Walters's avatar
Colin Walters committed
1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142
      (message "Not saved permanently: Customize not available"))))

;;;###autoload
(defun ibuffer-save-filters (name filters)
  "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
Interactively, prompt for NAME, and use the current filters."
  (interactive
   (if (null ibuffer-filtering-qualifiers)
       (error "No filters currently in effect")
     (list
      (read-from-minibuffer "Save current filters as: ")
      ibuffer-filtering-qualifiers)))
  (ibuffer-aif (assoc name ibuffer-saved-filters)
      (setcdr it filters)
1143
    (push (cons name filters) ibuffer-saved-filters))
1144
  (ibuffer-maybe-save-stuff))
Colin Walters's avatar
Colin Walters committed
1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155

;;;###autoload
(defun ibuffer-delete-saved-filters (name)
  "Delete saved filters with NAME from `ibuffer-saved-filters'."
  (interactive
   (list
    (if (null ibuffer-saved-filters)
	(error "No saved filters")
      (completing-read "Delete saved filters: "
		       ibuffer-saved-filters nil t))))
  (setq ibuffer-saved-filters
1156
	(ibuffer-remove-alist name ibuffer-saved-filters))
1157
  (ibuffer-maybe-save-stuff)
Colin Walters's avatar
Colin Walters committed
1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173
  (ibuffer-update nil t))

;;;###autoload
(defun ibuffer-add-saved-filters (name)
  "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
  (interactive
   (list
    (if (null ibuffer-saved-filters)
	(error "No saved filters")
      (completing-read "Add saved filters: "
		       ibuffer-saved-filters nil t))))
  (push (cons 'saved name) ibuffer-filtering-qualifiers)
  (ibuffer-update nil t))

;;;###autoload
(defun ibuffer-switch-to-saved-filters (name)
1174
  "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
Colin Walters's avatar
Colin Walters committed
1175 1176 1177 1178 1179 1180 1181 1182
  (interactive
   (list
    (if (null ibuffer-saved-filters)
	(error "No saved filters")
      (completing-read "Switch to saved filters: "
		       ibuffer-saved-filters nil t))))
  (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
  (ibuffer-update nil t))
1183 1184 1185 1186

(defun ibuffer-format-filter-group-data (filter)
  (if (equal filter "Default")
      ""
1187 1188 1189
    (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
				 (cdr (assq filter ibuffer-filter-groups))
				 " "))))
1190

Colin Walters's avatar
Colin Walters committed
1191 1192
(defun ibuffer-format-qualifier (qualifier)
  (if (eq (car-safe qualifier) 'not)
1193 1194 1195
      (concat " [NOT"
              (ibuffer-format-qualifier-1 (ibuffer-unary-operand qualifier))
              "]")
Colin Walters's avatar
Colin Walters committed
1196 1197 1198
    (ibuffer-format-qualifier-1 qualifier)))

(defun ibuffer-format-qualifier-1 (qualifier)
1199
  (pcase (car qualifier)
1200
    ('saved
Colin Walters's avatar
Colin Walters committed
1201
     (concat " [filter: " (cdr qualifier) "]"))
1202
    ('or
Colin Walters's avatar
Colin Walters committed
1203
     (concat " [OR" (mapconcat #'ibuffer-format-qualifier
1204
                               (cdr qualifier) "") "]"))
1205
    ('and
1206 1207
     (concat " [AND" (mapconcat #'ibuffer-format-qualifier
                                (cdr qualifier) "") "]"))
1208
    (_
Colin Walters's avatar
Colin Walters committed
1209 1210
     (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
       (unless qualifier
1211
         (error "Ibuffer: bad qualifier %s" qualifier))
Colin Walters's avatar
Colin Walters committed
1212
       (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
1213

1214
(defun ibuffer-list-buffer-modes (&optional include-parents)
1215 1216 1217 1218 1219 1220 1221 1222 1223 1224
  "Create a completion table of buffer modes currently in use.
If INCLUDE-PARENTS is non-nil then include parent modes."
  (let ((modes))
    (dolist (buf (buffer-list))
      (let ((this-mode (buffer-local-value 'major-mode buf)))
        (while (and this-mode (not (memq this-mode modes)))
          (push this-mode modes)
          (setq this-mode (and include-parents
                               (get this-mode 'derived-mode-parent))))))
    (mapcar #'symbol-name modes)))
1225 1226


Colin Walters's avatar
Colin Walters committed
1227 1228
;;; Extra operation definitions

1229
;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
1230
(define-ibuffer-filter mode
1231 1232 1233
    "Limit current view to buffers with major mode(s) specified by QUALIFIER.
QUALIFIER is the mode name as a symbol or a list of symbols.
Called interactively, accept a comma separated list of mode names."
Colin Walters's avatar
Colin Walters committed
1234 1235
  (:description "major mode"
   :reader
Stefan Monnier's avatar