changeset 93205:29c57be95740

(map_keymap_internal): New fun. (map_keymap): Use it. (Fmap_keymap_internal): New fun. (Fmap_keymap): Remove left-out test from before make_save_value.

--- a/src/ChangeLog	Tue Mar 25 19:42:34 2008 +0000
+++ b/src/ChangeLog	Tue Mar 25 20:12:54 2008 +0000
@@ -1,5 +1,10 @@
 2008-03-25  Stefan Monnier  <[e-mail]>
 
+	* keymap.c (map_keymap_internal): New fun.
+	(map_keymap): Use it.
+	(Fmap_keymap_internal): New fun.
+	(Fmap_keymap): Remove left-out test from before make_save_value.
+
 	* keymap.c (Fmap_keymap): Use `map-keymap-sorted.
 
 	* frame.c (Fmodify_frame_parameters, x_set_frame_parameters):

--- a/src/keymap.c	Tue Mar 25 19:42:34 2008 +0000
+++ b/src/keymap.c	Tue Mar 25 20:12:54 2008 +0000
@@ -660,25 +660,20 @@
     }
 }
 
-/* Call FUN for every binding in MAP.
-   FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
-   AUTOLOAD if non-zero means that we can autoload keymaps if necessary.  */
-void
-map_keymap (map, fun, args, data, autoload)
-     map_keymap_function_t fun;
-     Lisp_Object map, args;
-     void *data;
-     int autoload;
+/* Call FUN for every binding in MAP and stop at (and return) the parent.
+   FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).  */
+Lisp_Object
+map_keymap_internal (Lisp_Object map,
+		     map_keymap_function_t fun,
+		     Lisp_Object args,
+		     void *data)
 {
   struct gcpro gcpro1, gcpro2, gcpro3;
-  Lisp_Object tail;
-
-  tail = Qnil;
+  Lisp_Object tail
+    = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
+
   GCPRO3 (map, args, tail);
-  map = get_keymap (map, 1, autoload);
-  for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
-       CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
-       tail = XCDR (tail))
+  for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
     {
       Lisp_Object binding = XCAR (tail);
 
@@ -705,6 +700,7 @@
 	}
     }
   UNGCPRO;
+  return tail;
 }
 
 static void
@@ -715,13 +711,46 @@
   call2 (fun, key, val);
 }
 
+/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
+   A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded.  */
+void
+map_keymap (map, fun, args, data, autoload)
+     map_keymap_function_t fun;
+     Lisp_Object map, args;
+     void *data;
+     int autoload;
+{
+  struct gcpro gcpro1;
+  GCPRO1 (args);
+  map = get_keymap (map, 1, autoload);
+  while (CONSP (map))
+    {
+      map = map_keymap_internal (map, fun, args, data);
+      map = get_keymap (map, 0, autoload);
+    }
+  UNGCPRO;
+}
+
+DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
+       doc: /* Call FUNCTION once for each event binding in KEYMAP.
+FUNCTION is called with two arguments: the event that is bound, and
+the definition it is bound to.  The event may be a character range.
+If KEYMAP has a parent, this function returns it without processing it.  */)
+     (function, keymap)
+     Lisp_Object function, keymap;
+{
+  struct gcpro gcpro1;
+  GCPRO1 (function);
+  keymap = get_keymap (keymap, 1, 1);
+  keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
+  UNGCPRO;
+  return keymap;
+}
+
 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
        doc: /* Call FUNCTION once for each event binding in KEYMAP.
 FUNCTION is called with two arguments: the event that is bound, and
-the definition it is bound to.  If the event is an integer, it may be
-a generic character (see Info node `(elisp)Splitting Characters'), and
-that means that all actual character events belonging to that generic
-character are bound to the definition.
+the definition it is bound to.  The event may be a character range.
 
 If KEYMAP has a parent, the parent's bindings are included as well.
 This works recursively: if the parent has itself a parent, then the
@@ -730,10 +759,6 @@
      (function, keymap, sort_first)
      Lisp_Object function, keymap, sort_first;
 {
-  if (INTEGERP (function))
-    /* We have to stop integers early since map_keymap gives them special
-       significance.  */
-    xsignal1 (Qinvalid_function, function);
   if (! NILP (sort_first))
     return call2 (intern ("map-keymap-sorted"), function, keymap);
 
@@ -3967,6 +3992,7 @@
   defsubr (&Sset_keymap_parent);
   defsubr (&Smake_keymap);
   defsubr (&Smake_sparse_keymap);
+  defsubr (&Smap_keymap_internal);
   defsubr (&Smap_keymap);
   defsubr (&Scopy_keymap);
   defsubr (&Scommand_remapping);