(completion-setup-function):

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

diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 27f12df6e5e8db23bceea2aba293d097d8b4c870..3a12f564b3837b34d978ca69758296707c9029f4 100644 (file)
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -1,6 +1,7 @@
 ;;; ibuf-macs.el --- macros for ibuffer
 
 ;;; ibuf-macs.el --- macros for ibuffer
 

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

 
 ;; Author: Colin Walters <walters@verbum.org>
 ;; Maintainer: John Paul Wallington <jpw@gnu.org>
 
 ;; Author: Colin Walters <walters@verbum.org>
 ;; Maintainer: John Paul Wallington <jpw@gnu.org>


@@ -9,20 +10,18 @@
 
 ;; This file is 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:
 
 
 ;;; Commentary:
 


@@ -37,6 +36,7 @@
 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'."
 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'."

+  (declare (indent 2))

   (let ((sym (make-symbol "ibuffer-aif-sym")))
     `(let ((,sym ,test))
        (if ,sym
   (let ((sym (make-symbol "ibuffer-aif-sym")))
     `(let ((,sym ,test))
        (if ,sym


@@ -44,18 +44,18 @@ Compare with `if'."
             ,true-body)
         (progn
           ,@false-body)))))
             ,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."

+  (declare (indent 0))

   (let ((bufsym (make-symbol "bufsym")))
     `(let ((,bufsym (current-buffer))
           (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
   (let ((bufsym (make-symbol "bufsym")))
     `(let ((,bufsym (current-buffer))
           (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))


@@ -71,11 +71,10 @@ During evaluation of body, bind `it' to the value returned by TEST."
                                          e))
                          ibuffer-save-marks-tmp-mark-list)))
           (ibuffer-redisplay t))))))
                                          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
-                                              summarizer) &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


@@ -89,19 +88,25 @@ 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.
 
 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


@@ -112,6 +117,7 @@ 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
        ,(if summarizer
            ;; Store the name of the summarizing function.
            `(put (quote ,sym) 'ibuffer-column-summarizer


@@ -121,7 +127,6 @@ change its definition, you should explicitly call
            ;; summary.
            `(put (quote ,sym) 'ibuffer-column-summary nil))
        :autoload-end)))
            ;; summary.
            `(put (quote ,sym) 'ibuffer-column-summary nil))
        :autoload-end)))

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

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


@@ -135,19 +140,24 @@ 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
 
 ;;;###autoload
 (defmacro* define-ibuffer-op (op args


@@ -189,67 +199,69 @@ 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 (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 (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)
-                                 ,(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


@@ -265,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)))))
     `(progn
        (defun ,fn-name (qualifier)
   (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
     `(progn
        (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