Add missing bug number to last changelog entry
[bpt/emacs.git] / lisp / ibuf-ext.el
... / ...
CommitLineData
1;;; ibuf-ext.el --- extensions for ibuffer
2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Colin Walters <walters@verbum.org>
7;; Maintainer: John Paul Wallington <jpw@gnu.org>
8;; Created: 2 Dec 2001
9;; Keywords: buffer, convenience
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27
28;; These functions should be automatically loaded when called, but you
29;; can explicity (require 'ibuf-ext) in your ~/.emacs to have them
30;; preloaded.
31
32;;; Code:
33
34(require 'ibuffer)
35
36(eval-when-compile
37 (require 'ibuf-macs)
38 (require 'cl))
39
40;;; Utility functions
41(defun ibuffer-delete-alist (key alist)
42 "Delete all entries in ALIST that have a key equal to KEY."
43 (let (entry)
44 (while (setq entry (assoc key alist))
45 (setq alist (delete entry alist)))
46 alist))
47
48;; borrowed from Gnus
49(defun ibuffer-remove-duplicates (list)
50 "Return a copy of LIST with duplicate elements removed."
51 (let ((new nil)
52 (tail list))
53 (while tail
54 (or (member (car tail) new)
55 (setq new (cons (car tail) new)))
56 (setq tail (cdr tail)))
57 (nreverse new)))
58
59(defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
60 (let ((hip-crowd nil)
61 (lamers nil))
62 (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
63 (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
64 (push ibuffer-split-list-elt hip-crowd)
65 (push ibuffer-split-list-elt lamers)))
66 ;; Too bad Emacs Lisp doesn't have multiple values.
67 (list (nreverse hip-crowd) (nreverse lamers))))
68
69(defcustom ibuffer-never-show-predicates nil
70 "A list of predicates (a regexp or function) for buffers not to display.
71If a regexp, then it will be matched against the buffer's name.
72If a function, it will be called with the buffer as an argument, and
73should return non-nil if this buffer should not be shown."
74 :type '(repeat (choice regexp function))
75 :require 'ibuf-ext
76 :group 'ibuffer)
77
78(defcustom ibuffer-always-show-predicates nil
79 "A list of predicates (a regexp or function) for buffers to always display.
80If a regexp, then it will be matched against the buffer's name.
81If a function, it will be called with the buffer as an argument, and
82should return non-nil if this buffer should be shown.
83Note that buffers matching one of these predicates will be shown
84regardless of any active filters in this buffer."
85 :type '(repeat (choice regexp function))
86 :group 'ibuffer)
87
88(defvar ibuffer-tmp-hide-regexps nil
89 "A list of regexps which should match buffer names to not show.")
90
91(defvar ibuffer-tmp-show-regexps nil
92 "A list of regexps which should match buffer names to always show.")
93
94(defvar ibuffer-auto-mode nil
95 "If non-nil, Ibuffer auto-mode should be enabled for this buffer.
96Do not set this variable directly! Use the function
97`ibuffer-auto-mode' instead.")
98
99(defvar ibuffer-auto-buffers-changed nil)
100
101(defcustom ibuffer-saved-filters '(("gnus"
102 ((or (mode . message-mode)
103 (mode . mail-mode)
104 (mode . gnus-group-mode)
105 (mode . gnus-summary-mode)
106 (mode . gnus-article-mode))))
107 ("programming"
108 ((or (mode . emacs-lisp-mode)
109 (mode . cperl-mode)
110 (mode . c-mode)
111 (mode . java-mode)
112 (mode . idl-mode)
113 (mode . lisp-mode)))))
114
115 "An alist of filter qualifiers to switch between.
116
117This variable should look like ((\"STRING\" QUALIFIERS)
118 (\"STRING\" QUALIFIERS) ...), where
119QUALIFIERS is a list of the same form as
120`ibuffer-filtering-qualifiers'.
121See also the variables `ibuffer-filtering-qualifiers',
122`ibuffer-filtering-alist', and the functions
123`ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
124 :type '(repeat sexp)
125 :group 'ibuffer)
126
127(defvar ibuffer-filtering-qualifiers nil
128 "A list like (SYMBOL . QUALIFIER) which filters the current buffer list.
129See also `ibuffer-filtering-alist'.")
130
131;; This is now frobbed by `define-ibuffer-filter'.
132(defvar ibuffer-filtering-alist nil
133 "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
134
135You most likely do not want to modify this variable directly; see
136`define-ibuffer-filter'.
137
138SYMBOL is the symbolic name of the filter. DESCRIPTION is used when
139displaying information to the user. FUNCTION is given a buffer and
140the value of the qualifier, and returns non-nil if and only if the
141buffer should be displayed.")
142
143(defcustom ibuffer-filter-format-alist nil
144 "An alist which has special formats used when a filter is active.
145The contents of this variable should look like:
146 ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
147
148For example, suppose that when you add a filter for buffers whose
149major mode is `emacs-lisp-mode', you only want to see the mark and the
150name of the buffer. You could accomplish that by adding:
151 (mode ((mark \" \" name)))
152to this variable."
153 :type '(repeat (list :tag "Association" (symbol :tag "Filter")
154 (list :tag "Formats" (repeat (sexp :tag "Format")))))
155 :group 'ibuffer)
156
157(defvar ibuffer-cached-filter-formats nil)
158(defvar ibuffer-compiled-filter-formats nil)
159
160(defvar ibuffer-filter-groups nil
161 "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.
162The SYMBOL should be one from `ibuffer-filtering-alist'.
163The QUALIFIER should be the same as QUALIFIER in
164`ibuffer-filtering-qualifiers'.")
165
166(defcustom ibuffer-show-empty-filter-groups t
167 "If non-nil, then show the names of filter groups which are empty."
168 :type 'boolean
169 :group 'ibuffer)
170
171(defcustom ibuffer-saved-filter-groups nil
172 "An alist of filtering groups to switch between.
173
174This variable should look like ((\"STRING\" QUALIFIERS)
175 (\"STRING\" QUALIFIERS) ...), where
176QUALIFIERS is a list of the same form as
177`ibuffer-filtering-qualifiers'.
178
179See also the variables `ibuffer-filter-groups',
180`ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the
181functions `ibuffer-switch-to-saved-filter-groups',
182`ibuffer-save-filter-groups'."
183 :type '(repeat sexp)
184 :group 'ibuffer)
185
186(defvar ibuffer-hidden-filter-groups nil
187 "A list of filtering groups which are currently hidden.")
188
189(defvar ibuffer-filter-group-kill-ring nil)
190
191(defcustom ibuffer-old-time 72
192 "The number of hours before a buffer is considered \"old\"."
193 :type '(choice (const :tag "72 hours (3 days)" 72)
194 (const :tag "48 hours (2 days)" 48)
195 (const :tag "24 hours (1 day)" 24)
196 (integer :tag "hours"))
197 :group 'ibuffer)
198
199(defcustom ibuffer-save-with-custom t
200 "If non-nil, then use Custom to save interactively changed variables.
201Currently, this only applies to `ibuffer-saved-filters' and
202`ibuffer-saved-filter-groups'."
203 :type 'boolean
204 :group 'ibuffer)
205
206(defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
207 (or
208 (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
209 (and (not
210 (or
211 (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
212 (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
213 (or all
214 (not
215 (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
216 (or ibuffer-view-ibuffer
217 (and ibuffer-buf
218 (not (eq ibuffer-buf buf))))
219 (or
220 (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
221 (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
222
223(defun ibuffer-auto-update-changed ()
224 (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
225 (dolist (buf (buffer-list))
226 (ignore-errors
227 (with-current-buffer buf
228 (when (and ibuffer-auto-mode
229 (derived-mode-p 'ibuffer-mode))
230 (ibuffer-update nil t)))))))
231
232;;;###autoload
233(defun ibuffer-auto-mode (&optional arg)
234 "Toggle use of Ibuffer's auto-update facility.
235With numeric ARG, enable auto-update if and only if ARG is positive."
236 (interactive)
237 (unless (derived-mode-p 'ibuffer-mode)
238 (error "This buffer is not in Ibuffer mode"))
239 (set (make-local-variable 'ibuffer-auto-mode)
240 (if arg
241 (plusp arg)
242 (not ibuffer-auto-mode)))
243 (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
244 (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
245
246;;;###autoload
247(defun ibuffer-mouse-filter-by-mode (event)
248 "Enable or disable filtering by the major mode chosen via mouse."
249 (interactive "e")
250 (ibuffer-interactive-filter-by-mode event))
251
252;;;###autoload
253(defun ibuffer-interactive-filter-by-mode (event-or-point)
254 "Enable or disable filtering by the major mode at point."
255 (interactive "d")
256 (if (eventp event-or-point)
257 (posn-set-point (event-end event-or-point))
258 (goto-char event-or-point))
259 (let ((buf (ibuffer-current-buffer)))
260 (if (assq 'mode ibuffer-filtering-qualifiers)
261 (setq ibuffer-filtering-qualifiers
262 (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))
263 (ibuffer-push-filter (cons 'mode (buffer-local-value 'major-mode buf)))))
264 (ibuffer-update nil t))
265
266;;;###autoload
267(defun ibuffer-mouse-toggle-filter-group (event)
268 "Toggle the display status of the filter group chosen with the mouse."
269 (interactive "e")
270 (ibuffer-toggle-filter-group-1 (save-excursion
271 (mouse-set-point event)
272 (point))))
273
274;;;###autoload
275(defun ibuffer-toggle-filter-group ()
276 "Toggle the display status of the filter group on this line."
277 (interactive)
278 (ibuffer-toggle-filter-group-1 (point)))
279
280(defun ibuffer-toggle-filter-group-1 (posn)
281 (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
282 (unless (stringp name)
283 (error "No filtering group name present"))
284 (if (member name ibuffer-hidden-filter-groups)
285 (setq ibuffer-hidden-filter-groups
286 (delete name ibuffer-hidden-filter-groups))
287 (push name ibuffer-hidden-filter-groups))
288 (ibuffer-update nil t)))
289
290;;;###autoload
291(defun ibuffer-forward-filter-group (&optional count)
292 "Move point forwards by COUNT filtering groups."
293 (interactive "P")
294 (unless count
295 (setq count 1))
296 (when (> count 0)
297 (when (get-text-property (point) 'ibuffer-filter-group-name)
298 (goto-char (next-single-property-change
299 (point) 'ibuffer-filter-group-name
300 nil (point-max))))
301 (goto-char (next-single-property-change
302 (point) 'ibuffer-filter-group-name
303 nil (point-max)))
304 (ibuffer-forward-filter-group (1- count)))
305 (ibuffer-forward-line 0))
306
307;;;###autoload
308(defun ibuffer-backward-filter-group (&optional count)
309 "Move point backwards by COUNT filtering groups."
310 (interactive "P")
311 (unless count
312 (setq count 1))
313 (when (> count 0)
314 (when (get-text-property (point) 'ibuffer-filter-group-name)
315 (goto-char (previous-single-property-change
316 (point) 'ibuffer-filter-group-name
317 nil (point-min))))
318 (goto-char (previous-single-property-change
319 (point) 'ibuffer-filter-group-name
320 nil (point-min)))
321 (ibuffer-backward-filter-group (1- count)))
322 (when (= (point) (point-min))
323 (goto-char (point-max))
324 (ibuffer-backward-filter-group 1))
325 (ibuffer-forward-line 0))
326
327;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext")
328(define-ibuffer-op shell-command-pipe (command)
329 "Pipe the contents of each marked buffer to shell command COMMAND."
330 (:interactive "sPipe to shell command: "
331 :opstring "Shell command executed on"
332 :modifier-p nil)
333 (shell-command-on-region
334 (point-min) (point-max) command
335 (get-buffer-create "* ibuffer-shell-output*")))
336
337;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext")
338(define-ibuffer-op shell-command-pipe-replace (command)
339 "Replace the contents of marked buffers with output of pipe to COMMAND."
340 (:interactive "sPipe to shell command (replace): "
341 :opstring "Buffer contents replaced in"
342 :active-opstring "replace buffer contents in"
343 :dangerous t
344 :modifier-p t)
345 (with-current-buffer buf
346 (shell-command-on-region (point-min) (point-max)
347 command nil t)))
348
349;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext")
350(define-ibuffer-op shell-command-file (command)
351 "Run shell command COMMAND separately on files of marked buffers."
352 (:interactive "sShell command on buffer's file: "
353 :opstring "Shell command executed on"
354 :modifier-p nil)
355 (shell-command (concat command " "
356 (shell-quote-argument
357 (if buffer-file-name
358 buffer-file-name
359 (make-temp-file
360 (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
361
362;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext")
363(define-ibuffer-op eval (form)
364 "Evaluate FORM in each of the buffers.
365Does not display the buffer during evaluation. See
366`ibuffer-do-view-and-eval' for that."
367 (:interactive
368 (list
369 (read-from-minibuffer
370 "Eval in buffers (form): "
371 nil read-expression-map t 'read-expression-history))
372 :opstring "evaluated in"
373 :modifier-p :maybe)
374 (eval form))
375
376;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
377(define-ibuffer-op view-and-eval (form)
378 "Evaluate FORM while displaying each of the marked buffers.
379To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
380 (:interactive
381 (list
382 (read-from-minibuffer
383 "Eval viewing in buffers (form): "
384 nil read-expression-map t 'read-expression-history))
385 :opstring "evaluated in"
386 :complex t
387 :modifier-p :maybe)
388 (let ((ibuffer-buf (current-buffer)))
389 (unwind-protect
390 (progn
391 (switch-to-buffer buf)
392 (eval form))
393 (switch-to-buffer ibuffer-buf))))
394
395;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
396(define-ibuffer-op rename-uniquely ()
397 "Rename marked buffers as with `rename-uniquely'."
398 (:opstring "renamed"
399 :modifier-p t)
400 (rename-uniquely))
401
402;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext")
403(define-ibuffer-op revert ()
404 "Revert marked buffers as with `revert-buffer'."
405 (:dangerous t
406 :opstring "reverted"
407 :active-opstring "revert"
408 :modifier-p :maybe)
409 (revert-buffer t t))
410
411;;;###autoload (autoload 'ibuffer-do-isearch "ibuf-ext")
412(define-ibuffer-op ibuffer-do-isearch ()
413 "Perform a `isearch-forward' in marked buffers."
414 (:interactive ()
415 :opstring "searched in"
416 :complex t
417 :modifier-p :maybe)
418 (multi-isearch-buffers (ibuffer-get-marked-buffers)))
419
420;;;###autoload (autoload 'ibuffer-do-isearch-regexp "ibuf-ext")
421(define-ibuffer-op ibuffer-do-isearch-regexp ()
422 "Perform a `isearch-forward-regexp' in marked buffers."
423 (:interactive ()
424 :opstring "searched regexp in"
425 :complex t
426 :modifier-p :maybe)
427 (multi-isearch-buffers-regexp (ibuffer-get-marked-buffers)))
428
429;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext")
430(define-ibuffer-op replace-regexp (from-str to-str)
431 "Perform a `replace-regexp' in marked buffers."
432 (:interactive
433 (let* ((from-str (read-from-minibuffer "Replace regexp: "))
434 (to-str (read-from-minibuffer (concat "Replace " from-str
435 " with: "))))
436 (list from-str to-str))
437 :opstring "replaced in"
438 :complex t
439 :modifier-p :maybe)
440 (save-window-excursion
441 (switch-to-buffer buf)
442 (save-excursion
443 (goto-char (point-min))
444 (let ((case-fold-search ibuffer-case-fold-search))
445 (while (re-search-forward from-str nil t)
446 (replace-match to-str))))
447 t))
448
449;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext")
450(define-ibuffer-op query-replace (&rest args)
451 "Perform a `query-replace' in marked buffers."
452 (:interactive
453 (query-replace-read-args "Query replace" t t)
454 :opstring "replaced in"
455 :complex t
456 :modifier-p :maybe)
457 (save-window-excursion
458 (switch-to-buffer buf)
459 (save-excursion
460 (let ((case-fold-search ibuffer-case-fold-search))
461 (goto-char (point-min))
462 (apply #'query-replace args)))
463 t))
464
465;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext")
466(define-ibuffer-op query-replace-regexp (&rest args)
467 "Perform a `query-replace-regexp' in marked buffers."
468 (:interactive
469 (query-replace-read-args "Query replace regexp" t t)
470 :opstring "replaced in"
471 :complex t
472 :modifier-p :maybe)
473 (save-window-excursion
474 (switch-to-buffer buf)
475 (save-excursion
476 (let ((case-fold-search ibuffer-case-fold-search))
477 (goto-char (point-min))
478 (apply #'query-replace-regexp args)))
479 t))
480
481;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext")
482(define-ibuffer-op print ()
483 "Print marked buffers as with `print-buffer'."
484 (:opstring "printed"
485 :modifier-p nil)
486 (print-buffer))
487
488;;;###autoload
489(defun ibuffer-included-in-filters-p (buf filters)
490 (not
491 (memq nil ;; a filter will return nil if it failed
492 (mapcar
493 ;; filter should be like (TYPE . QUALIFIER), or
494 ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...)
495 #'(lambda (qual)
496 (ibuffer-included-in-filter-p buf qual))
497 filters))))
498
499(defun ibuffer-included-in-filter-p (buf filter)
500 (if (eq (car filter) 'not)
501 (not (ibuffer-included-in-filter-p-1 buf (cdr filter)))
502 (ibuffer-included-in-filter-p-1 buf filter)))
503
504(defun ibuffer-included-in-filter-p-1 (buf filter)
505 (not
506 (not
507 (case (car filter)
508 (or
509 (memq t (mapcar #'(lambda (x)
510 (ibuffer-included-in-filter-p buf x))
511 (cdr filter))))
512 (saved
513 (let ((data
514 (assoc (cdr filter)
515 ibuffer-saved-filters)))
516 (unless data
517 (ibuffer-filter-disable)
518 (error "Unknown saved filter %s" (cdr filter)))
519 (ibuffer-included-in-filters-p buf (cadr data))))
520 (t
521 (let ((filterdat (assq (car filter)
522 ibuffer-filtering-alist)))
523 ;; filterdat should be like (TYPE DESCRIPTION FUNC)
524 ;; just a sanity check
525 (unless filterdat
526 (ibuffer-filter-disable)
527 (error "Undefined filter %s" (car filter)))
528 (not
529 (not
530 (funcall (caddr filterdat)
531 buf
532 (cdr filter))))))))))
533
534(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
535 (let ((filter-group-alist (if nodefault
536 ibuffer-filter-groups
537 (append ibuffer-filter-groups
538 (list (cons "Default" nil))))))
539;; (dolist (hidden ibuffer-hidden-filter-groups)
540;; (setq filter-group-alist (ibuffer-delete-alist
541;; hidden filter-group-alist)))
542 (let ((vec (make-vector (length filter-group-alist) nil))
543 (i 0))
544 (dolist (filtergroup filter-group-alist)
545 (let ((filterset (cdr filtergroup)))
546 (multiple-value-bind (hip-crowd lamers)
547 (ibuffer-split-list (lambda (bufmark)
548 (ibuffer-included-in-filters-p (car bufmark)
549 filterset))
550 bmarklist)
551 (aset vec i hip-crowd)
552 (incf i)
553 (setq bmarklist lamers))))
554 (let (ret)
555 (dotimes (j i ret)
556 (let ((bufs (aref vec j)))
557 (unless (and noempty (null bufs))
558 (push (cons (car (nth j filter-group-alist))
559 bufs)
560 ret))))))))
561
562;;;###autoload
563(defun ibuffer-filters-to-filter-group (name)
564 "Make the current filters into a filtering group."
565 (interactive "sName for filtering group: ")
566 (when (null ibuffer-filtering-qualifiers)
567 (error "No filters in effect"))
568 (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
569 (ibuffer-filter-disable))
570
571;;;###autoload
572(defun ibuffer-set-filter-groups-by-mode ()
573 "Set the current filter groups to filter by mode."
574 (interactive)
575 (setq ibuffer-filter-groups
576 (mapcar (lambda (mode)
577 (cons (format "%s" mode) `((mode . ,mode))))
578 (let ((modes
579 (ibuffer-remove-duplicates
580 (mapcar (lambda (buf)
581 (buffer-local-value 'major-mode buf))
582 (buffer-list)))))
583 (if ibuffer-view-ibuffer
584 modes
585 (delq 'ibuffer-mode modes)))))
586 (ibuffer-update nil t))
587
588;;;###autoload
589(defun ibuffer-pop-filter-group ()
590 "Remove the first filter group."
591 (interactive)
592 (when (null ibuffer-filter-groups)
593 (error "No filter groups active"))
594 (setq ibuffer-hidden-filter-groups
595 (delete (pop ibuffer-filter-groups)
596 ibuffer-hidden-filter-groups))
597 (ibuffer-update nil t))
598
599(defun ibuffer-read-filter-group-name (msg &optional nodefault noerror)
600 (when (and (not noerror) (null ibuffer-filter-groups))
601 (error "No filter groups active"))
602 ;; `ibuffer-generate-filter-groups' returns all non-hidden filter
603 ;; groups, possibly excluding empty groups or Default.
604 ;; We add `ibuffer-hidden-filter-groups' to the list, excluding
605 ;; Default if necessary.
606 (completing-read msg (nconc
607 (ibuffer-generate-filter-groups
608 (ibuffer-current-state-list)
609 (not ibuffer-show-empty-filter-groups)
610 nodefault)
611 (if nodefault
612 (remove "Default" ibuffer-hidden-filter-groups)
613 ibuffer-hidden-filter-groups))
614 nil t))
615
616;;;###autoload
617(defun ibuffer-decompose-filter-group (group)
618 "Decompose the filter group GROUP into active filters."
619 (interactive
620 (list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
621 (let ((data (cdr (assoc group ibuffer-filter-groups))))
622 (setq ibuffer-filter-groups (ibuffer-delete-alist
623 group ibuffer-filter-groups)
624 ibuffer-filtering-qualifiers data))
625 (ibuffer-update nil t))
626
627;;;###autoload
628(defun ibuffer-clear-filter-groups ()
629 "Remove all filter groups."
630 (interactive)
631 (setq ibuffer-filter-groups nil
632 ibuffer-hidden-filter-groups nil)
633 (ibuffer-update nil t))
634
635(defun ibuffer-current-filter-groups-with-position ()
636 (save-excursion
637 (goto-char (point-min))
638 (let ((pos nil)
639 (result nil))
640 (while (and (not (eobp))
641 (setq pos (next-single-property-change
642 (point) 'ibuffer-filter-group-name)))
643 (goto-char pos)
644 (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
645 pos)
646 result)
647 (goto-char (next-single-property-change
648 pos 'ibuffer-filter-group-name)))
649 (nreverse result))))
650
651;;;###autoload
652(defun ibuffer-jump-to-filter-group (name)
653 "Move point to the filter group whose name is NAME."
654 (interactive
655 (list (ibuffer-read-filter-group-name "Jump to filter group: ")))
656 (ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
657 (goto-char (cdr it))
658 (error "No filter group with name %s" name)))
659
660;;;###autoload
661(defun ibuffer-kill-filter-group (name)
662 "Kill the filter group named NAME.
663The group will be added to `ibuffer-filter-group-kill-ring'."
664 (interactive (list (ibuffer-read-filter-group-name "Kill filter group: " t)))
665 (when (equal name "Default")
666 (error "Can't kill default filter group"))
667 (ibuffer-aif (assoc name ibuffer-filter-groups)
668 (progn
669 (push (copy-tree it) ibuffer-filter-group-kill-ring)
670 (setq ibuffer-filter-groups (ibuffer-delete-alist
671 name ibuffer-filter-groups))
672 (setq ibuffer-hidden-filter-groups
673 (delete name ibuffer-hidden-filter-groups)))
674 (error "No filter group with name \"%s\"" name))
675 (ibuffer-update nil t))
676
677;;;###autoload
678(defun ibuffer-kill-line (&optional arg interactive-p)
679 "Kill the filter group at point.
680See also `ibuffer-kill-filter-group'."
681 (interactive "P\np")
682 (ibuffer-aif (save-excursion
683 (ibuffer-forward-line 0)
684 (get-text-property (point) 'ibuffer-filter-group-name))
685 (progn
686 (ibuffer-kill-filter-group it))
687 (funcall (if interactive-p #'call-interactively #'funcall)
688 #'kill-line arg)))
689
690(defun ibuffer-insert-filter-group-before (newgroup group)
691 (let* ((found nil)
692 (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
693 (res 0))
694 (while groups
695 (if (equal (car groups) group)
696 (setq found t
697 groups nil)
698 (incf res)
699 (setq groups (cdr groups))))
700 res)))
701 (cond ((not found)
702 (setq ibuffer-filter-groups
703 (nconc ibuffer-filter-groups (list newgroup))))
704 ((zerop pos)
705 (push newgroup ibuffer-filter-groups))
706 (t
707 (let ((cell (nthcdr pos ibuffer-filter-groups)))
708 (setf (cdr cell) (cons (car cell) (cdr cell)))
709 (setf (car cell) newgroup))))))
710
711;;;###autoload
712(defun ibuffer-yank ()
713 "Yank the last killed filter group before group at point."
714 (interactive)
715 (ibuffer-yank-filter-group
716 (or (get-text-property (point) 'ibuffer-filter-group-name)
717 (get-text-property (point) 'ibuffer-filter-group)
718 (error "No filter group at point"))))
719
720;;;###autoload
721(defun ibuffer-yank-filter-group (name)
722 "Yank the last killed filter group before group named NAME."
723 (interactive (list (ibuffer-read-filter-group-name
724 "Yank filter group before group: ")))
725 (unless ibuffer-filter-group-kill-ring
726 (error "The Ibuffer filter group kill-ring is empty"))
727 (save-excursion
728 (ibuffer-forward-line 0)
729 (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
730 name))
731 (ibuffer-update nil t))
732
733;;;###autoload
734(defun ibuffer-save-filter-groups (name groups)
735 "Save all active filter groups GROUPS as NAME.
736They are added to `ibuffer-saved-filter-groups'. Interactively,
737prompt for NAME, and use the current filters."
738 (interactive
739 (if (null ibuffer-filter-groups)
740 (error "No filter groups active")
741 (list
742 (read-from-minibuffer "Save current filter groups as: ")
743 ibuffer-filter-groups)))
744 (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
745 (setcdr it groups)
746 (push (cons name groups) ibuffer-saved-filter-groups))
747 (ibuffer-maybe-save-stuff))
748
749;;;###autoload
750(defun ibuffer-delete-saved-filter-groups (name)
751 "Delete saved filter groups with NAME.
752They are removed from `ibuffer-saved-filter-groups'."
753 (interactive
754 (list
755 (if (null ibuffer-saved-filter-groups)
756 (error "No saved filter groups")
757 (completing-read "Delete saved filter group: "
758 ibuffer-saved-filter-groups nil t))))
759 (setq ibuffer-saved-filter-groups
760 (ibuffer-delete-alist name ibuffer-saved-filter-groups))
761 (ibuffer-maybe-save-stuff)
762 (ibuffer-update nil t))
763
764;;;###autoload
765(defun ibuffer-switch-to-saved-filter-groups (name)
766 "Set this buffer's filter groups to saved version with NAME.
767The value from `ibuffer-saved-filter-groups' is used."
768 (interactive
769 (list
770 (if (null ibuffer-saved-filter-groups)
771 (error "No saved filters")
772 (completing-read "Switch to saved filter group: "
773 ibuffer-saved-filter-groups nil t))))
774 (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
775 ibuffer-hidden-filter-groups nil)
776 (ibuffer-update nil t))
777
778;;;###autoload
779(defun ibuffer-filter-disable ()
780 "Disable all filters currently in effect in this buffer."
781 (interactive)
782 (setq ibuffer-filtering-qualifiers nil)
783 (let ((buf (ibuffer-current-buffer)))
784 (ibuffer-update nil t)
785 (when buf
786 (ibuffer-jump-to-buffer (buffer-name buf)))))
787
788;;;###autoload
789(defun ibuffer-pop-filter ()
790 "Remove the top filter in this buffer."
791 (interactive)
792 (when (null ibuffer-filtering-qualifiers)
793 (error "No filters in effect"))
794 (pop ibuffer-filtering-qualifiers)
795 (let ((buf (ibuffer-current-buffer)))
796 (ibuffer-update nil t)
797 (when buf
798 (ibuffer-jump-to-buffer (buffer-name buf)))))
799
800(defun ibuffer-push-filter (qualifier)
801 "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
802 (push qualifier ibuffer-filtering-qualifiers))
803
804;;;###autoload
805(defun ibuffer-decompose-filter ()
806 "Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
807
808This means that the topmost filter on the filtering stack, which must
809be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
810turned into two separate filters [name: foo] and [mode: bar-mode]."
811 (interactive)
812 (when (null ibuffer-filtering-qualifiers)
813 (error "No filters in effect"))
814 (let ((lim (pop ibuffer-filtering-qualifiers)))
815 (case (car lim)
816 (or
817 (setq ibuffer-filtering-qualifiers (append
818 (cdr lim)
819 ibuffer-filtering-qualifiers)))
820 (saved
821 (let ((data
822 (assoc (cdr lim)
823 ibuffer-saved-filters)))
824 (unless data
825 (ibuffer-filter-disable)
826 (error "Unknown saved filter %s" (cdr lim)))
827 (setq ibuffer-filtering-qualifiers (append
828 (cadr data)
829 ibuffer-filtering-qualifiers))))
830 (not
831 (push (cdr lim)
832 ibuffer-filtering-qualifiers))
833 (t
834 (error "Filter type %s is not compound" (car lim)))))
835 (ibuffer-update nil t))
836
837;;;###autoload
838(defun ibuffer-exchange-filters ()
839 "Exchange the top two filters on the stack in this buffer."
840 (interactive)
841 (when (< (length ibuffer-filtering-qualifiers)
842 2)
843 (error "Need two filters to exchange"))
844 (let ((first (pop ibuffer-filtering-qualifiers))
845 (second (pop ibuffer-filtering-qualifiers)))
846 (push first ibuffer-filtering-qualifiers)
847 (push second ibuffer-filtering-qualifiers))
848 (ibuffer-update nil t))
849
850;;;###autoload
851(defun ibuffer-negate-filter ()
852 "Negate the sense of the top filter in the current buffer."
853 (interactive)
854 (when (null ibuffer-filtering-qualifiers)
855 (error "No filters in effect"))
856 (let ((lim (pop ibuffer-filtering-qualifiers)))
857 (push (if (eq (car lim) 'not)
858 (cdr lim)
859 (cons 'not lim))
860 ibuffer-filtering-qualifiers))
861 (ibuffer-update nil t))
862
863;;;###autoload
864(defun ibuffer-or-filter (&optional reverse)
865 "Replace the top two filters in this buffer with their logical OR.
866If optional argument REVERSE is non-nil, instead break the top OR
867filter into parts."
868 (interactive "P")
869 (if reverse
870 (progn
871 (when (or (null ibuffer-filtering-qualifiers)
872 (not (eq 'or (caar ibuffer-filtering-qualifiers))))
873 (error "Top filter is not an OR"))
874 (let ((lim (pop ibuffer-filtering-qualifiers)))
875 (setq ibuffer-filtering-qualifiers
876 (nconc (cdr lim) ibuffer-filtering-qualifiers))))
877 (when (< (length ibuffer-filtering-qualifiers) 2)
878 (error "Need two filters to OR"))
879 ;; If the second filter is an OR, just add to it.
880 (let ((first (pop ibuffer-filtering-qualifiers))
881 (second (pop ibuffer-filtering-qualifiers)))
882 (if (eq 'or (car second))
883 (push (nconc (list 'or first) (cdr second))
884 ibuffer-filtering-qualifiers)
885 (push (list 'or first second)
886 ibuffer-filtering-qualifiers))))
887 (ibuffer-update nil t))
888
889(defun ibuffer-maybe-save-stuff ()
890 (when ibuffer-save-with-custom
891 (if (fboundp 'customize-save-variable)
892 (progn
893 (customize-save-variable 'ibuffer-saved-filters
894 ibuffer-saved-filters)
895 (customize-save-variable 'ibuffer-saved-filter-groups
896 ibuffer-saved-filter-groups))
897 (message "Not saved permanently: Customize not available"))))
898
899;;;###autoload
900(defun ibuffer-save-filters (name filters)
901 "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
902Interactively, prompt for NAME, and use the current filters."
903 (interactive
904 (if (null ibuffer-filtering-qualifiers)
905 (error "No filters currently in effect")
906 (list
907 (read-from-minibuffer "Save current filters as: ")
908 ibuffer-filtering-qualifiers)))
909 (ibuffer-aif (assoc name ibuffer-saved-filters)
910 (setcdr it filters)
911 (push (list name filters) ibuffer-saved-filters))
912 (ibuffer-maybe-save-stuff))
913
914;;;###autoload
915(defun ibuffer-delete-saved-filters (name)
916 "Delete saved filters with NAME from `ibuffer-saved-filters'."
917 (interactive
918 (list
919 (if (null ibuffer-saved-filters)
920 (error "No saved filters")
921 (completing-read "Delete saved filters: "
922 ibuffer-saved-filters nil t))))
923 (setq ibuffer-saved-filters
924 (ibuffer-delete-alist name ibuffer-saved-filters))
925 (ibuffer-maybe-save-stuff)
926 (ibuffer-update nil t))
927
928;;;###autoload
929(defun ibuffer-add-saved-filters (name)
930 "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
931 (interactive
932 (list
933 (if (null ibuffer-saved-filters)
934 (error "No saved filters")
935 (completing-read "Add saved filters: "
936 ibuffer-saved-filters nil t))))
937 (push (cons 'saved name) ibuffer-filtering-qualifiers)
938 (ibuffer-update nil t))
939
940;;;###autoload
941(defun ibuffer-switch-to-saved-filters (name)
942 "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
943 (interactive
944 (list
945 (if (null ibuffer-saved-filters)
946 (error "No saved filters")
947 (completing-read "Switch to saved filters: "
948 ibuffer-saved-filters nil t))))
949 (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
950 (ibuffer-update nil t))
951
952(defun ibuffer-format-filter-group-data (filter)
953 (if (equal filter "Default")
954 ""
955 (concat "Filter:" (mapconcat #'ibuffer-format-qualifier
956 (cdr (assq filter ibuffer-filter-groups))
957 " "))))
958
959(defun ibuffer-format-qualifier (qualifier)
960 (if (eq (car-safe qualifier) 'not)
961 (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")
962 (ibuffer-format-qualifier-1 qualifier)))
963
964(defun ibuffer-format-qualifier-1 (qualifier)
965 (case (car qualifier)
966 (saved
967 (concat " [filter: " (cdr qualifier) "]"))
968 (or
969 (concat " [OR" (mapconcat #'ibuffer-format-qualifier
970 (cdr qualifier) "") "]"))
971 (t
972 (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
973 (unless qualifier
974 (error "Ibuffer: bad qualifier %s" qualifier))
975 (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
976
977
978(defun ibuffer-list-buffer-modes ()
979 "Create an alist of buffer modes currently in use.
980The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
981 (let ((bufs (buffer-list))
982 (modes)
983 (this-mode))
984 (while bufs
985 (setq this-mode (buffer-local-value 'major-mode (car bufs))
986 bufs (cdr bufs))
987 (add-to-list
988 'modes
989 `(,(symbol-name this-mode) .
990 ,this-mode)))
991 modes))
992
993
994;;; Extra operation definitions
995
996;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext")
997(define-ibuffer-filter mode
998 "Toggle current view to buffers with major mode QUALIFIER."
999 (:description "major mode"
1000 :reader
1001 (intern
1002 (completing-read "Filter by major mode: " obarray
1003 #'(lambda (e)
1004 (string-match "-mode$"
1005 (symbol-name e)))
1006 t
1007 (let ((buf (ibuffer-current-buffer)))
1008 (if (and buf (buffer-live-p buf))
1009 (symbol-name (buffer-local-value 'major-mode buf))
1010 "")))))
1011 (eq qualifier (buffer-local-value 'major-mode buf)))
1012
1013;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
1014(define-ibuffer-filter used-mode
1015 "Toggle current view to buffers with major mode QUALIFIER.
1016Called interactively, this function allows selection of modes
1017currently used by buffers."
1018 (:description "major mode in use"
1019 :reader
1020 (intern
1021 (completing-read "Filter by major mode: "
1022 (ibuffer-list-buffer-modes)
1023 nil
1024 t
1025 (let ((buf (ibuffer-current-buffer)))
1026 (if (and buf (buffer-live-p buf))
1027 (symbol-name (buffer-local-value
1028 'major-mode buf))
1029 "")))))
1030 (eq qualifier (buffer-local-value 'major-mode buf)))
1031
1032;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
1033(define-ibuffer-filter name
1034 "Toggle current view to buffers with name matching QUALIFIER."
1035 (:description "buffer name"
1036 :reader (read-from-minibuffer "Filter by name (regexp): "))
1037 (string-match qualifier (buffer-name buf)))
1038
1039;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext")
1040(define-ibuffer-filter filename
1041 "Toggle current view to buffers with filename matching QUALIFIER."
1042 (:description "filename"
1043 :reader (read-from-minibuffer "Filter by filename (regexp): "))
1044 (ibuffer-awhen (buffer-local-value 'buffer-file-name buf)
1045 (string-match qualifier it)))
1046
1047;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
1048(define-ibuffer-filter size-gt
1049 "Toggle current view to buffers with size greater than QUALIFIER."
1050 (:description "size greater than"
1051 :reader
1052 (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
1053 (> (with-current-buffer buf (buffer-size))
1054 qualifier))
1055
1056;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext")
1057(define-ibuffer-filter size-lt
1058 "Toggle current view to buffers with size less than QUALIFIER."
1059 (:description "size less than"
1060 :reader
1061 (string-to-number (read-from-minibuffer "Filter by size less than: ")))
1062 (< (with-current-buffer buf (buffer-size))
1063 qualifier))
1064
1065;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext")
1066(define-ibuffer-filter content
1067 "Toggle current view to buffers whose contents match QUALIFIER."
1068 (:description "content"
1069 :reader (read-from-minibuffer "Filter by content (regexp): "))
1070 (with-current-buffer buf
1071 (save-excursion
1072 (goto-char (point-min))
1073 (re-search-forward qualifier nil t))))
1074
1075;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext")
1076(define-ibuffer-filter predicate
1077 "Toggle current view to buffers for which QUALIFIER returns non-nil."
1078 (:description "predicate"
1079 :reader (read-minibuffer "Filter by predicate (form): "))
1080 (with-current-buffer buf
1081 (eval qualifier)))
1082
1083;;; Sorting
1084
1085;;;###autoload
1086(defun ibuffer-toggle-sorting-mode ()
1087 "Toggle the current sorting mode.
1088Default sorting modes are:
1089 Recency - the last time the buffer was viewed
1090 Name - the name of the buffer
1091 Major Mode - the name of the major mode of the buffer
1092 Size - the size of the buffer"
1093 (interactive)
1094 (let ((modes (mapcar 'car ibuffer-sorting-functions-alist)))
1095 (add-to-list 'modes 'recency)
1096 (setq modes (sort modes 'string-lessp))
1097 (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
1098 (car modes))))
1099 (setq ibuffer-sorting-mode next)
1100 (message "Sorting by %s" next)))
1101 (ibuffer-redisplay t))
1102
1103;;;###autoload
1104(defun ibuffer-invert-sorting ()
1105 "Toggle whether or not sorting is in reverse order."
1106 (interactive)
1107 (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
1108 (message "Sorting order %s"
1109 (if ibuffer-sorting-reversep
1110 "reversed"
1111 "normal"))
1112 (ibuffer-redisplay t))
1113
1114;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext")
1115(define-ibuffer-sorter major-mode
1116 "Sort the buffers by major modes.
1117Ordering is lexicographic."
1118 (:description "major mode")
1119 (string-lessp (downcase
1120 (symbol-name (buffer-local-value 'major-mode (car a))))
1121 (downcase
1122 (symbol-name (buffer-local-value 'major-mode (car b))))))
1123
1124;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext")
1125(define-ibuffer-sorter mode-name
1126 "Sort the buffers by their mode name.
1127Ordering is lexicographic."
1128 (:description "major mode name")
1129 (string-lessp (downcase
1130 (with-current-buffer
1131 (car a)
1132 (format-mode-line mode-name)))
1133 (downcase
1134 (with-current-buffer
1135 (car b)
1136 (format-mode-line mode-name)))))
1137
1138;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext")
1139(define-ibuffer-sorter alphabetic
1140 "Sort the buffers by their names.
1141Ordering is lexicographic."
1142 (:description "buffer name")
1143 (string-lessp
1144 (buffer-name (car a))
1145 (buffer-name (car b))))
1146
1147;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext")
1148(define-ibuffer-sorter size
1149 "Sort the buffers by their size."
1150 (:description "size")
1151 (< (with-current-buffer (car a)
1152 (buffer-size))
1153 (with-current-buffer (car b)
1154 (buffer-size))))
1155
1156;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext")
1157(define-ibuffer-sorter filename/process
1158 "Sort the buffers by their file name/process name."
1159 (:description "file name")
1160 (string-lessp
1161 ;; FIXME: For now just compare the file name and the process name
1162 ;; (if it exists). Is there a better way to do this?
1163 (or (buffer-file-name (car a))
1164 (let ((pr-a (get-buffer-process (car a))))
1165 (and (processp pr-a) (process-name pr-a))))
1166 (or (buffer-file-name (car b))
1167 (let ((pr-b (get-buffer-process (car b))))
1168 (and (processp pr-b) (process-name pr-b))))))
1169
1170;;; Functions to emulate bs.el
1171
1172;;;###autoload
1173(defun ibuffer-bs-show ()
1174 "Emulate `bs-show' from the bs.el package."
1175 (interactive)
1176 (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
1177 (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
1178
1179(defun ibuffer-bs-toggle-all ()
1180 "Emulate `bs-toggle-show-all' from the bs.el package."
1181 (interactive)
1182 (if ibuffer-filtering-qualifiers
1183 (ibuffer-pop-filter)
1184 (progn (ibuffer-push-filter '(filename . ".*"))
1185 (ibuffer-update nil t))))
1186
1187;;; Handy functions
1188
1189;;;###autoload
1190(defun ibuffer-add-to-tmp-hide (regexp)
1191 "Add REGEXP to `ibuffer-tmp-hide-regexps'.
1192This means that buffers whose name matches REGEXP will not be shown
1193for this Ibuffer session."
1194 (interactive
1195 (list
1196 (read-from-minibuffer "Never show buffers matching: "
1197 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1198 (push regexp ibuffer-tmp-hide-regexps))
1199
1200;;;###autoload
1201(defun ibuffer-add-to-tmp-show (regexp)
1202 "Add REGEXP to `ibuffer-tmp-show-regexps'.
1203This means that buffers whose name matches REGEXP will always be shown
1204for this Ibuffer session."
1205 (interactive
1206 (list
1207 (read-from-minibuffer "Always show buffers matching: "
1208 (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
1209 (push regexp ibuffer-tmp-show-regexps))
1210
1211;;;###autoload
1212(defun ibuffer-forward-next-marked (&optional count mark direction)
1213 "Move forward by COUNT marked buffers (default 1).
1214
1215If MARK is non-nil, it should be a character denoting the type of mark
1216to move by. The default is `ibuffer-marked-char'.
1217
1218If DIRECTION is non-nil, it should be an integer; negative integers
1219mean move backwards, non-negative integers mean move forwards."
1220 (interactive "P")
1221 (unless count
1222 (setq count 1))
1223 (unless mark
1224 (setq mark ibuffer-marked-char))
1225 (unless direction
1226 (setq direction 1))
1227 ;; Skip the title
1228 (ibuffer-forward-line 0)
1229 (let ((opos (point))
1230 curmark)
1231 (ibuffer-forward-line direction)
1232 (while (not (or (= (point) opos)
1233 (eq (setq curmark (ibuffer-current-mark))
1234 mark)))
1235 (ibuffer-forward-line direction))
1236 (when (and (= (point) opos)
1237 (not (eq (ibuffer-current-mark) mark)))
1238 (error "No buffers with mark %c" mark))))
1239
1240;;;###autoload
1241(defun ibuffer-backwards-next-marked (&optional count mark)
1242 "Move backwards by COUNT marked buffers (default 1).
1243
1244If MARK is non-nil, it should be a character denoting the type of mark
1245to move by. The default is `ibuffer-marked-char'."
1246 (interactive "P")
1247 (ibuffer-forward-next-marked count mark -1))
1248
1249;;;###autoload
1250(defun ibuffer-do-kill-lines ()
1251 "Hide all of the currently marked lines."
1252 (interactive)
1253 (if (= (ibuffer-count-marked-lines) 0)
1254 (message "No buffers marked; use 'm' to mark a buffer")
1255 (let ((count
1256 (ibuffer-map-marked-lines
1257 #'(lambda (buf mark)
1258 'kill))))
1259 (message "Killed %s lines" count))))
1260
1261;;;###autoload
1262(defun ibuffer-jump-to-buffer (name)
1263 "Move point to the buffer whose name is NAME.
1264
1265If called interactively, prompt for a buffer name and go to the
1266corresponding line in the Ibuffer buffer. If said buffer is in a
1267hidden group filter, open it.
1268
1269If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer
1270visible buffers in the completion list. Calling the command with
1271a prefix argument reverses the meaning of that variable."
1272 (interactive (list
1273 (let ((only-visible ibuffer-jump-offer-only-visible-buffers))
1274 (when current-prefix-arg
1275 (setq only-visible (not only-visible)))
1276 (if only-visible
1277 (let ((table (mapcar #'(lambda (x)
1278 (buffer-name (car x)))
1279 (ibuffer-current-state-list))))
1280 (when (null table)
1281 (error "No buffers!"))
1282 (completing-read "Jump to buffer: "
1283 table nil t))
1284 (read-buffer "Jump to buffer: " nil t)))))
1285 (when (not (string= "" name))
1286 (let (buf-point)
1287 ;; Blindly search for our buffer: it is very likely that it is
1288 ;; not in a hidden filter group.
1289 (ibuffer-map-lines #'(lambda (buf marks)
1290 (when (string= (buffer-name buf) name)
1291 (setq buf-point (point))
1292 nil))
1293 t nil)
1294 (when (and
1295 (null buf-point)
1296 (not (null ibuffer-hidden-filter-groups)))
1297 ;; We did not find our buffer. It must be in a hidden filter
1298 ;; group, so go through all hidden filter groups to find it.
1299 (catch 'found
1300 (dolist (group ibuffer-hidden-filter-groups)
1301 (ibuffer-jump-to-filter-group group)
1302 (ibuffer-toggle-filter-group)
1303 (ibuffer-map-lines #'(lambda (buf marks)
1304 (when (string= (buffer-name buf) name)
1305 (setq buf-point (point))
1306 nil))
1307 t group)
1308 (if buf-point
1309 (throw 'found nil)
1310 (ibuffer-toggle-filter-group)))))
1311 (if (null buf-point)
1312 ;; Still not found even though we expanded all hidden filter
1313 ;; groups: that must be because it's hidden by predicate:
1314 ;; we won't bother trying to display it.
1315 (error "No buffer with name %s" name)
1316 (goto-char buf-point)))))
1317
1318(declare-function diff-sentinel "diff" (code))
1319
1320(defun ibuffer-diff-buffer-with-file-1 (buffer)
1321 (let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
1322 (tempfile (make-temp-file "buffer-content-")))
1323 (when bufferfile
1324 (unwind-protect
1325 (progn
1326 (with-current-buffer buffer
1327 (write-region nil nil tempfile nil 'nomessage))
1328 (let* ((old (expand-file-name bufferfile))
1329 (new (expand-file-name tempfile))
1330 (oldtmp (file-local-copy old))
1331 (newtmp (file-local-copy new))
1332 (switches diff-switches)
1333 (command
1334 (mapconcat
1335 'identity
1336 `(,diff-command
1337 ;; Use explicitly specified switches
1338 ,@(if (listp switches) switches (list switches))
1339 ,@(if (or old new)
1340 (list "-L" (shell-quote-argument old)
1341 "-L" (shell-quote-argument
1342 (format "Buffer %s" (buffer-name buffer)))))
1343 ,(shell-quote-argument (or oldtmp old))
1344 ,(shell-quote-argument (or newtmp new)))
1345 " "))
1346 proc)
1347 (let ((inhibit-read-only t))
1348 (insert command "\n")
1349 (diff-sentinel
1350 (call-process shell-file-name nil
1351 (current-buffer) nil
1352 shell-command-switch command)))
1353 (insert "\n"))))
1354 (sit-for 0)
1355 (when (file-exists-p tempfile)
1356 (delete-file tempfile)))))
1357
1358;;;###autoload
1359(defun ibuffer-diff-with-file ()
1360 "View the differences between marked buffers and their associated files.
1361If no buffers are marked, use buffer at point.
1362This requires the external program \"diff\" to be in your `exec-path'."
1363 (interactive)
1364 (require 'diff)
1365 (let ((marked-bufs (ibuffer-get-marked-buffers)))
1366 (when (null marked-bufs)
1367 (setq marked-bufs (list (ibuffer-current-buffer t))))
1368 (with-current-buffer (get-buffer-create "*Ibuffer Diff*")
1369 (setq buffer-read-only nil)
1370 (buffer-disable-undo (current-buffer))
1371 (erase-buffer)
1372 (buffer-enable-undo (current-buffer))
1373 (diff-mode)
1374 (dolist (buf marked-bufs)
1375 (unless (buffer-live-p buf)
1376 (error "Buffer %s has been killed" buf))
1377 (ibuffer-diff-buffer-with-file-1 buf))
1378 (setq buffer-read-only t)))
1379 (switch-to-buffer "*Ibuffer Diff*"))
1380
1381;;;###autoload
1382(defun ibuffer-copy-filename-as-kill (&optional arg)
1383 "Copy filenames of marked buffers into the kill ring.
1384
1385The names are separated by a space.
1386If a buffer has no filename, it is ignored.
1387
1388With no prefix arg, use the filename sans its directory of each marked file.
1389With a zero prefix arg, use the complete filename of each marked file.
1390With \\[universal-argument], use the filename of each marked file relative
1391to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
1392
1393You can then feed the file name(s) to other commands with \\[yank]."
1394 (interactive "p")
1395 (if (zerop (ibuffer-count-marked-lines))
1396 (message "No buffers marked; use 'm' to mark a buffer")
1397 (let ((ibuffer-copy-filename-as-kill-result "")
1398 (type (cond ((zerop arg)
1399 'full)
1400 ((= arg 4)
1401 'relative)
1402 (t
1403 'name))))
1404 (ibuffer-map-marked-lines
1405 #'(lambda (buf mark)
1406 (setq ibuffer-copy-filename-as-kill-result
1407 (concat ibuffer-copy-filename-as-kill-result
1408 (let ((name (buffer-file-name buf)))
1409 (if name
1410 (case type
1411 (full
1412 name)
1413 (relative
1414 (file-relative-name
1415 name (or ibuffer-default-directory
1416 default-directory)))
1417 (t
1418 (file-name-nondirectory name)))
1419 ""))
1420 " "))))
1421 (kill-new ibuffer-copy-filename-as-kill-result))))
1422
1423(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1424 (let ((count
1425 (ibuffer-map-lines
1426 #'(lambda (buf mark)
1427 (when (funcall func buf)
1428 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1429 ibuffer-marked-char))
1430 t))
1431 nil
1432 group)))
1433 (ibuffer-redisplay t)
1434 (unless (eq ibuffer-mark-on-buffer-mark ?\s)
1435 (message "Marked %s buffers" count))))
1436
1437;;;###autoload
1438(defun ibuffer-mark-by-name-regexp (regexp)
1439 "Mark all buffers whose name matches REGEXP."
1440 (interactive "sMark by name (regexp): ")
1441 (ibuffer-mark-on-buffer
1442 #'(lambda (buf)
1443 (string-match regexp (buffer-name buf)))))
1444
1445;;;###autoload
1446(defun ibuffer-mark-by-mode-regexp (regexp)
1447 "Mark all buffers whose major mode matches REGEXP."
1448 (interactive "sMark by major mode (regexp): ")
1449 (ibuffer-mark-on-buffer
1450 #'(lambda (buf)
1451 (with-current-buffer buf
1452 (string-match regexp (format-mode-line mode-name nil nil buf))))))
1453
1454;;;###autoload
1455(defun ibuffer-mark-by-file-name-regexp (regexp)
1456 "Mark all buffers whose file name matches REGEXP."
1457 (interactive "sMark by file name (regexp): ")
1458 (ibuffer-mark-on-buffer
1459 #'(lambda (buf)
1460 (let ((name (or (buffer-file-name buf)
1461 (with-current-buffer buf
1462 (and
1463 (boundp 'dired-directory)
1464 (stringp dired-directory)
1465 dired-directory)))))
1466 (when name
1467 (string-match regexp name))))))
1468
1469;;;###autoload
1470(defun ibuffer-mark-by-mode (mode)
1471 "Mark all buffers whose major mode equals MODE."
1472 (interactive
1473 (list (intern (completing-read "Mark by major mode: " obarray
1474 #'(lambda (e)
1475 ;; kind of a hack...
1476 (and (fboundp e)
1477 (string-match "-mode$"
1478 (symbol-name e))))
1479 t
1480 (let ((buf (ibuffer-current-buffer)))
1481 (if (and buf (buffer-live-p buf))
1482 (with-current-buffer buf
1483 (cons (symbol-name major-mode)
1484 0))
1485 ""))))))
1486 (ibuffer-mark-on-buffer
1487 #'(lambda (buf)
1488 (eq (buffer-local-value 'major-mode buf) mode))))
1489
1490;;;###autoload
1491(defun ibuffer-mark-modified-buffers ()
1492 "Mark all modified buffers."
1493 (interactive)
1494 (ibuffer-mark-on-buffer
1495 #'(lambda (buf) (buffer-modified-p buf))))
1496
1497;;;###autoload
1498(defun ibuffer-mark-unsaved-buffers ()
1499 "Mark all modified buffers that have an associated file."
1500 (interactive)
1501 (ibuffer-mark-on-buffer
1502 #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
1503 (buffer-modified-p buf)))))
1504
1505;;;###autoload
1506(defun ibuffer-mark-dissociated-buffers ()
1507 "Mark all buffers whose associated file does not exist."
1508 (interactive)
1509 (ibuffer-mark-on-buffer
1510 #'(lambda (buf)
1511 (with-current-buffer buf
1512 (or
1513 (and buffer-file-name
1514 (not (file-exists-p buffer-file-name)))
1515 (and (eq major-mode 'dired-mode)
1516 (boundp 'dired-directory)
1517 (stringp dired-directory)
1518 (not (file-exists-p (file-name-directory dired-directory)))))))))
1519
1520;;;###autoload
1521(defun ibuffer-mark-help-buffers ()
1522 "Mark buffers like *Help*, *Apropos*, *Info*."
1523 (interactive)
1524 (ibuffer-mark-on-buffer
1525 #'(lambda (buf)
1526 (with-current-buffer buf
1527 (memq major-mode ibuffer-help-buffer-modes)))))
1528
1529;;;###autoload
1530(defun ibuffer-mark-compressed-file-buffers ()
1531 "Mark buffers whose associated file is compressed."
1532 (interactive)
1533 (ibuffer-mark-on-buffer
1534 #'(lambda (buf)
1535 (with-current-buffer buf
1536 (and buffer-file-name
1537 (string-match ibuffer-compressed-file-name-regexp
1538 buffer-file-name))))))
1539
1540;;;###autoload
1541(defun ibuffer-mark-old-buffers ()
1542 "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
1543 (interactive)
1544 (ibuffer-mark-on-buffer
1545 #'(lambda (buf)
1546 (with-current-buffer buf
1547 ;; hacked from midnight.el
1548 (when buffer-display-time
1549 (let* ((tm (current-time))
1550 (now (+ (* (float (ash 1 16)) (car tm))
1551 (float (cadr tm)) (* 0.0000001 (caddr tm))))
1552 (then (+ (* (float (ash 1 16))
1553 (car buffer-display-time))
1554 (float (cadr buffer-display-time))
1555 (* 0.0000001 (caddr buffer-display-time)))))
1556 (> (- now then) (* 60 60 ibuffer-old-time))))))))
1557
1558;;;###autoload
1559(defun ibuffer-mark-special-buffers ()
1560 "Mark all buffers whose name begins and ends with '*'."
1561 (interactive)
1562 (ibuffer-mark-on-buffer
1563 #'(lambda (buf) (string-match "^\\*.+\\*$"
1564 (buffer-name buf)))))
1565
1566;;;###autoload
1567(defun ibuffer-mark-read-only-buffers ()
1568 "Mark all read-only buffers."
1569 (interactive)
1570 (ibuffer-mark-on-buffer
1571 #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
1572
1573;;;###autoload
1574(defun ibuffer-mark-dired-buffers ()
1575 "Mark all `dired' buffers."
1576 (interactive)
1577 (ibuffer-mark-on-buffer
1578 #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
1579
1580;;;###autoload
1581(defun ibuffer-do-occur (regexp &optional nlines)
1582 "View lines which match REGEXP in all marked buffers.
1583Optional argument NLINES says how many lines of context to display: it
1584defaults to one."
1585 (interactive (occur-read-primary-args))
1586 (if (or (not (integerp nlines))
1587 (< nlines 0))
1588 (setq nlines 0))
1589 (when (zerop (ibuffer-count-marked-lines))
1590 (ibuffer-set-mark ibuffer-marked-char))
1591 (let ((ibuffer-do-occur-bufs nil))
1592 ;; Accumulate a list of marked buffers
1593 (ibuffer-map-marked-lines
1594 #'(lambda (buf mark)
1595 (push buf ibuffer-do-occur-bufs)))
1596 (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1597
1598(provide 'ibuf-ext)
1599
1600;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d
1601;;; ibuf-ext.el ends here