X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/dfcf069d565c347abf3cb7cec80e6ed8432037ba..b1314e15504ca365f79942dfff08591e5ef553d3:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 8739326a73..1b67338480 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -109,8 +109,8 @@ static void describe_map (); /* 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\ @@ -224,9 +224,16 @@ get_keymap_1 (object, error, autoload) 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. */ @@ -250,6 +257,7 @@ get_keymap_1 (object, error, autoload) } } + end: if (error) wrong_type_argument (Qkeymapp, object); else @@ -545,68 +553,76 @@ get_keyelt (object, autoload) { 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; } } @@ -1357,17 +1373,19 @@ bindings; see the description of `lookup-key' for more details about this.") 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); @@ -1470,15 +1488,17 @@ then the value includes only maps for prefixes that start with PREFIX.") 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; @@ -1702,7 +1722,7 @@ spaces are put between sequence elements, etc.") { 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; @@ -1710,33 +1730,54 @@ spaces are put between sequence elements, etc.") 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); } @@ -1822,29 +1863,40 @@ push_key_description (c, p) *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 { - *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'; + 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; @@ -1858,14 +1910,39 @@ Control characters turn into C-whatever, etc.") (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 + && CHARSET_DEFINED_P (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); @@ -2594,9 +2671,8 @@ describe_command (definition) if (SYMBOLP (definition)) { XSETSTRING (tem1, XSYMBOL (definition)->name); - insert_string ("`"); insert1 (tem1); - insert_string ("'\n"); + insert_string ("\n"); } else if (STRINGP (definition) || VECTORP (definition)) insert_string ("Keyboard Macro\n");