changeset 110314:405e3949f580

* 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.

--- a/lisp/ChangeLog	Sun Sep 12 13:06:19 2010 +0200
+++ b/lisp/ChangeLog	Sun Sep 12 16:35:37 2010 +0200
@@ -1,3 +1,7 @@
[phone]  Stefan Monnier  <[e-mail]>
+
+	* subr.el (y-or-n-p): New function, moved from src/fns.c.  Use read-key.
+
 2010-09-12  Leo  <[e-mail]>
 
 	* net/rcirc.el (rcirc-server-commands, rcirc-client-commands)

--- a/lisp/subr.el	Sun Sep 12 13:06:19 2010 +0200
+++ b/lisp/subr.el	Sun Sep 12 16:35:37 2010 +0200
@@ -3358,6 +3358,52 @@
     (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

--- a/src/ChangeLog	Sun Sep 12 13:06:19 2010 +0200
+++ b/src/ChangeLog	Sun Sep 12 16:35:37 2010 +0200
@@ -1,3 +1,10 @@
[phone]  Stefan Monnier  <[e-mail]>
+
+	* fns.c (Fy_or_n_p): Move to lisp/subr.el.
+	(syms_of_fns): Don't defsubr Sy_or_n_p.
+	* lisp.h: Don't declare Fy_or_n_p.
+	* fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p.
+
 2010-09-09  Lars Magne Ingebrigtsen  <[e-mail]>
 
 	* xml.c (Fxml_parse_buffer): New function to parse XML files.
@@ -70,8 +77,8 @@
 	characters.
 
 	* term.c (encode_terminal_code): Fix the previous change.
-	(produce_glyphs): Don't set it->char_to_display here.  Don't
-	handle unibyte-display-via-language-environment here.
+	(produce_glyphs): Don't set it->char_to_display here.
+	Don't handle unibyte-display-via-language-environment here.
 	(produce_special_glyphs): Set temp_it.char_to_display before
 	calling produce_glyphs.
 
@@ -114,7 +121,7 @@
 2010-08-29  Kenichi Handa  <[e-mail]>
 
 	* term.c (encode_terminal_code): Encode byte chars to the
-	correspnding bytes.
+	corresponding bytes.
 
 2010-08-29  Jan Djärv  <[e-mail]>
 

--- a/src/fileio.c	Sun Sep 12 13:06:19 2010 +0200
+++ b/src/fileio.c	Sun Sep 12 16:35:37 2010 +0200
@@ -1842,7 +1842,7 @@
       tem = format2 ("File %s already exists; %s anyway? ",
 		     absname, build_string (querystring));
       if (quick)
-	tem = Fy_or_n_p (tem);
+	tem = call1 (intern ("y-or-n-p"), tem);
       else
 	tem = do_yes_or_no_p (tem);
       UNGCPRO;

--- a/src/fns.c	Sun Sep 12 13:06:19 2010 +0200
+++ b/src/fns.c	Sun Sep 12 16:35:37 2010 +0200
@@ -2444,146 +2444,6 @@
   return sequence;
 }
 
