]> code.delx.au - gnu-emacs/blobdiff - lisp/ibuf-ext.el
Update for MH-E release 7.95.
[gnu-emacs] / lisp / ibuf-ext.el
index 96678d2bc9a9f0831339a52c59fa63d6bc9c6660..292e158c097273b5d3ea63ba5b14aaa042e7db89 100644 (file)
@@ -1,6 +1,7 @@
 ;;; ibuf-ext.el --- extensions for ibuffer
 
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Colin Walters <walters@verbum.org>
 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -21,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program ; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -73,6 +74,7 @@ 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 not be shown."
   :type '(repeat (choice regexp function))
+  :require 'ibuf-ext
   :group 'ibuffer)
 
 (defcustom ibuffer-always-show-predicates nil
@@ -221,8 +223,7 @@ Currently, this only applies to `ibuffer-saved-filters' and
         (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
 
 (defun ibuffer-auto-update-changed ()
-  (when ibuffer-auto-buffers-changed
-    (setq ibuffer-auto-buffers-changed nil)
+  (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
     (mapcar #'(lambda (buf)
                (ignore-errors
                  (with-current-buffer buf
@@ -242,10 +243,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
        (if arg
           (plusp arg)
         (not ibuffer-auto-mode)))
-  (defadvice get-buffer-create (after ibuffer-notify-create activate)
-    (setq ibuffer-auto-buffers-changed t))
-  (defadvice kill-buffer (after ibuffer-notify-kill activate)
-    (setq ibuffer-auto-buffers-changed t))
+  (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
   (add-hook 'post-command-hook 'ibuffer-auto-update-changed)
   (ibuffer-update-mode-name))
 
@@ -260,7 +258,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
   "Enable or disable filtering by the major mode at point."
   (interactive "d")
   (if (eventp event-or-point)
-      (mouse-set-point event-or-point)
+      (posn-set-point (event-end event-or-point))
     (goto-char event-or-point))
   (let ((buf (ibuffer-current-buffer)))
     (if (assq 'mode ibuffer-filtering-qualifiers)
@@ -332,7 +330,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
     (ibuffer-backward-filter-group 1))
   (ibuffer-forward-line 0))
 
-;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
 (define-ibuffer-op shell-command-pipe (command)
   "Pipe the contents of each marked buffer to shell command COMMAND."
   (:interactive "sPipe to shell command: "
@@ -342,7 +340,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
    (point-min) (point-max) command
    (get-buffer-create "* ibuffer-shell-output*")))
 
-;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
 (define-ibuffer-op shell-command-pipe-replace (command)
   "Replace the contents of marked buffers with output of pipe to COMMAND."
   (:interactive "sPipe to shell command (replace): "
@@ -354,7 +352,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
     (shell-command-on-region (point-min) (point-max)
                             command nil t)))
 
-;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
 (define-ibuffer-op shell-command-file (command)
   "Run shell command COMMAND separately on files of marked buffers."
   (:interactive "sShell command on buffer's file: "
@@ -367,7 +365,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive."
                            (make-temp-file
                             (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
 
-;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
 (define-ibuffer-op eval (form)
   "Evaluate FORM in each of the buffers.
 Does not display the buffer during evaluation. See
@@ -377,7 +375,7 @@ Does not display the buffer during evaluation. See
    :modifier-p :maybe)
   (eval form))
 
-;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
 (define-ibuffer-op view-and-eval (form)
   "Evaluate FORM while displaying each of the marked buffers.
 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
@@ -392,14 +390,14 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
          (eval form))
       (switch-to-buffer ibuffer-buf))))
 
-;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
 (define-ibuffer-op rename-uniquely ()
   "Rename marked buffers as with `rename-uniquely'."
   (:opstring "renamed"
    :modifier-p t)
   (rename-uniquely))
 
-;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
 (define-ibuffer-op revert ()
   "Revert marked buffers as with `revert-buffer'."
   (:dangerous t
@@ -408,7 +406,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
    :modifier-p :maybe)
   (revert-buffer t t))
 
-;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
 (define-ibuffer-op replace-regexp (from-str to-str)
   "Perform a `replace-regexp' in marked buffers."
   (:interactive
@@ -428,7 +426,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
          (replace-match to-str))))
     t))
 
