* src/puresize.h (BASE_PURESIZE): Bump by another 1K.
[bpt/emacs.git] / src / callint.c
index 4454b1f..35411bf 100644 (file)
@@ -1,6 +1,6 @@
 /* Call a Lisp function interactively.
-   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012
-                 Free Software Foundation, Inc.
+   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software
+   Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -19,7 +19,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
-#include <setjmp.h>
 
 #include "lisp.h"
 #include "character.h"
@@ -30,11 +29,12 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "keymap.h"
 
 Lisp_Object Qminus, Qplus;
-Lisp_Object Qcall_interactively;
+static Lisp_Object Qcall_interactively;
 static Lisp_Object Qcommand_debug_status;
 static Lisp_Object Qenable_recursive_minibuffers;
 
 static Lisp_Object Qhandle_shift_selection;
+static Lisp_Object Qread_number;
 
 Lisp_Object Qmouse_leave_buffer_hook;
 
@@ -127,7 +127,7 @@ quotify_arg (register Lisp_Object exp)
   if (CONSP (exp)
       || (SYMBOLP (exp)
          && !NILP (exp) && !EQ (exp, Qt)))
-    return Fcons (Qquote, Fcons (exp, Qnil));
+    return list2 (Qquote, exp);
 
   return exp;
 }
@@ -150,7 +150,7 @@ static const char *callint_argfuns[]
     = {"", "point", "mark", "region-beginning", "region-end"};
 
 static void
-check_mark (int for_region)
+check_mark (bool for_region)
 {
   Lisp_Object tem;
   tem = Fmarker_buffer (BVAR (current_buffer, mark));
@@ -251,6 +251,9 @@ invoke it.  If KEYS is omitted or nil, the return value of
 `this-command-keys-vector' is used.  */)
   (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
 {
+  /* `args' will contain the array of arguments to pass to the function.
+     `visargs' will contain the same list but in a nicer form, so that if we
+     pass it to `Fformat' it will be understandable to a human.  */
   Lisp_Object *args, *visargs;
   Lisp_Object specs;
   Lisp_Object filter_specs;
@@ -273,11 +276,11 @@ invoke it.  If KEYS is omitted or nil, the return value of
   signed char *varies;
 
   ptrdiff_t i, nargs;
-  int foo;
-  int arg_from_tty = 0;
+  ptrdiff_t mark;
+  bool arg_from_tty = 0;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   ptrdiff_t key_count;
-  int record_then_fail = 0;
+  bool record_then_fail = 0;
 
   Lisp_Object save_this_command, save_last_command;
   Lisp_Object save_this_original_command, save_real_this_command;
@@ -305,7 +308,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   specs = Qnil;
   string = 0;
-  /* The idea of FILTER_SPECS is to provide away to
+  /* The idea of FILTER_SPECS is to provide a way to
      specify how to represent the arguments in command history.
      The feature is not fully implemented.  */
   filter_specs = Qnil;
@@ -328,12 +331,9 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   /* If SPECS is set to a string, use it as an interactive prompt.  */
   if (STRINGP (specs))
-    {
-      /* Make a copy of string so that if a GC relocates specs,
-        `string' will still be valid.  */
-      string = alloca (SBYTES (specs) + 1);
-      memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
-    }
+    /* Make a copy of string so that if a GC relocates specs,
+       `string' will still be valid.  */
+    string = xlispstrdupa (specs);
   else
     {
       Lisp_Object input;
@@ -343,8 +343,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
       /* Compute the arg values using the user's expression.  */
       GCPRO2 (input, filter_specs);
       specs = Feval (specs,
-                    CONSP (funval) && EQ (Qclosure, XCAR (funval))
-                    ? Qt : Qnil);
+                    CONSP (funval) && EQ (Qclosure, XCAR (funval))
+                    ? CAR_SAFE (XCDR (funval)) : Qnil);
       UNGCPRO;
       if (events != num_input_events || !NILP (record_flag))
        {
@@ -372,7 +372,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
       Vthis_command = save_this_command;
       Vthis_original_command = save_this_original_command;
       Vreal_this_command = save_real_this_command;
-      KVAR (current_kboard, Vlast_command) = save_last_command;
+      kset_last_command (current_kboard, save_last_command);
 
       temporarily_switch_to_single_kboard (NULL);
       return unbind_to (speccount, apply1 (function, specs));
@@ -465,7 +465,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
     }
 
   if (min (MOST_POSITIVE_FIXNUM,
-          min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
+          min (PTRDIFF_MAX, SIZE_MAX) / word_size)
       < nargs)
     memory_full (SIZE_MAX);
 
@@ -498,47 +498,47 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
       switch (*tem)
        {
-       case 'a':               /* Symbol defined as a function */
+       case 'a':               /* Symbol defined as a function */
          visargs[i] = Fcompleting_read (callint_message,
                                         Vobarray, Qfboundp, Qt,
                                         Qnil, Qnil, Qnil, Qnil);
-         /* Passing args[i] directly stimulates compiler bug */
+         /* Passing args[i] directly stimulates compiler bug */
          teml = visargs[i];
          args[i] = Fintern (teml, Qnil);
          break;
 
-       case 'b':               /* Name of existing buffer */
+       case 'b':               /* Name of existing buffer */
          args[i] = Fcurrent_buffer ();
          if (EQ (selected_window, minibuf_window))
            args[i] = Fother_buffer (args[i], Qnil, Qnil);
          args[i] = Fread_buffer (callint_message, args[i], Qt);
          break;
 
-       case 'B':               /* Name of buffer, possibly nonexistent */
+       case 'B':               /* Name of buffer, possibly nonexistent */
          args[i] = Fread_buffer (callint_message,
                                  Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
                                  Qnil);
          break;
 
-        case 'c':              /* Character */
+        case 'c':              /* Character */
          /* Prompt in `minibuffer-prompt' face.  */
          Fput_text_property (make_number (0),
                              make_number (SCHARS (callint_message)),
                              Qface, Qminibuffer_prompt, callint_message);
          args[i] = Fread_char (callint_message, Qnil, Qnil);
-         message1_nolog ((char *) 0);
-         /* Passing args[i] directly stimulates compiler bug */
+         message1_nolog (0);
+         /* Passing args[i] directly stimulates compiler bug */
          teml = args[i];
          /* See bug#8479.  */
          if (! CHARACTERP (teml)) error ("Non-character input-event");
          visargs[i] = Fchar_to_string (teml);
          break;
 
-       case 'C':               /* Command: symbol with interactive function */
+       case 'C':             /* Command: symbol with interactive function.  */
          visargs[i] = Fcompleting_read (callint_message,
                                         Vobarray, Qcommandp,
                                         Qt, Qnil, Qnil, Qnil, Qnil);
-         /* Passing args[i] directly stimulates compiler bug */
+         /* Passing args[i] directly stimulates compiler bug */
          teml = visargs[i];
          args[i] = Fintern (teml, Qnil);
          break;
@@ -550,33 +550,33 @@ invoke it.  If KEYS is omitted or nil, the return value of
          varies[i] = 1;
          break;
 
-       case 'D':               /* Directory name. */
+       case 'D':               /* Directory name.  */
          args[i] = Fread_file_name (callint_message, Qnil,
                                     BVAR (current_buffer, directory), Qlambda, Qnil,
                                     Qfile_directory_p);
          break;
 
-       case 'f':               /* Existing file name. */
+       case 'f':               /* Existing file name.  */
          args[i] = Fread_file_name (callint_message,
                                     Qnil, Qnil, Qlambda, Qnil, Qnil);
          break;
 
-       case 'F':               /* Possibly nonexistent file name. */
+       case 'F':               /* Possibly nonexistent file name.  */
          args[i] = Fread_file_name (callint_message,
                                     Qnil, Qnil, Qnil, Qnil, Qnil);
          break;
 
        case 'G':               /* Possibly nonexistent file name,
-                                  default to directory alone. */
+                                  default to directory alone.  */
          args[i] = Fread_file_name (callint_message,
                                     Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
          break;
 
-       case 'i':               /* Ignore an argument -- Does not do I/O */
+       case 'i':               /* Ignore an argument -- Does not do I/O */
          varies[i] = -1;
          break;
 
-       case 'k':               /* Key sequence. */
+       case 'k':               /* Key sequence.  */
          {
            ptrdiff_t speccount1 = SPECPDL_INDEX ();
            specbind (Qcursor_in_echo_area, Qt);
@@ -608,7 +608,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
          }
          break;
 
-       case 'K':               /* Key sequence to be defined. */
+       case 'K':               /* Key sequence to be defined.  */
          {
            ptrdiff_t speccount1 = SPECPDL_INDEX ();
            specbind (Qcursor_in_echo_area, Qt);
@@ -616,8 +616,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
            Fput_text_property (make_number (0),
                                make_number (SCHARS (callint_message)),
                                Qface, Qminibuffer_prompt, callint_message);
-           args[i] = Fread_key_sequence (callint_message,
-                                         Qnil, Qt, Qnil, Qnil);
+           args[i] = Fread_key_sequence_vector (callint_message,
+                                                Qnil, Qt, Qnil, Qnil);
            teml = args[i];
            visargs[i] = Fkey_description (teml, Qnil);
            unbind_to (speccount1, Qnil);
@@ -640,7 +640,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
          }
          break;
 
-       case 'U':               /* Up event from last k or K */
+       case 'U':               /* Up event from last k or K */
          if (!NILP (up_event))
            {
              args[i] = Fmake_vector (make_number (1), up_event);
@@ -680,33 +680,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
                                  Qnil, Qnil, Qnil, Qt);
          break;
 
-       case 'N':               /* Prefix arg as number, else number from minibuffer */
+       case 'N':     /* Prefix arg as number, else number from minibuffer.  */
          if (!NILP (prefix_arg))
            goto have_prefix_arg;
        case 'n':               /* Read number from minibuffer.  */
-         {
-           int first = 1;
-           do
-             {
-               Lisp_Object str;
-               if (! first)
-                 {
-                   message ("Please enter a number.");
-                   sit_for (make_number (1), 0, 0);
-                 }
-               first = 0;
-
-               str = Fread_from_minibuffer (callint_message,
-                                            Qnil, Qnil, Qnil, Qnil, Qnil,
-                                            Qnil);
-               if (! STRINGP (str) || SCHARS (str) == 0)
-                 args[i] = Qnil;
-               else
-                 args[i] = Fread (str);
-             }
-           while (! NUMBERP (args[i]));
-         }
-         visargs[i] = args[i];
+         args[i] = call1 (Qread_number, callint_message);
+         /* Passing args[i] directly stimulates compiler bug.  */
+         teml = args[i];
+         visargs[i] = Fnumber_to_string (teml);
          break;
 
        case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
@@ -715,22 +696,22 @@ invoke it.  If KEYS is omitted or nil, the return value of
          varies[i] = -1;
          break;
 
-       case 'p':               /* Prefix arg converted to number.  No I/O. */
+       case 'p':               /* Prefix arg converted to number.  No I/O.  */
        have_prefix_arg:
          args[i] = Fprefix_numeric_value (prefix_arg);
          /* visargs[i] = Qnil; */
          varies[i] = -1;
          break;
 
-       case 'r':               /* Region, point and mark as 2 args. */
+       case 'r':               /* Region, point and mark as 2 args.  */
          check_mark (1);
          set_marker_both (point_marker, Qnil, PT, PT_BYTE);
          /* visargs[i+1] = Qnil; */
-         foo = marker_position (BVAR (current_buffer, mark));
+         mark = marker_position (BVAR (current_buffer, mark));
          /* visargs[i] = Qnil; */
-         args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
+         args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
          varies[i] = 3;
-         args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
+         args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
          varies[i] = 4;
          break;
 
@@ -743,29 +724,29 @@ invoke it.  If KEYS is omitted or nil, the return value of
        case 'S':               /* Any symbol.  */
          visargs[i] = Fread_string (callint_message,
                                     Qnil, Qnil, Qnil, Qnil);
-         /* Passing args[i] directly stimulates compiler bug */
+         /* Passing args[i] directly stimulates compiler bug */
          teml = visargs[i];
          args[i] = Fintern (teml, Qnil);
          break;
 
        case 'v':               /* Variable name: symbol that is
-                                  custom-variable-p. */
+                                  custom-variable-p.  */
          args[i] = Fread_variable (callint_message, Qnil);
          visargs[i] = last_minibuf_string;
          break;
 
-       case 'x':               /* Lisp expression read but not evaluated */
-         args[i] = Fread_minibuffer (callint_message, Qnil);
+       case 'x':               /* Lisp expression read but not evaluated */
+         args[i] = call1 (intern ("read-minibuffer"), callint_message);
          visargs[i] = last_minibuf_string;
          break;
 
-       case 'X':               /* Lisp expression read and evaluated */
-         args[i] = Feval_minibuffer (callint_message, Qnil);
+       case 'X':               /* Lisp expression read and evaluated */
+         args[i] = call1 (intern ("eval-minibuffer"), callint_message);
          visargs[i] = last_minibuf_string;
          break;
 
        case 'Z':               /* Coding-system symbol, or ignore the
-                                  argument if no prefix */
+                                  argument if no prefix */
          if (NILP (prefix_arg))
            {
              args[i] = Qnil;
@@ -779,7 +760,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
            }
          break;
 
-       case 'z':               /* Coding-system symbol or nil */
+       case 'z':               /* Coding-system symbol or nil */
          args[i] = Fread_coding_system (callint_message, Qnil);
          visargs[i] = last_minibuf_string;
          break;
@@ -812,11 +793,13 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   if (arg_from_tty || !NILP (record_flag))
     {
+      /* We don't need `visargs' any more, so let's recycle it since we need
+        an array of just the same size.  */
       visargs[0] = function;
       for (i = 1; i < nargs; i++)
        {
          if (varies[i] > 0)
-           visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
+           visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
          else
            visargs[i] = quotify_arg (args[i]);
        }
@@ -843,7 +826,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   Vthis_command = save_this_command;
   Vthis_original_command = save_this_original_command;
   Vreal_this_command = save_real_this_command;
-  KVAR (current_kboard, Vlast_command) = save_last_command;
+  kset_last_command (current_kboard, save_last_command);
 
   {
     Lisp_Object val;
@@ -888,7 +871,7 @@ syms_of_callint (void)
   callint_message = Qnil;
   staticpro (&callint_message);
 
-  preserved_fns = listn (PURE, 4,
+  preserved_fns = listn (CONSTYPE_PURE, 4,
                         intern_c_string ("region-beginning"),
                         intern_c_string ("region-end"),
                         intern_c_string ("point"),
@@ -904,6 +887,7 @@ syms_of_callint (void)
   DEFSYM (Qminus, "-");
   DEFSYM (Qplus, "+");
   DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
+  DEFSYM (Qread_number, "read-number");
   DEFSYM (Qcall_interactively, "call-interactively");
   DEFSYM (Qcommand_debug_status, "command-debug-status");
   DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");