lisp/ibuf-ext.el

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