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