Mercurial > emacs

changeset 2081:2b04be5e47e6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(map-y-or-n-p): Use query-replace-map.
author Richard M. Stallman <rms@gnu.org>
date Tue, 09 Mar 1993 19:53:06 +0000
parents 6ee99287dbc6
children 4b05402f3ac5
files lisp/map-ynp.el
diffstat 1 files changed, 48 insertions(+), 40 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/map-ynp.el	Tue Mar 09 19:51:29 1993 +0000
+++ b/lisp/map-ynp.el	Tue Mar 09 19:53:06 1993 +0000
@@ -67,28 +67,12 @@
 \"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 (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))))
-	 (user-keys (if action-alist
+  (let* ((user-keys (if action-alist
 			(concat (mapconcat (function
 					    (lambda (elt)
 					      (key-description
@@ -96,8 +80,15 @@
 					   action-alist ", ")
 				" ")
 		      ""))
+	 ;; Make a map that defines all the user keys as `user'.
+	 (map (cons 'keymap
+		    (append (mapcar (function
+				     (lambda (elt)
+				       (cons (car elt) 'user)))
+				    action-alist)
+			    query-replace-map)))
 	 (actions 0)
-	 prompt char elt tail
+	 prompt char elt tail def
 	 (next (if (or (symbolp list)
 		       (subrp list)
 		       (byte-code-function-p list)
@@ -112,6 +103,7 @@
 					 list (cdr list))
 				   t)
 			       nil))))))
+
     (if (stringp prompter)
 	(setq prompter (` (lambda (object)
 			    (format (, prompter) object)))))
@@ -124,28 +116,23 @@
 	      (message "%s(y, n, !, ., q, %sor %s) "
 		       prompt user-keys
 		       (key-description (char-to-string help-char)))
-	      (setq char (read-char)))
-	    (cond ((or (= ?q char)
-		       (= ?\e char))
+	      (setq char (read-event)))
+	    (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)
+		  ((eq def 'automatic)
 		   ;; Act on this and all following objects.
 		   (if (eval (funcall prompter elt))
 		       (progn
@@ -156,20 +143,41 @@
 			 (progn
 			   (funcall actor elt)
 			   (setq actions (1+ actions))))))
-		  ((= ?? char)
-		   (setq unread-command-events (list help-char))
+		  ((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)))))
-		  ((setq tail (assq char action-alist))
+		  ((eq def 'user)
 		   ;; A user-defined key.
 		   (if (funcall (nth 1 tail) elt) ;Call its function.
 		       ;; The function has eaten this object.
 		       (setq actions (1+ actions))
 		     ;; Regurgitated; try again.
 		     (setq next (` (lambda ()
-				   (setq next '(, next))
-				   '(, elt))))))
+				     (setq next '(, next))
+				     '(, elt))))))
 		  (t
 		   ;; Random char.
 		   (message "Type %s for help."