-;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
 (define-ibuffer-op query-replace (&rest args)
   "Perform a `query-replace' in marked buffers."
   (:interactive
@@ -444,7 +442,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
        (apply #'query-replace args)))
     t))
 
-;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
 (define-ibuffer-op query-replace-regexp (&rest args)
   "Perform a `query-replace-regexp' in marked buffers."
   (:interactive
@@ -460,7 +458,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
        (apply #'query-replace-regexp args)))
     t))
 
-;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
 (define-ibuffer-op print ()
   "Print marked buffers as with `print-buffer'."
   (:opstring "printed"
@@ -513,9 +511,11 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
                   buf
                   (cdr filter))))))))))
 
-(defun ibuffer-generate-filter-groups (bmarklist)
-  (let ((filter-group-alist (append ibuffer-filter-groups
-                                      (list (cons "Default" nil)))))
+(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
+  (let ((filter-group-alist (if nodefault
+                               ibuffer-filter-groups
+                             (append ibuffer-filter-groups
+                                     (list (cons "Default" nil))))))
 ;;     (dolist (hidden ibuffer-hidden-filter-groups)
 ;;       (setq filter-group-alist (ibuffer-delete-alist
 ;;                                hidden filter-group-alist)))
@@ -531,11 +531,13 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
            (aset vec i hip-crowd)
            (incf i)
            (setq bmarklist lamers))))
-      (let ((ret nil))
+      (let (ret)
        (dotimes (j i ret)
-         (push (cons (car (nth j filter-group-alist))
-                     (aref vec j))
-               ret))))))
+         (let ((bufs (aref vec j)))
+           (unless (and noempty (null bufs))
+             (push (cons (car (nth j filter-group-alist))
+                         bufs)
+                   ret))))))))
 
 ;;;###autoload
 (defun ibuffer-filters-to-filter-group (name)
@@ -577,11 +579,19 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
 (defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
   (when (and (not noerror) (null ibuffer-filter-groups))
     (error "No filter groups active"))
-  (let ((groups (mapcar #'car ibuffer-filter-groups)))
-    (completing-read msg (if nodefault
-                            groups
-                          (cons "Default" groups))
-                    nil t)))
+  ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
+  ;; groups, possibly excluding empty groups or Default.
+  ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
+  ;; Default if necessary.
+  (completing-read msg (nconc
+                       (ibuffer-generate-filter-groups
+                        (ibuffer-current-state-list)
+                        (not ibuffer-show-empty-filter-groups)
+                        nodefault)
+                       (if nodefault
+                           (remove "Default" ibuffer-hidden-filter-groups)
+                         ibuffer-hidden-filter-groups))
+                  nil t))
 
 ;;;###autoload
 (defun ibuffer-decompose-filter-group (group)
@@ -645,16 +655,16 @@ The group will be added to `ibuffer-filter-group-kill-ring'."
   (ibuffer-update nil t))
 
 ;;;###autoload
-(defun ibuffer-kill-line (&optional arg)
+(defun ibuffer-kill-line (&optional arg interactive-p)
   "Kill the filter group at point.
 See also `ibuffer-kill-filter-group'."
-  (interactive "P")
+  (interactive "P\np")
   (ibuffer-aif (save-excursion
                 (ibuffer-forward-line 0)
                 (get-text-property (point) 'ibuffer-filter-group-name))
       (progn
        (ibuffer-kill-filter-group it))
-      (funcall (if (interactive-p) #'call-interactively #'funcall)
+      (funcall (if interactive-p #'call-interactively #'funcall)
               #'kill-line arg)))
 
 (defun ibuffer-insert-filter-group-before (newgroup group)
@@ -753,7 +763,10 @@ of replacing the current filters."
   "Disable all filters currently in effect in this buffer."
   (interactive)
   (setq ibuffer-filtering-qualifiers nil)
-  (ibuffer-update nil t))
+  (let ((buf (ibuffer-current-buffer)))
+    (ibuffer-update nil t)
+    (when buf
+      (ibuffer-jump-to-buffer (buffer-name buf)))))
 
 ;;;###autoload
 (defun ibuffer-pop-filter ()
@@ -762,7 +775,10 @@ of replacing the current filters."
   (when (null ibuffer-filtering-qualifiers)
     (error "No filters in effect"))
   (pop ibuffer-filtering-qualifiers)
-  (ibuffer-update nil t))
+  (let ((buf (ibuffer-current-buffer)))
+    (ibuffer-update nil t)
+    (when buf
+      (ibuffer-jump-to-buffer (buffer-name buf)))))
 
 (defun ibuffer-push-filter (qualifier)
   "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
@@ -966,7 +982,7 @@ The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
 
 ;;; Extra operation definitions
 
-;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
 (define-ibuffer-filter mode
   "Toggle current view to buffers with major mode QUALIFIER."
   (:description "major mode"
@@ -984,7 +1000,7 @@ The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
                         "")))))
   (eq qualifier (with-current-buffer buf major-mode)))
 
-;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
 (define-ibuffer-filter used-mode
   "Toggle current view to buffers with major mode QUALIFIER.
 Called interactively, this function allows selection of modes
@@ -1003,22 +1019,30 @@ currently used by buffers."
                                      "")))))
   (eq qualifier (with-current-buffer buf major-mode)))
 
-;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
 (define-ibuffer-filter name
   "Toggle current view to buffers with name matching QUALIFIER."
   (:description "buffer name"
    :reader (read-from-minibuffer "Filter by name (regexp): "))
   (string-match qualifier (buffer-name buf)))
 
-;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext")
 (define-ibuffer-filter filename
   "Toggle current view to buffers with filename matching QUALIFIER."
   (:description "filename"
    :reader (read-from-minibuffer "Filter by filename (regexp): "))
-  (ibuffer-awhen (buffer-file-name buf)
+  (ibuffer-awhen (with-current-buffer buf
+                  (or buffer-file-name
+                      (and (boundp 'dired-directory)
+                           (let ((dired-dir
+                                  (if (stringp dired-directory)
+                                      dired-directory
+                                    (car dired-directory))))
+                             (and dired-dir
+                                  (expand-file-name dired-dir))))))
     (string-match qualifier it)))
 
-;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext")
 (define-ibuffer-filter size-gt
   "Toggle current view to buffers with size greater than QUALIFIER."
   (:description "size greater than"
@@ -1027,7 +1051,7 @@ currently used by buffers."
   (> (with-current-buffer buf (buffer-size))
      qualifier))
 
-;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext")
 (define-ibuffer-filter size-lt
    "Toggle current view to buffers with size less than QUALIFIER."
   (:description "size less than"
@@ -1036,7 +1060,7 @@ currently used by buffers."
   (< (with-current-buffer buf (buffer-size))
      qualifier))
 
-;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext")
 (define-ibuffer-filter content
    "Toggle current view to buffers whose contents match QUALIFIER."
   (:description "content"
@@ -1046,7 +1070,7 @@ currently used by buffers."
       (goto-char (point-min))
       (re-search-forward qualifier nil t))))
 
-;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext")
 (define-ibuffer-filter predicate
    "Toggle current view to buffers for which QUALIFIER returns non-nil."
   (:description "predicate"
@@ -1085,7 +1109,7 @@ Default sorting modes are:
             "normal"))
   (ibuffer-redisplay t))
 
-;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext")
 (define-ibuffer-sorter major-mode
   "Sort the buffers by major modes.
 Ordering is lexicographic."
@@ -1099,7 +1123,7 @@ Ordering is lexicographic."
                                  (car b)
                                major-mode)))))
 
