#include <config.h>
#include <stdio.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
#undef NULL
#include "lisp.h"
#include "commands.h"
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)
+ if (CONSP (submap))
{
/* May be an old format menu item */
- if STRINGP (XCONS (submap)->car)
+ if (STRINGP (XCONS (submap)->car))
{
submap = XCONS (submap)->cdr;
/* Also remove a menu help string, if any,
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);
}
*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;
(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);
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");
return apropos_accumulate;
}
\f
+void
syms_of_keymap ()
{
Lisp_Object tem;
defsubr (&Sapropos_internal);
}
+void
keys_of_keymap ()
{
Lisp_Object tem;
HCoop / bpt / emacs.git / blobdiff