X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bde5791106abfdd8a7738419481f2074b6ae7e98..5fd6d89f46d4603757d5669904637201dd6677bb:/lisp/ibuf-ext.el diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 64e335c354..9aef1ed95b 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1,12 +1,13 @@ -;;; ibuf-ext.el --- extensions for ibuffer -*-byte-compile-dynamic: t;-*- +;;; ibuf-ext.el --- extensions for ibuffer -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Colin Walters +;; Maintainer: John Paul Wallington ;; Created: 2 Dec 2001 ;; Keywords: buffer, convenience -;; This file is not currently part of GNU Emacs. +;; This file is 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 @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program ; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -34,7 +35,6 @@ (require 'ibuffer) (eval-when-compile - (require 'derived) (require 'ibuf-macs) (require 'cl)) @@ -46,14 +46,26 @@ (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)) +;; borrowed from Gnus +(defun ibuffer-remove-duplicates (list) + "Return a copy of LIST with duplicate elements removed." + (let ((new nil) + (tail list)) + (while tail + (or (member (car tail) new) + (setq new (cons (car tail) new))) + (setq tail (cdr tail))) + (nreverse new))) + +(defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts) + (let ((hip-crowd nil) + (lamers nil)) + (dolist (ibuffer-split-list-elt ibuffer-split-list-elts) + (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt) + (push ibuffer-split-list-elt hip-crowd) + (push ibuffer-split-list-elt lamers))) + ;; Too bad Emacs Lisp doesn't have multiple values. + (list (nreverse hip-crowd) (nreverse lamers)))) (defcustom ibuffer-never-show-predicates nil "A list of predicates (a regexp or function) for buffers not to display. @@ -75,7 +87,7 @@ regardless of any active filters in this buffer." (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.") @@ -86,25 +98,20 @@ Do not set this variable directly! Use the function (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-summary-mode) (mode . gnus-article-mode)))) ("programming" ((or (mode . emacs-lisp-mode) (mode . cperl-mode) (mode . c-mode) - (mode . java-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) @@ -148,7 +155,38 @@ to this variable." :group 'ibuffer) (defvar ibuffer-cached-filter-formats nil) -(defvar ibuffer-compiled-filter-formats nil) +(defvar ibuffer-compiled-filter-formats nil) + +(defvar ibuffer-filter-groups nil + "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers. +The SYMBOL should be one from `ibuffer-filtering-alist'. +The QUALIFIER should be the same as QUALIFIER in +`ibuffer-filtering-qualifiers'.") + +(defcustom ibuffer-show-empty-filter-groups t + "If non-nil, then show the names of filter groups which are empty." + :type 'boolean + :group 'ibuffer) + +(defcustom ibuffer-saved-filter-groups nil + "An alist of filtering groups 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-filter-groups', +`ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the +functions `ibuffer-switch-to-saved-filter-group', +`ibuffer-save-filter-group'." + :type '(repeat sexp) + :group 'ibuffer) + +(defvar ibuffer-hidden-filter-groups nil + "A list of filtering groups which are currently hidden.") + +(defvar ibuffer-filter-group-kill-ring nil) (defcustom ibuffer-old-time 72 "The number of hours before a buffer is considered \"old\"." @@ -160,7 +198,8 @@ to this variable." (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'." +Currently, this only applies to `ibuffer-saved-filters' and +`ibuffer-saved-filter-groups'." :type 'boolean :group 'ibuffer) @@ -175,7 +214,7 @@ Currently, this only applies to `ibuffer-saved-filters'." (not (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates))) (or ibuffer-view-ibuffer - (and ibuffer-buf + (and ibuffer-buf (not (eq ibuffer-buf buf)))) (or (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers) @@ -227,11 +266,73 @@ With numeric ARG, enable auto-update if and only if ARG is positive." (if (assq 'mode ibuffer-filtering-qualifiers) (setq ibuffer-filtering-qualifiers (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers)) - (ibuffer-push-filter (cons 'mode + (ibuffer-push-filter (cons 'mode (with-current-buffer buf major-mode))))) (ibuffer-update nil t)) +;;;###autoload +(defun ibuffer-mouse-toggle-filter-group (event) + "Toggle the display status of the filter group chosen with the mouse." + (interactive "e") + (ibuffer-toggle-filter-group-1 (save-excursion + (mouse-set-point event) + (point)))) + +;;;###autoload +(defun ibuffer-toggle-filter-group () + "Toggle the display status of the filter group on this line." + (interactive) + (ibuffer-toggle-filter-group-1 (point))) + +(defun ibuffer-toggle-filter-group-1 (posn) + (let ((name (get-text-property posn 'ibuffer-filter-group-name))) + (unless (stringp name) + (error "No filtering group name present")) + (if (member name ibuffer-hidden-filter-groups) + (setq ibuffer-hidden-filter-groups + (delete name ibuffer-hidden-filter-groups)) + (push name ibuffer-hidden-filter-groups)) + (ibuffer-update nil t))) + +;;;###autoload +(defun ibuffer-forward-filter-group (&optional count) + "Move point forwards by COUNT filtering groups." + (interactive "P") + (unless count + (setq count 1)) + (when (> count 0) + (when (get-text-property (point) 'ibuffer-filter-group-name) + (goto-char (next-single-property-change + (point) 'ibuffer-filter-group-name + nil (point-max)))) + (goto-char (next-single-property-change + (point) 'ibuffer-filter-group-name + nil (point-max))) + (ibuffer-forward-filter-group (1- count))) + (ibuffer-forward-line 0)) + +;;;###autoload +(defun ibuffer-backward-filter-group (&optional count) + "Move point backwards by COUNT filtering groups." + (interactive "P") + (unless count + (setq count 1)) + (when (> count 0) + (when (get-text-property (point) 'ibuffer-filter-group-name) + (goto-char (previous-single-property-change + (point) 'ibuffer-filter-group-name + nil (point-min)))) + (goto-char (previous-single-property-change + (point) 'ibuffer-filter-group-name + nil (point-min))) + (ibuffer-backward-filter-group (1- count))) + (when (= (point) (point-min)) + (goto-char (point-max)) + (ibuffer-backward-filter-group 1)) + (ibuffer-forward-line 0)) + +;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext.el") (define-ibuffer-op shell-command-pipe (command) "Pipe the contents of each marked buffer to shell command COMMAND." (:interactive "sPipe to shell command: " @@ -241,6 +342,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive." (point-min) (point-max) command (get-buffer-create "* ibuffer-shell-output*"))) +;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext.el") (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): " @@ -252,6 +354,7 @@ With numeric ARG, enable auto-update if and only if ARG is positive." (shell-command-on-region (point-min) (point-max) command nil t))) +;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext.el") (define-ibuffer-op shell-command-file (command) "Run shell command COMMAND separately on files of marked buffers." (:interactive "sShell command on buffer's file: " @@ -263,7 +366,8 @@ With numeric ARG, enable auto-update if and only if ARG is positive." buffer-file-name (make-temp-file (substring (buffer-name) 0 (min 10 (length (buffer-name)))))))))) - + +;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext.el") (define-ibuffer-op eval (form) "Evaluate FORM in each of the buffers. Does not display the buffer during evaluation. See @@ -273,6 +377,7 @@ Does not display the buffer during evaluation. See :modifier-p :maybe) (eval form)) +;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext.el") (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'." @@ -287,12 +392,14 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (eval form)) (switch-to-buffer ibuffer-buf)))) +;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext.el") (define-ibuffer-op rename-uniquely () "Rename marked buffers as with `rename-uniquely'." (:opstring "renamed" :modifier-p t) (rename-uniquely)) +;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext.el") (define-ibuffer-op revert () "Revert marked buffers as with `revert-buffer'." (:dangerous t @@ -301,6 +408,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." :modifier-p :maybe) (revert-buffer t t)) +;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext.el") (define-ibuffer-op replace-regexp (from-str to-str) "Perform a `replace-regexp' in marked buffers." (:interactive @@ -320,6 +428,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (replace-match to-str)))) t)) +;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext.el") (define-ibuffer-op query-replace (&rest args) "Perform a `query-replace' in marked buffers." (:interactive @@ -335,6 +444,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (apply #'query-replace args))) t)) +;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext.el") (define-ibuffer-op query-replace-regexp (&rest args) "Perform a `query-replace-regexp' in marked buffers." (:interactive @@ -350,6 +460,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (apply #'query-replace-regexp args))) t)) +;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext.el") (define-ibuffer-op print () "Print marked buffers as with `print-buffer'." (:opstring "printed" @@ -402,12 +513,250 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." buf (cdr filter)))))))))) +(defun ibuffer-generate-filter-groups (bmarklist) + (let ((filter-group-alist (append ibuffer-filter-groups + (list (cons "Default" nil))))) +;; (dolist (hidden ibuffer-hidden-filter-groups) +;; (setq filter-group-alist (ibuffer-delete-alist +;; hidden filter-group-alist))) + (let ((vec (make-vector (length filter-group-alist) nil)) + (i 0)) + (dolist (filtergroup filter-group-alist) + (let ((filterset (cdr filtergroup))) + (multiple-value-bind (hip-crowd lamers) + (ibuffer-split-list (lambda (bufmark) + (ibuffer-included-in-filters-p (car bufmark) + filterset)) + bmarklist) + (aset vec i hip-crowd) + (incf i) + (setq bmarklist lamers)))) + (let ((ret nil)) + (dotimes (j i ret) + (push (cons (car (nth j filter-group-alist)) + (aref vec j)) + ret)))))) + +;;;###autoload +(defun ibuffer-filters-to-filter-group (name) + "Make the current filters into a filtering group." + (interactive "sName for filtering group: ") + (when (null ibuffer-filtering-qualifiers) + (error "No filters in effect")) + (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups) + (ibuffer-filter-disable)) + +;;;###autoload +(defun ibuffer-set-filter-groups-by-mode () + "Set the current filter groups to filter by mode." + (interactive) + (setq ibuffer-filter-groups + (mapcar (lambda (mode) + (cons (format "%s" mode) `((mode . ,mode)))) + (let ((modes + (ibuffer-remove-duplicates + (mapcar (lambda (buf) + (with-current-buffer buf major-mode)) + (buffer-list))))) + (if ibuffer-view-ibuffer + modes + (delq 'ibuffer-mode modes))))) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-pop-filter-group () + "Remove the first filter group." + (interactive) + (when (null ibuffer-filter-groups) + (error "No filter groups active")) + (setq ibuffer-hidden-filter-groups + (delete (pop ibuffer-filter-groups) + ibuffer-hidden-filter-groups)) + (ibuffer-update nil t)) + +(defun ibuffer-read-filter-group-name (msg &optional nodefault noerror) + (when (and (not noerror) (null ibuffer-filter-groups)) + (error "No filter groups active")) + (let ((groups (mapcar #'car ibuffer-filter-groups))) + (completing-read msg (if nodefault + groups + (cons "Default" groups)) + nil t))) + +;;;###autoload +(defun ibuffer-decompose-filter-group (group) + "Decompose the filter group GROUP into active filters." + (interactive + (list (ibuffer-read-filter-group-name "Decompose filter group: " t))) + (let ((data (cdr (assoc group ibuffer-filter-groups)))) + (setq ibuffer-filter-groups (ibuffer-delete-alist + group ibuffer-filter-groups) + ibuffer-filtering-qualifiers data)) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-clear-filter-groups () + "Remove all filter groups." + (interactive) + (setq ibuffer-filter-groups nil + ibuffer-hidden-filter-groups nil) + (ibuffer-update nil t)) + +(defun ibuffer-current-filter-groups-with-position () + (save-excursion + (goto-char (point-min)) + (let ((pos nil) + (result nil)) + (while (and (not (eobp)) + (setq pos (next-single-property-change + (point) 'ibuffer-filter-group-name))) + (goto-char pos) + (push (cons (get-text-property (point) 'ibuffer-filter-group-name) + pos) + result) + (goto-char (next-single-property-change + pos 'ibuffer-filter-group-name))) + (nreverse result)))) + +;;;###autoload +(defun ibuffer-jump-to-filter-group (name) + "Move point to the filter group whose name is NAME." + (interactive + (list (ibuffer-read-filter-group-name "Jump to filter group: "))) + (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position)) + (goto-char (cdr it)) + (error "No filter group with name %s" name))) + +;;;###autoload +(defun ibuffer-kill-filter-group (name) + "Kill the filter group named NAME. +The group will be added to `ibuffer-filter-group-kill-ring'." + (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t))) + (when (equal name "Default") + (error "Can't kill default filter group")) + (ibuffer-aif (assoc name ibuffer-filter-groups) + (progn + (push (copy-tree it) ibuffer-filter-group-kill-ring) + (setq ibuffer-filter-groups (ibuffer-delete-alist + name ibuffer-filter-groups)) + (setq ibuffer-hidden-filter-groups + (delete name ibuffer-hidden-filter-groups))) + (error "No filter group with name \"%s\"" name)) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-kill-line (&optional arg interactive-p) + "Kill the filter group at point. +See also `ibuffer-kill-filter-group'." + (interactive "P\np") + (ibuffer-aif (save-excursion + (ibuffer-forward-line 0) + (get-text-property (point) 'ibuffer-filter-group-name)) + (progn + (ibuffer-kill-filter-group it)) + (funcall (if interactive-p #'call-interactively #'funcall) + #'kill-line arg))) + +(defun ibuffer-insert-filter-group-before (newgroup group) + (let* ((found nil) + (pos (let ((groups (mapcar #'car ibuffer-filter-groups)) + (res 0)) + (while groups + (if (equal (car groups) group) + (setq found t + groups nil) + (incf res) + (setq groups (cdr groups)))) + res))) + (cond ((not found) + (setq ibuffer-filter-groups + (nconc ibuffer-filter-groups (list newgroup)))) + ((zerop pos) + (push newgroup ibuffer-filter-groups)) + (t + (let ((cell (nthcdr pos ibuffer-filter-groups))) + (setf (cdr cell) (cons (car cell) (cdr cell))) + (setf (car cell) newgroup)))))) + +;;;###autoload +(defun ibuffer-yank () + "Yank the last killed filter group before group at point." + (interactive) + (ibuffer-yank-filter-group + (or (get-text-property (point) 'ibuffer-filter-group-name) + (get-text-property (point) 'ibuffer-filter-group) + (error "No filter group at point")))) + +;;;###autoload +(defun ibuffer-yank-filter-group (name) + "Yank the last killed filter group before group named NAME." + (interactive (list (ibuffer-read-filter-group-name + "Yank filter group before group: "))) + (unless ibuffer-filter-group-kill-ring + (error "The Ibuffer filter group kill-ring is empty")) + (save-excursion + (ibuffer-forward-line 0) + (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring) + name)) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-save-filter-groups (name groups) + "Save all active filter groups GROUPS as NAME. +They are added to `ibuffer-saved-filter-groups'. Interactively, +prompt for NAME, and use the current filters." + (interactive + (if (null ibuffer-filter-groups) + (error "No filter groups active") + (list + (read-from-minibuffer "Save current filter groups as: ") + ibuffer-filter-groups))) + (ibuffer-aif (assoc name ibuffer-saved-filter-groups) + (setcdr it groups) + (push (cons name groups) ibuffer-saved-filter-groups)) + (ibuffer-maybe-save-stuff) + (ibuffer-update-mode-name)) + +;;;###autoload +(defun ibuffer-delete-saved-filter-groups (name) + "Delete saved filter groups with NAME. +They are removed from `ibuffer-saved-filter-groups'." + (interactive + (list + (if (null ibuffer-saved-filter-groups) + (error "No saved filter groups") + (completing-read "Delete saved filter group: " + ibuffer-saved-filter-groups nil t)))) + (setq ibuffer-saved-filter-groups + (ibuffer-delete-alist name ibuffer-saved-filter-groups)) + (ibuffer-maybe-save-stuff) + (ibuffer-update nil t)) + +;;;###autoload +(defun ibuffer-switch-to-saved-filter-groups (name) + "Set this buffer's filter groups to saved version with NAME. +The value from `ibuffer-saved-filters' is used. +If prefix argument ADD is non-nil, then add the saved filters instead +of replacing the current filters." + (interactive + (list + (if (null ibuffer-saved-filter-groups) + (error "No saved filters") + (completing-read "Switch to saved filter group: " + ibuffer-saved-filter-groups nil t)))) + (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups)) + ibuffer-hidden-filter-groups nil) + (ibuffer-update nil t)) + ;;;###autoload (defun ibuffer-filter-disable () "Disable all filters currently in effect in this buffer." (interactive) (setq ibuffer-filtering-qualifiers nil) - (ibuffer-update nil t)) + (let ((buf (ibuffer-current-buffer))) + (ibuffer-update nil t) + (when buf + (ibuffer-jump-to-buffer (buffer-name buf))))) ;;;###autoload (defun ibuffer-pop-filter () @@ -416,7 +765,10 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (when (null ibuffer-filtering-qualifiers) (error "No filters in effect")) (pop ibuffer-filtering-qualifiers) - (ibuffer-update nil t)) + (let ((buf (ibuffer-current-buffer))) + (ibuffer-update nil t) + (when buf + (ibuffer-jump-to-buffer (buffer-name buf))))) (defun ibuffer-push-filter (qualifier) "Add QUALIFIER to `ibuffer-filtering-qualifiers'." @@ -431,7 +783,7 @@ 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")) + (error "No filters in effect")) (let ((lim (pop ibuffer-filtering-qualifiers))) (case (car lim) (or @@ -493,24 +845,28 @@ filter into parts." (not (eq 'or (caar ibuffer-filtering-qualifiers)))) (error "Top filter is not an OR")) (let ((lim (pop ibuffer-filtering-qualifiers))) - (setq ibuffer-filtering-qualifiers (nconc (cdr lim) 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 (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 () +(defun ibuffer-maybe-save-stuff () (when ibuffer-save-with-custom (if (fboundp 'customize-save-variable) (progn (customize-save-variable 'ibuffer-saved-filters - ibuffer-saved-filters)) + ibuffer-saved-filters) + (customize-save-variable 'ibuffer-saved-filter-groups + ibuffer-saved-filter-groups)) (message "Not saved permanently: Customize not available")))) ;;;###autoload @@ -525,8 +881,8 @@ Interactively, prompt for NAME, and use the current filters." 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) + (push (list name filters) ibuffer-saved-filters)) + (ibuffer-maybe-save-stuff) (ibuffer-update-mode-name)) ;;;###autoload @@ -540,7 +896,7 @@ Interactively, prompt for NAME, and use the current filters." ibuffer-saved-filters nil t)))) (setq ibuffer-saved-filters (ibuffer-delete-alist name ibuffer-saved-filters)) - (ibuffer-maybe-save-saved-filters) + (ibuffer-maybe-save-stuff) (ibuffer-update nil t)) ;;;###autoload @@ -568,7 +924,14 @@ of replacing the current filters." ibuffer-saved-filters nil t)))) (setq ibuffer-filtering-qualifiers (list (cons 'saved name))) (ibuffer-update nil t)) - + +(defun ibuffer-format-filter-group-data (filter) + (if (equal filter "Default") + "" + (concat "Filter:" (mapconcat #'ibuffer-format-qualifier + (cdr (assq filter ibuffer-filter-groups)) + " ")))) + (defun ibuffer-format-qualifier (qualifier) (if (eq (car-safe qualifier) 'not) (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]") @@ -586,10 +949,31 @@ of replacing the current filters." (unless qualifier (error "Ibuffer: bad qualifier %s" qualifier)) (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier))))))) - + + +(defun ibuffer-list-buffer-modes () + "Create an alist of buffer modes currently in use. +The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)." + (let ((bufs (buffer-list)) + (modes) + (this-mode)) + (while bufs + (setq this-mode + (with-current-buffer + (car bufs) + major-mode) + bufs (cdr bufs)) + (add-to-list + 'modes + `(,(symbol-name this-mode) . + ,this-mode))) + modes)) + + ;;; Extra operation definitions -(define-ibuffer-filter mode +;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext.el") +(define-ibuffer-filter mode "Toggle current view to buffers with major mode QUALIFIER." (:description "major mode" :reader @@ -606,22 +990,48 @@ of replacing the current filters." ""))))) (eq qualifier (with-current-buffer buf major-mode))) -(define-ibuffer-filter name +;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext.el") +(define-ibuffer-filter used-mode + "Toggle current view to buffers with major mode QUALIFIER. +Called interactively, this function allows selection of modes +currently used by buffers." + (:description "major mode in use" + :reader + (intern + (completing-read "Filter by major mode: " + (ibuffer-list-buffer-modes) + nil + 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 (autoload 'ibuffer-filter-by-name "ibuf-ext.el") +(define-ibuffer-filter name "Toggle current view to buffers with name matching QUALIFIER." (:description "buffer name" - :reader - (read-from-minibuffer "Filter by name (regexp): ")) + :reader (read-from-minibuffer "Filter by name (regexp): ")) (string-match qualifier (buffer-name buf))) +;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext.el") (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) + :reader (read-from-minibuffer "Filter by filename (regexp): ")) + (ibuffer-awhen (with-current-buffer buf + (or buffer-file-name + (and (boundp 'dired-directory) + (if (stringp dired-directory) + dired-directory + (car dired-directory)) + (expand-file-name dired-directory)))) (string-match qualifier it))) -(define-ibuffer-filter size-gt +;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext.el") +(define-ibuffer-filter size-gt "Toggle current view to buffers with size greater than QUALIFIER." (:description "size greater than" :reader @@ -629,29 +1039,30 @@ of replacing the current filters." (> (with-current-buffer buf (buffer-size)) qualifier)) -(define-ibuffer-filter size-lt +;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext.el") +(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 (autoload 'ibuffer-filter-by-content "ibuf-ext.el") (define-ibuffer-filter content "Toggle current view to buffers whose contents match QUALIFIER." (:description "content" - :reader - (read-from-minibuffer "Filter by content (regexp): ")) + :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 (autoload 'ibuffer-filter-by-predicate "ibuf-ext.el") (define-ibuffer-filter predicate "Toggle current view to buffers for which QUALIFIER returns non-nil." (:description "predicate" - :reader - (read-minibuffer "Filter by predicate (form): ")) + :reader (read-minibuffer "Filter by predicate (form): ")) (with-current-buffer buf (eval qualifier))) @@ -686,6 +1097,7 @@ Default sorting modes are: "normal")) (ibuffer-redisplay t)) +;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext.el") (define-ibuffer-sorter major-mode "Sort the buffers by major modes. Ordering is lexicographic." @@ -699,6 +1111,7 @@ Ordering is lexicographic." (car b) major-mode))))) +;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext.el") (define-ibuffer-sorter mode-name "Sort the buffers by their mode name. Ordering is lexicographic." @@ -712,6 +1125,7 @@ Ordering is lexicographic." (car b) mode-name)))) +;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext.el") (define-ibuffer-sorter alphabetic "Sort the buffers by their names. Ordering is lexicographic." @@ -720,6 +1134,7 @@ Ordering is lexicographic." (buffer-name (car a)) (buffer-name (car b)))) +;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext.el") (define-ibuffer-sorter size "Sort the buffers by their size." (:description "size") @@ -751,7 +1166,7 @@ Ordering is lexicographic." (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." +for this Ibuffer session." (interactive (list (read-from-minibuffer "Never show buffers matching: " @@ -762,7 +1177,7 @@ for this ibuffer session." (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." +for this Ibuffer session." (interactive (list (read-from-minibuffer "Always show buffers matching: " @@ -821,81 +1236,92 @@ to move by. The default is `ibuffer-marked-char'." ;;;###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)))) + "Move point to the buffer whose name is NAME. + +If called interactively, prompt for a buffer name and go to the +corresponding line in the Ibuffer buffer. If said buffer is in a +hidden group filter, open it. + +If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer +visible buffers in the completion list. Calling the command with +a prefix argument reverses the meaning of that variable." + (interactive (list + (let ((only-visible ibuffer-jump-offer-only-visible-buffers)) + (when current-prefix-arg + (setq only-visible (not only-visible))) + (if only-visible + (let ((table (mapcar #'(lambda (x) + (buffer-name (car x))) + (ibuffer-current-state-list)))) + (when (null table) + (error "No buffers!")) + (completing-read "Jump to buffer: " + table nil t)) + (read-buffer "Jump to buffer: " nil t))))) + (when (not (string= "" name)) + (let (buf-point) + ;; Blindly search for our buffer: it is very likely that it is + ;; not in a hidden filter group. + (ibuffer-map-lines #'(lambda (buf marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) + t nil) + (when (and + (null buf-point) + (not (null ibuffer-hidden-filter-groups))) + ;; We did not find our buffer. It must be in a hidden filter + ;; group, so go through all hidden filter groups to find it. + (catch 'found + (dolist (group ibuffer-hidden-filter-groups) + (ibuffer-jump-to-filter-group group) + (ibuffer-toggle-filter-group) + (ibuffer-map-lines #'(lambda (buf marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) + t group) + (if buf-point + (throw 'found nil) + (ibuffer-toggle-filter-group))))) + (if (null buf-point) + ;; Still not found even though we expanded all hidden filter + ;; groups: that must be because it's hidden by predicate: + ;; we won't bother trying to display it. + (error "No buffer with name %s" name) + (goto-char buf-point))))) ;;;###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))) + (let ((buf (ibuffer-current-buffer))) (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)) + (diff-buffer-with-file buf))) ;;;###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. +With no prefix arg, use the filename sans its directory of each marked file. +With a zero prefix arg, use the complete filename of each marked file. +With \\[universal-argument], use the filename of each marked file relative +to `ibuffer-default-directory' iff non-nil, otherwise `default-directory'. - [ 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) +You can then feed the file name(s) to other commands with \\[yank]." + (interactive "p") + (if (zerop (ibuffer-count-marked-lines)) (message "No buffers marked; use 'm' to mark a buffer") (let ((ibuffer-copy-filename-as-kill-result "") - (type (cond ((eql arg 0) + (type (cond ((zerop arg) 'full) - ;; ((eql arg 4) - ;; 'relative) + ((= arg 4) + 'relative) (t 'name)))) (ibuffer-map-marked-lines @@ -907,19 +1333,26 @@ You can then feed the file name(s) to other commands with C-y. (case type (full name) + (relative + (file-relative-name + name (or ibuffer-default-directory + default-directory))) (t (file-name-nondirectory name))) "")) " ")))) - (push ibuffer-copy-filename-as-kill-result kill-ring)))) + (kill-new ibuffer-copy-filename-as-kill-result)))) -(defun ibuffer-mark-on-buffer (func) +(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) (let ((count (ibuffer-map-lines #'(lambda (buf mark) (when (funcall func buf) - (ibuffer-set-mark-1 ibuffer-marked-char) - t))))) + (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark + ibuffer-marked-char)) + t)) + nil + group))) (ibuffer-redisplay t) (message "Marked %s buffers" count))) @@ -1060,96 +1493,15 @@ You can then feed the file name(s) to other commands with C-y. (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)) + (interactive (occur-read-primary-args)) (if (or (not (integerp nlines)) (< nlines 0)) - (setq nlines 1)) + (setq nlines 0)) (when (zerop (ibuffer-count-marked-lines)) (ibuffer-set-mark ibuffer-marked-char)) (let ((ibuffer-do-occur-bufs nil)) @@ -1157,147 +1509,9 @@ defaults to one." (ibuffer-map-marked-lines #'(lambda (buf mark) (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)))) + (occur-1 regexp nlines ibuffer-do-occur-bufs))) (provide 'ibuf-ext) +;;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d ;;; ibuf-ext.el ends here