use dynwind_begin and dynwind_end
[bpt/emacs.git] / src / keymap.c
index 536db77..5b0b874 100644 (file)
@@ -1,5 +1,5 @@
 /* Manipulation of keymaps
-   Copyright (C) 1985-1988, 1993-1995, 1998-2013 Free Software
+   Copyright (C) 1985-1988, 1993-1995, 1998-2014 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -106,6 +106,12 @@ static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
                              Lisp_Object, Lisp_Object, bool, bool);
 static void silly_event_symbol_error (Lisp_Object);
 static Lisp_Object get_keyelt (Lisp_Object, bool);
+
+static void
+CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
+{
+  CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x);
+}
 \f
 /* Keymap object support - constructors and predicates.                        */
 
@@ -123,7 +129,7 @@ in case you use it as a menu with `x-popup-menu'.  */)
 {
   Lisp_Object tail;
   if (!NILP (string))
-    tail = Fcons (string, Qnil);
+    tail = list1 (string);
   else
     tail = Qnil;
   return Fcons (Qkeymap,
@@ -145,9 +151,9 @@ in case you use it as a menu with `x-popup-menu'.  */)
     {
       if (!NILP (Vpurify_flag))
        string = Fpurecopy (string);
-      return Fcons (Qkeymap, Fcons (string, Qnil));
+      return list2 (Qkeymap, string);
     }
-  return Fcons (Qkeymap, Qnil);
+  return list1 (Qkeymap);
 }
 
 /* This function is used for installing the standard key bindings
@@ -350,7 +356,7 @@ Return PARENT.  PARENT should be nil or another keymap.  */)
        {
          CHECK_IMPURE (prev);
          XSETCDR (prev, parent);
-         RETURN_UNGCPRO (parent);
+         return parent;
        }
       prev = list;
     }
@@ -528,12 +534,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
              retval = val;
            else if (CONSP (retval_tail))
              {
-               XSETCDR (retval_tail, Fcons (val, Qnil));
+               XSETCDR (retval_tail, list1 (val));
                retval_tail = XCDR (retval_tail);
              }
            else
              {
-               retval_tail = Fcons (val, Qnil);
+               retval_tail = list1 (val);
                retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
              }
          }
@@ -566,7 +572,7 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
   if (!NILP (val))
     {
       map_keymap_function_t fun
-       = (map_keymap_function_t) XSAVE_POINTER (args, 0);
+       = (map_keymap_function_t) XSAVE_FUNCPOINTER (args, 0);
       /* If the key is a range, make a copy since map_char_table modifies
         it in place.  */
       if (CONSP (key))
@@ -611,8 +617,8 @@ map_keymap_internal (Lisp_Object map,
        }
       else if (CHAR_TABLE_P (binding))
        map_char_table (map_keymap_char_table_item, Qnil, binding,
-                       make_save_value (SAVE_TYPE_PTR_PTR_OBJ,
-                                        fun, data, args));
+                       make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
+                                                  args));
     }
   UNGCPRO;
   return tail;
@@ -1039,9 +1045,9 @@ However, a key definition which is a symbol whose definition is a keymap
 is not copied.  */)
   (Lisp_Object keymap)
 {
-  register Lisp_Object copy, tail;
+  Lisp_Object copy, tail;
   keymap = get_keymap (keymap, 1, 0);
-  copy = tail = Fcons (Qkeymap, Qnil);
+  copy = tail = list1 (Qkeymap);
   keymap = XCDR (keymap);              /* Skip the `keymap' symbol.  */
 
   while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
@@ -1067,7 +1073,7 @@ is not copied.  */)
          else
            elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
        }
-      XSETCDR (tail, Fcons (elt, Qnil));
+      XSETCDR (tail, list1 (elt));
       tail = XCDR (tail);
       keymap = XCDR (keymap);
     }
@@ -1125,7 +1131,7 @@ binding KEY to DEF is added at the front of KEYMAP.  */)
 
   length = XFASTINT (Flength (key));
   if (length == 0)
-    RETURN_UNGCPRO (Qnil);
+    return Qnil;
 
   if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
     Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
@@ -1188,7 +1194,7 @@ binding KEY to DEF is added at the front of KEYMAP.  */)
        message_with_string ("Key sequence contains invalid event %s", c, 1);
 
       if (idx == length)
-       RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
+       return store_in_keymap (keymap, c, def);
 
       cmd = access_keymap (keymap, c, 0, 1, 1);
 
