lisp/ibuf-ext.el

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