]> code.delx.au - gnu-emacs/blobdiff - lisp/ibuf-ext.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / ibuf-ext.el
index e2e5d25137194c9a575f8ff78f37db339ba4bbb5..0b2586d0fce77747a3d4653a3f27525d17c40449 100644 (file)
@@ -1,6 +1,7 @@
 ;;; ibuf-ext.el --- extensions for ibuffer
 
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Colin Walters <walters@verbum.org>
 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -11,7 +12,7 @@
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
+;; published by the Free Software Foundation; either version 3, or (at
 ;; your option) any later version.
 
 ;; This program is distributed in the hope that it will be useful, but
@@ -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
@@ -178,8 +180,8 @@ QUALIFIERS is a list of the same form as
 
 See also the variables `ibuffer-filter-groups',
 `ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the
-functions `ibuffer-switch-to-saved-filter-group',
-`ibuffer-save-filter-group'."
+functions `ibuffer-switch-to-saved-filter-groups',
+`ibuffer-save-filter-groups'."
   :type '(repeat sexp)
   :group 'ibuffer)
 
@@ -221,15 +223,13 @@ 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)
-    (mapcar #'(lambda (buf)
-               (ignore-errors
-                 (with-current-buffer buf
-                   (when (and ibuffer-auto-mode
-                              (eq major-mode 'ibuffer-mode))
-                     (ibuffer-update nil t)))))
-           (buffer-list))))
+  (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
+    (dolist (buf (buffer-list))
+      (ignore-errors
+       (with-current-buffer buf
+         (when (and ibuffer-auto-mode
+                    (eq major-mode 'ibuffer-mode))
+           (ibuffer-update nil t)))))))
 
 ;;;###autoload
 (defun ibuffer-auto-mode (&optional arg)
@@ -242,10 +242,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) ; Initialize state vector
   (add-hook 'post-command-hook 'ibuffer-auto-update-changed)
   (ibuffer-update-mode-name))
 
@@ -260,7 +257,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 +329,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 +339,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 +351,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,21 +364,29 @@ 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
 `ibuffer-do-view-and-eval' for that."
-  (:interactive "xEval in buffers (form): "
+  (:interactive
+   (list
+    (read-from-minibuffer
+     "Eval in buffers (form): "
+     nil read-expression-map t 'read-expression-history))
    :opstring "evaluated in"
    :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'."
-  (:interactive "xEval viewing buffers (form): "
+  (:interactive
+   (list
+    (read-from-minibuffer
+     "Eval viewing in buffers (form): "
+     nil read-expression-map t 'read-expression-history))
    :opstring "evaluated in"
    :complex t
    :modifier-p :maybe)
@@ -392,14 +397,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 +413,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 +433,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 +449,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 +465,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 +518,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 +538,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)
@@ -555,7 +564,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
                   (cons (format "%s" mode) `((mode . ,mode))))
                 (let ((modes
                        (ibuffer-remove-duplicates
-                        (mapcar (lambda (buf) 
+                        (mapcar (lambda (buf)
                                  (with-current-buffer buf major-mode))
                                 (buffer-list)))))
                   (if ibuffer-view-ibuffer
@@ -577,16 +586,24 @@ 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)
   "Decompose the filter group GROUP into active filters."
-  (interactive 
+  (interactive
    (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
   (let ((data (cdr (assoc group ibuffer-filter-groups))))
     (setq ibuffer-filter-groups (ibuffer-delete-alist
@@ -621,7 +638,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
 ;;;###autoload
 (defun ibuffer-jump-to-filter-group (name)
   "Move point to the filter group whose name is NAME."
-  (interactive 
+  (interactive
    (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
   (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
       (goto-char (cdr it))
@@ -735,9 +752,7 @@ They are removed from `ibuffer-saved-filter-groups'."
 ;;;###autoload
 (defun ibuffer-switch-to-saved-filter-groups (name)
   "Set this buffer's filter groups to saved version with NAME.
-The value from `ibuffer-saved-filters' is used.
-If prefix argument ADD is non-nil, then add the saved filters instead
-of replacing the current filters."
+The value from `ibuffer-saved-filter-groups' is used."
   (interactive
    (list
     (if (null ibuffer-saved-filter-groups)
@@ -845,7 +860,7 @@ filter into parts."
                  (not (eq 'or (caar ibuffer-filtering-qualifiers))))
          (error "Top filter is not an OR"))
        (let ((lim (pop ibuffer-filtering-qualifiers)))
-         (setq ibuffer-filtering-qualifiers 
+         (setq ibuffer-filtering-qualifiers
                (nconc (cdr lim) ibuffer-filtering-qualifiers))))
     (when (< (length ibuffer-filtering-qualifiers) 2)
       (error "Need two filters to OR"))
@@ -913,9 +928,7 @@ Interactively, prompt for NAME, and use the current filters."
 
 ;;;###autoload
 (defun ibuffer-switch-to-saved-filters (name)
-  "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
-If prefix argument ADD is non-nil, then add the saved filters instead
-of replacing the current filters."
+  "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
   (interactive
    (list
     (if (null ibuffer-saved-filters)
@@ -972,7 +985,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"
@@ -990,7 +1003,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
@@ -1009,14 +1022,14 @@ 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"
@@ -1024,11 +1037,15 @@ currently used by buffers."
   (ibuffer-awhen (with-current-buffer buf
                   (or buffer-file-name
                       (and (boundp 'dired-directory)
-                           dired-directory
-                           (expand-file-name 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"
@@ -1037,7 +1054,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"
@@ -1046,7 +1063,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"
@@ -1056,7 +1073,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"
@@ -1095,7 +1112,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."
@@ -1109,7 +1126,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."
@@ -1117,13 +1134,13 @@ Ordering is lexicographic."
   (string-lessp (downcase
                  (with-current-buffer
                      (car a)
-                   mode-name))
+                   (format-mode-line mode-name)))
                (downcase
                 (with-current-buffer
                     (car b)
-                  mode-name))))
+                  (format-mode-line 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."
@@ -1132,7 +1149,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")
@@ -1309,7 +1326,7 @@ If a buffer has no filename, it is ignored.
 With no prefix arg, use the filename sans its directory of each marked file.
 With a zero prefix arg, use the complete filename of each marked file.
 With \\[universal-argument], use the filename of each marked file relative
-to `ibuffer-default-directory' iff non-nil, otherwise `default-directory'.
+to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
 
 You can then feed the file name(s) to other commands with \\[yank]."
   (interactive "p")
@@ -1369,7 +1386,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
   (ibuffer-mark-on-buffer
    #'(lambda (buf)
        (with-current-buffer buf
-        (string-match regexp mode-name)))))
+        (string-match regexp (format-mode-line mode-name))))))
 
 ;;;###autoload
 (defun ibuffer-mark-by-file-name-regexp (regexp)
@@ -1447,9 +1464,20 @@ 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."
+  "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
   (interactive)
   (ibuffer-mark-on-buffer
    #'(lambda (buf)