@@ -1281,7 +1287,7 @@ recognize the default bindings, just as `read-key-sequence' does.  */)
 
   length = XFASTINT (Flength (key));
   if (length == 0)
-    RETURN_UNGCPRO (keymap);
+    return keymap;
 
   idx = 0;
   while (1)
@@ -1302,11 +1308,11 @@ recognize the default bindings, just as `read-key-sequence' does.  */)
 
       cmd = access_keymap (keymap, c, t_ok, 0, 1);
       if (idx == length)
-       RETURN_UNGCPRO (cmd);
+       return cmd;
 
       keymap = get_keymap (cmd, 0, 1);
       if (!CONSP (keymap))
-       RETURN_UNGCPRO (make_number (idx));
+       return make_number (idx);
 
       QUIT;
     }
@@ -1335,8 +1341,7 @@ append_key (Lisp_Object key_sequence, Lisp_Object key)
   Lisp_Object args[2];
 
   args[0] = key_sequence;
-
-  args[1] = Fcons (key, Qnil);
+  args[1] = list1 (key);
   return Fvconcat (2, args);
 }
 
@@ -1378,9 +1383,7 @@ silly_event_symbol_error (Lisp_Object c)
       c = reorder_modifiers (c);
       keystring = concat2 (build_string (new_mods), XCDR (assoc));
 
-      error ((modifiers & ~meta_modifier
-             ? "To bind the key %s, use [?%s], not [%s]"
-             : "To bind the key %s, use \"%s\", not [%s]"),
+      error ("To bind the key %s, use [?%s], not [%s]",
             SDATA (SYMBOL_NAME (c)), SDATA (keystring),
             SDATA (SYMBOL_NAME (c)));
     }
@@ -1474,26 +1477,26 @@ 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 = malloc (allocsize);
+               newmodes = xmalloc_unsafe (allocsize);
                if (newmodes)
                  {
                    if (cmm_modes)
                      {
                        memcpy (newmodes, cmm_modes,
                                cmm_size * sizeof cmm_modes[0]);
-                       free (cmm_modes);
+                       xfree (cmm_modes);
                      }
                    cmm_modes = newmodes;
                  }
 
-               newmaps = malloc (allocsize);
+               newmaps = xmalloc_unsafe (allocsize);
                if (newmaps)
                  {
                    if (cmm_maps)
                      {
                        memcpy (newmaps, cmm_maps,
                                cmm_size * sizeof cmm_maps[0]);
-                       free (cmm_maps);
+                       xfree (cmm_maps);
                      }
                    cmm_maps = newmaps;
                  }
@@ -1541,9 +1544,9 @@ 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)
 {
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 
-  Lisp_Object keymaps = Fcons (current_global_map, Qnil);
+  Lisp_Object keymaps = list1 (current_global_map);
 
   /* If a mouse click position is given, our variables are based on
      the buffer clicked on, not the current buffer.  So we may have to
@@ -1659,7 +1662,7 @@ like in the respective argument of `key-binding'.  */)
        keymaps = Fcons (otlp, keymaps);
     }
 
-  unbind_to (count, Qnil);
+  dynwind_end ();
 
   return keymaps;
 }
