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 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 ;;; 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   (let ((sym (gensym "--ibuffer-aif-")))
  40     `(let ((,sym ,test))
  41        (if ,sym
  42            (let ((it ,sym))
  43              ,true-body)
  44          (progn
  45            ,@false-body)))))
  46 ;; (put 'ibuffer-aif 'lisp-indent-function 2)
  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   `(ibuffer-aif ,test
  52        (progn ,@body)
  53      nil))
  54 ;; (put 'ibuffer-awhen 'lisp-indent-function 1)
  55
  56 (defmacro ibuffer-save-marks (&rest body)
  57   "Save the marked status of the buffers and execute BODY; restore marks."
  58   (let ((bufsym (gensym)))
  59     `(let ((,bufsym (current-buffer))
  60            (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
  61        (unwind-protect
  62            (progn
  63              (save-excursion
  64                ,@body))
  65          (with-current-buffer ,bufsym
  66            (ibuffer-redisplay-engine
  67             ;; Get rid of dead buffers
  68             (delq nil
  69                   (mapcar #'(lambda (e) (when (buffer-live-p (car e))
  70                                           e))
  71                           ibuffer-save-marks-tmp-mark-list)))
  72            (ibuffer-redisplay t))))))
  73 ;; (put 'ibuffer-save-marks 'lisp-indent-function 0)
  74
  75 ;;;###autoload
  76 (defmacro* define-ibuffer-column (symbol (&key name inline props
  77                                                summarizer) &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 Note that this macro expands into a `defun' for a function named
  92 ibuffer-make-column-NAME.  If INLINE is non-nil, then the form will be
  93 inlined into the compiled format versions.  This means that if you
  94 change its definition, you should explicitly call
  95 `ibuffer-recompile-formats'."
  96   (let* ((sym (intern (concat "ibuffer-make-column-"
  97                               (symbol-name symbol))))
  98          (bod-1 `(with-current-buffer buffer
  99                    ,@body))
 100          (bod (if props
 101                  `(propertize
 102                    ,bod-1
 103                    ,@props)
 104                 bod-1)))
 105     `(progn
 106        ,(if inline
 107             `(push '(,sym ,bod) ibuffer-inline-columns)
 108           `(defun ,sym (buffer mark)
 109              ,bod))
 110        (put (quote ,sym) 'ibuffer-column-name
 111             ,(if (stringp name)
 112                  name
 113                (capitalize (symbol-name symbol))))
 114        ,(if summarizer
 115             ;; Store the name of the summarizing function.
 116             `(put (quote ,sym) 'ibuffer-column-summarizer
 117                   (quote ,summarizer)))
 118        ,(if summarizer
 119             ;; This will store the actual values of the column
 120             ;; summary.
 121             `(put (quote ,sym) 'ibuffer-column-summary nil))
 122        :autoload-end)))
 123 ;; (put 'define-ibuffer-column 'lisp-indent-function 'defun)
 124
 125 ;;;###autoload
 126 (defmacro* define-ibuffer-sorter (name documentation
 127                                        (&key
 128                                         description)
 129                                        &rest body)
 130   "Define a method of sorting named NAME.
 131 DOCUMENTATION is the documentation of the function, which will be called
 132 `ibuffer-do-sort-by-NAME'.
 133 DESCRIPTION is a short string describing the sorting method.
 134
 135 For sorting, the forms in BODY will be evaluated with `a' bound to one
 136 buffer object, and `b' bound to another.  BODY should return a non-nil
 137 value if and only if `a' is \"less than\" `b'."
 138   `(progn
 139      (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
 140        ,(or documentation "No :documentation specified for this sorting method.")
 141        (interactive)
 142        (setq ibuffer-sorting-mode ',name)
 143        (ibuffer-redisplay t))
 144      (push (list ',name ,description
 145                  #'(lambda (a b)
 146                      ,@body))
 147            ibuffer-sorting-functions-alist)
 148      :autoload-end))
 149 ;; (put 'define-ibuffer-sorter 'lisp-indent-function 1)
 150
 151 ;;;###autoload
 152 (defmacro* define-ibuffer-op (op args
 153                                  documentation
 154                                  (&key
 155                                   interactive
 156                                   mark
 157                                   modifier-p
 158                                   dangerous
 159                                   (opstring "operated on")
 160                                   (active-opstring "Operate on")
 161                                   complex)
 162                                  &rest body)
 163   "Generate a function which operates on a buffer.
 164 OP becomes the name of the function; if it doesn't begin with
 165 `ibuffer-do-', then that is prepended to it.
 166 When an operation is performed, this function will be called once for
 167 each marked buffer, with that buffer current.
 168
 169 ARGS becomes the formal parameters of the function.
 170 DOCUMENTATION becomes the docstring of the function.
 171 INTERACTIVE becomes the interactive specification of the function.
 172 MARK describes which type of mark (:deletion, or nil) this operation
 173 uses.  :deletion means the function operates on buffers marked for
 174 deletion, otherwise it acts on normally marked buffers.
 175 MODIFIER-P describes how the function modifies buffers.  This is used
 176 to set the modification flag of the Ibuffer buffer itself.  Valid
 177 values are:
 178  nil - the function never modifiers buffers
 179  t - the function it always modifies buffers
 180  :maybe - attempt to discover this information by comparing the
 181   buffer's modification flag.
 182 DANGEROUS is a boolean which should be set if the user should be
 183 prompted before performing this operation.
 184 OPSTRING is a string which will be displayed to the user after the
 185 operation is complete, in the form:
 186  \"Operation complete; OPSTRING x buffers\"
 187 ACTIVE-OPSTRING is a string which will be displayed to the user in a
 188 confirmation message, in the form:
 189  \"Really ACTIVE-OPSTRING x buffers?\"
 190 COMPLEX means this function is special; see the source code of this
 191 macro for exactly what it does."
 192   `(progn
 193     (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
 194                                 "" "ibuffer-do-") (symbol-name op)))
 195       ,args
 196      ,(if (stringp documentation)
 197           documentation
 198         (format "%s marked buffers." active-opstring))
 199      ,(if (not (null interactive))
 200           `(interactive ,interactive)
 201         '(interactive))
 202      (assert (eq major-mode 'ibuffer-mode))
 203      (setq ibuffer-did-modification nil)
 204      (let ((marked-names  (,(case mark
 205                               (:deletion
 206                                'ibuffer-deletion-marked-buffer-names)
 207                               (t
 208                                'ibuffer-marked-buffer-names)))))
 209        (when (null marked-names)
 210          (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
 211          (ibuffer-set-mark ,(case mark
 212                               (:deletion
 213                                'ibuffer-deletion-char)
 214                               (t
 215                                'ibuffer-marked-char))))
 216        ,(let* ((finish (append
 217                         '(progn)
 218                         (if (eq modifier-p t)
 219                             '((setq ibuffer-did-modification t))
 220                           ())
 221                         `((ibuffer-redisplay t)
 222                           (message ,(concat "Operation finished; " opstring " %s buffers") count))))
 223                (inner-body (if complex
 224                                `(progn ,@body)
 225                              `(progn
 226                                 (with-current-buffer buf
 227                                   (save-excursion
 228                                     ,@body))
 229                                 t)))
 230                (body `(let ((count
 231                              (,(case mark
 232                                  (:deletion
 233                                   'ibuffer-map-deletion-lines)
 234                                  (t
 235                                   'ibuffer-map-marked-lines))
 236                               #'(lambda (buf mark)
 237                                   ,(if (eq modifier-p :maybe)
 238                                        `(let ((ibuffer-tmp-previous-buffer-modification
 239                                                (buffer-modified-p buf)))
 240                                           (prog1 ,inner-body
 241                                             (when (not (eq ibuffer-tmp-previous-buffer-modification
 242                                                            (buffer-modified-p buf)))
 243                                               (setq ibuffer-did-modification t))))
 244                                      inner-body)))))
 245                         ,finish)))
 246           (if dangerous
 247               `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
 248                  ,body)
 249             body))))
 250     :autoload-end))
 251 ;; (put 'define-ibuffer-op 'lisp-indent-function 2)
 252
 253 ;;;###autoload
 254 (defmacro* define-ibuffer-filter (name documentation
 255                                        (&key
 256                                         reader
 257                                         description)
 258                                        &rest body)
 259   "Define a filter named NAME.
 260 DOCUMENTATION is the documentation of the function.
 261 READER is a form which should read a qualifier from the user.
 262 DESCRIPTION is a short string describing the filter.
 263
 264 BODY should contain forms which will be evaluated to test whether or
 265 not a particular buffer should be displayed or not.  The forms in BODY
 266 will be evaluated with BUF bound to the buffer object, and QUALIFIER
 267 bound to the current value of the filter."
 268   (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
 269     `(progn
 270        (defun ,fn-name (qualifier)
 271          ,(concat (or documentation "This filter is not documented."))
 272          (interactive (list ,reader))
 273          (ibuffer-push-filter (cons ',name qualifier))
 274          (message
 275           (format ,(concat (format "Filter by %s added: " description)
 276                            " %s")
 277                   qualifier))
 278          (ibuffer-update nil t))
 279        (push (list ',name ,description
 280                    #'(lambda (buf qualifier)
 281                        ,@body))
 282              ibuffer-filtering-alist)
 283        :autoload-end)))
 284 ;; (put 'define-ibuffer-filter 'lisp-indent-function 2)
 285
 286 (provide 'ibuf-macs)
 287
 288 ;;; ibuf-macs.el ends here