(ucs-names): New internal variable.

[gnu-emacs] / lisp / ibuf-macs.el

diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 8d3033acea87d6f08068e1abf8d161f364b70449..6889b68f01b18cc486f12179bccb30843f9b510f 100644 (file)
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -1,58 +1,62 @@
 ;;; ibuf-macs.el --- macros for ibuffer
 
 ;;; ibuf-macs.el --- macros for ibuffer
 

-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.

 
 ;; Author: Colin Walters <walters@verbum.org>
 
 ;; Author: Colin Walters <walters@verbum.org>

+;; Maintainer: John Paul Wallington <jpw@gnu.org>

 ;; Created: 6 Dec 2001
 ;; Created: 6 Dec 2001

-;; X-RCS: $Id: ibuf-macs.el,v 1.6 2001/12/11 22:47:09 walters Exp $
-;; URL: http://cvs.verbum.org/ibuffer

 ;; Keywords: buffer, convenience
 
 ;; Keywords: buffer, convenience
 

-;; This file is not currently part of GNU Emacs.
+;; This file is part of GNU Emacs.

 
 

-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 

-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.

 
 ;; You should have received a copy of the GNU General Public License
 
 ;; You should have received a copy of the GNU General Public License

-;; along with this program ; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:

 
 ;;; Code:
 
 
 ;;; Code:
 

+(eval-when-compile
+  (require 'cl))
+

 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
 (defmacro ibuffer-aif (test true-body &rest false-body)
   "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
 If TEST returns non-nil, bind `it' to the value, and evaluate
 TRUE-BODY.  Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
 Compare with `if'."
 ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
 (defmacro ibuffer-aif (test true-body &rest false-body)
   "Evaluate TRUE-BODY or FALSE-BODY depending on value of TEST.
 If TEST returns non-nil, bind `it' to the value, and evaluate
 TRUE-BODY.  Otherwise, evaluate forms in FALSE-BODY as if in `progn'.
 Compare with `if'."

-  (let ((sym (gensym "--ibuffer-aif-")))
+  (declare (indent 2))
+  (let ((sym (make-symbol "ibuffer-aif-sym")))

     `(let ((,sym ,test))
        (if ,sym
           (let ((it ,sym))
             ,true-body)
         (progn
           ,@false-body)))))
     `(let ((,sym ,test))
        (if ,sym
           (let ((it ,sym))
             ,true-body)
         (progn
           ,@false-body)))))

-;; (put 'ibuffer-aif 'lisp-indent-function 2)

 
 (defmacro ibuffer-awhen (test &rest body)
   "Evaluate BODY if TEST returns non-nil.
 During evaluation of body, bind `it' to the value returned by TEST."
 
 (defmacro ibuffer-awhen (test &rest body)
   "Evaluate BODY if TEST returns non-nil.
 During evaluation of body, bind `it' to the value returned by TEST."

+  (declare (indent 1))

   `(ibuffer-aif ,test
        (progn ,@body)
      nil))
   `(ibuffer-aif ,test
        (progn ,@body)
      nil))

-;; (put 'ibuffer-awhen 'lisp-indent-function 1)

 
 (defmacro ibuffer-save-marks (&rest body)
   "Save the marked status of the buffers and execute BODY; restore marks."
 
 (defmacro ibuffer-save-marks (&rest body)
   "Save the marked status of the buffers and execute BODY; restore marks."

-  (let ((bufsym (gensym)))
+  (declare (indent 0))
+  (let ((bufsym (make-symbol "bufsym")))

     `(let ((,bufsym (current-buffer))
           (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
        (unwind-protect
     `(let ((,bufsym (current-buffer))
           (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
        (unwind-protect


@@ -60,41 +64,49 @@ During evaluation of body, bind `it' to the value returned by TEST."
             (save-excursion
               ,@body))
         (with-current-buffer ,bufsym
             (save-excursion
               ,@body))
         (with-current-buffer ,bufsym

-          (ibuffer-insert-buffers-and-marks
+          (ibuffer-redisplay-engine

            ;; Get rid of dead buffers
            (delq nil
                  (mapcar #'(lambda (e) (when (buffer-live-p (car e))
                                          e))
                          ibuffer-save-marks-tmp-mark-list)))
           (ibuffer-redisplay t))))))
            ;; Get rid of dead buffers
            (delq nil
                  (mapcar #'(lambda (e) (when (buffer-live-p (car e))
                                          e))
                          ibuffer-save-marks-tmp-mark-list)))
           (ibuffer-redisplay t))))))

