Merge from emacs-24; up to 2012-12-19T19:51:40Z!monnier@iro.umontreal.ca
[bpt/emacs.git] / src / callint.c
index 61ab4a3..1a125d3 100644 (file)
@@ -1,6 +1,6 @@
 /* Call a Lisp function interactively.
-   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2011
-                 Free Software Foundation, Inc.
+   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2013 Free Software
+   Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -19,15 +19,14 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
-#include <setjmp.h>
 
 #include "lisp.h"
+#include "character.h"
 #include "buffer.h"
 #include "commands.h"
 #include "keyboard.h"
 #include "window.h"
 #include "keymap.h"
-#include "character.h"
 
 Lisp_Object Qminus, Qplus;
 Lisp_Object Qcall_interactively;
@@ -78,7 +77,7 @@ c -- Character (no input method is used).
 C -- Command name: symbol with interactive function definition.
 d -- Value of point as number.  Does not do I/O.
 D -- Directory name.
-e -- Parametrized event (i.e., one that's a list) that invoked this command.
+e -- Parameterized event (i.e., one that's a list) that invoked this command.
      If used more than once, the Nth `e' returns the Nth parameterized event.
      This skips events that are integers or symbols.
 f -- Existing file name.
@@ -97,7 +96,7 @@ r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
 s -- Any string.  Does not inherit the current input method.
 S -- Any symbol.
 U -- Mouse up event discarded by a previous k or K argument.
-v -- Variable name: symbol that is user-variable-p.
+v -- Variable name: symbol that is `custom-variable-p'.
 x -- Lisp expression read but not evaluated.
 X -- Lisp expression read and evaluated.
 z -- Coding system.
@@ -150,7 +149,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));
@@ -205,7 +204,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
              if (CONSP (elt))
                {
                  Lisp_Object presflag, carelt;
-                 carelt = Fcar (elt);
+                 carelt = XCAR (elt);
                  /* If it is (if X Y), look at Y.  */
                  if (EQ (carelt, Qif)
                      && EQ (Fnthcdr (make_number (3), elt), Qnil))
@@ -257,11 +256,11 @@ invoke it.  If KEYS is omitted or nil, the return value of
   Lisp_Object teml;
   Lisp_Object up_event;
   Lisp_Object enable;
-  int speccount = SPECPDL_INDEX ();
+  ptrdiff_t speccount = SPECPDL_INDEX ();
 
   /* The index of the next element of this_command_keys to examine for
      the 'e' interactive code.  */
-  int next_event;
+  ptrdiff_t next_event;
 
   Lisp_Object prefix_arg;
   char *string;
@@ -273,20 +272,18 @@ invoke it.  If KEYS is omitted or nil, the return value of
   signed char *varies;
 
   ptrdiff_t i, nargs;
-  int foo;
-  char prompt1[100];
-  char *tem1;
-  int arg_from_tty = 0;
+  ptrdiff_t mark;
+  bool arg_from_tty = 0;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-  int key_count;
-  int record_then_fail = 0;
+  ptrdiff_t key_count;
+  bool record_then_fail = 0;
 
   Lisp_Object save_this_command, save_last_command;
   Lisp_Object save_this_original_command, save_real_this_command;
 
   save_this_command = Vthis_command;
   save_this_original_command = Vthis_original_command;
-  save_real_this_command = real_this_command;
+  save_real_this_command = Vreal_this_command;
   save_last_command = KVAR (current_kboard, Vlast_command);
 
   if (NILP (keys))
@@ -297,7 +294,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
       key_count = ASIZE (keys);
     }
 
-  /* Save this now, since use of minibuffer will clobber it. */
+  /* Save this now, since use of minibuffer will clobber it.  */
   prefix_arg = Vcurrent_prefix_arg;
 
   if (SYMBOLP (function))
@@ -312,7 +309,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
      The feature is not fully implemented.  */
   filter_specs = Qnil;
 
-  /* If k or K discard an up-event, save it here so it can be retrieved with U */
+  /* If k or K discard an up-event, save it here so it can be retrieved with
+     U.  */
   up_event = Qnil;
 
   /* Set SPECS to the interactive form, or barf if not interactive.  */
@@ -332,7 +330,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
     {
       /* Make a copy of string so that if a GC relocates specs,
         `string' will still be valid.  */
-      string = (char *) alloca (SBYTES (specs) + 1);
+      string = alloca (SBYTES (specs) + 1);
       memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
     }
   else
@@ -372,14 +370,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
       Vthis_command = save_this_command;
       Vthis_original_command = save_this_original_command;
