Initial revision

1 files changed, 148 insertions, 0 deletions

diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el
new file mode 100644
index 00000000000..b562234e9a7
--- /dev/null
+++ b/lisp/map-ynp.el
@@ -0,0 +1,148 @@
+;;; map-ynp.el -- General-purpose boolean question-asker.
+;;; Copyright (C) 1991 Free Software Foundation, Inc.
+;;; Written by Roland McGrath.
+;;;
+;;; 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)
+;;; 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.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; 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.
+;;;
+;;; 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.
+;;; The nice thing is that you also get some other possible answers
+;;; to use, reminiscent of query-replace: ! to answer y to all remaining
+;;; 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))
+
+;;;###autoload
+(defun map-y-or-n-p (prompter actor list &optional help)
+  "Ask a series of boolean questions.
+Takes args PROMPTER ACTOR LIST, and optional arg HELP.
+
+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\).
+
+ACTOR is a function of one arg (an object from LIST),
+which gets called with each object that the user answers `yes' for.
+
+If HELP is given, it is a list (OBJECT OBJECTS ACTION),
+where OBJECT is a string giving the singular noun for an elt of LIST;
+OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
+verb describing ACTOR.  The default is \(\"object\" \"objects\" \"act on\"\).
+
+At the prompts, the user may enter y, Y, or SPC to act on that object;
+n, N, or DEL to skip that object; ! to act on all following objects;
+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.
+
+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)
+    (if (stringp prompter)
+        (setq prompter (` (lambda (object)
+                            (format (, prompter) object)))))
+    (while (setq elt (funcall next))
+      (setq prompt (funcall prompter elt))
+      (if (stringp prompt)
+          (progn
+            ;; 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))
+                   (setq next (function (lambda () nil))))
+                  ((or (= ?y char)
+                       (= ?Y char)
+                       (= ?  char))
+                   ;; Act on the object.
+                   (let ((help-form old-help-form))
+                     (funcall actor elt))
+                   (setq actions (1+ actions)))
+                  ((or (= ?n char)
+                       (= ?N char)
+                       (= ?\^? char))
+                   ;; Skip the object.
+                   )
+                  ((= ?. char)
+                   ;; 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)
+                         (progn
+                           (funcall actor elt)
+                           (setq actions (1+ actions)))))
+                  ((= ?? char)
+                   (setq unread-command-char help-char)
+                   (setq next (` (function (lambda ()
+                                             (setq next (, next))
+                                             t)))))
+                  (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))))))))
+        (if (eval prompt)
+            (progn
+              (funcall actor (car list))
+              (setq actions (1+ actions)))))
+      (setq list (cdr list)))
+    ;; Clear the last prompt from the minibuffer.
+    (message "")
+    ;; Return the number of actions that were taken.
+    actions))
+
+(provide 'map-ynp)