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 <https://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 (defun ibuffer--maybe-erase-shell-cmd-output ()
 510   (let ((buf (get-buffer "*Shell Command Output*")))
 511     (when (and (buffer-live-p buf)
 512                (not shell-command-dont-erase-buffer)
 513                (not (zerop (buffer-size buf))))
 514       (with-current-buffer buf (erase-buffer)))))
 515
 516 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
 517 (define-ibuffer-op shell-command-pipe (command)
 518   "Pipe the contents of each marked buffer to shell command COMMAND."
 519   (:interactive "sPipe to shell command: "
 520    :opstring "Shell command executed on"
 521    :before (ibuffer--maybe-erase-shell-cmd-output)
 522    :modifier-p nil)
 523   (let ((out-buf (get-buffer-create "*Shell Command Output*")))
 524     (with-current-buffer out-buf (goto-char (point-max)))
 525     (call-shell-region (point-min) (point-max)
 526                        command nil out-buf)))
 527
 528 ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
 529 (define-ibuffer-op shell-command-pipe-replace (command)
 530   "Replace the contents of marked buffers with output of pipe to COMMAND."
 531   (:interactive "sPipe to shell command (replace): "
 532    :opstring "Buffer contents replaced in"
 533    :active-opstring "replace buffer contents in"
 534    :dangerous t
 535    :modifier-p t)
 536   (call-shell-region (point-min) (point-max)
 537                      command 'delete buf))
 538
 539 ;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
 540 (define-ibuffer-op shell-command-file (command)
 541   "Run shell command COMMAND separately on files of marked buffers."
 542   (:interactive "sShell command on buffer's file: "
 543    :opstring "Shell command executed on"
 544    :before (ibuffer--maybe-erase-shell-cmd-output)
 545    :modifier-p nil)
 546   (let ((file (and (not (buffer-modified-p))
 547                    buffer-file-name))
 548         (out-buf (get-buffer-create "*Shell Command Output*")))
 549     (unless (and file (file-exists-p file))
 550       (setq file
 551             (make-temp-file
 552              (substring
 553               (buffer-name) 0
 554               (min 10 (length (buffer-name))))))
 555       (write-region nil nil file nil 0))
 556     (with-current-buffer out-buf (goto-char (point-max)))
 557     (call-process-shell-command
 558      (format "%s %s"
 559              command
 560              (shell-quote-argument file))
 561      nil out-buf nil)))
 562
 563 ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
 564 (define-ibuffer-op eval (form)
 565   "Evaluate FORM in each of the buffers.
 566 Does not display the buffer during evaluation. See
 567 `ibuffer-do-view-and-eval' for that."
 568   (:interactive
 569    (list
 570     (read-from-minibuffer
 571      "Eval in buffers (form): "
 572      nil read-expression-map t 'read-expression-history))
 573    :opstring "evaluated in"
 574    :modifier-p :maybe)
 575   (eval form))
 576
 577 ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
 578 (define-ibuffer-op view-and-eval (form)
 579   "Evaluate FORM while displaying each of the marked buffers.
 580 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
 581   (:interactive
 582    (list
 583     (read-from-minibuffer
 584      "Eval viewing in buffers (form): "
 585      nil read-expression-map t 'read-expression-history))
 586    :opstring "evaluated in"
 587    :complex t
 588    :modifier-p :maybe)
 589   (let ((ibuffer-buf (current-buffer)))
 590     (unwind-protect
 591         (progn
 592           (switch-to-buffer buf)
 593           (eval form))
 594       (switch-to-buffer ibuffer-buf))))
 595
 596 ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
 597 (define-ibuffer-op rename-uniquely ()
 598   "Rename marked buffers as with `rename-uniquely'."
 599   (:opstring "renamed"
 600    :modifier-p t)
 601   (rename-uniquely))
 602
 603 ;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
 604 (define-ibuffer-op revert ()
 605   "Revert marked buffers as with `revert-buffer'."
 606   (:dangerous t
 607    :opstring "reverted"
 608    :active-opstring "revert"
 609    :modifier-p :maybe)
 610   (revert-buffer t t))
 611
 612 ;;;###autoload (autoload 'ibuffer-do-isearch "ibuf-ext")
 613 (define-ibuffer-op ibuffer-do-isearch ()
 614   "Perform a `isearch-forward' in marked buffers."
 615   (:interactive ()
 616    :opstring "searched in"
 617    :complex t
 618    :modifier-p :maybe)
 619   (multi-isearch-buffers (ibuffer-get-marked-buffers)))
 620
 621 ;;;###autoload (autoload 'ibuffer-do-isearch-regexp "ibuf-ext")
 622 (define-ibuffer-op ibuffer-do-isearch-regexp ()
 623   "Perform a `isearch-forward-regexp' in marked buffers."
 624   (:interactive ()
 625    :opstring "searched regexp in"
 626    :complex t
 627    :modifier-p :maybe)
 628   (multi-isearch-buffers-regexp (ibuffer-get-marked-buffers)))
 629
 630 ;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
 631 (define-ibuffer-op replace-regexp (from-str to-str)
 632   "Perform a `replace-regexp' in marked buffers."
 633   (:interactive
 634    (let* ((from-str (read-from-minibuffer "Replace regexp: "))
 635           (to-str (read-from-minibuffer (concat "Replace " from-str
 636                                                 " with: "))))
 637      (list from-str to-str))
 638    :opstring "replaced in"
 639    :complex t
 640    :modifier-p :maybe)
 641   (save-window-excursion
 642     (switch-to-buffer buf)
 643     (save-excursion
 644       (goto-char (point-min))
 645       (let ((case-fold-search ibuffer-case-fold-search))
 646         (while (re-search-forward from-str nil t)
 647           (replace-match to-str))))
 648     t))
 649
 650 ;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
 651 (define-ibuffer-op query-replace (&rest args)
 652   "Perform a `query-replace' in marked buffers."
 653   (:interactive
 654    (query-replace-read-args "Query replace" 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 args)))
 664     t))
 665
 666 ;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
 667 (define-ibuffer-op query-replace-regexp (&rest args)
 668   "Perform a `query-replace-regexp' in marked buffers."
 669   (:interactive
 670    (query-replace-read-args "Query replace regexp" t t)
 671    :opstring "replaced in"
 672    :complex t
 673    :modifier-p :maybe)
 674   (save-window-excursion
 675     (switch-to-buffer buf)
 676     (save-excursion
 677       (let ((case-fold-search ibuffer-case-fold-search))
 678         (goto-char (point-min))
 679         (apply #'query-replace-regexp args)))
 680     t))
 681
 682 ;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
 683 (define-ibuffer-op print ()
 684   "Print marked buffers as with `print-buffer'."
 685   (:opstring "printed"
 686    :modifier-p nil)
 687   (print-buffer))
 688
 689 ;;;###autoload
 690 (defun ibuffer-included-in-filters-p (buf filters)
 691   "Return non-nil if BUF passes all FILTERS.
 692
 693 BUF is a lisp buffer object, and FILTERS is a list of filter
 694 specifications with the same structure as
 695 `ibuffer-filtering-qualifiers'."
 696   (not
 697    (memq nil ;; a filter will return nil if it failed
 698          (mapcar #'(lambda (filter)
 699                      (ibuffer-included-in-filter-p buf filter))
 700                  filters))))
 701
 702 (defun ibuffer-unary-operand (filter)
 703   "Extracts operand from a unary compound FILTER specification.
 704
 705 FILTER should be a cons cell of either form (f . d) or (f d),
 706 where operand d is itself a cons cell, or nil. Returns d."
 707   (let* ((tail (cdr filter))
 708          (maybe-q (car-safe tail)))
 709     (if (consp maybe-q) maybe-q tail)))
 710
 711 (defun ibuffer-included-in-filter-p (buf filter)
 712   "Return non-nil if BUF pass FILTER.
 713
 714 BUF is a lisp buffer object, and FILTER is a filter
 715 specification, with the same structure as an element of the list
 716 `ibuffer-filtering-qualifiers'."
 717   (if (eq (car filter) 'not)
 718       (let ((inner (ibuffer-unary-operand filter)))
 719         ;; Allows (not (not ...)) etc, which may be overkill
 720         (if (eq (car inner) 'not)
 721             (ibuffer-included-in-filter-p buf (ibuffer-unary-operand inner))
 722           (not (ibuffer-included-in-filter-p-1 buf inner))))
 723     (ibuffer-included-in-filter-p-1 buf filter)))
 724
 725 (defun ibuffer-included-in-filter-p-1 (buf filter)
 726   (not
 727    (not
 728     (pcase (car filter)
 729       (`or
 730        ;;; ATTN: Short-circuiting alternative with parallel structure w/`and
 731        ;;(catch 'has-match
 732        ;;  (dolist (filter-spec (cdr filter) nil)
 733        ;;    (when (ibuffer-included-in-filter-p buf filter-spec)
 734        ;;      (throw 'has-match t))))
 735        (memq t (mapcar #'(lambda (x)
 736                            (ibuffer-included-in-filter-p buf x))
 737                        (cdr filter))))
 738       (`and
 739        (catch 'no-match
 740          (dolist (filter-spec (cdr filter) t)
 741            (unless (ibuffer-included-in-filter-p buf filter-spec)
 742              (throw 'no-match nil)))))
 743       (`saved
 744        (let ((data (assoc (cdr filter) ibuffer-saved-filters)))
 745          (unless data
 746            (ibuffer-filter-disable t)
 747            (error "Unknown saved filter %s" (cdr filter)))
 748          (ibuffer-included-in-filters-p buf (cdr data))))
 749       (_
 750        (pcase-let ((`(,_type ,_desc ,func)
 751                     (assq (car filter) ibuffer-filtering-alist)))
 752          (unless func
 753            (ibuffer-filter-disable t)
 754            (error "Undefined filter %s" (car filter)))
 755          (funcall func buf (cdr filter))))))))
 756
 757 (defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
 758   (let ((filter-group-alist (if nodefault
 759                                 ibuffer-filter-groups
 760                               (append ibuffer-filter-groups
 761                                       (list (cons "Default" nil))))))
 762     ;; (dolist (hidden ibuffer-hidden-filter-groups)
 763     ;;   (setq filter-group-alist (ibuffer-remove-alist
 764     ;;                             hidden filter-group-alist)))
 765     (let ((vec (make-vector (length filter-group-alist) nil))
 766           (i 0))
 767       (dolist (filtergroup filter-group-alist)
 768         (let ((filterset (cdr filtergroup)))
 769           (cl-multiple-value-bind (hip-crowd lamers)
 770               (cl-values-list
 771                (ibuffer-split-list (lambda (bufmark)
 772                                      (ibuffer-included-in-filters-p (car bufmark)
 773                                                                     filterset))
 774                                    bmarklist))
 775             (aset vec i hip-crowd)
 776             (cl-incf i)
 777             (setq bmarklist lamers))))
 778       (let (ret)
 779         (dotimes (j i)
 780           (let ((bufs (aref vec j)))
 781             (unless (and noempty (null bufs))
 782               (push (cons (car (nth j filter-group-alist))
 783                           bufs)
 784                     ret))))
 785         ret))))
 786
 787 ;;;###autoload
 788 (defun ibuffer-filters-to-filter-group (name)
 789   "Make the current filters into a filtering group."
 790   (interactive "sName for filtering group: ")
 791   (when (null ibuffer-filtering-qualifiers)
 792     (error "No filters in effect"))
 793   (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
 794   (ibuffer-filter-disable))
 795
 796 ;;;###autoload
 797 (defun ibuffer-set-filter-groups-by-mode ()
 798   "Set the current filter groups to filter by mode."
 799   (interactive)
 800   (setq ibuffer-filter-groups
 801         (mapcar (lambda (mode)
 802                   (cons (format "%s" mode) `((mode . ,mode))))
 803                 (let ((modes
 804                        (ibuffer-remove-duplicates
 805                         (mapcar (lambda (buf)
 806                                   (buffer-local-value 'major-mode buf))
 807                                 (buffer-list)))))
 808                   (if ibuffer-view-ibuffer
 809                       modes
 810                     (delq 'ibuffer-mode modes)))))
 811   (ibuffer-update nil t))
 812
 813 ;;;###autoload
 814 (defun ibuffer-pop-filter-group ()
 815   "Remove the first filter group."
 816   (interactive)
 817   (when (null ibuffer-filter-groups)
 818     (error "No filter groups active"))
 819   (setq ibuffer-hidden-filter-groups
 820         (delete (pop ibuffer-filter-groups)
 821                 ibuffer-hidden-filter-groups))
 822   (ibuffer-update nil t))
 823
 824 (defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
 825   (when (and (not noerror) (null ibuffer-filter-groups))
 826     (error "No filter groups active"))
 827   ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
 828   ;; groups, possibly excluding empty groups or Default.
 829   ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
 830   ;; Default if necessary.
 831   (completing-read msg (nconc
 832                         (ibuffer-generate-filter-groups
 833                          (ibuffer-current-state-list)
 834                          (not ibuffer-show-empty-filter-groups)
 835                          nodefault)
 836                         (if nodefault
 837                             (remove "Default" ibuffer-hidden-filter-groups)
 838                           ibuffer-hidden-filter-groups))
 839                    nil t))
 840
 841 ;;;###autoload
 842 (defun ibuffer-decompose-filter-group (group)
 843   "Decompose the filter group GROUP into active filters."
 844   (interactive
 845    (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
 846   (let ((data (cdr (assoc group ibuffer-filter-groups))))
 847     (setq ibuffer-filter-groups (ibuffer-remove-alist
 848                                  group ibuffer-filter-groups)
 849           ibuffer-filtering-qualifiers data))
 850   (ibuffer-update nil t))
 851
 852 ;;;###autoload
 853 (defun ibuffer-clear-filter-groups ()
 854   "Remove all filter groups."
 855   (interactive)
 856   (setq ibuffer-filter-groups nil
 857         ibuffer-hidden-filter-groups nil)
 858   (ibuffer-update nil t))
 859
 860 (defun ibuffer-current-filter-groups-with-position ()
 861   (save-excursion
 862     (goto-char (point-min))
 863     (let ((pos nil)
 864           (result nil))
 865       (while (and (not (eobp))
 866                   (setq pos (next-single-property-change
 867                              (point) 'ibuffer-filter-group-name)))
 868         (goto-char pos)
 869         (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
 870                     pos)
 871               result)
 872         (goto-char (next-single-property-change
 873                     pos 'ibuffer-filter-group-name)))
 874       (nreverse result))))
 875
 876 ;;;###autoload
 877 (defun ibuffer-jump-to-filter-group (name)
 878   "Move point to the filter group whose name is NAME."
 879   (interactive
 880    (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
 881   (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
 882       (goto-char (cdr it))
 883     (error "No filter group with name %s" name)))
 884
 885 ;;;###autoload
 886 (defun ibuffer-kill-filter-group (name)
 887   "Kill the filter group named NAME.
 888 The group will be added to `ibuffer-filter-group-kill-ring'."
 889   (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
 890   (when (equal name "Default")
 891     (error "Can't kill default filter group"))
 892   (ibuffer-aif (assoc name ibuffer-filter-groups)
 893       (progn
 894         (push (copy-tree it) ibuffer-filter-group-kill-ring)
 895         (setq ibuffer-filter-groups (ibuffer-remove-alist
 896                                      name ibuffer-filter-groups))
 897         (setq ibuffer-hidden-filter-groups
 898               (delete name ibuffer-hidden-filter-groups)))
 899     (error "No filter group with name \"%s\"" name))
 900   (ibuffer-update nil t))
 901
 902 ;;;###autoload
 903 (defun ibuffer-kill-line (&optional arg interactive-p)
 904   "Kill the filter group at point.
 905 See also `ibuffer-kill-filter-group'."
 906   (interactive "P\np")
 907   (ibuffer-aif (save-excursion
 908                  (ibuffer-forward-line 0)
 909                  (get-text-property (point) 'ibuffer-filter-group-name))
 910       (progn
 911         (ibuffer-kill-filter-group it))
 912       (funcall (if interactive-p #'call-interactively #'funcall)
 913                #'kill-line arg)))
 914
 915 (defun ibuffer-insert-filter-group-before (newgroup group)
 916   (let* ((found nil)
 917          (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
 918                     (res 0))
 919                 (while groups
 920                   (if (equal (car groups) group)
 921                       (setq found t
 922                             groups nil)
 923                     (cl-incf res)
 924                     (setq groups (cdr groups))))
 925                 res)))
 926     (cond ((not found)
 927            (setq ibuffer-filter-groups
 928                  (nconc ibuffer-filter-groups (list newgroup))))
 929           ((zerop pos)
 930            (push newgroup ibuffer-filter-groups))
 931           (t
 932            (let ((cell (nthcdr pos ibuffer-filter-groups)))
 933              (setf (cdr cell) (cons (car cell) (cdr cell)))
 934              (setf (car cell) newgroup))))))
 935
 936 ;;;###autoload
 937 (defun ibuffer-yank ()
 938   "Yank the last killed filter group before group at point."
 939   (interactive)
 940   (ibuffer-yank-filter-group
 941    (or (get-text-property (point) 'ibuffer-filter-group-name)
 942        (get-text-property (point) 'ibuffer-filter-group)
 943        (error "No filter group at point"))))
 944
 945 ;;;###autoload
 946 (defun ibuffer-yank-filter-group (name)
 947   "Yank the last killed filter group before group named NAME."
 948   (interactive (list (ibuffer-read-filter-group-name
 949                         "Yank filter group before group: ")))
 950   (unless ibuffer-filter-group-kill-ring
 951     (error "The Ibuffer filter group kill-ring is empty"))
 952   (save-excursion
 953     (ibuffer-forward-line 0)
 954     (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
 955                                         name))
 956   (ibuffer-update nil t))
 957
 958 ;;;###autoload
 959 (defun ibuffer-save-filter-groups (name groups)
 960   "Save all active filter groups GROUPS as NAME.
 961 They are added to `ibuffer-saved-filter-groups'.  Interactively,
 962 prompt for NAME, and use the current filters."
 963   (interactive
 964    (if (null ibuffer-filter-groups)
 965        (error "No filter groups active")
 966      (list
 967       (read-from-minibuffer "Save current filter groups as: ")
 968       ibuffer-filter-groups)))
 969   (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
 970       (setcdr it groups)
 971     (push (cons name groups) ibuffer-saved-filter-groups))
 972   (ibuffer-maybe-save-stuff))
 973
 974 ;;;###autoload
 975 (defun ibuffer-delete-saved-filter-groups (name)
 976   "Delete saved filter groups with NAME.
 977 They are removed from `ibuffer-saved-filter-groups'."
 978   (interactive
 979    (list
 980     (if (null ibuffer-saved-filter-groups)
 981         (error "No saved filter groups")
 982       (completing-read "Delete saved filter group: "
 983                        ibuffer-saved-filter-groups nil t))))
 984   (setq ibuffer-saved-filter-groups
 985         (ibuffer-remove-alist name ibuffer-saved-filter-groups))
 986   (ibuffer-maybe-save-stuff)
 987   (ibuffer-update nil t))
 988
 989 ;;;###autoload
 990 (defun ibuffer-switch-to-saved-filter-groups (name)
 991   "Set this buffer's filter groups to saved version with NAME.
 992 The value from `ibuffer-saved-filter-groups' is used."
 993   (interactive
 994    (list
 995     (cond ((null ibuffer-saved-filter-groups)
 996            (error "No saved filters"))
 997           ;; `ibuffer-saved-filter-groups' is a user variable that defaults
 998           ;; to nil.  We assume that with one element in this list the user
 999           ;; knows what she wants.  See bug#12331.
1000           ((null (cdr ibuffer-saved-filter-groups))
1001            (caar ibuffer-saved-filter-groups))
1002           (t
1003            (completing-read "Switch to saved filter group: "
1004                             ibuffer-saved-filter-groups nil t)))))
1005   (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
1006         ibuffer-hidden-filter-groups nil)
1007   (ibuffer-update nil t))
1008
1009 ;;;###autoload
1010 (defun ibuffer-filter-disable (&optional delete-filter-groups)
1011   "Disable all filters currently in effect in this buffer.
1012 With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter
1013 group definitions by setting `ibuffer-filter-groups' to nil."
1014   (interactive)
1015   (setq ibuffer-filtering-qualifiers nil)
1016   (if delete-filter-groups
1017       (setq ibuffer-filter-groups nil))
1018   (let ((buf (ibuffer-current-buffer)))
1019     (ibuffer-update nil t)
1020     (when buf
1021       (ibuffer-jump-to-buffer (buffer-name buf)))))
1022
1023 ;;;###autoload
1024 (defun ibuffer-pop-filter ()
1025   "Remove the top filter in this buffer."
1026   (interactive)
1027   (when (null ibuffer-filtering-qualifiers)
1028     (error "No filters in effect"))
1029   (pop ibuffer-filtering-qualifiers)
1030   (let ((buf (ibuffer-current-buffer)))
1031     (ibuffer-update nil t)
1032     (when buf
1033       (ibuffer-jump-to-buffer (buffer-name buf)))))
1034
1035 (defun ibuffer-push-filter (filter-specification)
1036   "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'."
1037   (push filter-specification ibuffer-filtering-qualifiers))
1038
1039 ;;;###autoload
1040 (defun ibuffer-decompose-filter ()
1041   "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED).
1042
1043 This means that the topmost filter on the filtering stack, which must
1044 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]."
1046   (interactive)
1047   (unless ibuffer-filtering-qualifiers
1048     (error "No filters in effect"))
1049   (let* ((filters ibuffer-filtering-qualifiers)
1050          (head (cdar filters))
1051          (tail (cdr filters))
1052          (value
1053           (pcase (caar filters)
1054             ((or `or 'and) (nconc head tail))
1055             (`saved
1056              (let ((data (assoc head ibuffer-saved-filters)))
1057                (unless data
1058                  (ibuffer-filter-disable)
1059                  (error "Unknown saved filter %s" head))
1060                (append (cdr data) tail)))
1061             (`not (cons (ibuffer-unary-operand (car filters)) tail))
1062             (_
1063              (error "Filter type %s is not compound" (caar filters))))))
1064     (setq ibuffer-filtering-qualifiers value))
1065   (ibuffer-update nil t))
1066
1067 ;;;###autoload
1068 (defun ibuffer-exchange-filters ()
1069   "Exchange the top two filters on the stack in this buffer."
1070   (interactive)
1071   (let ((filters ibuffer-filtering-qualifiers))
1072     (when (< (length filters) 2)
1073       (error "Need two filters to exchange"))
1074     (cl-rotatef (car filters) (cadr filters))
1075     (ibuffer-update nil t)))
1076
1077 ;;;###autoload
1078 (defun ibuffer-negate-filter ()
1079   "Negate the sense of the top filter in the current buffer."
1080   (interactive)
1081   (when (null ibuffer-filtering-qualifiers)
1082     (error "No filters in effect"))
1083   (let ((lim (pop ibuffer-filtering-qualifiers)))
1084     (push (if (eq (car lim) 'not)
1085               (cdr lim)
1086             (cons 'not lim))
1087           ibuffer-filtering-qualifiers))
1088   (ibuffer-update nil t))
1089
1090 (defun ibuffer--or-and-filter (op decompose)
1091   (if decompose
1092       (if (eq op (caar ibuffer-filtering-qualifiers))
1093           (ibuffer-decompose-filter)
1094         (error "Top filter is not an %s" (upcase (symbol-name op))))
1095     (when (< (length ibuffer-filtering-qualifiers) 2)
1096       (error "Need two filters to %s" (upcase (symbol-name op))))
1097     ;; If either filter is an op, eliminate unnecessary nesting.
1098     (let ((first (pop ibuffer-filtering-qualifiers))
1099           (second (pop ibuffer-filtering-qualifiers)))
1100       (push (nconc (if (eq op (car first)) first (list op first))
1101                    (if (eq op (car second)) (cdr second) (list second)))
1102             ibuffer-filtering-qualifiers)))
1103   (ibuffer-update nil t))
1104
1105 ;;;###autoload
1106 (defun ibuffer-or-filter (&optional decompose)
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
1109 filter into parts."
1110   (interactive "P")
1111   (ibuffer--or-and-filter 'or decompose))
1112
1113 ;;;###autoload
1114 (defun ibuffer-and-filter (&optional decompose)
1115   "Replace the top two filters in this buffer with their logical AND.
1116 If optional argument DECOMPOSE is non-nil, instead break the top AND
1117 filter into parts."
1118   (interactive "P")
1119   (ibuffer--or-and-filter 'and decompose))
1120
1121 (defun ibuffer-maybe-save-stuff ()
1122   (when ibuffer-save-with-custom
1123     (if (fboundp 'customize-save-variable)
1124         (progn
1125           (customize-save-variable 'ibuffer-saved-filters
1126                                    ibuffer-saved-filters)
1127           (customize-save-variable 'ibuffer-saved-filter-groups
1128                                    ibuffer-saved-filter-groups))
1129       (message "Not saved permanently: Customize not available"))))
1130
1131 ;;;###autoload
1132 (defun ibuffer-save-filters (name filters)
1133   "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
1134 Interactively, prompt for NAME, and use the current filters."
1135   (interactive
1136    (if (null ibuffer-filtering-qualifiers)
1137        (error "No filters currently in effect")
1138      (list
1139       (read-from-minibuffer "Save current filters as: ")
1140       ibuffer-filtering-qualifiers)))
1141   (ibuffer-aif (assoc name ibuffer-saved-filters)
1142       (setcdr it filters)
1143     (push (cons name filters) ibuffer-saved-filters))
1144   (ibuffer-maybe-save-stuff))
1145
1146 ;;;###autoload
1147 (defun ibuffer-delete-saved-filters (name)
1148   "Delete saved filters with NAME from `ibuffer-saved-filters'."
1149   (interactive
1150    (list
1151     (if (null ibuffer-saved-filters)
1152         (error "No saved filters")
1153       (completing-read "Delete saved filters: "
1154                        ibuffer-saved-filters nil t))))
1155   (setq ibuffer-saved-filters
1156         (ibuffer-remove-alist name ibuffer-saved-filters))
1157   (ibuffer-maybe-save-stuff)
1158   (ibuffer-update nil t))
1159
1160 ;;;###autoload
1161 (defun ibuffer-add-saved-filters (name)
1162   "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
1163   (interactive
1164    (list
1165     (if (null ibuffer-saved-filters)
1166         (error "No saved filters")
1167       (completing-read "Add saved filters: "
1168                        ibuffer-saved-filters nil t))))
1169   (push (cons 'saved name) ibuffer-filtering-qualifiers)
1170   (ibuffer-update nil t))
1171
1172 ;;;###autoload
1173 (defun ibuffer-switch-to-saved-filters (name)
1174   "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
1175   (interactive
1176    (list
1177     (if (null ibuffer-saved-filters)
1178         (error "No saved filters")
1179       (completing-read "Switch to saved filters: "
1180                        ibuffer-saved-filters nil t))))
1181   (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
1182   (ibuffer-update nil t))
1183
1184 (defun ibuffer-format-filter-group-data (filter)
1185   (if (equal filter "Default")
1186       ""
1187     (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
1188                                  (cdr (assq filter ibuffer-filter-groups))
1189                                  " "))))
1190
1191 (defun ibuffer-format-qualifier (qualifier)
1192   (if (eq (car-safe qualifier) 'not)
1193       (concat " [NOT"
1194               (ibuffer-format-qualifier-1 (ibuffer-unary-operand qualifier))
1195               "]")
1196     (ibuffer-format-qualifier-1 qualifier)))
1197
1198 (defun ibuffer-format-qualifier-1 (qualifier)
1199   (pcase (car qualifier)
1200     (`saved
1201      (concat " [filter: " (cdr qualifier) "]"))
1202     (`or
1203      (concat " [OR" (mapconcat #'ibuffer-format-qualifier
1204                                (cdr qualifier) "") "]"))
1205     (`and
1206      (concat " [AND" (mapconcat #'ibuffer-format-qualifier
1207                                 (cdr qualifier) "") "]"))
1208     (_
1209      (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
1210        (unless qualifier
1211          (error "Ibuffer: bad qualifier %s" qualifier))
1212        (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
1213
1214 (defun ibuffer-list-buffer-modes (&optional include-parents)
1215   "Create a completion table of buffer modes currently in use.
1216 If INCLUDE-PARENTS is non-nil then include parent modes."
1217   (let ((modes))
1218     (dolist (buf (buffer-list))
1219       (let ((this-mode (buffer-local-value 'major-mode buf)))
1220         (while (and this-mode (not (memq this-mode modes)))
1221           (push this-mode modes)
1222           (setq this-mode (and include-parents
1223                                (get this-mode 'derived-mode-parent))))))
1224     (mapcar #'symbol-name modes)))
1225
1226
1227 ;;; Extra operation definitions
1228
1229 ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
1230 (define-ibuffer-filter mode
1231   "Limit current view to buffers with major mode QUALIFIER."
1232   (:description "major mode"
1233    :reader
1234    (let* ((buf (ibuffer-current-buffer))
1235           (default (if (and buf (buffer-live-p buf))
1236                        (symbol-name (buffer-local-value
1237                                      'major-mode buf)))))
1238      (intern
1239       (completing-read
1240        (if default
1241            (format "Filter by major mode (default %s): " default)
1242          "Filter by major mode: ")
1243        obarray
1244        #'(lambda (e)
1245            (string-match "-mode\\'" (symbol-name e)))
1246        t nil nil default))))
1247   (eq qualifier (buffer-local-value 'major-mode buf)))
1248
1249 ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
1250 (define-ibuffer-filter used-mode
1251   "Limit current view to buffers with major mode QUALIFIER.
1252 Called interactively, this function allows selection of modes
1253 currently used by buffers."
1254   (:description "major mode in use"
1255    :reader
1256    (let* ((buf (ibuffer-current-buffer))
1257           (default (if (and buf (buffer-live-p buf))
1258                        (symbol-name (buffer-local-value
1259                                      'major-mode buf)))))
1260      (intern
1261       (completing-read
1262        (if default
1263            (format "Filter by major mode (default %s): " default)
1264          "Filter by major mode: ")
1265        (ibuffer-list-buffer-modes) nil t nil nil default))))
1266   (eq qualifier (buffer-local-value 'major-mode buf)))
1267
1268 ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
1269 (define-ibuffer-filter derived-mode
1270     "Limit current view to buffers whose major mode inherits from QUALIFIER."
1271   (:description "derived mode"
1272                 :reader
1273                 (intern
1274                  (completing-read "Filter by derived mode: "
1275                                   (ibuffer-list-buffer-modes t)
1276                                   nil t)))
1277   (with-current-buffer buf (derived-mode-p qualifier)))
1278
1279 ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
1280 (define-ibuffer-filter name
1281   "Limit current view to buffers with name matching QUALIFIER."
1282   (:description "buffer name"
1283    :reader (read-from-minibuffer "Filter by name (regexp): "))
1284   (string-match qualifier (buffer-name buf)))
1285
1286 ;;;###autoload (autoload 'ibuffer-filter-by-starred-name "ibuf-ext")
1287 (define-ibuffer-filter starred-name
1288     "Limit current view to buffers with name beginning and ending
1289 with *, along with an optional suffix of the form digits or
1290 <digits>."
1291   (:description "starred buffer name"
1292    :reader nil)
1293   (string-match "\\`\\*[^*]+\\*\\(?:<[[:digit:]]+>\\)?\\'" (buffer-name buf)))
1294
1295 ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext")
1296 (define-ibuffer-filter filename
1297     "Limit current view to buffers with full file name matching QUALIFIER.
1298
1299 For example, for a buffer associated with file '/a/b/c.d', this
1300 matches against '/a/b/c.d'."
1301   (:description "full file name"
1302    :reader (read-from-minibuffer "Filter by full file name (regexp): "))
1303   (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1304     (string-match qualifier it)))
1305
1306 ;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext")
1307 (define-ibuffer-filter basename
1308     "Limit current view to buffers with file basename matching QUALIFIER.
1309
1310 For example, for a buffer associated with file '/a/b/c.d', this
1311 matches against 'c.d'."
1312   (:description "file basename"
1313    :reader (read-from-minibuffer
1314             "Filter by file name, without directory part (regex): "))
1315   (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1316     (string-match qualifier (file-name-nondirectory it))))
1317
1318 ;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext")
1319 (define-ibuffer-filter file-extension
1320     "Limit current view to buffers with filename extension matching QUALIFIER.
1321
1322 The separator character (typically `.') is not part of the
1323 pattern. For example, for a buffer associated with file
1324 '/a/b/c.d', this matches against 'd'."
1325   (:description "filename extension"
1326    :reader (read-from-minibuffer
1327             "Filter by filename extension without separator (regex): "))
1328   (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
1329     (string-match qualifier (or (file-name-extension it) ""))))
1330
1331 ;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext")
1332 (define-ibuffer-filter directory
1333     "Limit current view to buffers with directory matching QUALIFIER.
1334
1335 For a buffer associated with file '/a/b/c.d', this matches
1336 against '/a/b'. For a buffer not associated with a file, this
1337 matches against the value of `default-directory' in that buffer."
1338   (:description "directory name"
1339    :reader (read-from-minibuffer "Filter by directory name (regex): "))
1340   (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name))
1341       (let ((dirname (file-name-directory it)))
1342         (when dirname (string-match qualifier dirname)))
1343     (when default-directory (string-match qualifier default-directory))))
1344
1345 ;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext")
1346 (define-ibuffer-filter size-gt
1347   "Limit current view to buffers with size greater than QUALIFIER."
1348   (:description "size greater than"
1349    :reader
1350    (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
1351   (> (with-current-buffer buf (buffer-size))
1352      qualifier))
1353
1354 ;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext")
1355 (define-ibuffer-filter size-lt
1356     "Limit current view to buffers with size less than QUALIFIER."
1357   (:description "size less than"
1358    :reader
1359    (string-to-number (read-from-minibuffer "Filter by size less than: ")))
1360   (< (with-current-buffer buf (buffer-size))
1361      qualifier))
1362
1363 ;;;###autoload (autoload 'ibuffer-filter-by-modified "ibuf-ext")
1364 (define-ibuffer-filter modified
1365     "Limit current view to buffers that are marked as modified."
1366   (:description "modified"
1367    :reader nil)
1368   (buffer-modified-p buf))
1369
1370 ;;;###autoload (autoload 'ibuffer-filter-by-visiting-file "ibuf-ext")
1371 (define-ibuffer-filter visiting-file
1372     "Limit current view to buffers that are visiting a file."
1373   (:description "visiting a file"
1374    :reader nil)
1375   (with-current-buffer buf (buffer-file-name)))
1376
1377 ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext")
1378 (define-ibuffer-filter content
1379    "Limit current view to buffers whose contents match QUALIFIER."
1380   (:description "content"
1381    :reader (read-from-minibuffer "Filter by content (regexp): "))
1382   (with-current-buffer buf
1383     (save-excursion
1384       (goto-char (point-min))
1385       (re-search-forward qualifier nil t))))
1386
1387 ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext")
1388 (define-ibuffer-filter predicate
1389    "Limit current view to buffers for which QUALIFIER returns non-nil."
1390   (:description "predicate"
1391    :reader (read-minibuffer "Filter by predicate (form): "))
1392   (with-current-buffer buf
1393     (eval qualifier)))
1394
1395 ;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext")
1396 (defun ibuffer-filter-chosen-by-completion ()
1397   "Select and apply filter chosen by completion against available filters.
1398 Indicates corresponding key sequences in echo area after filtering.
1399
1400 The completion matches against the filter description text of
1401 each filter in `ibuffer-filtering-alist'."
1402   (interactive)
1403   (let* ((filters (mapcar (lambda (x) (cons (cadr x) (car x)))
1404                           ibuffer-filtering-alist))
1405          (match (completing-read "Filter by: " filters nil t))
1406          (filter (cdr (assoc match filters)))
1407          (command (intern (concat "ibuffer-filter-by-" (symbol-name filter)))))
1408     (call-interactively command)
1409     (message "%s can be run with key sequences: %s"
1410              command
1411              (mapconcat #'key-description
1412                         (where-is-internal command ibuffer-mode-map nil t)
1413                         "or "))))
1414
1415
1416 ;;; Sorting
1417
1418 ;;;###autoload
1419 (defun ibuffer-toggle-sorting-mode ()
1420   "Toggle the current sorting mode.
1421 Default sorting modes are:
1422  Recency - the last time the buffer was viewed
1423  Name - the name of the buffer
1424  Major Mode - the name of the major mode of the buffer
1425  Size - the size of the buffer"
1426   (interactive)
1427   (let ((modes (mapcar #'car ibuffer-sorting-functions-alist)))
1428     (cl-pushnew 'recency modes)
1429     (setq modes (sort modes #'string-lessp))
1430     (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
1431                     (car modes))))
1432       (setq ibuffer-sorting-mode next)
1433       (message "Sorting by %s" next)))
1434   (ibuffer-redisplay t))
1435
1436 ;;;###autoload
1437 (defun ibuffer-invert-sorting ()
1438   "Toggle whether or not sorting is in reverse order."
1439   (interactive)
1440   (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
1441   (message "Sorting order %s"
1442            (if ibuffer-sorting-reversep
1443                "reversed"
1444              "normal"))
1445   (ibuffer-redisplay t))
1446
1447 ;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext")
1448 (define-ibuffer-sorter major-mode
1449   "Sort the buffers by major modes.
1450 Ordering is lexicographic."
1451   (:description "major mode")
1452   (string-lessp (downcase
1453                  (symbol-name (buffer-local-value 'major-mode (car a))))
1454                 (downcase
1455                  (symbol-name (buffer-local-value 'major-mode (car b))))))
1456
1457 ;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext")
1458 (define-ibuffer-sorter mode-name
1459   "Sort the buffers by their mode name.
1460 Ordering is lexicographic."
1461   (:description "major mode name")
1462   (string-lessp (downcase
1463                  (with-current-buffer
1464                      (car a)
1465                    (format-mode-line mode-name)))
1466                 (downcase
1467                  (with-current-buffer
1468                      (car b)
1469                    (format-mode-line mode-name)))))
1470
1471 ;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext")
1472 (define-ibuffer-sorter alphabetic
1473   "Sort the buffers by their names.
1474 Ordering is lexicographic."
1475   (:description "buffer name")
1476   (string-lessp
1477    (buffer-name (car a))
1478    (buffer-name (car b))))
1479
1480 ;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext")
1481 (define-ibuffer-sorter size
1482  "Sort the buffers by their size."
1483   (:description "size")
1484   (< (with-current-buffer (car a)
1485        (buffer-size))
1486      (with-current-buffer (car b)
1487        (buffer-size))))
1488
1489 ;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext")
1490 (define-ibuffer-sorter filename/process
1491  "Sort the buffers by their file name/process name."
1492   (:description "file name")
1493   (string-lessp
1494    ;; FIXME: For now just compare the file name and the process name
1495    ;; (if it exists).  Is there a better way to do this?
1496    (or (buffer-file-name (car a))
1497        (let ((pr-a (get-buffer-process (car a))))
1498          (and (processp pr-a) (process-name pr-a))))
1499    (or (buffer-file-name (car b))
1500        (let ((pr-b (get-buffer-process (car b))))
1501          (and (processp pr-b) (process-name pr-b))))))
1502
1503 ;;; Functions to emulate bs.el
1504
1505 ;;;###autoload
1506 (defun ibuffer-bs-show ()
1507   "Emulate `bs-show' from the bs.el package."
1508   (interactive)
1509   (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
1510   (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
1511
1512 (defun ibuffer-bs-toggle-all ()
1513   "Emulate `bs-toggle-show-all' from the bs.el package."
1514   (interactive)
1515   (if ibuffer-filtering-qualifiers
1516       (ibuffer-pop-filter)
1517     (progn (ibuffer-push-filter '(filename . ".*"))
1518            (ibuffer-update nil t))))
1519
1520 ;;; Handy functions
1521
1522 ;;;###autoload
1523 (defun ibuffer-add-to-tmp-hide (regexp)
1524   "Add REGEXP to `ibuffer-tmp-hide-regexps'.
1525 This means that buffers whose name matches REGEXP will not be shown
1526 for this Ibuffer session."
1527   (interactive
1528    (list
1529     (read-from-minibuffer "Never show buffers matching: "
1530                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1531   (push regexp ibuffer-tmp-hide-regexps))
1532
1533 ;;;###autoload
1534 (defun ibuffer-add-to-tmp-show (regexp)
1535   "Add REGEXP to `ibuffer-tmp-show-regexps'.
1536 This means that buffers whose name matches REGEXP will always be shown
1537 for this Ibuffer session."
1538   (interactive
1539    (list
1540     (read-from-minibuffer "Always show buffers matching: "
1541                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1542   (push regexp ibuffer-tmp-show-regexps))
1543
1544 ;;;###autoload
1545 (defun ibuffer-forward-next-marked (&optional count mark direction)
1546   "Move forward by COUNT marked buffers (default 1).
1547
1548 If MARK is non-nil, it should be a character denoting the type of mark
1549 to move by.  The default is `ibuffer-marked-char'.
1550
1551 If DIRECTION is non-nil, it should be an integer; negative integers
1552 mean move backwards, non-negative integers mean move forwards."
1553   (interactive "P")
1554   (unless count
1555     (setq count 1))
1556   (unless mark
1557     (setq mark ibuffer-marked-char))
1558   (unless direction
1559     (setq direction 1))
1560   ;; Skip the title
1561   (ibuffer-forward-line 0)
1562   (let ((opos (point)))
1563     (ibuffer-forward-line direction)
1564     (while (not (or (= (point) opos)
1565                     (eq (ibuffer-current-mark) mark)))
1566       (ibuffer-forward-line direction))
1567     (when (and (= (point) opos)
1568                (not (eq (ibuffer-current-mark) mark)))
1569       (error "No buffers with mark %c" mark))))
1570
1571 ;;;###autoload
1572 (defun ibuffer-backwards-next-marked (&optional count mark)
1573    "Move backwards by COUNT marked buffers (default 1).
1574
1575 If MARK is non-nil, it should be a character denoting the type of mark
1576 to move by.  The default is `ibuffer-marked-char'."
1577    (interactive "P")
1578    (ibuffer-forward-next-marked count mark -1))
1579
1580 ;;;###autoload
1581 (defun ibuffer-do-kill-lines ()
1582   "Hide all of the currently marked lines."
1583   (interactive)
1584   (if (= (ibuffer-count-marked-lines) 0)
1585       (message "No buffers marked; use 'm' to mark a buffer")
1586     (let ((count
1587            (ibuffer-map-marked-lines
1588             #'(lambda (_buf _mark)
1589                 'kill))))
1590       (message "Killed %s lines" count))))
1591
1592 ;;;###autoload
1593 (defun ibuffer-jump-to-buffer (name)
1594   "Move point to the buffer whose name is NAME.
1595
1596 If called interactively, prompt for a buffer name and go to the
1597 corresponding line in the Ibuffer buffer.  If said buffer is in a
1598 hidden group filter, open it.
1599
1600 If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer
1601 visible buffers in the completion list.  Calling the command with
1602 a prefix argument reverses the meaning of that variable."
1603   (interactive (list
1604                 (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
1605                   (when current-prefix-arg
1606                     (setq only-visible (not only-visible)))
1607                   (if only-visible
1608                       (let ((table (mapcar #'(lambda (x)
1609                                                (buffer-name (car x)))
1610                                            (ibuffer-current-state-list))))
1611                         (when (null table)
1612                           (error "No buffers!"))
1613                         (completing-read "Jump to buffer: "
1614                                          table nil t))
1615                     (read-buffer "Jump to buffer: " nil t)))))
1616   (when (not (string= "" name))
1617     (let (buf-point)
1618       ;; Blindly search for our buffer: it is very likely that it is
1619       ;; not in a hidden filter group.
1620       (ibuffer-map-lines #'(lambda (buf _marks)
1621                              (when (string= (buffer-name buf) name)
1622                                (setq buf-point (point))
1623                                nil))
1624                          t nil)
1625       (when (and
1626              (null buf-point)
1627              (not (null ibuffer-hidden-filter-groups)))
1628         ;; We did not find our buffer.  It must be in a hidden filter
1629         ;; group, so go through all hidden filter groups to find it.
1630         (catch 'found
1631           (dolist (group ibuffer-hidden-filter-groups)
1632             (ibuffer-jump-to-filter-group group)
1633             (ibuffer-toggle-filter-group)
1634             (ibuffer-map-lines #'(lambda (buf _marks)
1635                                    (when (string= (buffer-name buf) name)
1636                                      (setq buf-point (point))
1637                                      nil))
1638                                t group)
1639             (if buf-point
1640                 (throw 'found nil)
1641               (ibuffer-toggle-filter-group)))))
1642       (if (null buf-point)
1643           ;; Still not found even though we expanded all hidden filter
1644           ;; groups: that must be because it's hidden by predicate:
1645           ;; we won't bother trying to display it.
1646           (error "No buffer with name %s" name)
1647         (goto-char buf-point)))))
1648
1649 (declare-function diff-sentinel "diff"
1650                   (code &optional old-temp-file new-temp-file))
1651
1652 (defun ibuffer-diff-buffer-with-file-1 (buffer)
1653   (let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
1654         (tempfile (make-temp-file "buffer-content-")))
1655     (when bufferfile
1656       (unwind-protect
1657           (progn
1658             (with-current-buffer buffer
1659               (write-region nil nil tempfile nil 'nomessage))
1660             (let* ((old (expand-file-name bufferfile))
1661                    (new (expand-file-name tempfile))
1662                    (oldtmp (file-local-copy old))
1663                    (newtmp (file-local-copy new))
1664                    (switches diff-switches)
1665                    (command
1666                     (mapconcat
1667                      'identity
1668                      `(,diff-command
1669                        ;; Use explicitly specified switches
1670                        ,@(if (listp switches) switches (list switches))
1671                        ,@(if (or old new)
1672                              (list "-L" (shell-quote-argument old)
1673                                    "-L" (shell-quote-argument
1674                                          (format "Buffer %s" (buffer-name buffer)))))
1675                        ,(shell-quote-argument (or oldtmp old))
1676                        ,(shell-quote-argument (or newtmp new)))
1677                      " ")))
1678               (let ((inhibit-read-only t))
1679                 (insert command "\n")
1680                 (diff-sentinel
1681                  (call-process shell-file-name nil
1682                                (current-buffer) nil
1683                                shell-command-switch command))
1684                 (insert "\n")))))
1685       (sit-for 0)
1686       (when (file-exists-p tempfile)
1687         (delete-file tempfile)))))
1688
1689 ;;;###autoload
1690 (defun ibuffer-diff-with-file ()
1691   "View the differences between marked buffers and their associated files.
1692 If no buffers are marked, use buffer at point.
1693 This requires the external program \"diff\" to be in your `exec-path'."
1694   (interactive)
1695   (require 'diff)
1696   (let ((marked-bufs (ibuffer-get-marked-buffers)))
1697     (when (null marked-bufs)
1698       (setq marked-bufs (list (ibuffer-current-buffer t))))
1699     (with-current-buffer (get-buffer-create "*Ibuffer Diff*")
1700       (setq buffer-read-only nil)
1701       (buffer-disable-undo (current-buffer))
1702       (erase-buffer)
1703       (buffer-enable-undo (current-buffer))
1704       (diff-mode)
1705       (dolist (buf marked-bufs)
1706         (unless (buffer-live-p buf)
1707           (error "Buffer %s has been killed" buf))
1708         (ibuffer-diff-buffer-with-file-1 buf))
1709       (setq buffer-read-only t)))
1710   (switch-to-buffer "*Ibuffer Diff*"))
1711
1712 ;;;###autoload
1713 (defun ibuffer-copy-filename-as-kill (&optional arg)
1714   "Copy filenames of marked (or next ARG) buffers into the kill ring.
1715
1716 The names are separated by a space.
1717 If a buffer has no filename, it is ignored.
1718
1719 With no prefix arg, use the filename sans its directory of each marked file.
1720 With a zero prefix arg, use the complete filename of each marked file.
1721 With \\[universal-argument], use the filename of each marked file relative
1722 to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
1723
1724 You can then feed the file name(s) to other commands with \\[yank]."
1725   (interactive "P")
1726   (let* ((buffers (cond ((and (integerp arg) (not (zerop arg)))
1727                          (ibuffer--near-buffers arg))
1728                         (t
1729                          (or (ibuffer-get-marked-buffers)
1730                              (list (ibuffer-current-buffer))))))
1731          (file-names
1732           (mapcar
1733            (lambda (buf)
1734              (let ((name (with-current-buffer buf
1735                            (ibuffer-buffer-file-name))))
1736                (if (null name)
1737                    ""
1738                  (cond ((and (integerp arg) (zerop arg)) name)
1739                        ((consp arg)
1740                         (file-relative-name
1741                          name (or ibuffer-default-directory
1742                                   default-directory)))
1743                        (t (file-name-nondirectory name))))))
1744            buffers))
1745          (string
1746           (mapconcat 'identity (delete "" file-names) " ")))
1747     (unless (string= string "")
1748       (if (eq last-command 'kill-region)
1749           (kill-append string nil)
1750         (kill-new string))
1751       (message "%s" string))))
1752
1753 ;;;###autoload
1754 (defun ibuffer-copy-buffername-as-kill (&optional arg)
1755   "Copy buffer names of marked (or next ARG) buffers into the kill ring.
1756 The names are separated by a space.
1757 You can then feed the file name(s) to other commands with \\[yank]."
1758   (interactive "P")
1759   (let* ((buffers (cond ((and (integerp arg) (not (zerop arg)))
1760                          (ibuffer--near-buffers arg))
1761                         (t
1762                          (or (ibuffer-get-marked-buffers)
1763                              (list (ibuffer-current-buffer))))))
1764          (string (mapconcat #'buffer-name buffers " ")))
1765     (unless (string= string "")
1766       (if (eq last-command 'kill-region)
1767           (kill-append string nil)
1768         (kill-new string))
1769       (message "%s" string))))
1770
1771 (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1772   (let ((count
1773          (ibuffer-map-lines
1774           #'(lambda (buf _mark)
1775               (when (funcall func buf)
1776                 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1777                                         ibuffer-marked-char))
1778                 t))
1779           nil
1780           group)))
1781     (ibuffer-redisplay t)
1782     (unless (eq ibuffer-mark-on-buffer-mark ?\s)
1783       (message "Marked %s buffers" count))))
1784
1785 ;;;###autoload
1786 (defun ibuffer-mark-by-name-regexp (regexp)
1787   "Mark all buffers whose name matches REGEXP."
1788   (interactive "sMark by name (regexp): ")
1789   (ibuffer-mark-on-buffer
1790    #'(lambda (buf)
1791        (string-match regexp (buffer-name buf)))))
1792
1793 (defun ibuffer-locked-buffer-p (&optional buf)
1794   "Return non-nil if BUF is locked.
1795 When BUF nil, default to the buffer at current line."
1796   (let ((cbuffer (or buf (ibuffer-current-buffer))))
1797     (when cbuffer
1798       (with-current-buffer cbuffer
1799         (and (boundp 'emacs-lock-mode) emacs-lock-mode)))))
1800
1801 ;;;###autoload
1802 (defun ibuffer-mark-by-locked ()
1803   "Mark all locked buffers."
1804   (interactive)
1805   (when (featurep 'emacs-lock)
1806     (ibuffer-mark-on-buffer
1807      (lambda (buf)
1808        (ibuffer-locked-buffer-p buf)))))
1809
1810 ;;;###autoload
1811 (defun ibuffer-mark-by-mode-regexp (regexp)
1812   "Mark all buffers whose major mode matches REGEXP."
1813   (interactive "sMark by major mode (regexp): ")
1814   (ibuffer-mark-on-buffer
1815    #'(lambda (buf)
1816        (with-current-buffer buf
1817          (string-match regexp (format-mode-line mode-name nil nil buf))))))
1818
1819 ;;;###autoload
1820 (defun ibuffer-mark-by-file-name-regexp (regexp)
1821   "Mark all buffers whose file name matches REGEXP."
1822   (interactive "sMark by file name (regexp): ")
1823   (ibuffer-mark-on-buffer
1824    #'(lambda (buf)
1825        (let ((name (or (buffer-file-name buf)
1826                        (with-current-buffer buf
1827                          (and
1828                           (boundp 'dired-directory)
1829                           (stringp dired-directory)
1830                           dired-directory)))))
1831          (when name
1832            (string-match regexp name))))))
1833
1834 ;;;###autoload
1835 (defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
1836   "Mark all buffers whose content matches REGEXP.
1837 Optional arg ALL-BUFFERS, if non-nil, then search in all buffers.
1838 Otherwise buffers whose name matches an element of
1839 `ibuffer-never-search-content-name' or whose major mode is on
1840 `ibuffer-never-search-content-mode' are excluded."
1841   (interactive (let ((reg (read-string "Mark by content (regexp): ")))
1842                  (list reg current-prefix-arg)))
1843   (ibuffer-mark-on-buffer
1844    #'(lambda (buf)
1845        (let ((mode (with-current-buffer buf major-mode))
1846              res)
1847          (cond ((and (not all-buffers)
1848                      (or
1849                       (memq mode ibuffer-never-search-content-mode)
1850                       (cl-some (lambda (x) (string-match x (buffer-name buf)))
1851                                ibuffer-never-search-content-name)))
1852                 (setq res nil))
1853                (t
1854                 (with-current-buffer buf
1855                   (save-mark-and-excursion
1856                    (goto-char (point-min))
1857                    (setq res (re-search-forward regexp nil t)))))) res))))
1858
1859 ;;;###autoload
1860 (defun ibuffer-mark-by-mode (mode)
1861   "Mark all buffers whose major mode equals MODE."
1862   (interactive
1863    (let* ((buf (ibuffer-current-buffer))
1864           (default (if (and buf (buffer-live-p buf))
1865                        (symbol-name (buffer-local-value
1866                                      'major-mode buf)))))
1867      (list (intern
1868             (completing-read
1869              (if default
1870                  (format "Mark by major mode (default %s): " default)
1871                "Mark by major mode: ")
1872              (ibuffer-list-buffer-modes) nil t nil nil default)))))
1873   (ibuffer-mark-on-buffer
1874    #'(lambda (buf)
1875        (eq (buffer-local-value 'major-mode buf) mode))))
1876
1877 ;;;###autoload
1878 (defun ibuffer-mark-modified-buffers ()
1879   "Mark all modified buffers."
1880   (interactive)
1881   (ibuffer-mark-on-buffer
1882    #'(lambda (buf) (buffer-modified-p buf))))
1883
1884 ;;;###autoload
1885 (defun ibuffer-mark-unsaved-buffers ()
1886   "Mark all modified buffers that have an associated file."
1887   (interactive)
1888   (ibuffer-mark-on-buffer
1889    #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
1890                         (buffer-modified-p buf)))))
1891
1892 ;;;###autoload
1893 (defun ibuffer-mark-dissociated-buffers ()
1894   "Mark all buffers whose associated file does not exist."
1895   (interactive)
1896   (ibuffer-mark-on-buffer
1897    #'(lambda (buf)
1898        (with-current-buffer buf
1899          (or
1900           (and buffer-file-name
1901                (not (file-exists-p buffer-file-name)))
1902           (and (eq major-mode 'dired-mode)
1903                (boundp 'dired-directory)
1904                (stringp dired-directory)
1905                (not (file-exists-p (file-name-directory dired-directory)))))))))
1906
1907 ;;;###autoload
1908 (defun ibuffer-mark-help-buffers ()
1909   "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
1910   (interactive)
1911   (ibuffer-mark-on-buffer
1912    #'(lambda (buf)
1913        (with-current-buffer buf
1914          (memq major-mode ibuffer-help-buffer-modes)))))
1915
1916 ;;;###autoload
1917 (defun ibuffer-mark-compressed-file-buffers ()
1918   "Mark buffers whose associated file is compressed."
1919   (interactive)
1920   (ibuffer-mark-on-buffer
1921    #'(lambda (buf)
1922        (with-current-buffer buf
1923          (and buffer-file-name
1924               (string-match ibuffer-compressed-file-name-regexp
1925                            buffer-file-name))))))
1926
1927 ;;;###autoload
1928 (defun ibuffer-mark-old-buffers ()
1929   "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
1930   (interactive)
1931   (ibuffer-mark-on-buffer
1932    #'(lambda (buf)
1933        (with-current-buffer buf
1934          ;; hacked from midnight.el
1935          (when buffer-display-time
1936            (let* ((now (float-time))
1937                   (then (float-time buffer-display-time)))
1938              (> (- now then) (* 60 60 ibuffer-old-time))))))))
1939
1940 ;;;###autoload
1941 (defun ibuffer-mark-special-buffers ()
1942   "Mark all buffers whose name begins and ends with `*'."
1943   (interactive)
1944   (ibuffer-mark-on-buffer
1945    #'(lambda (buf) (string-match "^\\*.+\\*$"
1946                                  (buffer-name buf)))))
1947
1948 ;;;###autoload
1949 (defun ibuffer-mark-read-only-buffers ()
1950   "Mark all read-only buffers."
1951   (interactive)
1952   (ibuffer-mark-on-buffer
1953    #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
1954
1955 ;;;###autoload
1956 (defun ibuffer-mark-dired-buffers ()
1957   "Mark all `dired' buffers."
1958   (interactive)
1959   (ibuffer-mark-on-buffer
1960    #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
1961
1962 ;;;###autoload
1963 (defun ibuffer-do-occur (regexp &optional nlines)
1964   "View lines which match REGEXP in all marked buffers.
1965 Optional argument NLINES says how many lines of context to display: it
1966 defaults to one."
1967   (interactive (occur-read-primary-args))
1968   (if (or (not (integerp nlines))
1969           (< nlines 0))
1970       (setq nlines 0))
1971   (when (zerop (ibuffer-count-marked-lines))
1972     (ibuffer-set-mark ibuffer-marked-char))
1973   (let ((ibuffer-do-occur-bufs nil))
1974     ;; Accumulate a list of marked buffers
1975     (ibuffer-map-marked-lines
1976      #'(lambda (buf _mark)
1977          (push buf ibuffer-do-occur-bufs)))
1978     (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1979
1980 (provide 'ibuf-ext)
1981
1982 ;; Local Variables:
1983 ;; generated-autoload-file: "ibuffer-loaddefs.el"
1984 ;; End:
1985
1986 ;;; ibuf-ext.el ends here