xemacs-beta: src/keymap.c comparison

comparison src/keymap.c @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28

author	cvs
date	Mon, 13 Aug 2007 11:33:38 +0200
parents	84b14dcb0985
children	abe6d1db359e

comparison

equal deleted inserted replaced

-:357dd071b03c
+:8de8e3f6228a
 compatibility.
 Since keymaps are opaque, the only way to extract information from them
 is with the functions lookup-key, key-binding, local-key-binding, and
 global-key-binding, which work just as before, and the new function
-map-keymap, which is roughly analagous to maphash.
+map-keymap, which is roughly analogous to maphash.
 Note that map-keymap perpetuates the illusion that the "bucky" submaps
 don't exist: if you map over a keymap with bucky submaps, it will also
 map over those submaps.  It does not, however, map over other random
 submaps of the keymap, just the bucky ones.
 distinction between ESC and "meta" even more.  "M-x" is no more a two-
 key sequence than "C-x" is.
 */
-typedef struct Lisp_Keymap
+struct Lisp_Keymap
 {
 struct lcrecord_header header;
-Lisp_Object parents;		/* Keymaps to be searched after this one
+Lisp_Object parents;		/* Keymaps to be searched after this one.
-				 *  An ordered list */
+				   An ordered list */
 Lisp_Object prompt;           /* Qnil or a string to print in the minibuffer
-*  when reading from this keymap */
+when reading from this keymap */
 Lisp_Object table;		/* The contents of this keymap */
 Lisp_Object inverse_table;	/* The inverse mapping of the above */
 Lisp_Object default_binding;  /* Use this if no other binding is found
-*  (this overrides parent maps and the
+(this overrides parent maps and the
-*   normal global-map lookup). */
+normal global-map lookup). */
 Lisp_Object sub_maps_cache;	/* Cache of directly inferior keymaps;
 				   This holds an alist, of the key and the
 				   maps, or the modifier bit and the map.
 				   If this is the symbol t, then the cache
-				   needs to be recomputed.
+				   needs to be recomputed. */
-				 */
-int fullness;			/* How many entries there are in this table.
-				   This should be the same as the fullness
-				   of the `table', but hash.c is broken. */
 Lisp_Object name;             /* Just for debugging convenience */
-} Lisp_Keymap;
+};
 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
 /* Actually allocate storage for these variables */
-static Lisp_Object Vcurrent_global_map; /* Always a keymap */
+Lisp_Object Vcurrent_global_map; /* Always a keymap */
 static Lisp_Object Vmouse_grabbed_buffer;
 /* Alist of minor mode variables and keymaps.  */
 static Lisp_Object Qminor_mode_map_alist;
 			  void (*elt_describer) (Lisp_Object, Lisp_Object),
 			  int partial,
 			  Lisp_Object shadow,
 			  int mice_only_p,
 			  Lisp_Object buffer);
+static Lisp_Object keymap_submaps (Lisp_Object keymap);
 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
 /* This function can GC */
 Lisp_Keymap *keymap = XKEYMAP (obj);
 char buf[200];
-int size = XINT (Fkeymap_fullness (obj));
 if (print_readably)
 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
 write_c_string ("#<keymap ", printcharfun);
 if (!NILP (keymap->name))
-print_internal (keymap->name, printcharfun, 1);
+{
-/* #### Yuck!  This is no way to form plural!  --hniksic */
+print_internal (keymap->name, printcharfun, 1);
-sprintf (buf, "%s%d entr%s 0x%x>",
+write_c_string (" ", printcharfun);
-(NILP (keymap->name) ? "" : " "),
+}
-size,
+sprintf (buf, "size %ld 0x%x>",
-((size == 1) ? "y" : "ies"),
+	   (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
-keymap->header.uid);
 write_c_string (buf, printcharfun);
 }
 static const struct lrecord_description keymap_description[] = {
-{ XD_LISP_OBJECT, offsetof(Lisp_Keymap, parents), 6 },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) },
-{ XD_LISP_OBJECT, offsetof(Lisp_Keymap, name), 1 },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) },
 { XD_END }
 };
 /* No need for keymap_equal #### Why not? */
 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
 gcpro1.nvars = 0;
 start_keymap = get_keymap (start_keymap, 1, 1);
 keymap = start_keymap;
 /* Hack special-case parents at top-level */
