X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7ad5b902577a752358dd6c8fdf9f0c1a17c1d3f9..aaed846c01c90115574a8098dd1636ef1c866ab6:/lisp/ibuffer.el diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 03722a80aa..f2ebb5db32 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1,9 +1,9 @@ ;;; ibuffer.el --- operate on buffers like dired -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Colin Walters -;; Maintainer: John Paul Wallington +;; Maintainer: John Paul Wallington ;; Created: 8 Sep 2000 ;; Keywords: buffer, convenience @@ -37,17 +37,7 @@ (require 'ibuf-macs) (require 'dired)) -(require 'font-lock) - -;;; Compatibility -(eval-and-compile - (if (fboundp 'window-list) - (defun ibuffer-window-list () - (window-list nil 'nomini)) - (defun ibuffer-window-list () - (let ((ibuffer-window-list-result nil)) - (walk-windows #'(lambda (win) (push win ibuffer-window-list-result)) 'nomini) - (nreverse ibuffer-window-list-result))))) +(require 'font-core) (defgroup ibuffer nil "An advanced replacement for `buffer-menu'. @@ -55,10 +45,11 @@ Ibuffer allows you to operate on buffers in a manner much like Dired. Operations include sorting, marking by regular expression, and the ability to filter the displayed buffers by various criteria." + :version "22.1" :group 'convenience) -(defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide) - " " (size 6 -1 :right) +(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) + " " (size 9 -1 :right) " " (mode 16 16 :right :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) "A list of ways to display buffer lines. @@ -148,7 +139,7 @@ buffer, and FACE is the face to use for fontification. If the FORM evaluates to non-nil, then FACE will be put on the buffer name. The element with the highest PRIORITY takes precedence. -If you change this variable, you must kill the ibuffer buffer and +If you change this variable, you must kill the Ibuffer buffer and recreate it for the change to take effect." :type '(repeat (list (integer :tag "Priority") @@ -167,6 +158,11 @@ recreate it for the change to take effect." :group 'ibuffer) (defvar ibuffer-shrink-to-minimum-size nil) +(defcustom ibuffer-display-summary t + "If non-nil, summarize Ibuffer columns." + :type 'boolean + :group 'ibuffer) + (defcustom ibuffer-truncate-lines t "If non-nil, do not display continuation lines." :type 'boolean @@ -180,8 +176,8 @@ recreate it for the change to take effect." (defcustom ibuffer-default-sorting-mode 'recency "The criteria by which to sort the buffers. -Note that this variable is local to each ibuffer buffer. Thus, you -can have multiple ibuffer buffers open, each with a different sorted +Note that this variable is local to each Ibuffer buffer. Thus, you +can have multiple Ibuffer buffers open, each with a different sorted view of the buffers." :type '(choice (const :tag "Last view time" :value recency) (const :tag "Lexicographic" :value alphabetic) @@ -211,17 +207,27 @@ This variable is deprecated; use the :elide argument of (defcustom ibuffer-maybe-show-predicates `(,(lambda (buf) (and (string-match "^ " (buffer-name buf)) (null buffer-file-name)))) - "A list of predicates (a regexp or function) for buffers to display conditionally. + "A list of predicates for buffers to display conditionally. + +A predicate can be a regexp or a function. 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 be shown. -Viewing of buffers hidden because of these predicates is enabled by -giving a non-nil prefix argument to `ibuffer-update'. Note that this -specialized filtering occurs before real filtering." +Viewing of buffers hidden because of these predicates may be customized +via `ibuffer-default-display-maybe-show-predicates' and is toggled by +giving a non-nil prefix argument to `ibuffer-update'. +Note that this specialized filtering occurs before real filtering." :type '(repeat (choice regexp function)) :group 'ibuffer) +(defcustom ibuffer-default-display-maybe-show-predicates nil + "Non-nil means show buffers that match `ibuffer-maybe-show-predicates'." + :type 'boolean + :group 'ibuffer) + +(defvar ibuffer-display-maybe-show-predicates nil) + (defvar ibuffer-current-format nil) (defcustom ibuffer-movement-cycle t @@ -263,21 +269,27 @@ state, size, etc." :group 'ibuffer) (defcustom ibuffer-always-show-last-buffer nil - "If non-nil, always display the previous buffer. This variable -takes precedence over filtering, and even + "If non-nil, always display the previous buffer. +This variable takes precedence over filtering, and even `ibuffer-never-show-predicates'." :type '(choice (const :tag "Always" :value t) (const :tag "Never" :value nil) (const :tag "Always except minibuffer" :value :nomini)) :group 'ibuffer) +(defcustom ibuffer-jump-offer-only-visible-buffers nil + "If non-nil, only offer buffers visible in the Ibuffer buffer +in completion lists of the `ibuffer-jump-to-buffer' command." + :type 'boolean + :group 'ibuffer) + (defcustom ibuffer-use-header-line (boundp 'header-line-format) "If non-nil, display a header line containing current filters." :type 'boolean :group 'ibuffer) (defcustom ibuffer-default-directory nil - "The default directory to use for a new ibuffer buffer. + "The default directory to use for a new Ibuffer buffer. If nil, inherit the directory of the buffer in which `ibuffer' was called. Otherwise, this variable should be a string naming a directory, like `default-directory'." @@ -285,24 +297,29 @@ directory, like `default-directory'." string) :group 'ibuffer) -(defcustom ibuffer-help-buffer-modes '(help-mode apropos-mode - Info-mode Info-edit-mode) +(defcustom ibuffer-help-buffer-modes + '(help-mode apropos-mode Info-mode Info-edit-mode) "List of \"Help\" major modes." :type '(repeat function) :group 'ibuffer) (defcustom ibuffer-hook nil - "Hooks run when `ibuffer' is called." + "Hook run when `ibuffer' is called." :type 'hook :group 'ibuffer) (defvaralias 'ibuffer-hooks 'ibuffer-hook) (defcustom ibuffer-mode-hook nil - "Hooks run upon entry into `ibuffer-mode'." + "Hook run upon entry into `ibuffer-mode'." :type 'hook :group 'ibuffer) (defvaralias 'ibuffer-mode-hooks 'ibuffer-mode-hook) +(defcustom ibuffer-load-hook nil + "Hook run when Ibuffer is loaded." + :type 'hook + :group 'ibuffer) + (defcustom ibuffer-marked-face 'font-lock-warning-face "Face used for displaying marked buffers." :type 'face @@ -331,6 +348,7 @@ directory, like `default-directory'." (regexp :tag "To"))) :group 'ibuffer) + (defvar ibuffer-mode-map nil) (defvar ibuffer-mode-operate-map nil) (defvar ibuffer-mode-groups-popup nil) @@ -354,6 +372,7 @@ directory, like `default-directory'." (define-key map (kbd "u") 'ibuffer-unmark-forward) (define-key map (kbd "=") 'ibuffer-diff-with-file) (define-key map (kbd "j") 'ibuffer-jump-to-buffer) + (define-key map (kbd "M-g") 'ibuffer-jump-to-buffer) (define-key map (kbd "DEL") 'ibuffer-unmark-backward) (define-key map (kbd "M-DEL") 'ibuffer-unmark-all) (define-key map (kbd "* *") 'ibuffer-unmark-all) @@ -366,12 +385,12 @@ directory, like `default-directory'." (define-key map (kbd "* e") 'ibuffer-mark-dissociated-buffers) (define-key map (kbd "* h") 'ibuffer-mark-help-buffers) (define-key map (kbd ".") 'ibuffer-mark-old-buffers) - + (define-key map (kbd "d") 'ibuffer-mark-for-delete) (define-key map (kbd "C-d") 'ibuffer-mark-for-delete-backwards) (define-key map (kbd "k") 'ibuffer-mark-for-delete) (define-key map (kbd "x") 'ibuffer-do-kill-on-deletion-marks) - + ;; immediate operations (define-key map (kbd "n") 'ibuffer-forward-line) (define-key map (kbd "") 'ibuffer-forward-line) @@ -427,7 +446,7 @@ directory, like `default-directory'." (define-key map (kbd "/ R") 'ibuffer-switch-to-saved-filter-groups) (define-key map (kbd "/ X") 'ibuffer-delete-saved-filter-groups) (define-key map (kbd "/ \\") 'ibuffer-clear-filter-groups) - + (define-key map (kbd "q") 'ibuffer-quit) (define-key map (kbd "h") 'describe-mode) (define-key map (kbd "?") 'describe-mode) @@ -435,7 +454,7 @@ directory, like `default-directory'." (define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp) (define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp) (define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp) - + (define-key map (kbd "C-t") 'ibuffer-visit-tags-table) (define-key map (kbd "|") 'ibuffer-do-shell-command-pipe) @@ -460,7 +479,7 @@ directory, like `default-directory'." (define-key map (kbd "V") 'ibuffer-do-revert) (define-key map (kbd "W") 'ibuffer-do-view-and-eval) (define-key map (kbd "X") 'ibuffer-do-shell-command-pipe) - + (define-key map (kbd "k") 'ibuffer-do-kill-lines) (define-key map (kbd "w") 'ibuffer-copy-filename-as-kill) @@ -509,6 +528,8 @@ directory, like `default-directory'." (define-key-after map [menu-bar view sort do-sort-by-recency] '(menu-item "Sort by view time" ibuffer-do-sort-by-recency :help "Sort by the last time the buffer was displayed")) + (define-key-after map [menu-bar view sort dashes] + '("--")) (define-key-after map [menu-bar view sort invert-sorting] '(menu-item "Reverse sorting order" ibuffer-invert-sorting)) (define-key-after map [menu-bar view sort toggle-sorting-mode] @@ -558,7 +579,7 @@ directory, like `default-directory'." (cdr ibuffer-filtering-qualifiers)))) (define-key-after map [menu-bar view filter save-filters] '(menu-item "Save current filters permanently..." ibuffer-save-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) :help "Use a mnemnonic name to store current filter stack")) (define-key-after map [menu-bar view filter switch-to-saved-filters] '(menu-item "Restore permanently saved filters..." ibuffer-switch-to-saved-filters @@ -581,7 +602,7 @@ directory, like `default-directory'." :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) (define-key-after groups-map [forward-filter-group] '(menu-item "Move point to the next filter group" - ibuffer-forward-filter-group)) + ibuffer-forward-filter-group)) (define-key-after groups-map [backward-filter-group] '(menu-item "Move point to the previous filter group" ibuffer-backward-filter-group)) @@ -618,7 +639,7 @@ directory, like `default-directory'." '(menu-item "Restore permanently saved filters..." ibuffer-switch-to-saved-filter-groups :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups) - :help "Replace current filters with a saved stack")) + :help "Replace current filters with a saved stack")) (define-key-after groups-map [delete-saved-filter-groups] '(menu-item "Delete permanently saved filter groups..." ibuffer-delete-saved-filter-groups @@ -639,8 +660,7 @@ directory, like `default-directory'." '(menu-item "Toggle Auto Mode" ibuffer-auto-mode :help "Attempt to automatically update the Ibuffer buffer")) (define-key-after map [menu-bar view customize] - '(menu-item "Customize Ibuffer" (lambda () (interactive) - (customize-group 'ibuffer)) + '(menu-item "Customize Ibuffer" ibuffer-customize :help "Use Custom to customize Ibuffer")) (define-key-after map [menu-bar mark] @@ -684,10 +704,10 @@ directory, like `default-directory'." :help "Mark buffers which have not been viewed recently")) (define-key-after map [menu-bar mark unmark-all] '(menu-item "Unmark All" ibuffer-unmark-all)) - + (define-key-after map [menu-bar mark dashes] '("--")) - + (define-key-after map [menu-bar mark mark-by-name-regexp] '(menu-item "Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp :help "Mark buffers whose name matches a regexp")) @@ -745,46 +765,48 @@ directory, like `default-directory'." (define-key-after operate-map [do-view-and-eval] '(menu-item "Eval (viewing buffer)..." ibuffer-do-view-and-eval :help "Evaluate a Lisp form in each marked buffer while viewing it")) - + (setq ibuffer-mode-map map ibuffer-mode-operate-map operate-map ibuffer-mode-groups-popup (copy-keymap groups-map)))) (define-key ibuffer-mode-groups-popup [kill-filter-group] - '(menu-item "Kill filter group" - ibuffer-kill-line - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) + '(menu-item "Kill filter group" + ibuffer-kill-line + :enable (and (featurep 'ibuf-ext) + ibuffer-filter-groups))) (define-key ibuffer-mode-groups-popup [yank-filter-group] - '(menu-item "Yank last killed filter group" - ibuffer-yank - :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring))) - -(defvar ibuffer-name-map nil) -(unless ibuffer-name-map + '(menu-item "Yank last killed filter group" + ibuffer-yank + :enable (and (featurep 'ibuf-ext) + ibuffer-filter-group-kill-ring))) + +(defvar ibuffer-name-map (let ((map (make-sparse-keymap))) (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark) (define-key map [(mouse-2)] 'ibuffer-mouse-visit-buffer) (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) - (setq ibuffer-name-map map))) + map)) -(defvar ibuffer-mode-name-map nil) -(unless ibuffer-mode-name-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) - (setq ibuffer-mode-name-map map))) + map)) -(defvar ibuffer-mode-filter-group-map nil) -(unless ibuffer-mode-filter-group-map +(defvar ibuffer-mode-filter-group-map (let ((map (make-sparse-keymap))) (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark) (define-key map [(mouse-2)] 'ibuffer-mouse-toggle-filter-group) (define-key map (kbd "RET") 'ibuffer-toggle-filter-group) (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) - (setq ibuffer-mode-filter-group-map map))) + map)) + +(defvar ibuffer-restore-window-config-on-quit nil + "If non-nil, restore previous window configuration upon exiting `ibuffer'.") -(defvar ibuffer-delete-window-on-quit nil - "Whether or not to delete the window upon exiting `ibuffer'.") +(defvar ibuffer-prev-window-config nil + "Window configuration before starting Ibuffer.") (defvar ibuffer-did-modification nil) @@ -852,8 +874,8 @@ width and the longest string in LIST." default-directory) default-directory)))) (list (read-file-name "Find file: " default-directory) - current-prefix-arg))) - (find-file file (or wildcards (interactive-p)))) + t))) + (find-file file wildcards)) (defun ibuffer-mouse-visit-buffer (event) "Visit the buffer chosen with the mouse." @@ -875,15 +897,15 @@ width and the longest string in LIST." (popup-menu ibuffer-mode-groups-popup)) (let ((inhibit-read-only t)) (ibuffer-save-marks - ;; hm. we could probably do this in a better fashion - (ibuffer-unmark-all ?\r) - (save-excursion - (goto-char eventpt) - (ibuffer-set-mark ibuffer-marked-char)) - (save-excursion - (popup-menu ibuffer-mode-operate-map))))) + ;; hm. we could probably do this in a better fashion + (ibuffer-unmark-all ?\r) + (save-excursion + (goto-char eventpt) + (ibuffer-set-mark ibuffer-marked-char)) + (save-excursion + (popup-menu ibuffer-mode-operate-map))))) (setq buffer-read-only t) - (if (eq eventpt (point)) + (if (= eventpt (point)) (goto-char origpt))))) (defun ibuffer-skip-properties (props direction) @@ -895,18 +917,23 @@ width and the longest string in LIST." (forward-line direction) (beginning-of-line))) +(defun ibuffer-customize () + "Begin customizing Ibuffer interactively." + (interactive) + (customize-group 'ibuffer)) + (defun ibuffer-backward-line (&optional arg skip-group-names) "Move backwards ARG lines, wrapping around the list if necessary." (interactive "P") - (unless arg - (setq arg 1)) + (or arg (setq arg 1)) (beginning-of-line) (while (> arg 0) (forward-line -1) (when (and ibuffer-movement-cycle (or (get-text-property (point) 'ibuffer-title) (and skip-group-names - (get-text-property (point) 'ibuffer-filter-group-name)))) + (get-text-property (point) + 'ibuffer-filter-group-name)))) (goto-char (point-max)) (beginning-of-line)) (ibuffer-skip-properties (append '(ibuffer-summary) @@ -922,8 +949,7 @@ width and the longest string in LIST." (defun ibuffer-forward-line (&optional arg skip-group-names) "Move forward ARG lines, wrapping around the list if necessary." (interactive "P") - (unless arg - (setq arg 1)) + (or arg (setq arg 1)) (beginning-of-line) (when (and ibuffer-movement-cycle (or (eobp) @@ -1030,16 +1056,16 @@ a new window in the current frame, splitting vertically." (> (length marked-bufs) 3) (not (y-or-n-p (format "Really create a new frame for %s buffers? " (length marked-bufs))))) - (set-buffer-modified-p nil) + (set-buffer-modified-p nil) (delete-other-windows) (switch-to-buffer (pop marked-bufs)) (let ((height (/ (1- (if (eq type 'horizontally) (frame-width) - (frame-height))) + (frame-height))) (1+ (length marked-bufs))))) (mapcar (if (eq type 'other-frame) #'(lambda (buf) (let ((curframe (selected-frame))) - (select-frame (new-frame)) + (select-frame (make-frame)) (switch-to-buffer buf) (select-frame curframe))) #'(lambda (buf) @@ -1073,7 +1099,7 @@ a new window in the current frame, splitting vertically." (ibuffer-columnize-and-insert-list names) (goto-char (point-min)) (setq buffer-read-only t)) - (let ((lastwin (car (last (ibuffer-window-list))))) + (let ((lastwin (car (last (window-list nil 'nomini))))) ;; Now attempt to display the buffer... (save-window-excursion (select-window lastwin) @@ -1090,11 +1116,11 @@ a new window in the current frame, splitting vertically." ;; Handle a failure (if (or (> (incf attempts) 4) (and (stringp (cadr err)) - ;; This definitely falls in the ghetto hack category... + ;; This definitely falls in the + ;; ghetto hack category... (not (string-match "too small" (cadr err))))) (apply #'signal err) (enlarge-window 3)))))) - ;; This part doesn't work correctly sometimes under XEmacs. (select-window (next-window)) (switch-to-buffer buf) (unwind-protect @@ -1111,7 +1137,7 @@ a new window in the current frame, splitting vertically." (defun ibuffer-buffer-names-with-mark (mark) (let ((ibuffer-buffer-names-with-mark-result nil)) (ibuffer-map-lines-nomodify - #'(lambda (buf mk) + #'(lambda (buf mk) (when (char-equal mark mk) (push (buffer-name buf) ibuffer-buffer-names-with-mark-result)))) @@ -1260,14 +1286,13 @@ If point is on a group name, this function operates on that group." (defun ibuffer-mark-interactive (arg mark movement) (assert (eq major-mode 'ibuffer-mode)) - (unless arg - (setq arg 1)) + (or arg (setq arg 1)) (ibuffer-forward-line 0) (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name) (progn (require 'ibuf-ext) (ibuffer-mark-on-buffer #'identity mark it)) - (ibuffer-forward-line 0 t) + (ibuffer-forward-line 0 t) (let ((inhibit-read-only t)) (while (> arg 0) (ibuffer-set-mark mark) @@ -1334,35 +1359,35 @@ If point is on a group name, this function operates on that group." (if uncompiledp ibuffer-filter-format-alist ibuffer-compiled-filter-formats)))))) - + (defun ibuffer-current-format (&optional uncompiledp) (or ibuffer-current-format (setq ibuffer-current-format 0)) - (nth ibuffer-current-format (ibuffer-current-formats uncompiledp))) + (nth ibuffer-current-format (ibuffer-current-formats uncompiledp))) (defun ibuffer-expand-format-entry (form) (if (or (consp form) (symbolp form)) - (let ((sym (intern (concat "ibuffer-make-column-" - (symbol-name (if (consp form) - (car form) - form)))))) - (unless (or (fboundp sym) - (assq sym ibuffer-inline-columns)) - (error "Unknown column %s in ibuffer-formats" form)) - (let (min max align elide) - (if (consp form) - (setq min (or (nth 1 form) 0) - max (or (nth 2 form) -1) - align (or (nth 3 form) :left) - elide (or (nth 4 form) nil)) - (setq min 0 - max -1 - align :left - elide nil)) - (list sym min max align elide))) + (let ((sym (intern (concat "ibuffer-make-column-" + (symbol-name (if (consp form) + (car form) + form)))))) + (unless (or (fboundp sym) + (assq sym ibuffer-inline-columns)) + (error "Unknown column %s in ibuffer-formats" form)) + (let (min max align elide) + (if (consp form) + (setq min (or (nth 1 form) 0) + max (or (nth 2 form) -1) + align (or (nth 3 form) :left) + elide (or (nth 4 form) nil)) + (setq min 0 + max -1 + align :left + elide nil)) + (list sym min max align elide))) form)) - + (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) @@ -1385,7 +1410,7 @@ If point is on a group name, this function operates on that group." (defun ibuffer-compile-make-format-form (strvar widthform alignment) (let* ((left `(make-string tmp2 ? )) - (right `(make-string (- tmp1 tmp2) ? ))) + (right `(make-string (- tmp1 tmp2) ? ))) `(progn (setq tmp1 ,widthform tmp2 (/ tmp1 2)) @@ -1462,19 +1487,19 @@ If point is on a group name, this function operates on that group." ;; into our generated code. Otherwise, we just ;; generate a call to the column function. (ibuffer-aif (assq sym ibuffer-inline-columns) - (nth 1 it) - `(,sym buffer mark))) + (nth 1 it) + `(,sym buffer mark))) ;; You're not expected to understand this. Hell, I ;; don't even understand it, and I wrote it five ;; minutes ago. (insertgenfn (ibuffer-aif (get sym 'ibuffer-column-summarizer) - ;; I really, really wish Emacs Lisp had closures. - (lambda (arg sym) - `(insert - (let ((ret ,arg)) - (put ',sym 'ibuffer-column-summary - (cons ret (get ',sym 'ibuffer-column-summary))) - ret))) + ;; I really, really wish Emacs Lisp had closures. + (lambda (arg sym) + `(insert + (let ((ret ,arg)) + (put ',sym 'ibuffer-column-summary + (cons ret (get ',sym 'ibuffer-column-summary))) + ret))) (lambda (arg sym) `(insert ,arg)))) (mincompform `(< strlen ,(if (integerp min) @@ -1483,40 +1508,40 @@ If point is on a group name, this function operates on that group." (maxcompform `(> strlen ,(if (integerp max) max 'max)))) - (if (or min-used max-used) - ;; The complex case, where we have to limit the - ;; form to a maximum or minimum size. - (progn - (when (and min-used (not (integerp min))) - (push `(min ,min) letbindings)) - (when (and max-used (not (integerp max))) - (push `(max ,max) letbindings)) - (push - (if (and min-used max-used) - `(if ,mincompform - ,minform - (if ,maxcompform - ,maxform)) - (if min-used - `(when ,mincompform - ,minform) - `(when ,maxcompform - ,maxform))) - outforms) - (push (append - `(setq str ,callform) - (when strlen-used - `(strlen (length str)))) - outforms) - (setq outforms - (append outforms (list (funcall insertgenfn 'str sym))))) - ;; The simple case; just insert the string. - (push (funcall insertgenfn callform sym) outforms)) - ;; Finally, return a `let' form which binds the - ;; variables in `letbindings', and contains all the - ;; code in `outforms'. - `(let ,letbindings - ,@outforms))))) + (if (or min-used max-used) + ;; The complex case, where we have to limit the + ;; form to a maximum or minimum size. + (progn + (when (and min-used (not (integerp min))) + (push `(min ,min) letbindings)) + (when (and max-used (not (integerp max))) + (push `(max ,max) letbindings)) + (push + (if (and min-used max-used) + `(if ,mincompform + ,minform + (if ,maxcompform + ,maxform)) + (if min-used + `(when ,mincompform + ,minform) + `(when ,maxcompform + ,maxform))) + outforms) + (push (append + `(setq str ,callform) + (when strlen-used + `(strlen (length str)))) + outforms) + (setq outforms + (append outforms (list (funcall insertgenfn 'str sym))))) + ;; The simple case; just insert the string. + (push (funcall insertgenfn callform sym) outforms)) + ;; Finally, return a `let' form which binds the + ;; variables in `letbindings', and contains all the + ;; code in `outforms'. + `(let ,letbindings + ,@outforms))))) result)) (setq result ;; We don't want to unconditionally load the byte-compiler. @@ -1547,7 +1572,7 @@ If point is on a group name, this function operates on that group." "Recompile `ibuffer-formats'." (interactive) (setq ibuffer-compiled-formats - (mapcar #'ibuffer-compile-format ibuffer-formats)) + (mapcar #'ibuffer-compile-format ibuffer-formats)) (when (boundp 'ibuffer-filter-format-alist) (setq ibuffer-compiled-filter-formats (mapcar #'(lambda (entry) @@ -1562,7 +1587,7 @@ If point is on a group name, this function operates on that group." (ibuffer-awhen (and (consp form) (get (car form) 'ibuffer-column-summarizer)) (put (car form) 'ibuffer-column-summary nil)))) - + (defun ibuffer-check-formats () (when (null ibuffer-formats) (error "No formats!")) @@ -1596,7 +1621,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column read-only (:name "R" :inline t) (if buffer-read-only - "%" + (string ibuffer-read-only-char) " ")) (define-ibuffer-column modified (:name "M" :inline t) @@ -1604,29 +1629,61 @@ If point is on a group name, this function operates on that group." (string ibuffer-modified-char) " ")) -(define-ibuffer-column name (:inline t - :props - ('mouse-face 'highlight 'keymap ibuffer-name-map - 'ibuffer-name-column t - 'help-echo "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer")) +(define-ibuffer-column name + (:inline t + :props + ('mouse-face 'highlight 'keymap ibuffer-name-map + 'ibuffer-name-column t + 'help-echo '(if tooltip-mode + "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer" + "mouse-1: mark buffer mouse-2: select buffer mouse-3: operate")) + :summarizer + (lambda (strings) + (let ((bufs (length strings))) + (cond ((zerop bufs) "No buffers") + ((= 1 bufs) "1 buffer") + (t (format "%s buffers" bufs)))))) (propertize (buffer-name) 'font-lock-face (ibuffer-buffer-name-face buffer mark))) - -(define-ibuffer-column size (:inline t) + +(define-ibuffer-column size + (:inline t + :summarizer + (lambda (column-strings) + (let ((total 0)) + (dolist (string column-strings) + (setq total + ;; like, ewww ... + (+ (float (string-to-number string)) + total))) + (format "%.0f" total)))) (format "%s" (buffer-size))) -(define-ibuffer-column mode (:inline t - :props - ('mouse-face 'highlight - 'keymap ibuffer-mode-name-map - 'help-echo "mouse-2: filter by this mode")) +(define-ibuffer-column mode + (:inline t + :props + ('mouse-face 'highlight + 'keymap ibuffer-mode-name-map + 'help-echo "mouse-2: filter by this mode")) (format "%s" mode-name)) -(define-ibuffer-column process () +(define-ibuffer-column process + (:summarizer + (lambda (strings) + (let ((total (length (delete "" strings)))) + (cond ((zerop total) "No processes") + ((= 1 total) "1 process") + (t (format "%d processes" total)))))) (ibuffer-aif (get-buffer-process buffer) (format "(%s %s)" it (process-status it)) - "none")) - -(define-ibuffer-column filename () + "")) + +(define-ibuffer-column filename + (:summarizer + (lambda (strings) + (let ((total (length (delete "" strings)))) + (cond ((zerop total) "No files") + ((= 1 total) "1 file") + (t (format "%d files" total)))))) (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist)) (abbreviate-file-name (or buffer-file-name @@ -1634,13 +1691,34 @@ If point is on a group name, this function operates on that group." dired-directory) "")))) -(define-ibuffer-column filename-and-process (:name "Filename/Process") +(define-ibuffer-column filename-and-process + (:name "Filename/Process" + :summarizer + (lambda (strings) + (setq strings (delete "" strings)) + (let ((procs 0) + (files 0)) + (dolist (string strings) + (if (string-match "\\(\?:\\`(\[\[:ascii:\]\]\+)\\)" string) + (progn (setq procs (1+ procs)) + (if (< (match-end 0) (length string)) + (setq files (1+ files)))) + (setq files (1+ files)))) + (concat (cond ((zerop files) "No files") + ((= 1 files) "1 file") + (t (format "%d files" files))) + ", " + (cond ((zerop procs) "no processes") + ((= 1 procs) "1 process") + (t (format "%d processes" procs))))))) (let ((proc (get-buffer-process buffer)) (filename (ibuffer-make-column-filename buffer mark))) (if proc - (concat (propertize (format "(%s %s) " proc (process-status proc)) + (concat (propertize (format "(%s %s)" proc (process-status proc)) 'font-lock-face 'italic) - filename) + (if (> (length filename) 0) + (format " %s" filename) + "")) filename))) (defun ibuffer-format-column (str width alignment) @@ -1694,7 +1772,7 @@ If point is on a group name, this function operates on that group." (ibuffer-current-format))) (when ibuffer-shrink-to-minimum-size (ibuffer-shrink-to-fit))))))) - + (defun ibuffer-map-on-mark (mark func) (ibuffer-map-lines #'(lambda (buf mk) @@ -1709,8 +1787,8 @@ Don't set the ibuffer modification flag iff NOMODIFY is non-nil. If optional argument GROUP is non-nil, then only call FUNCTION on buffers in filtering group GROUP. - FUNCTION is called with four arguments: the buffer object itself, the -current mark symbol, and the beginning and ending line positions." +FUNCTION is called with two arguments: +the buffer object itself and the current mark symbol." (assert (eq major-mode 'ibuffer-mode)) (ibuffer-forward-line 0) (let* ((orig-target-line (1+ (count-lines (save-excursion @@ -1725,7 +1803,7 @@ current mark symbol, and the beginning and ending line positions." (progn (setq buffer-read-only nil) (goto-char (point-min)) - (ibuffer-forward-line 0 t) + (ibuffer-forward-line 0 t) (while (and (not (eobp)) (not (get-text-property (point) 'ibuffer-summary)) (progn @@ -1755,7 +1833,7 @@ current mark symbol, and the beginning and ending line positions." (1+ (line-end-position))) (incf ibuffer-map-lines-count) (when (< ibuffer-map-lines-total - orig-target-line) + orig-target-line) (decf target-line-offset))) (t (incf ibuffer-map-lines-count) @@ -1813,7 +1891,7 @@ the value of point at the beginning of the line for that buffer." (funcall pred buf)) (setq hit t))) hit)) - + (defun ibuffer-filter-buffers (ibuffer-buf last bmarklist all) (let ((ext-loaded (featurep 'ibuf-ext))) (delq nil @@ -1824,11 +1902,11 @@ the value of point at the beginning of the line for that buffer." (when ;; This takes precedence over anything else (or (and ibuffer-always-show-last-buffer - (eq last buf)) - (funcall (if ext-loaded - #'ibuffer-ext-visible-p - #'ibuffer-visible-p) - buf all ibuffer-buf)) + (eq last buf)) + (funcall (if ext-loaded + #'ibuffer-ext-visible-p + #'ibuffer-visible-p) + buf all ibuffer-buf)) e))) bmarklist)))) @@ -1837,7 +1915,7 @@ the value of point at the beginning of the line for that buffer." (not (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates))) (or ibuffer-view-ibuffer - (and ibuffer-buf + (and ibuffer-buf (not (eq ibuffer-buf buf)))))) ;; This function is a special case; it's not defined by @@ -1889,7 +1967,7 @@ the value of point at the beginning of the line for that buffer." (min (cadr element)) ;; (max (caddr element)) (align (cadddr element))) - ;; Ignore a negative min when we're inserting the title + ;; Ignore a negative min when we're inserting the title (when (minusp min) (setq min (- min))) (let* ((name (or (get sym 'ibuffer-column-name) @@ -1923,34 +2001,35 @@ the value of point at the beginning of the line for that buffer." (delete-region (previous-single-property-change (point-max) 'ibuffer-summary) (point-max))) - (add-text-properties - (point) - (progn - (insert "\n") - (dolist (element format) - (insert - (if (stringp element) - (make-string (length element) ? ) - (let ((sym (car element))) - (let ((min (cadr element)) - ;; (max (caddr element)) - (align (cadddr element))) - ;; Ignore a negative min when we're inserting the title - (when (minusp min) - (setq min (- min))) - (let* ((summary (if (get sym 'ibuffer-column-summarizer) - (funcall (get sym 'ibuffer-column-summarizer) - (get sym 'ibuffer-column-summary)) - (make-string (length (get sym 'ibuffer-column-name)) - ? ))) - (len (length summary))) - (if (< len min) - (ibuffer-format-column summary - (- min len) - align) - summary))))))) - (point)) - `(ibuffer-summary t)))) + (if ibuffer-display-summary + (add-text-properties + (point) + (progn + (insert "\n") + (dolist (element format) + (insert + (if (stringp element) + (make-string (length element) ? ) + (let ((sym (car element))) + (let ((min (cadr element)) + ;; (max (caddr element)) + (align (cadddr element))) + ;; Ignore a negative min when we're inserting the title + (when (minusp min) + (setq min (- min))) + (let* ((summary (if (get sym 'ibuffer-column-summarizer) + (funcall (get sym 'ibuffer-column-summarizer) + (get sym 'ibuffer-column-summary)) + (make-string (length (get sym 'ibuffer-column-name)) + ? ))) + (len (length summary))) + (if (< len min) + (ibuffer-format-column summary + (- min len) + align) + summary))))))) + (point)) + `(ibuffer-summary t))))) (defun ibuffer-update-mode-name () (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode @@ -1999,11 +2078,15 @@ If optional arg SILENT is non-nil, do not display progress messages." (defun ibuffer-update (arg &optional silent) "Regenerate the list of all buffers. -Display buffers whose name matches one of `ibuffer-maybe-show-predicates' -iff arg ARG is non-nil. + +Prefix arg non-nil means to toggle whether buffers that match +`ibuffer-maybe-show-predicates' should be displayed. If optional arg SILENT is non-nil, do not display progress messages." (interactive "P") + (if arg + (setq ibuffer-display-maybe-show-predicates + (not ibuffer-display-maybe-show-predicates))) (ibuffer-forward-line 0) (let* ((bufs (buffer-list)) (blist (ibuffer-filter-buffers @@ -2016,7 +2099,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (caddr bufs) (cadr bufs)) (ibuffer-current-buffers-with-marks bufs) - arg))) + ibuffer-display-maybe-show-predicates))) (when (null blist) (if (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) @@ -2059,7 +2142,14 @@ If optional arg SILENT is non-nil, do not display progress messages." font-lock-face ,ibuffer-filter-group-name-face keymap ,ibuffer-mode-filter-group-map mouse-face highlight - help-echo ,(concat filter-string "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group "))) + help-echo ,(let ((echo '(if tooltip-mode + "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group" + "mouse-1: toggle marks mouse-2: hide/show"))) + (if (> (length filter-string) 0) + `(concat ,filter-string + (if tooltip-mode "\n" " ") + ,echo) + echo)))) (insert "\n") (when bmarklist (put-text-property @@ -2071,7 +2161,7 @@ If optional arg SILENT is non-nil, do not display progress messages." 'ibuffer-filter-group name))) -(defun ibuffer-redisplay-engine (bmarklist &optional all) +(defun ibuffer-redisplay-engine (bmarklist &optional ignore) (assert (eq major-mode 'ibuffer-mode)) (let* ((--ibuffer-insert-buffers-and-marks-format (ibuffer-current-format)) @@ -2097,6 +2187,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (member name ibuffer-hidden-filter-groups))) (bmarklist (cdr group))) (unless (and (null bmarklist) + (not disabled) ext-loaded (null ibuffer-show-empty-filter-groups)) (ibuffer-insert-filter-group @@ -2117,13 +2208,14 @@ If optional arg SILENT is non-nil, do not display progress messages." (defun ibuffer-quit () "Quit this `ibuffer' session. -Delete the current window iff `ibuffer-delete-window-on-quit' is non-nil." +Try to restore the previous window configuration iff +`ibuffer-restore-window-config-on-quit' is non-nil." (interactive) - (if ibuffer-delete-window-on-quit + (if ibuffer-restore-window-config-on-quit (progn (bury-buffer) (unless (= (count-windows) 1) - (delete-window))) + (set-window-configuration ibuffer-prev-window-config))) (bury-buffer))) ;;;###autoload @@ -2166,9 +2258,8 @@ locally in this buffer." (interactive "P") (when ibuffer-use-other-window (setq other-window-p t)) - (let* ((buf (get-buffer-create (or name "*Ibuffer*"))) - (already-in (eq (current-buffer) buf)) - (need-update nil)) + (setq ibuffer-prev-window-config (current-window-configuration)) + (let ((buf (get-buffer-create (or name "*Ibuffer*")))) (if other-window-p (funcall (if noselect #'(lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf) (funcall (if noselect #'display-buffer #'switch-to-buffer) buf)) @@ -2177,10 +2268,9 @@ locally in this buffer." ;; We switch to the buffer's window in order to be able ;; to modify the value of point (select-window (get-buffer-window buf)) - (unless (eq major-mode 'ibuffer-mode) - (ibuffer-mode) - (setq need-update t)) - (setq ibuffer-delete-window-on-quit other-window-p) + (or (eq major-mode 'ibuffer-mode) + (ibuffer-mode)) + (setq ibuffer-restore-window-config-on-quit other-window-p) (when shrink (setq ibuffer-shrink-to-minimum-size shrink)) (when qualifiers @@ -2296,7 +2386,7 @@ Filter group commands: '\\[ibuffer-save-filter-groups]' - Save the current groups with a name. '\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups. '\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups. - + Sorting commands: '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. @@ -2387,6 +2477,9 @@ will be inserted before the group at point." ;; This makes things less ugly for Emacs 21 users with a non-nil ;; `show-trailing-whitespace'. (setq show-trailing-whitespace nil) + ;; disable `show-paren-mode' buffer-locally + (if (bound-and-true-p show-paren-mode) + (set (make-local-variable 'show-paren-mode) nil)) (set (make-local-variable 'revert-buffer-function) #'ibuffer-update) (set (make-local-variable 'ibuffer-sorting-mode) @@ -2395,6 +2488,8 @@ will be inserted before the group at point." ibuffer-default-sorting-reversep) (set (make-local-variable 'ibuffer-shrink-to-minimum-size) ibuffer-default-shrink-to-minimum-size) + (set (make-local-variable 'ibuffer-display-maybe-show-predicates) + ibuffer-default-display-maybe-show-predicates) (set (make-local-variable 'ibuffer-filtering-qualifiers) nil) (set (make-local-variable 'ibuffer-filter-groups) nil) (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil) @@ -2404,8 +2499,7 @@ will be inserted before the group at point." (set (make-local-variable 'ibuffer-cached-eliding-string) nil) (set (make-local-variable 'ibuffer-cached-elide-long-columns) nil) (set (make-local-variable 'ibuffer-current-format) nil) - (set (make-local-variable 'ibuffer-did-modifiction) nil) - (set (make-local-variable 'ibuffer-delete-window-on-quit) nil) + (set (make-local-variable 'ibuffer-restore-window-config-on-quit) nil) (set (make-local-variable 'ibuffer-did-modification) nil) (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil) (set (make-local-variable 'ibuffer-tmp-show-regexps) nil) @@ -2421,8 +2515,11 @@ will be inserted before the group at point." (provide 'ibuffer) +(run-hooks 'ibuffer-load-hook) + ;; Local Variables: ;; coding: iso-8859-1 ;; End: +;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 ;;; ibuffer.el ends here