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