]> code.delx.au - gnu-emacs/blobdiff - src/keymap.c
(Fx_create_frame): Add debugging code.
[gnu-emacs] / src / keymap.c
index 99883415914183ee32a06516236df4ca4f9fd963..f74ee61a08c16f851a391985d76d68de6fa70e9a 100644 (file)
@@ -1,6 +1,7 @@
 /* Manipulation of keymaps
-   Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
-   Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
+                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,8 +17,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
@@ -120,10 +121,11 @@ static void describe_command P_ ((Lisp_Object, Lisp_Object));
 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
 static void describe_map P_ ((Lisp_Object, Lisp_Object,
                              void (*) P_ ((Lisp_Object, Lisp_Object)),
-                             int, Lisp_Object, Lisp_Object*, int));
+                             int, Lisp_Object, Lisp_Object*, int, int));
 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
                                 void (*) (Lisp_Object, Lisp_Object), int,
-                                Lisp_Object, Lisp_Object, int *, int, int));
+                                Lisp_Object, Lisp_Object, int *,
+                                int, int, int));
 static void silly_event_symbol_error P_ ((Lisp_Object));
 \f
 /* Keymap object support - constructors and predicates.                        */
@@ -528,6 +530,10 @@ access_keymap (map, idx, t_ok, noinherit, autoload)
       struct gcpro gcpro1;
       Lisp_Object meta_map;
       GCPRO1 (map);
+      /* A strange value in which Meta is set would cause
+        infinite recursion.  Protect against that.  */
+      if (XINT (meta_prefix_char) & CHAR_META)
+       meta_prefix_char = make_number (27);
       meta_map = get_keymap (access_keymap (map, meta_prefix_char,
                                            t_ok, noinherit, autoload),
                             0, autoload);
@@ -744,7 +750,7 @@ usage: (map-keymap FUNCTION KEYMAP)  */)
     Fsignal (Qinvalid_function, Fcons (function, Qnil));
   if (! NILP (sort_first))
     return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
-      
+
   map_keymap (keymap, map_keymap_call, function, NULL, 1);
   return Qnil;
 }
@@ -759,7 +765,9 @@ usage: (map-keymap FUNCTION KEYMAP)  */)
    remove that.  Also remove a menu help string as second element.
 
    If AUTOLOAD is nonzero, load autoloadable keymaps
-   that are referred to with indirection.  */
+   that are referred to with indirection.
+
+   This can GC because menu_item_eval_property calls Feval.  */
 
 Lisp_Object
 get_keyelt (object, autoload)
