[bpt/emacs.git] / lisp / ibuf-macs.el

;;; ibuf-macs.el --- macros for ibuffer

;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.

;; Author: Colin Walters <walters@verbum.org>
;; Created: 6 Dec 2001
;; Keywords: buffer, convenience

;; 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.

;; 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.

;; 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.

;;; Commentary:

;;; 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'."
  (let ((sym (gensym "--ibuffer-aif-")))
    `(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."
  `(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."
  (let ((bufsym (gensym)))
    `(let ((,bufsym (current-buffer))
	   (ibuffer-save-marks-tmp-mark-list (ibuffer-current-state-list)))
       (unwind-protect
	   (progn
	     (save-excursion
	       ,@body))
	 (with-current-buffer ,bufsym
	   (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))))))
;; (put 'ibuffer-save-marks 'lisp-indent-function 0)

;;;###autoload
(defmacro* define-ibuffer-column (symbol (&key name inline props
					       summarizer) &rest body)
  "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 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
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.

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'."
  (let* ((sym (intern (concat "ibuffer-make-column-"
			      (symbol-name symbol))))
	 (bod-1 `(with-current-buffer buffer
		   ,@body))
	 (bod (if props
		 `(propertize
		   ,bod-1
		   ,@props)
		bod-1)))
    `(progn
       ,(if inline
	    `(push '(,sym ,bod) ibuffer-inline-columns)
	  `(defun ,sym (buffer mark ibuffer-buf)
	     ,bod))
       (put (quote ,sym) 'ibuffer-column-name
	    ,(if (stringp name)
		 name
	       (capitalize (symbol-name symbol))))
       ,(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)))
;; (put 'define-ibuffer-column 'lisp-indent-function 'defun)

;;;###autoload
(defmacro* define-ibuffer-sorter (name documentation
				       (&key 
					description)
				       &rest body)
  "Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
`ibuffer-do-sort-by-NAME'.
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
value if and only if `a' is \"less than\" `b'."
  `(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))
     (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
				 (&key 
				  interactive
				  mark
				  modifier-p
				  dangerous
				  (opstring "operated on")
				  (active-opstring "Operate on")
				  complex)
				 &rest body)
  "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.

ARGS becomes the formal parameters of the function.
DOCUMENTATION becomes the docstring of the function.
INTERACTIVE becomes the interactive specification of the function.
MARK describes which type of mark (:deletion, or nil) this operation
uses.  :deletion means the function operates on buffers marked for
deletion, otherwise it acts on normally marked buffers.
MODIFIER-P describes how the function modifies buffers.  This is used
to set the modification flag of the Ibuffer buffer itself.  Valid
values are:
 nil - the function never modifiers buffers
 t - the function it always modifies buffers
 :maybe - attempt to discover this information by comparing the
  buffer's modification flag.
DANGEROUS is a boolean which should be set if the user should be
prompted before performing this operation.
OPSTRING is a string which will be displayed to the user after the
operation is complete, in the form:
 \"Operation complete; OPSTRING x buffers\"
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
macro for exactly what it does."
  `(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)

;;;###autoload
(defmacro* define-ibuffer-filter (name documentation
				       (&key 
					reader
					description)
				       &rest body)
  "Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
READER is a form which should read a qualifier from the user.
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
bound to the current value of the filter."
  (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
    `(progn 
       (defun ,fn-name (qualifier)
	 ,(concat (or documentation "This filter is not documented."))
	 (interactive (list ,reader))
	 (ibuffer-push-filter (cons ',name qualifier))
	 (message
	  (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)))
;; (put 'define-ibuffer-filter 'lisp-indent-function 2)

(provide 'ibuf-macs)

;;; ibuf-macs.el ends here
Commit	Line	Data
25d2f683 CW	1	;;; ibuf-macs.el --- macros for ibuffer
25d2f683 CW	2
00332656	3	;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
25d2f683 CW	4
	5	;; Author: Colin Walters <walters@verbum.org>
	6	;; Created: 6 Dec 2001
25d2f683 CW	7	;; Keywords: buffer, convenience
25d2f683 CW	8
76649361	9	;; This file is part of GNU Emacs.
25d2f683 CW	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
30764597 PJ	26	;;; Commentary:
30764597 PJ	27
25d2f683 CW	28	;;; Code:
25d2f683 CW	29
00332656 CW	30	(eval-when-compile
	31	(require 'cl))
	32
25d2f683 CW	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
76649361	66	(ibuffer-redisplay-engine
25d2f683 CW	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
1255dfe6 CW	76	(defmacro* define-ibuffer-column (symbol (&key name inline props
1255dfe6 CW	77	summarizer) &rest body)
25d2f683 CW	78	"Define a column SYMBOL for use with `ibuffer-formats'.
	79
	80	BODY will be called with `buffer' bound to the buffer object, and
1bb57048 CW	81	`mark' bound to the current mark on the buffer. The original ibuffer
1bb57048 CW	82	buffer will be bound to `ibuffer-buf'.
25d2f683 CW	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
1255dfe6 CW	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.
25d2f683 CW	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))))
ceb44935	98	(bod-1 `(with-current-buffer buffer
25d2f683 CW	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)
1bb57048	108	`(defun ,sym (buffer mark ibuffer-buf)
25d2f683 CW	109	,bod))
	110	(put (quote ,sym) 'ibuffer-column-name
	111	,(if (stringp name)
	112	name
	113	(capitalize (symbol-name symbol))))
1255dfe6	114	,(if summarizer
ceb44935	115	;; Store the name of the summarizing function.
1255dfe6 CW	116	`(put (quote ,sym) 'ibuffer-column-summarizer
	117	(quote ,summarizer)))
	118	,(if summarizer
ceb44935 CW	119	;; This will store the actual values of the column
	120	;; summary.
	121	`(put (quote ,sym) 'ibuffer-column-summary nil))
25d2f683 CW	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)
1bb57048 CW	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.
25d2f683 CW	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
1bb57048 CW	193	(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
	194	"" "ibuffer-do-") (symbol-name op)))
	195	,args
25d2f683 CW	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))
bde57911	236	#'(lambda (buf mark)
25d2f683 CW	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