cgit.sxemacs.org Git - packages/blob - xemacs-packages/ibuffer/ibuffer.el

   1 ;;; ibuffer.el --- operate on buffers like dired
   2
   3 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   4
   5 ;; Author: Colin Walters <walters@verbum.org>
   6 ;; Created: 8 Sep 2000
   7 ;; Keywords: buffer, convenience
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program ; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; ibuffer.el is an advanced replacement for the `buffer-menu' which
  29 ;; is normally distributed with Emacs.  Its interface is intended to
  30 ;; be analogous to that of Dired.
  31
  32 ;;; Code:
  33
  34 (eval-when-compile
  35   (require 'cl)
  36   (require 'easymenu)
  37   (require 'ibuf-macs))
  38
  39 ;;; Compatibility
  40 (eval-and-compile
  41   (if (fboundp 'window-list)
  42       (defun ibuffer-window-list ()
  43         (window-list nil 'nomini))
  44     (defun ibuffer-window-list ()
  45       (let ((ibuffer-window-list-result nil))
  46         (walk-windows #'(lambda (win) (push win ibuffer-window-list-result)) 'nomini)
  47         (nreverse ibuffer-window-list-result))))
  48
  49   (if (fboundp 'make-temp-file)
  50       (defalias 'ibuffer-make-temp-file 'make-temp-file)
  51     (defun ibuffer-make-temp-file (prefix)
  52       "Create a temporary file.  DO NOT USE THIS FUNCTION.
  53 This function does not create files atomically, and is thus insecure."
  54       (let* ((tempdir (file-name-as-directory (temp-directory)))
  55              (name (concat tempdir (make-temp-name prefix))))
  56         (while (file-exists-p name)
  57           (setq name (concat tempdir (make-temp-name prefix))))
  58         (append-to-file (point-min) (point-min) name)
  59         name)))
  60
  61   (if (fboundp 'propertize)
  62       (defalias 'ibuffer-propertize 'propertize)
  63     (defun ibuffer-propertize (string &rest properties)
  64       "Return a copy of STRING with text properties added.
  65 First argument is the string to copy.
  66 Remaining arguments form a sequence of PROPERTY VALUE pairs for text
  67 properties to add to the result."
  68       (let ((str (copy-sequence string)))
  69         (add-text-properties 0 (length str)
  70                              properties
  71                              str)
  72         str)))
  73
  74   ;; Deal with different interfaces to mouse events. Sigh.
  75   (cond ((fboundp 'posn-point)
  76          ;; Emacs
  77          (defun ibuffer-event-position (event)
  78            (posn-point (event-start event))))
  79         ((or (featurep 'xemacs)
  80              (string-match "XEmacs\\|Lucid" (emacs-version)))
  81          (defun ibuffer-event-position (event)
  82            (event-point event)))
  83         (t
  84          (error "Couldn't make a suitable definition of `ibuffer-event-position'")))
  85
  86   ;; Mouse events have different names.
  87   (if (or (featurep 'xemacs)
  88           (string-match "XEmacs\\|Lucid" (emacs-version)))
  89       (progn
  90         (defvar ibuffer-button-1 [button1])
  91         (defvar ibuffer-button-2 [button2]))
  92     (defvar ibuffer-button-1 [mouse-1])
  93     (defvar ibuffer-button-2 [mouse-2]))
  94
  95   (cond ((fboundp 'posn-window)
  96          ;; Emacs
  97          (defun ibuffer-event-window (event)
  98            (posn-window (event-start event))))
  99         ((or (featurep 'xemacs)
 100              (string-match "XEmacs\\|Lucid" (emacs-version)))
 101          (defun ibuffer-event-window (event)
 102            (event-window event)))
 103         (t
 104          (error "Couldn't make a suitable definition of `ibuffer-event-window'")))
 105
 106   (if (fboundp 'point-at-bol)
 107       (defalias 'ibuffer-line-beginning-position 'point-at-bol)
 108     (if (fboundp 'line-beginning-position)
 109         (defalias 'ibuffer-line-beginning-position 'line-beginning-position)
 110       (defun ibuffer-line-beginning-position ()
 111         (save-excursion
 112           (beginning-of-line)
 113           (point)))))
 114
 115   (if (fboundp 'point-at-eol)
 116       (defalias 'ibuffer-line-end-position 'point-at-eol)
 117     (if (fboundp 'line-end-position)
 118         (defalias 'ibuffer-line-end-position 'line-end-position)
 119       (defun ibuffer-line-end-position ()
 120         (save-excursion
 121           (end-of-line)
 122           (point)))))
 123
 124   (if (fboundp 'window-buffer-height)
 125       (defalias 'ibuffer-window-buffer-height 'window-buffer-height)
 126     (defalias 'ibuffer-window-buffer-height 'window-displayed-height))
 127
 128   (if (fboundp 'fit-window-to-buffer)
 129       (defun ibuffer-shrink-to-fit (&optional owin)
 130         (fit-window-to-buffer nil (when owin (/ (frame-height)
 131                                               (length (window-list (selected-frame)))))))
 132     (defun ibuffer-shrink-to-fit (&optional owin)
 133       "Make window the right size to display its contents exactly."
 134       (interactive)
 135       (if owin
 136           (delete-other-windows))
 137       (when (> (length (ibuffer-window-list)) 1)
 138         (let* ((window (selected-window))
 139                (buf (window-buffer window))
 140                (height (window-displayed-height (selected-window)))
 141                (new-height (with-current-buffer buf
 142                              (count-lines (point-min) (point-max))))
 143                (diff (- new-height height)))
 144           (unless (zerop diff)
 145             (enlarge-window diff))
 146           (let ((end (with-current-buffer buf (point-max))))
 147             (while (and (> (length (ibuffer-window-list)) 1)
 148                         (not (pos-visible-in-window-p end)))
 149               (enlarge-window 1)))))))
 150
 151   (if (fboundp 'replace-regexp-in-string)
 152       (defalias 'ibuffer-replace-regexp-in-string 'replace-regexp-in-string)
 153     (defun ibuffer-replace-regexp-in-string (regexp rep string &optional
 154                                         fixedcase literal subexp start)
 155       "Replace all matches for REGEXP with REP in STRING.
 156 Return a new string containing the replacements.
 157
 158 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
 159 arguments with the same names of function `replace-match'.  If START
 160 is non-nil, start replacements at that index in STRING.
 161
 162 REP is either a string used as the NEWTEXT arg of `replace-match' or a
 163 function.  If it is a function it is applied to each match to generate
 164 the replacement passed to `replace-match'; the match-data at this
 165 point are such that match 0 is the function's argument."
 166       (let ((l (length string))
 167             (start (or start 0))
 168             matches str mb me)
 169         (save-match-data
 170           (while (and (< start l) (string-match regexp string start))
 171             (setq mb (match-beginning 0)
 172                   me (match-end 0))
 173             (when (= me mb) (setq me (min l (1+ mb))))
 174             (string-match regexp (setq str (substring string mb me)))
 175             (setq matches
 176                   (cons (replace-match (if (stringp rep)
 177                                            rep
 178                                          (funcall rep (match-string 0 str)))
 179                                        fixedcase literal str subexp)
 180                         (cons (substring string start mb)
 181                               matches)))
 182             (setq start me))
 183           (setq matches (cons (substring string start l) matches))
 184           (apply #'concat (nreverse matches))))))
 185
 186   (if (and (boundp 'header-line-format)
 187            (not (string-match "Lucid\\|XEmacs" emacs-version)))
 188       (defun ibuffer-set-header-line-format (format)
 189         (setq header-line-format format))
 190     (defun ibuffer-set-header-line-format (format)
 191       (save-excursion
 192         (let ((top (goto-char (point-min)))
 193               (inhibit-read-only t))
 194           (when (get-text-property top 'ibuffer-header-line)
 195             (delete-region top (next-single-property-change top 'ibuffer-title)))
 196           (goto-char top)
 197           (when format
 198             (if (> (length format) (- (window-width) 2))
 199                 (setq format (substring format 0 (- (window-width) 2))))
 200             (insert format)
 201             (insert-char ?\  (max 0 (- (window-width) (current-column) 1)))
 202             (put-text-property top (point) 'ibuffer-header-line t)
 203             (unless (eolp)
 204               (insert "\n")))))))
 205   )
 206
 207 ;; XEmacs doesn't have buffer-display-time.  Nor are enter-window-hook or
 208 ;; leave-window-hook implemented yet.
 209 (unless (boundp 'buffer-display-time)
 210   (defvar ibuffer-buffer-display-time nil)
 211   (make-variable-buffer-local 'ibuffer-buffer-display-time)
 212   (defvar ibuffer-tracked-buffers (make-hash-table))
 213
 214   (defun ibuffer-track-buffers (frame)
 215     (dolist (buffer (buffer-list frame))
 216       (let ((tick (buffer-modified-tick buffer)))
 217         (unless (equal tick (gethash buffer ibuffer-tracked-buffers))
 218           (puthash buffer tick ibuffer-tracked-buffers)
 219           (with-current-buffer buffer
 220             (setq ibuffer-buffer-display-time (current-time)))))))
 221
 222   (add-hook 'buffer-list-changed-hook 'ibuffer-track-buffers 'append))
 223
 224
 225 ;;;###autoload
 226 (defgroup ibuffer nil
 227   "An advanced replacement for `buffer-menu'.
 228
 229 Ibuffer allows you to operate on buffers in a manner much like Dired.
 230 Operations include sorting, marking by regular expression, and
 231 the ability to filter the displayed buffers by various criteria."
 232   :group 'convenience)
 233
 234 (defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide)
 235                                    " " (size 7 -1 :right)
 236                                    " " (mode 16 16 :center :elide) " " filename)
 237                              (mark "  " (name 18 18 :left :elide) "  " (major-mode 20 20 :left :elide) "  " filename))
 238   "A list of ways to display buffer lines.
 239
 240 With Ibuffer, you are not limited to displaying just certain
 241 attributes of a buffer such as size, name, and mode in a particular
 242 fashion.  Through this variable, you can completely customize and
 243 control the appearance of an Ibuffer buffer.  See also
 244 `define-ibuffer-column', which allows you to define your own columns
 245 for display.
 246
 247 This variable has the form
 248  ((COLUMN COLUMN ...) (COLUMN COLUMN ...) ...)
 249 Each element in `ibuffer-formats' should be a list containing COLUMN
 250 specifiers.  A COLUMN can be any of the following:
 251
 252   SYMBOL - A symbol naming the column.  Predefined columns are:
 253        mark modified read-only name size mode process filename
 254    When you define your own columns using `define-ibuffer-column', just
 255    use their name like the predefined columns here.  This entry can
 256    also be a function of two arguments, which should return a string.
 257    The first argument is the buffer object, and the second is the mark
 258    on that buffer.
 259  or
 260   \"STRING\" - A literal string to display.
 261  or
 262   (SYMBOL MIN-SIZE MAX-SIZE &optional ALIGN ELIDE) - SYMBOL is a
 263    symbol naming the column, and MIN-SIZE and MAX-SIZE are integers (or
 264    functions of no arguments returning an integer) which constrict the
 265    size of a column.  If MAX-SIZE is -1, there is no upper bound.  The
 266    default values are 0 and -1, respectively.  If MIN-SIZE is negative,
 267    use the end of the string.  The optional element ALIGN describes the
 268    alignment of the column; it can be :left, :center or :right.  The
 269    optional element ELIDE describes whether or not to elide the column
 270    if it is too long; valid values are :elide and nil.  The default is
 271    nil (don't elide).
 272
 273 Some example of valid entries in `ibuffer-formats', with
 274 description (also, feel free to try them out, and experiment with your
 275 own!):
 276
 277  (mark \" \" name)
 278   This format just displays the current mark (if any) and the name of
 279   the buffer, separated by a space.
 280  (mark modified read-only \" \" (name 16 16 :left) \" \" (size 6 -1 :right))
 281   This format displays the current mark (if any), its modification and
 282   read-only status, as well as the name of the buffer and its size.  In
 283   this format, the name is restricted to 16 characters (longer names
 284   will be truncated, and shorter names will be padded with spaces), and
 285   the name is also aligned to the right.  The size of the buffer will
 286   be padded with spaces up to a minimum of six characters, but there is
 287   no upper limit on its size.  The size will also be aligned to the
 288   right.
 289
 290 Thus, if you wanted to use these two formats, add
 291
 292  (setq ibuffer-formats '((mark \" \" name)
 293                          (mark modified read-only
 294                           (name 16 16 :left) (size 6 -1 :right))))
 295
 296 to your ~/.emacs file.
 297
 298 Using \\[ibuffer-switch-format], you can rotate the display between
 299 the specified formats in the list."
 300   :type '(repeat sexp)
 301   :group 'ibuffer)
 302
 303 (defcustom ibuffer-always-compile-formats (featurep 'bytecomp)
 304   "If non-nil, then use the byte-compiler to optimize `ibuffer-formats'.
 305 This will increase the redisplay speed, at the cost of loading the
 306 elisp byte-compiler."
 307   :type 'boolean
 308   :group 'ibuffer)
 309
 310 ;;;###autoload
 311 (defgroup ibuffer-faces nil
 312   "Faces used by Ibuffer package."
 313   :group 'ibuffer
 314   :group 'faces)
 315
 316 (defcustom ibuffer-marked-face 'font-lock-warning-face
 317    "Face used for displaying marked buffers."
 318   :type 'face
 319   :group 'ibuffer-faces)
 320
 321 (defcustom ibuffer-deletion-face 'font-lock-type-face
 322   "Face used for displaying buffers marked for deletion."
 323   :type 'face
 324   :group 'ibuffer-faces)
 325
 326 (defcustom ibuffer-title-face 'font-lock-type-face
 327   "Face used for the title string."
 328   :type 'face
 329   :group 'ibuffer-faces)
 330
 331 (defcustom ibuffer-read-only-buffer-face 'font-lock-keyword-face
 332   "Face used for displaying read-only buffers."
 333   :type 'face
 334   :group 'ibuffer-faces)
 335
 336 (defcustom ibuffer-special-buffer-face 'font-lock-keyword-face
 337   "Face used for displaying \"special\" buffers."
 338   :type 'face
 339   :group 'ibuffer-faces)
 340
 341 (defcustom ibuffer-hidden-buffer-face 'font-lock-keyword-face
 342   "Face used for displaying normally hidden buffers."
 343   :type 'face
 344   :group 'ibuffer-faces)
 345
 346 (defcustom ibuffer-help-buffer-face 'font-lock-keyword-face
 347   "Face used for displaying help buffers \(info, apropos, help\)."
 348   :type 'face
 349   :group 'ibuffer-faces)
 350
 351 (defcustom ibuffer-dired-buffer-face 'font-lock-keyword-face
 352   "Face used for displaying dired buffers."
 353   :type 'face
 354   :group 'ibuffer-faces)
 355
 356 (defcustom ibuffer-occur-match-face 'font-lock-warning-face
 357   "Face used for displaying matched strings for `ibuffer-do-occur'."
 358   :type 'face
 359   :group 'ibuffer-faces)
 360
 361 (defcustom ibuffer-filter-group-name-face 'bold
 362   "Face used for displaying filtering group names."
 363   :type 'face
 364   :group 'ibuffer-faces)
 365
 366 (defcustom ibuffer-header-line-face 'header-line
 367   "Face used for displaying header-line."
 368   :type 'face
 369   :group 'ibuffer-faces)
 370
 371 (unless (boundp 'header-line)
 372   (defface header-line
 373     '((((class color) (background light))
 374        (:foreground "Gray20" :background "Gray90"))
 375       (((class color) (background dark))
 376        (:foreground "Gray90" :background "Gray20"))
 377       (((class grayscale) (background light)) (:background "LightGray" :bold t))
 378       (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
 379       (t (:bold t)))
 380     "Face used for displaying header-line."
 381     :group 'ibuffer-faces)
 382   (defvar header-line 'header-line))
 383
 384 (defcustom ibuffer-use-fontification (if (boundp 'font-lock-auto-fontify)
 385                                          font-lock-auto-fontify
 386                                        (if (boundp 'global-font-lock-mode)
 387                                            global-font-lock-mode
 388                                          nil))
 389   "If non-nil, fontify contents of Ibuffer buffer."
 390   :type 'boolean
 391   :group 'ibuffer)
 392
 393 (defcustom ibuffer-help-buffer-modes '(help-mode apropos-mode hyper-apropos-mode hyper-apropos-help-mode Info-mode Info-edit-mode)
 394   "List of \"Help\" major modes."
 395   :type '(repeat function)
 396   :group 'ibuffer)
 397
 398 (defcustom ibuffer-fontification-alist
 399   `((10 buffer-read-only ,ibuffer-read-only-buffer-face)
 400     (15 (string-match "^*" (buffer-name)) ,ibuffer-special-buffer-face)
 401     (20 (string-match "^ " (buffer-name)) ,ibuffer-hidden-buffer-face)
 402     (25 (memq major-mode ibuffer-help-buffer-modes) ,ibuffer-help-buffer-face)
 403     (30 (eq major-mode 'dired-mode) ,ibuffer-dired-buffer-face))
 404   "An alist describing how to fontify buffers.
 405 Each element should be of the form (PRIORITY FORM FACE), where
 406 PRIORITY is an integer, FORM is an arbitrary form to evaluate in the
 407 buffer, and FACE is the face to use for fontification.  If the FORM
 408 evaluates to non-nil, then FACE will be put on the buffer name.  The
 409 element with the highest PRIORITY takes precedence."
 410   :type '(repeat
 411           (list (integer :tag "Priority")
 412                 (sexp :tag "Test Form")
 413                 face))
 414   :group 'ibuffer)
 415
 416 (defcustom ibuffer-use-other-window nil
 417   "If non-nil, display the Ibuffer in another window by default."
 418   :type 'boolean
 419   :group 'ibuffer)
 420
 421 (defcustom ibuffer-default-shrink-to-minimum-size nil
 422   "If non-nil, minimize the size of the Ibuffer window by default."
 423   :type 'boolean
 424   :group 'ibuffer)
 425 (defvar ibuffer-shrink-to-minimum-size nil)
 426
 427 (defcustom ibuffer-case-fold-search case-fold-search
 428   "If non-nil, ignore case when searching."
 429   :type 'boolean
 430   :group 'ibuffer)
 431
 432 (defcustom ibuffer-default-sorting-mode 'recency
 433   "The criteria by which to sort the buffers.
 434
 435 Note that this variable is local to each ibuffer buffer.  Thus, you
 436 can have multiple ibuffer buffers open, each with a different sorted
 437 view of the buffers."
 438   :type '(choice (const :tag "Last view time" :value recency)
 439                  (const :tag "Lexicographic" :value alphabetic)
 440                  (const :tag "Buffer size" :value size)
 441                  (const :tag "Major mode" :value major-mode)
 442                  (const :tag "Mode name" :value mode-name))
 443   :group 'ibuffer)
 444 (defvar ibuffer-sorting-mode nil)
 445
 446 (defcustom ibuffer-toggle-sorting-modes '(alphabetic major-mode mode-name recency size)
 447   "List of sorters that `ibuffer-toggle-sorting-mode' toggles between."
 448   :type '(choice (repeat :tag "Edit" (symbol :tag "Sorter"))
 449                  (const :tag "Default" :value (alphabetic major-mode mode-name recency size))
 450                  (const :tag "All" :value all))
 451   :group 'ibuffer)
 452
 453 (defcustom ibuffer-default-sorting-reversep nil
 454   "If non-nil, reverse the default sorting order."
 455   :type 'boolean
 456   :group 'ibuffer)
 457 (defvar ibuffer-sorting-reversep nil)
 458
 459 (defcustom ibuffer-elide-long-columns nil
 460   "If non-nil, then elide column entries which exceed their max length.
 461 This variable is deprecated; use the :elide argument of
 462 `ibuffer-formats' to elide just certain columns."
 463   :type 'boolean
 464   :group 'ibuffer)
 465
 466 (defcustom ibuffer-eliding-string "..."
 467   "The string to use for eliding long columns."
 468   :type 'string
 469   :group 'ibuffer)
 470
 471 (defcustom ibuffer-maybe-show-predicates `(,(lambda (buf)
 472                                               (and (string-match "^ " (buffer-name buf))
 473                                                    (null buffer-file-name))))
 474   "A list of predicates (a regexp or function) for buffers to display conditionally.
 475 If a regexp, then it will be matched against the buffer's name.
 476 If a function, it will be called with the buffer as an argument, and
 477 should return non-nil if this buffer should be shown.
 478
 479 Viewing of buffers hidden because of these predicates is enabled by
 480 giving a non-nil prefix argument to `ibuffer-update'.  Note that this
 481 specialized filtering occurs before real filtering."
 482   :type '(repeat (choice regexp function))
 483   :group 'ibuffer)
 484
 485 (defvar ibuffer-current-format nil)
 486
 487 (defcustom ibuffer-modified-char ?*
 488   "The character to display for modified buffers."
 489   :type 'character
 490   :group 'ibuffer)
 491
 492 (defcustom ibuffer-read-only-char ?%
 493   "The character to display for read-only buffers."
 494   :type 'character
 495   :group 'ibuffer)
 496
 497 (defcustom ibuffer-marked-char ?>
 498   "The character to display for marked buffers."
 499   :type 'character
 500   :group 'ibuffer)
 501
 502 (defcustom ibuffer-deletion-char ?D
 503   "The character to display for buffers marked for deletion."
 504   :type 'character
 505   :group 'ibuffer)
 506
 507 (defcustom ibuffer-expert nil
 508   "If non-nil, don't ask for confirmation of \"dangerous\" operations."
 509   :type 'boolean
 510   :group 'ibuffer)
 511
 512 (defcustom ibuffer-view-ibuffer nil
 513   "If non-nil, display the current Ibuffer buffer itself.
 514 Note that this has a drawback - the data about the current Ibuffer
 515 buffer will most likely be inaccurate.  This includes modification
 516 state, size, etc."
 517   :type 'boolean
 518   :group 'ibuffer)
 519
 520 (defcustom ibuffer-always-show-last-buffer nil
 521   "If non-nil, always display the previous buffer.  This variable
 522 takes precedence over filtering, and even `ibuffer-never-show-predicates'."
 523   :type '(choice (const :tag "Always" :value t)
 524                  (const :tag "Never" :value nil)
 525                  (const :tag "Always except minibuffer" :value :nomini))
 526   :group 'ibuffer)
 527
 528 (defcustom ibuffer-use-header-line t
 529   "If non-nil, display a header line containing current filters."
 530   :type 'boolean
 531   :group 'ibuffer)
 532
 533 (defcustom ibuffer-default-directory nil
 534   "The default directory to use for a new ibuffer buffer.
 535 If nil, inherit the directory of the buffer in which `ibuffer' was
 536 called.  Otherwise, this variable should be a string naming a
 537 directory, like `default-directory'."
 538   :type '(choice (const :tag "Inherit" :value nil)
 539                  string)
 540   :group 'ibuffer)
 541
 542 (defcustom ibuffer-hooks nil
 543   "Hooks run when `ibuffer' is called."
 544   :type 'hook
 545   :group 'ibuffer)
 546
 547 (defcustom ibuffer-mode-hooks nil
 548   "Hooks run upon entry into `ibuffer-mode'."
 549   :type 'hook
 550   :group 'ibuffer)
 551
 552 (defcustom ibuffer-directory-abbrev-alist nil
 553   "An alist of file name abbreviations like `directory-abbrev-alist'."
 554   :type '(repeat (cons :format "%v"
 555                        :value ("" . "")
 556                        (regexp :tag "From")
 557                        (regexp :tag "To")))
 558   :group 'ibuffer)
 559
 560 (defcustom ibuffer-truncate-lines t
 561   "If non-nil, do not display continuation lines."
 562   :type 'boolean
 563   :group 'ibuffer)
 564
 565 (defcustom ibuffer-filter-format-alist nil
 566   "An alist which has special formats used when a filter is active.
 567 The contents of this variable should look like:
 568  ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
 569
 570 For example, suppose that when you add a filter for buffers whose
 571 major mode is `emacs-lisp-mode', you only want to see the mark and the
 572 name of the buffer.  You could accomplish that by adding:
 573  (mode ((mark \" \" name)))
 574 to this variable."
 575   :type '(repeat (list :tag "Association" (symbol :tag "Filter")
 576                        (list :tag "Formats" (repeat (sexp :tag "Format")))))
 577   :group 'ibuffer)
 578
 579 (defcustom ibuffer-never-show-predicates nil
 580   "A list of predicates (a regexp or function) for buffers not to display.
 581 If a regexp, then it will be matched against the buffer's name.
 582 If a function, it will be called with the buffer as an argument, and
 583 should return non-nil if this buffer should not be shown."
 584   :type '(repeat (choice regexp function))
 585   :group 'ibuffer)
 586
 587 (defcustom ibuffer-always-show-predicates nil
 588   "A list of predicates (a regexp or function) for buffers to always display.
 589 If a regexp, then it will be matched against the buffer's name.
 590 If a function, it will be called with the buffer as an argument, and
 591 should return non-nil if this buffer should be shown.
 592 Note that buffers matching one of these predicates will be shown
 593 regardless of any active filters in this buffer."
 594   :type '(repeat (choice regexp function))
 595   :group 'ibuffer)
 596
 597 (defcustom ibuffer-saved-filters '(("gnus"
 598                                     ((or (mode . message-mode)
 599                                          (mode . mail-mode)
 600                                          (mode . gnus-group-mode)
 601                                          (mode . gnus-summary-mode)
 602                                          (mode . gnus-article-mode))))
 603                                    ("programming"
 604                                     ((or (mode . emacs-lisp-mode)
 605                                          (mode . cperl-mode)
 606                                          (mode . c-mode)
 607                                          (mode . java-mode)
 608                                          (mode . idl-mode)
 609                                          (mode . lisp-mode)))))
 610
 611   "An alist of filter qualifiers to switch between.
 612
 613 This variable should look like ((\"STRING\" QUALIFIERS)
 614                                 (\"STRING\" QUALIFIERS) ...), where
 615 QUALIFIERS is a list of the same form as
 616 `ibuffer-filtering-qualifiers'.
 617 See also the variables `ibuffer-filtering-qualifiers',
 618 `ibuffer-filtering-alist', and the functions
 619 `ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
 620   :type '(repeat sexp)
 621   :group 'ibuffer)
 622
 623 (defcustom ibuffer-old-time 72
 624   "The number of hours before a buffer is considered \"old\"."
 625   :type '(choice (const :tag "72 hours (3 days)" 72)
 626                  (const :tag "48 hours (2 days)" 48)
 627                  (const :tag "24 hours (1 day)" 24)
 628                  (integer :tag "hours"))
 629   :group 'ibuffer)
 630
 631 (defcustom ibuffer-save-with-custom t
 632   "If non-nil, then use Custom to save interactively changed variables.
 633 Currently, this only applies to `ibuffer-saved-filters'."
 634   :type 'boolean
 635   :group 'ibuffer)
 636
 637 ;; mode-map
 638
 639 (defvar ibuffer-mode-map nil)
 640 (unless ibuffer-mode-map
 641   (let ((map (make-sparse-keymap)))
 642     (define-key map (kbd "0") 'digit-argument)
 643     (define-key map (kbd "1") 'digit-argument)
 644     (define-key map (kbd "2") 'digit-argument)
 645     (define-key map (kbd "3") 'digit-argument)
 646     (define-key map (kbd "4") 'digit-argument)
 647     (define-key map (kbd "5") 'digit-argument)
 648     (define-key map (kbd "6") 'digit-argument)
 649     (define-key map (kbd "7") 'digit-argument)
 650     (define-key map (kbd "8") 'digit-argument)
 651     (define-key map (kbd "9") 'digit-argument)
 652
 653     (define-key map (kbd "m") 'ibuffer-mark-forward)
 654     (define-key map (kbd "t") 'ibuffer-toggle-marks)
 655     (define-key map (kbd "u") 'ibuffer-unmark-forward)
 656     (define-key map (kbd "=") 'ibuffer-diff-with-file)
 657     (define-key map (kbd "j") 'ibuffer-jump-to-buffer)
 658     (define-key map (kbd "DEL") 'ibuffer-unmark-backward)
 659     (define-key map (kbd "M-DEL") 'ibuffer-unmark-all)
 660     (define-key map (kbd "* *") 'ibuffer-unmark-all)
 661     (define-key map (kbd "* M") 'ibuffer-mark-by-mode)
 662     (define-key map (kbd "* m") 'ibuffer-mark-modified-buffers)
 663     (define-key map (kbd "* u") 'ibuffer-mark-unsaved-buffers)
 664     (define-key map (kbd "* s") 'ibuffer-mark-special-buffers)
 665     (define-key map (kbd "* r") 'ibuffer-mark-read-only-buffers)
 666     (define-key map (kbd "* /") 'ibuffer-mark-dired-buffers)
 667     (define-key map (kbd "* e") 'ibuffer-mark-dissociated-buffers)
 668     (define-key map (kbd "* h") 'ibuffer-mark-help-buffers)
 669     (define-key map (kbd ".") 'ibuffer-mark-old-buffers)
 670
 671     (define-key map (kbd "d") 'ibuffer-mark-for-delete)
 672     (define-key map (kbd "C-d") 'ibuffer-mark-for-delete-backwards)
 673     (define-key map (kbd "k") 'ibuffer-mark-for-delete)
 674     (define-key map (kbd "x") 'ibuffer-do-kill-on-deletion-marks)
 675
 676     ;; immediate operations
 677     (define-key map (kbd "n") 'ibuffer-forward-line)
 678     (define-key map (kbd "<down>") 'ibuffer-forward-line)
 679     (define-key map (kbd "SPC") 'forward-line)
 680     (define-key map (kbd "p") 'ibuffer-backward-line)
 681     (define-key map (kbd "<up>") 'ibuffer-backward-line)
 682     (define-key map (kbd "M-}") 'ibuffer-forward-next-marked)
 683     (define-key map (kbd "M-{") 'ibuffer-backwards-next-marked)
 684     (define-key map (kbd "l") 'ibuffer-redisplay)
 685     (define-key map (kbd "g") 'ibuffer-update)
 686     (define-key map "`" 'ibuffer-switch-format)
 687     (define-key map "-" 'ibuffer-add-to-tmp-hide)
 688     (define-key map "+" 'ibuffer-add-to-tmp-show)
 689     (define-key map "b" 'ibuffer-bury-buffer)
 690     (define-key map (kbd ",") 'ibuffer-toggle-sorting-mode)
 691     (define-key map (kbd "s i") 'ibuffer-invert-sorting)
 692     (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic)
 693     (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency)
 694     (define-key map (kbd "s s") 'ibuffer-do-sort-by-size)
 695     (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
 696     (define-key map (kbd "s M") 'ibuffer-do-sort-by-mode-name)
 697
 698     (define-key map (kbd "/ m") 'ibuffer-filter-by-mode)
 699     (define-key map (kbd "/ n") 'ibuffer-filter-by-name)
 700     (define-key map (kbd "/ c") 'ibuffer-filter-by-content)
 701     (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate)
 702     (define-key map (kbd "/ f") 'ibuffer-filter-by-filename)
 703     (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt)
 704     (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt)
 705     (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters)
 706     (define-key map (kbd "/ a") 'ibuffer-add-saved-filters)
 707     (define-key map (kbd "/ x") 'ibuffer-delete-saved-filters)
 708     (define-key map (kbd "/ d") 'ibuffer-decompose-filter)
 709     (define-key map (kbd "/ s") 'ibuffer-save-filters)
 710     (define-key map (kbd "/ p") 'ibuffer-pop-filter)
 711     (define-key map (kbd "/ !") 'ibuffer-negate-filter)
 712     (define-key map (kbd "/ t") 'ibuffer-exchange-filters)
 713     (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters)
 714     (define-key map (kbd "/ o") 'ibuffer-or-filter)
 715     (define-key map (kbd "/ /") 'ibuffer-filter-disable)
 716
 717     (define-key map (kbd "/ g") 'ibuffer-filters-to-filter-group)
 718     (define-key map (kbd "/ P") 'ibuffer-pop-filter-group)
 719     (define-key map (kbd "M-n") 'ibuffer-forward-filter-group)
 720     (define-key map (kbd "<right>") 'ibuffer-forward-filter-group)
 721     (define-key map (kbd "M-p") 'ibuffer-backward-filter-group)
 722     (define-key map (kbd "<left>") 'ibuffer-backward-filter-group)
 723     (define-key map (kbd "M-j") 'ibuffer-jump-to-filter-group)
 724     (define-key map (kbd "/ S") 'ibuffer-save-filter-groups)
 725     (define-key map (kbd "/ R") 'ibuffer-switch-to-saved-filter-groups)
 726     (define-key map (kbd "/ X") 'ibuffer-delete-saved-filter-groups)
 727     (define-key map (kbd "/ \\") 'ibuffer-clear-filter-groups)
 728
 729     (define-key map (kbd "C-k") 'ibuffer-kill-line)
 730     (define-key map (kbd "C-y") 'ibuffer-yank)
 731
 732     (define-key map (kbd "q") 'ibuffer-quit)
 733     (define-key map (kbd "h") 'describe-mode)
 734     (define-key map (kbd "?") 'describe-mode)
 735
 736     (define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp)
 737     (define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp)
 738     (define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp)
 739
 740     (define-key map (kbd "C-t") 'ibuffer-visit-tags-table)
 741
 742     (define-key map (kbd "|") 'ibuffer-do-shell-command-pipe)
 743     (define-key map (kbd "!") 'ibuffer-do-shell-command-file)
 744     (define-key map (kbd "~") 'ibuffer-do-toggle-modified)
 745
 746     ;; marked operations
 747     (define-key map (kbd "v") 'ibuffer-do-view)
 748     (define-key map (kbd "A") 'ibuffer-do-view)
 749     (define-key map (kbd "D") 'ibuffer-do-delete)
 750     (define-key map (kbd "E") 'ibuffer-do-eval)
 751     (define-key map (kbd "F") 'ibuffer-do-shell-command-file)
 752     (define-key map (kbd "I") 'ibuffer-do-query-replace-regexp)
 753     (define-key map (kbd "H") 'ibuffer-do-view-other-frame)
 754     (define-key map (kbd "N") 'ibuffer-do-shell-command-pipe-replace)
 755     (define-key map (kbd "M") 'ibuffer-do-toggle-modified)
 756     (define-key map (kbd "O") 'ibuffer-do-occur)
 757     (define-key map (kbd "P") 'ibuffer-do-print)
 758     (define-key map (kbd "Q") 'ibuffer-do-query-replace)
 759     (define-key map (kbd "R") 'ibuffer-do-rename-uniquely)
 760     (define-key map (kbd "S") 'ibuffer-do-save)
 761     (define-key map (kbd "T") 'ibuffer-do-toggle-read-only)
 762     (define-key map (kbd "U") 'ibuffer-do-replace-regexp)
 763     (define-key map (kbd "V") 'ibuffer-do-revert)
 764     (define-key map (kbd "W") 'ibuffer-do-view-and-eval)
 765     (define-key map (kbd "X") 'ibuffer-do-shell-command-pipe)
 766
 767     (define-key map (kbd "k") 'ibuffer-do-kill-lines)
 768     (define-key map (kbd "w") 'ibuffer-copy-filename-as-kill)
 769
 770     (define-key map (kbd "RET") 'ibuffer-visit-buffer)
 771     (define-key map (kbd "e") 'ibuffer-visit-buffer)
 772     (define-key map (kbd "f") 'ibuffer-visit-buffer)
 773     (define-key map (kbd "C-x C-f") 'ibuffer-find-file)
 774     (define-key map (kbd "o") 'ibuffer-visit-buffer-other-window)
 775     (define-key map (kbd "C-o") 'ibuffer-visit-buffer-other-window-noselect)
 776     (define-key map (kbd "M-o") 'ibuffer-visit-buffer-1-window)
 777     (define-key map (kbd "C-x v") 'ibuffer-do-view-horizontally)
 778     (define-key map (kbd "C-c C-a") 'ibuffer-auto-mode)
 779     (define-key map (kbd "C-x 4 RET") 'ibuffer-visit-buffer-other-window)
 780     (define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame)
 781
 782     (setq ibuffer-mode-map map))
 783   )
 784
 785 (defvar ibuffer-name-map nil)
 786 (unless ibuffer-name-map
 787   (let ((map (make-sparse-keymap)))
 788     (set-keymap-parent map ibuffer-mode-map)
 789     (define-key map ibuffer-button-1 'ibuffer-mouse-toggle-mark)
 790     (define-key map ibuffer-button-2 'ibuffer-mouse-visit-buffer)
 791     (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
 792     (setq ibuffer-name-map map)))
 793
 794 (defvar ibuffer-mode-name-map nil)
 795 (unless ibuffer-mode-name-map
 796   (let ((map (make-sparse-keymap)))
 797     (set-keymap-parent map ibuffer-mode-map)
 798     (define-key map ibuffer-button-2 'ibuffer-mouse-filter-by-mode)
 799     (define-key map (kbd "RET") 'ibuffer-interactive-filter-by-mode)
 800     (setq ibuffer-mode-name-map map)))
 801
 802 (defvar ibuffer-mode-filter-group-map nil)
 803 (unless ibuffer-mode-filter-group-map
 804   (let ((map (make-sparse-keymap)))
 805     (set-keymap-parent map ibuffer-mode-map)
 806     (define-key map ibuffer-button-1 'ibuffer-mouse-toggle-mark)
 807     (define-key map ibuffer-button-2 'ibuffer-mouse-toggle-filter-group)
 808     (define-key map [down-mouse-3] 'ibuffer-filter-group-popup-menu)
 809     (define-key map (kbd "RET") 'ibuffer-toggle-filter-group)
 810     (setq ibuffer-mode-filter-group-map map)))
 811
 812 ;; quiet the byte-compiler
 813 (defvar ibuffer-mode-operate-menu nil)
 814 (defvar ibuffer-mode-mark-menu nil)
 815 (defvar ibuffer-mode-immediate-menu nil)
 816
 817 (defvar ibuffer-mode-hooks nil)
 818
 819 (defvar ibuffer-delete-window-on-quit nil
 820   "Whether or not to delete the window upon exiting `ibuffer'.")
 821
 822 (defvar ibuffer-did-modification nil)
 823
 824 (defvar ibuffer-sorting-functions-alist nil
 825   "An alist of functions which describe how to sort buffers.
 826
 827 Note: You most likely do not want to modify this variable directly;
 828 use `define-ibuffer-sorter' instead.
 829
 830 The alist elements are constructed like (NAME DESCRIPTION FUNCTION)
 831 Where NAME is a symbol describing the sorting method, DESCRIPTION is a
 832 short string which will be displayed in the minibuffer and menu, and
 833 FUNCTION is a function of two arguments, which will be the buffers to
 834 compare.")
 835
 836 ;;; Menu definitions
 837
 838 (defvar ibuffer-sort-menu-data
 839   '("Sort"
 840     ["Toggle sorting mode" ibuffer-toggle-sorting-mode t]
 841     ["Reverse sorting order" ibuffer-invert-sorting t]
 842     "----"
 843     ["Sort by view time" ibuffer-do-sort-by-recency t]
 844     ["Sort lexicographically" ibuffer-do-sort-by-alphabetic t]
 845     ["Sort by buffer size" ibuffer-do-sort-by-size t]
 846     ["Sort by major mode" ibuffer-do-sort-by-major-mode t]
 847     ["Sort by mode name" ibuffer-do-sort-by-mode-name t]))
 848
 849 (unless ibuffer-mode-mark-menu
 850   (easy-menu-define
 851     ibuffer-mode-mark-menu ibuffer-mode-map ""
 852     '("Mark"
 853       ["Toggle marks" ibuffer-toggle-marks t]
 854       ["Mark" ibuffer-mark-forward t]
 855       ["Unmark" ibuffer-unmark-forward t]
 856       "----"
 857       ["Mark by mode..." ibuffer-mark-by-mode t]
 858       ["Mark modified buffers" ibuffer-mark-modified-buffers t]
 859       ["Mark unsaved buffers" ibuffer-mark-unsaved-buffers t]
 860       ["Mark read-only buffers" ibuffer-mark-read-only-buffers t]
 861       ["Mark special buffers" ibuffer-mark-special-buffers t]
 862       ["Mark dired buffers" ibuffer-mark-dired-buffers t]
 863       ["Mark dissociated buffers" ibuffer-mark-dissociated-buffers t]
 864       ["Mark help buffers" ibuffer-mark-help-buffers t]
 865       ["Mark old buffers" ibuffer-mark-old-buffers t]
 866       "----"
 867       ["Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp t]
 868       ["Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp t]
 869       ["Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp t]
 870       "----"
 871       ["Unmark All" ibuffer-unmark-all t])))
 872
 873 (defvar ibuffer-filter-menu-data
 874   '("Filter"
 875     ["Disable all filtering" ibuffer-filter-disable t]
 876     "----"
 877     ["Add filter by major mode..." ibuffer-filter-by-mode t]
 878     ["Add filter by buffer name..." ibuffer-filter-by-name t]
 879     ["Add filter by filename..." ibuffer-filter-by-filename t]
 880     ["Add filter by size less than..." ibuffer-filter-by-size-lt t]
 881     ["Add filter by size greater than..." ibuffer-filter-by-size-gt t]
 882     ["Add filter by content (regexp)..." ibuffer-filter-by-content t]
 883     ["Add filter by Lisp predicate..." ibuffer-filter-by-predicate t]
 884     "----"
 885     ["Remove top filter" ibuffer-pop-filter t]
 886     ["OR top two filters" ibuffer-or-filter t]
 887     ["Negate top filter" ibuffer-negate-filter t]
 888     ["Decompose top filter" ibuffer-decompose-filter t]
 889     ["Swap top two filters" ibuffer-exchange-filters t]
 890     "----"
 891     ["Save current filters permanently..." ibuffer-save-filters t]
 892     ["Restore permanently saved filters..." ibuffer-switch-to-saved-filters t]
 893     ["Add to permanently saved filters..." ibuffer-add-saved-filters t]
 894     ["Delete permanently saved filters..." ibuffer-delete-saved-filters t]))
 895
 896 (defvar ibuffer-filter-group-menu-data
 897   '("Filter Groups"
 898     ["Create filter group from current filters..." ibuffer-filters-to-filter-group t]
 899     "----"
 900     ["Move point to the next filter group" ibuffer-forward-filter-group t]
 901     ["Move point to the previous filter group" ibuffer-backward-filter-group t]
 902     ["Move point to a specific filter group..." ibuffer-jump-to-filter-group t]
 903     "----"
 904     ["Remove top filter group" ibuffer-pop-filter-group t]
 905     ["Remove all filter groups" ibuffer-clear-filter-groups t]
 906     ["Save current filter groups permanently..." ibuffer-save-filter-groups t]
 907     ["Restore permanently saved filters..." ibuffer-switch-to-saved-filter-groups t]
 908     ["Delete permanently saved filter groups..." ibuffer-delete-saved-filter-groups t]
 909     "----"
 910     ["Set current filter groups to filter by mode" ibuffer-set-filter-groups-by-mode t]))
 911
 912 (unless ibuffer-mode-immediate-menu
 913   (easy-menu-define
 914     ibuffer-mode-immediate-menu ibuffer-mode-map ""
 915     `("Immediate"
 916       ["View this buffer" ibuffer-visit-buffer t]
 917       ["View (other window)" ibuffer-visit-buffer-other-window t]
 918       ["View (other frame)" ibuffer-visit-buffer-other-frame t]
 919       "----"
 920       ,ibuffer-sort-menu-data
 921       ,ibuffer-filter-menu-data
 922       ,ibuffer-filter-group-menu-data
 923       "----"
 924       ["Diff with file" ibuffer-diff-with-file t]
 925       ["Redisplay" ibuffer-redisplay t]
 926       ["Update" ibuffer-update t]
 927       ["Switch display format" ibuffer-switch-format t]
 928       "----"
 929       ["Customize Ibuffer" ibuffer-customize t])))
 930
 931 (defvar ibuffer-operate-menu-data
 932   '("Operate"
 933     ["View" ibuffer-do-view t]
 934     ["View (separate frame)" ibuffer-do-view-other-frame t]
 935     ["Save" ibuffer-do-save t]
 936     "----"
 937     ["Replace (regexp)..." ibuffer-do-replace-regexp t]
 938     ["Query Replace..." ibuffer-do-query-replace t]
 939     ["Query Replace (regexp)..." ibuffer-do-query-replace-regexp t]
 940     "----"
 941     ["Print" ibuffer-do-print t]
 942     ["Revert" ibuffer-do-revert t]
 943     ["Rename Uniquely" ibuffer-do-rename-uniquely t]
 944     ["Kill" ibuffer-do-delete t]
 945     ["List lines matching..." ibuffer-do-occur t]
 946     "----"
 947     ["Shell Command..." ibuffer-do-shell-command-pipe t]
 948     ["Shell Command (replace)..." ibuffer-do-shell-command-pipe-replace t]
 949     ["Eval..." ibuffer-do-eval t]
 950     ["Eval (viewing buffer)..." ibuffer-do-view-and-eval t]))
 951
 952 (unless ibuffer-mode-operate-menu
 953   (easy-menu-define
 954    ibuffer-mode-operate-menu ibuffer-mode-map ""
 955    ibuffer-operate-menu-data))
 956
 957 (defvar ibuffer-popup-menu ibuffer-operate-menu-data)
 958
 959 ;;; Utility functions
 960 (defun ibuffer-columnize-and-insert-list (list &optional pad-width)
 961   "Insert LIST into the current buffer in as many columns as possible.
 962 The maximum number of columns is determined by the current window
 963 width and the longest string in LIST."
 964   (unless pad-width
 965     (setq pad-width 3))
 966   (let ((width (window-width))
 967         (max (+ (apply #'max (mapcar #'length list))
 968                 pad-width)))
 969     (let ((columns (/ width max)))
 970       (when (zerop columns)
 971         (setq columns 1))
 972       (while list
 973         (dotimes (i (1- columns))
 974           (insert (concat (car list) (make-string (- max (length (car list)))
 975                                                   ? )))
 976           (setq list (cdr list)))
 977         (when (not (null list))
 978           (insert (pop list)))
 979         (insert "\n")))))
 980
 981 (defun ibuffer-accumulate-lines (count)
 982   (save-excursion
 983     (let ((forwardp (> count 0))
 984           (result nil))
 985       (while (not (or (zerop count)
 986                       (if forwardp
 987                           (eobp)
 988                         (bobp))))
 989         (if forwardp
 990             (decf count)
 991           (incf count))
 992         (push
 993          (buffer-substring
 994           (ibuffer-line-beginning-position)
 995           (ibuffer-line-end-position))
 996          result)
 997         (forward-line (if forwardp 1 -1)))
 998       (nreverse result))))
 999
1000 (defsubst ibuffer-current-mark ()
1001   (cadr (get-text-property (ibuffer-line-beginning-position)
1002                            'ibuffer-properties)))
1003
1004 (defun ibuffer-mouse-toggle-mark (event)
1005   "Toggle the marked status of the buffer chosen with the mouse."
1006   (interactive "e")
1007   (unwind-protect
1008       (progn
1009         (mouse-set-point event)
1010         (let ((fgn (get-text-property (point) 'ibuffer-filter-group-name)))
1011           (if fgn
1012               (ibuffer-toggle-marks fgn)
1013             (let ((mark (ibuffer-current-mark)))
1014               (setq buffer-read-only nil)
1015               (if (eq mark ibuffer-marked-char)
1016                   (ibuffer-set-mark ? )
1017                 (ibuffer-set-mark ibuffer-marked-char)))))
1018         (setq buffer-read-only t))))
1019
1020 (defun ibuffer-find-file (file &optional wildcards)
1021   "Like `find-file', but default to the directory of the buffer at point."
1022   (interactive
1023    (let ((default-directory (let ((buf (ibuffer-current-buffer)))
1024                               (if (buffer-live-p buf)
1025                                   (with-current-buffer buf
1026                                     default-directory)
1027                                 default-directory))))
1028      (list (read-file-name "Find file: " default-directory)
1029            current-prefix-arg)))
1030   (find-file file wildcards))
1031
1032 (defun ibuffer-mouse-visit-buffer (event)
1033   "Visit the buffer chosen with the mouse."
1034   (interactive "e")
1035   (switch-to-buffer
1036    (save-excursion
1037      (mouse-set-point event)
1038      (ibuffer-current-buffer t))))
1039
1040 (defun ibuffer-mouse-popup-menu (event)
1041   "Display a menu of operations."
1042   (interactive "e")
1043   (let ((origline (count-lines (point-min) (point))))
1044     (let ((pnt (ibuffer-event-position event)))
1045       (unwind-protect
1046           (progn
1047             (setq buffer-read-only nil)
1048             (ibuffer-save-marks
1049               ;; hm.  we could probably do this in a better fashion
1050               (goto-char pnt)
1051               (ibuffer-unmark-all ?\r)
1052               (setq buffer-read-only nil)
1053               (ibuffer-set-mark ibuffer-marked-char)
1054               (setq buffer-read-only nil)
1055               (save-excursion
1056               (if (featurep 'xemacs)
1057                   (popup-menu-and-execute-in-window
1058                    ibuffer-popup-menu
1059                    (selected-window))
1060                 (popup-menu ibuffer-popup-menu)))))
1061         (progn
1062           (setq buffer-read-only t)
1063           (goto-line (1+ origline)))))))
1064
1065 (defun ibuffer-filter-group-popup-menu (event)
1066   "Display a menu of Filter Group commands."
1067   (interactive "e")
1068   (mouse-set-point event)
1069   (popup-menu `(,(car ibuffer-filter-group-menu-data)
1070                 ["Kill" ibuffer-kill-line t] ["Yank" ibuffer-yank t]
1071                 "----"
1072                 ,@(cdr ibuffer-filter-group-menu-data))))
1073
1074 (defun ibuffer-skip-properties (props direction)
1075   (while (and (not (eobp))
1076               (let ((hit nil))
1077                 (dolist (prop props hit)
1078                   (when (get-text-property (point) prop)
1079                     (setq hit t)))))
1080     (forward-line direction)
1081     (beginning-of-line)))
1082
1083 ;;;###autoload
1084 (defun ibuffer-customize ()
1085   "Begin customizing Ibuffer interactively."
1086   (interactive)
1087   (customize-group 'ibuffer))
1088
1089 (defun ibuffer-backward-line (&optional arg skip-group-names)
1090   "Move backwards ARG lines, wrapping around the list if necessary."
1091   (interactive "P")
1092   (unless arg
1093     (setq arg 1))
1094   (beginning-of-line)
1095   (while (> arg 0)
1096     (forward-line -1)
1097     (when (or (get-text-property (point) 'ibuffer-title)
1098               (and skip-group-names
1099                    (get-text-property (point) 'ibuffer-filter-group-name)))
1100       (goto-char (point-max))
1101       (beginning-of-line))
1102     (ibuffer-skip-properties (append '(ibuffer-summary)
1103                                      (when skip-group-names
1104                                        '(ibuffer-filter-group-name)))
1105                              -1)
1106     ;; Handle the special case of no buffers.
1107     (when (get-text-property (point) 'ibuffer-title)
1108       (forward-line 1)
1109       (setq arg 1))
1110     (decf arg)))
1111
1112 (defun ibuffer-forward-line (&optional arg skip-group-names)
1113   "Move forward ARG lines, wrapping around the list if necessary."
1114   (interactive "P")
1115   (unless arg
1116     (setq arg 1))
1117   (beginning-of-line)
1118   (when (or (eobp)
1119             (get-text-property (point) 'ibuffer-summary))
1120     (goto-char (point-min)))
1121   (when (or (get-text-property (point) 'ibuffer-title)
1122             (and skip-group-names
1123                  (get-text-property (point) 'ibuffer-filter-group-name)))
1124     (when (> arg 0)
1125       (decf arg))
1126     (ibuffer-skip-properties (append '(ibuffer-title)
1127                                      (when skip-group-names
1128                                        '(ibuffer-filter-group-name)))
1129                              1))
1130   (if (< arg 0)
1131       (ibuffer-backward-line (- arg))
1132     (while (> arg 0)
1133       (forward-line 1)
1134       (when (or (eobp)
1135                 (get-text-property (point) 'ibuffer-summary))
1136         (goto-char (point-min)))
1137       (decf arg)
1138       (ibuffer-skip-properties (append '(ibuffer-title)
1139                                        (when skip-group-names
1140                                          '(ibuffer-filter-group-name)))
1141                                1))))
1142
1143 (defun ibuffer-visit-buffer (&optional single)
1144   "Visit the buffer on this line.
1145 If optional argument SINGLE is non-nil, then also ensure there is only
1146 one window."
1147   (interactive "P")
1148   (let ((buf (ibuffer-current-buffer t)))
1149     (bury-buffer (current-buffer))
1150     (switch-to-buffer buf)
1151     (when single
1152       (delete-other-windows))))
1153
1154 (defun ibuffer-visit-buffer-other-window (&optional noselect)
1155   "Visit the buffer on this line in another window."
1156   (interactive)
1157   (let ((buf (ibuffer-current-buffer t)))
1158     (bury-buffer (current-buffer))
1159     (if noselect
1160         (let ((curwin (selected-window)))
1161           (pop-to-buffer buf)
1162           (select-window curwin))
1163       (switch-to-buffer-other-window buf))))
1164
1165 (defun ibuffer-visit-buffer-other-window-noselect ()
1166   "Visit the buffer on this line in another window, but don't select it."
1167   (interactive)
1168   (ibuffer-visit-buffer-other-window t))
1169
1170 (defun ibuffer-visit-buffer-other-frame ()
1171   "Visit the buffer on this line in another frame."
1172   (interactive)
1173   (let ((buf (ibuffer-current-buffer t)))
1174     (bury-buffer (current-buffer))
1175     (switch-to-buffer-other-frame buf)))
1176
1177 (defun ibuffer-visit-buffer-1-window ()
1178   "Visit the buffer on this line, and delete other windows."
1179   (interactive)
1180   (ibuffer-visit-buffer t))
1181
1182 (defun ibuffer-bury-buffer ()
1183   "Bury the buffer on this line."
1184   (interactive)
1185   (let ((buf (ibuffer-current-buffer t))
1186         (line (+ 1 (count-lines 1 (point)))))
1187     (bury-buffer buf)
1188     (ibuffer-update nil t)
1189     (goto-line line)))
1190
1191 (defun ibuffer-visit-tags-table ()
1192   "Visit the tags table in the buffer on this line.  See `visit-tags-table'."
1193   (interactive)
1194   (let ((file (buffer-file-name (ibuffer-current-buffer t))))
1195     (if file
1196         (visit-tags-table file)
1197       (error "Specified buffer has no file"))))
1198
1199 (defun ibuffer-do-view (&optional other-frame)
1200   "View marked buffers, or the buffer on the current line.
1201 If optional argument OTHER-FRAME is non-nil, then display each
1202 marked buffer in a new frame.  Otherwise, display each buffer as
1203 a new window in the current frame, splitting vertically."
1204   (interactive)
1205   (ibuffer-do-view-1 (if other-frame 'other-frame 'vertically)))
1206
1207 (defun ibuffer-do-view-horizontally (&optional other-frame)
1208   "As `ibuffer-do-view', but split windows horizontally."
1209   (interactive)
1210   (ibuffer-do-view-1 (if other-frame 'other-frame 'horizontally)))
1211
1212 (defun ibuffer-do-view-1 (type)
1213   (let ((marked-bufs (ibuffer-get-marked-buffers)))
1214     (when (null marked-bufs)
1215       (setq marked-bufs (list (ibuffer-current-buffer t))))
1216     (unless (and (eq type 'other-frame)
1217                  (not ibuffer-expert)
1218                  (> (length marked-bufs) 3)
1219                  (not (y-or-n-p (format "Really create a new frame for %s buffers? "
1220                                         (length marked-bufs)))))
1221      (set-buffer-modified-p nil)
1222       (delete-other-windows)
1223       (switch-to-buffer (pop marked-bufs))
1224       (let ((height (/ (1- (if (eq type 'horizontally) (frame-width)
1225                                (frame-height)))
1226                        (1+ (length marked-bufs)))))
1227         (mapcar (if (eq type 'other-frame)
1228                     #'(lambda (buf)
1229                         (let ((curframe (selected-frame)))
1230                           (select-frame (new-frame))
1231                           (switch-to-buffer buf)
1232                           (select-frame curframe)))
1233                   #'(lambda (buf)
1234                       (split-window nil height (eq type 'horizontally))
1235                       (other-window 1)
1236                       (switch-to-buffer buf)))
1237                 marked-bufs)))))
1238
1239 (defun ibuffer-do-view-other-frame ()
1240   "View each of the marked buffers in a separate frame."
1241   (interactive)
1242   (ibuffer-do-view t))
1243
1244 (defsubst ibuffer-map-marked-lines (func)
1245   (prog1 (ibuffer-map-on-mark ibuffer-marked-char func)
1246     (ibuffer-redisplay t)))
1247
1248 (defun ibuffer-confirm-operation-on (operation names)
1249   "Display a buffer asking whether to perform OPERATION on NAMES."
1250   (or ibuffer-expert
1251       (if (= (length names) 1)
1252           (y-or-n-p (format "Really %s buffer %s? " operation (car names)))
1253         (let ((buf (get-buffer-create "*Ibuffer confirmation*")))
1254           (with-current-buffer buf
1255             (setq buffer-read-only nil)
1256             (erase-buffer)
1257             (ibuffer-columnize-and-insert-list names)
1258             (goto-char (point-min))
1259             (setq buffer-read-only t))
1260           (let ((lastwin (car (last (ibuffer-window-list)))))
1261             ;; Now attempt to display the buffer...
1262             (save-window-excursion
1263               (select-window lastwin)
1264               ;; The window might be too small to split; in that case,
1265              ;; try a few times to increase its size before giving up.
1266               (let ((attempts 0)
1267                     (trying t))
1268                 (while trying
1269                   (condition-case err
1270                       (progn
1271                         (split-window)
1272                         (setq trying nil))
1273                     (error
1274                      ;; Handle a failure
1275                      (if (or (> (incf attempts) 4)
1276                              (and (stringp (cadr err))
1277                ;; This definitely falls in the ghetto hack category...
1278                                   (not (string-match "too small" (cadr err)))))
1279                          (apply #'signal err)
1280                        (enlarge-window 3))))))
1281            ;; This part doesn't work correctly sometimes under XEmacs.
1282               (select-window (next-window))
1283               (switch-to-buffer buf)
1284               (unwind-protect
1285                   (progn
1286                     (ibuffer-shrink-to-fit)
1287                     (y-or-n-p (format "Really %s %d buffers? "
1288                                       operation (length names))))
1289                 (kill-buffer buf))))))))
1290
1291 (defsubst ibuffer-map-lines-nomodify (function)
1292   "As `ibuffer-map-lines', but don't set the modification flag."
1293   (ibuffer-map-lines function t))
1294
1295 (defun ibuffer-buffer-names-with-mark (mark)
1296   (let ((ibuffer-buffer-names-with-mark-result nil))
1297     (ibuffer-map-lines-nomodify
1298      #'(lambda (buf mk)
1299          (when (char-equal mark mk)
1300            (push (buffer-name buf)
1301                  ibuffer-buffer-names-with-mark-result))))
1302     ibuffer-buffer-names-with-mark-result))
1303
1304 (defsubst ibuffer-marked-buffer-names ()
1305   (ibuffer-buffer-names-with-mark ibuffer-marked-char))
1306
1307 (defsubst ibuffer-deletion-marked-buffer-names ()
1308   (ibuffer-buffer-names-with-mark ibuffer-deletion-char))
1309
1310 (defun ibuffer-count-marked-lines (&optional all)
1311   (if all
1312       (ibuffer-map-lines-nomodify
1313        #'(lambda (buf mark)
1314            (not (char-equal mark ? ))))
1315     (ibuffer-map-lines-nomodify
1316      #'(lambda (buf mark)
1317          (char-equal mark ibuffer-marked-char)))))
1318
1319 (defsubst ibuffer-count-deletion-lines ()
1320   (ibuffer-map-lines-nomodify
1321    #'(lambda (buf mark)
1322        (char-equal mark ibuffer-deletion-char))))
1323
1324 (defsubst ibuffer-map-deletion-lines (func)
1325   (ibuffer-map-on-mark ibuffer-deletion-char func))
1326
1327 (define-ibuffer-op save ()
1328   "Save marked buffers as with `save-buffer'."
1329   (:complex t
1330    :opstring "saved"
1331    :modifier-p :maybe)
1332   (when (buffer-modified-p buf)
1333     (if (not (with-current-buffer buf
1334                buffer-file-name))
1335         ;; handle the case where we're prompted
1336         ;; for a file name
1337         (save-window-excursion
1338           (switch-to-buffer buf)
1339           (save-buffer))
1340       (with-current-buffer buf
1341         (save-buffer))))
1342   t)
1343
1344 (define-ibuffer-op toggle-modified ()
1345   "Toggle modification flag of marked buffers."
1346   (:opstring "(un)marked as modified"
1347    :modifier-p t)
1348   (set-buffer-modified-p (not (buffer-modified-p))))
1349
1350 (define-ibuffer-op toggle-read-only ()
1351   "Toggle read only status in marked buffers."
1352   (:opstring "toggled read only status in"
1353    :modifier-p t)
1354   (toggle-read-only))
1355
1356 (define-ibuffer-op delete ()
1357   "Kill marked buffers as with `kill-this-buffer'."
1358   (:opstring "killed"
1359    :active-opstring "kill"
1360    :dangerous t
1361    :complex t
1362    :modifier-p t)
1363   (if (kill-buffer buf)
1364       'kill
1365     nil))
1366
1367 (define-ibuffer-op kill-on-deletion-marks ()
1368   "Kill buffers marked for deletion as with `kill-this-buffer'."
1369   (:opstring "killed"
1370    :active-opstring "kill"
1371    :dangerous t
1372    :complex t
1373    :mark :deletion
1374    :modifier-p t)
1375   (if (kill-buffer buf)
1376       'kill
1377     nil))
1378
1379 (defun ibuffer-unmark-all (mark)
1380   "Unmark all buffers with mark MARK."
1381   (interactive "cRemove marks (RET means all):")
1382   (if (= (ibuffer-count-marked-lines t) 0)
1383       (message "No buffers marked; use 'm' to mark a buffer")
1384     (cond
1385      ((char-equal mark ibuffer-marked-char)
1386       (ibuffer-map-marked-lines
1387        #'(lambda (buf mark)
1388            (ibuffer-set-mark-1 ? )
1389            t)))
1390      ((char-equal mark ibuffer-deletion-char)
1391       (ibuffer-map-deletion-lines
1392        #'(lambda (buf mark)
1393            (ibuffer-set-mark-1 ? )
1394            t)))
1395      (t
1396       (ibuffer-map-lines
1397        #'(lambda (buf mark)
1398            (when (not (char-equal mark ? ))
1399              (ibuffer-set-mark-1 ? ))
1400            t)))))
1401   (ibuffer-redisplay t))
1402
1403 (defun ibuffer-toggle-marks (&optional group)
1404   "Toggle which buffers are marked.
1405 In other words, unmarked buffers become marked, and marked buffers
1406 become unmarked.
1407 If point is on a group name, then this function operates on that
1408 group."
1409   (interactive)
1410   (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
1411       (setq group it))
1412   (let ((count
1413          (ibuffer-map-lines
1414           #'(lambda (buf mark)
1415               (cond ((eq mark ibuffer-marked-char)
1416                      (ibuffer-set-mark-1 ? )
1417                      nil)
1418                     ((eq mark ? )
1419                      (ibuffer-set-mark-1 ibuffer-marked-char)
1420                      t)
1421                     (t
1422                      nil)))
1423           nil group)))
1424     (message "%s buffers marked" count))
1425   (ibuffer-redisplay t))
1426
1427 (defun ibuffer-mark-forward (arg)
1428   "Mark the buffer or group name on this line, and move forward ARG lines."
1429   (interactive "P")
1430   (ibuffer-mark-interactive arg ibuffer-marked-char 1))
1431
1432 (defun ibuffer-unmark-forward (arg)
1433   "Unmark the buffer or group name on this line, and move forward ARG lines."
1434   (interactive "P")
1435   (ibuffer-mark-interactive arg ?  1))
1436
1437 (defun ibuffer-unmark-backward (arg)
1438   "Unmark the buffer or group name on this line, and move backward ARG lines."
1439   (interactive "P")
1440   (ibuffer-mark-interactive arg ?  -1))
1441
1442 (defun ibuffer-mark-interactive (arg mark movement)
1443   (assert (eq major-mode 'ibuffer-mode))
1444   (unless arg
1445     (setq arg 1))
1446   (ibuffer-forward-line 0)
1447   (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
1448       (progn
1449         (require 'ibuf-ext)
1450         (ibuffer-mark-on-buffer #'identity mark it))
1451     (ibuffer-forward-line 0 t)
1452     (let ((inhibit-read-only t))
1453       (while (> arg 0)
1454         (ibuffer-set-mark mark)
1455         (ibuffer-forward-line movement t)
1456         (setq arg (1- arg))))))
1457
1458 (defun ibuffer-set-mark (mark)
1459   (assert (eq major-mode 'ibuffer-mode))
1460   (let ((inhibit-read-only t))
1461     (ibuffer-set-mark-1 mark)
1462     (setq ibuffer-did-modification t)
1463     (ibuffer-redisplay-current)
1464     (beginning-of-line)))
1465
1466 (defun ibuffer-set-mark-1 (mark)
1467   (let ((beg (ibuffer-line-beginning-position))
1468         (end (ibuffer-line-end-position)))
1469     (put-text-property beg end 'ibuffer-properties
1470                        (list (ibuffer-current-buffer)
1471                              mark))))
1472
1473 (defun ibuffer-mark-for-delete (arg)
1474   "Mark the buffers on ARG lines forward for deletion.
1475 If point is on a group name, this function operates on that group."
1476   (interactive "P")
1477   (ibuffer-mark-interactive arg ibuffer-deletion-char 1))
1478
1479 (defun ibuffer-mark-for-delete-backwards (arg)
1480   "Mark the buffers on ARG lines backward for deletion.
1481 If point is on a group name, this function operates on that group."
1482   (interactive "P")
1483   (ibuffer-mark-interactive arg ibuffer-deletion-char -1))
1484
1485 (defun ibuffer-current-buffer (&optional must-be-live)
1486   (let ((buf (car (get-text-property (ibuffer-line-beginning-position)
1487                                      'ibuffer-properties))))
1488     (when must-be-live
1489       (if (bufferp buf)
1490           (unless (buffer-live-p buf)
1491             (error (substitute-command-keys "Buffer %s has been killed; use `\\[ibuffer-update]' to update") buf))
1492         (error "No buffer on this line")))
1493     buf))
1494
1495 (defun ibuffer-active-formats-name ()
1496   (if (boundp 'ibuffer-filter-format-alist)
1497       (let ((ret nil))
1498         (dolist (filter ibuffer-filtering-qualifiers ret)
1499           (let ((val (assq (car filter) ibuffer-filter-format-alist)))
1500             (when val
1501               (setq ret (car filter)))))
1502         (if ret
1503             ret
1504           :ibuffer-formats))
1505     :ibuffer-formats))
1506
1507 (defun ibuffer-current-formats (uncompiledp)
1508   (let* ((name (ibuffer-active-formats-name)))
1509     (ibuffer-check-formats)
1510     (if (eq name :ibuffer-formats)
1511         (if uncompiledp
1512             ibuffer-formats
1513           ibuffer-compiled-formats)
1514       (cadr (assq name
1515                   (if uncompiledp
1516                       ibuffer-filter-format-alist
1517                     ibuffer-compiled-filter-formats))))))
1518
1519 (defun ibuffer-current-format (&optional uncompiledp)
1520   (or ibuffer-current-format
1521       (setq ibuffer-current-format 0))
1522   (nth ibuffer-current-format (ibuffer-current-formats uncompiledp)))
1523
1524 (defun ibuffer-expand-format-entry (form)
1525   (if (or (consp form)
1526           (symbolp form))
1527     (let ((sym (intern (concat "ibuffer-make-column-"
1528                                (symbol-name (if (consp form)
1529                                                 (car form)
1530                                               form))))))
1531       (unless (or (fboundp sym)
1532                   (assq sym ibuffer-inline-columns))
1533         (error "Unknown column %s in ibuffer-formats" form))
1534       (let (min max align elide)
1535         (if (consp form)
1536             (setq min (or (nth 1 form) 0)
1537                   max (or (nth 2 form) -1)
1538                   align (or (nth 3 form) :left)
1539                   elide (or (nth 4 form) nil))
1540           (setq min 0
1541                 max -1
1542                 align :left
1543                 elide nil))
1544         (list sym min max align elide)))
1545     form))
1546
1547 (defun ibuffer-compile-make-eliding-form (strvar elide from-end-p)
1548   (let ((ellipsis (if ibuffer-use-fontification
1549                       (ibuffer-propertize ibuffer-eliding-string 'face 'bold)
1550                     ibuffer-eliding-string)))
1551     (if (or elide ibuffer-elide-long-columns)
1552         `(if (> strlen 5)
1553              ,(if from-end-p
1554                   `(concat ,ellipsis
1555                            (substring ,strvar
1556                                       (length ibuffer-eliding-string)))
1557                 `(concat
1558                   (substring ,strvar 0 (- strlen ,(length ellipsis)))
1559                   ,ellipsis))
1560            ,strvar)
1561       strvar)))
1562
1563 (defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p)
1564   (if from-end-p
1565       `(substring str
1566                   (- strlen ,maxvar))
1567     `(substring ,strvar 0 ,maxvar)))
1568
1569 (defun ibuffer-compile-make-format-form (strvar widthform alignment)
1570   (let* ((left `(make-string tmp2 ? ))
1571          (right `(make-string (- tmp1 tmp2) ? )))
1572     `(progn
1573        (setq tmp1 ,widthform
1574              tmp2 (/ tmp1 2))
1575        ,(case alignment
1576           (:right `(concat ,left ,right ,strvar))
1577           (:center `(concat ,left ,strvar ,right))
1578           (:left `(concat ,strvar ,left ,right))
1579           (t (error "Invalid alignment %s" alignment))))))
1580
1581 (defun ibuffer-compile-format (format)
1582   (let ((result nil)
1583         ;; We use these variables to keep track of which variables
1584         ;; inside the generated function we need to bind, since
1585         ;; binding variables in Emacs takes time.
1586         str-used tmp1-used tmp2-used global-strlen-used)
1587     (dolist (form format)
1588       (push
1589        ;; Generate a form based on a particular format entry, like
1590        ;; " ", mark, or (mode 16 16 :right).
1591        (if (stringp form)
1592            ;; It's a string; all we need to do is insert it.
1593            `(insert ,form)
1594          (let* ((form (ibuffer-expand-format-entry form))
1595                 (sym (nth 0 form))
1596                 (min (nth 1 form))
1597                 (max (nth 2 form))
1598                 (align (nth 3 form))
1599                 (elide (nth 4 form)))
1600            (let* ((from-end-p (when (minusp min)
1601                                 (setq min (- min))
1602                                 t))
1603                   (letbindings nil)
1604                   (outforms nil)
1605                   minform
1606                   maxform
1607                   min-used max-used strlen-used)
1608              (when (or (not (integerp min)) (>= min 0))
1609                ;; This is a complex case; they want it limited to a
1610                ;; minimum size.
1611                (setq min-used t)
1612                (setq str-used t strlen-used t global-strlen-used t
1613                      tmp1-used t tmp2-used t)
1614                ;; Generate code to limit the string to a minimum size.
1615                (setq minform `(progn
1616                                 (setq str
1617                                       ,(ibuffer-compile-make-format-form
1618                                         'str
1619                                         `(- ,(if (integerp min)
1620                                                  min
1621                                                'min)
1622                                             strlen)
1623                                         align)))))
1624              (when (or (not (integerp max)) (> max 0))
1625                (setq str-used t max-used t)
1626                ;; Generate code to limit the string to a maximum size.
1627                (setq maxform `(progn
1628                                 (setq str
1629                                       ,(ibuffer-compile-make-substring-form
1630                                         'str
1631                                         (if (integerp max)
1632                                             max
1633                                           'max)
1634                                         from-end-p))
1635                                 (setq strlen (length str))
1636                                 (setq str
1637                                       ,(ibuffer-compile-make-eliding-form 'str
1638                                                                           elide
1639                                                                           from-end-p)))))
1640              ;; Now, put these forms together with the rest of the code.
1641              (let ((callform
1642                     ;; Is this an "inline" column?  This means we have
1643                     ;; to get the code from the
1644                     ;; `ibuffer-inline-columns' alist and insert it
1645                     ;; into our generated code.  Otherwise, we just
1646                     ;; generate a call to the column function.
1647                     (ibuffer-aif (assq sym ibuffer-inline-columns)
1648                                  (nth 1 it)
1649                                  `(,sym buffer mark)))
1650                    ;; You're not expected to understand this.  Hell, I
1651                    ;; don't even understand it, and I wrote it five
1652                    ;; minutes ago.
1653                    (insertgenfn (ibuffer-aif (get sym 'ibuffer-column-summarizer)
1654                                   ;; I really, really wish Emacs Lisp had closures.
1655                                   (lambda (arg sym)
1656                                     `(insert
1657                                       (let ((ret ,arg))
1658                                         (put ',sym 'ibuffer-column-summary
1659                                              (cons ret (get ',sym 'ibuffer-column-summary)))
1660                                         ret)))
1661                                   (lambda (arg sym)
1662                                     `(insert ,arg))))
1663                    (mincompform `(< strlen ,(if (integerp min)
1664                                                 min
1665                                               'min)))
1666                    (maxcompform `(> strlen ,(if (integerp max)
1667                                                 max
1668                                               'max))))
1669                  (if (or min-used max-used)
1670                      ;; The complex case, where we have to limit the
1671                      ;; form to a maximum or minimum size.
1672                      (progn
1673                        (when (and min-used (not (integerp min)))
1674                          (push `(min ,min) letbindings))
1675                        (when (and max-used (not (integerp max)))
1676                          (push `(max ,max) letbindings))
1677                        (push
1678                         (if (and min-used max-used)
1679                             `(if ,mincompform
1680                                  ,minform
1681                                (if ,maxcompform
1682                                    ,maxform))
1683                           (if min-used
1684                               `(when ,mincompform
1685                                  ,minform)
1686                             `(when ,maxcompform
1687                                ,maxform)))
1688                         outforms)
1689                        (push (append
1690                               `(setq str ,callform)
1691                               (when strlen-used
1692                                 `(strlen (length str))))
1693                              outforms)
1694                        (setq outforms
1695                              (append outforms (list (funcall insertgenfn 'str sym)))))
1696                    ;; The simple case; just insert the string.
1697                    (push (funcall insertgenfn callform sym) outforms))
1698                  ;; Finally, return a `let' form which binds the
1699                  ;; variables in `letbindings', and contains all the
1700                  ;; code in `outforms'.
1701                  `(let ,letbindings
1702                     ,@outforms)))))
1703        result))
1704     (setq result
1705           ;; We don't want to unconditionally load the byte-compiler.
1706           (funcall (if (or ibuffer-always-compile-formats
1707                            (featurep 'bytecomp))
1708                        #'byte-compile
1709                      #'identity)
1710                    ;; Here, we actually create a lambda form which
1711                    ;; inserts all the generated forms for each entry
1712                    ;; in the format string.
1713                    (nconc (list 'lambda '(buffer mark))
1714                           `((let ,(append (when str-used
1715                                             '(str))
1716                                           (when global-strlen-used
1717                                             '(strlen))
1718                                           (when tmp1-used
1719                                             '(tmp1))
1720                                           (when tmp2-used
1721                                             '(tmp2)))
1722                               ,@(nreverse result))))))))
1723
1724 (defvar ibuffer-compiled-formats nil)
1725 (defvar ibuffer-cached-formats nil)
1726 (defvar ibuffer-cached-eliding-string nil)
1727 (defvar ibuffer-cached-elide-long-columns 0)
1728
1729 (defun ibuffer-recompile-formats ()
1730   "Recompile `ibuffer-formats'."
1731   (interactive)
1732   (setq ibuffer-compiled-formats
1733           (mapcar #'ibuffer-compile-format ibuffer-formats))
1734   (when (boundp 'ibuffer-filter-format-alist)
1735     (setq ibuffer-compiled-filter-formats
1736           (mapcar #'(lambda (entry)
1737                       (cons (car entry)
1738                             (mapcar #'(lambda (formats)
1739                                         (mapcar #'ibuffer-compile-format formats))
1740                                     (cdr entry))))
1741                   ibuffer-filter-format-alist))))
1742
1743 (defun ibuffer-clear-summary-columns (format)
1744   (dolist (form format)
1745     (ibuffer-awhen (and (consp form)
1746                         (get (car form) 'ibuffer-column-summarizer))
1747       (put (car form) 'ibuffer-column-summary nil))))
1748
1749 (defun ibuffer-check-formats ()
1750   (when (null ibuffer-formats)
1751     (error "No formats!"))
1752   (let ((ext-loaded (featurep 'ibuf-ext)))
1753     (when (or (null ibuffer-compiled-formats)
1754               (null ibuffer-cached-formats)
1755               (not (eq ibuffer-cached-formats ibuffer-formats))
1756               (null ibuffer-cached-eliding-string)
1757               (not (equal ibuffer-cached-eliding-string ibuffer-eliding-string))
1758               (eql 0 ibuffer-cached-elide-long-columns)
1759               (not (eql ibuffer-cached-elide-long-columns
1760                         ibuffer-elide-long-columns))
1761               (and ext-loaded
1762                    (not (eq ibuffer-cached-filter-formats
1763                             ibuffer-filter-format-alist))
1764                    (and ibuffer-filter-format-alist
1765                         (null ibuffer-compiled-filter-formats))))
1766       (message "Formats have changed, recompiling...")
1767       (ibuffer-recompile-formats)
1768       (setq ibuffer-cached-formats ibuffer-formats
1769             ibuffer-cached-eliding-string ibuffer-eliding-string
1770             ibuffer-cached-elide-long-columns ibuffer-elide-long-columns)
1771       (when ext-loaded
1772         (setq ibuffer-cached-filter-formats ibuffer-filter-format-alist))
1773       (message "Formats have changed, recompiling...done"))))
1774
1775 (defvar ibuffer-inline-columns nil)
1776
1777 (define-ibuffer-column mark (:name " " :inline t)
1778   (string mark))
1779
1780 (define-ibuffer-column read-only (:name "R" :inline t)
1781   (if buffer-read-only
1782       "%"
1783     " "))
1784
1785 (define-ibuffer-column modified (:name "M" :inline t)
1786   (if (buffer-modified-p)
1787       (string ibuffer-modified-char)
1788     " "))
1789
1790 (define-ibuffer-column name (:inline t
1791                              :props
1792                              ('mouse-face 'highlight
1793                               'keymap ibuffer-name-map
1794                               'ibuffer-name-column t
1795                               'help-echo "button1: mark   button2: select   button3: Operate menu"))
1796   (buffer-name))
1797
1798 (define-ibuffer-column size (:inline t)
1799   (format "%s" (buffer-size)))
1800
1801 (define-ibuffer-column mode (:inline t
1802                              :props
1803                              ('mouse-face 'highlight
1804                               'keymap ibuffer-mode-name-map
1805                               'help-echo "button2: filter by mode-name"))
1806   (format "%s" mode-name))
1807
1808 (define-ibuffer-column major-mode (:name "Major Mode"
1809                                    :inline t
1810                                    :props
1811                                    ('mouse-face 'highlight
1812                                     'keymap ibuffer-mode-name-map
1813                                     'help-echo "button2: filter by major-mode"))
1814   (format "%s" major-mode))
1815
1816 (define-ibuffer-column process ()
1817   (let ((proc (get-buffer-process buffer)))
1818     (if proc
1819         (format "(%s %s)" proc (process-status proc))
1820       "none")))
1821
1822 (define-ibuffer-column filename ()
1823   (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist))
1824     (abbreviate-file-name
1825      (or buffer-file-name
1826          (and (boundp 'dired-directory)
1827               dired-directory)
1828          ""))))
1829
1830 (defun ibuffer-format-column (str width alignment)
1831   (let ((left (make-string (/ width 2) ? ))
1832         (right (make-string (- width (/ width 2)) ? )))
1833     (case alignment
1834       (:right (concat left right str))
1835       (:center (concat left str right))
1836       (t (concat str left right)))))
1837
1838 (defun ibuffer-fontify-region-function (beg end &optional verbose)
1839   (when verbose (message "Fontifying..."))
1840   (let ((inhibit-read-only t))
1841     (save-excursion
1842       (goto-char beg)
1843       (beginning-of-line)
1844       (while (< (point) end)
1845         (if (get-text-property (point) 'ibuffer-title-header)
1846             (put-text-property (point) (ibuffer-line-end-position) 'face ibuffer-title-face)
1847           (if (get-text-property (point) 'ibuffer-filter-group-name)
1848               (put-text-property (point) (ibuffer-line-end-position) 'face
1849                                  ibuffer-filter-group-name-face)
1850             (unless (or (get-text-property (point) 'ibuffer-title)
1851                         (get-text-property (point) 'ibuffer-summary))
1852               (destructuring-bind (buf mark)
1853                   (get-text-property (point) 'ibuffer-properties)
1854                 (let* ((namebeg (next-single-property-change (point) 'ibuffer-name-column
1855                                                              nil (ibuffer-line-end-position)))
1856                        (nameend (next-single-property-change namebeg 'ibuffer-name-column
1857                                                              nil (ibuffer-line-end-position))))
1858                   (put-text-property namebeg
1859                                      nameend
1860                                      'face
1861                                      (cond ((char-equal mark ibuffer-marked-char)
1862                                             ibuffer-marked-face)
1863                                            ((char-equal mark ibuffer-deletion-char)
1864                                             ibuffer-deletion-face)
1865                                            (t
1866                                             (let ((level -1)
1867                                                   result)
1868                                               (dolist (e ibuffer-fontification-alist result)
1869                                                 (when (and (> (car e) level)
1870                                                            (with-current-buffer buf
1871                                                              (eval (cadr e))))
1872                                                   (setq level (car e)
1873                                                         result
1874                                                         (if (featurep 'xemacs)
1875                                                             (face-name (find-face (caddr e)))
1876                                                           (if (symbolp (caddr e))
1877                                                               (if (facep (caddr e))
1878                                                                   (caddr e)
1879                                                                 (symbol-value (caddr e)))))))))))))))))
1880         (forward-line 1))))
1881   ;; fontify header-line
1882   (save-excursion
1883     (goto-char (point-min))
1884     (if (get-text-property (point) 'ibuffer-header-line)
1885         (put-text-property (point) (next-single-property-change (point) 'ibuffer-header-line) 'face ibuffer-header-line-face)))
1886   (when verbose (message "Fontifying...done")))
1887
1888 (defun ibuffer-unfontify-region-function (beg end &optional loudly)
1889   (let ((inhibit-read-only t))
1890     (remove-text-properties beg end '(face nil))))
1891
1892 (defun ibuffer-insert-buffer-line (buffer mark format)
1893   "Insert a line describing BUFFER and MARK using FORMAT."
1894   (assert (eq major-mode 'ibuffer-mode))
1895   (let ((beg (point)))
1896     (funcall format buffer mark)
1897     (put-text-property beg (point) 'ibuffer-properties (list buffer mark))
1898     (insert "\n")))
1899
1900 (defun ibuffer-redisplay-current ()
1901   (assert (eq major-mode 'ibuffer-mode))
1902   (when (eobp)
1903     (forward-line -1))
1904   (beginning-of-line)
1905   (let ((curformat (mapcar #'ibuffer-expand-format-entry
1906                            (ibuffer-current-format t))))
1907     (ibuffer-clear-summary-columns curformat)
1908     (let ((buf (ibuffer-current-buffer)))
1909       (when buf
1910         (let ((mark (ibuffer-current-mark)))
1911           (save-excursion
1912             (ibuffer-insert-buffer-line
1913              buf mark
1914              (ibuffer-current-format))
1915              (delete-region (point) (1+ (ibuffer-line-end-position))))
1916           (when ibuffer-shrink-to-minimum-size
1917             (ibuffer-shrink-to-fit)))))))
1918
1919 (defun ibuffer-map-on-mark (mark func)
1920   (ibuffer-map-lines
1921    #'(lambda (buf mk)
1922        (if (char-equal mark mk)
1923            (funcall func buf mark)
1924          nil))))
1925
1926 (defun ibuffer-map-lines (function &optional nomodify group)
1927   "Call FUNCTION for each buffer.
1928 Don't set the ibuffer modification flag iff NOMODIFY is non-nil.
1929
1930 If optional argument GROUP is non-nil, then only call FUNCTION on
1931 buffers in filtering group GROUP.
1932
1933  FUNCTION is called with four arguments: the buffer object itself, the
1934 current mark symbol, and the beginning and ending line positions."
1935   (assert (eq major-mode 'ibuffer-mode))
1936   (ibuffer-forward-line 0)
1937   (let* ((orig-target-line (1+ (count-lines (save-excursion
1938                                               (goto-char (point-min))
1939                                               (ibuffer-forward-line 0)
1940                                               (point))
1941                                             (point))))
1942          (target-line-offset orig-target-line)
1943          (ibuffer-map-lines-total 0)
1944          (ibuffer-map-lines-count 0))
1945     (unwind-protect
1946         (progn
1947           (setq buffer-read-only nil)
1948           (goto-char (point-min))
1949           (ibuffer-forward-line 0 t)
1950           (while (and (not (eobp))
1951                       (not (get-text-property (point) 'ibuffer-summary))
1952                       (progn
1953                         (ibuffer-forward-line 0 t)
1954                         (and (not (eobp))
1955                              (not (get-text-property (point) 'ibuffer-summary)))))
1956             (let ((result
1957                    (if (buffer-live-p (ibuffer-current-buffer))
1958                        (when (or (null group)
1959                                  (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group)
1960                                      (equal group it)))
1961                          (save-excursion
1962                            (funcall function
1963                                     (ibuffer-current-buffer)
1964                                     (ibuffer-current-mark))))
1965                      ;; Kill the line if the buffer is dead
1966                      'kill)))
1967               ;; A given mapping function should return:
1968               ;; `nil' if it chose not to affect the buffer
1969               ;; `kill' means the remove line from the buffer list
1970               ;; `t' otherwise
1971               (incf ibuffer-map-lines-total)
1972               (cond ((null result)
1973                      (forward-line 1))
1974                     ((eq result 'kill)
1975                      (delete-region (ibuffer-line-beginning-position)
1976                                     (1+ (ibuffer-line-end-position)))
1977                      (incf ibuffer-map-lines-count)
1978                      (when (< ibuffer-map-lines-total
1979                                orig-target-line)
1980                        (decf target-line-offset)))
1981                     (t
1982                      (incf ibuffer-map-lines-count)
1983                      (forward-line 1)))))
1984           ibuffer-map-lines-count)
1985       (progn
1986         (setq buffer-read-only t)
1987         (unless nomodify
1988           (set-buffer-modified-p nil))
1989         (goto-char (point-min))
1990         (ibuffer-forward-line 0)
1991         (ibuffer-forward-line (1- target-line-offset))))))
1992
1993 (defun ibuffer-get-marked-buffers ()
1994   "Return a list of buffer objects currently marked."
1995   (delq nil
1996         (mapcar #'(lambda (e)
1997                     (when (eq (cdr e) ibuffer-marked-char)
1998                       (car e)))
1999                 (ibuffer-current-state-list))))
2000
2001 (defun ibuffer-current-state-list (&optional pos)
2002   "Return a list like (BUF . MARK) of all buffers in an ibuffer.
2003 If POS is non-nil, return a list like (BUF MARK POINT), where POINT is
2004 the value of point at the beginning of the line for that buffer."
2005   (let ((ibuffer-current-state-list-tmp '()))
2006     ;; ah, if only we had closures.  I bet this will mysteriously
2007     ;; break later.  Don't blame me.
2008     (if pos
2009         (ibuffer-map-lines-nomodify
2010          #'(lambda (buf mark)
2011              (when (buffer-live-p buf)
2012                (push (list buf mark (point)) ibuffer-current-state-list-tmp))))
2013       (ibuffer-map-lines-nomodify
2014        #'(lambda (buf mark)
2015            (when (buffer-live-p buf)
2016              (push (cons buf mark) ibuffer-current-state-list-tmp)))))
2017     (nreverse ibuffer-current-state-list-tmp)))
2018
2019 (defsubst ibuffer-canonicalize-state-list (bmarklist)
2020   "Order BMARKLIST in the same way as the current buffer list."
2021   (delq nil
2022         (mapcar #'(lambda (buf) (assq buf bmarklist)) (buffer-list))))
2023
2024 (defun ibuffer-current-buffers-with-marks (&optional curbufs)
2025   "Return a list like (BUF . MARK) of all buffers in the list CURBUFS."
2026   (let ((bufs (ibuffer-current-state-list)))
2027     (unless curbufs
2028       (setq curbufs (buffer-list)))
2029     (mapcar #'(lambda (buf) (let ((e (assq buf bufs)))
2030                               (if e
2031                                   e
2032                                 (cons buf ? ))))
2033             curbufs)))
2034
2035 (defun ibuffer-buf-matches-predicates (buf predicates)
2036   (let ((hit nil)
2037         (name (buffer-name buf)))
2038     (dolist (pred predicates)
2039       (when (if (stringp pred)
2040                 (string-match pred name)
2041               (funcall pred buf))
2042         (setq hit t)))
2043     hit))
2044
2045 (defun ibuffer-filter-buffers (ibuffer-buf last bmarklist all)
2046   (let ((ext-loaded (featurep 'ibuf-ext)))
2047     (delq nil
2048           (mapcar
2049            ;; element should be like (BUFFER . MARK)
2050            #'(lambda (e)
2051                (let* ((buf (car e)))
2052                  (when
2053                      ;; This takes precedence over anything else
2054                      (or (and ibuffer-always-show-last-buffer
2055                               (eq last buf))
2056                          (funcall (if ext-loaded
2057                                       #'ibuffer-ext-visible-p
2058                                     #'ibuffer-visible-p)
2059                                   buf all ibuffer-buf))
2060                    e)))
2061            bmarklist))))
2062
2063 (defun ibuffer-visible-p (buf all &optional ibuffer-buf)
2064   (and (or all
2065            (not
2066             (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
2067        (or ibuffer-view-ibuffer
2068            (and ibuffer-buf
2069                 (not (eq ibuffer-buf buf))))))
2070
2071 ;; This function is a special case; it's not defined by
2072 ;; `ibuffer-define-sorter'.
2073 (defun ibuffer-do-sort-by-recency ()
2074   "Sort the buffers by last view time."
2075   (interactive)
2076   (setq ibuffer-sorting-mode 'recency)
2077   (ibuffer-redisplay t))
2078
2079 (defun ibuffer-update-format ()
2080   (when (null ibuffer-current-format)
2081     (setq ibuffer-current-format 0))
2082   (when (null ibuffer-formats)
2083     (error "Ibuffer error: no formats!")))
2084
2085 (defun ibuffer-switch-format ()
2086   "Switch the current display format."
2087   (interactive)
2088   (assert (eq major-mode 'ibuffer-mode))
2089   (unless (consp ibuffer-formats)
2090     (error "Ibuffer error: No formats!"))
2091   (setq ibuffer-current-format
2092         (if (>= ibuffer-current-format (1- (length (ibuffer-current-formats nil))))
2093             0
2094           (1+ ibuffer-current-format)))
2095   (ibuffer-update-format)
2096   (ibuffer-redisplay t))
2097
2098 (defun ibuffer-update-title (format)
2099   (assert (eq major-mode 'ibuffer-mode))
2100   (let ((inhibit-read-only t))
2101     (if (get-text-property (point-min) 'ibuffer-title)
2102         (delete-region (point-min)
2103                        (next-single-property-change
2104                         (point-min) 'ibuffer-title)))
2105     (goto-char (point-min))
2106     (put-text-property
2107      (point)
2108      (progn
2109        (let ((opos (point)))
2110          ;; Insert the title names.
2111          (dolist (element format)
2112            (insert
2113             (if (stringp element)
2114                 element
2115               (let ((sym (car element))
2116                     (min (cadr element))
2117                     ;; (max (caddr element))
2118                     (align (cadddr element)))
2119                ;; Ignore a negative min when we're inserting the title
2120                 (when (minusp min)
2121                   (setq min (- min)))
2122                 (let* ((name (or (get sym 'ibuffer-column-name)
2123                                  (error "Unknown column %s in ibuffer-formats" sym)))
2124                        (len (length name)))
2125                   (if (< len min)
2126                       (ibuffer-format-column name
2127                                              (- min len)
2128                                              align)
2129                     name))))))
2130          (put-text-property opos (point) 'ibuffer-title-header t)
2131          (insert "\n")
2132          ;; Add the underlines
2133          (let ((str (save-excursion
2134                       (forward-line -1)
2135                       (beginning-of-line)
2136                       (buffer-substring (point) (ibuffer-line-end-position)))))
2137            (apply 'insert (mapcar
2138                            (lambda (c)
2139                              (if (not (or (char-equal c ? )
2140                                           (char-equal c ?\n)))
2141                                  ?-
2142                                ? ))
2143                            str)))
2144          (insert "\n"))
2145        (point))
2146      'ibuffer-title t)))
2147
2148 (defun ibuffer-update-summary (format)
2149   (goto-char (point-max))
2150   (if (get-text-property (1- (point-max)) 'ibuffer-summary)
2151       (delete-region (previous-single-property-change
2152                       (point-max) 'ibuffer-summary)
2153                      (point-max)))
2154   (put-text-property
2155    (point)
2156    (progn
2157      (insert "\n")
2158      (dolist (element format)
2159        (insert
2160         (if (stringp element)
2161             (make-string (length element) ? )
2162           (let ((sym (car element)))
2163             (let ((min (cadr element))
2164                   ;; (max (caddr element))
2165                   (align (cadddr element)))
2166               ;; Ignore a negative min when we're inserting the title
2167               (when (minusp min)
2168                 (setq min (- min)))
2169               (let* ((summary (if (get sym 'ibuffer-column-summarizer)
2170                                   (funcall (get sym 'ibuffer-column-summarizer)
2171                                            (get sym 'ibuffer-column-summary))
2172                                 (make-string (length (get sym 'ibuffer-column-name))
2173                                              ? )))
2174                      (len (length summary)))
2175                 (if (< len min)
2176                     (ibuffer-format-column summary
2177                                            (- min len)
2178                                            align)
2179                   summary)))))))
2180      (point))
2181    'ibuffer-summary t))
2182
2183 (defun ibuffer-update-mode-name ()
2184   (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode
2185                                               ibuffer-sorting-mode
2186                                             "recency")))
2187   (when ibuffer-sorting-reversep
2188     (setq mode-name (concat mode-name " [rev]")))
2189   (when (and (featurep 'ibuf-ext)
2190              ibuffer-auto-mode)
2191     (setq mode-name (concat mode-name " (Auto)")))
2192   (let ((result ""))
2193     (when (featurep 'ibuf-ext)
2194       (dolist (qualifier ibuffer-filtering-qualifiers)
2195         (setq result
2196               (concat result (ibuffer-format-qualifier qualifier))))
2197       (if ibuffer-use-header-line
2198           (ibuffer-set-header-line-format
2199            (when ibuffer-filtering-qualifiers
2200              (ibuffer-replace-regexp-in-string "%" "%%"
2201                                                (concat mode-name result))))
2202         (progn
2203           (setq mode-name (concat mode-name result))
2204           (when (boundp 'header-line-format)
2205             (ibuffer-set-header-line-format nil)))))))
2206
2207 (defun ibuffer-redisplay (&optional silent)
2208   "Redisplay the current list of buffers.
2209
2210 This does not show new buffers; use `ibuffer-update' for that.
2211
2212 If SILENT is non-`nil', do not generate progress messages."
2213   (interactive)
2214   (ibuffer-forward-line 0)
2215   (unless silent
2216     (message "Redisplaying current buffer list..."))
2217   (let ((blist (ibuffer-current-state-list)))
2218     (when (null blist)
2219       (if (and (featurep 'ibuf-ext)
2220                (or ibuffer-filtering-qualifiers ibuffer-hidden-filter-groups))
2221           (message "No buffers! (note: filtering in effect)")
2222         (error "No buffers!")))
2223     (ibuffer-redisplay-engine blist t)
2224     (ibuffer-update-mode-name)
2225     (unless silent
2226       (message "Redisplaying current buffer list...done"))
2227     (ibuffer-forward-line 0)))
2228
2229 (defun ibuffer-update (arg &optional silent)
2230   "Regenerate the list of all buffers.
2231
2232 Display buffers whose name matches one of `ibuffer-maybe-show-predicates'
2233 iff arg ARG is non-nil.
2234
2235 Do not display messages if SILENT is non-nil."
2236   (interactive "P")
2237   (ibuffer-forward-line 0)
2238   (let* ((bufs (buffer-list))
2239          (blist (ibuffer-filter-buffers
2240                 (current-buffer)
2241                 (if (and
2242                      (cadr bufs)
2243                      (eq ibuffer-always-show-last-buffer
2244                          :nomini)
2245                      ;; This is a hack.
2246                      (string-match " \\*Minibuf"
2247                                    (buffer-name (cadr bufs))))
2248                     (caddr bufs)
2249                   (cadr bufs))
2250                 (ibuffer-current-buffers-with-marks bufs)
2251                 arg)))
2252     (when (null blist)
2253       (if (and (featurep 'ibuf-ext)
2254                ibuffer-filtering-qualifiers)
2255           (message "No buffers! (note: filtering in effect)")
2256         (error "No buffers!")))
2257     (unless silent
2258       (message "Updating buffer list..."))
2259     (ibuffer-redisplay-engine blist arg)
2260     (ibuffer-update-mode-name)
2261     (unless silent
2262       (message "Updating buffer list...done")))
2263   (if (eq ibuffer-shrink-to-minimum-size 'onewindow)
2264       (ibuffer-shrink-to-fit t)
2265     (when ibuffer-shrink-to-minimum-size
2266       (ibuffer-shrink-to-fit)))
2267   (ibuffer-forward-line 0))
2268
2269 (defun ibuffer-sort-bufferlist (bmarklist)
2270   (let* ((sortdat (assq ibuffer-sorting-mode
2271                         ibuffer-sorting-functions-alist))
2272          (func (caddr sortdat)))
2273     (let ((result
2274            ;; actually sort the buffers
2275            (if (and sortdat func)
2276                (sort bmarklist func)
2277              bmarklist)))
2278       ;; perhaps reverse the sorted buffer list
2279       (if ibuffer-sorting-reversep
2280           (nreverse result)
2281         result))))
2282
2283 (defun ibuffer-insert-filter-group (name display-name format bmarklist)
2284   (insert (ibuffer-propertize (concat "[ " display-name " ]")
2285                               'ibuffer-filter-group-name name
2286                               'keymap ibuffer-mode-filter-group-map
2287                               'mouse-face 'highlight
2288                               'help-echo "button1: toggle marks   button2: hide/show   button3: Filter Groups menu")
2289           "\n")
2290   (when bmarklist
2291     (put-text-property
2292      (point)
2293      (progn
2294        (dolist (entry bmarklist)
2295          (ibuffer-insert-buffer-line (car entry) (cdr entry) format))
2296        (point))
2297      'ibuffer-filter-group
2298      name)))
2299
2300 (defun ibuffer-redisplay-engine (bmarklist &optional all)
2301   (assert (eq major-mode 'ibuffer-mode))
2302   (let* ((--ibuffer-insert-buffers-and-marks-format
2303           (ibuffer-current-format))
2304          (--ibuffer-expanded-format (mapcar #'ibuffer-expand-format-entry
2305                                             (ibuffer-current-format t)))
2306          (orig (count-lines (point-min) (point)))
2307          ;; Inhibit font-lock caching tricks, since we're modifying the
2308          ;; entire buffer at once
2309          ;; (after-change-functions nil)
2310          (ext-loaded (featurep 'ibuf-ext))
2311          (bgroups (if ext-loaded
2312                       (ibuffer-generate-filter-groups bmarklist)
2313                     (list (cons "Default" bmarklist)))))
2314     (ibuffer-clear-summary-columns --ibuffer-expanded-format)
2315     (unwind-protect
2316         (progn
2317           (setq buffer-read-only nil)
2318           (erase-buffer)
2319           (ibuffer-update-format)
2320           (ibuffer-update-title --ibuffer-expanded-format)
2321           (dolist (group (nreverse bgroups))
2322             (let* ((name (car group))
2323                    (disabled (and ext-loaded
2324                                   (member name ibuffer-hidden-filter-groups)))
2325                    (bmarklist (cdr group)))
2326               (unless (and (null bmarklist)
2327                            ext-loaded
2328                            (null ibuffer-show-empty-filter-groups))
2329                 (ibuffer-insert-filter-group
2330                  name
2331                  (if disabled (concat name " ...") name)
2332                  --ibuffer-insert-buffers-and-marks-format
2333                  (if disabled
2334                      nil
2335                    (ibuffer-sort-bufferlist bmarklist)))))))
2336       (setq buffer-read-only t)
2337       (set-buffer-modified-p ibuffer-did-modification)
2338       (setq ibuffer-did-modification nil)
2339       (goto-line (1+ orig)))))
2340
2341 (defun ibuffer-quit ()
2342   "Quit this `ibuffer' session.
2343 Delete the current window iff `ibuffer-delete-window-on-quit' is non-nil."
2344   (interactive)
2345   (if ibuffer-delete-window-on-quit
2346       (progn
2347         (bury-buffer)
2348         (unless (= (count-windows) 1)
2349           (delete-window)))
2350     (bury-buffer)))
2351
2352 ;;;###autoload
2353 (defun ibuffer-other-window (&optional files-only)
2354   "Like `ibuffer', but displayed in another window by default.
2355 If optional argument FILES-ONLY is non-nil, then add a filter for
2356 buffers which are visiting a file."
2357   (interactive "P")
2358   (ibuffer t nil (when files-only
2359                    '((filename . ".*")))))
2360
2361 ;;;###autoload
2362 (defalias 'ibuffer-list-buffers 'ibuffer-other-window)
2363
2364 ;;;###autoload
2365 (defun ibuffer (&optional other-window-p name qualifiers noselect
2366                           shrink filter-groups)
2367   "Begin using `ibuffer' to edit a list of buffers.
2368 Type 'h' after entering ibuffer for more information.
2369
2370 Optional argument OTHER-WINDOW-P says to use another window.
2371 Optional argument NAME specifies the name of the buffer; it defaults
2372 to \"*Ibuffer*\".
2373 Optional argument QUALIFIERS is an initial set of filtering qualifiers
2374 to use; see `ibuffer-filtering-qualifiers'.
2375 Optional argument NOSELECT means don't select the Ibuffer buffer.
2376 Optional argument SHRINK means shrink the buffer to minimal size.  The
2377 special value `onewindow' means always use another window.
2378 Optional argument FILTER-GROUPS is an initial set of filtering
2379 groups to use; see `ibuffer-filter-groups'."
2380   (interactive "P")
2381
2382   ;; The individual functions are lazy-loaded, via byte-compile-dynamic,
2383   ;; so we may as well load the file unconditionally now.
2384   (require 'ibuf-ext)
2385
2386   (when ibuffer-use-other-window
2387     (setq other-window-p t))
2388   (let* ((buf (get-buffer-create (or name "*Ibuffer*")))
2389          (already-in (eq (current-buffer) buf))
2390          (need-update nil))
2391     (if other-window-p
2392         (funcall (if noselect #'(lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf)
2393       (funcall (if noselect #'display-buffer #'switch-to-buffer) buf))
2394     (with-current-buffer buf
2395       (let ((owin (selected-window)))
2396         (unwind-protect
2397             (progn
2398               ;; We switch to the buffer's window in order to be able
2399               ;; to modify the value of point
2400               (select-window (get-buffer-window buf))
2401               (unless (eq major-mode 'ibuffer-mode)
2402                 (ibuffer-mode)
2403                 (setq need-update t))
2404               (when ibuffer-use-fontification
2405                 (require 'font-lock))
2406               (setq ibuffer-delete-window-on-quit other-window-p)
2407               (when shrink
2408                 (setq ibuffer-shrink-to-minimum-size shrink))
2409               (when qualifiers
2410                 (setq ibuffer-filtering-qualifiers qualifiers))
2411               (when filter-groups
2412                 (require 'ibuf-ext)
2413                 (setq ibuffer-filter-groups filter-groups))
2414               (ibuffer-update nil)
2415               (unwind-protect
2416                   (progn
2417                     (setq buffer-read-only nil)
2418                     (run-hooks 'ibuffer-hooks))
2419                 (setq buffer-read-only t))
2420               ;; Skip the group name by default.
2421               (ibuffer-forward-line 0 t)
2422               (unless ibuffer-expert
2423                 (message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for help")))
2424           (select-window owin))))))
2425
2426 (put 'ibuffer-mode 'mode-class 'special)
2427 (defun ibuffer-mode ()
2428   "A major mode for viewing a list of buffers.
2429 In ibuffer, you can conveniently perform many operations on the
2430 currently open buffers, in addition to filtering your view to a
2431 particular subset of them, and sorting by various criteria.
2432
2433 Operations on marked buffers:
2434
2435   '\\[ibuffer-do-save]' - Save the marked buffers
2436   '\\[ibuffer-do-view]' - View the marked buffers in this frame.
2437   '\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
2438   '\\[ibuffer-do-revert]' - Revert the marked buffers.
2439   '\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers.
2440   '\\[ibuffer-do-delete]' - Kill the marked buffers.
2441   '\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked
2442           buffers.
2443   '\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers.
2444   '\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression.
2445   '\\[ibuffer-do-print]' - Print the marked buffers.
2446   '\\[ibuffer-do-occur]' - List lines in all marked buffers which match
2447           a given regexp (like the function `occur').
2448   '\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked
2449           buffers to a shell command.
2450   '\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked
2451           buffers with the output of a shell command.
2452   '\\[ibuffer-do-shell-command-file]' - Run a shell command with the
2453           buffer's file as an argument.
2454   '\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers.  This
2455           is a very flexible command.  For example, if you want to make all
2456           of the marked buffers read only, try using (toggle-read-only 1) as
2457           the input form.
2458   '\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
2459           is evaluated.
2460   '\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer,
2461           but don't kill the associated buffer.
2462   '\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion.
2463
2464 Marking commands:
2465
2466   '\\[ibuffer-mark-forward]' - Mark the buffer at point.
2467   '\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark
2468           all unmarked buffers.
2469   '\\[ibuffer-unmark-forward]' - Unmark the buffer at point.
2470   '\\[ibuffer-unmark-backward]' - Unmark the buffer at point, and move to the
2471           previous line.
2472   '\\[ibuffer-unmark-all]' - Unmark all marked buffers.
2473   '\\[ibuffer-mark-by-mode]' - Mark buffers by major mode.
2474   '\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers.
2475           This means that the buffer is modified, and has an associated file.
2476   '\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers,
2477           regardless of whether or not they have an associated file.
2478   '\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and
2479           ends with '*'.
2480   '\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have
2481           an associated file, but that file doesn't currently exist.
2482   '\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers.
2483   '\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired' mode.
2484   '\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc.
2485   '\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'.
2486   '\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion.
2487   '\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp.
2488   '\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp.
2489   '\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp.
2490
2491 Filtering commands:
2492
2493   '\\[ibuffer-filter-by-mode]' - Add a filter by major mode.
2494   '\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
2495   '\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
2496   '\\[ibuffer-filter-by-filename]' - Add a filter by filename.
2497   '\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
2498   '\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
2499   '\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate.
2500   '\\[ibuffer-save-filters]' - Save the current filters with a name.
2501   '\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
2502   '\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
2503   '\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
2504   '\\[ibuffer-pop-filter]' - Remove the top filter.
2505   '\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
2506   '\\[ibuffer-decompose-filter]' - Break down the topmost filter.
2507   '\\[ibuffer-filter-disable]' - Remove all filtering currently in effect.
2508
2509 Filter group commands:
2510
2511   '\\[ibuffer-filters-to-filter-group]' - Create filter group from filters.
2512   '\\[ibuffer-pop-filter-group]' - Remove top filter group.
2513   '\\[ibuffer-forward-filter-group]' - Move to the next filter group.
2514   '\\[ibuffer-backward-filter-group]' - Move to the previous filter group.
2515   '\\[ibuffer-clear-filter-groups]' - Remove all active filter groups.
2516   '\\[ibuffer-save-filter-groups]' - Save the current groups with a name.
2517   '\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups.
2518   '\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups.
2519
2520 Sorting commands:
2521
2522   '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes.
2523   '\\[ibuffer-invert-sorting]' - Reverse the current sorting order.
2524   '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically.
2525   '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time.
2526   '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size.
2527   '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode.
2528
2529 Other commands:
2530
2531   '\\[ibuffer-switch-format]' - Change the current display format.
2532   '\\[forward-line]' - Move point to the next line.
2533   '\\[previous-line]' - Move point to the previous line.
2534   '\\[ibuffer-update]' - As above, but add new buffers to the list.
2535   '\\[ibuffer-quit]' - Bury the Ibuffer buffer.
2536   '\\[describe-mode]' - This help.
2537   '\\[ibuffer-diff-with-file]' - View the differences between this buffer
2538           and its associated file.
2539   '\\[ibuffer-visit-buffer]' - View the buffer on this line.
2540   '\\[ibuffer-visit-buffer-other-window]' - As above, but in another window.
2541   '\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select
2542           the new window.
2543   '\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line.
2544
2545 Information on Filtering:
2546
2547  You can filter your ibuffer view via different critera.  Each Ibuffer
2548 buffer has its own stack of active filters.  For example, suppose you
2549 are working on an Emacs Lisp project.  You can create an Ibuffer
2550 buffer displays buffers in just `emacs-lisp' modes via
2551 '\\[ibuffer-filter-by-mode] emacs-lisp-mode RET'.  In this case, there
2552 is just one entry on the filtering stack.
2553
2554 You can also combine filters.  The various filtering commands push a
2555 new filter onto the stack, and the filters combine to show just
2556 buffers which satisfy ALL criteria on the stack.  For example, suppose
2557 you only want to see buffers in `emacs-lisp' mode, whose names begin
2558 with \"gnus\".  You can accomplish this via:
2559 '\\[ibuffer-filter-by-mode] emacs-lisp-mode RET
2560 \\[ibuffer-filter-by-name] ^gnus RET'.
2561
2562 Additionally, you can OR the top two filters together with
2563 '\\[ibuffer-or-filters]'.  To see all buffers in either
2564 `emacs-lisp-mode' or `lisp-interaction-mode', type:
2565
2566 '\\[ibuffer-filter-by-mode] emacs-lisp-mode RET \\[ibuffer-filter-by-mode] lisp-interaction-mode RET \\[ibuffer-or-filters]'.
2567
2568 Filters can also be saved and restored using mnemonic names: see the
2569 functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'.
2570
2571 To remove the top filter on the stack, use '\\[ibuffer-pop-filter]', and
2572 to disable all filtering currently in effect, use
2573 '\\[ibuffer-filter-disable]'.
2574
2575 ** Filter Groups:
2576
2577 Once one has mastered filters, the next logical step up is \"filter
2578 groups\".  A filter group is basically a named group of buffers which
2579 match a filter, which are displayed together in an Ibuffer buffer.  To
2580 create a filter group, simply use the regular functions to create a
2581 filter, and then type '\\[ibuffer-filters-to-filter-group]'.
2582
2583 A quick example will make things clearer.  Suppose that one wants to
2584 group all of one's Emacs Lisp buffers together.  To do this, type
2585
2586 '\\[ibuffer-filter-by-mode] emacs-lisp-mode RET \\[ibuffer-filters-to-filter-group] RET emacs lisp buffers RET'
2587
2588 You may, of course, name the group whatever you want; it doesn't have
2589 to be \"emacs lisp buffers\".  Filter groups may be composed of any
2590 arbitrary combination of filters.
2591
2592 Just like filters themselves, filter groups act as a stack.  Buffers
2593 will not be displayed multiple times if they would be included in
2594 multiple filter groups; instead, the first filter group is used.  The
2595 filter groups are displayed in this order of precedence.
2596
2597 You may rearrange filter groups by using the regular
2598 '\\[ibuffer-kill-line]' and '\\[ibuffer-yank]' pair.  Yanked groups
2599 will be inserted before the group at point."
2600   (kill-all-local-variables)
2601   (use-local-map ibuffer-mode-map)
2602   (setq major-mode 'ibuffer-mode)
2603   (setq mode-name "Ibuffer")
2604   (setq buffer-read-only t)
2605   (buffer-disable-undo)
2606   (setq truncate-lines ibuffer-truncate-lines)
2607   ;; This makes things less ugly for Emacs 21 users with a non-nil
2608   ;; `show-trailing-whitespace'.
2609   (if (boundp 'show-trailing-whitespace)
2610       (setq show-trailing-whitespace nil))
2611
2612   (if (and (boundp 'paren-mode)
2613            paren-mode)
2614       (set (make-local-variable 'paren-mode) nil))
2615
2616   ;; This should be nicer
2617   (set (make-local-variable 'font-lock-defaults) nil)
2618   (set (make-local-variable 'font-lock-fontify-region-function)
2619        'ibuffer-fontify-region-function)
2620   (set (make-local-variable 'font-lock-unfontify-region-function)
2621        'ibuffer-unfontify-region-function)
2622
2623   (set (make-local-variable 'revert-buffer-function)
2624        #'ibuffer-update)
2625   (set (make-local-variable 'ibuffer-sorting-mode)
2626        ibuffer-default-sorting-mode)
2627   (set (make-local-variable 'ibuffer-sorting-reversep)
2628        ibuffer-default-sorting-reversep)
2629   (set (make-local-variable 'ibuffer-shrink-to-minimum-size)
2630        ibuffer-default-shrink-to-minimum-size)
2631   (set (make-local-variable 'ibuffer-filtering-qualifiers) nil)
2632   (set (make-local-variable 'ibuffer-filter-groups) nil)
2633   (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)
2634   (set (make-local-variable 'ibuffer-hidden-filter-groups) nil)
2635   (set (make-local-variable 'ibuffer-compiled-formats) nil)
2636   (set (make-local-variable 'ibuffer-cached-formats) nil)
2637   (set (make-local-variable 'ibuffer-cached-eliding-string) nil)
2638   (set (make-local-variable 'ibuffer-cached-elide-long-columns) nil)
2639   (set (make-local-variable 'ibuffer-current-format) nil)
2640   (set (make-local-variable 'ibuffer-did-modifiction) nil)
2641   (set (make-local-variable 'ibuffer-delete-window-on-quit) nil)
2642   (set (make-local-variable 'ibuffer-did-modification) nil)
2643   (when (featurep 'ibuf-ext)
2644     (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil)
2645     (set (make-local-variable 'ibuffer-tmp-show-regexps) nil))
2646   (easy-menu-add ibuffer-mode-operate-menu)
2647   (easy-menu-add ibuffer-mode-immediate-menu)
2648   (easy-menu-add ibuffer-mode-mark-menu)
2649   (ibuffer-update-format)
2650   (when ibuffer-default-directory
2651     (setq default-directory ibuffer-default-directory))
2652   (run-hooks 'ibuffer-mode-hooks)
2653   ;; called after mode hooks to allow the user to add filters
2654   (ibuffer-update-mode-name)
2655   (if ibuffer-use-fontification
2656       (turn-on-font-lock)))
2657
2658 (provide 'ibuffer)
2659
2660 ;;; ibuffer.el ends here