Mercurial > hg > xemacs-beta

changeset 2730:7031e143e4ee

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-04-14 05:58:45 by michaels] 2005-04-12 Mike Sperber <mike@xemacs.org> * minibuf.el (get-user-response): Move here from dialog.el so it works even when dialogs are not available. * dialog.el: See above.
author michaels
date Thu, 14 Apr 2005 05:58:46 +0000
parents d3c4655e9c06
children 3213c79d6672
files lisp/ChangeLog lisp/dialog.el lisp/minibuf.el
diffstat 3 files changed, 115 insertions(+), 110 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Apr 13 21:51:24 2005 +0000
+++ b/lisp/ChangeLog	Thu Apr 14 05:58:46 2005 +0000
@@ -1,3 +1,9 @@
+2005-04-12  Mike Sperber  <mike@xemacs.org>
+
+	* minibuf.el (get-user-response): Move here from dialog.el so it
+	works even when dialogs are not available.
+	* dialog.el: See above.
+
 2005-04-01  Marcus Crestani  <crestani@xemacs.org>
 
 	The new allocator.
--- a/lisp/dialog.el	Wed Apr 13 21:51:24 2005 +0000
+++ b/lisp/dialog.el	Thu Apr 14 05:58:46 2005 +0000
@@ -92,116 +92,6 @@
 				 `[,(car x) (dialog-box-finish ',(cdr x)) t])))
 			   (cdr contents))))
 
-(defun get-user-response (position question answers)
-  "Ask a question and get a response from the user, in minibuffer or dialog box.
-POSITION specifies which frame to use.
-This is normally an event or a window or frame.
-If POSITION is t or nil, it means to use the frame the mouse is on.
-The dialog box appears in the middle of the specified frame.
-
-QUESTION is the question to ask (it should end with a question mark followed
-by a space).
-
-ANSWERS are the possible answers.  It is a list; each item looks like
-
-  (KEY BUTTON-TEXT RESPONSE)
-
-where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the
-text to be displayed in a dialog box button (you should put %_ in it to
-indicate the accelerator), and RESPONSE is a value (typically a symbol)
-to be returned if the user selects this response.  KEY should be either a
-single character or a string; which one you use needs to be consistent for
-all responses and determines whether the user responds by hitting a single
-key or typing in a string and hitting ENTER.
-
-An item may also be just a string--that makes a nonselectable item in the
-dialog box and is ignored in the minibuffer.
-
-An item may also be nil -- that means to put all preceding items
-on the left of the dialog box and all following items on the right; ignored
-in the minibuffer."
-  (if (should-use-dialog-box-p)
-      (get-dialog-box-response
-       position
-       (cons question
-	     (mapcar #'(lambda (x)
-			 (cond
-			  ((null x) nil)
-			  ((stringp x) x)
-			  (t (cons (second x) (third x)))))
-		     answers)))
-    (save-excursion
-      (let* ((answers (remove-if-not #'consp answers))
-	     (possible
-	      (gettext
-	       (flet ((car-to-string-if (x)
-			(setq x (car x))
-			(if (stringp x)  x (char-to-string x))))
-		 (concat (mapconcat #'car-to-string-if
-			   (butlast answers) ", ") " or "
-			   (car-to-string-if (car (last answers)))))))
-	     (question (gettext question))
-	     (p (format "%s(%s) " question possible)))
-	(block nil
-	  (if (stringp (caar answers))
-	      ;; based on yes-or-no-p.
-	      (while t
-		(let* ((ans (downcase (read-string p nil t))) ;no history
-		       (res (member* ans answers :test #'equal :key #'car)))
-		  (if res (return (third (car res)))
-		    (ding nil 'yes-or-no-p)
-		    (discard-input)
-		    (message "Please answer %s." possible)
-		    (sleep-for 2))))
-	    ;; based on y-or-n-p.
-	    (save-excursion
-	      (let* ((pre "") event)
-		(while t
-		  (if (let ((cursor-in-echo-area t)
-			    (inhibit-quit t))
-			(message "%s%s(%s) " pre question possible)
-			(setq event (next-command-event event))
-			(condition-case nil
-			    (prog1
-				(or quit-flag (eq 'keyboard-quit
-						  (key-binding event)))
-			      (setq quit-flag nil))
-			  (wrong-type-argument t)))
-		      (progn
-			(message "%s%s(%s) %s" pre question possible
-				 (single-key-description event))
-			(setq quit-flag nil)
-			(signal 'quit '())))
-		  (let* ((keys (events-to-keys (vector event)))
-			 (def (lookup-key query-replace-map keys)))
-		    (cond
-; 		     ((eq def 'skip)
-; 		      (message "%s%sNo" question possible)
-; 		      (return nil))
-; 		     ((eq def 'act)
-; 		      (message "%s%sYes" question possible)
-; 		      (return t))
-		     ((eq def 'recenter)
-		      (recenter))
-		     ((or (eq def 'quit) (eq def 'exit-prefix))
-		      (signal 'quit '()))
-		     ((button-release-event-p event) ; ignore them
-		      nil)
-		     (t
-		      (let ((res (member* (event-to-character event) answers
-					  :key #'car)))
-			(if res (return (third (car res)))
-			  (message "%s%s(%s) %s" pre question possible
-				   (single-key-description event))
-			  (ding nil 'y-or-n-p)
-			  (discard-input)
-			  (if (= (length pre) 0)
-			      (setq pre (format "Please answer %s.  "
-						;; 17 parens!  a record in
-						;; our lisp code.
-						possible)))))))))))))))))
-
-
 (defun message-box (fmt &rest args)
   "Display a message, in a dialog box if possible.
 If the selected device has no dialog-box support, use the echo area.
--- a/lisp/minibuf.el	Wed Apr 13 21:51:24 2005 +0000
+++ b/lisp/minibuf.el	Thu Apr 14 05:58:46 2005 +0000
@@ -2244,4 +2244,113 @@
 	   (button-release-event-p last-command-event)
 	   (misc-user-event-p last-command-event))))
 
+(defun get-user-response (position question answers)
+  "Ask a question and get a response from the user, in minibuffer or dialog box.
+POSITION specifies which frame to use.
+This is normally an event or a window or frame.
+If POSITION is t or nil, it means to use the frame the mouse is on.
+The dialog box appears in the middle of the specified frame.
+
+QUESTION is the question to ask (it should end with a question mark followed
+by a space).
+
+ANSWERS are the possible answers.  It is a list; each item looks like
+
+  (KEY BUTTON-TEXT RESPONSE)
+
+where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the
+text to be displayed in a dialog box button (you should put %_ in it to
+indicate the accelerator), and RESPONSE is a value (typically a symbol)
+to be returned if the user selects this response.  KEY should be either a
+single character or a string; which one you use needs to be consistent for
+all responses and determines whether the user responds by hitting a single
+key or typing in a string and hitting ENTER.
+
+An item may also be just a string--that makes a nonselectable item in the
+dialog box and is ignored in the minibuffer.
+
+An item may also be nil -- that means to put all preceding items
+on the left of the dialog box and all following items on the right; ignored
+in the minibuffer."
+  (if (should-use-dialog-box-p)
+      (get-dialog-box-response
+       position
+       (cons question
+	     (mapcar #'(lambda (x)
+			 (cond
+			  ((null x) nil)
+			  ((stringp x) x)
+			  (t (cons (second x) (third x)))))
+		     answers)))
+    (save-excursion
+      (let* ((answers (remove-if-not #'consp answers))
+	     (possible
+	      (gettext
+	       (flet ((car-to-string-if (x)
+			(setq x (car x))
+			(if (stringp x)  x (char-to-string x))))
+		 (concat (mapconcat #'car-to-string-if
+			   (butlast answers) ", ") " or "
+			   (car-to-string-if (car (last answers)))))))
+	     (question (gettext question))
+	     (p (format "%s(%s) " question possible)))
+	(block nil
+	  (if (stringp (caar answers))
+	      ;; based on yes-or-no-p.
+	      (while t
+		(let* ((ans (downcase (read-string p nil t))) ;no history
+		       (res (member* ans answers :test #'equal :key #'car)))
+		  (if res (return (third (car res)))
+		    (ding nil 'yes-or-no-p)
+		    (discard-input)
+		    (message "Please answer %s." possible)
+		    (sleep-for 2))))
+	    ;; based on y-or-n-p.
+	    (save-excursion
+	      (let* ((pre "") event)
+		(while t
+		  (if (let ((cursor-in-echo-area t)
+			    (inhibit-quit t))
+			(message "%s%s(%s) " pre question possible)
+			(setq event (next-command-event event))
+			(condition-case nil
+			    (prog1
+				(or quit-flag (eq 'keyboard-quit
+						  (key-binding event)))
+			      (setq quit-flag nil))
+			  (wrong-type-argument t)))
+		      (progn
+			(message "%s%s(%s) %s" pre question possible
+				 (single-key-description event))
+			(setq quit-flag nil)
+			(signal 'quit '())))
+		  (let* ((keys (events-to-keys (vector event)))
+			 (def (lookup-key query-replace-map keys)))
+		    (cond
+; 		     ((eq def 'skip)
+; 		      (message "%s%sNo" question possible)
+; 		      (return nil))
+; 		     ((eq def 'act)
+; 		      (message "%s%sYes" question possible)
+; 		      (return t))
+		     ((eq def 'recenter)
+		      (recenter))
+		     ((or (eq def 'quit) (eq def 'exit-prefix))
+		      (signal 'quit '()))
+		     ((button-release-event-p event) ; ignore them
+		      nil)
+		     (t
+		      (let ((res (member* (event-to-character event) answers
+					  :key #'car)))
+			(if res (return (third (car res)))
+			  (message "%s%s(%s) %s" pre question possible
+				   (single-key-description event))
+			  (ding nil 'y-or-n-p)
+			  (discard-input)
+			  (if (= (length pre) 0)
+			      (setq pre (format "Please answer %s.  "
+						;; 17 parens!  a record in
+						;; our lisp code.
+						possible)))))))))))))))))
+
 ;;; minibuf.el ends here