lisp/ibuf-macs.el

   1 ;;; ibuf-macs.el --- macros for ibuffer
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Colin Walters <walters@verbum.org>
   7 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
   8 ;; Created: 6 Dec 2001
   9 ;; Keywords: buffer, convenience
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile
  31   (require 'cl))
  32
  33 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
  34 (defmacro ibuffer-aif (test true-body &rest false-body)
  35   "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
  36 If TEST returns non-nil, bind `it' to the value, and evaluate
  37 TRUE-BODY.  Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
  38 Compare with `if'."
  39   (declare (indent 2))
  40   (let ((sym (make-symbol "ibuffer-aif-sym")))
  41     `(let ((,sym ,test))
  42        (if ,sym
  43            (let ((it ,sym))
  44              ,true-body)
  45          (progn
  46            ,@false-body)))))
  47
  48 (defmacro ibuffer-awhen (test &rest body)
  49   "Evaluate BODY if TEST returns non-nil.
  50 During evaluation of body, bind `it' to the value returned by TEST."
  51   (declare (indent 1))
  52   `(ibuffer-aif ,test
  53        (progn ,@body)
  54      nil))
  55
  56 (defmacro ibuffer-save-marks (&rest body)
  57   "Save the marked status of the buffers and execute BODY; restore marks."
  58   (declare (indent 0))
  59   (let ((bufsym (make-symbol "bufsym")))
  60     `(let ((,bufsym (current-buffer))
  61            (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
  62        (unwind-protect
  63            (progn
  64              (save-excursion
  65                ,@body))
  66          (with-current-buffer ,bufsym
  67            (ibuffer-redisplay-engine
  68             ;; Get rid of dead buffers
  69             (delq nil
  70                   (mapcar #'(lambda (e) (when (buffer-live-p (car e))
  71                                           e))
  72                           ibuffer-save-marks-tmp-mark-list)))
  73            (ibuffer-redisplay t))))))
  74
  75 ;;;###autoload
  76 (defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
  77                                                header-mouse-map) &rest body)
  78   "Define a column SYMBOL for use with `ibuffer-formats'.
  79
  80 BODY will be called with `buffer' bound to the buffer object, and
  81 `mark' bound to the current mark on the buffer.  The original ibuffer
  82 buffer will be bound to `ibuffer-buf'.
  83
  84 If NAME is given, it will be used as a title for the column.
  85 Otherwise, the title will default to a capitalized version of the
  86 SYMBOL's name.  PROPS is a plist of additional properties to add to
  87 the text, such as `mouse-face'.  And SUMMARIZER, if given, is a
  88 function which will be passed a list of all the strings in its column;
  89 it should return a string to display at the bottom.
  90
  91 If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
  92 title of the column.
  93
  94 Note that this macro expands into a `defun' for a function named
  95 ibuffer-make-column-NAME.  If INLINE is non-nil, then the form will be
  96 inlined into the compiled format versions.  This means that if you
  97 change its definition, you should explicitly call
  98 `ibuffer-recompile-formats'.
  99
 100 \(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
 101   (declare (indent defun))
 102   (let* ((sym (intern (concat "ibuffer-make-column-"
 103                               (symbol-name symbol))))
 104          (bod-1 `(with-current-buffer buffer
 105                    ,@body))
 106          (bod (if props
 107                   `(propertize
 108                     ,bod-1
 109                     ,@props)
 110                 bod-1)))
 111     `(progn
 112        ,(if inline
 113             `(push '(,sym ,bod) ibuffer-inline-columns)
 114           `(defun ,sym (buffer mark)
 115              ,bod))
 116        (put (quote ,sym) 'ibuffer-column-name
 117             ,(if (stringp name)
 118                  name
 119                (capitalize (symbol-name symbol))))
 120        ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
 121        ,(if summarizer
 122             ;; Store the name of the summarizing function.
 123             `(put (quote ,sym) 'ibuffer-column-summarizer
 124                   (quote ,summarizer)))
 125        ,(if summarizer
 126             ;; This will store the actual values of the column
 127             ;; summary.
 128             `(put (quote ,sym) 'ibuffer-column-summary nil))
 129        :autoload-end)))
 130
 131 ;;;###autoload
 132 (defmacro* define-ibuffer-sorter (name documentation
 133                                        (&key
 134                                         description)
 135                                        &rest body)
 136   "Define a method of sorting named NAME.
 137 DOCUMENTATION is the documentation of the function, which will be called
 138 `ibuffer-do-sort-by-NAME'.
 139 DESCRIPTION is a short string describing the sorting method.
 140
 141 For sorting, the forms in BODY will be evaluated with `a' bound to one
 142 buffer object, and `b' bound to another.  BODY should return a non-nil
 143 value if and only if `a' is \"less than\" `b'.
 144
 145 \(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
 146   (declare (indent 1))
 147   `(progn
 148      (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
 149        ,(or documentation "No :documentation specified for this sorting method.")
 150        (interactive)
 151        (setq ibuffer-sorting-mode ',name)
 152        (when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
 153          (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
 154        (ibuffer-redisplay t)
 155        (setq ibuffer-last-sorting-mode ',name))
 156      (push (list ',name ,description
 157                  #'(lambda (a b)
 158                      ,@body))
 159            ibuffer-sorting-functions-alist)
 160      :autoload-end))
 161
 162 ;;;###autoload
 163 (defmacro* define-ibuffer-op (op args
 164                                  documentation
 165                                  (&key
 166                                   interactive
 167                                   mark
 168                                   modifier-p
 169                                   dangerous
 170                                   (opstring "operated on")
 171                                   (active-opstring "Operate on")
 172                                   complex)
 173                                  &rest body)
 174   "Generate a function which operates on a buffer.
 175 OP becomes the name of the function; if it doesn't begin with
 176 `ibuffer-do-', then that is prepended to it.
 177 When an operation is performed, this function will be called once for
 178 each marked buffer, with that buffer current.
 179
 180 ARGS becomes the formal parameters of the function.
 181 DOCUMENTATION becomes the docstring of the function.
 182 INTERACTIVE becomes the interactive specification of the function.
 183 MARK describes which type of mark (:deletion, or nil) this operation
 184 uses.  :deletion means the function operates on buffers marked for
 185 deletion, otherwise it acts on normally marked buffers.
 186 MODIFIER-P describes how the function modifies buffers.  This is used
 187 to set the modification flag of the Ibuffer buffer itself.  Valid
 188 values are:
 189  nil - the function never modifiers buffers
 190  t - the function it always modifies buffers
 191  :maybe - attempt to discover this information by comparing the
 192   buffer's modification flag.
 193 DANGEROUS is a boolean which should be set if the user should be
 194 prompted before performing this operation.
 195 OPSTRING is a string which will be displayed to the user after the
 196 operation is complete, in the form:
 197  \"Operation complete; OPSTRING x buffers\"
 198 ACTIVE-OPSTRING is a string which will be displayed to the user in a
 199 confirmation message, in the form:
 200  \"Really ACTIVE-OPSTRING x buffers?\"
 201 COMPLEX means this function is special; see the source code of this
 202 macro for exactly what it does.
 203
 204 \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
 205   (declare (indent 2))
 206   `(progn
 207      (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
 208                                  "" "ibuffer-do-") (symbol-name op)))
 209        ,args
 210        ,(if (stringp documentation)
 211             documentation
 212           (format "%s marked buffers." active-opstring))
 213        ,(if (not (null interactive))
 214             `(interactive ,interactive)
 215           '(interactive))
 216        (assert (derived-mode-p 'ibuffer-mode))
 217        (setq ibuffer-did-modification nil)
 218        (let ((marked-names  (,(case mark
 219                                 (:deletion
 220                                  'ibuffer-deletion-marked-buffer-names)
 221                                 (t
 222                                  'ibuffer-marked-buffer-names)))))
 223          (when (null marked-names)
 224            (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
 225            (ibuffer-set-mark ,(case mark
 226                                 (:deletion
 227                                  'ibuffer-deletion-char)
 228                                 (t
 229                                  'ibuffer-marked-char))))
 230          ,(let* ((finish (append
 231                           '(progn)
 232                           (if (eq modifier-p t)
 233                               '((setq ibuffer-did-modification t))
 234                             ())
 235                           `((ibuffer-redisplay t)
 236                             (message ,(concat "Operation finished; " opstring " %s buffers") count))))
 237                  (inner-body (if complex
 238                                  `(progn ,@body)
 239                                `(progn
 240                                   (with-current-buffer buf
 241                                     (save-excursion
 242                                       ,@body))
 243                                   t)))
 244                  (body `(let ((count
 245                                (,(case mark
 246                                    (:deletion
 247                                     'ibuffer-map-deletion-lines)
 248                                    (t
 249                                     'ibuffer-map-marked-lines))
 250                                 #'(lambda (buf mark)
 251                                     ,(if (eq modifier-p :maybe)
 252                                          `(let ((ibuffer-tmp-previous-buffer-modification
 253                                                  (buffer-modified-p buf)))
 254                                             (prog1 ,inner-body
 255                                               (when (not (eq ibuffer-tmp-previous-buffer-modification
 256                                                              (buffer-modified-p buf)))
 257                                                 (setq ibuffer-did-modification t))))
 258                                        inner-body)))))
 259                           ,finish)))
 260             (if dangerous
 261                 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
 262                    ,body)
 263               body))))
 264      :autoload-end))
 265
 266 ;;;###autoload
 267 (defmacro* define-ibuffer-filter (name documentation
 268                                        (&key
 269                                         reader
 270                                         description)
 271                                        &rest body)
 272   "Define a filter named NAME.
 273 DOCUMENTATION is the documentation of the function.
 274 READER is a form which should read a qualifier from the user.
 275 DESCRIPTION is a short string describing the filter.
 276
 277 BODY should contain forms which will be evaluated to test whether or
 278 not a particular buffer should be displayed or not.  The forms in BODY
 279 will be evaluated with BUF bound to the buffer object, and QUALIFIER
 280 bound to the current value of the filter.
 281
 282 \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
 283   (declare (indent 2))
 284   (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
 285     `(progn
 286        (defun ,fn-name (qualifier)
 287          ,(or documentation "This filter is not documented.")
 288          (interactive (list ,reader))
 289          (ibuffer-push-filter (cons ',name qualifier))
 290          (message "%s"
 291                   (format ,(concat (format "Filter by %s added: " description)
 292                                    " %s")
 293                           qualifier))
 294          (ibuffer-update nil t))
 295        (push (list ',name ,description
 296                    #'(lambda (buf qualifier)
 297                        ,@body))
 298              ibuffer-filtering-alist)
 299        :autoload-end)))
 300
 301 (provide 'ibuf-macs)
 302
 303 ;; arch-tag: 2748edce-82c9-4cd9-9d9d-bd73e43c20c5
 304 ;;; ibuf-macs.el ends here