lisp/ibuf-macs.el

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