X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0bdd7ae4f9b0b27373b58865b9d0a747f7758071..1c9e62fec0a5b3ed35a4441d439d49f2473785a3:/lisp/ibuf-ext.el

diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 96678d2bc9..292e158c09 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -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."