-;; (put 'ibuffer-save-marks 'lisp-indent-function 0)

 
 ;;;###autoload
 
 ;;;###autoload

-(defmacro* define-ibuffer-column (symbol (&key name inline props) &rest body)
+(defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
+                                              header-mouse-map) &rest body)

   "Define a column SYMBOL for use with `ibuffer-formats'.
 
 BODY will be called with `buffer' bound to the buffer object, and
   "Define a column SYMBOL for use with `ibuffer-formats'.
 
 BODY will be called with `buffer' bound to the buffer object, and

-`mark' bound to the current mark on the buffer.  The current buffer
-will be `buffer'.
+`mark' bound to the current mark on the buffer.  The original ibuffer
+buffer will be bound to `ibuffer-buf'.

 
 If NAME is given, it will be used as a title for the column.
 Otherwise, the title will default to a capitalized version of the
 SYMBOL's name.  PROPS is a plist of additional properties to add to
 
 If NAME is given, it will be used as a title for the column.
 Otherwise, the title will default to a capitalized version of the
 SYMBOL's name.  PROPS is a plist of additional properties to add to

-the text, such as `mouse-face'.
+the text, such as `mouse-face'.  And SUMMARIZER, if given, is a
+function which will be passed a list of all the strings in its column;
+it should return a string to display at the bottom.
+
+If HEADER-MOUSE-MAP is given, it will be used as a keymap for the
+title of the column.

 
 Note that this macro expands into a `defun' for a function named
 ibuffer-make-column-NAME.  If INLINE is non-nil, then the form will be
 inlined into the compiled format versions.  This means that if you
 change its definition, you should explicitly call
 
 Note that this macro expands into a `defun' for a function named
 ibuffer-make-column-NAME.  If INLINE is non-nil, then the form will be
 inlined into the compiled format versions.  This means that if you
 change its definition, you should explicitly call

-`ibuffer-recompile-formats'."
+`ibuffer-recompile-formats'.
+
+\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)"
+  (declare (indent defun))

   (let* ((sym (intern (concat "ibuffer-make-column-"
                              (symbol-name symbol))))
         (bod-1 `(with-current-buffer buffer
                   ,@body))
         (bod (if props
   (let* ((sym (intern (concat "ibuffer-make-column-"
                              (symbol-name symbol))))
         (bod-1 `(with-current-buffer buffer
                   ,@body))
         (bod (if props

-                `(propertize
-                  ,bod-1
-                  ,@props)
+                 `(propertize
+                   ,bod-1
+                   ,@props)

                bod-1)))
     `(progn
        ,(if inline
                bod-1)))
     `(progn
        ,(if inline


@@ -105,12 +117,20 @@ change its definition, you should explicitly call
            ,(if (stringp name)
                 name
               (capitalize (symbol-name symbol))))
            ,(if (stringp name)
                 name
               (capitalize (symbol-name symbol))))

+       ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map))
+       ,(if summarizer
+           ;; Store the name of the summarizing function.
+           `(put (quote ,sym) 'ibuffer-column-summarizer
+                 (quote ,summarizer)))
+       ,(if summarizer
+           ;; This will store the actual values of the column
+           ;; summary.
+           `(put (quote ,sym) 'ibuffer-column-summary nil))

        :autoload-end)))
        :autoload-end)))

-;; (put 'define-ibuffer-column 'lisp-indent-function 'defun)

 
 ;;;###autoload
 (defmacro* define-ibuffer-sorter (name documentation
 
 ;;;###autoload
 (defmacro* define-ibuffer-sorter (name documentation

-                                      (&key 
+                                      (&key

                                        description)
                                       &rest body)
   "Define a method of sorting named NAME.
                                        description)
                                       &rest body)
   "Define a method of sorting named NAME.


@@ -120,24 +140,29 @@ DESCRIPTION is a short string describing the sorting method.
 
 For sorting, the forms in BODY will be evaluated with `a' bound to one
 buffer object, and `b' bound to another.  BODY should return a non-nil
 
 For sorting, the forms in BODY will be evaluated with `a' bound to one
 buffer object, and `b' bound to another.  BODY should return a non-nil

-value if and only if `a' is \"less than\" `b'."
+value if and only if `a' is \"less than\" `b'.
+
+\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
+  (declare (indent 1))

   `(progn
      (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
        ,(or documentation "No :documentation specified for this sorting method.")
        (interactive)
        (setq ibuffer-sorting-mode ',name)
   `(progn
      (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
        ,(or documentation "No :documentation specified for this sorting method.")
        (interactive)
        (setq ibuffer-sorting-mode ',name)

-       (ibuffer-redisplay t))
+       (when (eq ibuffer-sorting-mode ibuffer-last-sorting-mode)
+        (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
+       (ibuffer-redisplay t)
+       (setq ibuffer-last-sorting-mode ',name))

      (push (list ',name ,description
                 #'(lambda (a b)
                     ,@body))
           ibuffer-sorting-functions-alist)
      :autoload-end))
      (push (list ',name ,description
                 #'(lambda (a b)
                     ,@body))
           ibuffer-sorting-functions-alist)
      :autoload-end))

-;; (put 'define-ibuffer-sorter 'lisp-indent-function 1)

 
 ;;;###autoload
 (defmacro* define-ibuffer-op (op args
                                 documentation
 
 ;;;###autoload
 (defmacro* define-ibuffer-op (op args
                                 documentation

-                                (&key 
+                                (&key

                                  interactive
                                  mark
                                  modifier-p
                                  interactive
                                  mark
                                  modifier-p


@@ -146,7 +171,9 @@ value if and only if `a' is \"less than\" `b'."
                                  (active-opstring "Operate on")
                                  complex)
                                 &rest body)
                                  (active-opstring "Operate on")
                                  complex)
                                 &rest body)

-  "Generate a function named `ibuffer-do-OP', which operates on a buffer.
+  "Generate a function which operates on a buffer.
+OP becomes the name of the function; if it doesn't begin with
+`ibuffer-do-', then that is prepended to it.

 When an operation is performed, this function will be called once for
 each marked buffer, with that buffer current.
 
 When an operation is performed, this function will be called once for
 each marked buffer, with that buffer current.
 


@@ -172,69 +199,73 @@ ACTIVE-OPSTRING is a string which will be displayed to the user in a
 confirmation message, in the form:
  \"Really ACTIVE-OPSTRING x buffers?\"
 COMPLEX means this function is special; see the source code of this
 confirmation message, in the form:
  \"Really ACTIVE-OPSTRING x buffers?\"
 COMPLEX means this function is special; see the source code of this

-macro for exactly what it does."
+macro for exactly what it does.
+
+\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
+  (declare (indent 2))

   `(progn
   `(progn

-    (defun ,(intern (concat "ibuffer-do-" (symbol-name op))) ,args
-     ,(if (stringp documentation)
-         documentation
-       (format "%s marked buffers." active-opstring))
-     ,(if (not (null interactive))
-         `(interactive ,interactive)
-       '(interactive))
-     (assert (eq major-mode 'ibuffer-mode))
-     (setq ibuffer-did-modification nil)
-     (let ((marked-names  (,(case mark
-                             (:deletion
-                              'ibuffer-deletion-marked-buffer-names)
-                             (t
-                              'ibuffer-marked-buffer-names)))))
-       (when (null marked-names)
-        (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
-        (ibuffer-set-mark ,(case mark
-                             (:deletion
-                              'ibuffer-deletion-char)
-                             (t
-                              'ibuffer-marked-char))))
-       ,(let* ((finish (append
-                       '(progn)
-                       (if (eq modifier-p t)
-                           '((setq ibuffer-did-modification t))
-                         ())
-                       `((ibuffer-redisplay t)
-                         (message ,(concat "Operation finished; " opstring " %s buffers") count))))
-              (inner-body (if complex
-                              `(progn ,@body)
-                            `(progn
-                               (with-current-buffer buf
-                                 (save-excursion
-                                   ,@body))
-                               t)))
-              (body `(let ((count
-                            (,(case mark
-                                (:deletion
-                                 'ibuffer-map-deletion-lines)
-                                (t
-                                 'ibuffer-map-marked-lines))
-                             #'(lambda (buf mark beg end)
-                                 ,(if (eq modifier-p :maybe)
-                                      `(let ((ibuffer-tmp-previous-buffer-modification
-                                              (buffer-modified-p buf)))
-                                         (prog1 ,inner-body
-                                           (when (not (eq ibuffer-tmp-previous-buffer-modification
-                                                          (buffer-modified-p buf)))
-                                             (setq ibuffer-did-modification t))))
-                                    inner-body)))))
-                       ,finish)))
-         (if dangerous
-             `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
-                ,body)
-           body))))
-    :autoload-end))
-;; (put 'define-ibuffer-op 'lisp-indent-function 2)
+     (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
+                                "" "ibuffer-do-") (symbol-name op)))
+       ,args
+       ,(if (stringp documentation)
+           documentation
+         (format "%s marked buffers." active-opstring))
+       ,(if (not (null interactive))
+           `(interactive ,interactive)
+         '(interactive))
+       (assert (derived-mode-p 'ibuffer-mode))
+       (setq ibuffer-did-modification nil)
+       (let ((marked-names  (,(case mark
+                               (:deletion
+                                'ibuffer-deletion-marked-buffer-names)
+                               (t
+                                'ibuffer-marked-buffer-names)))))
+        (when (null marked-names)
+          (setq marked-names (list (buffer-name (ibuffer-current-buffer))))
+          (ibuffer-set-mark ,(case mark
+                               (:deletion
+                                'ibuffer-deletion-char)
+                               (t
+                                'ibuffer-marked-char))))
+        ,(let* ((finish (append
+                         '(progn)
+                         (if (eq modifier-p t)
+                             '((setq ibuffer-did-modification t))
+                           ())
+                         `((ibuffer-redisplay t)
+                           (message ,(concat "Operation finished; " opstring " %s buffers") count))))
+                (inner-body (if complex
+                                `(progn ,@body)
+                              `(progn
+                                 (with-current-buffer buf
+                                   (save-excursion
+                                     ,@body))
+                                 t)))
+                (body `(let ((count
+                              (,(case mark
+                                  (:deletion
+                                   'ibuffer-map-deletion-lines)
+                                  (t
+                                   'ibuffer-map-marked-lines))
+                               #'(lambda (buf mark)
+                                   ,(if (eq modifier-p :maybe)
+                                        `(let ((ibuffer-tmp-previous-buffer-modification
+                                                (buffer-modified-p buf)))
+                                           (prog1 ,inner-body
+                                             (when (not (eq ibuffer-tmp-previous-buffer-modification
+                                                            (buffer-modified-p buf)))
+                                               (setq ibuffer-did-modification t))))
+                                      inner-body)))))
+                         ,finish)))
+           (if dangerous
+               `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
+                  ,body)
+             body))))
+     :autoload-end))

 
 ;;;###autoload
 (defmacro* define-ibuffer-filter (name documentation
 
 ;;;###autoload
 (defmacro* define-ibuffer-filter (name documentation

-                                      (&key 
+                                      (&key

                                        reader
                                        description)
                                       &rest body)
                                        reader
                                        description)
                                       &rest body)


@@ -246,25 +277,28 @@ DESCRIPTION is a short string describing the filter.
 BODY should contain forms which will be evaluated to test whether or
 not a particular buffer should be displayed or not.  The forms in BODY
 will be evaluated with BUF bound to the buffer object, and QUALIFIER
 BODY should contain forms which will be evaluated to test whether or
 not a particular buffer should be displayed or not.  The forms in BODY
 will be evaluated with BUF bound to the buffer object, and QUALIFIER

-bound to the current value of the filter."
+bound to the current value of the filter.
+
+\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
+  (declare (indent 2))

   (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
   (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))

-    `(progn 
+    `(progn

        (defun ,fn-name (qualifier)
        (defun ,fn-name (qualifier)

-        ,(concat (or documentation "This filter is not documented."))
+        ,(or documentation "This filter is not documented.")

         (interactive (list ,reader))
         (ibuffer-push-filter (cons ',name qualifier))
         (interactive (list ,reader))
         (ibuffer-push-filter (cons ',name qualifier))

-        (message
-         (format ,(concat (format "Filter by %s added: " description)
-                          " %s")
-                 qualifier))
+        (message "%s"
+                 (format ,(concat (format "Filter by %s added: " description)
+                                  " %s")
+                         qualifier))

         (ibuffer-update nil t))
        (push (list ',name ,description
                   #'(lambda (buf qualifier)
                       ,@body))
             ibuffer-filtering-alist)
        :autoload-end)))
         (ibuffer-update nil t))
        (push (list ',name ,description
                   #'(lambda (buf qualifier)
                       ,@body))
             ibuffer-filtering-alist)
        :autoload-end)))

-;; (put 'define-ibuffer-filter 'lisp-indent-function 2)

 
 (provide 'ibuf-macs)
 
 
 (provide 'ibuf-macs)
 

+;; arch-tag: 2748edce-82c9-4cd9-9d9d-bd73e43c20c5

 ;;; ibuf-macs.el ends here
 ;;; ibuf-macs.el ends here