lisp/ibuf-ext.el

   1 ;;; ibuf-ext.el --- extensions for ibuffer -*-byte-compile-dynamic: t;-*-
   2
   3 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   4
   5 ;; Author: Colin Walters <walters@verbum.org>
   6 ;; Created: 2 Dec 2001
   7 ;; Keywords: buffer, convenience
   8
   9 ;; This file is not currently part of GNU Emacs.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program ; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  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 'derived)
  38   (require 'ibuf-macs)
  39   (require 'cl))
  40
  41 ;;; Utility functions
  42 (defun ibuffer-delete-alist (key alist)
  43   "Delete all entries in ALIST that have a key equal to KEY."
  44   (let (entry)
  45     (while (setq entry (assoc key alist))
  46       (setq alist (delete entry alist)))
  47     alist))
  48
  49 (defcustom ibuffer-never-show-predicates nil
  50   "A list of predicates (a regexp or function) for buffers not to display.
  51 If a regexp, then it will be matched against the buffer's name.
  52 If a function, it will be called with the buffer as an argument, and
  53 should return non-nil if this buffer should not be shown."
  54   :type '(repeat (choice regexp function))
  55   :group 'ibuffer)
  56
  57 (defcustom ibuffer-always-show-predicates nil
  58   "A list of predicates (a regexp or function) for buffers to always display.
  59 If a regexp, then it will be matched against the buffer's name.
  60 If a function, it will be called with the buffer as an argument, and
  61 should return non-nil if this buffer should be shown.
  62 Note that buffers matching one of these predicates will be shown
  63 regardless of any active filters in this buffer."
  64   :type '(repeat (choice regexp function))
  65   :group 'ibuffer)
  66
  67 (defvar ibuffer-tmp-hide-regexps nil
  68   "A list of regexps which should match buffer names to not show.")
  69
  70 (defvar ibuffer-tmp-show-regexps nil
  71   "A list of regexps which should match buffer names to always show.")
  72
  73 (defvar ibuffer-auto-mode nil
  74   "If non-nil, Ibuffer auto-mode should be enabled for this buffer.
  75 Do not set this variable directly!  Use the function
  76 `ibuffer-auto-mode' instead.")
  77
  78 (defvar ibuffer-auto-buffers-changed nil)
  79
  80 (defcustom ibuffer-saved-filters '(("gnus"
  81                                     ((or (mode . message-mode)
  82                                          (mode . mail-mode)
  83                                          (mode . gnus-group-mode)
  84                                          (mode . gnus-summary-mode)
  85                                          (mode . gnus-article-mode))))
  86                                    ("programming"
  87                                     ((or (mode . emacs-lisp-mode)
  88                                          (mode . cperl-mode)
  89                                          (mode . c-mode)
  90                                          (mode . java-mode)
  91                                          (mode . idl-mode)
  92                                          (mode . lisp-mode)))))
  93
  94   "An alist of filter qualifiers to switch between.
  95
  96 This variable should look like ((\"STRING\" QUALIFIERS)
  97                                 (\"STRING\" QUALIFIERS) ...), where
  98 QUALIFIERS is a list of the same form as
  99 `ibuffer-filtering-qualifiers'.
 100 See also the variables `ibuffer-filtering-qualifiers',
 101 `ibuffer-filtering-alist', and the functions
 102 `ibuffer-switch-to-saved-filters', `ibuffer-save-filters'."
 103   :type '(repeat sexp)
 104   :group 'ibuffer)
 105
 106 (defvar ibuffer-filtering-qualifiers nil
 107   "A list like (SYMBOL . QUALIFIER) which filters the current buffer list.
 108 See also `ibuffer-filtering-alist'.")
 109
 110 ;; This is now frobbed by `define-ibuffer-filter'.
 111 (defvar ibuffer-filtering-alist nil
 112   "An alist of (SYMBOL DESCRIPTION FUNCTION) which describes a filter.
 113
 114 You most likely do not want to modify this variable directly; see
 115 `define-ibuffer-filter'.
 116
 117 SYMBOL is the symbolic name of the filter.  DESCRIPTION is used when
 118 displaying information to the user.  FUNCTION is given a buffer and
 119 the value of the qualifier, and returns non-nil if and only if the
 120 buffer should be displayed.")
 121
 122 (defcustom ibuffer-filter-format-alist nil
 123   "An alist which has special formats used when a filter is active.
 124 The contents of this variable should look like:
 125  ((FILTER (FORMAT FORMAT ...)) (FILTER (FORMAT FORMAT ...)) ...)
 126
 127 For example, suppose that when you add a filter for buffers whose
 128 major mode is `emacs-lisp-mode', you only want to see the mark and the
 129 name of the buffer.  You could accomplish that by adding:
 130  (mode ((mark \" \" name)))
 131 to this variable."
 132   :type '(repeat (list :tag "Association" (symbol :tag "Filter")
 133                        (list :tag "Formats" (repeat (sexp :tag "Format")))))
 134   :group 'ibuffer)
 135
 136 (defvar ibuffer-cached-filter-formats nil)
 137 (defvar ibuffer-compiled-filter-formats nil)
 138
 139 (defcustom ibuffer-old-time 72
 140   "The number of hours before a buffer is considered \"old\"."
 141   :type '(choice (const :tag "72 hours (3 days)" 72)
 142                  (const :tag "48 hours (2 days)" 48)
 143                  (const :tag "24 hours (1 day)" 24)
 144                  (integer :tag "hours"))
 145   :group 'ibuffer)
 146
 147 (defcustom ibuffer-save-with-custom t
 148   "If non-nil, then use Custom to save interactively changed variables.
 149 Currently, this only applies to `ibuffer-saved-filters'."
 150   :type 'boolean
 151   :group 'ibuffer)
 152
 153 (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
 154   (or
 155    (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps)
 156    (and (not
 157          (or
 158           (ibuffer-buf-matches-predicates buf ibuffer-tmp-hide-regexps)
 159           (ibuffer-buf-matches-predicates buf ibuffer-never-show-predicates)))
 160         (or all
 161             (not
 162              (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
 163         (or ibuffer-view-ibuffer
 164             (and ibuffer-buf
 165                  (not (eq ibuffer-buf buf))))
 166         (or
 167          (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
 168          (ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
 169
 170 (defun ibuffer-auto-update-changed ()
 171   (when ibuffer-auto-buffers-changed
 172     (setq ibuffer-auto-buffers-changed nil)
 173     (mapcar #'(lambda (buf)
 174                 (ignore-errors
 175                   (with-current-buffer buf
 176                     (when (and ibuffer-auto-mode
 177                                (eq major-mode 'ibuffer-mode))
 178                       (ibuffer-update nil t)))))
 179             (buffer-list))))
 180
 181 ;;;###autoload
 182 (defun ibuffer-auto-mode (&optional arg)
 183   "Toggle use of Ibuffer's auto-update facility.
 184 With numeric ARG, enable auto-update if and only if ARG is positive."
 185   (interactive)
 186   (unless (eq major-mode 'ibuffer-mode)
 187     (error "This buffer is not in Ibuffer mode"))
 188   (set (make-local-variable 'ibuffer-auto-mode)
 189        (if arg
 190            (plusp arg)
 191          (not ibuffer-auto-mode)))
 192   (defadvice get-buffer-create (after ibuffer-notify-create activate)
 193     (setq ibuffer-auto-buffers-changed t))
 194   (defadvice kill-buffer (after ibuffer-notify-kill activate)
 195     (setq ibuffer-auto-buffers-changed t))
 196   (add-hook 'post-command-hook 'ibuffer-auto-update-changed)
 197   (ibuffer-update-mode-name))
 198
 199 ;;;###autoload
 200 (defun ibuffer-mouse-filter-by-mode (event)
 201   "Enable or disable filtering by the major mode chosen via mouse."
 202   (interactive "e")
 203   (ibuffer-interactive-filter-by-mode event))
 204
 205 ;;;###autoload
 206 (defun ibuffer-interactive-filter-by-mode (event-or-point)
 207   "Enable or disable filtering by the major mode at point."
 208   (interactive "d")
 209   (if (eventp event-or-point)
 210       (mouse-set-point event-or-point)
 211     (goto-char event-or-point))
 212   (let ((buf (ibuffer-current-buffer)))
 213     (if (assq 'mode ibuffer-filtering-qualifiers)
 214         (setq ibuffer-filtering-qualifiers
 215               (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))
 216       (ibuffer-push-filter (cons 'mode
 217                                 (with-current-buffer buf
 218                                   major-mode)))))
 219   (ibuffer-update nil t))
 220
 221 (define-ibuffer-op shell-command-pipe (command)
 222   "Pipe the contents of each marked buffer to shell command COMMAND."
 223   (:interactive "sPipe to shell command: "
 224    :opstring "Shell command executed on"
 225    :modifier-p nil)
 226   (shell-command-on-region
 227    (point-min) (point-max) command
 228    (get-buffer-create "* ibuffer-shell-output*")))
 229
 230 (define-ibuffer-op shell-command-pipe-replace (command)
 231   "Replace the contents of marked buffers with output of pipe to COMMAND."
 232   (:interactive "sPipe to shell command (replace): "
 233    :opstring "Buffer contents replaced in"
 234    :active-opstring "replace buffer contents in"
 235    :dangerous t
 236    :modifier-p t)
 237   (with-current-buffer buf
 238     (shell-command-on-region (point-min) (point-max)
 239                              command nil t)))
 240
 241 (define-ibuffer-op shell-command-file (command)
 242   "Run shell command COMMAND separately on files of marked buffers."
 243   (:interactive "sShell command on buffer's file: "
 244    :opstring "Shell command executed on"
 245    :modifier-p nil)
 246   (shell-command (concat command " "
 247                          (shell-quote-argument
 248                           (if buffer-file-name
 249                               buffer-file-name
 250                             (make-temp-file
 251                              (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
 252
 253 (define-ibuffer-op eval (form)
 254   "Evaluate FORM in each of the buffers.
 255 Does not display the buffer during evaluation. See
 256 `ibuffer-do-view-and-eval' for that."
 257   (:interactive "xEval in buffers (form): "
 258    :opstring "evaluated in"
 259    :modifier-p :maybe)
 260   (eval form))
 261
 262 (define-ibuffer-op view-and-eval (form)
 263   "Evaluate FORM while displaying each of the marked buffers.
 264 To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
 265   (:interactive "xEval viewing buffers (form): "
 266    :opstring "evaluated in"
 267    :complex t
 268    :modifier-p :maybe)
 269   (let ((ibuffer-buf (current-buffer)))
 270     (unwind-protect
 271         (progn
 272           (switch-to-buffer buf)
 273           (eval form))
 274       (switch-to-buffer ibuffer-buf))))
 275
 276 (define-ibuffer-op rename-uniquely ()
 277   "Rename marked buffers as with `rename-uniquely'."
 278   (:opstring "renamed"
 279    :modifier-p t)
 280   (rename-uniquely))
 281
 282 (define-ibuffer-op revert ()
 283   "Revert marked buffers as with `revert-buffer'."
 284   (:dangerous t
 285    :opstring "reverted"
 286    :active-opstring "revert"
 287    :modifier-p :maybe)
 288   (revert-buffer t t))
 289
 290 (define-ibuffer-op replace-regexp (from-str to-str)
 291   "Perform a `replace-regexp' in marked buffers."
 292   (:interactive
 293    (let* ((from-str (read-from-minibuffer "Replace regexp: "))
 294           (to-str (read-from-minibuffer (concat "Replace " from-str
 295                                                 " with: "))))
 296      (list from-str to-str))
 297    :opstring "replaced in"
 298    :complex t
 299    :modifier-p :maybe)
 300   (save-window-excursion
 301     (switch-to-buffer buf)
 302     (save-excursion
 303       (goto-char (point-min))
 304       (let ((case-fold-search ibuffer-case-fold-search))
 305         (while (re-search-forward from-str nil t)
 306           (replace-match to-str))))
 307     t))
 308
 309 (define-ibuffer-op query-replace (&rest args)
 310   "Perform a `query-replace' in marked buffers."
 311   (:interactive
 312    (query-replace-read-args "Query replace" t t)
 313    :opstring "replaced in"
 314    :complex t
 315    :modifier-p :maybe)
 316   (save-window-excursion
 317     (switch-to-buffer buf)
 318     (save-excursion
 319       (let ((case-fold-search ibuffer-case-fold-search))
 320         (goto-char (point-min))
 321         (apply #'query-replace args)))
 322     t))
 323
 324 (define-ibuffer-op query-replace-regexp (&rest args)
 325   "Perform a `query-replace-regexp' in marked buffers."
 326   (:interactive
 327    (query-replace-read-args "Query replace regexp" t t)
 328    :opstring "replaced in"
 329    :complex t
 330    :modifier-p :maybe)
 331   (save-window-excursion
 332     (switch-to-buffer buf)
 333     (save-excursion
 334       (let ((case-fold-search ibuffer-case-fold-search))
 335         (goto-char (point-min))
 336         (apply #'query-replace-regexp args)))
 337     t))
 338
 339 (define-ibuffer-op print ()
 340   "Print marked buffers as with `print-buffer'."
 341   (:opstring "printed"
 342    :modifier-p nil)
 343   (print-buffer))
 344
 345 ;;;###autoload
 346 (defun ibuffer-included-in-filters-p (buf filters)
 347   (not
 348    (memq nil ;; a filter will return nil if it failed
 349          (mapcar
 350           ;; filter should be like (TYPE . QUALIFIER), or
 351           ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...)
 352           #'(lambda (qual)
 353               (ibuffer-included-in-filter-p buf qual))
 354           filters))))
 355
 356 (defun ibuffer-included-in-filter-p (buf filter)
 357   (if (eq (car filter) 'not)
 358       (not (ibuffer-included-in-filter-p-1 buf (cdr filter)))
 359     (ibuffer-included-in-filter-p-1 buf filter)))
 360
 361 (defun ibuffer-included-in-filter-p-1 (buf filter)
 362   (not
 363    (not
 364     (case (car filter)
 365       (or
 366        (memq t (mapcar #'(lambda (x)
 367                            (ibuffer-included-in-filter-p buf x))
 368                        (cdr filter))))
 369       (saved
 370        (let ((data
 371               (assoc (cdr filter)
 372                      ibuffer-saved-filters)))
 373          (unless data
 374            (ibuffer-filter-disable)
 375            (error "Unknown saved filter %s" (cdr filter)))
 376          (ibuffer-included-in-filters-p buf (cadr data))))
 377       (t
 378        (let ((filterdat (assq (car filter)
 379                               ibuffer-filtering-alist)))
 380          ;; filterdat should be like (TYPE DESCRIPTION FUNC)
 381          ;; just a sanity check
 382         (unless filterdat
 383           (ibuffer-filter-disable)
 384           (error "Undefined filter %s" (car filter)))
 385         (not
 386          (not
 387           (funcall (caddr filterdat)
 388                    buf
 389                    (cdr filter))))))))))
 390
 391 ;;;###autoload
 392 (defun ibuffer-filter-disable ()
 393   "Disable all filters currently in effect in this buffer."
 394   (interactive)
 395   (setq ibuffer-filtering-qualifiers nil)
 396   (ibuffer-update nil t))
 397
 398 ;;;###autoload
 399 (defun ibuffer-pop-filter ()
 400   "Remove the top filter in this buffer."
 401   (interactive)
 402   (when (null ibuffer-filtering-qualifiers)
 403     (error "No filters in effect"))
 404   (pop ibuffer-filtering-qualifiers)
 405   (ibuffer-update nil t))
 406
 407 (defun ibuffer-push-filter (qualifier)
 408   "Add QUALIFIER to `ibuffer-filtering-qualifiers'."
 409   (push qualifier ibuffer-filtering-qualifiers))
 410
 411 ;;;###autoload
 412 (defun ibuffer-decompose-filter ()
 413   "Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
 414
 415 This means that the topmost filter on the filtering stack, which must
 416 be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
 417 turned into two separate filters [name: foo] and [mode: bar-mode]."
 418   (interactive)
 419   (when (null ibuffer-filtering-qualifiers)
 420     (error "No filters in effect"))
 421   (let ((lim (pop ibuffer-filtering-qualifiers)))
 422     (case (car lim)
 423       (or
 424        (setq ibuffer-filtering-qualifiers (append
 425                                           (cdr lim)
 426                                           ibuffer-filtering-qualifiers)))
 427       (saved
 428        (let ((data
 429               (assoc (cdr lim)
 430                      ibuffer-saved-filters)))
 431          (unless data
 432            (ibuffer-filter-disable)
 433            (error "Unknown saved filter %s" (cdr lim)))
 434          (setq ibuffer-filtering-qualifiers (append
 435                                             (cadr data)
 436                                             ibuffer-filtering-qualifiers))))
 437       (not
 438        (push (cdr lim)
 439              ibuffer-filtering-qualifiers))
 440       (t
 441        (error "Filter type %s is not compound" (car lim)))))
 442   (ibuffer-update nil t))
 443
 444 ;;;###autoload
 445 (defun ibuffer-exchange-filters ()
 446   "Exchange the top two filters on the stack in this buffer."
 447   (interactive)
 448   (when (< (length ibuffer-filtering-qualifiers)
 449            2)
 450     (error "Need two filters to exchange"))
 451   (let ((first (pop ibuffer-filtering-qualifiers))
 452         (second (pop ibuffer-filtering-qualifiers)))
 453     (push first ibuffer-filtering-qualifiers)
 454     (push second ibuffer-filtering-qualifiers))
 455   (ibuffer-update nil t))
 456
 457 ;;;###autoload
 458 (defun ibuffer-negate-filter ()
 459   "Negate the sense of the top filter in the current buffer."
 460   (interactive)
 461   (when (null ibuffer-filtering-qualifiers)
 462     (error "No filters in effect"))
 463   (let ((lim (pop ibuffer-filtering-qualifiers)))
 464     (push (if (eq (car lim) 'not)
 465               (cdr lim)
 466             (cons 'not lim))
 467           ibuffer-filtering-qualifiers))
 468   (ibuffer-update nil t))
 469
 470 ;;;###autoload
 471 (defun ibuffer-or-filter (&optional reverse)
 472   "Replace the top two filters in this buffer with their logical OR.
 473 If optional argument REVERSE is non-nil, instead break the top OR
 474 filter into parts."
 475   (interactive "P")
 476   (if reverse
 477       (progn
 478         (when (or (null ibuffer-filtering-qualifiers)
 479                   (not (eq 'or (caar ibuffer-filtering-qualifiers))))
 480           (error "Top filter is not an OR"))
 481         (let ((lim (pop ibuffer-filtering-qualifiers)))
 482           (setq ibuffer-filtering-qualifiers (nconc (cdr lim) ibuffer-filtering-qualifiers))))
 483     (when (< (length ibuffer-filtering-qualifiers) 2)
 484       (error "Need two filters to OR"))
 485     ;; If the second filter is an OR, just add to it.
 486     (let ((first (pop ibuffer-filtering-qualifiers))
 487           (second (pop ibuffer-filtering-qualifiers)))
 488       (if (eq 'or (car second))
 489           (push (nconc (list 'or first) (cdr second)) ibuffer-filtering-qualifiers)
 490         (push (list 'or first second)
 491               ibuffer-filtering-qualifiers))))
 492   (ibuffer-update nil t))
 493
 494 (defun ibuffer-maybe-save-saved-filters ()
 495   (when ibuffer-save-with-custom
 496     (if (fboundp 'customize-save-variable)
 497         (progn
 498           (customize-save-variable 'ibuffer-saved-filters
 499                                    ibuffer-saved-filters))
 500       (message "Not saved permanently: Customize not available"))))
 501
 502 ;;;###autoload
 503 (defun ibuffer-save-filters (name filters)
 504   "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
 505 Interactively, prompt for NAME, and use the current filters."
 506   (interactive
 507    (if (null ibuffer-filtering-qualifiers)
 508        (error "No filters currently in effect")
 509      (list
 510       (read-from-minibuffer "Save current filters as: ")
 511       ibuffer-filtering-qualifiers)))
 512   (ibuffer-aif (assoc name ibuffer-saved-filters)
 513       (setcdr it filters)
 514       (push (list name filters) ibuffer-saved-filters))
 515   (ibuffer-maybe-save-saved-filters)
 516   (ibuffer-update-mode-name))
 517
 518 ;;;###autoload
 519 (defun ibuffer-delete-saved-filters (name)
 520   "Delete saved filters with NAME from `ibuffer-saved-filters'."
 521   (interactive
 522    (list
 523     (if (null ibuffer-saved-filters)
 524         (error "No saved filters")
 525       (completing-read "Delete saved filters: "
 526                        ibuffer-saved-filters nil t))))
 527   (setq ibuffer-saved-filters
 528         (ibuffer-delete-alist name ibuffer-saved-filters))
 529   (ibuffer-maybe-save-saved-filters)
 530   (ibuffer-update nil t))
 531
 532 ;;;###autoload
 533 (defun ibuffer-add-saved-filters (name)
 534   "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."
 535   (interactive
 536    (list
 537     (if (null ibuffer-saved-filters)
 538         (error "No saved filters")
 539       (completing-read "Add saved filters: "
 540                        ibuffer-saved-filters nil t))))
 541   (push (cons 'saved name) ibuffer-filtering-qualifiers)
 542   (ibuffer-update nil t))
 543
 544 ;;;###autoload
 545 (defun ibuffer-switch-to-saved-filters (name)
 546   "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
 547 If prefix argument ADD is non-nil, then add the saved filters instead
 548 of replacing the current filters."
 549   (interactive
 550    (list
 551     (if (null ibuffer-saved-filters)
 552         (error "No saved filters")
 553       (completing-read "Switch to saved filters: "
 554                        ibuffer-saved-filters nil t))))
 555   (setq ibuffer-filtering-qualifiers (list (cons 'saved name)))
 556   (ibuffer-update nil t))
 557
 558 (defun ibuffer-format-qualifier (qualifier)
 559   (if (eq (car-safe qualifier) 'not)
 560       (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")
 561     (ibuffer-format-qualifier-1 qualifier)))
 562
 563 (defun ibuffer-format-qualifier-1 (qualifier)
 564   (case (car qualifier)
 565     (saved
 566      (concat " [filter: " (cdr qualifier) "]"))
 567     (or
 568      (concat " [OR" (mapconcat #'ibuffer-format-qualifier
 569                                (cdr qualifier) "") "]"))
 570     (t
 571      (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
 572        (unless qualifier
 573          (error "Ibuffer: bad qualifier %s" qualifier))
 574        (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
 575
 576 ;;; Extra operation definitions
 577
 578 (define-ibuffer-filter mode
 579   "Toggle current view to buffers with major mode QUALIFIER."
 580   (:description "major mode"
 581    :reader
 582    (intern
 583     (completing-read "Filter by major mode: " obarray
 584                      #'(lambda (e)
 585                          (string-match "-mode$"
 586                                        (symbol-name e)))
 587                      t
 588                      (let ((buf (ibuffer-current-buffer)))
 589                        (if (and buf (buffer-live-p buf))
 590                            (with-current-buffer buf
 591                              (symbol-name major-mode))
 592                          "")))))
 593   (eq qualifier (with-current-buffer buf major-mode)))
 594
 595 (define-ibuffer-filter name
 596   "Toggle current view to buffers with name matching QUALIFIER."
 597   (:description "buffer name"
 598    :reader
 599    (read-from-minibuffer "Filter by name (regexp): "))
 600   (string-match qualifier (buffer-name buf)))
 601
 602 (define-ibuffer-filter filename
 603   "Toggle current view to buffers with filename matching QUALIFIER."
 604   (:description "filename"
 605    :reader
 606    (read-from-minibuffer "Filter by filename (regexp): "))
 607   (ibuffer-awhen (buffer-file-name buf)
 608     (string-match qualifier it)))
 609
 610 (define-ibuffer-filter size-gt
 611   "Toggle current view to buffers with size greater than QUALIFIER."
 612   (:description "size greater than"
 613    :reader
 614    (string-to-number (read-from-minibuffer "Filter by size greater than: ")))
 615   (> (with-current-buffer buf (buffer-size))
 616      qualifier))
 617
 618 (define-ibuffer-filter size-lt
 619    "Toggle current view to buffers with size less than QUALIFIER."
 620   (:description "size less than"
 621    :reader
 622    (string-to-number (read-from-minibuffer "Filter by size less than: ")))
 623   (< (with-current-buffer buf (buffer-size))
 624      qualifier))
 625
 626 (define-ibuffer-filter content
 627    "Toggle current view to buffers whose contents match QUALIFIER."
 628   (:description "content"
 629    :reader
 630    (read-from-minibuffer "Filter by content (regexp): "))
 631   (with-current-buffer buf
 632     (save-excursion
 633       (goto-char (point-min))
 634       (re-search-forward qualifier nil t))))
 635
 636 (define-ibuffer-filter predicate
 637    "Toggle current view to buffers for which QUALIFIER returns non-nil."
 638   (:description "predicate"
 639    :reader
 640    (read-minibuffer "Filter by predicate (form): "))
 641   (with-current-buffer buf
 642     (eval qualifier)))
 643
 644 ;;; Sorting
 645
 646 ;;;###autoload
 647 (defun ibuffer-toggle-sorting-mode ()
 648   "Toggle the current sorting mode.
 649 Default sorting modes are:
 650  Recency - the last time the buffer was viewed
 651  Name - the name of the buffer
 652  Major Mode - the name of the major mode of the buffer
 653  Size - the size of the buffer"
 654   (interactive)
 655   (let ((modes (mapcar 'car ibuffer-sorting-functions-alist)))
 656     (add-to-list 'modes 'recency)
 657     (setq modes (sort modes 'string-lessp))
 658     (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
 659                     (car modes))))
 660       (setq ibuffer-sorting-mode next)
 661       (message "Sorting by %s" next)))
 662   (ibuffer-redisplay t))
 663
 664 ;;;###autoload
 665 (defun ibuffer-invert-sorting ()
 666   "Toggle whether or not sorting is in reverse order."
 667   (interactive)
 668   (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))
 669   (message "Sorting order %s"
 670            (if ibuffer-sorting-reversep
 671                "reversed"
 672              "normal"))
 673   (ibuffer-redisplay t))
 674
 675 (define-ibuffer-sorter major-mode
 676   "Sort the buffers by major modes.
 677 Ordering is lexicographic."
 678   (:description "major mode")
 679   (string-lessp (downcase
 680                  (symbol-name (with-current-buffer
 681                                   (car a)
 682                                 major-mode)))
 683                 (downcase
 684                  (symbol-name (with-current-buffer
 685                                   (car b)
 686                                 major-mode)))))
 687
 688 (define-ibuffer-sorter mode-name
 689   "Sort the buffers by their mode name.
 690 Ordering is lexicographic."
 691   (:description "major mode name")
 692   (string-lessp (downcase
 693                   (with-current-buffer
 694                       (car a)
 695                     mode-name))
 696                 (downcase
 697                  (with-current-buffer
 698                      (car b)
 699                    mode-name))))
 700
 701 (define-ibuffer-sorter alphabetic
 702   "Sort the buffers by their names.
 703 Ordering is lexicographic."
 704   (:description "buffer name")
 705   (string-lessp
 706    (buffer-name (car a))
 707    (buffer-name (car b))))
 708
 709 (define-ibuffer-sorter size
 710  "Sort the buffers by their size."
 711   (:description "size")
 712   (< (with-current-buffer (car a)
 713        (buffer-size))
 714      (with-current-buffer (car b)
 715        (buffer-size))))
 716
 717 ;;; Functions to emulate bs.el
 718
 719 ;;;###autoload
 720 (defun ibuffer-bs-show ()
 721   "Emulate `bs-show' from the bs.el package."
 722   (interactive)
 723   (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
 724   (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
 725
 726 (defun ibuffer-bs-toggle-all ()
 727   "Emulate `bs-toggle-show-all' from the bs.el package."
 728   (interactive)
 729   (if ibuffer-filtering-qualifiers
 730       (ibuffer-pop-filter)
 731     (progn (ibuffer-push-filter '(filename . ".*"))
 732            (ibuffer-update nil t))))
 733
 734 ;;; Handy functions
 735
 736 ;;;###autoload
 737 (defun ibuffer-add-to-tmp-hide (regexp)
 738   "Add REGEXP to `ibuffer-tmp-hide-regexps'.
 739 This means that buffers whose name matches REGEXP will not be shown
 740 for this ibuffer session."
 741   (interactive
 742    (list
 743     (read-from-minibuffer "Never show buffers matching: "
 744                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
 745   (push regexp ibuffer-tmp-hide-regexps))
 746
 747 ;;;###autoload
 748 (defun ibuffer-add-to-tmp-show (regexp)
 749   "Add REGEXP to `ibuffer-tmp-show-regexps'.
 750 This means that buffers whose name matches REGEXP will always be shown
 751 for this ibuffer session."
 752   (interactive
 753    (list
 754     (read-from-minibuffer "Always show buffers matching: "
 755                           (regexp-quote (buffer-name (ibuffer-current-buffer t))))))
 756   (push regexp ibuffer-tmp-show-regexps))
 757
 758 ;;;###autoload
 759 (defun ibuffer-forward-next-marked (&optional count mark direction)
 760   "Move forward by COUNT marked buffers (default 1).
 761
 762 If MARK is non-nil, it should be a character denoting the type of mark
 763 to move by.  The default is `ibuffer-marked-char'.
 764
 765 If DIRECTION is non-nil, it should be an integer; negative integers
 766 mean move backwards, non-negative integers mean move forwards."
 767   (interactive "P")
 768   (unless count
 769     (setq count 1))
 770   (unless mark
 771     (setq mark ibuffer-marked-char))
 772   (unless direction
 773     (setq direction 1))
 774   ;; Skip the title
 775   (ibuffer-forward-line 0)
 776   (let ((opos (point))
 777         curmark)
 778     (ibuffer-forward-line direction)
 779     (while (not (or (= (point) opos)
 780                     (eq (setq curmark (ibuffer-current-mark))
 781                         mark)))
 782       (ibuffer-forward-line direction))
 783     (when (and (= (point) opos)
 784                (not (eq (ibuffer-current-mark) mark)))
 785       (error "No buffers with mark %c" mark))))
 786
 787 ;;;###autoload
 788 (defun ibuffer-backwards-next-marked (&optional count mark)
 789    "Move backwards by COUNT marked buffers (default 1).
 790
 791 If MARK is non-nil, it should be a character denoting the type of mark
 792 to move by.  The default is `ibuffer-marked-char'."
 793    (interactive "P")
 794    (ibuffer-forward-next-marked count mark -1))
 795
 796 ;;;###autoload
 797 (defun ibuffer-do-kill-lines ()
 798   "Hide all of the currently marked lines."
 799   (interactive)
 800   (if (= (ibuffer-count-marked-lines) 0)
 801       (message "No buffers marked; use 'm' to mark a buffer")
 802     (let ((count
 803            (ibuffer-map-marked-lines
 804             #'(lambda (buf mark)
 805                 'kill))))
 806       (message "Killed %s lines" count))))
 807
 808 ;;;###autoload
 809 (defun ibuffer-jump-to-buffer (name)
 810   "Move point to the buffer whose name is NAME."
 811   (interactive (list nil))
 812   (let ((table (mapcar #'(lambda (x)
 813                            (cons (buffer-name (car x))
 814                                  (caddr x)))
 815                        (ibuffer-current-state-list t))))
 816     (when (null table)
 817       (error "No buffers!"))
 818     (when (interactive-p)
 819       (setq name (completing-read "Jump to buffer: " table nil t)))
 820     (ibuffer-aif (assoc name table)
 821         (goto-char (cdr it))
 822       (error "No buffer with name %s" name))))
 823
 824 ;;;###autoload
 825 (defun ibuffer-diff-with-file ()
 826   "View the differences between this buffer and its associated file.
 827 This requires the external program \"diff\" to be in your `exec-path'."
 828   (interactive)
 829   (let* ((buf (ibuffer-current-buffer))
 830          (buf-filename (with-current-buffer buf
 831                          buffer-file-name)))
 832     (unless (buffer-live-p buf)
 833       (error "Buffer %s has been killed" buf))
 834     (unless buf-filename
 835       (error "Buffer %s has no associated file" buf))
 836     (let ((diff-buf (get-buffer-create "*Ibuffer-diff*")))
 837       (with-current-buffer diff-buf
 838         (setq buffer-read-only nil)
 839         (erase-buffer))
 840       (let ((tempfile (make-temp-file "ibuffer-diff-")))
 841         (unwind-protect
 842             (progn
 843               (with-current-buffer buf
 844                 (write-region (point-min) (point-max) tempfile nil 'nomessage))
 845               (if (zerop
 846                    (apply #'call-process "diff" nil diff-buf nil
 847                           (append
 848                            (when (and (boundp 'ediff-custom-diff-options)
 849                                       (stringp ediff-custom-diff-options))
 850                              (list ediff-custom-diff-options))
 851                            (list buf-filename tempfile))))
 852                   (message "No differences found")
 853                 (progn
 854                   (with-current-buffer diff-buf
 855                     (goto-char (point-min))
 856                     (if (fboundp 'diff-mode)
 857                         (diff-mode)
 858                       (fundamental-mode)))
 859                   (display-buffer diff-buf))))
 860           (when (file-exists-p tempfile)
 861             (delete-file tempfile)))))
 862       nil))
 863
 864 ;;;###autoload
 865 (defun ibuffer-copy-filename-as-kill (&optional arg)
 866   "Copy filenames of marked buffers into the kill ring.
 867 The names are separated by a space.
 868 If a buffer has no filename, it is ignored.
 869 With a zero prefix arg, use the complete pathname of each marked file.
 870
 871 You can then feed the file name(s) to other commands with C-y.
 872
 873  [ This docstring shamelessly stolen from the
 874  `dired-copy-filename-as-kill' in \"dired-x\". ]"
 875   ;; Add to docstring later:
 876   ;; With C-u, use the relative pathname of each marked file.
 877   (interactive "P")
 878   (if (= (ibuffer-count-marked-lines) 0)
 879       (message "No buffers marked; use 'm' to mark a buffer")
 880     (let ((ibuffer-copy-filename-as-kill-result "")
 881           (type (cond ((eql arg 0)
 882                        'full)
 883                       ;; ((eql arg 4)
 884                       ;;  'relative)
 885                       (t
 886                        'name))))
 887       (ibuffer-map-marked-lines
 888        #'(lambda (buf mark)
 889            (setq ibuffer-copy-filename-as-kill-result
 890                  (concat ibuffer-copy-filename-as-kill-result
 891                          (let ((name (buffer-file-name buf)))
 892                            (if name
 893                                (case type
 894                                  (full
 895                                   name)
 896                                  (t
 897                                   (file-name-nondirectory name)))
 898                              ""))
 899                          " "))))
 900       (push ibuffer-copy-filename-as-kill-result kill-ring))))
 901
 902 (defun ibuffer-mark-on-buffer (func)
 903   (let ((count
 904          (ibuffer-map-lines
 905           #'(lambda (buf mark)
 906               (when (funcall func buf)
 907                 (ibuffer-set-mark-1 ibuffer-marked-char)
 908                 t)))))
 909     (ibuffer-redisplay t)
 910     (message "Marked %s buffers" count)))
 911
 912 ;;;###autoload
 913 (defun ibuffer-mark-by-name-regexp (regexp)
 914   "Mark all buffers whose name matches REGEXP."
 915   (interactive "sMark by name (regexp): ")
 916   (ibuffer-mark-on-buffer
 917    #'(lambda (buf)
 918        (string-match regexp (buffer-name buf)))))
 919
 920 ;;;###autoload
 921 (defun ibuffer-mark-by-mode-regexp (regexp)
 922   "Mark all buffers whose major mode matches REGEXP."
 923   (interactive "sMark by major mode (regexp): ")
 924   (ibuffer-mark-on-buffer
 925    #'(lambda (buf)
 926        (with-current-buffer buf
 927          (string-match regexp mode-name)))))
 928
 929 ;;;###autoload
 930 (defun ibuffer-mark-by-file-name-regexp (regexp)
 931   "Mark all buffers whose file name matches REGEXP."
 932   (interactive "sMark by file name (regexp): ")
 933   (ibuffer-mark-on-buffer
 934    #'(lambda (buf)
 935        (let ((name (or (buffer-file-name buf)
 936                        (with-current-buffer buf
 937                          (and
 938                           (boundp 'dired-directory)
 939                           (stringp dired-directory)
 940                           dired-directory)))))
 941          (when name
 942            (string-match regexp name))))))
 943
 944 ;;;###autoload
 945 (defun ibuffer-mark-by-mode (mode)
 946   "Mark all buffers whose major mode equals MODE."
 947   (interactive
 948    (list (intern (completing-read "Mark by major mode: " obarray
 949                                   #'(lambda (e)
 950                                       ;; kind of a hack...
 951                                       (and (fboundp e)
 952                                            (string-match "-mode$"
 953                                                          (symbol-name e))))
 954                                   t
 955                                   (let ((buf (ibuffer-current-buffer)))
 956                                     (if (and buf (buffer-live-p buf))
 957                                         (with-current-buffer buf
 958                                           (cons (symbol-name major-mode)
 959                                                 0))
 960                                       ""))))))
 961   (ibuffer-mark-on-buffer
 962    #'(lambda (buf)
 963        (with-current-buffer buf
 964          (eq major-mode mode)))))
 965
 966 ;;;###autoload
 967 (defun ibuffer-mark-modified-buffers ()
 968   "Mark all modified buffers."
 969   (interactive)
 970   (ibuffer-mark-on-buffer
 971    #'(lambda (buf) (buffer-modified-p buf))))
 972
 973 ;;;###autoload
 974 (defun ibuffer-mark-unsaved-buffers ()
 975   "Mark all modified buffers that have an associated file."
 976   (interactive)
 977   (ibuffer-mark-on-buffer
 978    #'(lambda (buf) (and (with-current-buffer buf buffer-file-name)
 979                         (buffer-modified-p buf)))))
 980
 981 ;;;###autoload
 982 (defun ibuffer-mark-dissociated-buffers ()
 983   "Mark all buffers whose associated file does not exist."
 984   (interactive)
 985   (ibuffer-mark-on-buffer
 986    #'(lambda (buf)
 987        (with-current-buffer buf
 988          (or
 989           (and buffer-file-name
 990                (not (file-exists-p buffer-file-name)))
 991           (and (eq major-mode 'dired-mode)
 992                (boundp 'dired-directory)
 993                (stringp dired-directory)
 994                (not (file-exists-p (file-name-directory dired-directory)))))))))
 995
 996 ;;;###autoload
 997 (defun ibuffer-mark-help-buffers ()
 998   "Mark buffers like *Help*, *Apropos*, *Info*."
 999   (interactive)
1000   (ibuffer-mark-on-buffer
1001    #'(lambda (buf)
1002        (with-current-buffer buf
1003          (memq major-mode ibuffer-help-buffer-modes)))))
1004
1005 ;;;###autoload
1006 (defun ibuffer-mark-old-buffers ()
1007   "Mark buffers which have not been viewed in `ibuffer-old-time' days."
1008   (interactive)
1009   (ibuffer-mark-on-buffer
1010    #'(lambda (buf)
1011        (with-current-buffer buf
1012          ;; hacked from midnight.el
1013          (when buffer-display-time
1014            (let* ((tm (current-time))
1015                   (now (+ (* (float (ash 1 16)) (car tm))
1016                           (float (cadr tm)) (* 0.0000001 (caddr tm))))
1017                   (then (+ (* (float (ash 1 16))
1018                               (car buffer-display-time))
1019                            (float (cadr buffer-display-time))
1020                            (* 0.0000001 (caddr buffer-display-time)))))
1021              (> (- now then) (* 60 60 ibuffer-old-time))))))))
1022
1023 ;;;###autoload
1024 (defun ibuffer-mark-special-buffers ()
1025   "Mark all buffers whose name begins and ends with '*'."
1026   (interactive)
1027   (ibuffer-mark-on-buffer
1028    #'(lambda (buf) (string-match "^\\*.+\\*$"
1029                                  (buffer-name buf)))))
1030
1031 ;;;###autoload
1032 (defun ibuffer-mark-read-only-buffers ()
1033   "Mark all read-only buffers."
1034   (interactive)
1035   (ibuffer-mark-on-buffer
1036    #'(lambda (buf)
1037        (with-current-buffer buf
1038          buffer-read-only))))
1039
1040 ;;;###autoload
1041 (defun ibuffer-mark-dired-buffers ()
1042   "Mark all `dired' buffers."
1043   (interactive)
1044   (ibuffer-mark-on-buffer
1045    #'(lambda (buf)
1046        (with-current-buffer buf
1047          (eq major-mode 'dired-mode)))))
1048
1049 ;;;###autoload
1050 (defun ibuffer-do-occur (regexp &optional nlines)
1051   "View lines which match REGEXP in all marked buffers.
1052 Optional argument NLINES says how many lines of context to display: it
1053 defaults to one."
1054   (interactive
1055    (list (let* ((default (car regexp-history))
1056                 (input
1057                  (read-from-minibuffer
1058                   (if default
1059                       (format "List lines matching regexp (default `%s'): "
1060                               default)
1061                     "List lines matching regexp: ")
1062                   nil
1063                   nil
1064                   nil
1065                   'regexp-history)))
1066            (if (equal input "")
1067                default
1068              input))
1069          current-prefix-arg))
1070   (if (or (not (integerp nlines))
1071           (< nlines 0))
1072       (setq nlines 1))
1073   (when (zerop (ibuffer-count-marked-lines))
1074     (ibuffer-set-mark ibuffer-marked-char))
1075   (let ((ibuffer-do-occur-bufs nil))
1076     ;; Accumulate a list of marked buffers
1077     (ibuffer-map-marked-lines
1078      #'(lambda (buf mark)
1079          (push buf ibuffer-do-occur-bufs)))
1080     (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1081
1082 (provide 'ibuf-ext)
1083
1084 ;;; ibuf-ext.el ends here