-;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext")
 (define-ibuffer-sorter mode-name
   "Sort the buffers by their mode name.
 Ordering is lexicographic."
@@ -1113,7 +1137,7 @@ Ordering is lexicographic."
                     (car b)
                   mode-name))))
 
-;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext")
 (define-ibuffer-sorter alphabetic
   "Sort the buffers by their names.
 Ordering is lexicographic."
@@ -1122,7 +1146,7 @@ Ordering is lexicographic."
    (buffer-name (car a))
    (buffer-name (car b))))
 
-;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext.el")
+;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext")
 (define-ibuffer-sorter size
  "Sort the buffers by their size."
   (:description "size")
@@ -1233,53 +1257,51 @@ hidden group filter, open it.
 If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer
 visible buffers in the completion list.  Calling the command with
 a prefix argument reverses the meaning of that variable."
-  (interactive (list nil))
-  (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
-    (when current-prefix-arg
-      (setq only-visible (not only-visible)))
-    (if only-visible
-       (let ((table (mapcar #'(lambda (x)
-                                (buffer-name (car x)))
-                            (ibuffer-current-state-list))))
-         (when (null table)
-           (error "No buffers!"))
-         (when (interactive-p)
-           (setq name (completing-read "Jump to buffer: "
-                                       table nil t))))
-      (when (interactive-p)
-       (setq name (read-buffer "Jump to buffer: " nil t))))
-    (when (not (string= "" name))
-      (let (buf-point)
-       ;; Blindly search for our buffer: it is very likely that it is
-       ;; not in a hidden filter group.
-       (ibuffer-map-lines #'(lambda (buf marks)
-                              (when (string= (buffer-name buf) name)
-                                (setq buf-point (point))
-                                nil))
-                          t nil)
-       (when (and
-              (null buf-point)
-              (not (null ibuffer-hidden-filter-groups)))
-         ;; We did not find our buffer.  It must be in a hidden filter
-         ;; group, so go through all hidden filter groups to find it.
-         (catch 'found
-           (dolist (group ibuffer-hidden-filter-groups)
-             (ibuffer-jump-to-filter-group group)
-             (ibuffer-toggle-filter-group)
-             (ibuffer-map-lines #'(lambda (buf marks)
-                                    (when (string= (buffer-name buf) name)
-                                      (setq buf-point (point))
-                                      nil))
-                                t group)
-             (if buf-point
-                 (throw 'found nil)
-               (ibuffer-toggle-filter-group)))))
-       (if (null buf-point)
-           ;; Still not found even though we expanded all hidden filter
-           ;; groups: that must be because it's hidden by predicate:
-           ;; we won't bother trying to display it.
-           (error "No buffer with name %s" name)
-         (goto-char buf-point))))))
+  (interactive (list
+               (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
+                 (when current-prefix-arg
+                   (setq only-visible (not only-visible)))
+                 (if only-visible
+                     (let ((table (mapcar #'(lambda (x)
+                                              (buffer-name (car x)))
+                                          (ibuffer-current-state-list))))
+                       (when (null table)
+                         (error "No buffers!"))
+                       (completing-read "Jump to buffer: "
+                                        table nil t))
+                   (read-buffer "Jump to buffer: " nil t)))))
+  (when (not (string= "" name))
+    (let (buf-point)
+      ;; Blindly search for our buffer: it is very likely that it is
+      ;; not in a hidden filter group.
+      (ibuffer-map-lines #'(lambda (buf marks)
+                            (when (string= (buffer-name buf) name)
+                              (setq buf-point (point))
+                              nil))
+                        t nil)
+      (when (and
+            (null buf-point)
+            (not (null ibuffer-hidden-filter-groups)))
+       ;; We did not find our buffer.  It must be in a hidden filter
+       ;; group, so go through all hidden filter groups to find it.
+       (catch 'found
+         (dolist (group ibuffer-hidden-filter-groups)
+           (ibuffer-jump-to-filter-group group)
+           (ibuffer-toggle-filter-group)
+           (ibuffer-map-lines #'(lambda (buf marks)
+                                  (when (string= (buffer-name buf) name)
+                                    (setq buf-point (point))
+                                    nil))
+                              t group)
+           (if buf-point
+               (throw 'found nil)
+             (ibuffer-toggle-filter-group)))))
+      (if (null buf-point)
+         ;; Still not found even though we expanded all hidden filter
+         ;; groups: that must be because it's hidden by predicate:
+         ;; we won't bother trying to display it.
+         (error "No buffer with name %s" name)
+       (goto-char buf-point)))))
 
 ;;;###autoload
 (defun ibuffer-diff-with-file ()
@@ -1439,6 +1461,17 @@ You can then feed the file name(s) to other commands with \\[yank]."
        (with-current-buffer buf
         (memq major-mode ibuffer-help-buffer-modes)))))
 
+;;;###autoload
+(defun ibuffer-mark-compressed-file-buffers ()
+  "Mark buffers whose associated file is compressed."
+  (interactive)
+  (ibuffer-mark-on-buffer
+   #'(lambda (buf)
+       (with-current-buffer buf
+        (and buffer-file-name
+             (string-match ibuffer-compressed-file-name-regexp
+                          buffer-file-name))))))
+
 ;;;###autoload
 (defun ibuffer-mark-old-buffers ()
   "Mark buffers which have not been viewed in `ibuffer-old-time' days."