@@ -1486,10 +1494,13 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and
 
   if (!NILP (olp))
     {
-      if (!NILP (Voverriding_local_map))
-       keymaps = Fcons (Voverriding_local_map, keymaps);
       if (!NILP (current_kboard->Voverriding_terminal_local_map))
        keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
+      /* The doc said that overriding-terminal-local-map should
+        override overriding-local-map.  The code used them both,
+        but it seems clearer to use just one.  rms, jan 2005.  */
+      else if (!NILP (Voverriding_local_map))
+       keymaps = Fcons (Voverriding_local_map, keymaps);
     }
   if (NILP (XCDR (keymaps)))
     {
@@ -1497,16 +1508,20 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and
       Lisp_Object *maps;
       int nmaps, i;
 
+      /* This usually returns the buffer's local map,
+        but that can be overridden by a `local-map' property.  */
       local = get_local_map (PT, current_buffer, Qlocal_map);
       if (!NILP (local))
        keymaps = Fcons (local, keymaps);
 
+      /* Now put all the minor mode keymaps on the list.  */
       nmaps = current_minor_maps (0, &maps);
 
       for (i = --nmaps; i >= 0; i--)
        if (!NILP (maps[i]))
          keymaps = Fcons (maps[i], keymaps);
 
+      /* This returns nil unless there is a `keymap' property.  */
       local = get_local_map (PT, current_buffer, Qkeymap);
       if (!NILP (local))
        keymaps = Fcons (local, keymaps);
@@ -1647,7 +1662,7 @@ bindings; see the description of `lookup-key' for more details about this.  */)
 
 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
        doc: /* Find the visible minor mode bindings of KEY.
-Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
+Return an alist of pairs (MODENAME . BINDING), where MODENAME is
 the symbol which names the minor mode binding KEY, and BINDING is
 KEY's definition in that mode.  In particular, if KEY has no
 minor-mode bindings, return nil.  If the first binding is a
@@ -2542,6 +2557,19 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
                continue;
 
            record_sequence:
+             /* Don't annoy user with strings from a menu such as
+                Select Paste.  Change them all to "(any string)",
+                so that there seems to be only one menu item
+                to report. */
+             if (! NILP (sequence))
+               {
+                 Lisp_Object tem;
+                 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
+                 if (STRINGP (tem))
+                   Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
+                          build_string ("(any string)"));
+               }
+
              /* It is a true unshadowed match.  Record it, unless it's already
                 been seen (as could happen when inheriting keymaps).  */
              if (NILP (Fmember (sequence, found)))
@@ -2719,7 +2747,7 @@ where_is_internal_2 (args, key, binding)
 }
 
 
-/* This function cannot GC.  */
+/* This function can GC because get_keyelt can.  */
 
 static Lisp_Object
 where_is_internal_1 (binding, key, definition, noindirect, this, last,
@@ -2816,6 +2844,9 @@ You type        Translation\n\
            insert (buf, bufend - buf);
 
            insert ("\n", 1);
+
+           /* Insert calls signal_after_change which may GC. */
+           translate = SDATA (Vkeyboard_translate_table);
          }
 
       insert ("\n", 1);
@@ -2823,7 +2854,7 @@ You type        Translation\n\
 
   if (!NILP (Vkey_translation_map))
     describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
-                      "Key translations", nomenu, 1, 0);
+                      "Key translations", nomenu, 1, 0, 0);
 
 
   /* Print the (major mode) local map.  */
@@ -2836,7 +2867,7 @@ You type        Translation\n\
   if (!NILP (start1))
     {
       describe_map_tree (start1, 1, shadow, prefix,
-                        "\f\nOverriding Bindings", nomenu, 0, 0);
+                        "\f\nOverriding Bindings", nomenu, 0, 0, 0);
       shadow = Fcons (start1, shadow);
     }
   else
@@ -2857,7 +2888,8 @@ You type        Translation\n\
       if (!NILP (start1))
        {
          describe_map_tree (start1, 1, shadow, prefix,
-                            "\f\n`keymap' Property Bindings", nomenu, 0, 0);
+                            "\f\n`keymap' Property Bindings", nomenu,
+                            0, 0, 0);
          shadow = Fcons (start1, shadow);
        }
 
@@ -2885,7 +2917,8 @@ You type        Translation\n\
          p += sizeof (" Minor Mode Bindings") - 1;
          *p = 0;
 
-         describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
+         describe_map_tree (maps[i], 1, shadow, prefix,
+                            title, nomenu, 0, 0, 0);
          shadow = Fcons (maps[i], shadow);
        }
 
@@ -2895,23 +2928,23 @@ You type        Translation\n\
        {
          if (EQ (start1, XBUFFER (buffer)->keymap))
            describe_map_tree (start1, 1, shadow, prefix,
-                              "\f\nMajor Mode Bindings", nomenu, 0, 0);
+                              "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
          else
            describe_map_tree (start1, 1, shadow, prefix,
                               "\f\n`local-map' Property Bindings",
-                              nomenu, 0, 0);
+                              nomenu, 0, 0, 0);
 
          shadow = Fcons (start1, shadow);
        }
     }
 
   describe_map_tree (current_global_map, 1, shadow, prefix,
-                    "\f\nGlobal Bindings", nomenu, 0, 1);
+                    "\f\nGlobal Bindings", nomenu, 0, 1, 0);
 
   /* Print the function-key-map translations under this prefix.  */
   if (!NILP (Vfunction_key_map))
     describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
-                      "\f\nFunction key map translations", nomenu, 1, 0);
+                      "\f\nFunction key map translations", nomenu, 1, 0, 0);
 
   UNGCPRO;
   return Qnil;
@@ -2932,17 +2965,21 @@ You type        Translation\n\
    so print strings and vectors differently.
 
    If ALWAYS_TITLE is nonzero, print the title even if there are no maps
-   to look through.  */
+   to look through.
+
+   If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
+   don't omit it; instead, mention it but say it is shadowed.  */
 
 void
 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
-                  always_title)
+                  always_title, mention_shadow)
      Lisp_Object startmap, shadow, prefix;
      int partial;
      char *title;
      int nomenu;
      int transl;
      int always_title;
+     int mention_shadow;
 {
   Lisp_Object maps, orig_maps, seen, sub_shadows;
   struct gcpro gcpro1, gcpro2, gcpro3;
@@ -3044,7 +3081,7 @@ key             binding\n\
 
       describe_map (Fcdr (elt), prefix,
                    transl ? describe_translation : describe_command,
-                   partial, sub_shadows, &seen, nomenu);
+                   partial, sub_shadows, &seen, nomenu, mention_shadow);
 
     skip: ;
     }
