Simplify redefinition of 'abort' (Bug#12316).
[bpt/emacs.git] / src / keymap.c
index 5b5faec..d79ff89 100644 (file)
@@ -43,8 +43,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <setjmp.h>
 #include "lisp.h"
 #include "commands.h"
-#include "buffer.h"
 #include "character.h"
+#include "buffer.h"
 #include "charset.h"
 #include "keyboard.h"
 #include "frame.h"
@@ -92,7 +92,6 @@ static Lisp_Object where_is_cache;
 /* Which keymaps are reverse-stored in the cache.  */
 static Lisp_Object where_is_cache_keymaps;
 
-static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
 static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
 
 static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
@@ -226,7 +225,7 @@ when reading a key-sequence to be looked-up in this keymap.  */)
    Fdefine_key should cause keymaps to be autoloaded.
 
    This function can GC when AUTOLOAD is non-zero, because it calls
-   do_autoload which can GC.  */
+   Fautoload_do_load which can GC.  */
 
 Lisp_Object
 get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
@@ -260,7 +259,7 @@ get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
                  struct gcpro gcpro1, gcpro2;
 
                  GCPRO2 (tem, object);
-                 do_autoload (tem, object);
+                 Fautoload_do_load (tem, object, Qnil);
                  UNGCPRO;
 
                  goto autoload_retry;
@@ -956,8 +955,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
   return def;
 }
 
