(debug): Quieten Drew Adams.
[bpt/emacs.git] / lisp / ibuffer.el
index 06b71c9..217696c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ibuffer.el --- operate on buffers like dired
 
-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Colin Walters <walters@verbum.org>
 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
 Ibuffer allows you to operate on buffers in a manner much like Dired.
 Operations include sorting, marking by regular expression, and
 the ability to filter the displayed buffers by various criteria."
+  :version "22.1"
   :group 'convenience)
 
-(defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide)
-                                  " " (size 7 -1 :right)
+(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide)
+                                  " " (size 9 -1 :right)
                                   " " (mode 16 16 :right :elide) " " filename-and-process)
                             (mark " " (name 16 -1) " " filename))
   "A list of ways to display buffer lines.
@@ -157,6 +158,11 @@ recreate it for the change to take effect."
   :group 'ibuffer)
 (defvar ibuffer-shrink-to-minimum-size nil)
 
+(defcustom ibuffer-display-summary t
+  "If non-nil, summarize Ibuffer columns."
+  :type 'boolean
+  :group 'ibuffer)
+
 (defcustom ibuffer-truncate-lines t
   "If non-nil, do not display continuation lines."
   :type 'boolean
@@ -208,12 +214,20 @@ If a regexp, then it will be matched against the buffer's name.
 If a function, it will be called with the buffer as an argument, and
 should return non-nil if this buffer should be shown.
 
-Viewing of buffers hidden because of these predicates is enabled by
-giving a non-nil prefix argument to `ibuffer-update'.  Note that this
-specialized filtering occurs before real filtering."
+Viewing of buffers hidden because of these predicates may be customized
+via `ibuffer-default-display-maybe-show-predicates' and is toggled by
+giving a non-nil prefix argument to `ibuffer-update'.
+Note that this specialized filtering occurs before real filtering."
   :type '(repeat (choice regexp function))
   :group 'ibuffer)
 
+(defcustom ibuffer-default-display-maybe-show-predicates nil
+  "Non-nil means show buffers that match `ibuffer-maybe-show-predicates'."
+  :type 'boolean
+  :group 'ibuffer)
+
+(defvar ibuffer-display-maybe-show-predicates nil)
+
 (defvar ibuffer-current-format nil)
 
 (defcustom ibuffer-movement-cycle t
@@ -263,6 +277,12 @@ This variable takes precedence over filtering, and even
                 (const :tag "Always except minibuffer" :value :nomini))
   :group 'ibuffer)
 
+(defcustom ibuffer-jump-offer-only-visible-buffers nil
+  "If non-nil, only offer buffers visible in the Ibuffer buffer
+in completion lists of the `ibuffer-jump-to-buffer' command."
+  :type 'boolean
+  :group 'ibuffer)
+
 (defcustom ibuffer-use-header-line (boundp 'header-line-format)
   "If non-nil, display a header line containing current filters."
   :type 'boolean
@@ -352,6 +372,7 @@ directory, like `default-directory'."
     (define-key map (kbd "u") 'ibuffer-unmark-forward)
     (define-key map (kbd "=") 'ibuffer-diff-with-file)
     (define-key map (kbd "j") 'ibuffer-jump-to-buffer)
+    (define-key map (kbd "M-g") 'ibuffer-jump-to-buffer)
     (define-key map (kbd "DEL") 'ibuffer-unmark-backward)
     (define-key map (kbd "M-DEL") 'ibuffer-unmark-all)
     (define-key map (kbd "* *") 'ibuffer-unmark-all)
@@ -752,38 +773,40 @@ directory, like `default-directory'."
 (define-key ibuffer-mode-groups-popup [kill-filter-group]
   '(menu-item "Kill filter group"
              ibuffer-kill-line
-             :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
+             :enable (and (featurep 'ibuf-ext)
+                          ibuffer-filter-groups)))
 (define-key ibuffer-mode-groups-popup [yank-filter-group]
   '(menu-item "Yank last killed filter group"
              ibuffer-yank
-             :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)))
+             :enable (and (featurep 'ibuf-ext)
+                          ibuffer-filter-group-kill-ring)))
 
-(defvar ibuffer-name-map nil)
-(unless ibuffer-name-map
+(defvar ibuffer-name-map
   (let ((map (make-sparse-keymap)))
     (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
     (define-key map [(mouse-2)] 'ibuffer-mouse-visit-buffer)
     (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
-    (setq ibuffer-name-map map)))
+    map))
 
-(defvar ibuffer-mode-name-map nil)
-(unless ibuffer-mode-name-map
+(defvar ibuffer-mode-name-map
   (let ((map (make-sparse-keymap)))
     (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode)
     (define-key map (kbd "RET") 'ibuffer-interactive-filter-by-mode)
-    (setq ibuffer-mode-name-map map)))
+    map))
 
-(defvar ibuffer-mode-filter-group-map nil)
-(unless ibuffer-mode-filter-group-map
+(defvar ibuffer-mode-filter-group-map
   (let ((map (make-sparse-keymap)))
     (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
     (define-key map [(mouse-2)] 'ibuffer-mouse-toggle-filter-group)
     (define-key map (kbd "RET") 'ibuffer-toggle-filter-group)
     (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
-    (setq ibuffer-mode-filter-group-map map)))
+    map))
 
-(defvar ibuffer-delete-window-on-quit nil
-  "Whether or not to delete the window upon exiting `ibuffer'.")
+(defvar ibuffer-restore-window-config-on-quit nil
+  "If non-nil, restore previous window configuration upon exiting `ibuffer'.")
+
+(defvar ibuffer-prev-window-config nil
+  "Window configuration before starting Ibuffer.")
 
 (defvar ibuffer-did-modification nil)
 
@@ -851,8 +874,8 @@ width and the longest string in LIST."
                                    default-directory)
                                default-directory))))
      (list (read-file-name "Find file: " default-directory)
-          current-prefix-arg)))
-  (find-file file (or wildcards (interactive-p))))
+          t)))
+  (find-file file wildcards))
 
 (defun ibuffer-mouse-visit-buffer (event)
   "Visit the buffer chosen with the mouse."
@@ -902,15 +925,15 @@ width and the longest string in LIST."
 (defun ibuffer-backward-line (&optional arg skip-group-names)
   "Move backwards ARG lines, wrapping around the list if necessary."
   (interactive "P")
-  (unless arg
-    (setq arg 1))
+  (or arg (setq arg 1))
   (beginning-of-line)
   (while (> arg 0)
     (forward-line -1)
     (when (and ibuffer-movement-cycle
               (or (get-text-property (point) 'ibuffer-title)
                   (and skip-group-names
-                       (get-text-property (point) 'ibuffer-filter-group-name))))
+                       (get-text-property (point)
+                                          'ibuffer-filter-group-name))))
       (goto-char (point-max))
       (beginning-of-line))
     (ibuffer-skip-properties (append '(ibuffer-summary)
@@ -926,8 +949,7 @@ width and the longest string in LIST."
 (defun ibuffer-forward-line (&optional arg skip-group-names)
   "Move forward ARG lines, wrapping around the list if necessary."
   (interactive "P")
-  (unless arg
-    (setq arg 1))
+  (or arg (setq arg 1))
   (beginning-of-line)
   (when (and ibuffer-movement-cycle
             (or (eobp)
@@ -1043,7 +1065,7 @@ a new window in the current frame, splitting vertically."
        (mapcar (if (eq type 'other-frame)
                    #'(lambda (buf)
                        (let ((curframe (selected-frame)))
-                         (select-frame (new-frame))
+                         (select-frame (make-frame))
                          (switch-to-buffer buf)
                          (select-frame curframe)))
                  #'(lambda (buf)
@@ -1264,8 +1286,7 @@ If point is on a group name, this function operates on that group."
 
 (defun ibuffer-mark-interactive (arg mark movement)
   (assert (eq major-mode 'ibuffer-mode))
-  (unless arg
-    (setq arg 1))
+  (or arg (setq arg 1))
   (ibuffer-forward-line 0)
   (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name)
       (progn
@@ -1389,7 +1410,7 @@ If point is on a group name, this function operates on that group."
 
 (defun ibuffer-compile-make-format-form (strvar widthform alignment)
   (let* ((left `(make-string tmp2 ? ))
-         (right `(make-string (- tmp1 tmp2) ? )))
+        (right `(make-string (- tmp1 tmp2) ? )))
     `(progn
        (setq tmp1 ,widthform
             tmp2 (/ tmp1 2))
@@ -1600,7 +1621,7 @@ If point is on a group name, this function operates on that group."
 
 (define-ibuffer-column read-only (:name "R" :inline t)
   (if buffer-read-only
-      "%"
+      (string ibuffer-read-only-char)
     " "))
 
 (define-ibuffer-column modified (:name "M" :inline t)
@@ -1608,43 +1629,98 @@ If point is on a group name, this function operates on that group."
       (string ibuffer-modified-char)
     " "))
 
-(define-ibuffer-column name (:inline t
-                            :props
-                            ('mouse-face 'highlight 'keymap ibuffer-name-map
-                             'ibuffer-name-column t
-                             'help-echo "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer"))
+(define-ibuffer-column name
+  (:inline t
+   :props
+   ('mouse-face 'highlight 'keymap ibuffer-name-map
+               'ibuffer-name-column t
+               'help-echo '(if tooltip-mode
+                               "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer"
+                             "mouse-1: mark buffer   mouse-2: select buffer   mouse-3: operate"))
+   :summarizer
+   (lambda (strings)
+     (let ((bufs (length strings)))
+       (cond ((zerop bufs) "No buffers")
+            ((= 1 bufs) "1 buffer")
+            (t (format "%s buffers" bufs))))))
   (propertize (buffer-name) 'font-lock-face (ibuffer-buffer-name-face buffer mark)))
 
-(define-ibuffer-column size (:inline t)
+(define-ibuffer-column size
+  (:inline t
+   :summarizer
+   (lambda (column-strings)
+     (let ((total 0))
+       (dolist (string column-strings)
+        (setq total
+              ;; like, ewww ...
+              (+ (float (string-to-number string))
+                 total)))
+       (format "%.0f" total))))
   (format "%s" (buffer-size)))
 
-(define-ibuffer-column mode (:inline t
-                            :props
-                            ('mouse-face 'highlight
-                             'keymap ibuffer-mode-name-map
-                             'help-echo "mouse-2: filter by this mode"))
+(define-ibuffer-column mode
+  (:inline t
+   :props
+   ('mouse-face 'highlight
+               'keymap ibuffer-mode-name-map
+               'help-echo "mouse-2: filter by this mode"))
   (format "%s" mode-name))
 
-(define-ibuffer-column process ()
+(define-ibuffer-column process
+  (:summarizer
+   (lambda (strings)
+     (let ((total (length (delete "" strings))))
+       (cond ((zerop total) "No processes")
+            ((= 1 total) "1 process")
+            (t (format "%d processes" total))))))
   (ibuffer-aif (get-buffer-process buffer)
       (format "(%s %s)" it (process-status it))
-    "none"))
-
-(define-ibuffer-column filename ()
+    ""))
+
+(define-ibuffer-column filename
+  (:summarizer
+   (lambda (strings)
+     (let ((total (length (delete "" strings))))
+       (cond ((zerop total) "No files")
+            ((= 1 total) "1 file")
+            (t (format "%d files" total))))))
   (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist))
     (abbreviate-file-name
      (or buffer-file-name
         (and (boundp 'dired-directory)
-             dired-directory)
+             (if (stringp dired-directory)
+                 dired-directory
+               (car dired-directory))) 
         ""))))
 
-(define-ibuffer-column filename-and-process (:name "Filename/Process")
+(define-ibuffer-column filename-and-process
+  (:name "Filename/Process"
+   :summarizer
+   (lambda (strings)
+     (setq strings (delete "" strings))
+     (let ((procs 0)
+          (files 0))
+       (dolist (string strings)
+        (if (string-match "\\(\?:\\`(\[\[:ascii:\]\]\+)\\)" string)
+            (progn (setq procs (1+ procs))
+                   (if (< (match-end 0) (length string))
+                       (setq files (1+ files))))
+          (setq files (1+ files))))
+       (concat (cond ((zerop files) "No files")
+                    ((= 1 files) "1 file")
+                    (t (format "%d files" files)))
+              ", "
+              (cond ((zerop procs) "no processes")
+                    ((= 1 procs) "1 process")
+                    (t (format "%d processes" procs)))))))
   (let ((proc (get-buffer-process buffer))
        (filename (ibuffer-make-column-filename buffer mark)))
     (if proc
-       (concat (propertize (format "(%s %s) " proc (process-status proc))
+       (concat (propertize (format "(%s %s)" proc (process-status proc))
                            'font-lock-face 'italic)
-               filename)
+               (if (> (length filename) 0)
+                   (format " %s" filename)
+                 ""))
       filename)))
 
 (defun ibuffer-format-column (str width alignment)
@@ -1927,34 +2003,35 @@ the value of point at the beginning of the line for that buffer."
        (delete-region (previous-single-property-change
                        (point-max) 'ibuffer-summary)
                       (point-max)))
-    (add-text-properties
-     (point)
-     (progn
-       (insert "\n")
-       (dolist (element format)
-        (insert
-         (if (stringp element)
-             (make-string (length element) ? )
-           (let ((sym (car element)))
-             (let ((min (cadr element))
-                   ;; (max (caddr element))
-                   (align (cadddr element)))
-               ;; Ignore a negative min when we're inserting the title
-               (when (minusp min)
-                 (setq min (- min)))
-               (let* ((summary (if (get sym 'ibuffer-column-summarizer)
-                                   (funcall (get sym 'ibuffer-column-summarizer)
-                                            (get sym 'ibuffer-column-summary))
-                                 (make-string (length (get sym 'ibuffer-column-name))
-                                              ? )))
-                      (len (length summary)))
-                 (if (< len min)
-                     (ibuffer-format-column summary
-                                            (- min len)
-                                            align)
-                   summary)))))))
-       (point))
-     `(ibuffer-summary t))))
+    (if ibuffer-display-summary
+       (add-text-properties
+        (point)
+        (progn
+          (insert "\n")
+          (dolist (element format)
+            (insert
+             (if (stringp element)
+                 (make-string (length element) ? )
+               (let ((sym (car element)))
+                 (let ((min (cadr element))
+                       ;; (max (caddr element))
+                       (align (cadddr element)))
+                   ;; Ignore a negative min when we're inserting the title
+                   (when (minusp min)
+                     (setq min (- min)))
+                   (let* ((summary (if (get sym 'ibuffer-column-summarizer)
+                                       (funcall (get sym 'ibuffer-column-summarizer)
+                                                (get sym 'ibuffer-column-summary))
+                                     (make-string (length (get sym 'ibuffer-column-name))
+                                                  ? )))
+                          (len (length summary)))
+                     (if (< len min)
+                         (ibuffer-format-column summary
+                                                (- min len)
+                                                align)
+                       summary)))))))
+          (point))
+        `(ibuffer-summary t)))))
 
 (defun ibuffer-update-mode-name ()
   (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode
@@ -2003,11 +2080,15 @@ If optional arg SILENT is non-nil, do not display progress messages."
 
 (defun ibuffer-update (arg &optional silent)
   "Regenerate the list of all buffers.
-Display buffers whose name matches one of `ibuffer-maybe-show-predicates'
-iff arg ARG is non-nil.
+
+Prefix arg non-nil means to toggle whether buffers that match
+`ibuffer-maybe-show-predicates' should be displayed.
 
 If optional arg SILENT is non-nil, do not display progress messages."
   (interactive "P")
+  (if arg
+      (setq ibuffer-display-maybe-show-predicates
+           (not ibuffer-display-maybe-show-predicates)))
   (ibuffer-forward-line 0)
   (let* ((bufs (buffer-list))
         (blist (ibuffer-filter-buffers
@@ -2020,7 +2101,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
                     (caddr bufs)
                   (cadr bufs))
                 (ibuffer-current-buffers-with-marks bufs)
-                arg)))
+                ibuffer-display-maybe-show-predicates)))
     (when (null blist)
       (if (and (featurep 'ibuf-ext)
               ibuffer-filtering-qualifiers)
@@ -2063,7 +2144,14 @@ If optional arg SILENT is non-nil, do not display progress messages."
      font-lock-face ,ibuffer-filter-group-name-face
      keymap ,ibuffer-mode-filter-group-map
      mouse-face highlight
-     help-echo ,(concat filter-string "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group ")))
+     help-echo ,(let ((echo '(if tooltip-mode
+                                "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group"
+                              "mouse-1: toggle marks  mouse-2: hide/show")))
+                 (if (> (length filter-string) 0)
+                     `(concat ,filter-string
+                              (if tooltip-mode "\n" " ")
+                              ,echo)
+                   echo))))
   (insert "\n")
   (when bmarklist
     (put-text-property
@@ -2075,7 +2163,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
      'ibuffer-filter-group
      name)))
 
-(defun ibuffer-redisplay-engine (bmarklist &optional all)
+(defun ibuffer-redisplay-engine (bmarklist &optional ignore)
   (assert (eq major-mode 'ibuffer-mode))
   (let* ((--ibuffer-insert-buffers-and-marks-format
          (ibuffer-current-format))
@@ -2101,6 +2189,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
                                  (member name ibuffer-hidden-filter-groups)))
                   (bmarklist (cdr group)))
              (unless (and (null bmarklist)
+                          (not disabled)
                           ext-loaded
                           (null ibuffer-show-empty-filter-groups))
                (ibuffer-insert-filter-group
@@ -2121,13 +2210,14 @@ If optional arg SILENT is non-nil, do not display progress messages."
 
 (defun ibuffer-quit ()
   "Quit this `ibuffer' session.
-Delete the current window iff `ibuffer-delete-window-on-quit' is non-nil."
+Try to restore the previous window configuration iff
+`ibuffer-restore-window-config-on-quit' is non-nil."
   (interactive)
-  (if ibuffer-delete-window-on-quit
+  (if ibuffer-restore-window-config-on-quit
       (progn
        (bury-buffer)
        (unless (= (count-windows) 1)
-         (delete-window)))
+         (set-window-configuration ibuffer-prev-window-config)))
     (bury-buffer)))
 
 ;;;###autoload
@@ -2170,9 +2260,8 @@ locally in this buffer."
   (interactive "P")
   (when ibuffer-use-other-window
     (setq other-window-p t))
-  (let* ((buf (get-buffer-create (or name "*Ibuffer*")))
-        (already-in (eq (current-buffer) buf))
-        (need-update nil))
+  (setq ibuffer-prev-window-config (current-window-configuration))
+  (let ((buf (get-buffer-create (or name "*Ibuffer*"))))
     (if other-window-p
        (funcall (if noselect #'(lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf)
       (funcall (if noselect #'display-buffer #'switch-to-buffer) buf))
@@ -2181,10 +2270,9 @@ locally in this buffer."
        ;; We switch to the buffer's window in order to be able
        ;; to modify the value of point
        (select-window (get-buffer-window buf))
-       (unless (eq major-mode 'ibuffer-mode)
-         (ibuffer-mode)
-         (setq need-update t))
-       (setq ibuffer-delete-window-on-quit other-window-p)
+       (or (eq major-mode 'ibuffer-mode)
+           (ibuffer-mode))
+       (setq ibuffer-restore-window-config-on-quit other-window-p)
        (when shrink
          (setq ibuffer-shrink-to-minimum-size shrink))
        (when qualifiers
@@ -2402,6 +2490,8 @@ will be inserted before the group at point."
        ibuffer-default-sorting-reversep)
   (set (make-local-variable 'ibuffer-shrink-to-minimum-size)
        ibuffer-default-shrink-to-minimum-size)
+  (set (make-local-variable 'ibuffer-display-maybe-show-predicates)
+       ibuffer-default-display-maybe-show-predicates)
   (set (make-local-variable 'ibuffer-filtering-qualifiers) nil)
   (set (make-local-variable 'ibuffer-filter-groups) nil)
   (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)
@@ -2411,7 +2501,7 @@ will be inserted before the group at point."
   (set (make-local-variable 'ibuffer-cached-eliding-string) nil)
   (set (make-local-variable 'ibuffer-cached-elide-long-columns) nil)
   (set (make-local-variable 'ibuffer-current-format) nil)
-  (set (make-local-variable 'ibuffer-delete-window-on-quit) nil)
+  (set (make-local-variable 'ibuffer-restore-window-config-on-quit) nil)
   (set (make-local-variable 'ibuffer-did-modification) nil)
   (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil)
   (set (make-local-variable 'ibuffer-tmp-show-regexps) nil)
@@ -2421,7 +2511,7 @@ will be inserted before the group at point."
   (when ibuffer-default-directory
     (setq default-directory ibuffer-default-directory))
   (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
-  (run-hooks 'ibuffer-mode-hook)
+  (run-mode-hooks 'ibuffer-mode-hook)
   ;; called after mode hooks to allow the user to add filters
   (ibuffer-update-mode-name))
 
@@ -2433,4 +2523,5 @@ will be inserted before the group at point."
 ;; coding: iso-8859-1
 ;; End:
 
+;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8
 ;;; ibuffer.el ends here