X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3e803487e8aa8a9bfbe375111f2ab3fffe1bcae2..622a113efd0c2b19ae75e017c6db1d08c51fef1d:/lisp/ibuffer.el diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 217696cb4a..a4762cfec1 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1,6 +1,7 @@ ;;; ibuffer.el --- operate on buffers like dired -;; 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 ;; Maintainer: John Paul Wallington @@ -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: @@ -39,6 +40,21 @@ (require 'font-core) +;; These come from ibuf-ext.el, which can not be require'd at compile time +;; because it has a recursive dependency on ibuffer.el +(defvar ibuffer-auto-mode) +(defvar ibuffer-cached-filter-formats) +(defvar ibuffer-compiled-filter-formats) +(defvar ibuffer-filter-format-alist) +(defvar ibuffer-filter-group-kill-ring) +(defvar ibuffer-filter-groups) +(defvar ibuffer-filtering-qualifiers) +(defvar ibuffer-hidden-filter-groups) +(defvar ibuffer-inline-columns) +(defvar ibuffer-show-empty-filter-groups) +(defvar ibuffer-tmp-hide-regexps) +(defvar ibuffer-tmp-show-regexps) + (defgroup ibuffer nil "An advanced replacement for `buffer-menu'. @@ -126,12 +142,16 @@ elisp byte-compiler." (defcustom ibuffer-fontification-alist `((10 buffer-read-only font-lock-constant-face) - (15 (string-match "^*" (buffer-name)) font-lock-keyword-face) - (20 (and (string-match "^ " (buffer-name)) + (15 (and buffer-file-name + (string-match ibuffer-compressed-file-name-regexp + buffer-file-name)) + font-lock-doc-face) + (20 (string-match "^*" (buffer-name)) font-lock-keyword-face) + (25 (and (string-match "^ " (buffer-name)) (null buffer-file-name)) italic) - (25 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face) - (30 (eq major-mode 'dired-mode) font-lock-function-name-face)) + (30 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face) + (35 (eq major-mode 'dired-mode) font-lock-function-name-face)) "An alist describing how to fontify buffers. Each element should be of the form (PRIORITY FORM FACE), where PRIORITY is an integer, FORM is an arbitrary form to evaluate in the @@ -193,11 +213,12 @@ view of the buffers." (defvar ibuffer-sorting-reversep nil) (defcustom ibuffer-elide-long-columns nil - "If non-nil, then elide column entries which exceed their max length. -This variable is deprecated; use the :elide argument of -`ibuffer-formats' to elide just certain columns." + "If non-nil, then elide column entries which exceed their max length." :type 'boolean :group 'ibuffer) +(make-obsolete-variable 'ibuffer-elide-long-columns + "use the :elide argument of `ibuffer-formats'." + "22.1") (defcustom ibuffer-eliding-string "..." "The string to use for eliding long columns." @@ -303,17 +324,27 @@ directory, like `default-directory'." :type '(repeat function) :group 'ibuffer) +(defcustom ibuffer-compressed-file-name-regexp + (concat "\\.\\(" + (regexp-opt '("arj" "bgz" "bz2" "gz" "lzh" "taz" "tgz" "zip" "z")) + "\\)$") + "Regexp to match compressed file names." + :type 'regexp + :group 'ibuffer) + (defcustom ibuffer-hook nil "Hook run when `ibuffer' is called." :type 'hook :group 'ibuffer) -(defvaralias 'ibuffer-hooks 'ibuffer-hook) +(define-obsolete-variable-alias 'ibuffer-hooks + 'ibuffer-hook "22.1") (defcustom ibuffer-mode-hook nil "Hook run upon entry into `ibuffer-mode'." :type 'hook :group 'ibuffer) -(defvaralias 'ibuffer-mode-hooks 'ibuffer-mode-hook) +(define-obsolete-variable-alias 'ibuffer-mode-hooks + 'ibuffer-mode-hook "22.1") (defcustom ibuffer-load-hook nil "Hook run when Ibuffer is loaded." @@ -384,6 +415,7 @@ directory, like `default-directory'." (define-key map (kbd "* /") 'ibuffer-mark-dired-buffers) (define-key map (kbd "* e") 'ibuffer-mark-dissociated-buffers) (define-key map (kbd "* h") 'ibuffer-mark-help-buffers) + (define-key map (kbd "* z") 'ibuffer-mark-compressed-file-buffers) (define-key map (kbd ".") 'ibuffer-mark-old-buffers) (define-key map (kbd "d") 'ibuffer-mark-for-delete) @@ -699,6 +731,9 @@ directory, like `default-directory'." (define-key-after map [menu-bar mark mark-help-buffers] '(menu-item "Mark help buffers" ibuffer-mark-help-buffers :help "Mark buffers in help-mode")) + (define-key-after map [menu-bar mark mark-compressed-file-buffers] + '(menu-item "Mark compressed file buffers" ibuffer-mark-compressed-file-buffers + :help "Mark buffers which have a file that is compressed")) (define-key-after map [menu-bar mark mark-old-buffers] '(menu-item "Mark old buffers" ibuffer-mark-old-buffers :help "Mark buffers which have not been viewed recently")) @@ -794,6 +829,21 @@ directory, like `default-directory'." (define-key map (kbd "RET") 'ibuffer-interactive-filter-by-mode) map)) +(defvar ibuffer-name-header-map + (let ((map (make-sparse-keymap))) + (define-key map [(mouse-1)] 'ibuffer-do-sort-by-alphabetic) + map)) + +(defvar ibuffer-size-header-map + (let ((map (make-sparse-keymap))) + (define-key map [(mouse-1)] 'ibuffer-do-sort-by-size) + map)) + +(defvar ibuffer-mode-header-map + (let ((map (make-sparse-keymap))) + (define-key map [(mouse-1)] 'ibuffer-do-sort-by-major-mode) + map)) + (defvar ibuffer-mode-filter-group-map (let ((map (make-sparse-keymap))) (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark) @@ -810,6 +860,11 @@ directory, like `default-directory'." (defvar ibuffer-did-modification nil) +(defvar ibuffer-compiled-formats nil) +(defvar ibuffer-cached-formats nil) +(defvar ibuffer-cached-eliding-string nil) +(defvar ibuffer-cached-elide-long-columns 0) + (defvar ibuffer-sorting-functions-alist nil "An alist of functions which describe how to sort buffers. @@ -838,7 +893,7 @@ width and the longest string in LIST." (while list (dotimes (i (1- columns)) (insert (concat (car list) (make-string (- max (length (car list))) - ? ))) + ?\s))) (setq list (cdr list))) (when (not (null list)) (insert (pop list))) @@ -861,7 +916,7 @@ width and the longest string in LIST." (let ((mark (ibuffer-current-mark))) (setq buffer-read-only nil) (if (eq mark ibuffer-marked-char) - (ibuffer-set-mark ? ) + (ibuffer-set-mark ?\s) (ibuffer-set-mark ibuffer-marked-char))))) (setq buffer-read-only t))) @@ -1153,7 +1208,7 @@ a new window in the current frame, splitting vertically." (if all (ibuffer-map-lines-nomodify #'(lambda (buf mark) - (not (char-equal mark ? )))) + (not (char-equal mark ?\s)))) (ibuffer-map-lines-nomodify #'(lambda (buf mark) (char-equal mark ibuffer-marked-char))))) @@ -1227,18 +1282,18 @@ a new window in the current frame, splitting vertically." ((char-equal mark ibuffer-marked-char) (ibuffer-map-marked-lines #'(lambda (buf mark) - (ibuffer-set-mark-1 ? ) + (ibuffer-set-mark-1 ?\s) t))) ((char-equal mark ibuffer-deletion-char) (ibuffer-map-deletion-lines #'(lambda (buf mark) - (ibuffer-set-mark-1 ? ) + (ibuffer-set-mark-1 ?\s) t))) (t (ibuffer-map-lines #'(lambda (buf mark) - (when (not (char-equal mark ? )) - (ibuffer-set-mark-1 ? )) + (when (not (char-equal mark ?\s)) + (ibuffer-set-mark-1 ?\s)) t))))) (ibuffer-redisplay t)) @@ -1255,9 +1310,9 @@ group." (ibuffer-map-lines #'(lambda (buf mark) (cond ((eq mark ibuffer-marked-char) - (ibuffer-set-mark-1 ? ) + (ibuffer-set-mark-1 ?\s) nil) - ((eq mark ? ) + ((eq mark ?\s) (ibuffer-set-mark-1 ibuffer-marked-char) t) (t @@ -1276,13 +1331,13 @@ If point is on a group name, this function operates on that group." "Unmark the buffer on this line, and move forward ARG lines. If point is on a group name, this function operates on that group." (interactive "P") - (ibuffer-mark-interactive arg ? 1)) + (ibuffer-mark-interactive arg ?\s 1)) (defun ibuffer-unmark-backward (arg) "Unmark the buffer on this line, and move backward ARG lines. If point is on a group name, this function operates on that group." (interactive "P") - (ibuffer-mark-interactive arg ? -1)) + (ibuffer-mark-interactive arg ?\s -1)) (defun ibuffer-mark-interactive (arg mark movement) (assert (eq major-mode 'ibuffer-mode)) @@ -1390,7 +1445,7 @@ If point is on a group name, this function operates on that group." (defun ibuffer-compile-make-eliding-form (strvar elide from-end-p) (let ((ellipsis (propertize ibuffer-eliding-string 'font-lock-face 'bold))) - (if (or elide ibuffer-elide-long-columns) + (if (or elide (with-no-warnings ibuffer-elide-long-columns)) `(if (> strlen 5) ,(if from-end-p `(concat ,ellipsis @@ -1409,8 +1464,8 @@ If point is on a group name, this function operates on that group." `(substring ,strvar 0 ,maxvar))) (defun ibuffer-compile-make-format-form (strvar widthform alignment) - (let* ((left `(make-string tmp2 ? )) - (right `(make-string (- tmp1 tmp2) ? ))) + (let* ((left `(make-string tmp2 ?\s)) + (right `(make-string (- tmp1 tmp2) ?\s))) `(progn (setq tmp1 ,widthform tmp2 (/ tmp1 2)) @@ -1563,11 +1618,6 @@ If point is on a group name, this function operates on that group." '(tmp2))) ,@(nreverse result)))))))) -(defvar ibuffer-compiled-formats nil) -(defvar ibuffer-cached-formats nil) -(defvar ibuffer-cached-eliding-string nil) -(defvar ibuffer-cached-elide-long-columns 0) - (defun ibuffer-recompile-formats () "Recompile `ibuffer-formats'." (interactive) @@ -1599,7 +1649,7 @@ If point is on a group name, this function operates on that group." (not (equal ibuffer-cached-eliding-string ibuffer-eliding-string)) (eql 0 ibuffer-cached-elide-long-columns) (not (eql ibuffer-cached-elide-long-columns - ibuffer-elide-long-columns)) + (with-no-warnings ibuffer-elide-long-columns))) (and ext-loaded (not (eq ibuffer-cached-filter-formats ibuffer-filter-format-alist)) @@ -1609,7 +1659,7 @@ If point is on a group name, this function operates on that group." (ibuffer-recompile-formats) (setq ibuffer-cached-formats ibuffer-formats ibuffer-cached-eliding-string ibuffer-eliding-string - ibuffer-cached-elide-long-columns ibuffer-elide-long-columns) + ibuffer-cached-elide-long-columns (with-no-warnings ibuffer-elide-long-columns)) (when ext-loaded (setq ibuffer-cached-filter-formats ibuffer-filter-format-alist)) (message "Formats have changed, recompiling...done")))) @@ -1631,6 +1681,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column name (:inline t + :header-mouse-map ibuffer-name-header-map :props ('mouse-face 'highlight 'keymap ibuffer-name-map 'ibuffer-name-column t @@ -1647,6 +1698,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column size (:inline t + :header-mouse-map ibuffer-size-header-map :summarizer (lambda (column-strings) (let ((total 0)) @@ -1660,6 +1712,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column mode (:inline t + :header-mouse-map ibuffer-mode-header-map :props ('mouse-face 'highlight 'keymap ibuffer-mode-name-map @@ -1690,7 +1743,7 @@ If point is on a group name, this function operates on that group." (and (boundp 'dired-directory) (if (stringp dired-directory) dired-directory - (car dired-directory))) + (car dired-directory))) "")))) (define-ibuffer-column filename-and-process @@ -1724,8 +1777,8 @@ If point is on a group name, this function operates on that group." filename))) (defun ibuffer-format-column (str width alignment) - (let ((left (make-string (/ width 2) ? )) - (right (make-string (- width (/ width 2)) ? ))) + (let ((left (make-string (/ width 2) ?\s)) + (right (make-string (- width (/ width 2)) ?\s))) (case alignment (:right (concat left right str)) (:center (concat left str right)) @@ -1881,7 +1934,7 @@ the value of point at the beginning of the line for that buffer." (mapcar #'(lambda (buf) (let ((e (assq buf bufs))) (if e e - (cons buf ? )))) + (cons buf ?\s)))) curbufs))) (defun ibuffer-buf-matches-predicates (buf predicates) @@ -1974,12 +2027,18 @@ the value of point at the beginning of the line for that buffer." (setq min (- min))) (let* ((name (or (get sym 'ibuffer-column-name) (error "Unknown column %s in ibuffer-formats" sym))) - (len (length name))) - (if (< len min) - (ibuffer-format-column name - (- min len) - align) - name)))))) + (len (length name)) + (hmap (get sym 'header-mouse-map)) + (strname (if (< len min) + (ibuffer-format-column name + (- min len) + align) + name))) + (when hmap + (setq + strname + (propertize strname 'mouse-face 'highlight 'keymap hmap))) + strname))))) (add-text-properties opos (point) `(ibuffer-title-header t)) (insert "\n") ;; Add the underlines @@ -1989,10 +2048,10 @@ the value of point at the beginning of the line for that buffer." (buffer-substring (point) (line-end-position))))) (apply #'insert (mapcar #'(lambda (c) - (if (not (or (char-equal c ? ) + (if (not (or (char-equal c ?\s) (char-equal c ?\n))) ?- - ? )) + ?\s)) str))) (insert "\n")) (point)) @@ -2011,7 +2070,7 @@ the value of point at the beginning of the line for that buffer." (dolist (element format) (insert (if (stringp element) - (make-string (length element) ? ) + (make-string (length element) ?\s) (let ((sym (car element))) (let ((min (cadr element)) ;; (max (caddr element)) @@ -2023,7 +2082,7 @@ the value of point at the beginning of the line for that buffer." (funcall (get sym 'ibuffer-column-summarizer) (get sym 'ibuffer-column-summary)) (make-string (length (get sym 'ibuffer-column-name)) - ? ))) + ?\s))) (len (length summary))) (if (< len min) (ibuffer-format-column summary @@ -2241,22 +2300,22 @@ buffers which are visiting a file." ;;;###autoload (defun ibuffer (&optional other-window-p name qualifiers noselect shrink filter-groups formats) - "Begin using `ibuffer' to edit a list of buffers. + "Begin using Ibuffer to edit a list of buffers. Type 'h' after entering ibuffer for more information. -Optional argument OTHER-WINDOW-P says to use another window. -Optional argument NAME specifies the name of the buffer; it defaults -to \"*Ibuffer*\". -Optional argument QUALIFIERS is an initial set of filtering qualifiers -to use; see `ibuffer-filtering-qualifiers'. -Optional argument NOSELECT means don't select the Ibuffer buffer. -Optional argument SHRINK means shrink the buffer to minimal size. The -special value `onewindow' means always use another window. -Optional argument FILTER-GROUPS is an initial set of filtering -groups to use; see `ibuffer-filter-groups'. -Optional argument FORMATS is the value to use for `ibuffer-formats'. -If specified, then the variable `ibuffer-formats' will have that value -locally in this buffer." +All arguments are optional. +OTHER-WINDOW-P says to use another window. +NAME specifies the name of the buffer (defaults to \"*Ibuffer*\"). +QUALIFIERS is an initial set of filtering qualifiers to use; + see `ibuffer-filtering-qualifiers'. +NOSELECT means don't select the Ibuffer buffer. +SHRINK means shrink the buffer to minimal size. The special + value `onewindow' means always use another window. +FILTER-GROUPS is an initial set of filtering groups to use; + see `ibuffer-filter-groups'. +FORMATS is the value to use for `ibuffer-formats'. + If specified, then the variable `ibuffer-formats' will have + that value locally in this buffer." (interactive "P") (when ibuffer-use-other-window (setq other-window-p t)) @@ -2269,7 +2328,7 @@ locally in this buffer." (save-selected-window ;; We switch to the buffer's window in order to be able ;; to modify the value of point - (select-window (get-buffer-window buf)) + (select-window (get-buffer-window buf 0)) (or (eq major-mode 'ibuffer-mode) (ibuffer-mode)) (setq ibuffer-restore-window-config-on-quit other-window-p) @@ -2297,7 +2356,7 @@ locally in this buffer." (put 'ibuffer-mode 'mode-class 'special) (defun ibuffer-mode () "A major mode for viewing a list of buffers. -In ibuffer, you can conveniently perform many operations on the +In Ibuffer, you can conveniently perform many operations on the currently open buffers, in addition to filtering your view to a particular subset of them, and sorting by various criteria.