@@ -1803,7 +1806,7 @@ bindings; see the description of `lookup-key' for more details about this.  */)
        if (KEYMAPP (binding))
          maps[j++] = Fcons (modes[i], binding);
        else if (j == 0)
-         RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
+         return list1 (Fcons (modes[i], binding));
       }
 
   UNGCPRO;
@@ -1889,7 +1892,7 @@ struct accessible_keymaps_data {
 
 static void
 accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
-/* Use void* data to be compatible with map_keymap_function_t.  */
+/* Use void * data to be compatible with map_keymap_function_t.  */
 {
   struct accessible_keymaps_data *d = data; /* Cast! */
   Lisp_Object maps = d->maps;
@@ -1945,7 +1948,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
   else
     {
       tem = append_key (thisseq, key);
-      nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
+      nconc2 (tail, list1 (Fcons (tem, cmd)));
     }
 }
 
@@ -1999,13 +2002,13 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
                }
              prefix = copy;
            }
-         maps = Fcons (Fcons (prefix, tem), Qnil);
+         maps = list1 (Fcons (prefix, tem));
        }
       else
        return Qnil;
     }
   else
-    maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
+    maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0)));
 
   /* For each map in the list maps,
      look at any other maps it points to,
@@ -2613,7 +2616,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
   if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
     keymaps = keymap;
   else if (!NILP (keymap))
-    keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
+    keymaps = list2 (keymap, current_global_map);
   else
     keymaps = Fcurrent_active_maps (Qnil, Qnil);
 
@@ -2644,11 +2647,11 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
       /* We have a list of advertised bindings.  */
       while (CONSP (tem))
        if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
-         RETURN_UNGCPRO (XCAR (tem));
+         return XCAR (tem);
        else
          tem = XCDR (tem);
       if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
-       RETURN_UNGCPRO (tem);
+       return tem;
     }
 
   sequences = Freverse (where_is_internal (definition, keymaps,
@@ -2717,10 +2720,10 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
         nil, then we should return the first ascii-only binding
         we find.  */
       if (EQ (firstonly, Qnon_ascii))
-       RETURN_UNGCPRO (sequence);
+       return sequence;
       else if (!NILP (firstonly)
               && 2 == preferred_sequence_p (sequence))
-       RETURN_UNGCPRO (sequence);
+       return sequence;
     }
 
   UNGCPRO;
@@ -3244,8 +3247,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
   for (tail = map; CONSP (tail); tail = XCDR (tail))
     length_needed++;
 
-  vect = ((struct describe_map_elt *)
-         alloca (sizeof (struct describe_map_elt) * length_needed));
+  vect = alloca (length_needed * sizeof *vect);
 
   for (tail = map; CONSP (tail); tail = XCDR (tail))
     {
@@ -3379,9 +3381,12 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
 
       if (vect[i].shadowed)
        {
-         SET_PT (PT - 1);
+         ptrdiff_t pt = max (PT - 1, BEG);
+
+         SET_PT (pt);
          insert_string ("\n  (that binding is currently shadowed by another mode)");
-         SET_PT (PT + 1);
+         pt = min (PT + 1, Z);
+         SET_PT (pt);
        }
     }
 
@@ -3402,7 +3407,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)
 {
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
   if (NILP (describer))
     describer = intern ("princ");
   specbind (Qstandard_output, Fcurrent_buffer ());
@@ -3410,7 +3415,8 @@ DESCRIBER is the output function used; nil means use `princ'.  */)
   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
                   Qnil, Qnil, 0, 0);
 
-  return unbind_to (count, Qnil);
+  dynwind_end ();
+  return Qnil;
 }
 
 /* Insert in the current buffer a description of the contents of VECTOR.
@@ -3675,6 +3681,8 @@ Return list of symbols found.  */)
 void
 syms_of_keymap (void)
 {
+#include "keymap.x"
+
   DEFSYM (Qkeymap, "keymap");
   staticpro (&apropos_predicate);
   staticpro (&apropos_accumulate);
@@ -3746,7 +3754,7 @@ it is provided for major modes to bind locally.  */);
   Vminor_mode_overriding_map_alist = Qnil;
 
   DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists,
-              doc: /* List of keymap alists to use for emulations modes.
+              doc: /* List of keymap alists to use for emulation modes.
 It is intended for modes or packages using multiple minor-mode keymaps.
 Each element is a keymap alist just like `minor-mode-map-alist', or a
 symbol with a variable binding which is a keymap alist, and it is used
@@ -3790,38 +3798,6 @@ be preferred.  */);
   where_is_cache = Qnil;
   staticpro (&where_is_cache);
   staticpro (&where_is_cache_keymaps);
-
-  defsubr (&Skeymapp);
-  defsubr (&Skeymap_parent);
-  defsubr (&Skeymap_prompt);
-  defsubr (&Sset_keymap_parent);
-  defsubr (&Smake_keymap);
-  defsubr (&Smake_sparse_keymap);
-  defsubr (&Smap_keymap_internal);
-  defsubr (&Smap_keymap);
-  defsubr (&Scopy_keymap);
-  defsubr (&Scommand_remapping);
-  defsubr (&Skey_binding);
-  defsubr (&Slocal_key_binding);
-  defsubr (&Sglobal_key_binding);
-  defsubr (&Sminor_mode_key_binding);
-  defsubr (&Sdefine_key);
-  defsubr (&Slookup_key);
-  defsubr (&Sdefine_prefix_command);
-  defsubr (&Suse_global_map);
-  defsubr (&Suse_local_map);
-  defsubr (&Scurrent_local_map);
-  defsubr (&Scurrent_global_map);
-  defsubr (&Scurrent_minor_mode_maps);
-  defsubr (&Scurrent_active_maps);
-  defsubr (&Saccessible_keymaps);
-  defsubr (&Skey_description);
-  defsubr (&Sdescribe_vector);
-  defsubr (&Ssingle_key_description);
-  defsubr (&Stext_char_description);
-  defsubr (&Swhere_is_internal);
-  defsubr (&Sdescribe_buffer_bindings);
-  defsubr (&Sapropos_internal);
 }
 
 void