-      real_this_command= save_real_this_command;
-      KVAR (current_kboard, Vlast_command) = save_last_command;
+      Vreal_this_command = save_real_this_command;
+      kset_last_command (current_kboard, save_last_command);
 
       temporarily_switch_to_single_kboard (NULL);
       return unbind_to (speccount, apply1 (function, specs));
     }
 
-  /* Here if function specifies a string to control parsing the defaults */
+  /* Here if function specifies a string to control parsing the defaults */
 
   /* Set next_event to point to the first event with parameters.  */
   for (next_event = 0; next_event < key_count; next_event++)
@@ -466,13 +464,13 @@ 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);
 
-  args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
-  visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
-  varies = (signed char *) alloca (nargs);
+  args = alloca (nargs * sizeof *args);
+  visargs = alloca (nargs * sizeof *visargs);
+  varies = alloca (nargs * sizeof *varies);
 
   for (i = 0; i < nargs; i++)
     {
@@ -491,60 +489,55 @@ invoke it.  If KEYS is omitted or nil, the return value of
   tem = string;
   for (i = 1; *tem; i++)
     {
-      strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
-      prompt1[sizeof prompt1 - 1] = 0;
-      tem1 = strchr (prompt1, '\n');
-      if (tem1) *tem1 = 0;
-
-      visargs[0] = build_string (prompt1);
-      if (strchr (prompt1, '%'))
+      visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n"));
+      if (strchr (SSDATA (visargs[0]), '%'))
        callint_message = Fformat (i, visargs);
       else
        callint_message = visargs[0];
 
       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 */
+         /* 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;
@@ -556,35 +549,35 @@ 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.  */
          {
-           int speccount1 = SPECPDL_INDEX ();
+           ptrdiff_t speccount1 = SPECPDL_INDEX ();
            specbind (Qcursor_in_echo_area, Qt);
            /* Prompt in `minibuffer-prompt' face.  */
            Fput_text_property (make_number (0),
@@ -614,9 +607,9 @@ 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.  */
          {
-           int speccount1 = SPECPDL_INDEX ();
+           ptrdiff_t speccount1 = SPECPDL_INDEX ();
            specbind (Qcursor_in_echo_area, Qt);
            /* Prompt in `minibuffer-prompt' face.  */
            Fput_text_property (make_number (0),
@@ -646,7 +639,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);
@@ -686,12 +679,12 @@ 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;
+           bool first = 1;
            do
              {
                Lisp_Object str;
@@ -721,22 +714,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;
 
@@ -749,29 +742,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
-                                  user-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 */
+       case 'x':               /* Lisp expression read but not evaluated */
          args[i] = Fread_minibuffer (callint_message, Qnil);
          visargs[i] = last_minibuf_string;
          break;
 
-       case 'X':               /* Lisp expression read and evaluated */
+       case 'X':               /* Lisp expression read and evaluated */
          args[i] = Feval_minibuffer (callint_message, Qnil);
          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;
@@ -785,7 +778,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;
@@ -848,8 +841,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   Vthis_command = save_this_command;
   Vthis_original_command = save_this_original_command;
-  real_this_command= save_real_this_command;
-  KVAR (current_kboard, Vlast_command) = save_last_command;
+  Vreal_this_command = save_real_this_command;
+  kset_last_command (current_kboard, save_last_command);
 
   {
     Lisp_Object val;
@@ -894,10 +887,11 @@ syms_of_callint (void)
   callint_message = Qnil;
   staticpro (&callint_message);
 
-  preserved_fns = pure_cons (intern_c_string ("region-beginning"),
-                        pure_cons (intern_c_string ("region-end"),
-                               pure_cons (intern_c_string ("point"),
-                                      pure_cons (intern_c_string ("mark"), Qnil))));
+  preserved_fns = listn (CONSTYPE_PURE, 4,
+                        intern_c_string ("region-beginning"),
+                        intern_c_string ("region-end"),
+                        intern_c_string ("point"),
+                        intern_c_string ("mark"));
 
   DEFSYM (Qlist, "list");
   DEFSYM (Qlet, "let");
@@ -952,7 +946,7 @@ may be set by the debugger as a reminder for itself.  */);
   Vcommand_debug_status = Qnil;
 
   DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
-              doc: /* *Non-nil means you can use the mark even when inactive.
+              doc: /* Non-nil means you can use the mark even when inactive.
 This option makes a difference in Transient Mark mode.
 When the option is non-nil, deactivation of the mark
 turns off region highlighting, but commands that use the mark