lisp/ibuf-ext.el

   1 ;;; ibuf-ext.el --- extensions for ibuffer  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Colin Walters <walters@verbum.org>
   6 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
   7 ;; Created: 2 Dec 2001
   8 ;; Keywords: buffer, convenience
   9 ;; Package: ibuffer
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; These functions should be automatically loaded when called, but you
  29 ;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them
  30 ;; preloaded.
  31 ;;
  32 ;; 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'.
  38
  39 ;;; Code:
  40
  41 (require 'ibuffer)
  42
  43 (eval-when-compile
  44   (require 'ibuf-macs)
  45   (require 'cl-lib)
  46   (require 'subr-x))
  47
  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)
  54
  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)))
  65
  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))))
  75
  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)
  84
  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)
  94
  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)
 112
 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)
 120
 121 (defvar ibuffer-tmp-hide-regexps nil
 122   "A list of regexps which should match buffer names to not show.")
 123
 124 (defvar ibuffer-tmp-show-regexps nil
 125   "A list of regexps which should match buffer names to always show.")
 126
 127 (defvar ibuffer-auto-buffers-changed nil)
 128
 129 (defun ibuffer-update-saved-filters-format (filters)
 130   "Transforms alist from old to new `ibuffer-saved-filters' format.
 131
 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.
 137
 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))))
 148
 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))))
 176
 177   "An alist mapping saved filter names to filter specifications.
 178
 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)
 197
 198 (defvar ibuffer-old-saved-filters-warning
 199   (concat "Deprecated format detected for variable `ibuffer-saved-filters'.
 200
 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.
 218
 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.
 225
 226 Alternative ways to save the repaired value:
 227
 228   1. Do M-x customize-variable and entering `ibuffer-saved-filters'
 229      when prompted.
 230
 231   2. Set the updated value manually by copying the
 232      following emacs-lisp form to your emacs init file.
 233
 234 %s
 235 "))
 236
 237 (defvar ibuffer-filtering-qualifiers nil
 238   "A list specifying the filters currently acting on the buffer list.
 239
 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.
 244
 245 Each filter specification can be of two types: simple or compound.
 246
 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).
 251
 252 A compound filter specification can have one of four forms:
 253
 254 -- (not FILTER-SPEC)
 255
 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.
 259
 260 -- (and FILTER-SPECS...)
 261
 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.
 266
 267 -- (or FILTER-SPECS...)
 268
 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.
 272
 273 -- (saved . \"NAME\")
 274
 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.
 278
 279 This variable is local to each ibuffer buffer.")
 280
 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.
 284
 285 You most likely do not want to modify this variable directly; see
 286 `define-ibuffer-filter'.
 287
 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.")
 292
 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 ...)) ...)
 297
 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)
 306
 307 (defvar ibuffer-cached-filter-formats nil)
 308 (defvar ibuffer-compiled-filter-formats nil)
 309
 310 (defvar ibuffer-filter-groups nil
 311   "An alist giving this buffer's active filter groups, or nil if none.
 312
 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'.
 318
 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.")
 323
 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)
 328
 329 (defcustom ibuffer-saved-filter-groups nil
 330   "An alist of filtering groups to switch between.
 331
 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'.
 336
 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)
 344
 345 (defvar ibuffer-hidden-filter-groups nil
 346   "The list of filter groups that are currently hidden.")
 347
 348 (defvar ibuffer-filter-group-kill-ring nil)
 349
 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)
 357
 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)
 364
 365 (defun ibuffer-repair-saved-filters ()
 366   "Updates `ibuffer-saved-filters' to its new-style format, if needed.
 367
 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))))))))
 386
 387 (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
 388   (or
 389    (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
 390    (and (not
 391          (or
 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))))
 400         (or
 401          (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
 402          (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
 403
 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))
 416         (t
 417          (remove-hook 'post-command-hook 'ibuffer-auto-update-changed))))
 418
 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)))))))
 427
 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))
 433
 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))
 447
 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))))
 455
 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)))
 461
 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)))
 471
 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))
 488
 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))
 508
 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))
 517
 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)))
 529
 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))))))
 546
 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))
 560
 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))))
 579
 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))
 586
 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))
 595
 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)))
 604
 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)))
 613
 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))))
 632     t))
 633
 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)))
 648     t))
 649
 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)))
 664     t))
 665
 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))
 672
 673 ;;;###autoload
 674 (defun ibuffer-included-in-filters-p (buf filters)
 675   "Return non-nil if BUF passes all FILTERS.
 676
 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))))
 685
 686 (defun ibuffer-unary-operand (filter)
 687   "Extracts operand from a unary compound FILTER specification.
 688
 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)))
 694
 695 (defun ibuffer-included-in-filter-p (buf filter)
 696   "Return non-nil if BUF pass FILTER.
 697
 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)))
 708
 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))))
 733       (_
 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))))))))
 740
 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))))
 770
 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))
 779
 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))
 796
 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))
 807
 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))
 824
 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))
 835
 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))
 843
 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))))
 859
 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)))
 868
 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))
 885
 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)))
 898
 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))
 915           (t
 916            (let ((cell (nthcdr pos ibuffer-filter-groups)))
 917              (setf (cdr cell) (cons (car cell) (cdr cell)))
 918              (setf (car cell) newgroup))))))
 919
 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"))))
 928
 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))
 941
 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))
 957
 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))
 972
 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))
 986           (t
 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))
 992
 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)))))