-tail = ((!NILP (tail)) ? tail : XKEYMAP (keymap)->parents);
+tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
 for (;;)
 {
 Lisp_Object result;
 QUIT;
-result = ((mapper) (keymap, mapper_arg));
+result = mapper (keymap, mapper_arg);
 if (!NILP (result))
 	{
 	  while (CONSP (malloc_bites))
 	    {
-	      struct Lisp_Cons *victim = XCONS (malloc_bites);
+	      Lisp_Cons *victim = XCONS (malloc_bites);
 	      malloc_bites = victim->cdr;
 	      free_cons (victim);
 	    }
 	  UNGCPRO;
 	  return result;
 	      return Qnil;          /* Nothing found */
 	    }
 	  stack_depth--;
 	  if (CONSP (malloc_bites))
 	    {
-	      struct Lisp_Cons *victim = XCONS (malloc_bites);
+	      Lisp_Cons *victim = XCONS (malloc_bites);
 	      tail = victim->car;
 	      malloc_bites = victim->cdr;
 	      free_cons (victim);
 	    }
 	  else
 /* else the list's tail has been modified, so we don't need to
 touch the hash table again (the pointer in there is ok).
 */
 }
+/* Prevent luser from shooting herself in the foot using something like
+(define-key ctl-x-4-map "p" global-map) */
+static void
+check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
+{
+def = get_keymap (def, 0, 0);
+if (KEYMAPP (def))
+{
+Lisp_Object maps;
+if (XKEYMAP (def) == to_keymap)
+	signal_simple_error ("Cyclic keymap definition", def);
+for (maps = keymap_submaps (def);
+	   CONSP (maps);
+	   maps = XCDR (maps))
+	check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
+}
+}
 static void
 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
-		       Lisp_Object value)
+		       Lisp_Object def)
 {
-Lisp_Object prev_value = Fgethash (keysym, keymap->table, Qnil);
+Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
-if (EQ (prev_value, value))
+if (EQ (prev_def, def))
 return;
-if (!NILP (prev_value))
+check_keymap_definition_loop (def, keymap);
+if (!NILP (prev_def))
 keymap_delete_inverse_internal (keymap->inverse_table,
-keysym, prev_value);
+keysym, prev_def);
-if (NILP (value))
+if (NILP (def))
 {
-keymap->fullness--;
-if (keymap->fullness < 0) abort ();
 Fremhash (keysym, keymap->table);
 }
 else
 {
-if (NILP (prev_value))
+Fputhash (keysym, def, keymap->table);
-	keymap->fullness++;
-Fputhash (keysym, value, keymap->table);
 keymap_store_inverse_internal (keymap->inverse_table,
-keysym, value);
+keysym, def);
 }
 keymap_tick++;
 }
 keymap_store (Lisp_Object keymap, CONST struct key_data *key,
 Lisp_Object value)
 {
 Lisp_Object keysym = key->keysym;
 unsigned int modifiers = key->modifiers;
-Lisp_Keymap *k;
+Lisp_Keymap *k = XKEYMAP (keymap);
-if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
+assert ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
-| MOD_ALT | MOD_SHIFT)) != 0)
+			 | MOD_ALT | MOD_SHIFT)) == 0);
-abort ();
-k = XKEYMAP (keymap);
 /* If the keysym is a one-character symbol, use the char code instead. */
 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
-{
+keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
-Lisp_Object run_the_gcc_developers_over_with_a_steamroller =
-	make_char (string_char (XSYMBOL (keysym)->name, 0));
-keysym = run_the_gcc_developers_over_with_a_steamroller;
-}
 if (modifiers & MOD_META)     /* Utterly hateful ESC lossage */
 {
 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
 				     k->table, Qnil);
 keymap->prompt          = Qnil;
 keymap->table           = Qnil;
 keymap->inverse_table   = Qnil;
 keymap->default_binding = Qnil;
 keymap->sub_maps_cache  = Qnil; /* No possible submaps */