-static Lisp_Object Fcopy_keymap (Lisp_Object);
-
 static Lisp_Object
 copy_keymap_item (Lisp_Object elt)
 {
@@ -1117,12 +1114,12 @@ binding is altered.  If there is no binding for KEY, the new pair
 binding KEY to DEF is added at the front of KEYMAP.  */)
   (Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
 {
-  register int idx;
+  register ptrdiff_t idx;
   register Lisp_Object c;
   register Lisp_Object cmd;
   int metized = 0;
   int meta_bit;
-  int length;
+  ptrdiff_t length;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   GCPRO3 (keymap, key, def);
@@ -1143,7 +1140,7 @@ binding KEY to DEF is added at the front of KEYMAP.  */)
   if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
     { /* DEF is apparently an XEmacs-style keyboard macro.  */
       Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
-      int i = ASIZE (def);
+      ptrdiff_t i = ASIZE (def);
       while (--i >= 0)
        {
          Lisp_Object defi = AREF (def, i);
@@ -1274,10 +1271,10 @@ third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
 recognize the default bindings, just as `read-key-sequence' does.  */)
   (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
 {
-  register int idx;
+  register ptrdiff_t idx;
   register Lisp_Object cmd;
   register Lisp_Object c;
-  int length;
+  ptrdiff_t length;
   int t_ok = !NILP (accept_default);
   struct gcpro gcpro1, gcpro2;
 
@@ -1481,7 +1478,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
                /* Use malloc here.  See the comment above this function.
                   Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
                BLOCK_INPUT;
-               newmodes = (Lisp_Object *) malloc (allocsize);
+               newmodes = malloc (allocsize);
                if (newmodes)
                  {
                    if (cmm_modes)
@@ -1493,7 +1490,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
                    cmm_modes = newmodes;
                  }
 
-               newmaps = (Lisp_Object *) malloc (allocsize);
+               newmaps = malloc (allocsize);
                if (newmaps)
                  {
                    if (cmm_maps)
@@ -1527,6 +1524,19 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
   return i;
 }
 
+/* Return the offset of POSITION, a click position, in the style of
+   the respective argument of Fkey_binding.  */
+static ptrdiff_t
+click_position (Lisp_Object position)
+{
+  EMACS_INT pos = (INTEGERP (position) ? XINT (position)
+                  : MARKERP (position) ? marker_position (position)
+                  : PT);
+  if (! (BEGV <= pos && pos <= ZV))
+    args_out_of_range (Fcurrent_buffer (), position);
+  return pos;
+}
+
 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
        0, 2, 0,
        doc: /* Return a list of the currently active keymaps.
@@ -1535,7 +1545,7 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and
 like in the respective argument of `key-binding'. */)
   (Lisp_Object olp, Lisp_Object position)
 {
-  int count = SPECPDL_INDEX ();
+  ptrdiff_t count = SPECPDL_INDEX ();
 
   Lisp_Object keymaps = Fcons (current_global_map, Qnil);
 
@@ -1560,9 +1570,7 @@ like in the respective argument of `key-binding'. */)
             would not be a problem here, but it is easier to keep
             things the same.
          */
-
-         record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
-
+         record_unwind_current_buffer ();
          set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
        }
     }
@@ -1582,10 +1590,7 @@ like in the respective argument of `key-binding'. */)
     {
       Lisp_Object *maps;
       int nmaps, i;
-      EMACS_INT pt
-       = INTEGERP (position) ? XINT (position)
-       : MARKERP (position) ? marker_position (position)
-       : PT;
+      ptrdiff_t pt = click_position (position);
       /* This usually returns the buffer's local map,
         but that can be overridden by a `local-map' property.  */
       Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
@@ -1847,7 +1852,7 @@ If KEYMAP is nil, that means no local keymap.  */)
   if (!NILP (keymap))
     keymap = get_keymap (keymap, 1, 1);
 
-  BVAR (current_buffer, keymap) = keymap;
+  bset_keymap (current_buffer, keymap);
 
   return Qnil;
 }
@@ -1904,10 +1909,10 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
   while (!NILP (tem = Frassq (cmd, maps)))
     {
       Lisp_Object prefix = XCAR (tem);
-      int lim = XINT (Flength (XCAR (tem)));
+      ptrdiff_t lim = XINT (Flength (XCAR (tem)));
       if (lim <= XINT (Flength (thisseq)))
        { /* This keymap was already seen with a smaller prefix.  */
-         int i = 0;
+         ptrdiff_t i = 0;
          while (i < lim && EQ (Faref (prefix, make_number (i)),
                                Faref (thisseq, make_number (i))))
            i++;
@@ -1960,7 +1965,7 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
   (Lisp_Object keymap, Lisp_Object prefix)
 {
   Lisp_Object maps, tail;
-  int prefixlen = XINT (Flength (prefix));
+  EMACS_INT prefixlen = XFASTINT (Flength (prefix));
 
   /* no need for gcpro because we don't autoload any keymaps.  */
 
@@ -2003,9 +2008,7 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
        return Qnil;
     }
   else
-    maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
-                        get_keymap (keymap, 1, 0)),
-                 Qnil);
+    maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
 
   /* For each map in the list maps,
      look at any other maps it points to,
@@ -2043,24 +2046,30 @@ static Lisp_Object Qsingle_key_description, Qkey_description;
 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
        doc: /* Return a pretty description of key-sequence KEYS.
 Optional arg PREFIX is the sequence of keys leading up to KEYS.
-Control characters turn into "C-foo" sequences, meta into "M-foo",
-spaces are put between sequence elements, etc.  */)
+For example, [?\C-x ?l] is converted into the string \"C-x l\".
+
+The `kbd' macro is an approximate inverse of this.  */)
   (Lisp_Object keys, Lisp_Object prefix)
 {
-  int len = 0;
-  int i, i_byte;
+  ptrdiff_t len = 0;
+  EMACS_INT i;
+  ptrdiff_t i_byte;
   Lisp_Object *args;
-  int size = XINT (Flength (keys));
+  EMACS_INT size = XINT (Flength (keys));
   Lisp_Object list;
   Lisp_Object sep = build_string (" ");
   Lisp_Object key;
+  Lisp_Object result;
   int add_meta = 0;
+  USE_SAFE_ALLOCA;
 
   if (!NILP (prefix))
     size += XINT (Flength (prefix));
 
   /* This has one extra element at the end that we don't pass to Fconcat.  */
-  args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
+  if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size)
+    memory_full (SIZE_MAX);
+  SAFE_ALLOCA_LISP (args, size * 4);
 
   /* In effect, this computes
      (mapconcat 'single-key-description keys " ")
@@ -2076,11 +2085,14 @@ spaces are put between sequence elements, etc.  */)
       if (add_meta)
        {
          args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
-         len += 2;
+         result = Fconcat (len + 1, args);
        }
       else if (len == 0)
-       return empty_unibyte_string;
-      return Fconcat (len - 1, args);
+       result = empty_unibyte_string;
+      else
+       result = Fconcat (len - 1, args);
+      SAFE_FREE ();
+      return result;
     }
 
   if (STRINGP (list))
@@ -2127,7 +2139,7 @@ spaces are put between sequence elements, etc.  */)
                continue;
            }
          else
-           XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+           XSETINT (key, XINT (key) | meta_modifier);
          add_meta = 0;
        }
       else if (EQ (key, meta_prefix_char))
@@ -2145,7 +2157,7 @@ spaces are put between sequence elements, etc.  */)
 char *
 push_key_description (EMACS_INT ch, char *p, int force_multibyte)
 {
-  int c, c2;
+  int c, c2, tab_as_ci;
 
   /* Clear all the meaningless bits above the meta bit.  */
   c = ch & (meta_modifier | ~ - meta_modifier);
@@ -2159,6 +2171,8 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
       return p;
     }
 
+  tab_as_ci = (c2 == '\t' && (c & meta_modifier));
+
   if (c & alt_modifier)
     {
       *p++ = 'A';
@@ -2166,7 +2180,8 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
       c -= alt_modifier;
     }
   if ((c & ctrl_modifier) != 0
-      || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
+      || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))
+      || tab_as_ci)
     {
       *p++ = 'C';
       *p++ = '-';
@@ -2204,6 +2219,10 @@ push_key_description (EMACS_INT ch, char *p, int force_multibyte)
          *p++ = 'S';
          *p++ = 'C';
        }
+      else if (tab_as_ci)
+       {
+         *p++ = 'i';
+       }
       else if (c == '\t')
        {
          *p++ = 'T';
@@ -2270,9 +2289,15 @@ around function keys and event symbols.  */)
   if (CONSP (key) && lucid_event_type_list_p (key))
     key = Fevent_convert_list (key);
 
+  if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
+    /* An interval from a map-char-table.  */
+    return concat3 (Fsingle_key_description (XCAR (key), no_angles),
+                   build_string (".."),
+                   Fsingle_key_description (XCDR (key), no_angles));
+
   key = EVENT_HEAD (key);
 
-  if (INTEGERP (key))          /* Normal character */
+  if (INTEGERP (key))          /* Normal character */
     {
       char tem[KEY_DESCRIPTION_SIZE], *p;
 
@@ -2280,15 +2305,14 @@ around function keys and event symbols.  */)
       *p = 0;
       return make_specified_string (tem, -1, p - tem, 1);
     }
-  else if (SYMBOLP (key))      /* Function key or event-symbol */
+  else if (SYMBOLP (key))      /* Function key or event-symbol */
     {
       if (NILP (no_angles))
        {
-         char *buffer;
          Lisp_Object result;
          USE_SAFE_ALLOCA;
-         SAFE_ALLOCA (buffer, char *,
-                      sizeof "<>" + SBYTES (SYMBOL_NAME (key)));
+         char *buffer = SAFE_ALLOCA (sizeof "<>"
+                                     + SBYTES (SYMBOL_NAME (key)));
          esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
          result = build_string (buffer);
          SAFE_FREE ();
@@ -2343,7 +2367,7 @@ See Info node `(elisp)Describing Characters' for examples.  */)
   char str[6];
   int c;
 
-  CHECK_NUMBER (character);
+  CHECK_CHARACTER (character);
 
   c = XINT (character);
   if (!ASCII_CHAR_P (c))
@@ -2366,8 +2390,8 @@ static int where_is_preferred_modifier;
 static int
 preferred_sequence_p (Lisp_Object seq)
 {
-  int i;
-  int len = XINT (Flength (seq));
+  EMACS_INT i;
+  EMACS_INT len = XFASTINT (Flength (seq));
   int result = 1;
 
   for (i = 0; i < len; i++)
@@ -2546,7 +2570,8 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
        doc: /* Return list of keys that invoke DEFINITION.
 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
-If KEYMAP is nil, search all the currently active keymaps.
+If KEYMAP is nil, search all the currently active keymaps, except
+ for `overriding-local-map' (which is ignored).
 If KEYMAP is a list of keymaps, search only those keymaps.
 
 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
@@ -2561,9 +2586,17 @@ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
 to other keymaps or slots.  This makes it possible to search for an
 indirect definition itself.
 
-If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
-that invoke a command which is remapped to DEFINITION, but include the
-remapped command in the returned list.  */)
+The optional 5th arg NO-REMAP alters how command remapping is handled:
+
+- If another command OTHER-COMMAND is remapped to DEFINITION, normally
+  search for the bindings of OTHER-COMMAND and include them in the
+  returned list.  But if NO-REMAP is non-nil, include the vector
+  [remap OTHER-COMMAND] in the returned list instead, without
+  searching for those other bindings.
+
+- If DEFINITION is remapped to OTHER-COMMAND, normally return the
+  bindings for OTHER-COMMAND.  But if NO-REMAP is non-nil, return the
+  bindings for DEFINITION instead, ignoring its remapping.  */)
   (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
 {
   /* The keymaps in which to search.  */
@@ -2890,9 +2923,9 @@ You type        Translation\n\
          char *title, *p;
 
          if (!SYMBOLP (modes[i]))
-           abort ();
+           emacs_abort ();
 
-         p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
+         p = title = alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
          *p++ = '\f';
          *p++ = '\n';
          *p++ = '`';
@@ -2962,9 +2995,9 @@ You type        Translation\n\
    If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
    don't omit it; instead, mention it but say it is shadowed.
 
-   Return whether something was inserted or not.  */
+   Any inserted text ends in two newlines (used by `help-make-xrefs').  */
 
-int
+void
 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
                   Lisp_Object prefix, const char *title, int nomenu, int transl,
                   int always_title, int mention_shadow)
@@ -3074,8 +3107,10 @@ key             binding\n\
     skip: ;
     }
 
+  if (something)
+    insert_string ("\n");
+
   UNGCPRO;
-  return something;
 }
 
 static int previous_description_column;
@@ -3084,7 +3119,7 @@ static void
 describe_command (Lisp_Object definition, Lisp_Object args)
 {
   register Lisp_Object tem1;
-  EMACS_INT column = current_column ();
+  ptrdiff_t column = current_column ();
   int description_column;
 
   /* If column 16 is no good, go to col 32;
@@ -3367,7 +3402,7 @@ This is text showing the elements of vector matched against indices.
 DESCRIBER is the output function used; nil means use `princ'.  */)
   (Lisp_Object vector, Lisp_Object describer)
 {
-  int count = SPECPDL_INDEX ();
+  ptrdiff_t count = SPECPDL_INDEX ();
   if (NILP (describer))
     describer = intern ("princ");
   specbind (Qstandard_output, Fcurrent_buffer ());
@@ -3671,13 +3706,12 @@ syms_of_keymap (void)
   Fset (intern_c_string ("ctl-x-map"), control_x_map);
   Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
 
-  exclude_keys
-    = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
-                pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
-                   pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
-                          pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
-                                 pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
-                                        Qnil)))));
+  exclude_keys = listn (CONSTYPE_PURE, 5,
+                       pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
+                       pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
+                       pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
+                       pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
+                       pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
   staticpro (&exclude_keys);
 
   DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
@@ -3730,16 +3764,16 @@ be preferred.  */);
   where_is_preferred_modifier = 0;
 
   staticpro (&Vmouse_events);
-  Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
-                 pure_cons (intern_c_string ("tool-bar"),
-                 pure_cons (intern_c_string ("header-line"),
-                 pure_cons (intern_c_string ("mode-line"),
-                 pure_cons (intern_c_string ("mouse-1"),
-                 pure_cons (intern_c_string ("mouse-2"),
-                 pure_cons (intern_c_string ("mouse-3"),
-                 pure_cons (intern_c_string ("mouse-4"),
-                 pure_cons (intern_c_string ("mouse-5"),
-                            Qnil)))))))));
+  Vmouse_events = listn (CONSTYPE_PURE, 9,
+                        intern_c_string ("menu-bar"),
+                        intern_c_string ("tool-bar"),
+                        intern_c_string ("header-line"),
+                        intern_c_string ("mode-line"),
+                        intern_c_string ("mouse-1"),
+                        intern_c_string ("mouse-2"),
+                        intern_c_string ("mouse-3"),
+                        intern_c_string ("mouse-4"),
+                        intern_c_string ("mouse-5"));
 
   DEFSYM (Qsingle_key_description, "single-key-description");
   DEFSYM (Qkey_description, "key-description");