@@ -3124,7 +3161,8 @@ describe_translation (definition, args)
    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
 
 static void
-describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
+describe_map (map, prefix, elt_describer, partial, shadow,
+             seen, nomenu, mention_shadow)
      register Lisp_Object map;
      Lisp_Object prefix;
      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
@@ -3132,6 +3170,7 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
      Lisp_Object shadow;
      Lisp_Object *seen;
      int nomenu;
+     int mention_shadow;
 {
   Lisp_Object tail, definition, event;
   Lisp_Object tem;
@@ -3161,9 +3200,10 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
          || CHAR_TABLE_P (XCAR (tail)))
        describe_vector (XCAR (tail),
                         prefix, Qnil, elt_describer, partial, shadow, map,
-                        (int *)0, 0, 1);
+                        (int *)0, 0, 1, mention_shadow);
       else if (CONSP (XCAR (tail)))
        {
+         int this_shadowed = 0;
          event = XCAR (XCAR (tail));
 
          /* Ignore bindings whose "prefix" are not really valid events.
@@ -3192,7 +3232,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
          if (!NILP (shadow))
            {
              tem = shadow_lookup (shadow, kludge, Qt);
-             if (!NILP (tem)) continue;
+             if (!NILP (tem))
+               {
+                 if (mention_shadow)
+                   this_shadowed = 1;
+                 else
+                   continue;
+               }
            }
 
          tem = Flookup_key (map, kludge, Qt);
@@ -3212,6 +3258,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
             elt_describer will take care of spacing out far enough
             for alignment purposes.  */
          (*elt_describer) (definition, Qnil);
+
+         if (this_shadowed)
+           {
+             SET_PT (PT - 1);
+             insert_string ("  (binding currently shadowed)");
+             SET_PT (PT + 1);
+           }
        }
       else if (EQ (XCAR (tail), Qkeymap))
        {
@@ -3250,7 +3303,7 @@ DESCRIBER is the output function used; nil means use `princ'.  */)
   specbind (Qstandard_output, Fcurrent_buffer ());
   CHECK_VECTOR_OR_CHAR_TABLE (vector);
   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
-                  Qnil, Qnil, (int *)0, 0, 0);
+                  Qnil, Qnil, (int *)0, 0, 0, 0);
 
   return unbind_to (count, Qnil);
 }
@@ -3292,7 +3345,8 @@ DESCRIBER is the output function used; nil means use `princ'.  */)
 static void
 describe_vector (vector, prefix, args, elt_describer,
                 partial, shadow, entire_map,
-                indices, char_table_depth, keymap_p)
+                indices, char_table_depth, keymap_p,
+                mention_shadow)
      register Lisp_Object vector;
      Lisp_Object prefix, args;
      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
@@ -3302,6 +3356,7 @@ describe_vector (vector, prefix, args, elt_describer,
      int *indices;
      int char_table_depth;
      int keymap_p;
+     int mention_shadow;
 {
   Lisp_Object definition;
   Lisp_Object tem2;
@@ -3385,6 +3440,7 @@ describe_vector (vector, prefix, args, elt_describer,
 
   for (i = from; i < to; i++)
     {
+      int this_shadowed = 0;
       QUIT;
 
       if (CHAR_TABLE_P (vector))
@@ -3444,7 +3500,13 @@ describe_vector (vector, prefix, args, elt_describer,
 
          tem = shadow_lookup (shadow, kludge, Qt);
 
-         if (!NILP (tem)) continue;
+         if (!NILP (tem))
+           {
+             if (mention_shadow)
+               this_shadowed = 1;
+             else
+               continue;
+           }
        }
 
       /* Ignore this definition if it is shadowed by an earlier
@@ -3520,7 +3582,8 @@ describe_vector (vector, prefix, args, elt_describer,
          insert ("\n", 1);
          describe_vector (definition, prefix, args, elt_describer,
                           partial, shadow, entire_map,
-                          indices, char_table_depth + 1, keymap_p);
+                          indices, char_table_depth + 1, keymap_p,
+                          mention_shadow);
          continue;
        }
 
@@ -3594,6 +3657,13 @@ describe_vector (vector, prefix, args, elt_describer,
         elt_describer will take care of spacing out far enough
         for alignment purposes.  */
       (*elt_describer) (definition, args);
+
+      if (this_shadowed)
+       {
+         SET_PT (PT - 1);
+         insert_string ("  (binding currently shadowed)");
+         SET_PT (PT + 1);
+       }
     }
 
   /* For (sub) char-table, print `defalt' slot at last.  */