* lisp/subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key.

* src/fns.c (Fy_or_n_p): Move to lisp/subr.el.
(syms_of_fns): Don't defsubr Sy_or_n_p.
* src/lisp.h: Don't declare Fy_or_n_p.
* src/fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p.

2 files changed, 50 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ddbc0b43eed..081d9a53735 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2010-09-12  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * subr.el (y-or-n-p): New function, moved from src/fns.c.  Use read-key.
+
 2010-09-12  Leo  <sdl.web@gmail.com>
 
         * net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
diff --git a/lisp/subr.el b/lisp/subr.el
index 83cf7211906..f2c12a736c2 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3358,6 +3358,52 @@ clone should be incorporated in the clone."
     (overlay-put ol2 'evaporate t)
     (overlay-put ol2 'text-clones dups)))
 
+;;;; Misc functions moved over from the C side.
+
+(defun y-or-n-p (prompt)
+  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
+The argument PROMPT is the string to display to ask the question.
+It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
+No confirmation of the answer is requested; a single character is enough.
+Also accepts Space to mean yes, or Delete to mean no.  \(Actually, it uses
+the bindings in `query-replace-map'; see the documentation of that variable
+for more information.  In this case, the useful bindings are `act', `skip',
+`recenter', and `quit'.\)
+
+Under a windowing system a dialog box will be used if `last-nonmenu-event'
+is nil and `use-dialog-box' is non-nil."
+  ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+  ;; where all the keys were unbound (i.e. it somehow got triggered
+  ;; within read-key, apparently).  I had to kill it.
+  (let ((answer 'none)
+        (xprompt prompt))
+    (if (and (display-popup-menus-p)
+             (listp last-nonmenu-event)
+             use-dialog-box)
+        (setq answer
+              (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
+      (while
+          (let* ((key
+                  (let ((cursor-in-echo-area t))
+                    (when minibuffer-auto-raise
+                      (raise-frame (window-frame (minibuffer-window))))
+                    (read-key (propertize xprompt 'face 'minibuffer-prompt)))))
+            (setq answer (lookup-key query-replace-map (vector key) t))
+            (cond
+             ((memq answer '(skip act)) nil)
+             ((eq answer 'recenter) (recenter) t)
+             ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
+             (t t)))
+        (ding)
+        (discard-input)
+        (setq xprompt
+              (if (eq answer 'recenter) prompt
+                (concat "Please answer y or n.  " prompt)))))
+    (let ((ret (eq answer 'act)))
+      (unless noninteractive
+        (message "%s %s" prompt (if ret "y" "n")))
+      ret)))
+
 ;;;; Mail user agents.
 
 ;; Here we include just enough for other packages to be able