Lisp_Object tem;
autoload_retry:
- tem = indirect_function (object);
- if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
- return tem;
+ if (NILP (object))
+ goto end;
+ if (CONSP (object) && EQ (XCAR (object), Qkeymap))
+ return object;
+ else
+ {
+ tem = indirect_function (object);
+ if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
+ return tem;
+ }
/* Should we do an autoload? Autoload forms for keymaps have
Qkeymap as their fifth element. */
}
}
+ end:
if (error)
wrong_type_argument (Qkeymapp, object);
else
{
while (1)
{
- register Lisp_Object map, tem;
+ if (!(CONSP (object)))
+ /* This is really the value. */
+ return object;
- /* If the contents are (KEYMAP . ELEMENT), go indirect. */
- map = get_keymap_1 (Fcar_safe (object), 0, autoload);
- tem = Fkeymapp (map);
- if (!NILP (tem))
+ /* If the keymap contents looks like (keymap ...) or (lambda ...)
+ then use itself. */
+ else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
+ return object;
+
+ /* 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 (XCAR (object), Qmenu_item))
{
- Lisp_Object key;
- key = Fcdr (object);
- if (INTEGERP (key) && (XINT (key) & meta_modifier))
+ if (CONSP (XCDR (object)))
{
- object = access_keymap (map, meta_prefix_char, 0, 0);
- map = get_keymap_1 (object, 0, autoload);
- object = access_keymap (map,
- make_number (XINT (key) & ~meta_modifier),
- 0, 0);
+ object = XCDR (XCDR (object));
+ if (CONSP (object))
+ object = XCAR (object);
}
else
- object = access_keymap (map, key, 0, 0);
+ /* Invalid keymap */
+ return object;
}
- else if (!(CONSP (object)))
- /* This is really the value. */
- return object;
-
- /* If the keymap contents looks like (STRING . DEFN),
- use DEFN.
+ /* 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 (STRINGP (XCONS (object)->car))
+ else if (STRINGP (XCAR (object)))
{
- object = XCONS (object)->cdr;
+ object = XCDR (object);
/* Also remove a menu help string, if any,
following the menu item name. */
- if (CONSP (object) && STRINGP (XCONS (object)->car))
- object = XCONS (object)->cdr;
+ if (CONSP (object) && STRINGP (XCAR (object)))
+ object = XCDR (object);
/* Also remove the sublist that caches key equivalences, if any. */
- if (CONSP (object)
- && CONSP (XCONS (object)->car))
+ if (CONSP (object) && CONSP (XCAR (object)))
{
Lisp_Object carcar;
- carcar = XCONS (XCONS (object)->car)->car;
+ carcar = XCAR (XCAR (object));
if (NILP (carcar) || VECTORP (carcar))
- object = XCONS (object)->cdr;
+ object = XCDR (object);
}
}
- /* 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))
+ /* If the contents are (KEYMAP . ELEMENT), go indirect. */
+ else
{
- object = XCONS (XCONS (object)->cdr)->cdr;
- if (CONSP (object))
- object = XCONS (object)->car;
+ register Lisp_Object map;
+ map = get_keymap_1 (Fcar_safe (object), 0, autoload);
+ if (NILP (map))
+ /* Invalid keymap */
+ return object;
+ else
+ {
+ Lisp_Object key;
+ key = Fcdr (object);
+ if (INTEGERP (key) && (XINT (key) & meta_modifier))
+ {
+ object = access_keymap (map, meta_prefix_char, 0, 0);
+ map = get_keymap_1 (object, 0, autoload);
+ object = access_keymap (map, make_number (XINT (key)
+ & ~meta_modifier),
+ 0, 0);
+ }
+ else
+ object = access_keymap (map, key, 0, 0);
+ }
}
-
- else
- /* Anything else is really the value. */
- return object;
}
}
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);
Lisp_Object copy;
copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
- for (i = 0, i_byte; i < XSTRING (prefix)->size;)
+ for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
{
int i_before = i;
if (STRING_MULTIBYTE (prefix))
FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
else
- c = XSTRING (prefix)->data[i++];
- if (c & 0200)
- c ^= 0200 | meta_modifier;
+ {
+ c = XSTRING (prefix)->data[i++];
+ if (c & 0200)
+ c ^= 0200 | meta_modifier;
+ }
XVECTOR (copy)->contents[i_before] = make_number (c);
}
prefix = copy;
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0; i < XSTRING (keys)->size; )
+ for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
{
int c;
int i_before = i;
if (STRING_MULTIBYTE (keys))
FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
else
- c = XSTRING (keys)->data[i++];
+ {
+ c = XSTRING (keys)->data[i++];
+ if (c & 0200)
+ c ^= 0200 | meta_modifier;
+ }
- if (c & 0x80)
- XSETFASTINT (XVECTOR (vector)->contents[i_before],
- meta_modifier | (c & ~0x80));
- else
- XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
+ XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
}
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);
}
*p++ = 'L';
}
else if (c == ' ')
- {
+ {
*p++ = 'S';
*p++ = 'P';
*p++ = 'C';
}
- else if (c < 128)
+ else if (c < 128
+ || (NILP (current_buffer->enable_multibyte_characters)
+ && SINGLE_BYTE_CHAR_P (c)))
*p++ = c;
- else if (c < 512)
- {
- *p++ = '\\';
- *p++ = (7 & (c >> 6)) + '0';
- *p++ = (7 & (c >> 3)) + '0';
- *p++ = (7 & (c >> 0)) + '0';
- }
else
{
- unsigned char work[4], *str;
- int i = CHAR_STRING (c, work, str);
- bcopy (str, p, i);
- p += i;
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ c = unibyte_char_to_multibyte (c);
+
+ if (NILP (current_buffer->enable_multibyte_characters)
+ || SINGLE_BYTE_CHAR_P (c)
+ || ! char_valid_p (c, 0))
+ {
+ int bit_offset;
+ *p++ = '\\';
+ /* The biggest character code uses 19 bits. */
+ for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
+ {
+ if (c >= (1 << bit_offset))
+ *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
+ }
+ }
+ else
+ {
+ unsigned char work[4], *str;
+ int i = CHAR_STRING (c, work, str);
+ bcopy (str, p, i);
+ p += i;
+ }
}
return p;
(key)
Lisp_Object key;
{
+ if (CONSP (key) && lucid_event_type_list_p (key))
+ key = Fevent_convert_list (key);
+
key = EVENT_HEAD (key);
if (INTEGERP (key)) /* Normal character */
{
unsigned int charset, c1, c2;
+ int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
- if (SINGLE_BYTE_CHAR_P (XINT (key)))
+ if (SINGLE_BYTE_CHAR_P (without_bits))
charset = 0;
else
- SPLIT_NON_ASCII_CHAR (XINT (key), charset, c1, c2);
+ SPLIT_NON_ASCII_CHAR (without_bits, charset, c1, c2);
if (charset
+ && CHARSET_DEFINED_P (charset)
&& ((c1 >= 0 && c1 < 32)
|| (c2 >= 0 && c2 < 32)))
{
HCoop / bpt / emacs.git / blobdiff