-/* Anything that calls this function must protect from GC!  */
-
-DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
-       doc: /* Ask user a "y or n" question.  Return t if answer is "y".
-Takes one argument, which 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.  */)
-  (Lisp_Object prompt)
-{
-  register Lisp_Object obj, key, def, map;
-  register int answer;
-  Lisp_Object xprompt;
-  Lisp_Object args[2];
-  struct gcpro gcpro1, gcpro2;
-  int count = SPECPDL_INDEX ();
-
-  specbind (Qcursor_in_echo_area, Qt);
-
-  map = Fsymbol_value (intern ("query-replace-map"));
-
-  CHECK_STRING (prompt);
-  xprompt = prompt;
-  GCPRO2 (prompt, xprompt);
-
-#ifdef HAVE_WINDOW_SYSTEM
-  if (display_hourglass_p)
-    cancel_hourglass ();
-#endif
-
-  while (1)
-    {
-
-#ifdef HAVE_MENUS
-      if (FRAME_WINDOW_P (SELECTED_FRAME ())
-          && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
-	  && use_dialog_box
-	  && have_menus_p ())
-	{
-	  Lisp_Object pane, menu;
-	  redisplay_preserve_echo_area (3);
-	  pane = Fcons (Fcons (build_string ("Yes"), Qt),
-			Fcons (Fcons (build_string ("No"), Qnil),
-			       Qnil));
-	  menu = Fcons (prompt, pane);
-	  obj = Fx_popup_dialog (Qt, menu, Qnil);
-	  answer = !NILP (obj);
-	  break;
-	}
-#endif /* HAVE_MENUS */
-      cursor_in_echo_area = 1;
-      choose_minibuf_frame ();
-
-      {
-	Lisp_Object pargs[3];
-
-	/* Colorize prompt according to `minibuffer-prompt' face.  */
-	pargs[0] = build_string ("%s(y or n) ");
-	pargs[1] = intern ("face");
-	pargs[2] = intern ("minibuffer-prompt");
-	args[0] = Fpropertize (3, pargs);
-	args[1] = xprompt;
-	Fmessage (2, args);
-      }
-
-      if (minibuffer_auto_raise)
-	{
-	  Lisp_Object mini_frame;
-
-	  mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
-
-	  Fraise_frame (mini_frame);
-	}
-
-      temporarily_switch_to_single_kboard (SELECTED_FRAME ());
-      obj = read_filtered_event (1, 0, 0, 0, Qnil);
-      cursor_in_echo_area = 0;
-      /* If we need to quit, quit with cursor_in_echo_area = 0.  */
-      QUIT;
-
-      key = Fmake_vector (make_number (1), obj);
-      def = Flookup_key (map, key, Qt);
-
-      if (EQ (def, intern ("skip")))
-	{
-	  answer = 0;
-	  break;
-	}
-      else if (EQ (def, intern ("act")))
-	{
-	  answer = 1;
-	  break;
-	}
-      else if (EQ (def, intern ("recenter")))
-	{
-	  Frecenter (Qnil);
-	  xprompt = prompt;
-	  continue;
-	}
-      else if (EQ (def, intern ("quit")))
-	Vquit_flag = Qt;
-      /* We want to exit this command for exit-prefix,
-	 and this is the only way to do it.  */
-      else if (EQ (def, intern ("exit-prefix")))
-	Vquit_flag = Qt;
-
-      QUIT;
-
-      /* If we don't clear this, then the next call to read_char will
-	 return quit_char again, and we'll enter an infinite loop.  */
-      Vquit_flag = Qnil;
-
-      Fding (Qnil);
-      Fdiscard_input ();
-      if (EQ (xprompt, prompt))
-	{
-	  args[0] = build_string ("Please answer y or n.  ");
-	  args[1] = prompt;
-	  xprompt = Fconcat (2, args);
-	}
-    }
-  UNGCPRO;
-
-  if (! noninteractive)
-    {
-      cursor_in_echo_area = -1;
-      message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n",
-			   xprompt, 0);
-    }
-
-  unbind_to (count, Qnil);
-  return answer ? Qt : Qnil;
-}
-
 /* This is how C code calls `yes-or-no-p' and allows the user
    to redefined it.
 
@@ -5058,7 +4918,6 @@
   defsubr (&Smapcar);
   defsubr (&Smapc);
   defsubr (&Smapconcat);
-  defsubr (&Sy_or_n_p);
   defsubr (&Syes_or_no_p);
   defsubr (&Sload_average);
   defsubr (&Sfeaturep);

--- a/src/lisp.h	Sun Sep 12 13:06:19 2010 +0200
+++ b/src/lisp.h	Sun Sep 12 16:35:37 2010 +0200
@@ -2516,7 +2516,6 @@
 EXFUN (Fnconc, MANY);
 EXFUN (Fmapcar, 2);
 EXFUN (Fmapconcat, 3);
-EXFUN (Fy_or_n_p, 1);
 extern Lisp_Object do_yes_or_no_p (Lisp_Object);
 EXFUN (Frequire, 3);
 EXFUN (Fprovide, 2);