-keymap->fullness        = 0;
 keymap->name            = Qnil;
 if (size != 0) /* hack for copy-keymap */
 {
 keymap->table =
 {
 Lisp_Object idx = Fcdr (object);
 struct key_data indirection;
 if (CHARP (idx))
 	{
-	  struct Lisp_Event event;
+	  Lisp_Event event;
 	  event.event_type = empty_event;
 	  character_to_event (XCHAR (idx), &event,
 			      XCONSOLE (Vselected_console), 0, 0);
 	  indirection = event.event.key;
 	}
 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
 new_keymap->parents        = Fcopy_sequence (keymap->parents);
-new_keymap->fullness       = keymap->fullness;
 new_keymap->sub_maps_cache = Qnil; /* No submaps */
 new_keymap->table          = Fcopy_hash_table (keymap->table);
 new_keymap->inverse_table  = Fcopy_hash_table (keymap->inverse_table);
 new_keymap->default_binding = keymap->default_binding;
 /* After copying the inverse map, we need to copy the conses which
 int fullness;
 Lisp_Object sub_maps;
 struct gcpro gcpro1, gcpro2;
 keymap = get_keymap (keymap, 1, 1);
-fullness = XKEYMAP (keymap)->fullness;
+fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
-sub_maps = keymap_submaps (keymap);
 GCPRO2 (keymap, sub_maps);
-for (; !NILP (sub_maps); sub_maps = XCDR (sub_maps))
+for (sub_maps = keymap_submaps (keymap);
+!NILP (sub_maps);
+sub_maps = XCDR (sub_maps))
 {
 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
 	{
-	  Lisp_Object sub_map = XCDR (XCAR (sub_maps));
+	  Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
-	  fullness--; /* don't count bucky maps */
+	  fullness--; /* don't count bucky maps themselves. */
-	  fullness += keymap_fullness (sub_map);
+	  fullness += keymap_fullness (bucky_map);
 	}
 }
 UNGCPRO;
 return fullness;
 }
 	  ("The `shift' modifier may not be applied to ASCII keysyms",
 	   spec);
 }
 else
 {
-signal_simple_error ("Unknown keysym specifier",
+signal_simple_error ("Unknown keysym specifier", *keysym);
-			   *keysym);
 }
 if (SYMBOLP (*keysym))
 {
-char *name = (char *)
+char *name = (char *) string_data (XSYMBOL (*keysym)->name);
-	string_data (XSYMBOL (*keysym)->name);
 /* FSFmacs uses symbols with the printed representation of keysyms in
 	 their names, like 'M-x, and we use the syntax '(meta x).  So, to avoid
 	 confusion, notice the M-x syntax and signal an error - because
 	 otherwise it would be interpreted as a regular keysym, and would even
 static void
 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
 {
 if (CHAR_OR_CHAR_INTP (spec))
 {
-struct Lisp_Event event;
+Lisp_Event event;
 event.event_type = empty_event;
 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
 			  XCONSOLE (Vselected_console), 0, 0);
 returned_value->keysym    = event.event.key.keysym;
 returned_value->modifiers = event.event.key.modifiers;
 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
 }
 int
-event_matches_key_specifier_p (struct Lisp_Event *event,
+event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
-			       Lisp_Object key_specifier)
 {
 Lisp_Object event2;
 int retval;
 struct gcpro gcpro1;
 }
 static int
 meta_prefix_char_p (CONST struct key_data *key)
 {
-struct Lisp_Event event;
+Lisp_Event event;
 event.event_type = key_press_event;
 event.channel = Vselected_console;
 event.event.key.keysym = key->keysym;
 event.event.key.modifiers = key->modifiers;
 		 (define-key my-map "\M-a" 'my-command)
 		 and then perhaps
 		 (defvar my-escape-map (lookup-key my-map "\e"))
 		 if the luser really wants the map in a variable.
 		 */
-	      Lisp_Object mmap;
+	      Lisp_Object meta_map;
 struct gcpro ngcpro1;
 NGCPRO1 (c);
-mmap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
+meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
-XKEYMAP (keymap)->table, Qnil);
+				   XKEYMAP (keymap)->table, Qnil);
-	      if (!NILP (mmap)
+	      if (!NILP (meta_map)
-		  && keymap_fullness (mmap) != 0)
+		  && keymap_fullness (meta_map) != 0)
-		{
+		signal_simple_error_2
-Lisp_Object desc
+		  ("Map contains meta-bindings, can't bind",
-= Fsingle_key_description (Vmeta_prefix_char);
+		   Fsingle_key_description (Vmeta_prefix_char), keymap);
-		  signal_simple_error_2
-		    ("Map contains meta-bindings, can't bind", desc, keymap);
-		}
 NUNGCPRO;
 	    }
 	  else
 	    {
 	      metized = 1;
 	  raw_key2.modifiers = 0;
 	}
 if (metized)
 	{
-	  raw_key1.modifiers  |= MOD_META;
+	  raw_key1.modifiers |= MOD_META;
 	  raw_key2.modifiers |= MOD_META;
 	  metized = 0;
 	}
 /* This crap is to make sure that someone doesn't bind something like
 Lisp_Object accessible_keymaps = Qnil;
 struct accessible_keymaps_closure c;
 c.tail = Qnil;
 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
+keymap = get_keymap (keymap, 1, 1);
 retry:
-keymap = get_keymap (keymap, 1, 1);
 if (NILP (prefix))
-prefix = make_vector (0, Qnil);
+{
-else if (!VECTORP (prefix) || STRINGP (prefix))
+prefix = make_vector (0, Qnil);
-{
+}
-prefix = wrong_type_argument (Qarrayp, prefix);
+else if (VECTORP (prefix) || STRINGP (prefix))
-goto retry;
-}
-else
 {
 int len = XINT (Flength (prefix));
-Lisp_Object def = Flookup_key (keymap, prefix, Qnil);
+Lisp_Object def;
 Lisp_Object p;
 int iii;
 struct gcpro ngcpro1;
+if (len == 0)
+	{
+	  prefix = Qnil;
+	  goto retry;
+	}
+def = Flookup_key (keymap, prefix, Qnil);
 def = get_keymap (def, 0, 1);
 if (!KEYMAPP (def))
 	goto RETURN;
 keymap = def;
 	  XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
 	}
 NUNGCPRO;
 prefix = p;
 }
+else
+{
+prefix = wrong_type_argument (Qarrayp, prefix);
+goto retry;
+}
 accessible_keymaps = list1 (Fcons (prefix, keymap));
-/* For each map in the list maps,
+/* For each map in the list maps, look at any other maps it points
-look at any other maps it points to
+to and stick them at the end if they are not already in the list */
-and stick them at the end if they are not already in the list */
 for (c.tail = accessible_keymaps;
 !NILP (c.tail);
 c.tail = XCDR (c.tail))
 {
 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
 {
 char buf [255];
 if (!EVENTP (key))
 	{
-	  struct Lisp_Event event;
+	  Lisp_Event event;
 	  event.event_type = empty_event;
 	  CHECK_CHAR_COERCE_INT (key);
 	  character_to_event (XCHAR (key), &event,
 			      XCONSOLE (Vselected_console), 0, 1);
 	  format_event_object (buf, &event, 1);
 static void
 format_raw_keys (struct key_data *keys, int count, char *buf)
 {
 int i;
-struct Lisp_Event event;
+Lisp_Event event;
 event.event_type = key_press_event;
 event.channel = Vselected_console;
 for (i = 0; i < count; i++)
 {
 event.event.key.keysym    = keys[i].keysym;

Mercurial > hg > xemacs-beta

comparison src/keymap.c @ 440:8de8e3f6228a r21-2-28