lisp/ibuf-ext.el

   1 ;;; ibuf-ext.el --- extensions for ibuffer -*-byte-compile-dynamic: t;-*-
   2
   3 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   4
   5 ;; Author: Colin Walters <walters@verbum.org>
   6 ;; Created: 2 Dec 2001
   7 ;; Keywords: buffer, convenience
   8
   9 ;; This file is not currently part of GNU Emacs.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program ; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; These functions should be automatically loaded when called, but you
  29 ;; can explicity (require 'ibuf-ext) in your ~/.emacs to have them
  30 ;; preloaded.
  31
  32 ;;; Code:
  33
  34 (require 'ibuffer)
  35
  36 (eval-when-compile
  37   (require 'derived)
  38   (require 'ibuf-macs)
  39   (require 'cl))
  40
  41 ;;; Utility functions
  42 (defun ibuffer-delete-alist (key alist)
  43   "Delete all entries in ALIST that have a key equal to KEY."
  44   (let (entry)
  45     (while (setq entry (assoc key alist))
  46       (setq alist (delete entry alist)))
  47     alist))
  48
  49 (defun ibuffer-depropertize-string (str &optional nocopy)
  50   "Return a copy of STR with text properties removed.
  51 If optional argument NOCOPY is non-nil, actually modify the string directly."
  52   (let ((str (if nocopy
  53                  str
  54                (copy-sequence str))))
  55     (set-text-properties 0 (length str) nil str)
  56     str))
  57
  58 (defcustom ibuffer-never-show-predicates nil
  59   "A list of predicates (a regexp or function) for buffers not to display.
  60 If a regexp, then it will be matched against the buffer's name.
  61 If a function, it will be called with the buffer as an argument, and
  62 should return non-nil if this buffer should not be shown."
  63   :type '(repeat (choice regexp function))
  64   :group 'ibuffer)
  65
  66 (defcustom ibuffer-always-show-predicates nil
  67   "A list of predicates (a regexp or function) for buffers to always display.
  68 If a regexp, then it will be matched against the buffer's name.
  69 If a function, it will be called with the buffer as an argument, and
  70 should return non-nil if this buffer should be shown.
  71 Note that buffers matching one of these predicates will be shown
  72 regardless of any active filters in this buffer."
  73   :type '(repeat (choice regexp function))
  74   :group 'ibuffer)
  75
  76 (defvar ibuffer-tmp-hide-regexps nil
  77   "A list of regexps which should match buffer names to not show.")
  78
  79 (defvar ibuffer-tmp-show-regexps nil
  80   "A list of regexps which should match buffer names to always show.")
  81
  82 (defvar ibuffer-auto-mode nil
  83   "If non-nil, Ibuffer auto-mode should be enabled for this buffer.
  84 Do not set this variable directly!  Use the function
  85 `ibuffer-auto-mode' instead.")
  86
  87 (defvar ibuffer-auto-buffers-changed nil)
  88
  89 (defcustom ibuffer-occur-match-face 'font-lock-warning-face
  90   "Face used for displaying matched strings for `ibuffer-do-occur'."
  91   :type 'face
  92   :group 'ibuffer)
  93
  94 (defcustom ibuffer-saved-filters '(("gnus"
  95                                     ((or (mode . message-mode)
  96                                          (mode . mail-mode)
  97                                          (mode . gnus-group-mode)
  98                                          (mode . gnus-summary-mode)
  99                                          (mode . gnus-article-mode))))
 100                                    ("programming"
 101                                     ((or (mode . emacs-lisp-mode)
 102                                          (mode . cperl-mode)
 103                                          (mode . c-mode)
 104                                          (mode . java-mode)
 105                                          (mode . idl-mode)
 106                                          (mode . lisp-mode)))))
 107
 108   "An alist of filter qualifiers to switch between.
 109
 110 This variable should look like ((\"STRING\" QUALIFIERS)
 111                                 (\"STRING\" QUALIFIERS) ...), where
 112 QUALIFIERS is a list of the same form as
 113 `ibuffer-filtering-qualifiers'.
 114 See also the variables `ibuffer-filtering-qualifiers',
 115 `ibuffer-filtering-alist', and the functions
 116 `ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
 117   :type '(repeat sexp)
 118   :group 'ibuffer)
 119
 120 (defvar ibuffer-filtering-qualifiers nil
 121   "A list like (SYMBOL . QUALIFIER) which filters the current buffer list.
 122 See also `ibuffer-filtering-alist'.")
 123
 124 ;; This is now frobbed by `define-ibuffer-filter'.
 125 (defvar ibuffer-filtering-alist nil
 126   "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
 127
 128 You most likely do not want to modify this variable directly; see
 129 `define-ibuffer-filter'.
 130
 131 SYMBOL is the symbolic name of the filter.  DESCRIPTION is used when
 132 displaying information to the user.  FUNCTION is given a buffer and
 133 the value of the qualifier, and returns non-nil if and only if the
 134 buffer should be displayed.")
 135
 136 (defcustom ibuffer-filter-format-alist nil
 137   "An alist which has special formats used when a filter is active.
 138 The contents of this variable should look like:
 139  ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
 140
 141 For example, suppose that when you add a filter for buffers whose
 142 major mode is `emacs-lisp-mode', you only want to see the mark and the
 143 name of the buffer.  You could accomplish that by adding:
 144  (mode ((mark \" \" name)))
 145 to this variable.")
 146
 147 (defvar ibuffer-cached-filter-formats nil)
 148 (defvar ibuffer-compiled-filter-formats nil)
 149
 150 (defcustom ibuffer-old-time 72
 151   "The number of hours before a buffer is considered \"old\"."
 152   :type '(choice (const :tag "72 hours (3 days)" 72)
 153                  (const :tag "48 hours (2 days)" 48)
 154                  (const :tag "24 hours (1 day)" 24)
 155                  (integer :tag "hours"))
 156   :group 'ibuffer)
 157
 158 (defcustom ibuffer-save-with-custom t
 159   "If non-nil, then use Custom to save interactively changed variables.
 160 Currently, this only applies to `ibuffer-saved-filters'."
 161   :type 'boolean
 162   :group 'ibuffer)
 163
 164 (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
 165   (or
 166    (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
 167    (and (not
 168          (or
 169           (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
 170           (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
 171         (or all
 172             (not
 173              (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
 174         (or ibuffer-view-ibuffer
 175             (and ibuffer-buf
 176                  (not (eq ibuffer-buf buf))))
 177         (or
 178          (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
 179          (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
 180
 181 (defun ibuffer-auto-update-changed ()
 182   (when ibuffer-auto-buffers-changed
 183     (setq ibuffer-auto-buffers-changed nil)
 184     (mapcar #'(lambda (buf)
 185                 (ignore-errors
 186                   (with-current-buffer buf
 187                     (when (and ibuffer-auto-mode
 188                                (eq major-mode 'ibuffer-mode))
 189                       (ibuffer-update nil t)))))
 190             (buffer-list))))
 191
 192 ;;;###autoload
 193 (defun ibuffer-auto-mode (&optional arg)
 194   "Toggle use of Ibuffer's auto-update facility.
 195 With numeric ARG, enable auto-update if and only if ARG is positive."
 196   (interactive)
 197   (unless (eq major-mode 'ibuffer-mode)
 198     (error "This buffer is not in Ibuffer mode"))
 199   (set (make-local-variable 'ibuffer-auto-mode)
 200        (if arg
 201            (plusp arg)
 202          (not ibuffer-auto-mode)))
 203   (defadvice get-buffer-create (after ibuffer-notify-create activate)
 204     (setq ibuffer-auto-buffers-changed t))
 205   (defadvice kill-buffer (after ibuffer-notify-kill activate)
 206     (setq ibuffer-auto-buffers-changed t))
 207   (add-hook 'post-command-hook 'ibuffer-auto-update-changed)
 208   (ibuffer-update-mode-name))
 209
 210 ;;;###autoload
 211 (defun ibuffer-mouse-filter-by-mode (event)
 212   "Enable or disable filtering by the major mode chosen via mouse."
 213   (interactive "e")
 214   (ibuffer-interactive-filter-by-mode event))
 215
 216 ;;;###autoload
 217 (defun ibuffer-interactive-filter-by-mode (event-or-point)
 218   "Enable or disable filtering by the major mode at point."
 219   (interactive "d")
 220   (if (eventp event-or-point)
 221       (mouse-set-point event-or-point)
 222     (goto-char event-or-point))
 223   (let ((buf (ibuffer-current-buffer)))
 224     (if (assq 'mode ibuffer-filtering-qualifiers)
 225         (setq ibuffer-filtering-qualifiers
 226               (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))
 227       (ibuffer-push-filter (cons 'mode
 228                                 (with-current-buffer buf
 229                                   major-mode)))))
 230   (ibuffer-update nil t))
 231
 232 (define-ibuffer-op shell-command-pipe (command)
 233   "Pipe the contents of each marked buffer to shell command COMMAND."
 234   (:interactive "sPipe to shell command: "
 235    :opstring "Shell command executed on"
 236    :modifier-p nil)
 237   (shell-command-on-region
 238    (point-min) (point-max) command
 239    (get-buffer-create "* ibuffer-shell-output*")))
 240
 241 (define-ibuffer-op shell-command-pipe-replace (command)
 242   "Replace the contents of marked buffers with output of pipe to COMMAND."
 243   (:interactive "sPipe to shell command (replace): "
 244    :opstring "Buffer contents replaced in"
 245    :active-opstring "replace buffer contents in"
 246    :dangerous t
 247    :modifier-p t)
 248   (with-current-buffer buf
 249     (shell-command-on-region (point-min) (point-max)
 250                              command nil t)))
 251
 252 (define-ibuffer-op shell-command-file (command)
 253   "Run shell command COMMAND separately on files of marked buffers."
 254   (:interactive "sShell command on buffer's file: "
 255    :opstring "Shell command executed on"
 256    :modifier-p nil)
 257   (shell-command (concat command " "
 258                          (shell-quote-argument
 259                           (if buffer-file-name
 260                               buffer-file-name
 261                             (make-temp-file
 262                              (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
 263
 264 (define-ibuffer-op eval (form)
 265   "Evaluate FORM in each of the buffers.
 266 Does not display the buffer during evaluation. See
 267 `ibuffer-do-view-and-eval' for that."
 268   (:interactive "xEval in buffers (form): "
 269    :opstring "evaluated in"
 270    :modifier-p :maybe)
 271   (eval form))
 272
 273 (define-ibuffer-op view-and-eval (form)
 274   "Evaluate FORM while displaying each of the marked buffers.
 275 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
 276   (:interactive "xEval viewing buffers (form): "
 277    :opstring "evaluated in"
 278    :complex t
 279    :modifier-p :maybe)
 280   (let ((ibuffer-buf (current-buffer)))
 281     (unwind-protect
 282         (progn
 283           (switch-to-buffer buf)
 284           (eval form))
 285       (switch-to-buffer ibuffer-buf))))
 286
 287 (define-ibuffer-op rename-uniquely ()
 288   "Rename marked buffers as with `rename-uniquely'."
 289   (:opstring "renamed"
 290    :modifier-p t)
 291   (rename-uniquely))
 292
 293 (define-ibuffer-op revert ()
 294   "Revert marked buffers as with `revert-buffer'."
 295   (:dangerous t
 296    :opstring "reverted"
 297    :active-opstring "revert"
 298    :modifier-p :maybe)
 299   (revert-buffer t t))
 300
 301 (define-ibuffer-op replace-regexp (from-str to-str)
 302   "Perform a `replace-regexp' in marked buffers."
 303   (:interactive
 304    (let* ((from-str (read-from-minibuffer "Replace regexp: "))
 305           (to-str (read-from-minibuffer (concat "Replace " from-str
 306                                                 " with: "))))
 307      (list from-str to-str))
 308    :opstring "replaced in"
 309    :complex t
 310    :modifier-p :maybe)
 311   (save-window-excursion
 312     (switch-to-buffer buf)
 313     (save-excursion
 314       (goto-char (point-min))
 315       (let ((case-fold-search ibuffer-case-fold-search))
 316         (while (re-search-forward from-str nil t)
 317           (replace-match to-str))))
 318     t))
 319
 320 (define-ibuffer-op query-replace (&rest args)
 321   "Perform a `query-replace' in marked buffers."
 322   (:interactive
 323    (query-replace-read-args "Query replace" t)
 324    :opstring "replaced in"
 325    :complex t
 326    :modifier-p :maybe)
 327   (save-window-excursion
 328     (switch-to-buffer buf)
 329     (save-excursion
 330       (let ((case-fold-search ibuffer-case-fold-search))
 331         (goto-char (point-min))
 332         (apply #'query-replace args)))
 333     t))
 334
 335 (define-ibuffer-op query-replace-regexp (&rest args)
 336   "Perform a `query-replace-regexp' in marked buffers."
 337   (:interactive
 338    (query-replace-read-args "Query replace regexp" t)
 339    :opstring "replaced in"
 340    :complex t
 341    :modifier-p :maybe)
 342   (save-window-excursion
 343     (switch-to-buffer buf)
 344     (save-excursion
 345       (let ((case-fold-search ibuffer-case-fold-search))
 346         (goto-char (point-min))
 347         (apply #'query-replace-regexp args)))
 348     t))
 349
 350 (define-ibuffer-op print ()
 351   "Print marked buffers as with `print-buffer'."
 352   (:opstring "printed"
 353    :modifier-p nil)
 354   (print-buffer))
 355
 356 ;;;###autoload
 357 (defun ibuffer-included-in-filters-p (buf filters)
 358   (not
 359    (memq nil ;; a filter will return nil if it failed
 360          (mapcar
 361           ;; filter should be like (TYPE . QUALIFIER), or
 362           ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...)
 363           #'(lambda (qual)
 364               (ibuffer-included-in-filter-p buf qual))
 365           filters))))
 366
 367 (defun ibuffer-included-in-filter-p (buf filter)
 368   (if (eq (car filter) 'not)
 369       (not (ibuffer-included-in-filter-p-1 buf (cdr filter)))
 370     (ibuffer-included-in-filter-p-1 buf filter)))
 371
 372 (defun ibuffer-included-in-filter-p-1 (buf filter)
 373   (not
 374    (not
 375     (case (car filter)
 376       (or
 377        (memq t (mapcar #'(lambda (x)
 378                            (ibuffer-included-in-filter-p buf x))
 379                        (cdr filter))))
 380       (saved
 381        (let ((data
 382               (assoc (cdr filter)
 383                      ibuffer-saved-filters)))
 384          (unless data
 385            (ibuffer-filter-disable)
 386            (error "Unknown saved filter %s" (cdr filter)))
 387          (ibuffer-included-in-filters-p buf (cadr data))))
 388       (t
 389        (let ((filterdat (assq (car filter)
 390                               ibuffer-filtering-alist)))
 391          ;; filterdat should be like (TYPE DESCRIPTION FUNC)
 392          ;; just a sanity check
 393         (unless filterdat
 394           (ibuffer-filter-disable)
 395           (error "Undefined filter %s" (car filter)))
 396         (not
 397          (not
 398           (funcall (caddr filterdat)
 399                    buf
 400                    (cdr filter))))))))))
 401
 402 ;;;###autoload
 403 (defun ibuffer-filter-disable ()
 404   "Disable all filters currently in effect in this buffer."
 405   (interactive)
 406   (setq ibuffer-filtering-qualifiers nil)
 407   (ibuffer-update nil t))
 408
 409 ;;;###autoload
 410 (defun ibuffer-pop-filter ()
 411   "Remove the top filter in this buffer."
 412   (interactive)
 413   (when (null ibuffer-filtering-qualifiers)
 414     (error "No filters in effect"))
 415   (pop ibuffer-filtering-qualifiers)
 416   (ibuffer-update nil t))
 417
 418 (defun ibuffer-push-filter (qualifier)
 419   "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
 420   (push qualifier ibuffer-filtering-qualifiers))
 421
 422 ;;;###autoload
 423 (defun ibuffer-decompose-filter ()
 424   "Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
 425
 426 This means that the topmost filter on the filtering stack, which must
 427 be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
 428 turned into two separate filters [name: foo] and [mode: bar-mode]."
 429   (interactive)
 430   (when (null ibuffer-filtering-qualifiers)
 431     (error "No filters in effect"))
 432   (let ((lim (pop ibuffer-filtering-qualifiers)))
 433     (case (car lim)
 434       (or
 435        (setq ibuffer-filtering-qualifiers (append
 436                                           (cdr lim)
 437                                           ibuffer-filtering-qualifiers)))
 438       (saved
 439        (let ((data
 440               (assoc (cdr lim)
 441                      ibuffer-saved-filters)))
 442          (unless data
 443            (ibuffer-filter-disable)
 444            (error "Unknown saved filter %s" (cdr lim)))
 445          (setq ibuffer-filtering-qualifiers (append
 446                                             (cadr data)
 447                                             ibuffer-filtering-qualifiers))))
 448       (not
 449        (push (cdr lim)
 450              ibuffer-filtering-qualifiers))
 451       (t
 452        (error "Filter type %s is not compound" (car lim)))))
 453   (ibuffer-update nil t))
 454
 455 ;;;###autoload
 456 (defun ibuffer-exchange-filters ()
 457   "Exchange the top two filters on the stack in this buffer."
 458   (interactive)
 459   (when (< (length ibuffer-filtering-qualifiers)
 460            2)
 461     (error "Need two filters to exchange"))
 462   (let ((first (pop ibuffer-filtering-qualifiers))
 463         (second (pop ibuffer-filtering-qualifiers)))
 464     (push first ibuffer-filtering-qualifiers)
 465     (push second ibuffer-filtering-qualifiers))
 466   (ibuffer-update nil t))
 467
 468 ;;;###autoload
 469 (defun ibuffer-negate-filter ()
 470   "Negate the sense of the top filter in the current buffer."
 471   (interactive)
 472   (when (null ibuffer-filtering-qualifiers)
 473     (error "No filters in effect"))
 474   (let ((lim (pop ibuffer-filtering-qualifiers)))
 475     (push (if (eq (car lim) 'not)
 476               (cdr lim)
 477             (cons 'not lim))
 478           ibuffer-filtering-qualifiers))
 479   (ibuffer-update nil t))
 480
 481 ;;;###autoload
 482 (defun ibuffer-or-filter (&optional reverse)
 483   "Replace the top two filters in this buffer with their logical OR.
 484 If optional argument REVERSE is non-nil, instead break the top OR
 485 filter into parts."
 486   (interactive "P")
 487   (if reverse
 488       (progn
 489         (when (or (null ibuffer-filtering-qualifiers)
 490                   (not (eq 'or (caar ibuffer-filtering-qualifiers))))
 491           (error "Top filter is not an OR"))
 492         (let ((lim (pop ibuffer-filtering-qualifiers)))
 493           (setq ibuffer-filtering-qualifiers (nconc (cdr lim) ibuffer-filtering-qualifiers))))
 494     (when (< (length ibuffer-filtering-qualifiers) 2)
 495       (error "Need two filters to OR"))
 496     ;; If the second filter is an OR, just add to it.
 497     (let ((first (pop ibuffer-filtering-qualifiers))
 498           (second (pop ibuffer-filtering-qualifiers)))
 499       (if (eq 'or (car second))
 500           (push (nconc (list 'or first) (cdr second)) ibuffer-filtering-qualifiers)
 501         (push (list 'or first second)
 502               ibuffer-filtering-qualifiers))))
 503   (ibuffer-update nil t))
 504
 505 (defun ibuffer-maybe-save-saved-filters ()
 506   (when ibuffer-save-with-custom
 507     (if (fboundp 'customize-save-variable)
 508         (progn
 509           (customize-save-variable 'ibuffer-saved-filters
 510                                    ibuffer-saved-filters))
 511       (message "Not saved permanently: Customize not available"))))
 512
 513 ;;;###autoload
 514 (defun ibuffer-save-filters (name filters)
 515   "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
 516 Interactively, prompt for NAME, and use the current filters."
 517   (interactive
 518    (if (null ibuffer-filtering-qualifiers)
 519        (error "No filters currently in effect")
 520      (list
 521       (read-from-minibuffer "Save current filters as: ")
 522       ibuffer-filtering-qualifiers)))
 523   (ibuffer-aif (assoc name ibuffer-saved-filters)
 524       (setcdr it filters)
 525       (push (list name filters) ibuffer-saved-filters))
 526   (ibuffer-maybe-save-saved-filters)
 527   (ibuffer-update-mode-name))
 528
 529 ;;;###autoload
 530 (defun ibuffer-delete-saved-filters (name)
 531   "Delete saved filters with NAME from `ibuffer-saved-filters'."
 532   (interactive
 533    (list
 534     (if (null ibuffer-saved-filters)
 535         (error "No saved filters")
 536       (completing-read "Delete saved filters: "
 537                        ibuffer-saved-filters nil t))))
 538   (setq ibuffer-saved-filters
 539         (ibuffer-delete-alist name ibuffer-saved-filters))
 540   (ibuffer-maybe-save-saved-filters)
 541   (ibuffer-update nil t))
 542
 543 ;;;###autoload
 544 (defun ibuffer-add-saved-filters (name)
 545   "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
 546   (interactive
 547    (list
 548     (if (null ibuffer-saved-filters)
 549         (error "No saved filters")
 550       (completing-read "Add saved filters: "
 551                        ibuffer-saved-filters nil t))))
 552   (push (cons 'saved name) ibuffer-filtering-qualifiers)
 553   (ibuffer-update nil t))
 554
 555 ;;;###autoload
 556 (defun ibuffer-switch-to-saved-filters (name)
 557   "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
 558 If prefix argument ADD is non-nil, then add the saved filters instead
 559 of replacing the current filters."
 560   (interactive
 561    (list
 562     (if (null ibuffer-saved-filters)
 563         (error "No saved filters")
 564       (completing-read "Switch to saved filters: "
 565                        ibuffer-saved-filters nil t))))
 566   (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
 567   (ibuffer-update nil t))
 568
 569 (defun ibuffer-format-qualifier (qualifier)
 570   (if (eq (car-safe qualifier) 'not)
 571       (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")
 572     (ibuffer-format-qualifier-1 qualifier)))
 573
 574 (defun ibuffer-format-qualifier-1 (qualifier)
 575   (case (car qualifier)
 576     (saved
 577      (concat " [filter: " (cdr qualifier) "]"))
 578     (or
 579      (concat " [OR" (mapconcat #'ibuffer-format-qualifier
 580                                (cdr qualifier) "") "]"))
 581     (t
 582      (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
 583        (unless qualifier
 584          (error "Ibuffer: bad qualifier %s" qualifier))
 585        (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
 586
 587 ;;; Extra operation definitions
 588
 589 (define-ibuffer-filter mode
 590   "Toggle current view to buffers with major mode QUALIFIER."
 591   (:description "major mode"
 592    :reader
 593    (intern
 594     (completing-read "Filter by major mode: " obarray
 595                      #'(lambda (e)
 596                          (string-match "-mode$"
 597                                        (symbol-name e)))
 598                      t
 599                      (let ((buf (ibuffer-current-buffer)))
 600                        (if (and buf (buffer-live-p buf))
 601                            (with-current-buffer buf
 602                              (symbol-name major-mode))
 603                          "")))))
 604   (eq qualifier (with-current-buffer buf major-mode)))
 605
 606 (define-ibuffer-filter name
 607   "Toggle current view to buffers with name matching QUALIFIER."
 608   (:description "buffer name"
 609    :reader
 610    (read-from-minibuffer "Filter by name (regexp): "))
 611   (string-match qualifier (buffer-name buf)))
 612
 613 (define-ibuffer-filter filename
 614   "Toggle current view to buffers with filename matching QUALIFIER."
 615   (:description "filename"
 616    :reader
 617    (read-from-minibuffer "Filter by filename (regexp): "))
 618   (ibuffer-awhen (buffer-file-name buf)
 619     (string-match qualifier it)))
 620
 621 (define-ibuffer-filter size-gt
 622   "Toggle current view to buffers with size greater than QUALIFIER."
 623   (:description "size greater than"
 624    :reader
 625    (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
 626   (> (with-current-buffer buf (buffer-size))
 627      qualifier))
 628
 629 (define-ibuffer-filter size-lt
 630    "Toggle current view to buffers with size less than QUALIFIER."
 631   (:description "size less than"
 632    :reader
 633    (string-to-number (read-from-minibuffer "Filter by size less than: ")))
 634   (< (with-current-buffer buf (buffer-size))
 635      qualifier))
 636
 637 (define-ibuffer-filter content
 638    "Toggle current view to buffers whose contents match QUALIFIER."
 639   (:description "content"
 640    :reader
 641    (read-from-minibuffer "Filter by content (regexp): "))
 642   (with-current-buffer buf
 643     (save-excursion
 644       (goto-char (point-min))
 645       (re-search-forward qualifier nil t))))
 646
 647 (define-ibuffer-filter predicate
 648    "Toggle current view to buffers for which QUALIFIER returns non-nil."
 649   (:description "predicate"
 650    :reader
 651    (read-minibuffer "Filter by predicate (form): "))
 652   (with-current-buffer buf
 653     (eval qualifier)))
 654
 655 ;;; Sorting
 656
 657 ;;;###autoload
 658 (defun ibuffer-toggle-sorting-mode ()
 659   "Toggle the current sorting mode.
 660 Default sorting modes are:
 661  Recency - the last time the buffer was viewed
 662  Name - the name of the buffer
 663  Major Mode - the name of the major mode of the buffer
 664  Size - the size of the buffer"
 665   (interactive)
 666   (let ((modes (mapcar 'car ibuffer-sorting-functions-alist)))
 667     (add-to-list 'modes 'recency)
 668     (setq modes (sort modes 'string-lessp))
 669     (let ((next (or (find-if
 670                      (lambda (x) (string-lessp ibuffer-sorting-mode x)) modes)
 671                     (car modes))))
 672       (setq ibuffer-sorting-mode next)
 673       (message "Sorting by %s" next)))
 674   (ibuffer-redisplay t))
 675
 676 ;;;###autoload
 677 (defun ibuffer-invert-sorting ()
 678   "Toggle whether or not sorting is in reverse order."
 679   (interactive)
 680   (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
 681   (message "Sorting order %s"
 682            (if ibuffer-sorting-reversep
 683                "reversed"
 684              "normal"))
 685   (ibuffer-redisplay t))
 686
 687 (define-ibuffer-sorter major-mode
 688   "Sort the buffers by major modes.
 689 Ordering is lexicographic."
 690   (:description "major mode")
 691   (string-lessp (downcase
 692                  (symbol-name (with-current-buffer
 693                                   (car a)
 694                                 major-mode)))
 695                 (downcase
 696                  (symbol-name (with-current-buffer
 697                                   (car b)
 698                                 major-mode)))))
 699
 700 (define-ibuffer-sorter mode-name
 701   "Sort the buffers by their mode name.
 702 Ordering is lexicographic."
 703   (:description "mode name")
 704   (string-lessp (downcase
 705                  (symbol-name (with-current-buffer
 706                                   (car a)
 707                                 mode-name)))
 708                 (downcase
 709                  (symbol-name (with-current-buffer
 710                                   (car b)
 711                                 mode-name)))))
 712
 713 (define-ibuffer-sorter alphabetic
 714   "Sort the buffers by their names.
 715 Ordering is lexicographic."
 716   (:description "buffer name")
 717   (string-lessp
 718    (buffer-name (car a))
 719    (buffer-name (car b))))
 720
 721 (define-ibuffer-sorter size
 722  "Sort the buffers by their size."
 723   (:description "size")
 724   (< (with-current-buffer (car a)
 725        (buffer-size))
 726      (with-current-buffer (car b)
 727        (buffer-size))))
 728
 729 ;;; Functions to emulate bs.el
 730
 731 ;;;###autoload
 732 (defun ibuffer-bs-show ()
 733   "Emulate `bs-show' from the bs.el package."
 734   (interactive)
 735   (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
 736   (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
 737
 738 (defun ibuffer-bs-toggle-all ()
 739   "Emulate `bs-toggle-show-all' from the bs.el package."
 740   (interactive)
 741   (if ibuffer-filtering-qualifiers
 742       (ibuffer-pop-filter)
 743     (progn (ibuffer-push-filter '(filename . ".*"))
 744            (ibuffer-update nil t))))
 745
 746 ;;; Handy functions
 747
 748 ;;;###autoload
 749 (defun ibuffer-add-to-tmp-hide (regexp)
 750   "Add REGEXP to `ibuffer-tmp-hide-regexps'.
 751 This means that buffers whose name matches REGEXP will not be shown
 752 for this ibuffer session."
 753   (interactive
 754    (list
 755     (read-from-minibuffer "Never show buffers matching: "
 756                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
 757   (push regexp ibuffer-tmp-hide-regexps))
 758
 759 ;;;###autoload
 760 (defun ibuffer-add-to-tmp-show (regexp)
 761   "Add REGEXP to `ibuffer-tmp-show-regexps'.
 762 This means that buffers whose name matches REGEXP will always be shown
 763 for this ibuffer session."
 764   (interactive
 765    (list
 766     (read-from-minibuffer "Always show buffers matching: "
 767                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
 768   (push regexp ibuffer-tmp-show-regexps))
 769
 770 ;;;###autoload
 771 (defun ibuffer-forward-next-marked (&optional count mark direction)
 772   "Move forward by COUNT marked buffers (default 1).
 773
 774 If MARK is non-nil, it should be a character denoting the type of mark
 775 to move by.  The default is `ibuffer-marked-char'.
 776
 777 If DIRECTION is non-nil, it should be an integer; negative integers
 778 mean move backwards, non-negative integers mean move forwards."
 779   (interactive "P")
 780   (unless count
 781     (setq count 1))
 782   (unless mark
 783     (setq mark ibuffer-marked-char))
 784   (unless direction
 785     (setq direction 1))
 786   ;; Skip the title
 787   (ibuffer-forward-line 0)
 788   (let ((opos (point))
 789         curmark)
 790     (ibuffer-forward-line direction)
 791     (while (not (or (= (point) opos)
 792                     (eq (setq curmark (ibuffer-current-mark))
 793                         mark)))
 794       (ibuffer-forward-line direction))
 795     (when (and (= (point) opos)
 796                (not (eq (ibuffer-current-mark) mark)))
 797       (error "No buffers with mark %c" mark))))
 798
 799 ;;;###autoload
 800 (defun ibuffer-backwards-next-marked (&optional count mark)
 801    "Move backwards by COUNT marked buffers (default 1).
 802
 803 If MARK is non-nil, it should be a character denoting the type of mark
 804 to move by.  The default is `ibuffer-marked-char'."
 805    (interactive "P")
 806    (ibuffer-forward-next-marked count mark -1))
 807
 808 ;;;###autoload
 809 (defun ibuffer-do-kill-lines ()
 810   "Hide all of the currently marked lines."
 811   (interactive)
 812   (if (= (ibuffer-count-marked-lines) 0)
 813       (message "No buffers marked; use 'm' to mark a buffer")
 814     (let ((count
 815            (ibuffer-map-marked-lines
 816             #'(lambda (buf mark beg end)
 817                 'kill))))
 818       (message "Killed %s lines" count))))
 819
 820 ;;;###autoload
 821 (defun ibuffer-jump-to-buffer (name)
 822   "Move point to the buffer whose name is NAME."
 823   (interactive (list nil))
 824   (let ((table (mapcar #'(lambda (x)
 825                            (cons (buffer-name (car x))
 826                                  (caddr x)))
 827                        (ibuffer-current-state-list t))))
 828     (when (null table)
 829       (error "No buffers!"))
 830     (when (interactive-p)
 831       (setq name (completing-read "Jump to buffer: " table nil t)))
 832     (ibuffer-aif (assoc name table)
 833         (goto-char (cdr it))
 834       (error "No buffer with name %s" name))))
 835
 836 ;;;###autoload
 837 (defun ibuffer-diff-with-file ()
 838   "View the differences between this buffer and its associated file.
 839 This requires the external program \"diff\" to be in your `exec-path'."
 840   (interactive)
 841   (let* ((buf (ibuffer-current-buffer))
 842          (buf-filename (with-current-buffer buf
 843                          buffer-file-name)))
 844     (unless (buffer-live-p buf)
 845       (error "Buffer %s has been killed" buf))
 846     (unless buf-filename
 847       (error "Buffer %s has no associated file" buf))
 848     (let ((diff-buf (get-buffer-create "*Ibuffer-diff*")))
 849       (with-current-buffer diff-buf
 850         (setq buffer-read-only nil)
 851         (erase-buffer))
 852       (let ((tempfile (make-temp-file "ibuffer-diff-")))
 853         (unwind-protect
 854             (progn
 855               (with-current-buffer buf
 856                 (write-region (point-min) (point-max) tempfile nil 'nomessage))
 857               (if (zerop
 858                    (apply #'call-process "diff" nil diff-buf nil
 859                           (append
 860                            (when (and (boundp 'ediff-custom-diff-options)
 861                                       (stringp ediff-custom-diff-options))
 862                              (list ediff-custom-diff-options))
 863                            (list buf-filename tempfile))))
 864                   (message "No differences found")
 865                 (progn
 866                   (with-current-buffer diff-buf
 867                     (goto-char (point-min))
 868                     (if (fboundp 'diff-mode)
 869                         (diff-mode)
 870                       (fundamental-mode)))
 871                   (display-buffer diff-buf))))
 872           (when (file-exists-p tempfile)
 873             (delete-file tempfile)))))
 874       nil))
 875
 876 ;;;###autoload
 877 (defun ibuffer-copy-filename-as-kill (&optional arg)
 878   "Copy filenames of marked buffers into the kill ring.
 879 The names are separated by a space.
 880 If a buffer has no filename, it is ignored.
 881 With a zero prefix arg, use the complete pathname of each marked file.
 882
 883 You can then feed the file name(s) to other commands with C-y.
 884
 885  [ This docstring shamelessly stolen from the
 886  `dired-copy-filename-as-kill' in \"dired-x\". ]"
 887   ;; Add to docstring later:
 888   ;; With C-u, use the relative pathname of each marked file.
 889   (interactive "P")
 890   (if (= (ibuffer-count-marked-lines) 0)
 891       (message "No buffers marked; use 'm' to mark a buffer")
 892     (let ((ibuffer-copy-filename-as-kill-result "")
 893           (type (cond ((eql arg 0)
 894                        'full)
 895                       ;; ((eql arg 4)
 896                       ;;  'relative)
 897                       (t
 898                        'name))))
 899       (ibuffer-map-marked-lines
 900        #'(lambda (buf mark beg end)
 901            (setq ibuffer-copy-filename-as-kill-result
 902                  (concat ibuffer-copy-filename-as-kill-result
 903                          (let ((name (buffer-file-name buf)))
 904                            (if name
 905                                (case type
 906                                  (full
 907                                   name)
 908                                  (t
 909                                   (file-name-nondirectory name)))
 910                              ""))
 911                          " "))))
 912       (push ibuffer-copy-filename-as-kill-result kill-ring))))
 913
 914 (defun ibuffer-mark-on-buffer (func)
 915   (let ((count
 916          (ibuffer-map-lines
 917           #'(lambda (buf mark beg end)
 918               (when (funcall func buf)
 919                 (ibuffer-set-mark-1 ibuffer-marked-char)
 920                 t)))))
 921     (ibuffer-redisplay t)
 922     (message "Marked %s buffers" count)))
 923
 924 ;;;###autoload
 925 (defun ibuffer-mark-by-name-regexp (regexp)
 926   "Mark all buffers whose name matches REGEXP."
 927   (interactive "sMark by name (regexp): ")
 928   (ibuffer-mark-on-buffer
 929    #'(lambda (buf)
 930        (string-match regexp (buffer-name buf)))))
 931
 932 ;;;###autoload
 933 (defun ibuffer-mark-by-mode-regexp (regexp)
 934   "Mark all buffers whose major mode matches REGEXP."
 935   (interactive "sMark by major mode (regexp): ")
 936   (ibuffer-mark-on-buffer
 937    #'(lambda (buf)
 938        (with-current-buffer buf
 939          (string-match regexp mode-name)))))
 940
 941 ;;;###autoload
 942 (defun ibuffer-mark-by-file-name-regexp (regexp)
 943   "Mark all buffers whose file name matches REGEXP."
 944   (interactive "sMark by file name (regexp): ")
 945   (ibuffer-mark-on-buffer
 946    #'(lambda (buf)
 947        (let ((name (or (buffer-file-name buf)
 948                        (with-current-buffer buf
 949                          (and
 950                           (boundp 'dired-directory)
 951                           (stringp dired-directory)
 952                           dired-directory)))))
 953          (when name
 954            (string-match regexp name))))))
 955
 956 ;;;###autoload
 957 (defun ibuffer-mark-by-mode (mode)
 958   "Mark all buffers whose major mode equals MODE."
 959   (interactive
 960    (list (intern (completing-read "Mark by major mode: " obarray
 961                                   #'(lambda (e)
 962                                       ;; kind of a hack...
 963                                       (and (fboundp e)
 964                                            (string-match "-mode$"
 965                                                          (symbol-name e))))
 966                                   t
 967                                   (let ((buf (ibuffer-current-buffer)))
 968                                     (if (and buf (buffer-live-p buf))
 969                                         (with-current-buffer buf
 970                                           (cons (symbol-name major-mode)
 971                                                 0))
 972                                       ""))))))
 973   (ibuffer-mark-on-buffer
 974    #'(lambda (buf)
 975        (with-current-buffer buf
 976          (eq major-mode mode)))))
 977
 978 ;;;###autoload
 979 (defun ibuffer-mark-modified-buffers ()
 980   "Mark all modified buffers."
 981   (interactive)
 982   (ibuffer-mark-on-buffer
 983    #'(lambda (buf) (buffer-modified-p buf))))
 984
 985 ;;;###autoload
 986 (defun ibuffer-mark-unsaved-buffers ()
 987   "Mark all modified buffers that have an associated file."
 988   (interactive)
 989   (ibuffer-mark-on-buffer
 990    #'(lambda (buf) (and (with-current-buffer buf buffer-file-name)
 991                         (buffer-modified-p buf)))))
 992
 993 ;;;###autoload
 994 (defun ibuffer-mark-dissociated-buffers ()
 995   "Mark all buffers whose associated file does not exist."
 996   (interactive)
 997   (ibuffer-mark-on-buffer
 998    #'(lambda (buf)
 999        (with-current-buffer buf
1000          (or
1001           (and buffer-file-name
1002                (not (file-exists-p buffer-file-name)))
1003           (and (eq major-mode 'dired-mode)
1004                (boundp 'dired-directory)
1005                (stringp dired-directory)
1006                (not (file-exists-p (file-name-directory dired-directory)))))))))
1007
1008 ;;;###autoload
1009 (defun ibuffer-mark-help-buffers ()
1010   "Mark buffers like *Help*, *Apropos*, *Info*."
1011   (interactive)
1012   (ibuffer-mark-on-buffer
1013    #'(lambda (buf)
1014        (with-current-buffer buf
1015          (or
1016           (eq major-mode 'apropos-mode)
1017           (eq major-mode 'help-mode)
1018           (eq major-mode 'info-mode))))))
1019
1020 ;;;###autoload
1021 (defun ibuffer-mark-old-buffers ()
1022   "Mark buffers which have not been viewed in `ibuffer-old-time' days."
1023   (interactive)
1024   (ibuffer-mark-on-buffer
1025    #'(lambda (buf)
1026        (with-current-buffer buf
1027          ;; hacked from midnight.el
1028          (when buffer-display-time
1029            (let* ((tm (current-time))
1030                   (now (+ (* (float (ash 1 16)) (car tm))
1031                           (float (cadr tm)) (* 0.0000001 (caddr tm))))
1032                   (then (+ (* (float (ash 1 16))
1033                               (car buffer-display-time))
1034                            (float (cadr buffer-display-time))
1035                            (* 0.0000001 (caddr buffer-display-time)))))
1036              (> (- now then) (* 60 60 ibuffer-old-time))))))))
1037
1038 ;;;###autoload
1039 (defun ibuffer-mark-special-buffers ()
1040   "Mark all buffers whose name begins and ends with '*'."
1041   (interactive)
1042   (ibuffer-mark-on-buffer
1043    #'(lambda (buf) (string-match "^\\*.+\\*$"
1044                                  (buffer-name buf)))))
1045
1046 ;;;###autoload
1047 (defun ibuffer-mark-read-only-buffers ()
1048   "Mark all read-only buffers."
1049   (interactive)
1050   (ibuffer-mark-on-buffer
1051    #'(lambda (buf)
1052        (with-current-buffer buf
1053          buffer-read-only))))
1054
1055 ;;;###autoload
1056 (defun ibuffer-mark-dired-buffers ()
1057   "Mark all `dired' buffers."
1058   (interactive)
1059   (ibuffer-mark-on-buffer
1060    #'(lambda (buf)
1061        (with-current-buffer buf
1062          (eq major-mode 'dired-mode)))))
1063
1064 ;;; An implementation of multi-buffer `occur'
1065
1066 (defvar ibuffer-occur-props nil)
1067
1068 (define-derived-mode ibuffer-occur-mode occur-mode "Ibuffer-Occur"
1069   "A special form of Occur mode for multiple buffers.
1070 Note this major mode is not meant for interactive use!
1071 See also `occur-mode'."
1072   (define-key ibuffer-occur-mode-map (kbd "n") 'forward-line)
1073   (define-key ibuffer-occur-mode-map (kbd "q") 'bury-buffer)
1074   (define-key ibuffer-occur-mode-map (kbd "p") 'previous-line)
1075   (define-key ibuffer-occur-mode-map (kbd "RET") 'ibuffer-occur-display-occurence)
1076   (define-key ibuffer-occur-mode-map (kbd "f") 'ibuffer-occur-goto-occurence)
1077   (define-key ibuffer-occur-mode-map [(mouse-2)] 'ibuffer-occur-mouse-display-occurence)
1078   (set (make-local-variable 'revert-buffer-function)
1079        #'ibuffer-occur-revert-buffer-function)
1080   (set (make-local-variable 'ibuffer-occur-props) nil)
1081   (setq buffer-read-only nil)
1082   (erase-buffer)
1083   (setq buffer-read-only t)
1084   (message (concat
1085             "Use RET "
1086             (if (or (and (< 21 emacs-major-version)
1087                          window-system)
1088                     (featurep 'mouse))
1089                "or mouse-2 ")
1090             "to display an occurence.")))
1091
1092 (defun ibuffer-occur-mouse-display-occurence (e)
1093   "Display occurence on this line in another window."
1094   (interactive "e")
1095   (let* ((occurbuf (save-window-excursion (mouse-select-window e)
1096                                           (selected-window)))
1097          (target (with-current-buffer occurbuf
1098                    (get-text-property (save-excursion
1099                                         (mouse-set-point e)
1100                                         (point))
1101                                       'ibuffer-occur-target))))
1102     (unless target
1103       (error "No occurence on this line"))
1104     (let ((buf (car target))
1105           (line (cdr target)))
1106       (switch-to-buffer occurbuf)
1107       (delete-other-windows)
1108       (pop-to-buffer buf)
1109       (goto-line line))))
1110
1111 (defun ibuffer-occur-goto-occurence ()
1112   "Switch to the buffer which has the occurence on this line."
1113   (interactive)
1114   (ibuffer-occur-display-occurence t))
1115
1116 (defun ibuffer-occur-display-occurence (&optional goto)
1117   "Display occurence on this line in another window."
1118   (interactive "P")
1119   (let ((target (get-text-property (point) 'ibuffer-occur-target)))
1120     (unless target
1121       (error "No occurence on this line"))
1122     (let ((buf (car target))
1123           (line (cdr target)))
1124       (delete-other-windows)
1125       (if goto
1126           (switch-to-buffer buf)
1127         (pop-to-buffer buf))
1128       (goto-line line))))
1129
1130 ;;;###autoload
1131 (defun ibuffer-do-occur (regexp &optional nlines)
1132   "View lines which match REGEXP in all marked buffers.
1133 Optional argument NLINES says how many lines of context to display: it
1134 defaults to one."
1135   (interactive
1136    (list (let* ((default (car regexp-history))
1137                 (input
1138                  (read-from-minibuffer
1139                   (if default
1140                       (format "List lines matching regexp (default `%s'): "
1141                               default)
1142                     "List lines matching regexp: ")
1143                   nil
1144                   nil
1145                   nil
1146                   'regexp-history)))
1147            (if (equal input "")
1148                default
1149              input))
1150          current-prefix-arg))
1151   (if (or (not (integerp nlines))
1152           (< nlines 0))
1153       (setq nlines 1))
1154   (when (zerop (ibuffer-count-marked-lines))
1155     (ibuffer-set-mark ibuffer-marked-char))
1156   (let ((ibuffer-do-occur-bufs nil))
1157     ;; Accumulate a list of marked buffers
1158     (ibuffer-map-marked-lines
1159      #'(lambda (buf mark beg end)
1160          (push buf ibuffer-do-occur-bufs)))
1161     (ibuffer-do-occur-1 regexp ibuffer-do-occur-bufs
1162                         (get-buffer-create "*Ibuffer-occur*")
1163                         nlines)))
1164
1165 (defun ibuffer-do-occur-1 (regexp buffers out-buf nlines)
1166   (let ((count (ibuffer-occur-engine regexp buffers out-buf nlines)))
1167     (if (> count 0)
1168         (progn
1169           (switch-to-buffer out-buf)
1170           (setq buffer-read-only t)
1171           (delete-other-windows)
1172           (goto-char (point-min))
1173           (message "Found %s matches in %s buffers" count (length buffers)))
1174       (message "No matches found"))))
1175
1176
1177 (defun ibuffer-occur-revert-buffer-function (ignore-auto noconfirm)
1178   "Update the *Ibuffer occur* buffer."
1179   (assert (eq major-mode 'ibuffer-occur-mode))
1180   (ibuffer-do-occur-1 (car ibuffer-occur-props)
1181                       (cadr ibuffer-occur-props)
1182                       (current-buffer)
1183                       (caddr ibuffer-occur-props)))
1184
1185 (defun ibuffer-occur-engine (regexp buffers out-buf nlines)
1186   (macrolet ((insert-get-point
1187               (&rest args)
1188               `(progn
1189                  (insert ,@args)
1190                  (point)))
1191              (maybe-put-overlay
1192               (over prop value)
1193               `(when (ibuffer-use-fontification)
1194                  (overlay-put ,over ,prop ,value)))
1195              (maybe-ibuffer-propertize
1196               (obj &rest args)
1197               (let ((objsym (gensym "--maybe-ibuffer-propertize-")))
1198                 `(let ((,objsym ,obj))
1199                    (if (ibuffer-use-fontification)
1200                        (propertize ,objsym ,@args)
1201                      ,objsym)))))
1202     (with-current-buffer out-buf
1203       (ibuffer-occur-mode)
1204       (setq buffer-read-only nil)
1205       (let ((globalcount 0))
1206         ;; Map over all the buffers
1207         (dolist (buf buffers)
1208           (when (buffer-live-p buf)
1209             (let ((c 0) ;; count of matched lines
1210                   (l 1) ;; line count
1211                   (headerpt (with-current-buffer out-buf (point))))
1212               (save-excursion
1213                 (set-buffer buf)
1214                 (save-excursion
1215                   (goto-char (point-min)) ;; begin searching in the buffer
1216                   (while (not (eobp))
1217                     ;; The line we're matching against
1218                     (let ((curline (buffer-substring
1219                                     (line-beginning-position)
1220                                     (line-end-position))))
1221                       (when (string-match regexp curline)
1222                         (incf c) ;; increment match count
1223                         (incf globalcount)
1224                         ;; Depropertize the string, and maybe highlight the matches
1225                         (setq curline
1226                               (progn
1227                                 (ibuffer-depropertize-string curline t)
1228                                 (when (ibuffer-use-fontification)
1229                                   (let ((len (length curline))
1230                                         (start 0))
1231                                     (while (and (< start len)
1232                                                 (string-match regexp curline start))
1233                                       (put-text-property (match-beginning 0)
1234                                                          (match-end 0)
1235                                                          'face ibuffer-occur-match-face
1236                                                          curline)
1237                                       (setq start (match-end 0)))))
1238                                 curline))
1239                         ;; Generate the string to insert for this match
1240                         (let ((data
1241                                (if (= nlines 1)
1242                                    ;; The simple display style
1243                                    (concat (maybe-ibuffer-propertize
1244                                             (format "%-6d:" l)
1245                                             'face 'bold)
1246                                            curline
1247                                            "\n")
1248                                  ;; The complex multi-line display style
1249                                  (let ((prevlines (nreverse
1250                                                    (ibuffer-accumulate-lines (- nlines))))
1251                                        (nextlines (ibuffer-accumulate-lines nlines))
1252                                        ;; The lack of `flet' seriously sucks.
1253                                        (fun #'(lambda (lines)
1254                                                 (mapcar
1255                                                  #'(lambda (line)
1256                                                      (concat "      :" line "\n"))
1257                                                  lines))))
1258                                    (setq prevlines (funcall fun prevlines))
1259                                    (setq nextlines (funcall fun nextlines))
1260                                    ;; Yes, I am trying to win the award for the
1261                                    ;; most consing.
1262                                    (apply #'concat
1263                                           (nconc
1264                                            prevlines
1265                                            (list
1266                                             (concat
1267                                              (maybe-ibuffer-propertize
1268                                               (format "%-6d" l)
1269                                               'face 'bold)
1270                                              ":"
1271                                              curline
1272                                              "\n"))
1273                                            nextlines))))))
1274                           ;; Actually insert the match display data
1275                           (with-current-buffer out-buf
1276                             (let ((beg (point))
1277                                   (end (insert-get-point
1278                                         data)))
1279                               (unless (= nlines 1)
1280                                 (insert "-------\n"))
1281                               (put-text-property
1282                                beg (1- end) 'ibuffer-occur-target (cons buf l))
1283                               (put-text-property
1284                                beg (1- end) 'mouse-face 'highlight))))))
1285                     ;; On to the next line...
1286                     (incf l)
1287                     (forward-line 1))))
1288               (when (not (zerop c)) ;; is the count zero?
1289                 (with-current-buffer out-buf
1290                   (goto-char headerpt)
1291                   (let ((beg (point))
1292                         (end (insert-get-point
1293                               (format "%d lines matching \"%s\" in buffer %s\n"
1294                                       c regexp (buffer-name buf)))))
1295                     (let ((o (make-overlay beg end)))
1296                       (maybe-put-overlay o 'face 'underline)))
1297                   (goto-char (point-max)))))))
1298         (setq ibuffer-occur-props (list regexp buffers nlines))
1299         ;; Return the number of matches
1300         globalcount))))
1301
1302 (provide 'ibuf-ext)
1303
1304 ;;; ibuf-ext.el ends here