diff options
| -rw-r--r-- | lisp/ibuf-ext.el | 1300 | ||||
| -rw-r--r-- | lisp/ibuf-macs.el | 270 | ||||
| -rw-r--r-- | lisp/ibuffer.el | 2109 |
3 files changed, 3679 insertions, 0 deletions
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el new file mode 100644 index 00000000000..944227f8beb --- /dev/null +++ b/lisp/ibuf-ext.el @@ -0,0 +1,1300 @@ +;;; ibuf-ext.el --- extended features for ibuffer + +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. + +;; Author: Colin Walters <walters@verbum.org> +;; Created: 2 Dec 2001 +;; X-RCS: $Id: ibuf-ext.el,v 1.30 2001/12/17 08:44:43 walters Exp $ +;; URL: http://cvs.verbum.org/ibuffer +;; Keywords: buffer, convenience + +;; This file is not currently part of GNU Emacs. + +;; 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 +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; 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. + +;;; Commentary: + +;; These functions should be automatically loaded when called, but you +;; can explicity (require 'ibuf-ext) in your ~/.emacs to have them +;; preloaded. + +;;; Code: + +(require 'ibuffer) + +(eval-when-compile + (require 'derived) + (require 'ibuf-macs) + (require 'cl)) + +;;; Utility functions +(defun ibuffer-delete-alist (key alist) + "Delete all entries in ALIST that have a key equal to KEY." + (let (entry) + (while (setq entry (assoc key alist)) + (setq alist (delete entry alist))) + alist)) + +(defun ibuffer-depropertize-string (str &optional nocopy) + "Return a copy of STR with text properties removed. +If optional argument NOCOPY is non-nil, actually modify the string directly." + (let ((str (if nocopy + str + (copy-sequence str)))) + (set-text-properties 0 (length str) nil str) + str)) + +(defcustom ibuffer-never-show-predicates nil + "A list of predicates (a regexp or function) for buffers not to display. +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)) + :group 'ibuffer) + +(defcustom ibuffer-always-show-predicates nil + "A list of predicates (a regexp or function) for buffers to always display. +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. +Note that buffers matching one of these predicates will be shown +regardless of any active filters in this buffer." + :type '(repeat (choice regexp function)) + :group 'ibuffer) + +(defvar ibuffer-tmp-hide-regexps nil + "A list of regexps which should match buffer names to not show.") + +(defvar ibuffer-tmp-show-regexps nil + "A list of regexps which should match buffer names to always show.") + +(defvar ibuffer-auto-mode nil + "If non-nil, Ibuffer auto-mode should be enabled for this buffer. +Do not set this variable directly! Use the function +`ibuffer-auto-mode' instead.") + +(defvar ibuffer-auto-buffers-changed nil) + +(defcustom ibuffer-occur-match-face 'font-lock-warning-face + "Face used for displaying matched strings for `ibuffer-do-occur'." + :type 'face + :group 'ibuffer) + +(defcustom ibuffer-saved-filters '(("gnus" + ((or (mode . message-mode) + (mode . mail-mode) + (mode . gnus-group-mode) + (mode . gnus-summary-mode) + (mode . gnus-article-mode)))) + ("programming" + ((or (mode . emacs-lisp-mode) + (mode . cperl-mode) + (mode . c-mode) + (mode . java-mode) + (mode . idl-mode) + (mode . lisp-mode))))) + + "An alist of filter qualifiers to switch between. + +This variable should look like ((\"STRING\" QUALIFIERS) + (\"STRING\" QUALIFIERS) ...), where +QUALIFIERS is a list of the same form as +`ibuffer-filtering-qualifiers'. +See also the variables `ibuffer-filtering-qualifiers', +`ibuffer-filtering-alist', and the functions +`ibuffer-switch-to-saved-filters', `ibuffer-save-filters'." + :type '(repeat sexp) + :group 'ibuffer) + +(defvar ibuffer-filtering-qualifiers nil + "A list like (SYMBOL . QUALIFIER) which filters the current buffer list. +See also `ibuffer-filtering-alist'.") + +;; This is now frobbed by `define-ibuffer-filter'. +(defvar ibuffer-filtering-alist nil + "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter. + +You most likely do not want to modify this variable directly; see +`define-ibuffer-filter'. + +SYMBOL is the symbolic name of the filter. DESCRIPTION is used when +displaying information to the user. FUNCTION is given a buffer and +the value of the qualifier, and returns non-nil if and only if the +buffer should be displayed.") + +(defcustom ibuffer-old-time 3 + "The number of days before a buffer is considered \"old\"." + :type 'integer + :group 'ibuffer) + +(defcustom ibuffer-save-with-custom t + "If non-nil, then use Custom to save interactively changed variables. +Currently, this only applies to `ibuffer-saved-filters'." + :type 'boolean + :group 'ibuffer) + +(defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf) + (or + (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps) + (and (not + (or + (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps) + (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates))) + (or all + (not + (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates))) + (or ibuffer-view-ibuffer + (and ibuffer-buf + (not (eq ibuffer-buf buf)))) + (or + (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers) + (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)))) + +;;;###autoload +(defun ibuffer-auto-mode (&optional arg) + "Toggle use of Ibuffer's auto-update facility. +With numeric ARG, enable auto-update if and only if ARG is positive." + (interactive) + (unless (eq major-mode 'ibuffer-mode) + (error "This buffer is not in Ibuffer mode")) + (set (make-local-variable 'ibuffer-auto-mode) + (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)) + (add-hook 'post-command-hook 'ibuffer-auto-update-changed) + (ibuffer-update-mode-name)) + +;;;###autoload +(defun ibuffer-mouse-filter-by-mode (event) + "Enable or disable filtering by the major mode chosen via mouse." + (interactive "e") + (ibuffer-interactive-filter-by-mode event)) + +;;;###autoload +(defun ibuffer-interactive-filter-by-mode (event-or-point) + "Enable or disable filtering by the major mode at point." + (interactive "d") + (if (eventp event-or-point) + (mouse-set-point event-or-point) + (goto-char event-or-point)) + (let ((buf (ibuffer-current-buffer))) + (if (assq 'mode ibuffer-filtering-qualifiers) + (setq ibuffer-filtering-qualifiers + (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers)) + (ibuffer-push-filter (cons 'mode + (with-current-buffer buf + major-mode))))) + (ibuffer-update nil t)) + +;;;###autoload +(define-ibuffer-op shell-command-pipe (command) + "Pipe the contents of each marked buffer to shell command COMMAND." + (:interactive "sPipe to shell command: " + :opstring "Shell command executed on" + :modifier-p nil) + (shell-command-on-region + (point-min) (point-max) command + (get-buffer-create "* ibuffer-shell-output*"))) + +;;;###autoload +(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): " + :opstring "Buffer contents replaced in" + :active-opstring "replace buffer contents in" + :dangerous t + :modifier-p t) + (with-current-buffer buf + (shell-command-on-region (point-min) (point-max) + command nil t))) + +;;;###autoload +(define-ibuffer-op shell-command-file (command) + "Run shell command COMMAND separately on files of marked buffers." + (:interactive "sShell command on buffer's file: " + :opstring "Shell command executed on" + :modifier-p nil) + (shell-command (concat command " " + (shell-quote-argument + (if buffer-file-name + buffer-file-name + (make-temp-file + (substring (buffer-name) 0 (min 10 (length (buffer-name)))))))))) + +;;;###autoload +(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): " + :opstring "evaluated in" + :modifier-p :maybe) + (eval form)) + +;;;###autoload +(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): " + :opstring "evaluated in" + :complex t + :modifier-p :maybe) + (let ((ibuffer-buf (current-buffer))) + (unwind-protect + (progn + (switch-to-buffer buf) + (eval form)) + (switch-to-buffer ibuffer-buf)))) + +;;;###autoload +(define-ibuffer-op rename-uniquely () + "Rename marked buffers as with `rename-uniquely'." + (:opstring "renamed" + :modifier-p t) + (rename-uniquely)) + +;;;###autoload +(define-ibuffer-op revert () + "Revert marked buffers as with `revert-buffer'." + (:dangerous t + :opstring "reverted" + :active-opstring "revert" + :modifier-p :maybe) + (revert-buffer t t)) + +;;;###autoload +(define-ibuffer-op replace-regexp (from-str to-str) + "Perform a `replace-regexp' in marked buffers." + (:interactive + (let* ((from-str (read-from-minibuffer "Replace regexp: ")) + (to-str (read-from-minibuffer (concat "Replace " from-str + " with: ")))) + (list from-str to-str)) + :opstring "replaced in" + :complex t + :modifier-p :maybe) + (save-window-excursion + (switch-to-buffer buf) + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search ibuffer-case-fold-search)) + (while (re-search-forward from-str nil t) + (replace-match to-str)))) + t)) + +;;;###autoload +(define-ibuffer-op query-replace (&rest args) + "Perform a `query-replace' in marked buffers." + (:interactive + (query-replace-read-args "Query replace" t) + :opstring "replaced in" + :complex t + :modifier-p :maybe) + (save-window-excursion + (switch-to-buffer buf) + (save-excursion + (let ((case-fold-search ibuffer-case-fold-search)) + (goto-char (point-min)) + (apply #'query-replace args))) + t)) + +;;;###autoload +(define-ibuffer-op query-replace-regexp (&rest args) + "Perform a `query-replace-regexp' in marked buffers." + (:interactive + (query-replace-read-args "Query replace regexp" t) + :opstring "replaced in" + :complex t + :modifier-p :maybe) + (save-window-excursion + (switch-to-buffer buf) + (save-excursion + (let ((case-fold-search ibuffer-case-fold-search)) + (goto-char (point-min)) + (apply #'query-replace-regexp args))) + t)) + +;;;###autoload +(define-ibuffer-op print () + "Print marked buffers as with `print-buffer'." + (:opstring "printed" + :modifier-p nil) + (print-buffer)) + +;;;###autoload +(defun ibuffer-included-in-filters-p (buf filters) + (not + (memq nil ;; a filter will return nil if it failed + (mapcar + ;; filter should be like (TYPE . QUALIFIER), or + ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...) + #'(lambda (qual) + (ibuffer-included-in-filter-p buf qual)) + filters)))) + +(defun ibuffer-included-in-filter-p (buf filter) + (if (eq (car filter) 'not) + (not (ibuffer-included-in-filter-p-1 buf (cdr filter))) + (ibuffer-included-in-filter-p-1 buf filter))) + +(defun ibuffer-included-in-filter-p-1 (buf filter) + (not + (not + (case (car filter) + (or + (memq t (mapcar #'(lambda (x) + (ibuffer-included-in-filter-p buf x)) + (cdr filter)))) + (saved + (let ((data + (assoc (cdr filter) + ibuffer-saved-filters))) + (unless data + (ibuffer-filter-disable) + (error "Unknown saved filter %s" (cdr filter))) + (ibuffer-included-in-filters-p buf (cadr data)))) + (t + (let ((filterdat (assq (car filter) + ibuffer-filtering-alist))) + ;; filterdat should be like (TYPE DESCRIPTION FUNC) + ;; just a sanity check + (unless filterdat + (ibuffer-filter-disable) + (error "Undefined filter %s" (car filter))) + (not + (not + (funcall (caddr filterdat) + buf + (cdr filter)))))))))) + +;;;###autoload +(defun ibuffer-filter-disable () + "Disable all filters currently in effect in this buffer." + (interactive) + (setq ibuffer-filtering-qualifiers nil) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-pop-filter () + "Remove the top filter in this buffer." + (interactive) + (when (null ibuffer-filtering-qualifiers) + (error "No filters in effect")) + (pop ibuffer-filtering-qualifiers) + (ibuffer-update nil t)) + +(defun ibuffer-push-filter (qualifier) + "Add QUALIFIER to `ibuffer-filtering-qualifiers'." + (push qualifier ibuffer-filtering-qualifiers)) + +;;;###autoload +(defun ibuffer-decompose-filter () + "Separate the top compound filter (OR, NOT, or SAVED) in this buffer. + +This means that the topmost filter on the filtering stack, which must +be a complex filter like (OR [name: foo] [mode: bar-mode]), will be +turned into two separate filters [name: foo] and [mode: bar-mode]." + (interactive) + (when (null ibuffer-filtering-qualifiers) + (error "No filters in effect")) + (let ((lim (pop ibuffer-filtering-qualifiers))) + (case (car lim) + (or + (setq ibuffer-filtering-qualifiers (append + (cdr lim) + ibuffer-filtering-qualifiers))) + (saved + (let ((data + (assoc (cdr lim) + ibuffer-saved-filters))) + (unless data + (ibuffer-filter-disable) + (error "Unknown saved filter %s" (cdr lim))) + (setq ibuffer-filtering-qualifiers (append + (cadr data) + ibuffer-filtering-qualifiers)))) + (not + (push (cdr lim) + ibuffer-filtering-qualifiers)) + (t + (error "Filter type %s is not compound" (car lim))))) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-exchange-filters () + "Exchange the top two filters on the stack in this buffer." + (interactive) + (when (< (length ibuffer-filtering-qualifiers) + 2) + (error "Need two filters to exchange")) + (let ((first (pop ibuffer-filtering-qualifiers)) + (second (pop ibuffer-filtering-qualifiers))) + (push first ibuffer-filtering-qualifiers) + (push second ibuffer-filtering-qualifiers)) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-negate-filter () + "Negate the sense of the top filter in the current buffer." + (interactive) + (when (null ibuffer-filtering-qualifiers) + (error "No filters in effect")) + (let ((lim (pop ibuffer-filtering-qualifiers))) + (push (if (eq (car lim) 'not) + (cdr lim) + (cons 'not lim)) + ibuffer-filtering-qualifiers)) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-or-filter (&optional reverse) + "Replace the top two filters in this buffer with their logical OR. +If optional argument REVERSE is non-nil, instead break the top OR +filter into parts." + (interactive "P") + (if reverse + (progn + (when (or (null ibuffer-filtering-qualifiers) + (not (eq 'or (caar ibuffer-filtering-qualifiers)))) + (error "Top filter is not an OR")) + (let ((lim (pop 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")) + ;; If the second filter is an OR, just add to it. + (let ((first (pop ibuffer-filtering-qualifiers)) + (second (pop ibuffer-filtering-qualifiers))) + (if (eq 'or (car second)) + (push (nconc (list 'or first) (cdr second)) ibuffer-filtering-qualifiers) + (push (list 'or first second) + ibuffer-filtering-qualifiers)))) + (ibuffer-update nil t)) + +(defun ibuffer-maybe-save-saved-filters () + (when ibuffer-save-with-custom + (if (fboundp 'customize-save-variable) + (progn + (customize-save-variable 'ibuffer-saved-filters + ibuffer-saved-filters)) + (message "Not saved permanently: Customize not available")))) + +;;;###autoload +(defun ibuffer-save-filters (name filters) + "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'. +Interactively, prompt for NAME, and use the current filters." + (interactive + (if (null ibuffer-filtering-qualifiers) + (error "No filters currently in effect") + (list + (read-from-minibuffer "Save current filters as: ") + ibuffer-filtering-qualifiers))) + (ibuffer-aif (assoc name ibuffer-saved-filters) + (setcdr it filters) + (push (list name filters) ibuffer-saved-filters)) + (ibuffer-maybe-save-saved-filters) + (ibuffer-update-mode-name)) + +;;;###autoload +(defun ibuffer-delete-saved-filters (name) + "Delete saved filters with NAME from `ibuffer-saved-filters'." + (interactive + (list + (if (null ibuffer-saved-filters) + (error "No saved filters") + (completing-read "Delete saved filters: " + ibuffer-saved-filters nil t)))) + (setq ibuffer-saved-filters + (ibuffer-delete-alist name ibuffer-saved-filters)) + (ibuffer-maybe-save-saved-filters) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-add-saved-filters (name) + "Add saved filters from `ibuffer-saved-filters' to this buffer's filters." + (interactive + (list + (if (null ibuffer-saved-filters) + (error "No saved filters") + (completing-read "Add saved filters: " + ibuffer-saved-filters nil t)))) + (push (cons 'saved name) ibuffer-filtering-qualifiers) + (ibuffer-update nil t)) + +;;;###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." + (interactive + (list + (if (null ibuffer-saved-filters) + (error "No saved filters") + (completing-read "Switch to saved filters: " + ibuffer-saved-filters nil t)))) + (setq ibuffer-filtering-qualifiers (list (cons 'saved name))) + (ibuffer-update nil t)) + +(defun ibuffer-format-qualifier (qualifier) + (if (eq (car-safe qualifier) 'not) + (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]") + (ibuffer-format-qualifier-1 qualifier))) + +(defun ibuffer-format-qualifier-1 (qualifier) + (case (car qualifier) + (saved + (concat " [filter: " (cdr qualifier) "]")) + (or + (concat " [OR" (mapconcat #'ibuffer-format-qualifier + (cdr qualifier) "") "]")) + (t + (let ((type (assq (car qualifier) ibuffer-filtering-alist))) + (unless qualifier + (error "Ibuffer: bad qualifier %s" qualifier)) + (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier))))))) + +;;; Extra operation definitions + +;;;###autoload +(define-ibuffer-filter mode + "Toggle current view to buffers with major mode QUALIFIER." + (:description "major mode" + :reader + (intern + (completing-read "Filter by major mode: " obarray + #'(lambda (e) + (string-match "-mode$" + (symbol-name e))) + t + (let ((buf (ibuffer-current-buffer))) + (if (and buf (buffer-live-p buf)) + (with-current-buffer buf + (symbol-name major-mode)) + ""))))) + (eq qualifier (with-current-buffer buf major-mode))) + +;;;###autoload +(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 +(define-ibuffer-filter filename + "Toggle current view to buffers with filename matching QUALIFIER." + (:description "filename" + :reader + (read-from-minibuffer "Filter by filename (regexp): ")) + (ibuffer-awhen (buffer-file-name buf) + (string-match qualifier it))) + +;;;###autoload +(define-ibuffer-filter size-gt + "Toggle current view to buffers with size greater than QUALIFIER." + (:description "size greater than" + :reader + (string-to-number (read-from-minibuffer "Filter by size greater than: "))) + (> (with-current-buffer buf (buffer-size)) + qualifier)) + +;;;###autoload +(define-ibuffer-filter size-lt + "Toggle current view to buffers with size less than QUALIFIER." + (:description "size less than" + :reader + (string-to-number (read-from-minibuffer "Filter by size less than: "))) + (< (with-current-buffer buf (buffer-size)) + qualifier)) + +;;;###autoload +(define-ibuffer-filter content + "Toggle current view to buffers whose contents match QUALIFIER." + (:description "content" + :reader + (read-from-minibuffer "Filter by content (regexp): ")) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (re-search-forward qualifier nil t)))) + +;;;###autoload +(define-ibuffer-filter predicate + "Toggle current view to buffers for which QUALIFIER returns non-nil." + (:description "predicate" + :reader + (read-minibuffer "Filter by predicate (form): ")) + (with-current-buffer buf + (eval qualifier))) + +;;; Sorting + +;;;###autoload +(defun ibuffer-toggle-sorting-mode () + "Toggle the current sorting mode. +Possible sorting modes are: + Recency - the last time the buffer was viewed + Name - the name of the buffer + Major Mode - the name of the major mode of the buffer + Size - the size of the buffer" + (interactive) + (let* ((keys (mapcar #'car ibuffer-sorting-functions-alist)) + (entry (memq ibuffer-sorting-mode keys)) + (next (or (cadr entry) (car keys))) + (nextentry (assq next ibuffer-sorting-functions-alist))) + (if (and entry nextentry) + (progn + (setq ibuffer-sorting-mode next) + (message "Sorting by %s" (cadr nextentry))) + (progn + (setq ibuffer-sorting-mode 'recency) + (message "Sorting by last view time")))) + (ibuffer-redisplay t)) + +;;;###autoload +(defun ibuffer-invert-sorting () + "Toggle whether or not sorting is in reverse order." + (interactive) + (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)) + (message "Sorting order %s" + (if ibuffer-sorting-reversep + "reversed" + "normal")) + (ibuffer-redisplay t)) + +;;;###autoload +(define-ibuffer-sorter major-mode + "Sort the buffers by major modes. +Ordering is lexicographic." + (:description "major mode") + (string-lessp (downcase + (symbol-name (with-current-buffer + (car a) + major-mode))) + (downcase + (symbol-name (with-current-buffer + (car b) + major-mode))))) + +;;;###autoload +(define-ibuffer-sorter alphabetic + "Sort the buffers by their names. +Ordering is lexicographic." + (:description "buffer name") + (string-lessp + (buffer-name (car a)) + (buffer-name (car b)))) + +;;;###autoload +(define-ibuffer-sorter size + "Sort the buffers by their size." + (:description "size") + (< (with-current-buffer (car a) + (buffer-size)) + (with-current-buffer (car b) + (buffer-size)))) + +;;; Functions to emulate bs.el + +;;;###autoload +(defun ibuffer-bs-show () + "Emulate `bs-show' from the bs.el package." + (interactive) + (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t) + (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all)) + +(defun ibuffer-bs-toggle-all () + "Emulate `bs-toggle-show-all' from the bs.el package." + (interactive) + (if ibuffer-filtering-qualifiers + (ibuffer-pop-filter) + (progn (ibuffer-push-filter '(filename . ".*")) + (ibuffer-update nil t)))) + +;;; Handy functions + +;;;###autoload +(defun ibuffer-add-to-tmp-hide (regexp) + "Add REGEXP to `ibuffer-tmp-hide-regexps'. +This means that buffers whose name matches REGEXP will not be shown +for this ibuffer session." + (interactive + (list + (read-from-minibuffer "Never show buffers matching: " + (regexp-quote (buffer-name (ibuffer-current-buffer t)))))) + (push regexp ibuffer-tmp-hide-regexps)) + +;;;###autoload +(defun ibuffer-add-to-tmp-show (regexp) + "Add REGEXP to `ibuffer-tmp-show-regexps'. +This means that buffers whose name matches REGEXP will always be shown +for this ibuffer session." + (interactive + (list + (read-from-minibuffer "Always show buffers matching: " + (regexp-quote (buffer-name (ibuffer-current-buffer t)))))) + (push regexp ibuffer-tmp-show-regexps)) + +;;;###autoload +(defun ibuffer-forward-next-marked (&optional count mark direction) + "Move forward by COUNT marked buffers (default 1). + +If MARK is non-nil, it should be a character denoting the type of mark +to move by. The default is `ibuffer-marked-char'. + +If DIRECTION is non-nil, it should be an integer; negative integers +mean move backwards, non-negative integers mean move forwards." + (interactive "P") + (unless count + (setq count 1)) + (unless mark + (setq mark ibuffer-marked-char)) + (unless direction + (setq direction 1)) + ;; Skip the title + (ibuffer-forward-line 0) + (let ((opos (point)) + curmark) + (ibuffer-forward-line direction) + (while (not (or (= (point) opos) + (eq (setq curmark (ibuffer-current-mark)) + mark))) + (ibuffer-forward-line direction)) + (when (and (= (point) opos) + (not (eq (ibuffer-current-mark) mark))) + (error "No buffers with mark %c" mark)))) + +;;;###autoload +(defun ibuffer-backwards-next-marked (&optional count mark) + "Move backwards by COUNT marked buffers (default 1). + +If MARK is non-nil, it should be a character denoting the type of mark +to move by. The default is `ibuffer-marked-char'." + (interactive "P") + (ibuffer-forward-next-marked count mark -1)) + +;;;###autoload +(defun ibuffer-do-kill-lines () + "Hide all of the currently marked lines." + (interactive) + (if (= (ibuffer-count-marked-lines) 0) + (message "No buffers marked; use 'm' to mark a buffer") + (let ((count + (ibuffer-map-marked-lines + #'(lambda (buf mark beg end) + 'kill)))) + (message "Killed %s lines" count)))) + +;;;###autoload +(defun ibuffer-jump-to-buffer (name) + "Move point to the buffer whose name is NAME." + (interactive (list nil)) + (let ((table (mapcar #'(lambda (x) + (cons (buffer-name (car x)) + (caddr x))) + (ibuffer-current-state-list t)))) + (when (null table) + (error "No buffers!")) + (when (interactive-p) + (setq name (completing-read "Jump to buffer: " table nil t))) + (ibuffer-aif (assoc name table) + (goto-char (cdr it)) + (error "No buffer with name %s" name)))) + +;;;###autoload +(defun ibuffer-diff-with-file () + "View the differences between this buffer and its associated file. +This requires the external program \"diff\" to be in your `exec-path'." + (interactive) + (let* ((buf (ibuffer-current-buffer)) + (buf-filename (with-current-buffer buf + buffer-file-name))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed" buf)) + (unless buf-filename + (error "Buffer %s has no associated file" buf)) + (let ((diff-buf (get-buffer-create "*Ibuffer-diff*"))) + (with-current-buffer diff-buf + (setq buffer-read-only nil) + (erase-buffer)) + (let ((tempfile (make-temp-file "ibuffer-diff-"))) + (unwind-protect + (progn + (with-current-buffer buf + (write-region (point-min) (point-max) tempfile nil 'nomessage)) + (if (zerop + (apply #'call-process "diff" nil diff-buf nil + (append + (when (and (boundp 'ediff-custom-diff-options) + (stringp ediff-custom-diff-options)) + (list ediff-custom-diff-options)) + (list buf-filename tempfile)))) + (message "No differences found") + (progn + (with-current-buffer diff-buf + (goto-char (point-min)) + (if (fboundp 'diff-mode) + (diff-mode) + (fundamental-mode))) + (display-buffer diff-buf)))) + (when (file-exists-p tempfile) + (delete-file tempfile))))) + nil)) + +;;;###autoload +(defun ibuffer-copy-filename-as-kill (&optional arg) + "Copy filenames of marked buffers into the kill ring. +The names are separated by a space. +If a buffer has no filename, it is ignored. +With a zero prefix arg, use the complete pathname of each marked file. + +You can then feed the file name(s) to other commands with C-y. + + [ This docstring shamelessly stolen from the + `dired-copy-filename-as-kill' in \"dired-x\". ]" + ;; Add to docstring later: + ;; With C-u, use the relative pathname of each marked file. + (interactive "P") + (if (= (ibuffer-count-marked-lines) 0) + (message "No buffers marked; use 'm' to mark a buffer") + (let ((ibuffer-copy-filename-as-kill-result "") + (type (cond ((eql arg 0) + 'full) + ;; ((eql arg 4) + ;; 'relative) + (t + 'name)))) + (ibuffer-map-marked-lines + #'(lambda (buf mark beg end) + (setq ibuffer-copy-filename-as-kill-result + (concat ibuffer-copy-filename-as-kill-result + (let ((name (buffer-file-name buf))) + (if name + (case type + (full + name) + (t + (file-name-nondirectory name))) + "")) + " ")))) + (push ibuffer-copy-filename-as-kill-result kill-ring)))) + +(defun ibuffer-mark-on-buffer (func) + (let ((count + (ibuffer-map-lines + #'(lambda (buf mark beg end) + (when (funcall func buf) + (ibuffer-set-mark-1 ibuffer-marked-char) + t))))) + (ibuffer-redisplay t) + (message "Marked %s buffers" count))) + +;;;###autoload +(defun ibuffer-mark-by-name-regexp (regexp) + "Mark all buffers whose name matches REGEXP." + (interactive "sMark by name (regexp): ") + (ibuffer-mark-on-buffer + #'(lambda (buf) + (string-match regexp (buffer-name buf))))) + +;;;###autoload +(defun ibuffer-mark-by-mode-regexp (regexp) + "Mark all buffers whose major mode matches REGEXP." + (interactive "sMark by major mode (regexp): ") + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + (string-match regexp mode-name))))) + +;;;###autoload +(defun ibuffer-mark-by-file-name-regexp (regexp) + "Mark all buffers whose file name matches REGEXP." + (interactive "sMark by file name (regexp): ") + (ibuffer-mark-on-buffer + #'(lambda (buf) + (let ((name (or (buffer-file-name buf) + (with-current-buffer buf + (and + (boundp 'dired-directory) + (stringp dired-directory) + dired-directory))))) + (when name + (string-match regexp name)))))) + +;;;###autoload +(defun ibuffer-mark-by-mode (mode) + "Mark all buffers whose major mode equals MODE." + (interactive + (list (intern (completing-read "Mark by major mode: " obarray + #'(lambda (e) + ;; kind of a hack... + (and (fboundp e) + (string-match "-mode$" + (symbol-name e)))) + t + (let ((buf (ibuffer-current-buffer))) + (if (and buf (buffer-live-p buf)) + (with-current-buffer buf + (cons (symbol-name major-mode) + 0)) + "")))))) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + (eq major-mode mode))))) + +;;;###autoload +(defun ibuffer-mark-modified-buffers () + "Mark all modified buffers." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) (buffer-modified-p buf)))) + +;;;###autoload +(defun ibuffer-mark-unsaved-buffers () + "Mark all modified buffers that have an associated file." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) (and (with-current-buffer buf buffer-file-name) + (buffer-modified-p buf))))) + +;;;###autoload +(defun ibuffer-mark-dissociated-buffers () + "Mark all buffers whose associated file does not exist." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + (or + (and buffer-file-name + (not (file-exists-p buffer-file-name))) + (and (eq major-mode 'dired-mode) + (boundp 'dired-directory) + (stringp dired-directory) + (not (file-exists-p (file-name-directory dired-directory))))))))) + +;;;###autoload +(defun ibuffer-mark-help-buffers () + "Mark buffers like *Help*, *Apropos*, *Info*." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + (or + (eq major-mode 'apropos-mode) + (eq major-mode 'help-mode) + (eq major-mode 'info-mode)))))) + +;;;###autoload +(defun ibuffer-mark-old-buffers () + "Mark buffers which have not been viewed in `ibuffer-old-time' days." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + ;; hacked from midnight.el + (when buffer-display-time + (let* ((tm (current-time)) + (now (+ (* (float (ash 1 16)) (car tm)) + (float (cadr tm)) (* 0.0000001 (caddr tm)))) + (then (+ (* (float (ash 1 16)) + (car buffer-display-time)) + (float (cadr buffer-display-time)) + (* 0.0000001 (caddr buffer-display-time))))) + (> (- now then) (* 24 60 60 ibuffer-old-time)))))))) + +;;;###autoload +(defun ibuffer-mark-special-buffers () + "Mark all buffers whose name begins and ends with '*'." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) (string-match "^\\*.+\\*$" + (buffer-name buf))))) + +;;;###autoload +(defun ibuffer-mark-read-only-buffers () + "Mark all read-only buffers." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + buffer-read-only)))) + +;;;###autoload +(defun ibuffer-mark-dired-buffers () + "Mark all `dired' buffers." + (interactive) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (with-current-buffer buf + (eq major-mode 'dired-mode))))) + +;;; An implementation of multi-buffer `occur' + +(defvar ibuffer-occur-props nil) + +(define-derived-mode ibuffer-occur-mode occur-mode "Ibuffer-Occur" + "A special form of Occur mode for multiple buffers. +Note this major mode is not meant for interactive use! +See also `occur-mode'." + (define-key ibuffer-occur-mode-map (kbd "n") 'forward-line) + (define-key ibuffer-occur-mode-map (kbd "q") 'bury-buffer) + (define-key ibuffer-occur-mode-map (kbd "p") 'previous-line) + (define-key ibuffer-occur-mode-map (kbd "RET") 'ibuffer-occur-display-occurence) + (define-key ibuffer-occur-mode-map (kbd "f") 'ibuffer-occur-goto-occurence) + (define-key ibuffer-occur-mode-map [(mouse-2)] 'ibuffer-occur-mouse-display-occurence) + (set (make-local-variable 'revert-buffer-function) + #'ibuffer-occur-revert-buffer-function) + (set (make-local-variable 'ibuffer-occur-props) nil) + (setq buffer-read-only nil) + (erase-buffer) + (setq buffer-read-only t) + (message (concat + "Use RET " + (if (or (and (< 21 emacs-major-version) + window-system) + (featurep 'mouse)) + "or mouse-2 ") + "to display an occurence."))) + +(defun ibuffer-occur-mouse-display-occurence (e) + "Display occurence on this line in another window." + (interactive "e") + (let* ((occurbuf (save-window-excursion (mouse-select-window e) + (selected-window))) + (target (with-current-buffer occurbuf + (get-text-property (save-excursion + (mouse-set-point e) + (point)) + 'ibuffer-occur-target)))) + (unless target + (error "No occurence on this line")) + (let ((buf (car target)) + (line (cdr target))) + (switch-to-buffer occurbuf) + (delete-other-windows) + (pop-to-buffer buf) + (goto-line line)))) + +(defun ibuffer-occur-goto-occurence () + "Switch to the buffer which has the occurence on this line." + (interactive) + (ibuffer-occur-display-occurence t)) + +(defun ibuffer-occur-display-occurence (&optional goto) + "Display occurence on this line in another window." + (interactive "P") + (let ((target (get-text-property (point) 'ibuffer-occur-target))) + (unless target + (error "No occurence on this line")) + (let ((buf (car target)) + (line (cdr target))) + (delete-other-windows) + (if goto + (switch-to-buffer buf) + (pop-to-buffer buf)) + (goto-line line)))) + +;;;###autoload +(defun ibuffer-do-occur (regexp &optional nlines) + "View lines which match REGEXP in all marked buffers. +Optional argument NLINES says how many lines of context to display: it +defaults to one." + (interactive + (list (let* ((default (car regexp-history)) + (input + (read-from-minibuffer + (if default + (format "List lines matching regexp (default `%s'): " + default) + "List lines matching regexp: ") + nil + nil + nil + 'regexp-history))) + (if (equal input "") + default + input)) + current-prefix-arg)) + (if (or (not (integerp nlines)) + (< nlines 0)) + (setq nlines 1)) + (when (zerop (ibuffer-count-marked-lines)) + (ibuffer-set-mark 'ibuffer-marked-char)) + (let ((ibuffer-do-occur-bufs nil)) + ;; Accumulate a list of marked buffers + (ibuffer-map-marked-lines + #'(lambda (buf mark beg end) + (push buf ibuffer-do-occur-bufs))) + (ibuffer-do-occur-1 regexp ibuffer-do-occur-bufs + (get-buffer-create "*Ibuffer-occur*") + nlines))) + +(defun ibuffer-do-occur-1 (regexp buffers out-buf nlines) + (let ((count (ibuffer-occur-engine regexp buffers out-buf nlines))) + (if (> count 0) + (progn + (switch-to-buffer out-buf) + (setq buffer-read-only t) + (delete-other-windows) + (goto-char (point-min)) + (message "Found %s matches in %s buffers" count (length buffers))) + (message "No matches found")))) + + +(defun ibuffer-occur-revert-buffer-function (ignore-auto noconfirm) + "Update the *Ibuffer occur* buffer." + (assert (eq major-mode 'ibuffer-occur-mode)) + (ibuffer-do-occur-1 (car ibuffer-occur-props) + (cadr ibuffer-occur-props) + (current-buffer) + (caddr ibuffer-occur-props))) + +(defun ibuffer-occur-engine (regexp buffers out-buf nlines) + (macrolet ((insert-get-point + (&rest args) + `(progn + (insert ,@args) + (point))) + (maybe-put-overlay + (over prop value) + `(when (ibuffer-use-fontification) + (overlay-put ,over ,prop ,value))) + (maybe-ibuffer-propertize + (obj &rest args) + (let ((objsym (gensym "--maybe-ibuffer-propertize-"))) + `(let ((,objsym ,obj)) + (if (ibuffer-use-fontification) + (propertize ,objsym ,@args) + ,objsym))))) + (with-current-buffer out-buf + (ibuffer-occur-mode) + (setq buffer-read-only nil) + (let ((globalcount 0)) + ;; Map over all the buffers + (dolist (buf buffers) + (when (buffer-live-p buf) + (let ((c 0) ;; count of matched lines + (l 1) ;; line count + (headerpt (with-current-buffer out-buf (point)))) + (save-excursion + (set-buffer buf) + (save-excursion + (goto-char (point-min)) ;; begin searching in the buffer + (while (not (eobp)) + ;; The line we're matching against + (let ((curline (buffer-substring + (line-beginning-position) + (line-end-position)))) + (when (string-match regexp curline) + (incf c) ;; increment match count + (incf globalcount) + ;; Depropertize the string, and maybe highlight the matches + (setq curline + (progn + (ibuffer-depropertize-string curline t) + (when (ibuffer-use-fontification) + (let ((len (length curline)) + (start 0)) + (while (and (< start len) + (string-match regexp curline start)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face ibuffer-occur-match-face + curline) + (setq start (match-end 0))))) + curline)) + ;; Generate the string to insert for this match + (let ((data + (if (= nlines 1) + ;; The simple display style + (concat (maybe-ibuffer-propertize + (format "%-6d:" l) + 'face 'bold) + curline + "\n") + ;; The complex multi-line display style + (let ((prevlines (nreverse + (ibuffer-accumulate-lines (- nlines)))) + (nextlines (ibuffer-accumulate-lines nlines)) + ;; The lack of `flet' seriously sucks. + (fun #'(lambda (lines) + (mapcar + #'(lambda (line) + (concat " :" line "\n")) + lines)))) + (setq prevlines (funcall fun prevlines)) + (setq nextlines (funcall fun nextlines)) + ;; Yes, I am trying to win the award for the + ;; most consing. + (apply #'concat + (nconc + prevlines + (list + (concat + (maybe-ibuffer-propertize + (format "%-6d" l) + 'face 'bold) + ":" + curline + "\n")) + nextlines)))))) + ;; Actually insert the match display data + (with-current-buffer out-buf + (let ((beg (point)) + (end (insert-get-point + data))) + (unless (= nlines 1) + (insert "-------\n")) + (put-text-property + beg (1- end) 'ibuffer-occur-target (cons buf l)) + (put-text-property + beg (1- end) 'mouse-face 'highlight)))))) + ;; On to the next line... + (incf l) + (forward-line 1)))) + (when (not (zerop c)) ;; is the count zero? + (with-current-buffer out-buf + (goto-char headerpt) + (let ((beg (point)) + (end (insert-get-point + (format "%d lines matching \"%s\" in buffer %s\n" + c regexp (buffer-name buf))))) + (let ((o (make-overlay beg end))) + (maybe-put-overlay o 'face 'underline))) + (goto-char (point-max))))))) + (setq ibuffer-occur-props (list regexp buffers nlines)) + ;; Return the number of matches + globalcount)))) + +(provide 'ibuf-ext) + +;;; ibuf-ext.el ends here diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el new file mode 100644 index 00000000000..8d3033acea8 --- /dev/null +++ b/lisp/ibuf-macs.el @@ -0,0 +1,270 @@ +;;; ibuf-macs.el --- macros for ibuffer + +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. + +;; Author: Colin Walters <walters@verbum.org> +;; Created: 6 Dec 2001 +;; X-RCS: $Id: ibuf-macs.el,v 1.6 2001/12/11 22:47:09 walters Exp $ +;; URL: http://cvs.verbum.org/ibuffer +;; Keywords: buffer, convenience + +;; This file is not currently part of GNU Emacs. + +;; 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 +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; 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. + +;;; Code: + +;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here. +(defmacro ibuffer-aif (test true-body &rest false-body) + "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST. +If TEST returns non-nil, bind `it' to the value, and evaluate +TRUE-BODY. Otherwise, evaluate forms in FALSE-BODY as if in `progn'. +Compare with `if'." + (let ((sym (gensym "--ibuffer-aif-"))) + `(let ((,sym ,test)) + (if ,sym + (let ((it ,sym)) + ,true-body) + (progn + ,@false-body))))) +;; (put 'ibuffer-aif 'lisp-indent-function 2) + +(defmacro ibuffer-awhen (test &rest body) + "Evaluate BODY if TEST returns non-nil. +During evaluation of body, bind `it' to the value returned by TEST." + `(ibuffer-aif ,test + (progn ,@body) + nil)) +;; (put 'ibuffer-awhen 'lisp-indent-function 1) + +(defmacro ibuffer-save-marks (&rest body) + "Save the marked status of the buffers and execute BODY; restore marks." + (let ((bufsym (gensym))) + `(let ((,bufsym (current-buffer)) + (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list))) + (unwind-protect + (progn + (save-excursion + ,@body)) + (with-current-buffer ,bufsym + (ibuffer-insert-buffers-and-marks + ;; Get rid of dead buffers + (delq nil + (mapcar #'(lambda (e) (when (buffer-live-p (car e)) + e)) + ibuffer-save-marks-tmp-mark-list))) + (ibuffer-redisplay t)))))) +;; (put 'ibuffer-save-marks 'lisp-indent-function 0) + +;;;###autoload +(defmacro* define-ibuffer-column (symbol (&key name inline props) &rest body) + "Define a column SYMBOL for use with `ibuffer-formats'. + +BODY will be called with `buffer' bound to the buffer object, and +`mark' bound to the current mark on the buffer. The current buffer +will be `buffer'. + +If NAME is given, it will be used as a title for the column. +Otherwise, the title will default to a capitalized version of the +SYMBOL's name. PROPS is a plist of additional properties to add to +the text, such as `mouse-face'. + +Note that this macro expands into a `defun' for a function named +ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be +inlined into the compiled format versions. This means that if you +change its definition, you should explicitly call +`ibuffer-recompile-formats'." + (let* ((sym (intern (concat "ibuffer-make-column-" + (symbol-name symbol)))) + (bod-1 `(with-current-buffer buffer + ,@body)) + (bod (if props + `(propertize + ,bod-1 + ,@props) + bod-1))) + `(progn + ,(if inline + `(push '(,sym ,bod) ibuffer-inline-columns) + `(defun ,sym (buffer mark) + ,bod)) + (put (quote ,sym) 'ibuffer-column-name + ,(if (stringp name) + name + (capitalize (symbol-name symbol)))) + :autoload-end))) +;; (put 'define-ibuffer-column 'lisp-indent-function 'defun) + +;;;###autoload +(defmacro* define-ibuffer-sorter (name documentation + (&key + description) + &rest body) + "Define a method of sorting named NAME. +DOCUMENTATION is the documentation of the function, which will be called +`ibuffer-do-sort-by-NAME'. +DESCRIPTION is a short string describing the sorting method. + +For sorting, the forms in BODY will be evaluated with `a' bound to one +buffer object, and `b' bound to another. BODY should return a non-nil +value if and only if `a' is \"less than\" `b'." + `(progn + (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) () + ,(or documentation "No :documentation specified for this sorting method.") + (interactive) + (setq ibuffer-sorting-mode ',name) + (ibuffer-redisplay t)) + (push (list ',name ,description + #'(lambda (a b) + ,@body)) + ibuffer-sorting-functions-alist) + :autoload-end)) +;; (put 'define-ibuffer-sorter 'lisp-indent-function 1) + +;;;###autoload +(defmacro* define-ibuffer-op (op args + documentation + (&key + interactive + mark + modifier-p + dangerous + (opstring "operated on") + (active-opstring "Operate on") + complex) + &rest body) + "Generate a function named `ibuffer-do-OP', which operates on a buffer. +When an operation is performed, this function will be called once for +each marked buffer, with that buffer current. + +ARGS becomes the formal parameters of the function. +DOCUMENTATION becomes the docstring of the function. +INTERACTIVE becomes the interactive specification of the function. +MARK describes which type of mark (:deletion, or nil) this operation +uses. :deletion means the function operates on buffers marked for +deletion, otherwise it acts on normally marked buffers. +MODIFIER-P describes how the function modifies buffers. This is used +to set the modification flag of the Ibuffer buffer itself. Valid +values are: + nil - the function never modifiers buffers + t - the function it always modifies buffers + :maybe - attempt to discover this information by comparing the + buffer's modification flag. +DANGEROUS is a boolean which should be set if the user should be +prompted before performing this operation. +OPSTRING is a string which will be displayed to the user after the +operation is complete, in the form: + \"Operation complete; OPSTRING x buffers\" +ACTIVE-OPSTRING is a string which will be displayed to the user in a +confirmation message, in the form: + \"Really ACTIVE-OPSTRING x buffers?\" +COMPLEX means this function is special; see the source code of this +macro for exactly what it does." + `(progn + (defun ,(intern (concat "ibuffer-do-" (symbol-name op))) ,args + ,(if (stringp documentation) + documentation + (format "%s marked buffers." active-opstring)) + ,(if (not (null interactive)) + `(interactive ,interactive) + '(interactive)) + (assert (eq major-mode 'ibuffer-mode)) + (setq ibuffer-did-modification nil) + (let ((marked-names (,(case mark + (:deletion + 'ibuffer-deletion-marked-buffer-names) + (t + 'ibuffer-marked-buffer-names))))) + (when (null marked-names) + (setq marked-names (list (buffer-name (ibuffer-current-buffer)))) + (ibuffer-set-mark ,(case mark + (:deletion + 'ibuffer-deletion-char) + (t + 'ibuffer-marked-char)))) + ,(let* ((finish (append + '(progn) + (if (eq modifier-p t) + '((setq ibuffer-did-modification t)) + ()) + `((ibuffer-redisplay t) + (message ,(concat "Operation finished; " opstring " %s buffers") count)))) + (inner-body (if complex + `(progn ,@body) + `(progn + (with-current-buffer buf + (save-excursion + ,@body)) + t))) + (body `(let ((count + (,(case mark + (:deletion + 'ibuffer-map-deletion-lines) + (t + 'ibuffer-map-marked-lines)) + #'(lambda (buf mark beg end) + ,(if (eq modifier-p :maybe) + `(let ((ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (prog1 ,inner-body + (when (not (eq ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (setq ibuffer-did-modification t)))) + inner-body))))) + ,finish))) + (if dangerous + `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) + ,body) + body)))) + :autoload-end)) +;; (put 'define-ibuffer-op 'lisp-indent-function 2) + +;;;###autoload +(defmacro* define-ibuffer-filter (name documentation + (&key + reader + description) + &rest body) + "Define a filter named NAME. +DOCUMENTATION is the documentation of the function. +READER is a form which should read a qualifier from the user. +DESCRIPTION is a short string describing the filter. + +BODY should contain forms which will be evaluated to test whether or +not a particular buffer should be displayed or not. The forms in BODY +will be evaluated with BUF bound to the buffer object, and QUALIFIER +bound to the current value of the filter." + (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name))))) + `(progn + (defun ,fn-name (qualifier) + ,(concat (or documentation "This filter is not documented.")) + (interactive (list ,reader)) + (ibuffer-push-filter (cons ',name qualifier)) + (message + (format ,(concat (format "Filter by %s added: " description) + " %s") + qualifier)) + (ibuffer-update nil t)) + (push (list ',name ,description + #'(lambda (buf qualifier) + ,@body)) + ibuffer-filtering-alist) + :autoload-end))) +;; (put 'define-ibuffer-filter 'lisp-indent-function 2) + +(provide 'ibuf-macs) + +;;; ibuf-macs.el ends here diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el new file mode 100644 index 00000000000..6c9937137e8 --- /dev/null +++ b/lisp/ibuffer.el @@ -0,0 +1,2109 @@ +;;; ibuffer.el --- operate on buffers like dired + +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. + +;; Author: Colin Walters <walters@verbum.org> +;; Created: 8 Sep 2000 +;; X-RCS: $Id: ibuffer.el,v 1.271 2002/01/12 23:10:48 walters Exp $ +;; URL: http://cvs.verbum.org/ibuffer +;; Keywords: buffer, convenience +;; Compatibility: Emacs 21 + +;; This file is not currently part of GNU Emacs. + +;; 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 +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; 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. + +;;; Commentary: + +;; ibuffer.el is an advanced replacement for the `buffer-menu' which +;; is normally distributed with Emacs. Its interface is intended to +;; be analogous to that of Dired. + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'ibuf-macs) + (require 'dired)) + +;;; 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)))) + + (cond ((boundp 'global-font-lock-mode) + (defsubst ibuffer-use-fontification () + (when (boundp 'font-lock-mode) + font-lock-mode))) + ((boundp 'font-lock-auto-fontify) + (defsubst ibuffer-use-fontification () + font-lock-auto-fontify)) + (t + (defsubst ibuffer-use-fontification () + nil)))) + +(defgroup ibuffer nil + "An advanced replacement for `buffer-menu'. + +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." + :link '(url-link "http://cvs.verbum.org/ibuffer") + :group 'convenience) + +(defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide) + " " (size 6 -1 :right) + " " (mode 16 16 :right :elide) " " filename) + (mark " " (name 16 -1) " " filename)) + "A list of ways to display buffer lines. + +With Ibuffer, you are not limited to displaying just certain +attributes of a buffer such as size, name, and mode in a particular +fashion. Through this variable, you can completely customize and +control the appearance of an Ibuffer buffer. See also +`define-ibuffer-column', which allows you to define your own columns +for display. + +This variable has the form +((COLUMN COLUMN ...) (COLUMN COLUMN ...) ...) +Each element in `ibuffer-formats' should be a list containing COLUMN +specifiers. A COLUMN can be any of the following: + + SYMBOL - A symbol naming the column. Predefined columns are: + mark modified read-only name size mode process filename + When you define your own columns using `define-ibuffer-column', just + use their name like the predefined columns here. This entry can + also be a function of two arguments, which should return a string. + The first argument is the buffer object, and the second is the mark + on that buffer. + or + \"STRING\" - A literal string to display. + or + (SYMBOL MIN-SIZE MAX-SIZE &optional ALIGN ELIDE) - SYMBOL is a + symbol naming the column, and MIN-SIZE and MAX-SIZE are integers (or + functions of no arguments returning an integer) which constrict the + size of a column. If MAX-SIZE is -1, there is no upper bound. The + default values are 0 and -1, respectively. If MIN-SIZE is negative, + use the end of the string. The optional element ALIGN describes the + alignment of the column; it can be :left, :center or :right. The + optional element ELIDE describes whether or not to elide the column + if it is too long; valid values are :elide and nil. The default is + nil (don't elide). + +Some example of valid entries in `ibuffer-formats', with +description (also, feel free to try them out, and experiment with your +own!): + + (mark \" \" name) + This format just displays the current mark (if any) and the name of + the buffer, separated by a space. + (mark modified read-only \" \" (name 16 16 :left) \" \" (size 6 -1 :right)) + This format displays the current mark (if any), its modification and + read-only status, as well as the name of the buffer and its size. In + this format, the name is restricted to 16 characters (longer names + will be truncated, nad shorter names will be padded with spaces), and + the name is also aligned to the right. The size of the buffer will + be padded with spaces up to a minimum of six characters, but there is + no upper limit on its size. The size will also be aligned to the + right. + +Thus, if you wanted to use these two formats, add + + (setq ibuffer-formats '((mark \" \" name) + (mark modified read-only + (name 16 16 :left) (size 6 -1 :right)))) + +to your ~/.emacs file. + +Using \\[ibuffer-switch-format], you can rotate the display between +the specified formats in the list." + :type '(repeat sexp) + :group 'ibuffer) + +(defcustom ibuffer-always-compile-formats (featurep 'bytecomp) + "If non-nil, then use the byte-compiler to optimize `ibuffer-formats'. +This will increase the redisplay speed, at the cost of loading the +elisp byte-compiler." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-fontification-alist + `((10 buffer-read-only font-lock-reference-face) + (15 (string-match "^*" (buffer-name)) font-lock-keyword-face) + (20 (string-match "^ " (buffer-name)) font-lock-warning-face) + (25 (memq major-mode '(help-mode apropos-mode info-mode)) font-lock-comment-face) + (30 (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 +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." + :type '(repeat + (list (integer :tag "Priority") + (sexp :tag "Test Form") + face)) + :group 'ibuffer) + +(defcustom ibuffer-use-other-window nil + "If non-nil, display the Ibuffer in another window by default." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-default-shrink-to-minimum-size nil + "If non-nil, minimize the size of the Ibuffer window by default." + :type 'boolean + :group 'ibuffer) +(defvar ibuffer-shrink-to-minimum-size nil) + +(defcustom ibuffer-case-fold-search case-fold-search + "If non-nil, ignore case when searching." + :type 'boolean + :group 'ibuffer) + +(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 +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 "Major mode" :value major-mode)) + :group 'ibuffer) +(defvar ibuffer-sorting-mode nil) + +(defcustom ibuffer-default-sorting-reversep nil + "If non-nil, reverse the default sorting order." + :type 'boolean + :group 'ibuffer) +(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." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-eliding-string "..." + "The string to use for eliding long columns." + :type 'string + :group 'ibuffer) + +(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. +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." + :type '(repeat (choice regexp function)) + :group 'ibuffer) + +(defvar ibuffer-current-format nil) + +(defcustom ibuffer-modified-char ?* + "The character to display for modified buffers." + :type 'character + :group 'ibuffer) + +(defcustom ibuffer-read-only-char ?% + "The character to display for read-only buffers." + :type 'character + :group 'ibuffer) + +(defcustom ibuffer-marked-char ?> + "The character to display for marked buffers." + :type 'character + :group 'ibuffer) + +(defcustom ibuffer-deletion-char ?D + "The character to display for buffers marked for deletion." + :type 'character + :group 'ibuffer) + +(defcustom ibuffer-expert nil + "If non-nil, don't ask for confirmation of \"dangerous\" operations." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-view-ibuffer nil + "If non-nil, display the current Ibuffer buffer itself. +Note that this has a drawback - the data about the current Ibuffer +buffer will most likely be inaccurate. This includes modification +state, size, etc." + :type 'boolean + :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 +`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-use-header-line (boundp 'header-line-format) + "If non-nil, display a header line containing current filters. +This feature only works on Emacs 21 or later." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-default-directory nil + "The default directory to use for a new ibuffer buffer. +Nil means inherit the directory of the buffer in which `ibuffer' was +called. Otherwise, this variable should be a string naming a +directory, like `default-directory'." + :type '(choice (const :tag "Inherit" :value nil) + string) + :group 'ibuffer) + +(defcustom ibuffer-hooks nil + "Hooks run when `ibuffer' is called." + :type 'hook + :group 'ibuffer) + +(defcustom ibuffer-mode-hooks nil + "Hooks run upon entry into `ibuffer-mode'." + :type 'hook + :group 'ibuffer) + +(defcustom ibuffer-marked-face 'font-lock-warning-face + "Face used for displaying marked buffers." + :type 'face + :group 'ibuffer) + +(defcustom ibuffer-deletion-face 'font-lock-type-face + "Face used for displaying buffers marked for deletion." + :type 'face + :group 'ibuffer) + +(defcustom ibuffer-title-face 'font-lock-type-face + "Face used for the title string." + :type 'face + :group 'ibuffer) + +(defcustom ibuffer-directory-abbrev-alist nil + "An alist of file name abbreviations like `directory-abbrev-alist'." + :type '(repeat (cons :format "%v" + :value ("" . "") + (regexp :tag "From") + (regexp :tag "To"))) + :group 'ibuffer) + +(defvar ibuffer-mode-map nil) +(defvar ibuffer-mode-operate-map nil) +(unless ibuffer-mode-map + (let ((map (make-sparse-keymap)) + (operate-map (make-sparse-keymap "Operate"))) + (define-key map (kbd "0") 'digit-argument) + (define-key map (kbd "1") 'digit-argument) + (define-key map (kbd "2") 'digit-argument) + (define-key map (kbd "3") 'digit-argument) + (define-key map (kbd "4") 'digit-argument) + (define-key map (kbd "5") 'digit-argument) + (define-key map (kbd "6") 'digit-argument) + (define-key map (kbd "7") 'digit-argument) + (define-key map (kbd "8") 'digit-argument) + (define-key map (kbd "9") 'digit-argument) + + (define-key map (kbd "m") 'ibuffer-mark-forward) + (define-key map (kbd "t") 'ibuffer-toggle-marks) + (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 "DEL") 'ibuffer-unmark-backward) + (define-key map (kbd "M-DEL") 'ibuffer-unmark-all) + (define-key map (kbd "* *") 'ibuffer-unmark-all) + (define-key map (kbd "* M") 'ibuffer-mark-by-mode) + (define-key map (kbd "* m") 'ibuffer-mark-modified-buffers) + (define-key map (kbd "* u") 'ibuffer-mark-unsaved-buffers) + (define-key map (kbd "* s") 'ibuffer-mark-special-buffers) + (define-key map (kbd "* r") 'ibuffer-mark-read-only-buffers) + (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 ".") '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 "SPC") 'forward-line) + (define-key map (kbd "p") 'ibuffer-backward-line) + (define-key map (kbd "M-}") 'ibuffer-forward-next-marked) + (define-key map (kbd "M-{") 'ibuffer-backwards-next-marked) + (define-key map (kbd "l") 'ibuffer-redisplay) + (define-key map (kbd "g") 'ibuffer-update) + (define-key map "`" 'ibuffer-switch-format) + (define-key map "-" 'ibuffer-add-to-tmp-hide) + (define-key map "+" 'ibuffer-add-to-tmp-show) + (define-key map "b" 'ibuffer-bury-buffer) + (define-key map (kbd ",") 'ibuffer-toggle-sorting-mode) + (define-key map (kbd "s i") 'ibuffer-invert-sorting) + (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 m") 'ibuffer-do-sort-by-major-mode) + + (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) + (define-key map (kbd "/ n") 'ibuffer-filter-by-name) + (define-key map (kbd "/ c") 'ibuffer-filter-by-content) + (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ f") 'ibuffer-filter-by-filename) + (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt) + (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters) + (define-key map (kbd "/ a") 'ibuffer-add-saved-filters) + (define-key map (kbd "/ x") 'ibuffer-delete-saved-filters) + (define-key map (kbd "/ d") 'ibuffer-decompose-filter) + (define-key map (kbd "/ s") 'ibuffer-save-filters) + (define-key map (kbd "/ p") 'ibuffer-pop-filter) + (define-key map (kbd "/ !") 'ibuffer-negate-filter) + (define-key map (kbd "/ t") 'ibuffer-exchange-filters) + (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters) + (define-key map (kbd "/ o") 'ibuffer-or-filter) + (define-key map (kbd "/ /") 'ibuffer-filter-disable) + + (define-key map (kbd "q") 'ibuffer-quit) + (define-key map (kbd "h") 'describe-mode) + (define-key map (kbd "?") 'describe-mode) + + (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) + (define-key map (kbd "!") 'ibuffer-do-shell-command-file) + (define-key map (kbd "~") 'ibuffer-do-toggle-modified) + ;; marked operations + (define-key map (kbd "A") 'ibuffer-do-view) + (define-key map (kbd "D") 'ibuffer-do-delete) + (define-key map (kbd "E") 'ibuffer-do-eval) + (define-key map (kbd "F") 'ibuffer-do-shell-command-file) + (define-key map (kbd "I") 'ibuffer-do-query-replace-regexp) + (define-key map (kbd "H") 'ibuffer-do-view-other-frame) + (define-key map (kbd "N") 'ibuffer-do-shell-command-pipe-replace) + (define-key map (kbd "M") 'ibuffer-do-toggle-modified) + (define-key map (kbd "O") 'ibuffer-do-occur) + (define-key map (kbd "P") 'ibuffer-do-print) + (define-key map (kbd "Q") 'ibuffer-do-query-replace) + (define-key map (kbd "R") 'ibuffer-do-rename-uniquely) + (define-key map (kbd "S") 'ibuffer-do-save) + (define-key map (kbd "T") 'ibuffer-do-toggle-read-only) + (define-key map (kbd "U") 'ibuffer-do-replace-regexp) + (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) + + (define-key map (kbd "RET") 'ibuffer-visit-buffer) + (define-key map (kbd "e") 'ibuffer-visit-buffer) + (define-key map (kbd "f") 'ibuffer-visit-buffer) + (define-key map (kbd "C-x C-f") 'ibuffer-find-file) + (define-key map (kbd "o") 'ibuffer-visit-buffer-other-window) + (define-key map (kbd "C-o") 'ibuffer-visit-buffer-other-window-noselect) + (define-key map (kbd "M-o") 'ibuffer-visit-buffer-1-window) + (define-key map (kbd "v") 'ibuffer-do-view) + (define-key map (kbd "C-x v") 'ibuffer-do-view-horizontally) + (define-key map (kbd "C-c C-a") 'ibuffer-auto-mode) + (define-key map (kbd "C-x 4 RET") 'ibuffer-visit-buffer-other-window) + (define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame) + + (define-key map [menu-bar view] + (cons "View" (make-sparse-keymap "View"))) + + (define-key-after map [menu-bar view visit-buffer] + '(menu-item "View this buffer" ibuffer-visit-buffer)) + (define-key-after map [menu-bar view visit-buffer-other-window] + '(menu-item "View (other window)" ibuffer-visit-buffer-other-window)) + (define-key-after map [menu-bar view visit-buffer-other-frame] + '(menu-item "View (other frame)" ibuffer-visit-buffer-other-frame)) + (define-key-after map [menu-bar view ibuffer-update] + '(menu-item "Update" ibuffer-update + :help "Regenerate the list of buffers")) + (define-key-after map [menu-bar view switch-format] + '(menu-item "Switch display format" ibuffer-switch-format + :help "Toggle between available values of `ibuffer-formats'")) + + (define-key-after map [menu-bar view dashes] + '("--")) + + (define-key-after map [menu-bar view sort] + (cons "Sort" (make-sparse-keymap "Sort"))) + + (define-key-after map [menu-bar view sort do-sort-by-major-mode] + '(menu-item "Sort by major mode" ibuffer-do-sort-by-major-mode + :help "Sort by the alphabetic order of the buffer's major mode")) + (define-key-after map [menu-bar view sort do-sort-by-size] + '(menu-item "Sort by buffer size" ibuffer-do-sort-by-size + :help "Sort by the size of the buffer")) + (define-key-after map [menu-bar view sort do-sort-by-alphabetic] + '(menu-item "Sort lexicographically" ibuffer-do-sort-by-alphabetic + :help "Sort by the alphabetic order of buffer name")) + (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 invert-sorting] + '(menu-item "Reverse sorting order" ibuffer-invert-sorting)) + (define-key-after map [menu-bar view sort toggle-sorting-mode] + '(menu-item "Switch sorting mode" ibuffer-toggle-sorting-mode + :help "Switch between the various sorting criteria")) + + (define-key-after map [menu-bar view filter] + (cons "Filter" (make-sparse-keymap "Filter"))) + + (define-key-after map [menu-bar view filter filter-disable] + '(menu-item "Disable all filtering" ibuffer-filter-disable)) + (define-key-after map [menu-bar view filter filter-by-mode] + '(menu-item "Add filter by major mode..." ibuffer-filter-by-mode + :help "Show only buffers in a major mode")) + (define-key-after map [menu-bar view filter filter-by-name] + '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name + :help "Show only buffers whose name matches a regexp")) + (define-key-after map [menu-bar view filter filter-by-filename] + '(menu-item "Add filter by filename..." ibuffer-filter-by-filename + :help "Show only buffers whose filename matches a regexp")) + (define-key-after map [menu-bar view filter filter-by-size-lt] + '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt + :help "Show only buffers of size less than...")) + (define-key-after map [menu-bar view filter filter-by-size-gt] + '(menu-item "Add filter by size greater than..." ibuffer-filter-by-size-gt + :help "Show only buffers of size greater than...")) + (define-key-after map [menu-bar view filter filter-by-content] + '(menu-item "Add filter by content (regexp)..." ibuffer-filter-by-content + :help "Show only buffers containing a regexp")) + (define-key-after map [menu-bar view filter filter-by-predicate] + '(menu-item "Add filter by Lisp predicate..." ibuffer-filter-by-predicate + :help "Show only buffers for which a predicate is true")) + (define-key-after map [menu-bar view filter pop-filter] + '(menu-item "Remove top filter" ibuffer-pop-filter)) + (define-key-after map [menu-bar view filter or-filter] + '(menu-item "OR top two filters" ibuffer-or-filter + :help "Create a new filter which is the logical OR of the top two filters")) + (define-key-after map [menu-bar view filter negate-filter] + '(menu-item "Negate top filter" ibuffer-negate-filter)) + (define-key-after map [menu-bar view filter decompose-filter] + '(menu-item "Decompose top filter" ibuffer-decompose-filter + :help "Break down a complex filter like OR or NOT")) + (define-key-after map [menu-bar view filter exchange-filters] + '(menu-item "Swap top two filters" ibuffer-exchange-filters)) + (define-key-after map [menu-bar view filter save-filters] + '(menu-item "Save current filters permanently..." ibuffer-save-filters + :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 + :help "Replace current filters with a saved stack")) + (define-key-after map [menu-bar view filter add-saved-filters] + '(menu-item "Add to permanently saved filters..." ibuffer-add-saved-filters + :help "Include current filters in an already saved stack")) + (define-key-after map [menu-bar view filter delete-saved-filters] + '(menu-item "Delete permanently saved filters..." ibuffer-delete-saved-filters + :help "Remove stack of filters from saved list")) + (define-key-after map [menu-bar view dashes2] + '("--")) + (define-key-after map [menu-bar view diff-with-file] + '(menu-item "Diff with file" ibuffer-diff-with-file + :help "View the differences between this buffer and its file")) + (define-key-after map [menu-bar view auto-mode] + '(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)) + :help "Use Custom to customize Ibuffer")) + + (define-key-after map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) + + (define-key-after map [menu-bar mark toggle-marks] + '(menu-item "Toggle marks" ibuffer-toggle-marks + :help "Unmark marked buffers, and mark unmarked buffers")) + (define-key-after map [menu-bar mark mark-forward] + '(menu-item "Mark" ibuffer-mark-forward + :help "Mark the buffer at point")) + (define-key-after map [menu-bar mark unmark-forward] + '(menu-item "Unmark" ibuffer-unmark-forward + :help "Unmark the buffer at point")) + (define-key-after map [menu-bar mark mark-by-mode] + '(menu-item "Mark by mode..." ibuffer-mark-by-mode + :help "Mark all buffers in a particular major mode")) + (define-key-after map [menu-bar mark mark-modified-buffers] + '(menu-item "Mark modified buffers" ibuffer-mark-modified-buffers + :help "Mark all buffers which have been modified")) + (define-key-after map [menu-bar mark mark-unsaved-buffers] + '(menu-item "Mark unsaved buffers" ibuffer-mark-unsaved-buffers + :help "Mark all buffers which have a file and are modified")) + (define-key-after map [menu-bar mark mark-read-only-buffers] + '(menu-item "Mark read-only buffers" ibuffer-mark-read-only-buffers + :help "Mark all buffers which are read-only")) + (define-key-after map [menu-bar mark mark-special-buffers] + '(menu-item "Mark special buffers" ibuffer-mark-special-buffers + :help "Mark all buffers whose name begins with a *")) + (define-key-after map [menu-bar mark mark-dired-buffers] + '(menu-item "Mark dired buffers" ibuffer-mark-dired-buffers + :help "Mark buffers in dired-mode")) + (define-key-after map [menu-bar mark mark-dissociated-buffers] + '(menu-item "Mark dissociated buffers" ibuffer-mark-dissociated-buffers + :help "Mark buffers with a non-existent associated file")) + (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-old-buffers] + '(menu-item "Mark old buffers" ibuffer-mark-old-buffers + :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")) + (define-key-after map [menu-bar mark mark-by-mode-regexp] + '(menu-item "Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp + :help "Mark buffers whose major mode name matches a regexp")) + (define-key-after map [menu-bar mark mark-by-file-name-regexp] + '(menu-item "Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp + :help "Mark buffers whose file name matches a regexp")) + + ;; Operate map is added later + + (define-key-after operate-map [do-view] + '(menu-item "View" ibuffer-do-view)) + (define-key-after operate-map [do-view-other-frame] + '(menu-item "View (separate frame)" ibuffer-do-view-other-frame)) + (define-key-after operate-map [do-save] + '(menu-item "Save" ibuffer-do-save)) + (define-key-after operate-map [do-replace-regexp] + '(menu-item "Replace (regexp)..." ibuffer-do-replace-regexp + :help "Replace text inside marked buffers")) + (define-key-after operate-map [do-query-replace] + '(menu-item "Query Replace..." ibuffer-do-query-replace + :help "Replace text in marked buffers, asking each time")) + (define-key-after operate-map [do-query-replace-regexp] + '(menu-item "Query Replace (regexp)..." ibuffer-do-query-replace-regexp + :help "Replace text in marked buffers by regexp, asking each time")) + (define-key-after operate-map [do-print] + '(menu-item "Print" ibuffer-do-print)) + (define-key-after operate-map [do-toggle-modified] + '(menu-item "Toggle modification flag" ibuffer-do-toggle-modified)) + (define-key-after operate-map [do-revert] + '(menu-item "Revert" ibuffer-do-revert + :help "Revert marked buffers to their associated file")) + (define-key-after operate-map [do-rename-uniquely] + '(menu-item "Rename Uniquely" ibuffer-do-rename-uniquely + :help "Rename marked buffers to a new, unique name")) + (define-key-after operate-map [do-delete] + '(menu-item "Kill" ibuffer-do-delete)) + (define-key-after operate-map [do-occur] + '(menu-item "List lines matching..." ibuffer-do-occur + :help "View all lines in marked buffers matching a regexp")) + (define-key-after operate-map [do-shell-command-pipe] + '(menu-item "Pipe to shell command..." ibuffer-do-shell-command-pipe + :help "For each marked buffer, send its contents to a shell command")) + (define-key-after operate-map [do-shell-command-pipe-replace] + '(menu-item "Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace + :help "For each marked buffer, replace its contents with output of shell command")) + (define-key-after operate-map [do-shell-command-file] + '(menu-item "Shell command on buffer's file..." ibuffer-do-shell-command-file + :help "For each marked buffer, run a shell command with its file as argument")) + (define-key-after operate-map [do-eval] + '(menu-item "Eval..." ibuffer-do-eval + :help "Evaluate a Lisp form in each marked buffer")) + (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))) + +(defvar ibuffer-name-map nil) +(unless ibuffer-name-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map ibuffer-mode-map) + (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))) + +(defvar ibuffer-mode-name-map nil) +(unless ibuffer-mode-name-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map ibuffer-mode-map) + (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))) + +;; quiet the byte-compiler +(defvar ibuffer-mode-operate-menu nil) +(defvar ibuffer-mode-mark-menu nil) +(defvar ibuffer-mode-view-menu nil) + +(defvar ibuffer-mode-hooks nil) + +(defvar ibuffer-delete-window-on-quit nil + "Whether or not to delete the window upon exiting `ibuffer'.") + +(defvar ibuffer-did-modification nil) + +(defvar ibuffer-sorting-functions-alist nil + "An alist of functions which describe how to sort buffers. + +Note: You most likely do not want to modify this variable directly; +use `define-ibuffer-sorter' instead. + +The alist elements are constructed like (NAME DESCRIPTION FUNCTION) +Where NAME is a symbol describing the sorting method, DESCRIPTION is a +short string which will be displayed in the minibuffer and menu, and +FUNCTION is a function of two arguments, which will be the buffers to +compare.") + +;;; Utility functions +(defun ibuffer-columnize-and-insert-list (list &optional pad-width) + "Insert LIST into the current buffer in as many columns as possible. +The maximum number of columns is determined by the current window +width and the longest string in LIST." + (unless pad-width + (setq pad-width 3)) + (let ((width (window-width)) + (max (+ (apply #'max (mapcar #'length list)) + pad-width))) + (let ((columns (/ width max))) + (when (zerop columns) + (setq columns 1)) + (while list + (dotimes (i (1- columns)) + (insert (concat (car list) (make-string (- max (length (car list))) + ? ))) + (setq list (cdr list))) + (when (not (null list)) + (insert (pop list))) + (insert "\n"))))) + +(defun ibuffer-accumulate-lines (count) + (save-excursion + (let ((forwardp (> count 0)) + (result nil)) + (while (not (or (zerop count) + (if forwardp + (eobp) + (bobp)))) + (if forwardp + (decf count) + (incf count)) + (push + (buffer-substring + (line-beginning-position) + (line-end-position)) + result) + (forward-line (if forwardp 1 -1))) + (nreverse result)))) + +(defsubst ibuffer-current-mark () + (cadr (get-text-property (line-beginning-position) + 'ibuffer-properties))) + +(defun ibuffer-mouse-toggle-mark (event) + "Toggle the marked status of the buffer chosen with the mouse." + (interactive "e") + (unwind-protect + (save-excursion + (mouse-set-point event) + (let ((mark (ibuffer-current-mark))) + (setq buffer-read-only nil) + (if (eq mark ibuffer-marked-char) + (ibuffer-set-mark ? ) + (ibuffer-set-mark ibuffer-marked-char)))) + (setq buffer-read-only t))) + +(defun ibuffer-find-file (file &optional wildcards) + "Like `find-file', but default to the directory of the buffer at point." + (interactive + (let ((default-directory (let ((buf (ibuffer-current-buffer))) + (if (buffer-live-p buf) + (with-current-buffer buf + default-directory) + default-directory)))) + (list (read-file-name "Find file: " default-directory) + current-prefix-arg))) + (find-file file wildcards)) + +(defun ibuffer-mouse-visit-buffer (event) + "Visit the buffer chosen with the mouse." + (interactive "e") + (switch-to-buffer + (save-excursion + (mouse-set-point event) + (ibuffer-current-buffer)))) + +(defun ibuffer-mouse-popup-menu (event) + "Display a menu of operations." + (interactive "e") + (let ((origline (count-lines (point-min) (point)))) + (unwind-protect + (progn + (setq buffer-read-only nil) + (ibuffer-save-marks + ;; hm. we could probably do this in a better fashion + (ibuffer-unmark-all ?\r) + (setq buffer-read-only nil) + (mouse-set-point event) + (ibuffer-set-mark ibuffer-marked-char) + (setq buffer-read-only nil) + (save-excursion + (popup-menu ibuffer-mode-operate-map)))) + (progn + (setq buffer-read-only t) + (goto-line (1+ origline)))))) + +(defun ibuffer-backward-line (&optional arg) + "Move backwards ARG lines, wrapping around the list if necessary." + (interactive "P") + (unless arg + (setq arg 1)) + (beginning-of-line) + (while (> arg 0) + (forward-line -1) + (when (get-text-property (point) 'ibuffer-title) + (goto-char (point-max)) + (forward-line -1) + (setq arg 0)) + (setq arg (1- arg)))) + +(defun ibuffer-forward-line (&optional arg) + "Move forward ARG lines, wrapping around the list if necessary." + (interactive "P") + (unless arg + (setq arg 1)) + (beginning-of-line) + (if (< arg 0) + (ibuffer-backward-line (- arg)) + (progn + (when (get-text-property (point) 'ibuffer-title) + ;; If we're already on the title, moving past it counts as + ;; moving a line. + (decf arg) + (while (and (get-text-property (point) 'ibuffer-title) + (not (eobp))) + (forward-line 1))) + (while (> arg 0) + (forward-line 1) + (when (eobp) + (goto-char (point-min))) + (while (and (get-text-property (point) 'ibuffer-title) + (not (eobp))) + (forward-line 1)) + (setq arg (1- arg)))))) + +(defun ibuffer-visit-buffer () + "Visit the buffer on this line." + (interactive) + (let ((buf (ibuffer-current-buffer))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed!" buf)) + (bury-buffer (current-buffer)) + (switch-to-buffer buf))) + +(defun ibuffer-visit-buffer-other-window (&optional noselect) + "Visit the buffer on this line in another window." + (interactive) + (let ((buf (ibuffer-current-buffer))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed!" buf)) + (bury-buffer (current-buffer)) + (if noselect + (let ((curwin (selected-window))) + (pop-to-buffer buf) + (select-window curwin)) + (switch-to-buffer-other-window buf)))) + +(defun ibuffer-visit-buffer-other-window-noselect () + "Visit the buffer on this line in another window, but don't select it." + (interactive) + (ibuffer-visit-buffer-other-window t)) + +(defun ibuffer-visit-buffer-other-frame () + "Visit the buffer on this line in another frame." + (interactive) + (let ((buf (ibuffer-current-buffer))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed!" buf)) + (bury-buffer (current-buffer)) + (switch-to-buffer-other-frame buf))) + +(defun ibuffer-visit-buffer-1-window () + "Visit the buffer on this line, and delete other windows." + (interactive) + (let ((buf (ibuffer-current-buffer))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed!" buf)) + (switch-to-buffer buf) + (delete-other-windows))) + +(defun ibuffer-bury-buffer () + "Bury the buffer on this line." + (interactive) + (let ((buf (ibuffer-current-buffer)) + (line (+ 1 (count-lines 1 (point))))) + (unless (buffer-live-p buf) + (error "Buffer %s has been killed!" buf)) + (bury-buffer buf) + (ibuffer-update nil t) + (goto-line line))) + +(defun ibuffer-visit-tags-table () + "Visit the tags table in the buffer on this line. See `visit-tags-table'." + (interactive) + (let ((file (buffer-file-name (ibuffer-current-buffer)))) + (if file + (visit-tags-table file) + (error "Specified buffer has no file")))) + +(defun ibuffer-do-view (&optional other-frame) + "View marked buffers, or the buffer on the current line. +If optional argument OTHER-FRAME is non-nil, then display each +marked buffer in a new frame. Otherwise, display each buffer as +a new window in the current frame, splitting vertically." + (interactive) + (ibuffer-do-view-1 (if other-frame 'other-frame 'vertically))) + +(defun ibuffer-do-view-horizontally (&optional other-frame) + "As `ibuffer-do-view', but split windows horizontally." + (interactive) + (ibuffer-do-view-1 (if other-frame 'other-frame 'horizontally))) + +(defun ibuffer-do-view-1 (type) + (let ((marked-bufs (ibuffer-get-marked-buffers))) + (when (null marked-bufs) + (setq marked-bufs (list (ibuffer-current-buffer)))) + (unless (and (eq type 'other-frame) + (not ibuffer-expert) + (> (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) + (delete-other-windows) + (switch-to-buffer (pop marked-bufs)) + (let ((height (/ (1- (if (eq type 'horizontally) (frame-width) + (frame-height))) + (1+ (length marked-bufs))))) + (mapcar (if (eq type 'other-frame) + #'(lambda (buf) + (let ((curframe (selected-frame))) + (select-frame (new-frame)) + (switch-to-buffer buf) + (select-frame curframe))) + #'(lambda (buf) + (split-window nil height (eq type 'horizontally)) + (other-window 1) + (switch-to-buffer buf))) + marked-bufs))))) + +(defun ibuffer-do-view-other-frame () + "View each of the marked buffers in a separate frame." + (interactive) + (ibuffer-do-view t)) + +(defsubst ibuffer-map-marked-lines (func) + (prog1 (ibuffer-map-on-mark ibuffer-marked-char func) + (ibuffer-redisplay t))) + +(defun ibuffer-shrink-to-fit (&optional owin) + (fit-window-to-buffer nil (when owin (/ (frame-height) + (length (window-list (selected-frame))))))) + +(defun ibuffer-confirm-operation-on (operation names) + "Display a buffer asking whether to perform OPERATION on NAMES." + (or ibuffer-expert + (if (= (length names) 1) + (y-or-n-p (format "Really %s buffer %s? " operation (car names))) + (let ((buf (get-buffer-create "*Ibuffer confirmation*"))) + (with-current-buffer buf + (setq buffer-read-only nil) + (erase-buffer) + (ibuffer-columnize-and-insert-list names) + (goto-char (point-min)) + (setq buffer-read-only t)) + (let ((lastwin (car (last (ibuffer-window-list))))) + ;; Now attempt to display the buffer... + (save-window-excursion + (select-window lastwin) + ;; The window might be too small to split; in that case, + ;; try a few times to increase its size before giving up. + (let ((attempts 0) + (trying t)) + (while trying + (condition-case err + (progn + (split-window) + (setq trying nil)) + (error + ;; Handle a failure + (if (or (> (incf attempts) 4) + (and (stringp (cadr err)) + ;; 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 + (progn + (fit-window-to-buffer) + (y-or-n-p (format "Really %s %d buffers? " + operation (length names)))) + (kill-buffer buf)))))))) + +(defsubst ibuffer-map-lines-nomodify (function) + "As `ibuffer-map-lines', but don't set the modification flag." + (ibuffer-map-lines function t)) + +(defun ibuffer-buffer-names-with-mark (mark) + (let ((ibuffer-buffer-names-with-mark-result nil)) + (ibuffer-map-lines-nomodify + #'(lambda (buf mk beg end) + (when (char-equal mark mk) + (push (buffer-name buf) + ibuffer-buffer-names-with-mark-result)))) + ibuffer-buffer-names-with-mark-result)) + +(defsubst ibuffer-marked-buffer-names () + (ibuffer-buffer-names-with-mark ibuffer-marked-char)) + +(defsubst ibuffer-deletion-marked-buffer-names () + (ibuffer-buffer-names-with-mark ibuffer-deletion-char)) + +(defun ibuffer-count-marked-lines (&optional all) + (if all + (ibuffer-map-lines-nomodify + #'(lambda (buf mark beg end) + (not (char-equal mark ? )))) + (ibuffer-map-lines-nomodify + #'(lambda (buf mark beg end) + (char-equal mark ibuffer-marked-char))))) + +(defsubst ibuffer-count-deletion-lines () + (ibuffer-map-lines-nomodify + #'(lambda (buf mark beg end) + (char-equal mark ibuffer-deletion-char)))) + +(defsubst ibuffer-map-deletion-lines (func) + (ibuffer-map-on-mark ibuffer-deletion-char func)) + +(define-ibuffer-op save () + "Save marked buffers as with `save-buffer'." + (:complex t + :opstring "saved" + :modifier-p :maybe) + (when (buffer-modified-p buf) + (if (not (with-current-buffer buf + buffer-file-name)) + ;; handle the case where we're prompted + ;; for a file name + (save-window-excursion + (switch-to-buffer buf) + (save-buffer)) + (with-current-buffer buf + (save-buffer)))) + t) + +(define-ibuffer-op toggle-modified () + "Toggle modification flag of marked buffers." + (:opstring "(un)marked as modified" + :modifier-p t) + (set-buffer-modified-p (not (buffer-modified-p)))) + +(define-ibuffer-op toggle-read-only () + "Toggle read only status in marked buffers." + (:opstring "toggled read only status in" + :modifier-p t) + (toggle-read-only)) + +(define-ibuffer-op delete () + "Kill marked buffers as with `kill-this-buffer'." + (:opstring "killed" + :active-opstring "kill" + :dangerous t + :complex t + :modifier-p t) + (if (kill-buffer buf) + 'kill + nil)) + +(define-ibuffer-op kill-on-deletion-marks () + "Kill buffers marked for deletion as with `kill-this-buffer'." + (:opstring "killed" + :active-opstring "kill" + :dangerous t + :complex t + :mark :deletion + :modifier-p t) + (if (kill-buffer buf) + 'kill + nil)) + +(defun ibuffer-unmark-all (mark) + "Unmark all buffers with mark MARK." + (interactive "cRemove marks (RET means all):") + (if (= (ibuffer-count-marked-lines t) 0) + (message "No buffers marked; use 'm' to mark a buffer") + (cond + ((char-equal mark ibuffer-marked-char) + (ibuffer-map-marked-lines + #'(lambda (buf mark beg end) + (ibuffer-set-mark-1 ? ) + t))) + ((char-equal mark ibuffer-deletion-char) + (ibuffer-map-deletion-lines + #'(lambda (buf mark beg end) + (ibuffer-set-mark-1 ? ) + t))) + (t + (ibuffer-map-lines + #'(lambda (buf mark beg end) + (when (not (char-equal mark ? )) + (ibuffer-set-mark-1 ? )) + t))))) + (ibuffer-redisplay t)) + +(defun ibuffer-toggle-marks () + "Toggle which buffers are marked. +In other words, unmarked buffers become marked, and marked buffers +become unmarked." + (interactive) + (let ((count + (ibuffer-map-lines + #'(lambda (buf mark beg end) + (cond ((eq mark ibuffer-marked-char) + (ibuffer-set-mark-1 ? ) + nil) + ((eq mark ? ) + (ibuffer-set-mark-1 ibuffer-marked-char) + t) + (t + nil)))))) + (message "%s buffers marked" count)) + (ibuffer-redisplay t)) + +(defun ibuffer-mark-forward (arg) + "Mark the buffer on this line, and move forward ARG lines." + (interactive "P") + (ibuffer-mark-interactive arg ibuffer-marked-char 1)) + +(defun ibuffer-unmark-forward (arg) + "Unmark the buffer on this line, and move forward ARG lines." + (interactive "P") + (ibuffer-mark-interactive arg ? 1)) + +(defun ibuffer-unmark-backward (arg) + "Unmark the buffer on this line, and move backward ARG lines." + (interactive "P") + (ibuffer-mark-interactive arg ? -1)) + +(defun ibuffer-mark-interactive (arg mark movement) + (assert (eq major-mode 'ibuffer-mode)) + (unless arg + (setq arg 1)) + (while (and (get-text-property (line-beginning-position) + 'ibuffer-title) + (not (eobp))) + (forward-line 1)) + + (let ((inhibit-read-only t)) + (while (> arg 0) + (ibuffer-set-mark mark) + (forward-line movement) + (when (or (get-text-property (line-beginning-position) + 'ibuffer-title) + (eobp)) + (forward-line (- movement)) + (setq arg 0)) + (setq arg (1- arg))))) + +(defun ibuffer-set-mark (mark) + (assert (eq major-mode 'ibuffer-mode)) + (let ((inhibit-read-only t)) + (ibuffer-set-mark-1 mark) + (setq ibuffer-did-modification t) + (ibuffer-redisplay-current))) + +(defun ibuffer-set-mark-1 (mark) + (let ((beg (line-beginning-position)) + (end (line-end-position))) + (put-text-property beg end 'ibuffer-properties + (list (ibuffer-current-buffer) + mark)))) + +(defun ibuffer-mark-for-delete (arg) + "Mark the buffers on ARG lines forward for deletion." + (interactive "P") + (ibuffer-mark-interactive arg ibuffer-deletion-char 1)) + +(defun ibuffer-mark-for-delete-backwards (arg) + "Mark the buffers on ARG lines backward for deletion." + (interactive "P") + (ibuffer-mark-interactive arg ibuffer-deletion-char -1)) + +(defun ibuffer-current-buffer (&optional must-be-live) + (let ((buf (car (get-text-property (line-beginning-position) + 'ibuffer-properties)))) + (when (and must-be-live + (not (buffer-live-p buf))) + (error "Buffer %s has been killed!" buf)) + buf)) + +(defun ibuffer-current-format () + (when (null ibuffer-formats) + (error "No format!")) + (ibuffer-check-formats) + (or ibuffer-current-format + (setq ibuffer-current-format 0)) + (nth ibuffer-current-format ibuffer-compiled-formats)) + +(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))) + form)) + +(defun ibuffer-compile-make-eliding-form (strvar elide from-end-p) + (let ((ellipsis (if (ibuffer-use-fontification) + (propertize ibuffer-eliding-string 'face 'bold) + ibuffer-eliding-string))) + (if (or elide ibuffer-elide-long-columns) + `(if (> strlen 5) + ,(if from-end-p + `(concat ,ellipsis + (substring ,strvar + (length ibuffer-eliding-string))) + `(concat + (substring ,strvar 0 (- strlen ,(length ellipsis))) + ,ellipsis)) + ,strvar) + strvar))) + +(defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p) + (if from-end-p + `(substring str + (- strlen ,maxvar)) + `(substring ,strvar 0 ,maxvar))) + +(defun ibuffer-compile-make-format-form (strvar widthform alignment) + (let* ((left `(make-string tmp2 ? )) + (right `(make-string (- tmp1 tmp2) ? ))) + `(progn + (setq tmp1 ,widthform + tmp2 (/ tmp1 2)) + ,(case alignment + (:right `(concat ,left ,right ,strvar)) + (:center `(concat ,left ,strvar ,right)) + (:left `(concat ,strvar ,left ,right)) + (t (error "Invalid alignment %s" alignment)))))) + +(defun ibuffer-compile-format (format) + (let ((result nil) + str-used + tmp1-used tmp2-used global-strlen-used) + (dolist (form format) + (push + (if (stringp form) + `(insert ,form) + (let* ((form (ibuffer-expand-format-entry form)) + (sym (nth 0 form)) + (min (nth 1 form)) + (max (nth 2 form)) + (align (nth 3 form)) + (elide (nth 4 form))) + (let* ((from-end-p (when (minusp min) + (setq min (- min)) + t)) + (letbindings nil) + (outforms nil) + minform + maxform + min-used max-used strlen-used) + (when (or (not (integerp min)) (>= min 0)) + (setq min-used t) + (setq str-used t strlen-used t global-strlen-used t + tmp1-used t tmp2-used t) + (setq minform `(progn + (setq str + ,(ibuffer-compile-make-format-form + 'str + `(- ,(if (integerp min) + min + 'min) + strlen) + align))))) + (when (or (not (integerp max)) (> max 0)) + (setq str-used t max-used t) + (setq maxform `(progn + (setq str + ,(ibuffer-compile-make-substring-form + 'str + (if (integerp max) + max + 'max) + from-end-p)) + (setq strlen (length str)) + (setq str + ,(ibuffer-compile-make-eliding-form 'str + elide + from-end-p))))) + (let ((callform (ibuffer-aif (assq sym ibuffer-inline-columns) + (nth 1 it) + `(,sym buffer mark))) + (mincompform `(< strlen ,(if (integerp min) + min + 'min))) + (maxcompform `(> strlen ,(if (integerp max) + max + 'max)))) + (if (or min-used max-used) + (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 `((insert str))))) + (push `(insert ,callform) outforms)) + `(let ,letbindings + ,@outforms))))) + result)) + (setq result + (funcall (if (or ibuffer-always-compile-formats + (featurep 'bytecomp)) + #'byte-compile + #'identity) + (nconc (list 'lambda '(buffer mark)) + `((let ,(append '(pt) + (when str-used + '(str)) + (when global-strlen-used + '(strlen)) + (when tmp1-used + '(tmp1)) + (when tmp2-used + '(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) + (setq ibuffer-compiled-formats + (mapcar #'ibuffer-compile-format ibuffer-formats))) + +(defun ibuffer-check-formats () + (when (or (null ibuffer-compiled-formats) + (null ibuffer-cached-formats) + (not (equal ibuffer-cached-formats ibuffer-formats)) + (null ibuffer-cached-eliding-string) + (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))) + (message "Formats have changed, recompiling...") + (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) + (message "Formats have changed, recompiling...done"))) + +(defvar ibuffer-inline-columns nil) + +(define-ibuffer-column mark (:name " " :inline t) + (string mark)) + +(define-ibuffer-column read-only (:name "R" :inline t) + (if buffer-read-only + "%" + " ")) + +(define-ibuffer-column modified (:name "M" :inline t) + (if (buffer-modified-p) + (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")) + (buffer-name)) + +(define-ibuffer-column size (:inline t) + (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")) + (format "%s" mode-name)) + +(define-ibuffer-column process () + (let ((proc (get-buffer-process buffer))) + (format "%s" (if proc + (list proc (process-status proc)) + "none")))) + +(define-ibuffer-column filename () + (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist)) + (abbreviate-file-name + (or buffer-file-name + (and (boundp 'dired-directory) + dired-directory) + "")))) + +(defun ibuffer-format-column (str width alignment) + (let ((left (make-string (/ width 2) ? )) + (right (make-string (- width (/ width 2)) ? ))) + (case alignment + (:right (concat left right str)) + (:center (concat left str right)) + (t (concat str left right))))) + +(defun ibuffer-fontify-region-function (beg end &optional verbose) + (when verbose (message "Fontifying...")) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char beg) + (beginning-of-line) + (while (< (point) end) + (if (get-text-property (point) 'ibuffer-title-header) + (put-text-property (point) (line-end-position) 'face ibuffer-title-face) + (unless (get-text-property (point) 'ibuffer-title) + (multiple-value-bind (buf mark) + (get-text-property (point) 'ibuffer-properties) + (let* ((namebeg (next-single-property-change (point) 'ibuffer-name-column + nil (line-end-position))) + (nameend (next-single-property-change namebeg 'ibuffer-name-column + nil (line-end-position)))) + (put-text-property namebeg + nameend + 'face + (cond ((char-equal mark ibuffer-marked-char) + ibuffer-marked-face) + ((char-equal mark ibuffer-deletion-char) + ibuffer-deletion-face) + (t + (let ((level -1) + result) + (dolist (e ibuffer-fontification-alist result) + (when (and (> (car e) level) + (with-current-buffer buf + (eval (cadr e)))) + (setq level (car e) + result + (if (symbolp (caddr e)) + (if (facep (caddr e)) + (caddr e) + (symbol-value (caddr e))))))))))))))) + (forward-line 1)))) + (when verbose (message "Fontifying...done"))) + +(defun ibuffer-unfontify-region-function (beg end) + (let ((inhibit-read-only t)) + (remove-text-properties beg end '(face nil)))) + +(defun ibuffer-insert-buffer-line (buffer mark format) + "Insert a line describing BUFFER and MARK using FORMAT." + (assert (eq major-mode 'ibuffer-mode)) + (let ((beg (point))) + ;; Here we inhibit `syntax-ppss-after-change-function' and other + ;; things font-lock uses. Otherwise, updating is slowed down dramatically. + (funcall format buffer mark) + (put-text-property beg (point) 'ibuffer-properties (list buffer mark)) + (insert "\n") + (goto-char beg))) + +(defun ibuffer-redisplay-current () + (assert (eq major-mode 'ibuffer-mode)) + (when (eobp) + (forward-line -1)) + (beginning-of-line) + (let ((buf (ibuffer-current-buffer))) + (when buf + (let ((mark (ibuffer-current-mark))) + (delete-region (point) (1+ (line-end-position))) + (ibuffer-insert-buffer-line + buf mark + (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 beg end) + (if (char-equal mark mk) + (funcall func buf mark beg end) + nil)))) + +(defun ibuffer-map-lines (function &optional nomodify) + "Call FUNCTION for each buffer in an ibuffer. +Don't set the ibuffer modification flag iff NOMODIFY is non-nil. + + FUNCTION is called with four arguments: the buffer object itself, the +current mark symbol, and the beginning and ending line positions." + (assert (eq major-mode 'ibuffer-mode)) + (let ((curline (count-lines (point-min) + (line-beginning-position))) + (deleted-lines-count 0) + (ibuffer-map-lines-total 0) + (ibuffer-map-lines-count 0)) + (unwind-protect + (progn + (setq buffer-read-only nil) + (goto-char (point-min)) + (while (and (get-text-property (point) 'ibuffer-title) + (not (eobp))) + (forward-line 1)) + (while (not (eobp)) + (let ((result + (if (buffer-live-p (ibuffer-current-buffer)) + (save-excursion + (funcall function + (ibuffer-current-buffer) + (ibuffer-current-mark) + (line-beginning-position) + (1+ (line-end-position)))) + ;; Kill the line if the buffer is dead + 'kill))) + ;; A given mapping function should return: + ;; `nil' if it chose not to affect the buffer + ;; `kill' means the remove line from the buffer list + ;; `t' otherwise + (incf ibuffer-map-lines-total) + (cond ((null result) + (forward-line 1)) + ((eq result 'kill) + (delete-region (line-beginning-position) + (1+ (line-end-position))) + (incf deleted-lines-count) + (incf ibuffer-map-lines-count)) + (t + (incf ibuffer-map-lines-count) + (forward-line 1))))) + ibuffer-map-lines-count) + (progn + (setq buffer-read-only t) + (unless nomodify + (set-buffer-modified-p nil)) + (goto-line (- (1+ curline) deleted-lines-count)))))) + +(defun ibuffer-get-marked-buffers () + "Return a list of buffer objects currently marked." + (delq nil + (mapcar #'(lambda (e) + (when (eq (cdr e) ibuffer-marked-char) + (car e))) + (ibuffer-current-state-list)))) + +(defun ibuffer-current-state-list (&optional include-lines) + "Return a list like (BUF . MARK) of all buffers in an ibuffer. +If optional argument INCLUDE-LINES is non-nil, return a list like + (BUF MARK BEGPOS)." + (let ((ibuffer-current-state-list-tmp '())) + ;; ah, if only we had closures. I bet this will mysteriously + ;; break later. Don't blame me. + (ibuffer-map-lines-nomodify + (if include-lines + #'(lambda (buf mark beg end) + (when (buffer-live-p buf) + (push (list buf mark beg) ibuffer-current-state-list-tmp))) + #'(lambda (buf mark beg end) + (when (buffer-live-p buf) + (push (cons buf mark) ibuffer-current-state-list-tmp))))) + (nreverse ibuffer-current-state-list-tmp))) + +(defsubst ibuffer-canonicalize-state-list (bmarklist) + "Order BMARKLIST in the same way as the current buffer list." + (delq nil + (mapcar #'(lambda (buf) (assq buf bmarklist)) (buffer-list)))) + +(defun ibuffer-current-buffers-with-marks () + "Return a list like (BUF . MARK) of all open buffers." + (let ((bufs (ibuffer-current-state-list))) + (mapcar #'(lambda (buf) (let ((e (assq buf bufs))) + (if e + e + (cons buf ? )))) + (buffer-list)))) + +(defun ibuffer-buf-matches-predicates (buf predicates) + (let ((hit nil) + (name (buffer-name buf))) + (dolist (pred predicates) + (when (if (stringp pred) + (string-match pred name) + (funcall pred buf)) + (setq hit t))) + hit)) + +(defun ibuffer-filter-buffers (ibuffer-buf last bmarklist all) + (let ((ext-loaded (featurep 'ibuf-ext))) + (delq nil + (mapcar + ;; element should be like (BUFFER . MARK) + #'(lambda (e) + (let* ((buf (car e))) + (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)) + e))) + bmarklist)))) + +(defun ibuffer-visible-p (buf all &optional ibuffer-buf) + (and (or all + (not + (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates))) + (or ibuffer-view-ibuffer + (and ibuffer-buf + (not (eq ibuffer-buf buf)))))) + +;; This function is a special case; it's not defined by +;; `ibuffer-define-sorter'. +(defun ibuffer-do-sort-by-recency () + "Sort the buffers by last view time." + (interactive) + (setq ibuffer-sorting-mode 'recency) + (ibuffer-redisplay t)) + +(defun ibuffer-update-format () + (when (null ibuffer-current-format) + (setq ibuffer-current-format 0)) + (when (null ibuffer-formats) + (error "Ibuffer error: no formats!"))) + +(defun ibuffer-switch-format () + "Switch the current display format." + (interactive) + (assert (eq major-mode 'ibuffer-mode)) + (unless (consp ibuffer-formats) + (error "Ibuffer error: No formats!")) + (setq ibuffer-current-format + (if (>= ibuffer-current-format (1- (length ibuffer-formats))) + 0 + (1+ ibuffer-current-format))) + (ibuffer-update-format) + (ibuffer-redisplay t)) + +(defun ibuffer-update-title (format) + (assert (eq major-mode 'ibuffer-mode)) + ;; Don't do funky font-lock stuff here + (let ((after-change-functions nil)) + (if (get-text-property (point-min) 'ibuffer-title) + (delete-region (point-min) + (next-single-property-change + (point-min) 'ibuffer-title))) + (goto-char (point-min)) + (put-text-property + (point) + (progn + (let ((opos (point))) + ;; Insert the title names. + (dolist (element (mapcar #'ibuffer-expand-format-entry format)) + (insert + (if (stringp element) + element + (let ((sym (car element)) + (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* ((name (or (get sym 'ibuffer-column-name) + (error "Unknown column %s in ibuffer-formats" sym))) + (len (length name))) + (prog1 + (if (< len min) + (ibuffer-format-column name + (- min len) + align) + name))))))) + (put-text-property opos (point) 'ibuffer-title-header t) + (insert "\n") + ;; Add the underlines + (let ((str (save-excursion + (forward-line -1) + (beginning-of-line) + (buffer-substring (point) (line-end-position))))) + (apply #'insert (mapcar + #'(lambda (c) + (if (not (or (char-equal c ? ) + (char-equal c ?\n))) + ?- + ? )) + str))) + (insert "\n")) + (point)) + 'ibuffer-title t))) + +(defun ibuffer-update-mode-name () + (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode + ibuffer-sorting-mode + "recency"))) + (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. + +This does not show new buffers; use `ibuffer-update' for that. + +If SILENT is non-`nil', do not generate progress messages." + (interactive) + (unless silent + (message "Redisplaying current buffer list...")) + (let ((blist (ibuffer-current-state-list))) + (when (null blist) + (if (and (featurep 'ibuf-ext) + ibuffer-filtering-qualifiers) + (message "No buffers! (note: filtering in effect)") + (error "No buffers!"))) + (ibuffer-insert-buffers-and-marks blist t) + (ibuffer-update-mode-name) + (unless silent + (message "Redisplaying current buffer list...done")))) + +(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. + +Do not display messages if SILENT is non-nil." + (interactive "P") + (let* ((bufs (buffer-list)) + (blist (ibuffer-filter-buffers + (current-buffer) + (if (and + (cadr bufs) + (eq ibuffer-always-show-last-buffer + :nomini) + ;; This is a hack. + (string-match " \\*Minibuf" + (buffer-name (cadr bufs)))) + (caddr bufs) + (cadr bufs)) + (ibuffer-current-buffers-with-marks) + arg))) + (when (null blist) + (if (and (featurep 'ibuf-ext) + ibuffer-filtering-qualifiers) + (message "No buffers! (note: filtering in effect)") + (error "No buffers!"))) + (unless silent + (message "Updating buffer list...")) + (ibuffer-insert-buffers-and-marks blist + arg) + (ibuffer-update-mode-name) + (unless silent + (message "Updating buffer list...done"))) + (if (eq ibuffer-shrink-to-minimum-size 'onewindow) + (ibuffer-shrink-to-fit t) + (when ibuffer-shrink-to-minimum-size + (ibuffer-shrink-to-fit))) + (ibuffer-forward-line 0)) + +(defun ibuffer-insert-buffers-and-marks (bmarklist &optional all) + (assert (eq major-mode 'ibuffer-mode)) + (let ((--ibuffer-insert-buffers-and-marks-format + (ibuffer-current-format)) + (orig (count-lines (point-min) (point))) + ;; Inhibit font-lock caching tricks, since we're modifying the + ;; entire buffer at once + (after-change-functions nil)) + (unwind-protect + (progn + (setq buffer-read-only nil) + (erase-buffer) + (ibuffer-update-format) + (let ((entries + (let* ((sortdat (assq ibuffer-sorting-mode + ibuffer-sorting-functions-alist)) + (func (caddr sortdat))) + (let ((result + ;; actually sort the buffers + (if (and sortdat func) + (sort bmarklist func) + bmarklist))) + ;; perhaps reverse the sorted buffer list + (if ibuffer-sorting-reversep + result + (nreverse result)))))) + (dolist (entry entries) + (ibuffer-insert-buffer-line + (car entry) + (cdr entry) + --ibuffer-insert-buffers-and-marks-format))) + (ibuffer-update-title (nth ibuffer-current-format ibuffer-formats))) + (setq buffer-read-only t) + (set-buffer-modified-p ibuffer-did-modification) + (setq ibuffer-did-modification nil) + (goto-line (1+ orig))))) + +(defun ibuffer-quit () + "Quit this `ibuffer' session. +Delete the current window iff `ibuffer-delete-window-on-quit' is non-nil." + (interactive) + (if ibuffer-delete-window-on-quit + (progn + (bury-buffer) + (unless (= (count-windows) 1) + (delete-window))) + (bury-buffer))) + +;;;###autoload +(defun ibuffer-list-buffers (&optional files-only) + "Display a list of buffers, in another window. +If optional argument FILES-ONLY is non-nil, then add a filter for +buffers which are visiting a file." + (interactive "P") + (ibuffer t nil (when files-only + '((filename . ".*"))) t)) + +;;;###autoload +(defun ibuffer-other-window (&optional files-only) + "Like `ibuffer', but displayed in another window by default. +If optional argument FILES-ONLY is non-nil, then add a filter for +buffers which are visiting a file." + (interactive "P") + (ibuffer t nil (when files-only + '((filename . ".*"))))) + +;;;###autoload +(defun ibuffer (&optional other-window-p name qualifiers noselect shrink) + "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." + (interactive "P") + (when ibuffer-use-other-window + (setq other-window-p (not other-window-p))) + (let* ((buf (get-buffer-create (or name "*Ibuffer*"))) + (already-in (eq (current-buffer) buf)) + (need-update nil)) + (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)) + (with-current-buffer buf + (let ((owin (selected-window))) + (unwind-protect + (progn + ;; 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)) + (when (ibuffer-use-fontification) + (require 'font-lock)) + (setq ibuffer-delete-window-on-quit other-window-p) + (when shrink + (setq ibuffer-shrink-to-minimum-size shrink)) + (when qualifiers + (setq ibuffer-filtering-qualifiers qualifiers)) + (ibuffer-update nil) + (unwind-protect + (progn + (setq buffer-read-only nil) + (run-hooks 'ibuffer-hooks)) + (setq buffer-read-only t)) + (unless ibuffer-expert + (message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for help"))) + (select-window owin)))))) + +(defun ibuffer-mode () + "A major mode for viewing a list of buffers. +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. + +Operations on marked buffers: + + '\\[ibuffer-do-save]' - Save the marked buffers + '\\[ibuffer-do-view]' - View the marked buffers in this frame. + '\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame. + '\\[ibuffer-do-revert]' - Revert the marked buffers. + '\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers. + '\\[ibuffer-do-delete]' - Kill the marked buffers. + '\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked + buffers. + '\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers. + '\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression. + '\\[ibuffer-do-print]' - Print the marked buffers. + '\\[ibuffer-do-occur]' - List lines in all marked buffers which match + a given regexp (like the function `occur'). + '\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked + buffers to a shell command. + '\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked + buffers with the output of a shell command. + '\\[ibuffer-do-shell-command-file]' - Run a shell command with the + buffer's file as an argument. + '\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This + is a very flexible command. For example, if you want to make all + of the marked buffers read only, try using (toggle-read-only 1) as + the input form. + '\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form + is evaluated. + '\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer, + but don't kill the associated buffer. + '\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion. + +Marking commands: + + '\\[ibuffer-mark-forward]' - Mark the buffer at point. + '\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark + all unmarked buffers. + '\\[ibuffer-unmark-forward]' - Unmark the buffer at point. + '\\[ibuffer-unmark-backward]' - Unmark the buffer at point, and move to the + previous line. + '\\[ibuffer-unmark-all]' - Unmark all marked buffers. + '\\[ibuffer-mark-by-mode]' - Mark buffers by major mode. + '\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers. + This means that the buffer is modified, and has an associated file. + '\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers, + regardless of whether or not they have an associated file. + '\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and + ends with '*'. + '\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have + an associated file, but that file doesn't currently exist. + '\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers. + '\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired' mode. + '\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc. + '\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'. + '\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion. + '\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp. + '\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp. + '\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp. + +Filtering commands: + + '\\[ibuffer-filter-by-mode]' - Add a filter by major mode. + '\\[ibuffer-filter-by-name]' - Add a filter by buffer name. + '\\[ibuffer-filter-by-content]' - Add a filter by buffer content. + '\\[ibuffer-filter-by-filename]' - Add a filter by filename. + '\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size. + '\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size. + '\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate. + '\\[ibuffer-save-filters]' - Save the current filters with a name. + '\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters. + '\\[ibuffer-add-saved-filters]' - Add saved filters to current filters. + '\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR. + '\\[ibuffer-pop-filter]' - Remove the top filter. + '\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter. + '\\[ibuffer-decompose-filter]' - Break down the topmost filter. + '\\[ibuffer-filter-disable]' - Remove all filtering currently in effect. + +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-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-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 + and its associated file. + '\\[ibuffer-visit-buffer]' - View the buffer on this line. + '\\[ibuffer-visit-buffer-other-window]' - As above, but in another window. + '\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select + the new window. + '\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line. + +Information on Filtering: + + You can filter your ibuffer view via different critera. Each Ibuffer +buffer has its own stack of active filters. For example, suppose you +are working on an Emacs Lisp project. You can create an Ibuffer +buffer displays buffers in just `emacs-lisp' modes via +'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET'. In this case, there +is just one entry on the filtering stack. + +You can also combine filters. The various filtering commands push a +new filter onto the stack, and the filters combine to show just +buffers which satisfy ALL criteria on the stack. For example, suppose +you only want to see buffers in `emacs-lisp' mode, whose names begin +with \"gnus\". You can accomplish this via: +'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET +\\[ibuffer-filter-by-name] ^gnus RET'. + +Additionally, you can OR the top two filters together with +'\\[ibuffer-or-filters]'. To see all buffers in either +`emacs-lisp-mode' or `lisp-interaction-mode', type: + +'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET \\[ibuffer-filter-by-mode] lisp-interaction-mode RET \\[ibuffer-or-filters]'. + +Filters can also be saved and restored using mnemonic names: see the +functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'. + +To remove the top filter on the stack, use '\\[ibuffer-pop-filter]', and +to disable all filtering currently in effect, use +'\\[ibuffer-filter-disable]'." + (kill-all-local-variables) + (use-local-map ibuffer-mode-map) + (setq major-mode 'ibuffer-mode) + (setq mode-name "Ibuffer") + (setq buffer-read-only t) + (buffer-disable-undo) + (setq truncate-lines t) + ;; This makes things less ugly for Emacs 21 users with a non-nil + ;; `show-trailing-whitespace'. + (setq show-trailing-whitespace nil) + ;; Dummy font-lock-defaults to make font-lock turn on. We want this + ;; so we know when to enable ibuffer's internal fontification. + (set (make-local-variable 'font-lock-defaults) + '(nil t nil nil nil + (font-lock-fontify-region-function . ibuffer-fontify-region-function) + (font-lock-unfontify-region-function . ibuffer-unfontify-region-function))) + (set (make-local-variable 'revert-buffer-function) + #'ibuffer-update) + (set (make-local-variable 'ibuffer-sorting-mode) + ibuffer-default-sorting-mode) + (set (make-local-variable 'ibuffer-sorting-reversep) + ibuffer-default-sorting-reversep) + (set (make-local-variable 'ibuffer-shrink-to-minimum-size) + ibuffer-default-shrink-to-minimum-size) + (set (make-local-variable 'ibuffer-filtering-qualifiers) nil) + (set (make-local-variable 'ibuffer-compiled-formats) nil) + (set (make-local-variable 'ibuffer-cached-formats) nil) + (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-did-modification) nil) + (when (featurep 'ibuf-ext) + (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil) + (set (make-local-variable 'ibuffer-tmp-show-regexps) nil)) + (define-key ibuffer-mode-map [menu-bar edit] 'undefined) + (define-key ibuffer-mode-map [menu-bar operate] (cons "Operate" ibuffer-mode-operate-map)) + (ibuffer-update-format) + (when ibuffer-default-directory + (setq default-directory ibuffer-default-directory)) + (run-hooks 'ibuffer-mode-hooks) + ;; called after mode hooks to allow the user to add filters + (ibuffer-update-mode-name)) + +(provide 'ibuffer) + +;; Local Variables: +;; coding: iso-8859-1 +;; End: + +;;; ibuffer.el ends here |