1 ;;; ibuf-ext.el --- extensions for ibuffer -*-byte-compile-dynamic: t;-*-
3 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
5 ;; Author: Colin Walters <walters@verbum.org>
7 ;; Keywords: buffer, convenience
9 ;; This file is not currently part of GNU Emacs.
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program ; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; These functions should be automatically loaded when called, but you
29 ;; can explicity (require 'ibuf-ext) in your ~/.emacs to have them
42 (defun ibuffer-delete-alist (key alist
)
43 "Delete all entries in ALIST that have a key equal to KEY."
45 (while (setq entry
(assoc key alist
))
46 (setq alist
(delete entry alist
)))
49 (defun ibuffer-depropertize-string (str &optional nocopy
)
50 "Return a copy of STR with text properties removed.
51 If optional argument NOCOPY is non-nil, actually modify the string directly."
54 (copy-sequence str
))))
55 (set-text-properties 0 (length str
) nil str
)
58 (defcustom ibuffer-never-show-predicates nil
59 "A list of predicates (a regexp or function) for buffers not to display.
60 If a regexp, then it will be matched against the buffer's name.
61 If a function, it will be called with the buffer as an argument, and
62 should return non-nil if this buffer should not be shown."
63 :type
'(repeat (choice regexp function
))
66 (defcustom ibuffer-always-show-predicates nil
67 "A list of predicates (a regexp or function) for buffers to always display.
68 If a regexp, then it will be matched against the buffer's name.
69 If a function, it will be called with the buffer as an argument, and
70 should return non-nil if this buffer should be shown.
71 Note that buffers matching one of these predicates will be shown
72 regardless of any active filters in this buffer."
73 :type
'(repeat (choice regexp function
))
76 (defvar ibuffer-tmp-hide-regexps nil
77 "A list of regexps which should match buffer names to not show.")
79 (defvar ibuffer-tmp-show-regexps nil
80 "A list of regexps which should match buffer names to always show.")
82 (defvar ibuffer-auto-mode nil
83 "If non-nil, Ibuffer auto-mode should be enabled for this buffer.
84 Do not set this variable directly! Use the function
85 `ibuffer-auto-mode' instead.")
87 (defvar ibuffer-auto-buffers-changed nil
)
89 (defcustom ibuffer-occur-match-face
'font-lock-warning-face
90 "Face used for displaying matched strings for `ibuffer-do-occur'."
94 (defcustom ibuffer-saved-filters
'(("gnus"
95 ((or (mode . message-mode
)
97 (mode . gnus-group-mode
)
98 (mode . gnus-summary-mode
)
99 (mode . gnus-article-mode
))))
101 ((or (mode . emacs-lisp-mode
)
106 (mode . lisp-mode
)))))
108 "An alist of filter qualifiers to switch between.
110 This variable should look like ((\"STRING\" QUALIFIERS)
111 (\"STRING\" QUALIFIERS) ...), where
112 QUALIFIERS is a list of the same form as
113 `ibuffer-filtering-qualifiers'.
114 See also the variables `ibuffer-filtering-qualifiers',
115 `ibuffer-filtering-alist', and the functions
116 `ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
120 (defvar ibuffer-filtering-qualifiers nil
121 "A list like (SYMBOL . QUALIFIER) which filters the current buffer list.
122 See also `ibuffer-filtering-alist'.")
124 ;; This is now frobbed by `define-ibuffer-filter'.
125 (defvar ibuffer-filtering-alist nil
126 "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
128 You most likely do not want to modify this variable directly; see
129 `define-ibuffer-filter'.
131 SYMBOL is the symbolic name of the filter. DESCRIPTION is used when
132 displaying information to the user. FUNCTION is given a buffer and
133 the value of the qualifier, and returns non-nil if and only if the
134 buffer should be displayed.")
136 (defcustom ibuffer-filter-format-alist nil
137 "An alist which has special formats used when a filter is active.
138 The contents of this variable should look like:
139 ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
141 For example, suppose that when you add a filter for buffers whose
142 major mode is `emacs-lisp-mode', you only want to see the mark and the
143 name of the buffer. You could accomplish that by adding:
144 (mode ((mark \" \" name)))
146 :type
'(repeat (list :tag
"Association" (symbol :tag
"Filter")
147 (list :tag
"Formats" (repeat (sexp :tag
"Format")))))
150 (defvar ibuffer-cached-filter-formats nil
)
151 (defvar ibuffer-compiled-filter-formats nil
)
153 (defcustom ibuffer-old-time
72
154 "The number of hours before a buffer is considered \"old\"."
155 :type
'(choice (const :tag
"72 hours (3 days)" 72)
156 (const :tag
"48 hours (2 days)" 48)
157 (const :tag
"24 hours (1 day)" 24)
158 (integer :tag
"hours"))
161 (defcustom ibuffer-save-with-custom t
162 "If non-nil, then use Custom to save interactively changed variables.
163 Currently, this only applies to `ibuffer-saved-filters'."
167 (defun ibuffer-ext-visible-p (buf all
&optional ibuffer-buf
)
169 (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps
)
172 (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps
)
173 (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates
)))
176 (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates
)))
177 (or ibuffer-view-ibuffer
179 (not (eq ibuffer-buf buf
))))
181 (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers
)
182 (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates
)))))
184 (defun ibuffer-auto-update-changed ()
185 (when ibuffer-auto-buffers-changed
186 (setq ibuffer-auto-buffers-changed nil
)
187 (mapcar #'(lambda (buf)
189 (with-current-buffer buf
190 (when (and ibuffer-auto-mode
191 (eq major-mode
'ibuffer-mode
))
192 (ibuffer-update nil t
)))))
196 (defun ibuffer-auto-mode (&optional arg
)
197 "Toggle use of Ibuffer's auto-update facility.
198 With numeric ARG, enable auto-update if and only if ARG is positive."
200 (unless (eq major-mode
'ibuffer-mode
)
201 (error "This buffer is not in Ibuffer mode"))
202 (set (make-local-variable 'ibuffer-auto-mode
)
205 (not ibuffer-auto-mode
)))
206 (defadvice get-buffer-create
(after ibuffer-notify-create activate
)
207 (setq ibuffer-auto-buffers-changed t
))
208 (defadvice kill-buffer
(after ibuffer-notify-kill activate
)
209 (setq ibuffer-auto-buffers-changed t
))
210 (add-hook 'post-command-hook
'ibuffer-auto-update-changed
)
211 (ibuffer-update-mode-name))
214 (defun ibuffer-mouse-filter-by-mode (event)
215 "Enable or disable filtering by the major mode chosen via mouse."
217 (ibuffer-interactive-filter-by-mode event
))
220 (defun ibuffer-interactive-filter-by-mode (event-or-point)
221 "Enable or disable filtering by the major mode at point."
223 (if (eventp event-or-point
)
224 (mouse-set-point event-or-point
)
225 (goto-char event-or-point
))
226 (let ((buf (ibuffer-current-buffer)))
227 (if (assq 'mode ibuffer-filtering-qualifiers
)
228 (setq ibuffer-filtering-qualifiers
229 (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers
))
230 (ibuffer-push-filter (cons 'mode
231 (with-current-buffer buf
233 (ibuffer-update nil t
))
235 (define-ibuffer-op shell-command-pipe
(command)
236 "Pipe the contents of each marked buffer to shell command COMMAND."
237 (:interactive
"sPipe to shell command: "
238 :opstring
"Shell command executed on"
240 (shell-command-on-region
241 (point-min) (point-max) command
242 (get-buffer-create "* ibuffer-shell-output*")))
244 (define-ibuffer-op shell-command-pipe-replace
(command)
245 "Replace the contents of marked buffers with output of pipe to COMMAND."
246 (:interactive
"sPipe to shell command (replace): "
247 :opstring
"Buffer contents replaced in"
248 :active-opstring
"replace buffer contents in"
251 (with-current-buffer buf
252 (shell-command-on-region (point-min) (point-max)
255 (define-ibuffer-op shell-command-file
(command)
256 "Run shell command COMMAND separately on files of marked buffers."
257 (:interactive
"sShell command on buffer's file: "
258 :opstring
"Shell command executed on"
260 (shell-command (concat command
" "
261 (shell-quote-argument
265 (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
267 (define-ibuffer-op eval
(form)
268 "Evaluate FORM in each of the buffers.
269 Does not display the buffer during evaluation. See
270 `ibuffer-do-view-and-eval' for that."
271 (:interactive
"xEval in buffers (form): "
272 :opstring
"evaluated in"
276 (define-ibuffer-op view-and-eval
(form)
277 "Evaluate FORM while displaying each of the marked buffers.
278 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
279 (:interactive
"xEval viewing buffers (form): "
280 :opstring
"evaluated in"
283 (let ((ibuffer-buf (current-buffer)))
286 (switch-to-buffer buf
)
288 (switch-to-buffer ibuffer-buf
))))
290 (define-ibuffer-op rename-uniquely
()
291 "Rename marked buffers as with `rename-uniquely'."
296 (define-ibuffer-op revert
()
297 "Revert marked buffers as with `revert-buffer'."
300 :active-opstring
"revert"
304 (define-ibuffer-op replace-regexp
(from-str to-str
)
305 "Perform a `replace-regexp' in marked buffers."
307 (let* ((from-str (read-from-minibuffer "Replace regexp: "))
308 (to-str (read-from-minibuffer (concat "Replace " from-str
310 (list from-str to-str
))
311 :opstring
"replaced in"
314 (save-window-excursion
315 (switch-to-buffer buf
)
317 (goto-char (point-min))
318 (let ((case-fold-search ibuffer-case-fold-search
))
319 (while (re-search-forward from-str nil t
)
320 (replace-match to-str
))))
323 (define-ibuffer-op query-replace
(&rest args
)
324 "Perform a `query-replace' in marked buffers."
326 (query-replace-read-args "Query replace" t t
)
327 :opstring
"replaced in"
330 (save-window-excursion
331 (switch-to-buffer buf
)
333 (let ((case-fold-search ibuffer-case-fold-search
))
334 (goto-char (point-min))
335 (apply #'query-replace args
)))
338 (define-ibuffer-op query-replace-regexp
(&rest args
)
339 "Perform a `query-replace-regexp' in marked buffers."
341 (query-replace-read-args "Query replace regexp" t t
)
342 :opstring
"replaced in"
345 (save-window-excursion
346 (switch-to-buffer buf
)
348 (let ((case-fold-search ibuffer-case-fold-search
))
349 (goto-char (point-min))
350 (apply #'query-replace-regexp args
)))
353 (define-ibuffer-op print
()
354 "Print marked buffers as with `print-buffer'."
360 (defun ibuffer-included-in-filters-p (buf filters
)
362 (memq nil
;; a filter will return nil if it failed
364 ;; filter should be like (TYPE . QUALIFIER), or
365 ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...)
367 (ibuffer-included-in-filter-p buf qual
))
370 (defun ibuffer-included-in-filter-p (buf filter
)
371 (if (eq (car filter
) 'not
)
372 (not (ibuffer-included-in-filter-p-1 buf
(cdr filter
)))
373 (ibuffer-included-in-filter-p-1 buf filter
)))
375 (defun ibuffer-included-in-filter-p-1 (buf filter
)
380 (memq t
(mapcar #'(lambda (x)
381 (ibuffer-included-in-filter-p buf x
))
386 ibuffer-saved-filters
)))
388 (ibuffer-filter-disable)
389 (error "Unknown saved filter %s" (cdr filter
)))
390 (ibuffer-included-in-filters-p buf
(cadr data
))))
392 (let ((filterdat (assq (car filter
)
393 ibuffer-filtering-alist
)))
394 ;; filterdat should be like (TYPE DESCRIPTION FUNC)
395 ;; just a sanity check
397 (ibuffer-filter-disable)
398 (error "Undefined filter %s" (car filter
)))
401 (funcall (caddr filterdat
)
403 (cdr filter
))))))))))
406 (defun ibuffer-filter-disable ()
407 "Disable all filters currently in effect in this buffer."
409 (setq ibuffer-filtering-qualifiers nil
)
410 (ibuffer-update nil t
))
413 (defun ibuffer-pop-filter ()
414 "Remove the top filter in this buffer."
416 (when (null ibuffer-filtering-qualifiers
)
417 (error "No filters in effect"))
418 (pop ibuffer-filtering-qualifiers
)
419 (ibuffer-update nil t
))
421 (defun ibuffer-push-filter (qualifier)
422 "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
423 (push qualifier ibuffer-filtering-qualifiers
))
426 (defun ibuffer-decompose-filter ()
427 "Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
429 This means that the topmost filter on the filtering stack, which must
430 be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
431 turned into two separate filters [name: foo] and [mode: bar-mode]."
433 (when (null ibuffer-filtering-qualifiers
)
434 (error "No filters in effect"))
435 (let ((lim (pop ibuffer-filtering-qualifiers
)))
438 (setq ibuffer-filtering-qualifiers
(append
440 ibuffer-filtering-qualifiers
)))
444 ibuffer-saved-filters
)))
446 (ibuffer-filter-disable)
447 (error "Unknown saved filter %s" (cdr lim
)))
448 (setq ibuffer-filtering-qualifiers
(append
450 ibuffer-filtering-qualifiers
))))
453 ibuffer-filtering-qualifiers
))
455 (error "Filter type %s is not compound" (car lim
)))))
456 (ibuffer-update nil t
))
459 (defun ibuffer-exchange-filters ()
460 "Exchange the top two filters on the stack in this buffer."
462 (when (< (length ibuffer-filtering-qualifiers
)
464 (error "Need two filters to exchange"))
465 (let ((first (pop ibuffer-filtering-qualifiers
))
466 (second (pop ibuffer-filtering-qualifiers
)))
467 (push first ibuffer-filtering-qualifiers
)
468 (push second ibuffer-filtering-qualifiers
))
469 (ibuffer-update nil t
))
472 (defun ibuffer-negate-filter ()
473 "Negate the sense of the top filter in the current buffer."
475 (when (null ibuffer-filtering-qualifiers
)
476 (error "No filters in effect"))
477 (let ((lim (pop ibuffer-filtering-qualifiers
)))
478 (push (if (eq (car lim
) 'not
)
481 ibuffer-filtering-qualifiers
))
482 (ibuffer-update nil t
))
485 (defun ibuffer-or-filter (&optional reverse
)
486 "Replace the top two filters in this buffer with their logical OR.
487 If optional argument REVERSE is non-nil, instead break the top OR
492 (when (or (null ibuffer-filtering-qualifiers
)
493 (not (eq 'or
(caar ibuffer-filtering-qualifiers
))))
494 (error "Top filter is not an OR"))
495 (let ((lim (pop ibuffer-filtering-qualifiers
)))
496 (setq ibuffer-filtering-qualifiers
(nconc (cdr lim
) ibuffer-filtering-qualifiers
))))
497 (when (< (length ibuffer-filtering-qualifiers
) 2)
498 (error "Need two filters to OR"))
499 ;; If the second filter is an OR, just add to it.
500 (let ((first (pop ibuffer-filtering-qualifiers
))
501 (second (pop ibuffer-filtering-qualifiers
)))
502 (if (eq 'or
(car second
))
503 (push (nconc (list 'or first
) (cdr second
)) ibuffer-filtering-qualifiers
)
504 (push (list 'or first second
)
505 ibuffer-filtering-qualifiers
))))
506 (ibuffer-update nil t
))
508 (defun ibuffer-maybe-save-saved-filters ()
509 (when ibuffer-save-with-custom
510 (if (fboundp 'customize-save-variable
)
512 (customize-save-variable 'ibuffer-saved-filters
513 ibuffer-saved-filters
))
514 (message "Not saved permanently: Customize not available"))))
517 (defun ibuffer-save-filters (name filters
)
518 "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
519 Interactively, prompt for NAME, and use the current filters."
521 (if (null ibuffer-filtering-qualifiers
)
522 (error "No filters currently in effect")
524 (read-from-minibuffer "Save current filters as: ")
525 ibuffer-filtering-qualifiers
)))
526 (ibuffer-aif (assoc name ibuffer-saved-filters
)
528 (push (list name filters
) ibuffer-saved-filters
))
529 (ibuffer-maybe-save-saved-filters)
530 (ibuffer-update-mode-name))
533 (defun ibuffer-delete-saved-filters (name)
534 "Delete saved filters with NAME from `ibuffer-saved-filters'."
537 (if (null ibuffer-saved-filters
)
538 (error "No saved filters")
539 (completing-read "Delete saved filters: "
540 ibuffer-saved-filters nil t
))))
541 (setq ibuffer-saved-filters
542 (ibuffer-delete-alist name ibuffer-saved-filters
))
543 (ibuffer-maybe-save-saved-filters)
544 (ibuffer-update nil t
))
547 (defun ibuffer-add-saved-filters (name)
548 "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
551 (if (null ibuffer-saved-filters
)
552 (error "No saved filters")
553 (completing-read "Add saved filters: "
554 ibuffer-saved-filters nil t
))))
555 (push (cons 'saved name
) ibuffer-filtering-qualifiers
)
556 (ibuffer-update nil t
))
559 (defun ibuffer-switch-to-saved-filters (name)
560 "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
561 If prefix argument ADD is non-nil, then add the saved filters instead
562 of replacing the current filters."
565 (if (null ibuffer-saved-filters
)
566 (error "No saved filters")
567 (completing-read "Switch to saved filters: "
568 ibuffer-saved-filters nil t
))))
569 (setq ibuffer-filtering-qualifiers
(list (cons 'saved name
)))
570 (ibuffer-update nil t
))
572 (defun ibuffer-format-qualifier (qualifier)
573 (if (eq (car-safe qualifier
) 'not
)
574 (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier
)) "]")
575 (ibuffer-format-qualifier-1 qualifier
)))
577 (defun ibuffer-format-qualifier-1 (qualifier)
578 (case (car qualifier
)
580 (concat " [filter: " (cdr qualifier
) "]"))
582 (concat " [OR" (mapconcat #'ibuffer-format-qualifier
583 (cdr qualifier
) "") "]"))
585 (let ((type (assq (car qualifier
) ibuffer-filtering-alist
)))
587 (error "Ibuffer: bad qualifier %s" qualifier
))
588 (concat " [" (cadr type
) ": " (format "%s]" (cdr qualifier
)))))))
590 ;;; Extra operation definitions
592 (define-ibuffer-filter mode
593 "Toggle current view to buffers with major mode QUALIFIER."
594 (:description
"major mode"
597 (completing-read "Filter by major mode: " obarray
599 (string-match "-mode$"
602 (let ((buf (ibuffer-current-buffer)))
603 (if (and buf
(buffer-live-p buf
))
604 (with-current-buffer buf
605 (symbol-name major-mode
))
607 (eq qualifier
(with-current-buffer buf major-mode
)))
609 (define-ibuffer-filter name
610 "Toggle current view to buffers with name matching QUALIFIER."
611 (:description
"buffer name"
613 (read-from-minibuffer "Filter by name (regexp): "))
614 (string-match qualifier
(buffer-name buf
)))
616 (define-ibuffer-filter filename
617 "Toggle current view to buffers with filename matching QUALIFIER."
618 (:description
"filename"
620 (read-from-minibuffer "Filter by filename (regexp): "))
621 (ibuffer-awhen (buffer-file-name buf
)
622 (string-match qualifier it
)))
624 (define-ibuffer-filter size-gt
625 "Toggle current view to buffers with size greater than QUALIFIER."
626 (:description
"size greater than"
628 (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
629 (> (with-current-buffer buf
(buffer-size))
632 (define-ibuffer-filter size-lt
633 "Toggle current view to buffers with size less than QUALIFIER."
634 (:description
"size less than"
636 (string-to-number (read-from-minibuffer "Filter by size less than: ")))
637 (< (with-current-buffer buf
(buffer-size))
640 (define-ibuffer-filter content
641 "Toggle current view to buffers whose contents match QUALIFIER."
642 (:description
"content"
644 (read-from-minibuffer "Filter by content (regexp): "))
645 (with-current-buffer buf
647 (goto-char (point-min))
648 (re-search-forward qualifier nil t
))))
650 (define-ibuffer-filter predicate
651 "Toggle current view to buffers for which QUALIFIER returns non-nil."
652 (:description
"predicate"
654 (read-minibuffer "Filter by predicate (form): "))
655 (with-current-buffer buf
661 (defun ibuffer-toggle-sorting-mode ()
662 "Toggle the current sorting mode.
663 Default sorting modes are:
664 Recency - the last time the buffer was viewed
665 Name - the name of the buffer
666 Major Mode - the name of the major mode of the buffer
667 Size - the size of the buffer"
669 (let ((modes (mapcar 'car ibuffer-sorting-functions-alist
)))
670 (add-to-list 'modes
'recency
)
671 (setq modes
(sort modes
'string-lessp
))
672 (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes
)))
674 (setq ibuffer-sorting-mode next
)
675 (message "Sorting by %s" next
)))
676 (ibuffer-redisplay t
))
679 (defun ibuffer-invert-sorting ()
680 "Toggle whether or not sorting is in reverse order."
682 (setq ibuffer-sorting-reversep
(not ibuffer-sorting-reversep
))
683 (message "Sorting order %s"
684 (if ibuffer-sorting-reversep
687 (ibuffer-redisplay t
))
689 (define-ibuffer-sorter major-mode
690 "Sort the buffers by major modes.
691 Ordering is lexicographic."
692 (:description
"major mode")
693 (string-lessp (downcase
694 (symbol-name (with-current-buffer
698 (symbol-name (with-current-buffer
702 (define-ibuffer-sorter mode-name
703 "Sort the buffers by their mode name.
704 Ordering is lexicographic."
705 (:description
"major mode name")
706 (string-lessp (downcase
715 (define-ibuffer-sorter alphabetic
716 "Sort the buffers by their names.
717 Ordering is lexicographic."
718 (:description
"buffer name")
720 (buffer-name (car a
))
721 (buffer-name (car b
))))
723 (define-ibuffer-sorter size
724 "Sort the buffers by their size."
725 (:description
"size")
726 (< (with-current-buffer (car a
)
728 (with-current-buffer (car b
)
731 ;;; Functions to emulate bs.el
734 (defun ibuffer-bs-show ()
735 "Emulate `bs-show' from the bs.el package."
737 (ibuffer t
"*Ibuffer-bs*" '((filename .
".*")) nil t
)
738 (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all
))
740 (defun ibuffer-bs-toggle-all ()
741 "Emulate `bs-toggle-show-all' from the bs.el package."
743 (if ibuffer-filtering-qualifiers
745 (progn (ibuffer-push-filter '(filename .
".*"))
746 (ibuffer-update nil t
))))
751 (defun ibuffer-add-to-tmp-hide (regexp)
752 "Add REGEXP to `ibuffer-tmp-hide-regexps'.
753 This means that buffers whose name matches REGEXP will not be shown
754 for this ibuffer session."
757 (read-from-minibuffer "Never show buffers matching: "
758 (regexp-quote (buffer-name (ibuffer-current-buffer t
))))))
759 (push regexp ibuffer-tmp-hide-regexps
))
762 (defun ibuffer-add-to-tmp-show (regexp)
763 "Add REGEXP to `ibuffer-tmp-show-regexps'.
764 This means that buffers whose name matches REGEXP will always be shown
765 for this ibuffer session."
768 (read-from-minibuffer "Always show buffers matching: "
769 (regexp-quote (buffer-name (ibuffer-current-buffer t
))))))
770 (push regexp ibuffer-tmp-show-regexps
))
773 (defun ibuffer-forward-next-marked (&optional count mark direction
)
774 "Move forward by COUNT marked buffers (default 1).
776 If MARK is non-nil, it should be a character denoting the type of mark
777 to move by. The default is `ibuffer-marked-char'.
779 If DIRECTION is non-nil, it should be an integer; negative integers
780 mean move backwards, non-negative integers mean move forwards."
785 (setq mark ibuffer-marked-char
))
789 (ibuffer-forward-line 0)
792 (ibuffer-forward-line direction
)
793 (while (not (or (= (point) opos
)
794 (eq (setq curmark
(ibuffer-current-mark))
796 (ibuffer-forward-line direction
))
797 (when (and (= (point) opos
)
798 (not (eq (ibuffer-current-mark) mark
)))
799 (error "No buffers with mark %c" mark
))))
802 (defun ibuffer-backwards-next-marked (&optional count mark
)
803 "Move backwards by COUNT marked buffers (default 1).
805 If MARK is non-nil, it should be a character denoting the type of mark
806 to move by. The default is `ibuffer-marked-char'."
808 (ibuffer-forward-next-marked count mark -
1))
811 (defun ibuffer-do-kill-lines ()
812 "Hide all of the currently marked lines."
814 (if (= (ibuffer-count-marked-lines) 0)
815 (message "No buffers marked; use 'm' to mark a buffer")
817 (ibuffer-map-marked-lines
818 #'(lambda (buf mark beg end
)
820 (message "Killed %s lines" count
))))
823 (defun ibuffer-jump-to-buffer (name)
824 "Move point to the buffer whose name is NAME."
825 (interactive (list nil
))
826 (let ((table (mapcar #'(lambda (x)
827 (cons (buffer-name (car x
))
829 (ibuffer-current-state-list t
))))
831 (error "No buffers!"))
832 (when (interactive-p)
833 (setq name
(completing-read "Jump to buffer: " table nil t
)))
834 (ibuffer-aif (assoc name table
)
836 (error "No buffer with name %s" name
))))
839 (defun ibuffer-diff-with-file ()
840 "View the differences between this buffer and its associated file.
841 This requires the external program \"diff\" to be in your `exec-path'."
843 (let* ((buf (ibuffer-current-buffer))
844 (buf-filename (with-current-buffer buf
846 (unless (buffer-live-p buf
)
847 (error "Buffer %s has been killed" buf
))
849 (error "Buffer %s has no associated file" buf
))
850 (let ((diff-buf (get-buffer-create "*Ibuffer-diff*")))
851 (with-current-buffer diff-buf
852 (setq buffer-read-only nil
)
854 (let ((tempfile (make-temp-file "ibuffer-diff-")))
857 (with-current-buffer buf
858 (write-region (point-min) (point-max) tempfile nil
'nomessage
))
860 (apply #'call-process
"diff" nil diff-buf nil
862 (when (and (boundp 'ediff-custom-diff-options
)
863 (stringp ediff-custom-diff-options
))
864 (list ediff-custom-diff-options
))
865 (list buf-filename tempfile
))))
866 (message "No differences found")
868 (with-current-buffer diff-buf
869 (goto-char (point-min))
870 (if (fboundp 'diff-mode
)
873 (display-buffer diff-buf
))))
874 (when (file-exists-p tempfile
)
875 (delete-file tempfile
)))))
879 (defun ibuffer-copy-filename-as-kill (&optional arg
)
880 "Copy filenames of marked buffers into the kill ring.
881 The names are separated by a space.
882 If a buffer has no filename, it is ignored.
883 With a zero prefix arg, use the complete pathname of each marked file.
885 You can then feed the file name(s) to other commands with C-y.
887 [ This docstring shamelessly stolen from the
888 `dired-copy-filename-as-kill' in \"dired-x\". ]"
889 ;; Add to docstring later:
890 ;; With C-u, use the relative pathname of each marked file.
892 (if (= (ibuffer-count-marked-lines) 0)
893 (message "No buffers marked; use 'm' to mark a buffer")
894 (let ((ibuffer-copy-filename-as-kill-result "")
895 (type (cond ((eql arg
0)
901 (ibuffer-map-marked-lines
902 #'(lambda (buf mark beg end
)
903 (setq ibuffer-copy-filename-as-kill-result
904 (concat ibuffer-copy-filename-as-kill-result
905 (let ((name (buffer-file-name buf
)))
911 (file-name-nondirectory name
)))
914 (push ibuffer-copy-filename-as-kill-result kill-ring
))))
916 (defun ibuffer-mark-on-buffer (func)
919 #'(lambda (buf mark beg end
)
920 (when (funcall func buf
)
921 (ibuffer-set-mark-1 ibuffer-marked-char
)
923 (ibuffer-redisplay t
)
924 (message "Marked %s buffers" count
)))
927 (defun ibuffer-mark-by-name-regexp (regexp)
928 "Mark all buffers whose name matches REGEXP."
929 (interactive "sMark by name (regexp): ")
930 (ibuffer-mark-on-buffer
932 (string-match regexp
(buffer-name buf
)))))
935 (defun ibuffer-mark-by-mode-regexp (regexp)
936 "Mark all buffers whose major mode matches REGEXP."
937 (interactive "sMark by major mode (regexp): ")
938 (ibuffer-mark-on-buffer
940 (with-current-buffer buf
941 (string-match regexp mode-name
)))))
944 (defun ibuffer-mark-by-file-name-regexp (regexp)
945 "Mark all buffers whose file name matches REGEXP."
946 (interactive "sMark by file name (regexp): ")
947 (ibuffer-mark-on-buffer
949 (let ((name (or (buffer-file-name buf
)
950 (with-current-buffer buf
952 (boundp 'dired-directory
)
953 (stringp dired-directory
)
956 (string-match regexp name
))))))
959 (defun ibuffer-mark-by-mode (mode)
960 "Mark all buffers whose major mode equals MODE."
962 (list (intern (completing-read "Mark by major mode: " obarray
966 (string-match "-mode$"
969 (let ((buf (ibuffer-current-buffer)))
970 (if (and buf
(buffer-live-p buf
))
971 (with-current-buffer buf
972 (cons (symbol-name major-mode
)
975 (ibuffer-mark-on-buffer
977 (with-current-buffer buf
978 (eq major-mode mode
)))))
981 (defun ibuffer-mark-modified-buffers ()
982 "Mark all modified buffers."
984 (ibuffer-mark-on-buffer
985 #'(lambda (buf) (buffer-modified-p buf
))))
988 (defun ibuffer-mark-unsaved-buffers ()
989 "Mark all modified buffers that have an associated file."
991 (ibuffer-mark-on-buffer
992 #'(lambda (buf) (and (with-current-buffer buf buffer-file-name
)
993 (buffer-modified-p buf
)))))
996 (defun ibuffer-mark-dissociated-buffers ()
997 "Mark all buffers whose associated file does not exist."
999 (ibuffer-mark-on-buffer
1001 (with-current-buffer buf
1003 (and buffer-file-name
1004 (not (file-exists-p buffer-file-name
)))
1005 (and (eq major-mode
'dired-mode
)
1006 (boundp 'dired-directory
)
1007 (stringp dired-directory
)
1008 (not (file-exists-p (file-name-directory dired-directory
)))))))))
1011 (defun ibuffer-mark-help-buffers ()
1012 "Mark buffers like *Help*, *Apropos*, *Info*."
1014 (ibuffer-mark-on-buffer
1016 (with-current-buffer buf
1017 (memq major-mode ibuffer-help-buffer-modes
)))))
1020 (defun ibuffer-mark-old-buffers ()
1021 "Mark buffers which have not been viewed in `ibuffer-old-time' days."
1023 (ibuffer-mark-on-buffer
1025 (with-current-buffer buf
1026 ;; hacked from midnight.el
1027 (when buffer-display-time
1028 (let* ((tm (current-time))
1029 (now (+ (* (float (ash 1 16)) (car tm
))
1030 (float (cadr tm
)) (* 0.0000001 (caddr tm
))))
1031 (then (+ (* (float (ash 1 16))
1032 (car buffer-display-time
))
1033 (float (cadr buffer-display-time
))
1034 (* 0.0000001 (caddr buffer-display-time
)))))
1035 (> (- now then
) (* 60 60 ibuffer-old-time
))))))))
1038 (defun ibuffer-mark-special-buffers ()
1039 "Mark all buffers whose name begins and ends with '*'."
1041 (ibuffer-mark-on-buffer
1042 #'(lambda (buf) (string-match "^\\*.+\\*$"
1043 (buffer-name buf
)))))
1046 (defun ibuffer-mark-read-only-buffers ()
1047 "Mark all read-only buffers."
1049 (ibuffer-mark-on-buffer
1051 (with-current-buffer buf
1052 buffer-read-only
))))
1055 (defun ibuffer-mark-dired-buffers ()
1056 "Mark all `dired' buffers."
1058 (ibuffer-mark-on-buffer
1060 (with-current-buffer buf
1061 (eq major-mode
'dired-mode
)))))
1063 ;;; An implementation of multi-buffer `occur'
1065 (defvar ibuffer-occur-props nil
)
1067 (define-derived-mode ibuffer-occur-mode occur-mode
"Ibuffer-Occur"
1068 "A special form of Occur mode for multiple buffers.
1069 Note this major mode is not meant for interactive use!
1070 See also `occur-mode'."
1071 (define-key ibuffer-occur-mode-map
(kbd "n") 'forward-line
)
1072 (define-key ibuffer-occur-mode-map
(kbd "q") 'bury-buffer
)
1073 (define-key ibuffer-occur-mode-map
(kbd "p") 'previous-line
)
1074 (define-key ibuffer-occur-mode-map
(kbd "RET") 'ibuffer-occur-display-occurence
)
1075 (define-key ibuffer-occur-mode-map
(kbd "f") 'ibuffer-occur-goto-occurence
)
1076 (define-key ibuffer-occur-mode-map
[(mouse-2)] 'ibuffer-occur-mouse-display-occurence
)
1077 (set (make-local-variable 'revert-buffer-function
)
1078 #'ibuffer-occur-revert-buffer-function
)
1079 (set (make-local-variable 'ibuffer-occur-props
) nil
)
1080 (setq buffer-read-only nil
)
1082 (setq buffer-read-only t
)
1085 (if (or (and (< 21 emacs-major-version
)
1089 "to display an occurence.")))
1091 (defun ibuffer-occur-mouse-display-occurence (e)
1092 "Display occurence on this line in another window."
1094 (let* ((occurbuf (save-window-excursion (mouse-select-window e
)
1096 (target (with-current-buffer occurbuf
1097 (get-text-property (save-excursion
1100 'ibuffer-occur-target
))))
1102 (error "No occurence on this line"))
1103 (let ((buf (car target
))
1104 (line (cdr target
)))
1105 (switch-to-buffer occurbuf
)
1106 (delete-other-windows)
1110 (defun ibuffer-occur-goto-occurence ()
1111 "Switch to the buffer which has the occurence on this line."
1113 (ibuffer-occur-display-occurence t
))
1115 (defun ibuffer-occur-display-occurence (&optional goto
)
1116 "Display occurence on this line in another window."
1118 (let ((target (get-text-property (point) 'ibuffer-occur-target
)))
1120 (error "No occurence on this line"))
1121 (let ((buf (car target
))
1122 (line (cdr target
)))
1123 (delete-other-windows)
1125 (switch-to-buffer buf
)
1126 (pop-to-buffer buf
))
1130 (defun ibuffer-do-occur (regexp &optional nlines
)
1131 "View lines which match REGEXP in all marked buffers.
1132 Optional argument NLINES says how many lines of context to display: it
1135 (list (let* ((default (car regexp-history
))
1137 (read-from-minibuffer
1139 (format "List lines matching regexp (default `%s'): "
1141 "List lines matching regexp: ")
1146 (if (equal input
"")
1149 current-prefix-arg
))
1150 (if (or (not (integerp nlines
))
1153 (when (zerop (ibuffer-count-marked-lines))
1154 (ibuffer-set-mark ibuffer-marked-char
))
1155 (let ((ibuffer-do-occur-bufs nil
))
1156 ;; Accumulate a list of marked buffers
1157 (ibuffer-map-marked-lines
1158 #'(lambda (buf mark beg end
)
1159 (push buf ibuffer-do-occur-bufs
)))
1160 (ibuffer-do-occur-1 regexp ibuffer-do-occur-bufs
1161 (get-buffer-create "*Ibuffer-occur*")
1164 (defun ibuffer-do-occur-1 (regexp buffers out-buf nlines
)
1165 (let ((count (ibuffer-occur-engine regexp buffers out-buf nlines
)))
1168 (switch-to-buffer out-buf
)
1169 (setq buffer-read-only t
)
1170 (delete-other-windows)
1171 (goto-char (point-min))
1172 (message "Found %s matches in %s buffers" count
(length buffers
)))
1173 (message "No matches found"))))
1176 (defun ibuffer-occur-revert-buffer-function (ignore-auto noconfirm
)
1177 "Update the *Ibuffer occur* buffer."
1178 (assert (eq major-mode
'ibuffer-occur-mode
))
1179 (ibuffer-do-occur-1 (car ibuffer-occur-props
)
1180 (cadr ibuffer-occur-props
)
1182 (caddr ibuffer-occur-props
)))
1184 (defun ibuffer-occur-engine (regexp buffers out-buf nlines
)
1185 (macrolet ((insert-get-point
1192 `(when (ibuffer-use-fontification)
1193 (overlay-put ,over
,prop
,value
)))
1194 (maybe-ibuffer-propertize
1196 (let ((objsym (gensym "--maybe-ibuffer-propertize-")))
1197 `(let ((,objsym
,obj
))
1198 (if (ibuffer-use-fontification)
1199 (propertize ,objsym
,@args
)
1201 (with-current-buffer out-buf
1202 (ibuffer-occur-mode)
1203 (setq buffer-read-only nil
)
1204 (let ((globalcount 0))
1205 ;; Map over all the buffers
1206 (dolist (buf buffers
)
1207 (when (buffer-live-p buf
)
1208 (let ((c 0) ;; count of matched lines
1210 (headerpt (with-current-buffer out-buf
(point))))
1214 (goto-char (point-min)) ;; begin searching in the buffer
1216 ;; The line we're matching against
1217 (let ((curline (buffer-substring
1218 (line-beginning-position)
1219 (line-end-position))))
1220 (when (string-match regexp curline
)
1221 (incf c
) ;; increment match count
1223 ;; Depropertize the string, and maybe highlight the matches
1226 (ibuffer-depropertize-string curline t
)
1227 (when (ibuffer-use-fontification)
1228 (let ((len (length curline
))
1230 (while (and (< start len
)
1231 (string-match regexp curline start
))
1232 (put-text-property (match-beginning 0)
1234 'face ibuffer-occur-match-face
1236 (setq start
(match-end 0)))))
1238 ;; Generate the string to insert for this match
1241 ;; The simple display style
1242 (concat (maybe-ibuffer-propertize
1247 ;; The complex multi-line display style
1248 (let ((prevlines (nreverse
1249 (ibuffer-accumulate-lines (- nlines
))))
1250 (nextlines (ibuffer-accumulate-lines nlines
))
1251 ;; The lack of `flet' seriously sucks.
1252 (fun #'(lambda (lines)
1255 (concat " :" line
"\n"))
1257 (setq prevlines
(funcall fun prevlines
))
1258 (setq nextlines
(funcall fun nextlines
))
1259 ;; Yes, I am trying to win the award for the
1266 (maybe-ibuffer-propertize
1273 ;; Actually insert the match display data
1274 (with-current-buffer out-buf
1276 (end (insert-get-point
1278 (unless (= nlines
1)
1279 (insert "-------\n"))
1281 beg
(1- end
) 'ibuffer-occur-target
(cons buf l
))
1283 beg
(1- end
) 'mouse-face
'highlight
))))))
1284 ;; On to the next line...
1287 (when (not (zerop c
)) ;; is the count zero?
1288 (with-current-buffer out-buf
1289 (goto-char headerpt
)
1291 (end (insert-get-point
1292 (format "%d lines matching \"%s\" in buffer %s\n"
1293 c regexp
(buffer-name buf
)))))
1294 (let ((o (make-overlay beg end
)))
1295 (maybe-put-overlay o
'face
'underline
)))
1296 (goto-char (point-max)))))))
1297 (setq ibuffer-occur-props
(list regexp buffers nlines
))
1298 ;; Return the number of matches
1303 ;;; ibuf-ext.el ends here