Mercurial > hg > xemacs-beta

comparison src/keymap.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 7e54bd776075
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
19 You should have received a copy of the GNU General Public License 19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to 20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */ 22 Boston, MA 02111-1307, USA. */
23 23
24 /* Synched up with: Not synched with FSF. Substantially different 24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
25 from FSF. */ 25 different from FSF. */
26
26 27
27 #include <config.h> 28 #include <config.h>
28 #include "lisp.h" 29 #include "lisp.h"
29 30
30 #include "buffer.h" 31 #include "buffer.h"
44 parents Ordered list of keymaps to search after 45 parents Ordered list of keymaps to search after
45 this one if no match is found. 46 this one if no match is found.
46 Keymaps can thus be arranged in a hierarchy. 47 Keymaps can thus be arranged in a hierarchy.
47 48
48 table A hash table, hashing keysyms to their bindings. 49 table A hash table, hashing keysyms to their bindings.
49 As in the rest of emacs, a keysym is either a symbol or 50 It will be one of the following:
50 an integer, which is an ASCII code (of one of the printing 51
51 ASCII characters: not 003 meaning C-c, for instance). 52 -- a symbol, e.g. 'home
52 It can also be an integer representing a modifier 53 -- a character, representing something printable
53 combination; this will be greater than or equal to 54 (not ?\C-c meaning C-c, for instance)
54 (1 << 16). 55 -- an integer representing a modifier combination
55 56
56 inverse_table A hash table, hashing bindings to the list of keysyms 57 inverse_table A hash table, hashing bindings to the list of keysyms
57 in this keymap which are bound to them. This is to make 58 in this keymap which are bound to them. This is to make
58 the Fwhere_is_internal() function be fast. It needs to be 59 the Fwhere_is_internal() function be fast. It needs to be
59 fast because we want to be able to call it in realtime to 60 fast because we want to be able to call it in realtime to
81 82
82 However, bucky bits ("modifiers" to the X-minded) are represented in the 83 However, bucky bits ("modifiers" to the X-minded) are represented in the
83 keymap hierarchy as well. (This lets us use EQable objects as hash keys.) 84 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
84 Each combination of modifiers (e.g. control-hyper) gets its own submap 85 Each combination of modifiers (e.g. control-hyper) gets its own submap
85 off of the main map. The hash key for a modifier combination is 86 off of the main map. The hash key for a modifier combination is
86 a large integer, computed by MAKE_MODIFIER_HASH_KEY(). 87 an integer, computed by MAKE_MODIFIER_HASH_KEY().
87 88
88 If the key `C-a' was bound to some command, the hierarchy would look like 89 If the key `C-a' was bound to some command, the hierarchy would look like
89 90
90 keymap-1: associates the integer (MOD_CONTROL << 16) with keymap-2 91 keymap-1: associates the integer MOD_CONTROL with keymap-2
91 keymap-2: associates "a" with the command 92 keymap-2: associates "a" with the command
92 93
93 Similarly, if the key `C-H-a' was bound to some command, the hierarchy 94 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
94 would look like 95 would look like
95 96
96 keymap-1: associates the integer ((MOD_CONTROL | MOD_HYPER) << 16) 97 keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER)
97 with keymap-2 98 with keymap-2
98 keymap-2: associates "a" with the command 99 keymap-2: associates "a" with the command
99 100
100 Note that a special exception is made for the meta modifier, in order 101 Note that a special exception is made for the meta modifier, in order
101 to deal with ESC/meta lossage. Any key combination containing the 102 to deal with ESC/meta lossage. Any key combination containing the
102 meta modifier is first indexed off of the main map into the meta 103 meta modifier is first indexed off of the main map into the meta
103 submap (with hash key (MOD_META << 16)) and then indexed off of the 104 submap (with hash key MOD_META) and then indexed off of the
104 meta submap with the meta modifier removed from the key combination. 105 meta submap with the meta modifier removed from the key combination.
105 For example, when associating a command with C-M-H-a, we'd have 106 For example, when associating a command with C-M-H-a, we'd have
106 107
107 keymap-1: associates the integer (MOD_META << 16) with keymap-2 108 keymap-1: associates the integer MOD_META with keymap-2
108 keymap-2: associates the integer ((MOD_CONTROL | MOD_HYPER) << 16) 109 keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER)
109 with keymap-3 110 with keymap-3
110 keymap-3: associates "a" with the command 111 keymap-3: associates "a" with the command
111 112
112 Note that keymap-2 might have normal bindings in it; these would be 113 Note that keymap-2 might have normal bindings in it; these would be
113 for key combinations containing only the meta modifier, such as 114 for key combinations containing only the meta modifier, such as
117 then that would make the key "C-M-H-a" be a prefix character. 118 then that would make the key "C-M-H-a" be a prefix character.
118 119
119 Note that this new model of keymaps takes much of the magic away from 120 Note that this new model of keymaps takes much of the magic away from
120 the Escape key: the value of the variable `esc-map' is no longer indexed 121 the Escape key: the value of the variable `esc-map' is no longer indexed
121 in the `global-map' under the ESC key. It's indexed under the integer 122 in the `global-map' under the ESC key. It's indexed under the integer
122 (MOD_META << 16). This is not user-visible, however; none of the "bucky" 123 MOD_META. This is not user-visible, however; none of the "bucky"
123 maps are. 124 maps are.
124 125
125 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[") 126 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
126 and (define-key some-random-map "\^[" my-esc-map) work as before, for 127 and (define-key some-random-map "\^[" my-esc-map) work as before, for
127 compatibility. 128 compatibility.
175 #define XKEYMAP(x) XRECORD (x, keymap, struct keymap) 176 #define XKEYMAP(x) XRECORD (x, keymap, struct keymap)
176 #define XSETKEYMAP(x, p) XSETRECORD (x, p, keymap) 177 #define XSETKEYMAP(x, p) XSETRECORD (x, p, keymap)
177 #define KEYMAPP(x) RECORDP (x, keymap) 178 #define KEYMAPP(x) RECORDP (x, keymap)
178 #define CHECK_KEYMAP(x) CHECK_RECORD (x, keymap) 179 #define CHECK_KEYMAP(x) CHECK_RECORD (x, keymap)
179 180
180 /* Hash key is shifted so it can't conflict with eight-bit 181 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
181 string-char constituents */ 182 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
182 #define MAKE_MODIFIER_HASH_KEY(modifier) (make_int ((modifier) << 16))
183 #define MODIFIER_HASH_KEY_BITS(x) ((INTP((x))) ? (XINT ((x)) >> 16) : 0)
184 183
185 184
186 185
187 /* Actually allocate storage for these variables */ 186 /* Actually allocate storage for these variables */
188 187
226 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3, Qbutton4, Qbutton5, 225 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3, Qbutton4, Qbutton5,
227 Qbutton6, Qbutton7; 226 Qbutton6, Qbutton7;
228 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up, Qbutton4up, 227 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up, Qbutton4up,
229 Qbutton5up, Qbutton6up, Qbutton7up; 228 Qbutton5up, Qbutton6up, Qbutton7up;
230 Lisp_Object Qmenu_selection; 229 Lisp_Object Qmenu_selection;
231 /* Emacs compatibility */
232 Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3;
233 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3;
234 230
235 /* Kludge kludge kludge */ 231 /* Kludge kludge kludge */
236 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS; 232 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
237 233
238 234
437 make_key_description (CONST struct key_data *key, int prettify) 433 make_key_description (CONST struct key_data *key, int prettify)
438 { 434 {
439 Lisp_Object keysym = key->keysym; 435 Lisp_Object keysym = key->keysym;
440 unsigned int modifiers = key->modifiers; 436 unsigned int modifiers = key->modifiers;
441 437
442 if (prettify && INTP (keysym)) 438 if (prettify && CHARP (keysym))
443 { 439 {
444 /* This is a little slow, but (control a) is prettier than (control 65). 440 /* This is a little slow, but (control a) is prettier than (control 65).
445 It's now ok to do this for digit-chars too, since we've fixed the 441 It's now ok to do this for digit-chars too, since we've fixed the
446 bug where \9 read as the integer 9 instead of as the symbol with 442 bug where \9 read as the integer 9 instead of as the symbol with
447 "9" as its name. 443 "9" as its name.
1236 1232
1237 /************************************************************************/ 1233 /************************************************************************/
1238 /* Defining keys in keymaps */ 1234 /* Defining keys in keymaps */
1239 /************************************************************************/ 1235 /************************************************************************/
1240 1236
1237 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1238 and perform any necessary canonicalization. */
1239
1241 static void 1240 static void
1242 define_key_check_keysym (Lisp_Object spec, 1241 define_key_check_and_coerce_keysym (Lisp_Object spec,
1243 Lisp_Object *keysym, unsigned int modifiers) 1242 Lisp_Object *keysym,
1243 unsigned int modifiers)
1244 { 1244 {
1245 /* Now, check and massage the trailing keysym specifier. */ 1245 /* Now, check and massage the trailing keysym specifier. */
1246 if (SYMBOLP (*keysym)) 1246 if (SYMBOLP (*keysym))
1247 { 1247 {
1248 if (string_length (XSYMBOL (*keysym)->name) == 1) 1248 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1249 { 1249 {
1250 *keysym = make_int (string_char (XSYMBOL (*keysym)->name, 0)); 1250 Lisp_Object ream_gcc_up_the_ass =
1251 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1252 *keysym = ream_gcc_up_the_ass;
1251 goto fixnum_keysym; 1253 goto fixnum_keysym;
1252 } 1254 }
1253 } 1255 }
1254 else if (INTP (*keysym)) 1256 else if (CHAR_OR_CHAR_INTP (*keysym))
1255 { 1257 {
1258 CHECK_CHAR_COERCE_INT (*keysym);
1256 fixnum_keysym: 1259 fixnum_keysym:
1257 if (XINT (*keysym) < ' ' || XINT (*keysym) > 255) 1260 if (XCHAR (*keysym) < ' '
1258 signal_simple_error ("keysym must be in the range 32 - 255", 1261 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1259 *keysym); 1262 /* yuck! Can't make the above restriction; too many compatibility
1263 problems ... */
1264 signal_simple_error ("keysym char must be printable", *keysym);
1260 /* #### This bites! I want to be able to write (control shift a) */ 1265 /* #### This bites! I want to be able to write (control shift a) */
1261 if (modifiers & MOD_SHIFT) 1266 if (modifiers & MOD_SHIFT)
1262 signal_simple_error ("the `shift' modifier may not be applied to ASCII keysyms", 1267 signal_simple_error
1263 spec); 1268 ("the `shift' modifier may not be applied to ASCII keysyms",
1269 spec);
1264 } 1270 }
1265 else 1271 else
1266 { 1272 {
1267 signal_simple_error ("unknown keysym specifier", 1273 signal_simple_error ("unknown keysym specifier",
1268 *keysym); 1274 *keysym);
1269 } 1275 }
1270 1276
1271 /* Code semi-snarfed from v20. */
1272 if (SYMBOLP (*keysym)) 1277 if (SYMBOLP (*keysym))
1273 { 1278 {
1274 char *name = (char *) 1279 char *name = (char *)
1275 string_data (XSYMBOL (*keysym)->name); 1280 string_data (XSYMBOL (*keysym)->name);
1276 1281
1277 if (!strncmp(name, "kp_", 3)) { 1282 /* FSFmacs uses symbols with the printed representation of keysyms in
1278 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */ 1283 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1279 char temp[50]; 1284 confusion, notice the M-x syntax and signal an error - because
1280 1285 otherwise it would be interpreted as a regular keysym, and would even
1281 strncpy(temp, name, sizeof (temp)); 1286 show up in the list-buffers output, causing confusion to the naive.
1282 temp[sizeof (temp) - 1] = '\0'; 1287
1283 temp[2] = '-'; 1288 We can get away with this because none of the X keysym names contain
1284 *keysym = Fintern_soft(make_string((Bufbyte *)temp, 1289 a hyphen (some contain underscore, however).
1285 strlen(temp)), 1290
1286 Qnil); 1291 It might be useful to reject keysyms which are not x-valid-keysym-
1287 } 1292 name-p, but that would interfere with various tricks we do to
1288 /* Emacs compatibility */ 1293 sanitize the Sun keyboards, and would make it trickier to
1289 else if (EQ(*keysym, Qdown_mouse_1)) 1294 conditionalize a .emacs file for multiple X servers.
1290 *keysym = Qbutton1; 1295 */
1291 else if (EQ(*keysym, Qdown_mouse_2)) 1296 if (((int) strlen (name) >= 2 && name[1] == '-')
1292 *keysym = Qbutton2; 1297 #if 1
1293 else if (EQ(*keysym, Qdown_mouse_3)) 1298 ||
1294 *keysym = Qbutton3; 1299 /* Ok, this is a bit more dubious - prevent people from doing things
1295 else if (EQ(*keysym, Qmouse_1)) 1300 like (global-set-key 'RET 'something) because that will have the
1296 *keysym = Qbutton1up; 1301 same problem as above. (Gag!) Maybe we should just silently
1297 else if (EQ(*keysym, Qmouse_2)) 1302 accept these as aliases for the "real" names?
1298 *keysym = Qbutton2up; 1303 */
1299 else if (EQ(*keysym, Qmouse_3)) 1304 (string_length (XSYMBOL (*keysym)->name) < 4 &&
1300 *keysym = Qbutton3up; 1305 (!strcmp (name, "LFD") ||
1301 } 1306 !strcmp (name, "TAB") ||
1302 } 1307 !strcmp (name, "RET") ||
1308 !strcmp (name, "ESC") ||
1309 !strcmp (name, "DEL") ||
1310 !strcmp (name, "SPC") ||
1311 !strcmp (name, "BS")))
1312 #endif /* unused */
1313 )
1314 signal_simple_error
1315 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1316 *keysym);
1317
1318 /* #### Ok, this is a bit more dubious - make people not lose if they
1319 do things like (global-set-key 'RET 'something) because that would
1320 otherwise have the same problem as above. (Gag!) We silently
1321 accept these as aliases for the "real" names.
1322 */
1323 else if (EQ (*keysym, QLFD))
1324 *keysym = QKlinefeed;
1325 else if (EQ (*keysym, QTAB))
1326 *keysym = QKtab;
1327 else if (EQ (*keysym, QRET))
1328 *keysym = QKreturn;
1329 else if (EQ (*keysym, QESC))
1330 *keysym = QKescape;
1331 else if (EQ (*keysym, QDEL))
1332 *keysym = QKdelete;
1333 else if (EQ (*keysym, QBS))
1334 *keysym = QKbackspace;
1335 }
1336 }
1337
1303 1338
1304 /* Given any kind of key-specifier, return a keysym and modifier mask. 1339 /* Given any kind of key-specifier, return a keysym and modifier mask.
1340 Proper canonicalization is performed:
1341
1342 -- integers are converted into the equivalent characters.
1343 -- one-character strings are converted into the equivalent characters.
1305 */ 1344 */
1345
1306 static void 1346 static void
1307 define_key_parser (Lisp_Object spec, struct key_data *returned_value) 1347 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1308 { 1348 {
1309 if (INTP (spec)) 1349 if (CHAR_OR_CHAR_INTP (spec))
1310 { 1350 {
1311 struct Lisp_Event event; 1351 struct Lisp_Event event;
1312 event.event_type = empty_event; 1352 event.event_type = empty_event;
1313 character_to_event (XINT (spec), &event, 1353 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1314 XCONSOLE (Vselected_console), 0); 1354 XCONSOLE (Vselected_console), 0);
1315 returned_value->keysym = event.event.key.keysym; 1355 returned_value->keysym = event.event.key.keysym;
1316 returned_value->modifiers = event.event.key.modifiers; 1356 returned_value->modifiers = event.event.key.modifiers;
1317 } 1357 }
1318 else if (EVENTP (spec)) 1358 else if (EVENTP (spec))
1361 else if (SYMBOLP (spec)) 1401 else if (SYMBOLP (spec))
1362 { 1402 {
1363 /* Be nice, allow = to mean (=) */ 1403 /* Be nice, allow = to mean (=) */
1364 if (bucky_sym_to_bucky_bit (spec) != 0) 1404 if (bucky_sym_to_bucky_bit (spec) != 0)
1365 signal_simple_error ("Key is a modifier name", spec); 1405 signal_simple_error ("Key is a modifier name", spec);
1366 define_key_check_keysym (spec, &spec, 0); 1406 define_key_check_and_coerce_keysym (spec, &spec, 0);
1367 returned_value->keysym = spec; 1407 returned_value->keysym = spec;
1368 returned_value->modifiers = 0; 1408 returned_value->modifiers = 0;
1369 } 1409 }
1370 else if (CONSP (spec)) 1410 else if (CONSP (spec))
1371 { 1411 {
1396 QUIT; 1436 QUIT;
1397 } 1437 }
1398 if (!NILP (rest)) 1438 if (!NILP (rest))
1399 signal_simple_error ("dotted list", spec); 1439 signal_simple_error ("dotted list", spec);
1400 1440
1401 define_key_check_keysym (spec, &keysym, modifiers); 1441 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1402 returned_value->keysym = keysym; 1442 returned_value->keysym = keysym;
1403 returned_value->modifiers = modifiers; 1443 returned_value->modifiers = modifiers;
1404 } 1444 }
1405 else 1445 else
1406 { 1446 {
1407 signal_simple_error ("unknown key-sequence specifier", 1447 signal_simple_error ("unknown key-sequence specifier",
1408 spec); 1448 spec);
1409 }
1410
1411 /* Convert single-character symbols into ints, since that's the
1412 way the events arrive from the keyboard... */
1413 if (SYMBOLP (returned_value->keysym) &&
1414 string_length (XSYMBOL (returned_value->keysym)->name) == 1)
1415 {
1416 returned_value->keysym =
1417 make_int (string_char (XSYMBOL (returned_value->keysym)->name, 0));
1418
1419 /* Detect bogus (user-provided) keysyms like '\?C-a;
1420 We can't do that for '\?M-a because that interferes with
1421 legitimate 8-bit input. */
1422 if (XINT (returned_value->keysym) < ' ' ||
1423 XINT (returned_value->keysym) > 255)
1424 signal_simple_error ("keysym must be in the range 32 - 255",
1425 returned_value->keysym);
1426 }
1427
1428 if (SYMBOLP (returned_value->keysym))
1429 {
1430 char *name = (char *) string_data (XSYMBOL (returned_value->keysym)->name);
1431
1432 /* FSFmacs uses symbols with the printed representation of keysyms in
1433 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1434 confusion, notice the M-x syntax and signal an error - because
1435 otherwise it would be interpreted as a regular keysym, and would even
1436 show up in the list-buffers output, causing confusion to the naive.
1437
1438 We can get away with this because none of the X keysym names contain
1439 a hyphen (some contain underscore, however).
1440
1441 It might be useful to reject keysyms which are not x-valid-keysym-
1442 name-p, but that would interfere with various tricks we do to
1443 sanitize the Sun keyboards, and would make it trickier to
1444 conditionalize a .emacs file for multiple X servers.
1445 */
1446 if (((unsigned int) strlen (name) >= 2 && name[1] == '-')
1447 #if 1
1448 ||
1449 /* Ok, this is a bit more dubious - prevent people from doing things
1450 like (global-set-key 'RET 'something) because that will have the
1451 same problem as above. (Gag!) Maybe we should just silently
1452 accept these as aliases for the "real" names?
1453 */
1454 (string_length (XSYMBOL (returned_value->keysym)->name) < 4 &&
1455 (!strcmp (name, "LFD") ||
1456 !strcmp (name, "TAB") ||
1457 !strcmp (name, "RET") ||
1458 !strcmp (name, "ESC") ||
1459 !strcmp (name, "DEL") ||
1460 !strcmp (name, "SPC") ||
1461 !strcmp (name, "BS")))
1462 #endif /* unused */
1463 )
1464 signal_simple_error ("invalid keysym (see doc of define-key)",
1465 returned_value->keysym);
1466
1467 /* #### Ok, this is a bit more dubious - make people not lose if they
1468 do things like (global-set-key 'RET 'something) because that would
1469 otherwise have the same problem as above. (Gag!) We silently
1470 accept these as aliases for the "real" names.
1471 */
1472 else if (EQ (returned_value->keysym, QLFD))
1473 returned_value->keysym = QKlinefeed;
1474 else if (EQ (returned_value->keysym, QTAB))
1475 returned_value->keysym = QKtab;
1476 else if (EQ (returned_value->keysym, QRET))
1477 returned_value->keysym = QKreturn;
1478 else if (EQ (returned_value->keysym, QESC))
1479 returned_value->keysym = QKescape;
1480 else if (EQ (returned_value->keysym, QDEL))
1481 returned_value->keysym = QKdelete;
1482 else if (EQ (returned_value->keysym, QBS))
1483 returned_value->keysym = QKbackspace;
1484 } 1449 }
1485 } 1450 }
1486 1451
1487 /* Used by character-to-event */ 1452 /* Used by character-to-event */
1488 void 1453 void
1537 Lisp_Object event2; 1502 Lisp_Object event2;
1538 int retval; 1503 int retval;
1539 struct gcpro gcpro1; 1504 struct gcpro gcpro1;
1540 1505
1541 if (event->event_type != key_press_event || NILP (key_specifier) || 1506 if (event->event_type != key_press_event || NILP (key_specifier) ||
1542 (INTP (key_specifier) && XINT (key_specifier) < 0)) 1507 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1543 return 0; 1508 return 0;
1544 1509
1545 /* if the specifier is an integer such as 27, then it should match 1510 /* if the specifier is an integer such as 27, then it should match
1546 both of the events 'escape' and 'control ['. Calling 1511 both of the events 'escape' and 'control ['. Calling
1547 Fcharacter_to_event() will only match 'escape'. */ 1512 Fcharacter_to_event() will only match 'escape'. */
1548 if (INTP (key_specifier)) 1513 if (CHAR_OR_CHAR_INTP (key_specifier))
1549 return XINT (key_specifier) == event_to_character (event, 0, 0, 0); 1514 return (XCHAR_OR_CHAR_INT (key_specifier)
1515 == event_to_character (event, 0, 0, 0));
1550 1516
1551 /* Otherwise, we cannot call event_to_character() because we may 1517 /* Otherwise, we cannot call event_to_character() because we may
1552 be dealing with non-ASCII keystrokes. In any case, if I ask 1518 be dealing with non-ASCII keystrokes. In any case, if I ask
1553 for 'control [' then I should get exactly that, and not 1519 for 'control [' then I should get exactly that, and not
1554 'escape'. 1520 'escape'.
1675 int i; 1641 int i;
1676 Lisp_Object mpc_binding; 1642 Lisp_Object mpc_binding;
1677 struct key_data meta_key; 1643 struct key_data meta_key;
1678 1644
1679 if (NILP (Vmeta_prefix_char) || 1645 if (NILP (Vmeta_prefix_char) ||
1680 (INTP (Vmeta_prefix_char) && XINT (Vmeta_prefix_char) < 0)) 1646 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1681 return; 1647 return;
1682 1648
1683 define_key_parser (Vmeta_prefix_char, &meta_key); 1649 define_key_parser (Vmeta_prefix_char, &meta_key);
1684 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0); 1650 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1685 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding))) 1651 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1698 } 1664 }
1699 else 1665 else
1700 abort (); 1666 abort ();
1701 if (EQ (keys, new_keys)) 1667 if (EQ (keys, new_keys))
1702 sprintf (buf, GETTEXT ("can't bind %s: %s has a non-keymap binding"), 1668 sprintf (buf, GETTEXT ("can't bind %s: %s has a non-keymap binding"),
1703 (char *) string_data (XSTRING (Fkey_description (keys))), 1669 (char *) XSTRING_DATA (Fkey_description (keys)),
1704 (char *) string_data (XSTRING 1670 (char *) XSTRING_DATA (Fsingle_key_description
1705 (Fsingle_key_description 1671 (Vmeta_prefix_char)));
1706 (Vmeta_prefix_char))));
1707 else 1672 else
1708 sprintf (buf, GETTEXT ("can't bind %s: %s %s has a non-keymap binding"), 1673 sprintf (buf, GETTEXT ("can't bind %s: %s %s has a non-keymap binding"),
1709 (char *) string_data (XSTRING (Fkey_description (keys))), 1674 (char *) XSTRING_DATA (Fkey_description (keys)),
1710 (char *) string_data (XSTRING (Fkey_description (new_keys))), 1675 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1711 (char *) string_data (XSTRING 1676 (char *) XSTRING_DATA (Fsingle_key_description
1712 (Fsingle_key_description 1677 (Vmeta_prefix_char)));
1713 (Vmeta_prefix_char))));
1714 signal_simple_error (buf, mpc_binding); 1678 signal_simple_error (buf, mpc_binding);
1715 } 1679 }
1716 1680
1717 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /* 1681 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1718 Define key sequence KEYS, in KEYMAP, as DEF. 1682 Define key sequence KEYS, in KEYMAP, as DEF.
1825 struct gcpro gcpro1, gcpro2, gcpro3; 1789 struct gcpro gcpro1, gcpro2, gcpro3;
1826 1790
1827 if (VECTORP (keys)) 1791 if (VECTORP (keys))
1828 size = vector_length (XVECTOR (keys)); 1792 size = vector_length (XVECTOR (keys));
1829 else if (STRINGP (keys)) 1793 else if (STRINGP (keys))
1830 size = string_length (XSTRING (keys)); 1794 size = string_char_length (XSTRING (keys));
1831 else if (INTP (keys) || SYMBOLP (keys) || CONSP (keys)) 1795 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1832 { 1796 {
1833 if (!CONSP (keys)) keys = list1 (keys); 1797 if (!CONSP (keys)) keys = list1 (keys);
1834 size = 1; 1798 size = 1;
1835 keys = make_vector (1, keys); /* this is kinda sleazy. */ 1799 keys = make_vector (1, keys); /* this is kinda sleazy. */
1836 } 1800 }
1865 struct key_data raw_key2; 1829 struct key_data raw_key2;
1866 1830
1867 if (STRINGP (keys)) 1831 if (STRINGP (keys))
1868 c = make_char (string_char (XSTRING (keys), idx)); 1832 c = make_char (string_char (XSTRING (keys), idx));
1869 else 1833 else
1870 { 1834 c = vector_data (XVECTOR (keys)) [idx];
1871 c = vector_data (XVECTOR (keys)) [idx];
1872 if (INTP (c) &&
1873 (XINT (c) < ' ' || XINT (c) > 127))
1874 args_out_of_range_3 (c, make_int (32), make_int (127));
1875 }
1876 1835
1877 define_key_parser (c, &raw_key1); 1836 define_key_parser (c, &raw_key1);
1878 1837
1879 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1)) 1838 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1880 { 1839 {
2108 int i; 2067 int i;
2109 2068
2110 if (nkeys == 0) 2069 if (nkeys == 0)
2111 return Qnil; 2070 return Qnil;
2112 2071
2113 if (nkeys < (countof (kkk))) 2072 if (nkeys > (countof (kkk)))
2114 raw_keys = kkk; 2073 raw_keys = kkk;
2115 else 2074 else
2116 raw_keys = (struct key_data *) alloca (sizeof (struct key_data) * nkeys); 2075 raw_keys = (struct key_data *) alloca (sizeof (struct key_data) * nkeys);
2117 2076
2118 for (i = 0; i < nkeys; i++) 2077 for (i = 0; i < nkeys; i++)
2187 return lookup_keys (keymap, 2146 return lookup_keys (keymap,
2188 vector_length (XVECTOR (keys)), 2147 vector_length (XVECTOR (keys)),
2189 vector_data (XVECTOR (keys)), 2148 vector_data (XVECTOR (keys)),
2190 !NILP (accept_default)); 2149 !NILP (accept_default));
2191 } 2150 }
2192 else if (SYMBOLP (keys) || INTP (keys) || CONSP (keys)) 2151 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2193 { 2152 {
2194 return lookup_keys (keymap, 1, &keys, 2153 return lookup_keys (keymap, 1, &keys,
2195 !NILP (accept_default)); 2154 !NILP (accept_default));
2196 } 2155 }
2197 else if (!STRINGP (keys)) 2156 else if (!STRINGP (keys))
2379 &closure); 2338 &closure);
2380 } 2339 }
2381 2340
2382 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */ 2341 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2383 { 2342 {
2384 Lisp_Object map = XBUFFER (buffer)->keymap;
2385
2386 get_relevant_minor_maps (buffer, &closure); 2343 get_relevant_minor_maps (buffer, &closure);
2387 if (!NILP(map)) 2344 relevant_map_push (XBUFFER (buffer)->keymap, &closure);
2388 relevant_map_push (map, &closure);
2389 } 2345 }
2390 } 2346 }
2391 } 2347 }
2392 else if (!NILP (Fevent_over_toolbar_p (terminal))) 2348 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2393 { 2349 {
2622 int nmaps; 2578 int nmaps;
2623 2579
2624 assert (EVENTP (event0)); 2580 assert (EVENTP (event0));
2625 2581
2626 nmaps = get_relevant_keymaps (event0, countof (maps), maps); 2582 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2627 if (nmaps > countof (maps))
2628 nmaps = countof (maps);
2629 return (process_event_binding_result 2583 return (process_event_binding_result
2630 (lookup_events (event0, nmaps, maps, accept_default))); 2584 (lookup_events (event0, nmaps, maps, accept_default)));
2631 } 2585 }
2632 2586
2633 /* Attempts to find a function key mapping corresponding to the 2587 /* Attempts to find a function key mapping corresponding to the
2812 that code instead of alphabetically. 2766 that code instead of alphabetically.
2813 */ 2767 */
2814 if (! bit1 && SYMBOLP (obj1)) 2768 if (! bit1 && SYMBOLP (obj1))
2815 { 2769 {
2816 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil); 2770 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2817 if (INTP (code)) 2771 if (CHAR_OR_CHAR_INTP (code))
2818 obj1 = code, sym1_p = 1; 2772 {
2773 obj1 = code;
2774 CHECK_CHAR_COERCE_INT (obj1);
2775 sym1_p = 1;
2776 }
2819 } 2777 }
2820 if (! bit2 && SYMBOLP (obj2)) 2778 if (! bit2 && SYMBOLP (obj2))
2821 { 2779 {
2822 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil); 2780 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2823 if (INTP (code)) 2781 if (CHAR_OR_CHAR_INTP (code))
2824 obj2 = code, sym2_p = 1; 2782 {
2783 obj2 = code;
2784 CHECK_CHAR_COERCE_INT (obj2);
2785 sym2_p = 1;
2786 }
2825 } 2787 }
2826 2788
2827 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ 2789 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2828 if (XTYPE (obj1) != XTYPE (obj2)) 2790 if (XTYPE (obj1) != XTYPE (obj2))
2829 return (SYMBOLP (obj2) ? 1 : -1); 2791 return (SYMBOLP (obj2) ? 1 : -1);
2960 If the optional third argument SORT-FIRST is non-nil, then the elements of 2922 If the optional third argument SORT-FIRST is non-nil, then the elements of
2961 the keymap will be passed to the mapper function in a canonical order. 2923 the keymap will be passed to the mapper function in a canonical order.
2962 Otherwise, they will be passed in hash (that is, random) order, which is 2924 Otherwise, they will be passed in hash (that is, random) order, which is
2963 faster. 2925 faster.
2964 */ 2926 */
2965 (function, keymap, sort_first)) 2927 (function, keymap, sort_first))
2966 { 2928 {
2967 /* This function can GC */ 2929 /* This function can GC */
2968 struct gcpro gcpro1, gcpro2; 2930 struct gcpro gcpro1, gcpro2;
2969 2931
2970 /* tolerate obviously transposed args */ 2932 /* tolerate obviously transposed args */
3142 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\" 3104 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"
3143 spaces are put between sequence elements, etc. 3105 spaces are put between sequence elements, etc.
3144 */ 3106 */
3145 (keys)) 3107 (keys))
3146 { 3108 {
3147 if (INTP (keys) || CONSP (keys) || SYMBOLP (keys) || EVENTP (keys)) 3109 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3110 || EVENTP (keys))
3148 { 3111 {
3149 return Fsingle_key_description (keys); 3112 return Fsingle_key_description (keys);
3150 } 3113 }
3151 else if (VECTORP (keys) || 3114 else if (VECTORP (keys) ||
3152 STRINGP (keys)) 3115 STRINGP (keys))
3185 (key)) 3148 (key))
3186 { 3149 {
3187 if (SYMBOLP (key)) 3150 if (SYMBOLP (key))
3188 key = Fcons (key, Qnil); /* sleaze sleaze */ 3151 key = Fcons (key, Qnil); /* sleaze sleaze */
3189 3152
3190 if (EVENTP (key) || CHARP (key)) 3153 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3191 { 3154 {
3192 char buf [255]; 3155 char buf [255];
3193 if (!EVENTP (key)) 3156 if (!EVENTP (key))
3194 { 3157 {
3195 struct Lisp_Event event; 3158 struct Lisp_Event event;
3218 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2; 3181 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3219 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2; 3182 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3220 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2; 3183 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3221 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2; 3184 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3222 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3; 3185 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3223 else if (INTP (keysym)) 3186 else if (CHAR_OR_CHAR_INTP (keysym))
3224 *bufp = XINT (keysym), bufp++, *bufp = 0; 3187 {
3188 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3189 XCHAR_OR_CHAR_INT (keysym));
3190 *bufp = 0;
3191 }
3225 else 3192 else
3226 { 3193 {
3227 CHECK_SYMBOL (keysym); 3194 CHECK_SYMBOL (keysym);
3228 #if 0 /* This is bogus */ 3195 #if 0 /* This is bogus */
3229 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD"); 3196 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3259 Bufbyte buf[200]; 3226 Bufbyte buf[200];
3260 Bufbyte *p; 3227 Bufbyte *p;
3261 unsigned int c; 3228 unsigned int c;
3262 Lisp_Object ctl_arrow = current_buffer->ctl_arrow; 3229 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3263 int ctl_p = !NILP (ctl_arrow); 3230 int ctl_p = !NILP (ctl_arrow);
3264 int printable_min = (INTP (ctl_arrow) 3231 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3265 ? XINT (ctl_arrow) 3232 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3266 : ((EQ (ctl_arrow, Qt) || EQ (ctl_arrow, Qnil)) 3233 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3267 ? 256 : 160)); 3234 ? 256 : 160));
3268 3235
3269 if (EVENTP (chr)) 3236 if (EVENTP (chr))
3270 { 3237 {
3271 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt); 3238 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3272 if (NILP (ch)) 3239 if (NILP (ch))
3296 *p++ = '?'; 3263 *p++ = '?';
3297 } 3264 }
3298 else if (c >= 0200 || c < 040) 3265 else if (c >= 0200 || c < 040)
3299 { 3266 {
3300 *p++ = '\\'; 3267 *p++ = '\\';
3268 #ifdef MULE
3269 /* !!#### This syntax is not readable. It will
3270 be interpreted as a 3-digit octal number rather
3271 than a 7-digit octal number. */
3272 if (c >= 0400)
3273 {
3274 *p++ = '0' + ((c & 07000000) >> 18);
3275 *p++ = '0' + ((c & 0700000) >> 15);
3276 *p++ = '0' + ((c & 070000) >> 12);
3277 *p++ = '0' + ((c & 07000) >> 9);
3278 }
3279 #endif
3301 *p++ = '0' + ((c & 0700) >> 6); 3280 *p++ = '0' + ((c & 0700) >> 6);
3302 *p++ = '0' + ((c & 0070) >> 3); 3281 *p++ = '0' + ((c & 0070) >> 3);
3303 *p++ = '0' + ((c & 0007)); 3282 *p++ = '0' + ((c & 0007));
3304 } 3283 }
3305 else 3284 else
3988 s2 = XCAR (XCAR (XCAR (XCDR (list)))); 3967 s2 = XCAR (XCAR (XCAR (XCDR (list))));
3989 3968
3990 if (SYMBOLP (s1)) 3969 if (SYMBOLP (s1))
3991 { 3970 {
3992 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil); 3971 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
3993 if (INTP (code)) s1 = code; 3972 if (CHAR_OR_CHAR_INTP (code))
3973 {
3974 s1 = code;
3975 CHECK_CHAR_COERCE_INT (s1);
3976 }
3994 else return 0; 3977 else return 0;
3995 } 3978 }
3996 if (SYMBOLP (s2)) 3979 if (SYMBOLP (s2))
3997 { 3980 {
3998 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil); 3981 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
3999 if (INTP (code)) s2 = code; 3982 if (CHAR_OR_CHAR_INTP (code))
3983 {
3984 s2 = code;
3985 CHECK_CHAR_COERCE_INT (s2);
3986 }
4000 else return 0; 3987 else return 0;
4001 } 3988 }
4002 3989
4003 if (XCHAR (s1) == XCHAR (s2) || 3990 if (XCHAR (s1) == XCHAR (s2) ||
4004 XCHAR (s1) + 1 == XCHAR (s2)) 3991 XCHAR (s1) + 1 == XCHAR (s2))
4199 defsymbol (&Qbutton3up, "button3up"); 4186 defsymbol (&Qbutton3up, "button3up");
4200 defsymbol (&Qbutton4up, "button4up"); 4187 defsymbol (&Qbutton4up, "button4up");
4201 defsymbol (&Qbutton5up, "button5up"); 4188 defsymbol (&Qbutton5up, "button5up");
4202 defsymbol (&Qbutton6up, "button6up"); 4189 defsymbol (&Qbutton6up, "button6up");
4203 defsymbol (&Qbutton7up, "button7up"); 4190 defsymbol (&Qbutton7up, "button7up");
4204 defsymbol (&Qmouse_1, "mouse-1");
4205 defsymbol (&Qmouse_2, "mouse-2");
4206 defsymbol (&Qmouse_3, "mouse-3");
4207 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4208 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4209 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4210 defsymbol (&Qmenu_selection, "menu-selection"); 4191 defsymbol (&Qmenu_selection, "menu-selection");
4211 defsymbol (&QLFD, "LFD"); 4192 defsymbol (&QLFD, "LFD");
4212 defsymbol (&QTAB, "TAB"); 4193 defsymbol (&QTAB, "TAB");
4213 defsymbol (&QRET, "RET"); 4194 defsymbol (&QRET, "RET");
4214 defsymbol (&QESC, "ESC"); 4195 defsymbol (&QESC, "ESC");