Mercurial > hg > xemacs-beta

comparison src/events.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents bbff43aa5eb7
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
79 /* Make sure we lose quickly if we try to use this event */ 79 /* Make sure we lose quickly if we try to use this event */
80 static void 80 static void
81 deinitialize_event (Lisp_Object ev) 81 deinitialize_event (Lisp_Object ev)
82 { 82 {
83 int i; 83 int i;
84 struct Lisp_Event *event = XEVENT (ev); 84 Lisp_Event *event = XEVENT (ev);
85 85
86 for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++) 86 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
87 ((int *) event) [i] = 0xdeadbeef; 87 ((int *) event) [i] = 0xdeadbeef;
88 event->event_type = dead_event; 88 event->event_type = dead_event;
89 event->channel = Qnil; 89 event->channel = Qnil;
90 set_lheader_implementation (&(event->lheader), lrecord_event); 90 set_lheader_implementation (&(event->lheader), &lrecord_event);
91 XSET_EVENT_NEXT (ev, Qnil); 91 XSET_EVENT_NEXT (ev, Qnil);
92 } 92 }
93 93
94 /* Set everything to zero or nil so that it's predictable. */ 94 /* Set everything to zero or nil so that it's predictable. */
95 void 95 void
96 zero_event (struct Lisp_Event *e) 96 zero_event (Lisp_Event *e)
97 { 97 {
98 xzero (*e); 98 xzero (*e);
99 set_lheader_implementation (&(e->lheader), lrecord_event); 99 set_lheader_implementation (&(e->lheader), &lrecord_event);
100 e->event_type = empty_event; 100 e->event_type = empty_event;
101 e->next = Qnil; 101 e->next = Qnil;
102 e->channel = Qnil; 102 e->channel = Qnil;
103 } 103 }
104 104
105 static Lisp_Object 105 static Lisp_Object
106 mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object)) 106 mark_event (Lisp_Object obj)
107 { 107 {
108 struct Lisp_Event *event = XEVENT (obj); 108 Lisp_Event *event = XEVENT (obj);
109 109
110 switch (event->event_type) 110 switch (event->event_type)
111 { 111 {
112 case key_press_event: 112 case key_press_event:
113 markobj (event->event.key.keysym); 113 mark_object (event->event.key.keysym);
114 break; 114 break;
115 case process_event: 115 case process_event:
116 markobj (event->event.process.process); 116 mark_object (event->event.process.process);
117 break; 117 break;
118 case timeout_event: 118 case timeout_event:
119 markobj (event->event.timeout.function); 119 mark_object (event->event.timeout.function);
120 markobj (event->event.timeout.object); 120 mark_object (event->event.timeout.object);
121 break; 121 break;
122 case eval_event: 122 case eval_event:
123 case misc_user_event: 123 case misc_user_event:
124 markobj (event->event.eval.function); 124 mark_object (event->event.eval.function);
125 markobj (event->event.eval.object); 125 mark_object (event->event.eval.object);
126 break; 126 break;
127 case magic_eval_event: 127 case magic_eval_event:
128 markobj (event->event.magic_eval.object); 128 mark_object (event->event.magic_eval.object);
129 break; 129 break;
130 case button_press_event: 130 case button_press_event:
131 case button_release_event: 131 case button_release_event:
132 case pointer_motion_event: 132 case pointer_motion_event:
133 case magic_event: 133 case magic_event:
135 case dead_event: 135 case dead_event:
136 break; 136 break;
137 default: 137 default:
138 abort (); 138 abort ();
139 } 139 }
140 markobj (event->channel); 140 mark_object (event->channel);
141 return event->next; 141 return event->next;
142 } 142 }
143 143
144 static void 144 static void
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun) 145 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
146 { 146 {
147 char buf[255]; 147 char buf[255];
148 write_c_string (str, printcharfun); 148 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0); 149 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun); 150 write_c_string (buf, printcharfun);
219 } 219 }
220 220
221 static int 221 static int
222 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 222 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
223 { 223 {
224 struct Lisp_Event *e1 = XEVENT (obj1); 224 Lisp_Event *e1 = XEVENT (obj1);
225 struct Lisp_Event *e2 = XEVENT (obj2); 225 Lisp_Event *e2 = XEVENT (obj2);
226 226
227 if (e1->event_type != e2->event_type) return 0; 227 if (e1->event_type != e2->event_type) return 0;
228 if (!EQ (e1->channel, e2->channel)) return 0; 228 if (!EQ (e1->channel, e2->channel)) return 0;
229 /* if (e1->timestamp != e2->timestamp) return 0; */ 229 /* if (e1->timestamp != e2->timestamp) return 0; */
230 switch (e1->event_type) 230 switch (e1->event_type)
291 #endif 291 #endif
292 #ifdef HAVE_MS_WINDOWS 292 #ifdef HAVE_MS_WINDOWS
293 if (CONSOLE_MSWINDOWS_P (con)) 293 if (CONSOLE_MSWINDOWS_P (con))
294 return (!memcmp(&e1->event.magic.underlying_mswindows_event, 294 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
295 &e2->event.magic.underlying_mswindows_event, 295 &e2->event.magic.underlying_mswindows_event,
296 sizeof(union magic_data))); 296 sizeof (union magic_data)));
297 #endif 297 #endif
298 abort ();
298 return 1; /* not reached */ 299 return 1; /* not reached */
299 } 300 }
300 301
301 case empty_event: /* Empty and deallocated events are equal. */ 302 case empty_event: /* Empty and deallocated events are equal. */
302 case dead_event: 303 case dead_event:
305 } 306 }
306 307
307 static unsigned long 308 static unsigned long
308 event_hash (Lisp_Object obj, int depth) 309 event_hash (Lisp_Object obj, int depth)
309 { 310 {
310 struct Lisp_Event *e = XEVENT (obj); 311 Lisp_Event *e = XEVENT (obj);
311 unsigned long hash; 312 unsigned long hash;
312 313
313 hash = HASH2 (e->event_type, LISP_HASH (e->channel)); 314 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
314 switch (e->event_type) 315 switch (e->event_type)
315 { 316 {
358 #endif 359 #endif
359 #ifdef HAVE_MS_WINDOWS 360 #ifdef HAVE_MS_WINDOWS
360 if (CONSOLE_MSWINDOWS_P (con)) 361 if (CONSOLE_MSWINDOWS_P (con))
361 return HASH2 (hash, e->event.magic.underlying_mswindows_event); 362 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
362 #endif 363 #endif
364 abort ();
365 return 0;
363 } 366 }
364 367
365 case empty_event: 368 case empty_event:
366 case dead_event: 369 case dead_event:
367 return hash; 370 return hash;
373 return 0; /* unreached */ 376 return 0; /* unreached */
374 } 377 }
375 378
376 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, 379 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
377 mark_event, print_event, 0, event_equal, 380 mark_event, print_event, 0, event_equal,
378 event_hash, struct Lisp_Event); 381 event_hash, 0, Lisp_Event);
379 382
380 383
381 DEFUN ("make-event", Fmake_event, 0, 2, 0, /* 384 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
382 Return a new event of type TYPE, with properties described by PLIST. 385 Return a new event of type TYPE, with properties described by PLIST.
383 386
426 */ 429 */
427 (type, plist)) 430 (type, plist))
428 { 431 {
429 Lisp_Object tail, keyword, value; 432 Lisp_Object tail, keyword, value;
430 Lisp_Object event = Qnil; 433 Lisp_Object event = Qnil;
431 struct Lisp_Event *e; 434 Lisp_Event *e;
432 EMACS_INT coord_x = 0, coord_y = 0; 435 EMACS_INT coord_x = 0, coord_y = 0;
433 struct gcpro gcpro1; 436 struct gcpro gcpro1;
434 437
435 GCPRO1 (event); 438 GCPRO1 (event);
436 439
761 764
762 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* 765 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
763 Make a copy of the given event object. 766 Make a copy of the given event object.
764 If a second argument is given, the first event is copied into the second 767 If a second argument is given, the first event is copied into the second
765 and the second is returned. If the second argument is not supplied (or 768 and the second is returned. If the second argument is not supplied (or
766 is nil) then a new event will be made as with `allocate-event.' See also 769 is nil) then a new event will be made as with `make-event'. See also
767 the function `deallocate-event'. 770 the function `deallocate-event'.
768 */ 771 */
769 (event1, event2)) 772 (event1, event2))
770 { 773 {
771 CHECK_LIVE_EVENT (event1); 774 CHECK_LIVE_EVENT (event1);
772 if (NILP (event2)) 775 if (NILP (event2))
773 event2 = Fmake_event (Qnil, Qnil); 776 event2 = Fmake_event (Qnil, Qnil);
774 else CHECK_LIVE_EVENT (event2); 777 else
775 if (EQ (event1, event2)) 778 {
776 return signal_simple_continuable_error_2 779 CHECK_LIVE_EVENT (event2);
777 ("copy-event called with `eq' events", event1, event2); 780 if (EQ (event1, event2))
781 return signal_simple_continuable_error_2
782 ("copy-event called with `eq' events", event1, event2);
783 }
778 784
779 assert (XEVENT_TYPE (event1) <= last_event_type); 785 assert (XEVENT_TYPE (event1) <= last_event_type);
780 assert (XEVENT_TYPE (event2) <= last_event_type); 786 assert (XEVENT_TYPE (event2) <= last_event_type);
781 787
782 { 788 {
783 Lisp_Object save_next = XEVENT_NEXT (event2); 789 Lisp_Event *ev2 = XEVENT (event2);
784 790 Lisp_Event *ev1 = XEVENT (event1);
785 *XEVENT (event2) = *XEVENT (event1); 791
786 XSET_EVENT_NEXT (event2, save_next); 792 ev2->event_type = ev1->event_type;
793 ev2->channel = ev1->channel;
794 ev2->timestamp = ev1->timestamp;
795 ev2->event = ev1->event;
796
787 return event2; 797 return event2;
788 } 798 }
789 } 799 }
790 800
791 801
961 } 971 }
962 } 972 }
963 973
964 974
965 void 975 void
966 character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, 976 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
967 int use_console_meta_flag, int do_backspace_mapping) 977 int use_console_meta_flag, int do_backspace_mapping)
968 { 978 {
969 Lisp_Object k = Qnil; 979 Lisp_Object k = Qnil;
970 unsigned int m = 0; 980 unsigned int m = 0;
971 if (event->event_type == dead_event) 981 if (event->event_type == dead_event)
1030 event->channel = make_console (con); 1040 event->channel = make_console (con);
1031 event->event.key.keysym = (!NILP (k) ? k : make_char (c)); 1041 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1032 event->event.key.modifiers = m; 1042 event->event.key.modifiers = m;
1033 } 1043 }
1034 1044
1035
1036 /* This variable controls what character name -> character code mapping 1045 /* This variable controls what character name -> character code mapping
1037 we are using. Window-system-specific code sets this to some symbol, 1046 we are using. Window-system-specific code sets this to some symbol,
1038 and we use that symbol as the plist key to convert keysyms into 8-bit 1047 and we use that symbol as the plist key to convert keysyms into 8-bit
1039 codes. In this way one can have several character sets predefined and 1048 codes. In this way one can have several character sets predefined and
1040 switch them by changing this. 1049 switch them by changing this.
1050
1051 #### This is utterly bogus and should be removed.
1041 */ 1052 */
1042 Lisp_Object Vcharacter_set_property; 1053 Lisp_Object Vcharacter_set_property;
1043 1054
1044 Emchar 1055 Emchar
1045 event_to_character (struct Lisp_Event *event, 1056 event_to_character (Lisp_Event *event,
1046 int allow_extra_modifiers, 1057 int allow_extra_modifiers,
1047 int allow_meta, 1058 int allow_meta,
1048 int allow_non_ascii) 1059 int allow_non_ascii)
1049 { 1060 {
1050 Emchar c = 0; 1061 Emchar c = 0;
1051 Lisp_Object code; 1062 Lisp_Object code;
1052 1063
1053 if (event->event_type != key_press_event) 1064 if (event->event_type != key_press_event)
1054 { 1065 {
1055 if (event->event_type == dead_event) abort (); 1066 assert (event->event_type != dead_event);
1056 return -1; 1067 return -1;
1057 } 1068 }
1058 if (!allow_extra_modifiers && 1069 if (!allow_extra_modifiers &&
1059 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT)) 1070 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1060 return -1; 1071 return -1;
1217 1228
1218 return head; 1229 return head;
1219 } 1230 }
1220 1231
1221 void 1232 void
1222 format_event_object (char *buf, struct Lisp_Event *event, int brief) 1233 format_event_object (char *buf, Lisp_Event *event, int brief)
1223 { 1234 {
1224 int mouse_p = 0; 1235 int mouse_p = 0;
1225 int mod = 0; 1236 int mod = 0;
1226 Lisp_Object key; 1237 Lisp_Object key;
1227 1238
1253 key = make_char (event->event.button.button + '0'); 1264 key = make_char (event->event.button.button + '0');
1254 break; 1265 break;
1255 } 1266 }
1256 case magic_event: 1267 case magic_event:
1257 { 1268 {
1258 CONST char *name = NULL; 1269 const char *name = NULL;
1259 1270
1260 #ifdef HAVE_X_WINDOWS 1271 #ifdef HAVE_X_WINDOWS
1261 { 1272 {
1262 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); 1273 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1263 if (CONSOLE_X_P (XCONSOLE (console))) 1274 if (CONSOLE_X_P (XCONSOLE (console)))
1301 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key)); 1312 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1302 *buf = 0; 1313 *buf = 0;
1303 } 1314 }
1304 else if (SYMBOLP (key)) 1315 else if (SYMBOLP (key))
1305 { 1316 {
1306 CONST char *str = 0; 1317 const char *str = 0;
1307 if (brief) 1318 if (brief)
1308 { 1319 {
1309 if (EQ (key, QKlinefeed)) str = "LFD"; 1320 if (EQ (key, QKlinefeed)) str = "LFD";
1310 else if (EQ (key, QKtab)) str = "TAB"; 1321 else if (EQ (key, QKtab)) str = "TAB";
1311 else if (EQ (key, QKreturn)) str = "RET"; 1322 else if (EQ (key, QKreturn)) str = "RET";
1320 memcpy (buf, str, i+1); 1331 memcpy (buf, str, i+1);
1321 str += i; 1332 str += i;
1322 } 1333 }
1323 else 1334 else
1324 { 1335 {
1325 struct Lisp_String *name = XSYMBOL (key)->name; 1336 Lisp_String *name = XSYMBOL (key)->name;
1326 memcpy (buf, string_data (name), string_length (name) + 1); 1337 memcpy (buf, string_data (name), string_length (name) + 1);
1327 str += string_length (name); 1338 str += string_length (name);
1328 } 1339 }
1329 } 1340 }
1330 else 1341 else
1356 Return the event object's `next' event, or nil if it has none. 1367 Return the event object's `next' event, or nil if it has none.
1357 The `next-event' field is changed by calling `set-next-event'. 1368 The `next-event' field is changed by calling `set-next-event'.
1358 */ 1369 */
1359 (event)) 1370 (event))
1360 { 1371 {
1361 struct Lisp_Event *e; 1372 Lisp_Event *e;
1362 CHECK_LIVE_EVENT (event); 1373 CHECK_LIVE_EVENT (event);
1363 1374
1364 return XEVENT_NEXT (event); 1375 return XEVENT_NEXT (event);
1365 } 1376 }
1366 1377
2096 This is in the form of a property list (alternating keyword/value pairs). 2107 This is in the form of a property list (alternating keyword/value pairs).
2097 */ 2108 */
2098 (event)) 2109 (event))
2099 { 2110 {
2100 Lisp_Object props = Qnil; 2111 Lisp_Object props = Qnil;
2101 struct Lisp_Event *e; 2112 Lisp_Event *e;
2102 struct gcpro gcpro1; 2113 struct gcpro gcpro1;
2103 2114
2104 CHECK_LIVE_EVENT (event); 2115 CHECK_LIVE_EVENT (event);
2105 e = XEVENT (event); 2116 e = XEVENT (event);
2106 GCPRO1 (props); 2117 GCPRO1 (props);
2227 defsymbol (&Qkey_press, "key-press"); 2238 defsymbol (&Qkey_press, "key-press");
2228 defsymbol (&Qbutton_press, "button-press"); 2239 defsymbol (&Qbutton_press, "button-press");
2229 defsymbol (&Qbutton_release, "button-release"); 2240 defsymbol (&Qbutton_release, "button-release");
2230 defsymbol (&Qmisc_user, "misc-user"); 2241 defsymbol (&Qmisc_user, "misc-user");
2231 defsymbol (&Qascii_character, "ascii-character"); 2242 defsymbol (&Qascii_character, "ascii-character");
2243
2244 defsymbol (&QKbackspace, "backspace");
2245 defsymbol (&QKtab, "tab");
2246 defsymbol (&QKlinefeed, "linefeed");
2247 defsymbol (&QKreturn, "return");
2248 defsymbol (&QKescape, "escape");
2249 defsymbol (&QKspace, "space");
2250 defsymbol (&QKdelete, "delete");
2251 }
2252
2253
2254 void
2255 reinit_vars_of_events (void)
2256 {
2257 Vevent_resource = Qnil;
2232 } 2258 }
2233 2259
2234 void 2260 void
2235 vars_of_events (void) 2261 vars_of_events (void)
2236 { 2262 {
2263 reinit_vars_of_events ();
2264
2237 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /* 2265 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2238 A symbol used to look up the 8-bit character of a keysym. 2266 A symbol used to look up the 8-bit character of a keysym.
2239 To convert a keysym symbol to an 8-bit code, as when that key is 2267 To convert a keysym symbol to an 8-bit code, as when that key is
2240 bound to self-insert-command, we will look up the property that this 2268 bound to self-insert-command, we will look up the property that this
2241 variable names on the property list of the keysym-symbol. The window- 2269 variable names on the property list of the keysym-symbol. The window-
2242 system-specific code will set up appropriate properties and set this 2270 system-specific code will set up appropriate properties and set this
2243 variable. 2271 variable.
2244 */ ); 2272 */ );
2245 Vcharacter_set_property = Qnil; 2273 Vcharacter_set_property = Qnil;
2246 2274 }
2247 Vevent_resource = Qnil;
2248
2249 QKbackspace = KEYSYM ("backspace");
2250 QKtab = KEYSYM ("tab");
2251 QKlinefeed = KEYSYM ("linefeed");
2252 QKreturn = KEYSYM ("return");
2253 QKescape = KEYSYM ("escape");
2254 QKspace = KEYSYM ("space");
2255 QKdelete = KEYSYM ("delete");
2256
2257 staticpro (&QKbackspace);
2258 staticpro (&QKtab);
2259 staticpro (&QKlinefeed);
2260 staticpro (&QKreturn);
2261 staticpro (&QKescape);
2262 staticpro (&QKspace);
2263 staticpro (&QKdelete);
2264 }