-;;; map-ynp.el -- General-purpose boolean question-asker.
-;;; Copyright (C) 1991 Free Software Foundation, Inc.
-;;; Written by Roland McGrath.
-;;;
+;;; map-ynp.el --- General-purpose boolean question-asker.
+
+;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc.
+
+;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
+;; Keywords: lisp, extensions
+
;;; 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 1, or (at your option)
+;;; 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,
;;; program's author (send electronic mail to roland@ai.mit.edu) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
-;;;
+
+;;; Commentary:
+
;;; map-y-or-n-p is a general-purpose question-asking function.
;;; It asks a series of y/n questions (a la y-or-n-p), and decides to
;;; applies an action to each element of a list based on the answer.
;;; questions; ESC or q to answer n to all remaining questions; . to answer
;;; y once and then n for the remainder; and you can get help with C-h.
-(defun map-y-or-n-p-help (object objects action)
- (format "Type SPC or `y' to %s the current %s;
-DEL or `n' to skip the current %s;
-! to %s all remaining %s;
-ESC or `q' to exit;
-or . (period) to %s the current %s and exit."
- action object object action objects action object))
+;;; Code:
;;;###autoload
-(defun map-y-or-n-p (prompter actor list &optional help)
+(defun map-y-or-n-p (prompter actor list &optional help action-alist)
"Ask a series of boolean questions.
-Takes args PROMPTER ACTOR LIST, and optional arg HELP.
+Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
LIST is a list of objects, or a function of no arguments to return the next
object or nil.
-PROMPTER is a function of one arg (an object from LIST),
-which returns a string to be used as the prompt for that object.
-If the return value is not a string, it is eval'd to get the answer.
-So, it may be nil to ignore the object, t to act on the object without
-asking the user, or a form to do a more complex prompt.
-PROMPTER may instead be a string, in which case the prompt is
-\(format PROMPTER OBJECT\).
+If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not
+a string, PROMPTER is a function of one arg (an object from LIST), which
+returns a string to be used as the prompt for that object. If the return
+value is not a string, it is eval'd to get the answer; it may be nil to
+ignore the object, t to act on the object without asking the user, or a
+form to do a more complex prompt.
ACTOR is a function of one arg (an object from LIST),
which gets called with each object that the user answers `yes' for.
ESC or q to exit (skip all following objects); . (period) to act on the
current object and then exit; or \\[help-command] to get help.
+If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
+that will be accepted. KEY is a character; FUNCTION is a function of one
+arg (an object from LIST); HELP is a string. When the user hits KEY,
+FUNCTION is called. If it returns non-nil, the object is considered
+\"acted upon\", and the next object from LIST is processed. If it returns
+nil, the prompt is repeated for the same object.
+
+This function uses `query-replace-map' to define the standard responses,
+but not all of the responses which `query-replace' understands
+are meaningful here.
+
Returns the number of actions taken."
- (let ((old-help-form help-form)
- (help-form (cons 'map-y-or-n-p-help
- (or help '("object" "objects" "act on"))))
- (actions 0)
- prompt
- char
- (next (if (or (symbolp list)
- (subrp list)
- (compiled-function-p list)
- (and (consp list)
- (eq (car list) 'lambda)))
- list
- (function (lambda ()
- (if list
- (prog1
- (car list)
- (setq list (cdr list)))
- nil)))))
- elt)
+ (let* ((user-keys (if action-alist
+ (concat (mapconcat (function
+ (lambda (elt)
+ (key-description
+ (char-to-string (car elt)))))
+ action-alist ", ")
+ " ")
+ ""))
+ ;; Make a map that defines each user key as a vector containing
+ ;; its definition.
+ (map (cons 'keymap
+ (append (mapcar (lambda (elt)
+ (cons (car elt) (vector (nth 1 elt))))
+ action-alist)
+ query-replace-map)))
+ (actions 0)
+ prompt char elt tail def
+ (next (if (or (symbolp list)
+ (subrp list)
+ (byte-code-function-p list)
+ (and (consp list)
+ (eq (car list) 'lambda)))
+ (function (lambda ()
+ (setq elt (funcall list))))
+ (function (lambda ()
+ (if list
+ (progn
+ (setq elt (car list)
+ list (cdr list))
+ t)
+ nil))))))
+
(if (stringp prompter)
(setq prompter (` (lambda (object)
(format (, prompter) object)))))
- (while (setq elt (funcall next))
+ (while (funcall next)
(setq prompt (funcall prompter elt))
(if (stringp prompt)
(progn
+ (setq quit-flag nil)
;; Prompt the user about this object.
(let ((cursor-in-echo-area t))
- (message "%s(y, n, ! ., q, or %s)"
- prompt (key-description (char-to-string help-char)))
- (setq char (read-char)))
- (cond ((or (= ?q char)
- (= ?\e char))
+ (message "%s(y, n, !, ., q, %sor %s) "
+ prompt user-keys
+ (key-description (char-to-string help-char)))
+ (setq char (read-event)))
+ ;; Show the answer to the question.
+ (message "%s(y, n, !, ., q, %sor %s) %s"
+ prompt user-keys
+ (key-description (char-to-string help-char))
+ (single-key-description char))
+ (setq def (lookup-key map (vector char)))
+ (cond ((eq def 'exit)
(setq next (function (lambda () nil))))
- ((or (= ?y char)
- (= ?Y char)
- (= ? char))
+ ((eq def 'act)
;; Act on the object.
- (let ((help-form old-help-form))
- (funcall actor elt))
+ (funcall actor elt)
(setq actions (1+ actions)))
- ((or (= ?n char)
- (= ?N char)
- (= ?\^? char))
+ ((eq def 'skip)
;; Skip the object.
)
- ((= ?. char)
+ ((eq def 'act-and-exit)
;; Act on the object and then exit.
(funcall actor elt)
(setq actions (1+ actions)
next (function (lambda () nil))))
- ((= ?! char)
- ;; Act on all following objects.
- (while (setq elt (funcall next))
- (if (funcall prompter elt)
+ ((eq def 'quit)
+ (setq quit-flag t)
+ (setq next (` (lambda ()
+ (setq next '(, next))
+ '(, elt)))))
+ ((eq def 'automatic)
+ ;; Act on this and all following objects.
+ (if (eval (funcall prompter elt))
+ (progn
+ (funcall actor elt)
+ (setq actions (1+ actions))))
+ (while (funcall next)
+ (if (eval (funcall prompter elt))
(progn
(funcall actor elt)
- (setq actions (1+ actions)))))
- ((= ?? char)
- (setq unread-command-char help-char)
- (setq next (` (function (lambda ()
- (setq next (, next))
- t)))))
+ (setq actions (1+ actions))))))
+ ((eq def 'help)
+ (with-output-to-temp-buffer "*Help*"
+ (princ
+ (let ((object (if help (nth 0 help) "object"))
+ (objects (if help (nth 1 help) "objects"))
+ (action (if help (nth 2 help) "act on")))
+ (concat (format "Type SPC or `y' to %s the current %s;
+DEL or `n' to skip the current %s;
+! to %s all remaining %s;
+ESC or `q' to exit;\n"
+ action object object action objects)
+ (mapconcat (function
+ (lambda (elt)
+ (format "%c to %s"
+ (nth 0 elt)
+ (nth 2 elt))))
+ action-alist
+ ";\n")
+ (if action-alist ";\n")
+ (format "or . (period) to %s \
+the current %s and exit."
+ action object)))))
+
+ (setq next (` (lambda ()
+ (setq next '(, next))
+ '(, elt)))))
+ ((vectorp def)
+ ;; A user-defined key.
+ (if (funcall (aref def 0) elt) ;Call its function.
+ ;; The function has eaten this object.
+ (setq actions (1+ actions))
+ ;; Regurgitated; try again.
+ (setq next (` (lambda ()
+ (setq next '(, next))
+ '(, elt))))))
(t
;; Random char.
(message "Type %s for help."
(key-description (char-to-string help-char)))
(beep)
(sit-for 1)
- (setq next (` (function (lambda ()
- (setq next (, next))
- t))))))))
+ (setq next (` (lambda ()
+ (setq next '(, next))
+ '(, elt)))))))
(if (eval prompt)
(progn
- (funcall actor (car list))
- (setq actions (1+ actions)))))
- (setq list (cdr list)))
+ (funcall actor elt)
+ (setq actions (1+ actions))))))
;; Clear the last prompt from the minibuffer.
(message "")
;; Return the number of actions that were taken.
actions))
-(provide 'map-ynp)
+;;; map-ynp.el ends here