lisp/ibuf-macs.el

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