1006
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)))))
1018
1019 (defun ibuffer-push-filter (filter-specification)
1020   "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'."
1021   (push filter-specification ibuffer-filtering-qualifiers))
1022
1023 ;;;###autoload
1024 (defun ibuffer-decompose-filter ()
1025   "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED).
1026
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))
1046             (_
1047              (error "Filter type %s is not compound" (caar filters))))))
1048     (setq ibuffer-filtering-qualifiers value))
1049   (ibuffer-update nil t))
1050
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)))
1060
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))
1073
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))
1088
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))
1096
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))
1104
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"))))
1114
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))
1129
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))
1143
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))
1155
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))
1167
1168 (defun ibuffer-format-filter-group-data (filter)
1169   (if (equal filter "Default")
1170       ""
1171     (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
1172                                  (cdr (assq filter ibuffer-filter-groups))
1173                                  " "))))
1174
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)))
1181
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) "") "]"))
1192     (_
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)))))))
1197
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)))
1209
1210
1211 ;;; Extra operation definitions
1212
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)))
1232
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)))
1251
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)))
1262
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)))
1269
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)))
1278
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.
1282
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)))
1289
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.
1293
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))))
1301
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.
1305
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) ""))))
1314
1315 ;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext")
1316 (define-ibuffer-filter directory
1317     "Limit current view to buffers with directory matching QUALIFIER.
1318
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))))
1328
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))
1337
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))
1346
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))
1353
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)))
1360
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))))
1370
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)))
1378
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.
1383
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 "))))
1398
1399
1400 ;;; Sorting
1401
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))
1419
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))
1430
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))))))
1440
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)))))
1454
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))))
1463
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))))
1472
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))))))
1486
1487 ;;; Functions to emulate bs.el
1488
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))
1495
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))))
1503
1504 ;;; Handy functions
1505
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))
1516
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))
1527
1528 ;;;###autoload
1529 (defun ibuffer-forward-next-marked (&optional count mark direction)
1530   "Move forward by COUNT marked buffers (default 1).
1531
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'.
1534
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))))
1554
1555 ;;;###autoload
1556 (defun ibuffer-backwards-next-marked (&optional count mark)
1557    "Move backwards by COUNT marked buffers (default 1).
1558
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))
1563
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))))
1575
1576 ;;;###autoload
1577 (defun ibuffer-jump-to-buffer (name)
1578   "Move point to the buffer whose name is NAME.
1579
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.
1583
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)))))
1632
1633 (declare-function diff-sentinel "diff"
1634                   (code &optional old-temp-file new-temp-file))
1635
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)))))
1672
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*"))
1695
1696 ;;;###autoload
1697 (defun ibuffer-copy-filename-as-kill (&optional arg)
1698   "Copy filenames of marked (or next ARG) buffers into the kill ring.
1699
1700 The names are separated by a space.
1701 If a buffer has no filename, it is ignored.
1702
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'.
1707
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))
1712                         (t
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)
1721                    ""
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))))
1736
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))
1745                         (t
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))))
1754
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))
1762                 t))
1763           nil
1764           group)))
1765     (ibuffer-redisplay t)
1766     (unless (eq ibuffer-mark-on-buffer-mark ?\s)
1767       (message "Marked %s buffers" count))))
1768
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)))))
1776
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)))))
1784
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)))))
1793
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))))))
1802
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))))))
1817
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)
1832                      (or
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))
1837                (t
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))))
1842
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))))
1860
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))))
1867
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)))))
1875
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
1883          (or
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)))))))))
1890
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)))))
1899
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))))))
1910
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))))))))
1923
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)))))
1931
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))))
1938
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))))
1945
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)))
1963
1964 (provide 'ibuf-ext)
1965
1966 ;; Local Variables:
1967 ;; generated-autoload-file: "ibuffer-loaddefs.el"
1968 ;; End:
1969
1970 ;;; ibuf-ext.el ends here