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