lisp/ibuf-macs.el

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