X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0d30b33766e277a5bff6eabc9da5afdaebd8b32a..78df961d5989299fc8e663fd83a33ea65256efdd:/lisp/ibuffer.el diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 8e32c6bc7c..7c6da00cf0 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1,7 +1,7 @@ ;;; ibuffer.el --- operate on buffers like dired ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Colin Walters ;; Maintainer: John Paul Wallington @@ -12,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 @@ -40,6 +40,28 @@ (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) + +(declare-function ibuffer-mark-on-buffer "ibuf-ext" + (func &optional ibuffer-mark-on-buffer-mark group)) +(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier)) +(declare-function ibuffer-generate-filter-groups "ibuf-ext" + (bmarklist &optional noempty nodefault)) +(declare-function ibuffer-format-filter-group-data "ibuf-ext" (filter)) + (defgroup ibuffer nil "An advanced replacement for `buffer-menu'. @@ -51,7 +73,7 @@ the ability to filter the displayed buffers by various criteria." (defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) " " (size 9 -1 :right) - " " (mode 16 16 :right :elide) " " filename-and-process) + " " (mode 16 16 :left :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) "A list of ways to display buffer lines. @@ -127,12 +149,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 @@ -183,6 +209,7 @@ view of the buffers." :type '(choice (const :tag "Last view time" :value recency) (const :tag "Lexicographic" :value alphabetic) (const :tag "Buffer size" :value size) + (const :tag "File name" :value filename/process) (const :tag "Major mode" :value major-mode)) :group 'ibuffer) (defvar ibuffer-sorting-mode nil) @@ -305,6 +332,12 @@ directory, like `default-directory'." :type '(repeat function) :group 'ibuffer) +(defcustom ibuffer-compressed-file-name-regexp + "\\.\\(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 @@ -388,6 +421,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) @@ -414,6 +448,7 @@ directory, like `default-directory'." (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic) (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency) (define-key map (kbd "s s") 'ibuffer-do-sort-by-size) + (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process) (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) @@ -703,6 +738,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")) @@ -792,12 +830,32 @@ directory, like `default-directory'." (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) map)) +(defvar ibuffer-filename/process-header-map + (let ((map (make-sparse-keymap))) + (define-key map [(mouse-1)] 'ibuffer-do-sort-by-filename/process) + 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) 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) @@ -814,6 +872,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. @@ -1336,7 +1399,7 @@ If point is on a group name, this function operates on that group." (when must-be-live (if (bufferp buf) (unless (buffer-live-p buf) - (error (substitute-command-keys "Buffer %s has been killed; use `\\[ibuffer-update]' to update") buf)) + (error "Buffer %s has been killed; %s" buf (substitute-command-keys "use `\\[ibuffer-update]' to update"))) (error "No buffer on this line"))) buf)) @@ -1394,7 +1457,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 @@ -1567,11 +1630,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) @@ -1603,7 +1661,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)) @@ -1613,7 +1671,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")))) @@ -1635,6 +1693,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 @@ -1651,6 +1710,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)) @@ -1664,11 +1724,12 @@ 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 'help-echo "mouse-2: filter by this mode")) - (format "%s" mode-name)) + (format-mode-line mode-name nil nil (current-buffer))) (define-ibuffer-column process (:summarizer @@ -1699,6 +1760,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column filename-and-process (:name "Filename/Process" + :header-mouse-map ibuffer-filename/process-header-map :summarizer (lambda (strings) (setq strings (delete "" strings)) @@ -1788,7 +1850,7 @@ If point is on a group name, this function operates on that group." (defun ibuffer-map-lines (function &optional nomodify group) "Call FUNCTION for each buffer. -Don't set the ibuffer modification flag iff NOMODIFY is non-nil. +Set the ibuffer modification flag unless NOMODIFY is non-nil. If optional argument GROUP is non-nil, then only call FUNCTION on buffers in filtering group GROUP. @@ -1925,12 +1987,12 @@ the value of point at the beginning of the line for that buffer." (not (eq ibuffer-buf buf)))))) ;; This function is a special case; it's not defined by -;; `ibuffer-define-sorter'. +;; `define-ibuffer-sorter'. (defun ibuffer-do-sort-by-recency () "Sort the buffers by last view time." (interactive) (setq ibuffer-sorting-mode 'recency) - (ibuffer-redisplay t)) + (ibuffer-update nil t)) (defun ibuffer-update-format () (when (null ibuffer-current-format) @@ -1978,12 +2040,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 @@ -2037,29 +2105,6 @@ the value of point at the beginning of the line for that buffer." (point)) `(ibuffer-summary t))))) -(defun ibuffer-update-mode-name () - (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode - ibuffer-sorting-mode - "view time"))) - (when ibuffer-sorting-reversep - (setq mode-name (concat mode-name " [rev]"))) - (when (and (featurep 'ibuf-ext) - ibuffer-auto-mode) - (setq mode-name (concat mode-name " (Auto)"))) - (let ((result "")) - (when (featurep 'ibuf-ext) - (dolist (qualifier ibuffer-filtering-qualifiers) - (setq result - (concat result (ibuffer-format-qualifier qualifier)))) - (if ibuffer-use-header-line - (setq header-line-format - (when ibuffer-filtering-qualifiers - (replace-regexp-in-string "%" "%%" - (concat mode-name result)))) - (progn - (setq mode-name (concat mode-name result)) - (when (boundp 'header-line-format) - (setq header-line-format nil))))))) (defun ibuffer-redisplay (&optional silent) "Redisplay the current list of buffers. @@ -2077,7 +2122,6 @@ If optional arg SILENT is non-nil, do not display progress messages." (message "No buffers! (note: filtering in effect)") (error "No buffers!"))) (ibuffer-redisplay-engine blist t) - (ibuffer-update-mode-name) (unless silent (message "Redisplaying current buffer list...done")) (ibuffer-forward-line 0))) @@ -2114,7 +2158,6 @@ If optional arg SILENT is non-nil, do not display progress messages." (unless silent (message "Updating buffer list...")) (ibuffer-redisplay-engine blist arg) - (ibuffer-update-mode-name) (unless silent (message "Updating buffer list...done"))) (if (eq ibuffer-shrink-to-minimum-size 'onewindow) @@ -2214,7 +2257,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (defun ibuffer-quit () "Quit this `ibuffer' session. -Try to restore the previous window configuration iff +Try to restore the previous window configuration if `ibuffer-restore-window-config-on-quit' is non-nil." (interactive) (if ibuffer-restore-window-config-on-quit @@ -2273,7 +2316,7 @@ FORMATS is the value to use for `ibuffer-formats'. (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) @@ -2398,16 +2441,20 @@ Sorting commands: '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. '\\[ibuffer-invert-sorting]' - Reverse the current sorting order. '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. + '\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name. '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. Other commands: + '\\[ibuffer-update]' - Regenerate the list of all buffers. + Prefix arg means to toggle whether buffers that match + `ibuffer-maybe-show-predicates' should be displayed. + '\\[ibuffer-switch-format]' - Change the current display format. '\\[forward-line]' - Move point to the next line. '\\[previous-line]' - Move point to the previous line. - '\\[ibuffer-update]' - As above, but add new buffers to the list. '\\[ibuffer-quit]' - Bury the Ibuffer buffer. '\\[describe-mode]' - This help. '\\[ibuffer-diff-with-file]' - View the differences between this buffer @@ -2477,6 +2524,28 @@ will be inserted before the group at point." (use-local-map ibuffer-mode-map) (setq major-mode 'ibuffer-mode) (setq mode-name "Ibuffer") + ;; Include state info next to the mode name. + (set (make-local-variable 'mode-line-process) + '(" by " + (ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode)) + "view time") + (ibuffer-sorting-reversep " [rev]") + (ibuffer-auto-mode " (Auto)") + ;; Only list the filters if they're not already in the header-line. + (header-line-format + "" + (:eval (if (functionp 'ibuffer-format-qualifier) + (mapconcat 'ibuffer-format-qualifier + ibuffer-filtering-qualifiers "")))))) + (setq header-line-format + (if ibuffer-use-header-line + ;; Display the part that won't be in the mode-line. + (list* "" mode-name + (mapcar (lambda (elem) + (if (eq (car-safe elem) 'header-line-format) + (nth 2 elem) elem)) + mode-line-process)))) + (setq buffer-read-only t) (buffer-disable-undo) (setq truncate-lines ibuffer-truncate-lines) @@ -2515,9 +2584,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-mode-hooks 'ibuffer-mode-hook) - ;; called after mode hooks to allow the user to add filters - (ibuffer-update-mode-name)) + (run-mode-hooks 'ibuffer-mode-hook)) (provide 'ibuffer) @@ -2527,5 +2594,5 @@ will be inserted before the group at point." ;; coding: iso-8859-1 ;; End: -;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 +;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 ;;; ibuffer.el ends here