#include <config.h>
#include <stdio.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
#undef NULL
#include "lisp.h"
#include "commands.h"
when Emacs starts up. t means don't record anything here. */
Lisp_Object Vdefine_key_rebound_commands;
-Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
+Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
/* A char with the CHAR_META bit set in a vector or the 0200 bit set
in a string key sequence is equivalent to prefixing with this
static Lisp_Object describe_buffer_bindings ();
static void describe_command (), describe_translation ();
static void describe_map ();
-Lisp_Object Fcopy_keymap ();
\f
/* Keymap object support - constructors and predicates. */
DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
- "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
-VECTOR is a vector which holds the bindings for the ASCII\n\
+ "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
+CHARTABLE is a char-table that holds the bindings for the ASCII\n\
characters. ALIST is an assoc-list which holds bindings for function keys,\n\
mouse events, and any other things that appear in the input stream.\n\
All entries in it are initially nil, meaning \"command undefined\".\n\n\
/* SUBMAP is a cons that we found as a key binding.
Discard the other things found in a menu key binding. */
- if (CONSP (submap)
- && STRINGP (XCONS (submap)->car))
+ if (CONSP (submap))
{
- submap = XCONS (submap)->cdr;
- /* Also remove a menu help string, if any,
- following the menu item name. */
- if (CONSP (submap) && STRINGP (XCONS (submap)->car))
- submap = XCONS (submap)->cdr;
- /* Also remove the sublist that caches key equivalences, if any. */
- if (CONSP (submap)
- && CONSP (XCONS (submap)->car))
+ /* May be an old format menu item */
+ if (STRINGP (XCONS (submap)->car))
{
- Lisp_Object carcar;
- carcar = XCONS (XCONS (submap)->car)->car;
- if (NILP (carcar) || VECTORP (carcar))
+ submap = XCONS (submap)->cdr;
+ /* Also remove a menu help string, if any,
+ following the menu item name. */
+ if (CONSP (submap) && STRINGP (XCONS (submap)->car))
submap = XCONS (submap)->cdr;
+ /* Also remove the sublist that caches key equivalences, if any. */
+ if (CONSP (submap)
+ && CONSP (XCONS (submap)->car))
+ {
+ Lisp_Object carcar;
+ carcar = XCONS (XCONS (submap)->car)->car;
+ if (NILP (carcar) || VECTORP (carcar))
+ submap = XCONS (submap)->cdr;
+ }
+ }
+
+ /* Or a new format menu item */
+ else if (EQ (XCONS (submap)->car, Qmenu_item)
+ && CONSP (XCONS (submap)->cdr))
+ {
+ submap = XCONS (XCONS (submap)->cdr)->cdr;
+ if (CONSP (submap))
+ submap = XCONS (submap)->car;
}
}
object = access_keymap (map, key, 0, 0);
}
+ else if (!(CONSP (object)))
+ /* This is really the value. */
+ return object;
+
/* If the keymap contents looks like (STRING . DEFN),
use DEFN.
Keymap alist elements like (CHAR MENUSTRING . DEFN)
will be used by HierarKey menus. */
- else if (CONSP (object)
- && STRINGP (XCONS (object)->car))
+ else if (STRINGP (XCONS (object)->car))
{
object = XCONS (object)->cdr;
/* Also remove a menu help string, if any,
}
}
+ /* If the keymap contents looks like (menu-item name . DEFN)
+ or (menu-item name DEFN ...) then use DEFN.
+ This is a new format menu item.
+ */
+ else if (EQ (XCONS (object)->car, Qmenu_item)
+ && CONSP (XCONS (object)->cdr))
+ {
+ object = XCONS (XCONS (object)->cdr)->cdr;
+ if (CONSP (object))
+ object = XCONS (object)->car;
+ }
+
else
/* Anything else is really the value. */
return object;
register Lisp_Object def;
{
/* If we are preparing to dump, and DEF is a menu element
- with a menu item string, copy it to ensure it is not pure. */
- if (CONSP (def) && PURE_P (def) && STRINGP (XCONS (def)->car))
+ with a menu item indicator, copy it to ensure it is not pure. */
+ if (CONSP (def) && PURE_P (def)
+ && (EQ (XCONS (def)->car, Qmenu_item) || STRINGP (XCONS (def)->car)))
def = Fcons (XCONS (def)->car, XCONS (def)->cdr);
if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
XVECTOR (elt)->contents[i]
= Fcopy_keymap (XVECTOR (elt)->contents[i]);
}
- else if (CONSP (elt))
+ else if (CONSP (elt) && CONSP (XCONS (elt)->cdr))
{
- /* Skip the optional menu string. */
- if (CONSP (XCONS (elt)->cdr)
- && STRINGP (XCONS (XCONS (elt)->cdr)->car))
- {
- Lisp_Object tem;
+ Lisp_Object tem;
+ tem = XCONS (elt)->cdr;
- /* Copy the cell, since copy-alist didn't go this deep. */
- XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
- XCONS (XCONS (elt)->cdr)->cdr);
+ /* Is this a new format menu item. */
+ if (EQ (XCONS (tem)->car,Qmenu_item))
+ {
+ /* Copy cell with menu-item marker. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
elt = XCONS (elt)->cdr;
-
- /* Also skip the optional menu help string. */
- if (CONSP (XCONS (elt)->cdr)
- && STRINGP (XCONS (XCONS (elt)->cdr)->car))
+ tem = XCONS (elt)->cdr;
+ if (CONSP (tem))
+ {
+ /* Copy cell with menu-item name. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ };
+ if (CONSP (tem))
+ {
+ /* Copy cell with binding and if the binding is a keymap,
+ copy that. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->car;
+ if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
+ XCONS (elt)->car = Fcopy_keymap (tem);
+ tem = XCONS (elt)->cdr;
+ if (CONSP (tem) && CONSP (XCONS (tem)->car))
+ /* Delete cache for key equivalences. */
+ XCONS (elt)->cdr = XCONS (tem)->cdr;
+ }
+ }
+ else
+ {
+ /* It may be an old fomat menu item.
+ Skip the optional menu string.
+ */
+ if (STRINGP (XCONS (tem)->car))
{
- XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
- XCONS (XCONS (elt)->cdr)->cdr);
+ /* Copy the cell, since copy-alist didn't go this deep. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ /* Also skip the optional menu help string. */
+ if (CONSP (tem) && STRINGP (XCONS (tem)->car))
+ {
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ }
+ /* There may also be a list that caches key equivalences.
+ Just delete it for the new keymap. */
+ if (CONSP (tem)
+ && CONSP (XCONS (tem)->car)
+ && (NILP (XCONS (XCONS (tem)->car)->car)
+ || VECTORP (XCONS (XCONS (tem)->car)->car)))
+ XCONS (elt)->cdr = XCONS (tem)->cdr;
}
- /* There may also be a list that caches key equivalences.
- Just delete it for the new keymap. */
- if (CONSP (XCONS (elt)->cdr)
- && CONSP (XCONS (XCONS (elt)->cdr)->car)
- && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
- || VECTORP (tem)))
- XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
+ if (CONSP (elt)
+ && ! SYMBOLP (XCONS (elt)->cdr)
+ && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
+ XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
}
- if (CONSP (elt)
- && ! SYMBOLP (XCONS (elt)->cdr)
- && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
- XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+
}
}
-
+
return copy;
}
\f
return Flist (j, maps);
}
-DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
+DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
"Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
A new sparse keymap is stored as COMMAND's function definition and its value.\n\
If a second optional argument MAPVAR is given, the map is stored as\n\
its value instead of as COMMAND's value; but COMMAND is still defined\n\
-as a function.")
- (command, mapvar)
- Lisp_Object command, mapvar;
+as a function.\n\
+The third optional argument NAME, if given, supplies a menu name\n\
+string for the map. This is required to use the keymap as a menu.")
+ (command, mapvar, name)
+ Lisp_Object command, mapvar, name;
{
Lisp_Object map;
- map = Fmake_sparse_keymap (Qnil);
+ map = Fmake_sparse_keymap (name);
Ffset (command, map);
if (!NILP (mapvar))
Fset (mapvar, map);
}
keys = vector;
}
- else if (!VECTORP (keys))
- keys = wrong_type_argument (Qarrayp, keys);
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
+ if (VECTORP (keys))
+ {
+ /* In effect, this computes
+ (mapconcat 'single-key-description keys " ")
+ but we shouldn't use mapconcat because it can do GC. */
- len = XVECTOR (keys)->size;
- sep = build_string (" ");
- /* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
+ len = XVECTOR (keys)->size;
+ sep = build_string (" ");
+ /* This has one extra element at the end that we don't pass to Fconcat. */
+ args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
- for (i = 0; i < len; i++)
+ for (i = 0; i < len; i++)
+ {
+ args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
+ args[i * 2 + 1] = sep;
+ }
+ }
+ else if (CONSP (keys))
{
- args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
- args[i * 2 + 1] = sep;
+ /* In effect, this computes
+ (mapconcat 'single-key-description keys " ")
+ but we shouldn't use mapconcat because it can do GC. */
+
+ len = XFASTINT (Flength (keys));
+ sep = build_string (" ");
+ /* This has one extra element at the end that we don't pass to Fconcat. */
+ args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
+
+ for (i = 0; i < len; i++)
+ {
+ args[i * 2] = Fsingle_key_description (XCONS (keys)->car);
+ args[i * 2 + 1] = sep;
+ keys = XCONS (keys)->cdr;
+ }
}
+ else
+ keys = wrong_type_argument (Qarrayp, keys);
return Fconcat (len * 2 - 1, args);
}
}
else
{
- *p++ = '\\';
- *p++ = (7 & (c >> 15)) + '0';
- *p++ = (7 & (c >> 12)) + '0';
- *p++ = (7 & (c >> 9)) + '0';
- *p++ = (7 & (c >> 6)) + '0';
- *p++ = (7 & (c >> 3)) + '0';
- *p++ = (7 & (c >> 0)) + '0';
+ unsigned char work[4], *str;
+ int i = CHAR_STRING (c, work, str);
+ bcopy (str, p, i);
+ p += i;
}
return p;
(key)
Lisp_Object key;
{
- char tem[20];
+ if (CONSP (key) && lucid_event_type_list_p (key))
+ key = Fevent_convert_list (key);
key = EVENT_HEAD (key);
if (INTEGERP (key)) /* Normal character */
{
- *push_key_description (XUINT (key), tem) = 0;
- return build_string (tem);
+ unsigned int charset, c1, c2;
+ int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
+
+ if (SINGLE_BYTE_CHAR_P (without_bits))
+ charset = 0;
+ else
+ SPLIT_NON_ASCII_CHAR (without_bits, charset, c1, c2);
+
+ if (charset
+ && ((c1 >= 0 && c1 < 32)
+ || (c2 >= 0 && c2 < 32)))
+ {
+ /* Handle a generic character. */
+ Lisp_Object name;
+ name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
+ CHECK_STRING (name, 0);
+ return concat2 (build_string ("Character set "), name);
+ }
+ else
+ {
+ char tem[20];
+
+ *push_key_description (XUINT (key), tem) = 0;
+ return build_string (tem);
+ }
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
return Fsymbol_name (key);
else
break;
}
- /* If the contents are (STRING ...), reject. */
+ /* If the contents are (menu-item ...) or (STRING ...), reject. */
if (CONSP (definition)
- && STRINGP (XCONS (definition)->car))
+ && (EQ (XCONS (definition)->car,Qmenu_item)
+ || STRINGP (XCONS (definition)->car)))
return Qnil;
}
else
int transl;
int always_title;
{
- Lisp_Object maps, seen, sub_shadows;
+ Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3;
int something = 0;
char *key_heading
key binding\n\
--- -------\n";
- maps = Faccessible_keymaps (startmap, prefix);
+ orig_maps = maps = Faccessible_keymaps (startmap, prefix);
seen = Qnil;
sub_shadows = Qnil;
GCPRO3 (maps, seen, sub_shadows);
sub_shadows = Fcons (shmap, sub_shadows);
}
- describe_map (Fcdr (elt), Fcar (elt),
+ /* Maps we have already listed in this loop shadow this map. */
+ for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
+ {
+ Lisp_Object tem;
+ tem = Fequal (Fcar (XCAR (tail)), prefix);
+ if (! NILP (tem))
+ sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
+ }
+
+ describe_map (Fcdr (elt), prefix,
transl ? describe_translation : describe_command,
partial, sub_shadows, &seen, nomenu);
tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
if (STRINGP (tem2))
insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
- XSTRING (tem2)->size_byte, 0);
+ STRING_BYTES (XSTRING (tem2)), 0);
else
insert ("?", 1);
insert (">", 1);
return apropos_accumulate;
}
\f
+void
syms_of_keymap ()
{
Lisp_Object tem;
Qnon_ascii = intern ("non-ascii");
staticpro (&Qnon_ascii);
+ Qmenu_item = intern ("menu-item");
+ staticpro (&Qmenu_item);
+
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
defsubr (&Sset_keymap_parent);
defsubr (&Sapropos_internal);
}
+void
keys_of_keymap ()
{
Lisp_Object tem;