lisp/ibuf-ext.el

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