Mercurial > hg > xemacs-beta

comparison src/gui-x.c @ 420:41dbb7a9d5f2 r21-2-18

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-18
author cvs
date Mon, 13 Aug 2007 11:24:09 +0200
parents 697ef44129c6
children 11054d720c21
comparison
equal deleted inserted replaced
419:66615b78f1a5 420:41dbb7a9d5f2
33 #include "gui-x.h" 33 #include "gui-x.h"
34 #include "buffer.h" 34 #include "buffer.h"
35 #include "device.h" 35 #include "device.h"
36 #include "frame.h" 36 #include "frame.h"
37 #include "gui.h" 37 #include "gui.h"
38 #include "redisplay.h"
38 #include "opaque.h" 39 #include "opaque.h"
39 40
40 #ifdef HAVE_POPUPS
41 Lisp_Object Qmenu_no_selection_hook; 41 Lisp_Object Qmenu_no_selection_hook;
42 #endif
43 42
44 /* we need a unique id for each popup menu, dialog box, and scrollbar */ 43 /* we need a unique id for each popup menu, dialog box, and scrollbar */
45 static unsigned int lwlib_id_tick; 44 static unsigned int lwlib_id_tick;
46 45
47 LWLIB_ID 46 LWLIB_ID
57 if (!tmp) memory_full (); 56 if (!tmp) memory_full ();
58 return tmp; 57 return tmp;
59 } 58 }
60 59
61 60
62 #ifdef HAVE_POPUPS
63
64 struct mark_widget_value_closure 61 struct mark_widget_value_closure
65 { 62 {
66 void (*markobj) (Lisp_Object); 63 void (*markobj) (Lisp_Object);
67 }; 64 };
68 65
106 return data->last_menubar_buffer; 103 return data->last_menubar_buffer;
107 } 104 }
108 105
109 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, 106 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
110 mark_popup_data, internal_object_printer, 107 mark_popup_data, internal_object_printer,
111 0, 0, 0, struct popup_data); 108 0, 0, 0, 0, struct popup_data);
112 109
113 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of 110 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
114 (id . popup-data) for GCPRO'ing the callbacks of the popup menus 111 (id . popup-data) for GCPRO'ing the callbacks of the popup menus
115 and dialog boxes. */ 112 and dialog boxes. */
116 static Lisp_Object Vpopup_callbacks; 113 static Lisp_Object Vpopup_callbacks;
257 { 254 {
258 fn = Qrun_hooks; 255 fn = Qrun_hooks;
259 arg = Qmenu_no_selection_hook; 256 arg = Qmenu_no_selection_hook;
260 } 257 }
261 else 258 else
262 get_gui_callback (data, &fn, &arg); 259 {
260 MARK_SUBWINDOWS_CHANGED;
261 get_gui_callback (data, &fn, &arg);
262 }
263 263
264 /* This is the timestamp used for asserting focus so we need to get an 264 /* This is the timestamp used for asserting focus so we need to get an
265 up-to-date value event if no events has been dispatched to emacs 265 up-to-date value event if no events has been dispatched to emacs
266 */ 266 */
267 #if defined(HAVE_MENUBARS) 267 #if defined(HAVE_MENUBARS)
313 return xstrdup (p+1); 313 return xstrdup (p+1);
314 314
315 return NULL; 315 return NULL;
316 } 316 }
317 317
318 /* set menu accelerator key to first underlined character in menu name */
319
320 Lisp_Object
321 menu_name_to_accelerator (char *name)
322 {
323 while (*name) {
324 if (*name=='%') {
325 ++name;
326 if (!(*name))
327 return Qnil;
328 if (*name=='_' && *(name+1))
329 {
330 int accelerator = (int) (unsigned char) (*(name+1));
331 return make_char (tolower (accelerator));
332 }
333 }
334 ++name;
335 }
336 return Qnil;
337 }
338 318
339 /* This does the dirty work. gc_currently_forbidden is 1 when this is called. 319 /* This does the dirty work. gc_currently_forbidden is 1 when this is called.
340 */ 320 */
341
342 int 321 int
343 button_item_to_widget_value (Lisp_Object desc, widget_value *wv, 322 button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
344 int allow_text_field_p, int no_keys_p) 323 int allow_text_field_p, int no_keys_p)
345 { 324 {
346 /* !!#### This function has not been Mule-ized */ 325 /* !!#### This function has not been Mule-ized */
347 /* This function cannot GC because gc_currently_forbidden is set when 326 /* This function cannot GC because gc_currently_forbidden is set when
348 it's called */ 327 it's called */
349 Lisp_Object name = Qnil; 328 struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item);
350 Lisp_Object callback = Qnil; 329
351 Lisp_Object suffix = Qnil; 330 if (!NILP (pgui->filter))
352 Lisp_Object active_p = Qt; 331 signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item);
353 Lisp_Object include_p = Qt;
354 Lisp_Object selected_p = Qnil;
355 Lisp_Object keys = Qnil;
356 Lisp_Object style = Qnil;
357 Lisp_Object config_tag = Qnil;
358 Lisp_Object accel = Qnil;
359 int length = XVECTOR_LENGTH (desc);
360 Lisp_Object *contents = XVECTOR_DATA (desc);
361 int plist_p;
362 int selected_spec = 0, included_spec = 0;
363
364 if (length < 2)
365 signal_simple_error ("Button descriptors must be at least 2 long", desc);
366
367 /* length 2: [ "name" callback ]
368 length 3: [ "name" callback active-p ]
369 length 4: [ "name" callback active-p suffix ]
370 or [ "name" callback keyword value ]
371 length 5+: [ "name" callback [ keyword value ]+ ]
372 */
373 plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2])));
374
375 if (!plist_p && length > 2)
376 /* the old way */
377 {
378 name = contents [0];
379 callback = contents [1];
380 active_p = contents [2];
381 if (length == 4)
382 suffix = contents [3];
383 }
384 else
385 {
386 /* the new way */
387 int i;
388 if (length & 1)
389 signal_simple_error (
390 "Button descriptor has an odd number of keywords and values",
391 desc);
392
393 name = contents [0];
394 callback = contents [1];
395 for (i = 2; i < length;)
396 {
397 Lisp_Object key = contents [i++];
398 Lisp_Object val = contents [i++];
399 if (!KEYWORDP (key))
400 signal_simple_error_2 ("Not a keyword", key, desc);
401
402 if (EQ (key, Q_active)) active_p = val;
403 else if (EQ (key, Q_suffix)) suffix = val;
404 else if (EQ (key, Q_keys)) keys = val;
405 else if (EQ (key, Q_style)) style = val;
406 else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1;
407 else if (EQ (key, Q_included)) include_p = val, included_spec = 1;
408 else if (EQ (key, Q_config)) config_tag = val;
409 else if (EQ (key, Q_accelerator))
410 {
411 if ( SYMBOLP (val)
412 || CHARP (val))
413 accel = val;
414 else
415 signal_simple_error ("Bad keyboard accelerator", val);
416 }
417 else if (EQ (key, Q_filter))
418 signal_simple_error(":filter keyword not permitted on leaf nodes", desc);
419 else
420 signal_simple_error_2 ("Unknown menu item keyword", key, desc);
421 }
422 }
423 332
424 #ifdef HAVE_MENUBARS 333 #ifdef HAVE_MENUBARS
425 if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) 334 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
426 || (included_spec && NILP (Feval (include_p))))
427 { 335 {
428 /* the include specification says to ignore this item. */ 336 /* the include specification says to ignore this item. */
429 return 0; 337 return 0;
430 } 338 }
431 #endif /* HAVE_MENUBARS */ 339 #endif /* HAVE_MENUBARS */
432 340
433 CHECK_STRING (name); 341 CHECK_STRING (pgui->name);
434 wv->name = (char *) XSTRING_DATA (name); 342 wv->name = (char *) XSTRING_DATA (pgui->name);
435 343 wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
436 if (NILP (accel)) 344
437 accel = menu_name_to_accelerator (wv->name); 345 if (!NILP (pgui->suffix))
438 wv->accel = LISP_TO_VOID (accel);
439
440 if (!NILP (suffix))
441 { 346 {
442 CONST char *const_bogosity; 347 CONST char *const_bogosity;
443 Lisp_Object suffix2; 348 Lisp_Object suffix2;
444 349
445 /* Shortcut to avoid evaluating suffix each time */ 350 /* Shortcut to avoid evaluating suffix each time */
446 if (STRINGP (suffix)) 351 if (STRINGP (pgui->suffix))
447 suffix2 = suffix; 352 suffix2 = pgui->suffix;
448 else 353 else
449 { 354 {
450 suffix2 = Feval (suffix); 355 suffix2 = Feval (pgui->suffix);
451 CHECK_STRING (suffix2); 356 CHECK_STRING (suffix2);
452 } 357 }
453 358
454 GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity); 359 GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity);
455 wv->value = (char *) const_bogosity; 360 wv->value = (char *) const_bogosity;
456 wv->value = xstrdup (wv->value); 361 wv->value = xstrdup (wv->value);
457 } 362 }
458 363
459 wv_set_evalable_slot (wv->enabled, active_p); 364 wv_set_evalable_slot (wv->enabled, pgui->active);
460 wv_set_evalable_slot (wv->selected, selected_p); 365 wv_set_evalable_slot (wv->selected, pgui->selected);
461 366
462 wv->call_data = LISP_TO_VOID (callback); 367 if (!NILP (pgui->callback))
368 wv->call_data = LISP_TO_VOID (pgui->callback);
463 369
464 if (no_keys_p 370 if (no_keys_p
465 #ifdef HAVE_MENUBARS 371 #ifdef HAVE_MENUBARS
466 || !menubar_show_keybindings 372 || !menubar_show_keybindings
467 #endif 373 #endif
468 ) 374 )
469 wv->key = 0; 375 wv->key = 0;
470 else if (!NILP (keys)) /* Use this string to generate key bindings */ 376 else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */
471 { 377 {
472 CHECK_STRING (keys); 378 CHECK_STRING (pgui->keys);
473 keys = Fsubstitute_command_keys (keys); 379 pgui->keys = Fsubstitute_command_keys (pgui->keys);
474 if (XSTRING_LENGTH (keys) > 0) 380 if (XSTRING_LENGTH (pgui->keys) > 0)
475 wv->key = xstrdup ((char *) XSTRING_DATA (keys)); 381 wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys));
476 else 382 else
477 wv->key = 0; 383 wv->key = 0;
478 } 384 }
479 else if (SYMBOLP (callback)) /* Show the binding of this command. */ 385 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */
480 { 386 {
481 char buf [1024]; 387 char buf [1024];
482 /* #### Warning, dependency here on current_buffer and point */ 388 /* #### Warning, dependency here on current_buffer and point */
483 where_is_to_char (callback, buf); 389 where_is_to_char (pgui->callback, buf);
484 if (buf [0]) 390 if (buf [0])
485 wv->key = xstrdup (buf); 391 wv->key = xstrdup (buf);
486 else 392 else
487 wv->key = 0; 393 wv->key = 0;
488 } 394 }
489 395
490 CHECK_SYMBOL (style); 396 CHECK_SYMBOL (pgui->style);
491 if (NILP (style)) 397 if (NILP (pgui->style))
492 { 398 {
493 /* If the callback is nil, treat this item like unselectable text. 399 /* If the callback is nil, treat this item like unselectable text.
494 This way, dashes will show up as a separator. */ 400 This way, dashes will show up as a separator. */
495 if (!wv->enabled) 401 if (!wv->enabled)
496 wv->type = BUTTON_TYPE; 402 wv->type = BUTTON_TYPE;
513 else 419 else
514 #endif 420 #endif
515 wv->type = BUTTON_TYPE; 421 wv->type = BUTTON_TYPE;
516 } 422 }
517 } 423 }
518 else if (EQ (style, Qbutton)) 424 else if (EQ (pgui->style, Qbutton))
519 wv->type = BUTTON_TYPE; 425 wv->type = BUTTON_TYPE;
520 else if (EQ (style, Qtoggle)) 426 else if (EQ (pgui->style, Qtoggle))
521 wv->type = TOGGLE_TYPE; 427 wv->type = TOGGLE_TYPE;
522 else if (EQ (style, Qradio)) 428 else if (EQ (pgui->style, Qradio))
523 wv->type = RADIO_TYPE; 429 wv->type = RADIO_TYPE;
524 else if (EQ (style, Qtext)) 430 else if (EQ (pgui->style, Qtext))
525 { 431 {
526 wv->type = TEXT_TYPE; 432 wv->type = TEXT_TYPE;
527 #if 0 433 #if 0
528 wv->value = wv->name; 434 wv->value = wv->name;
529 wv->name = "value"; 435 wv->name = "value";
530 #endif 436 #endif
531 } 437 }
532 else 438 else
533 signal_simple_error_2 ("Unknown style", style, desc); 439 signal_simple_error_2 ("Unknown style", pgui->style, gui_item);
534 440
535 if (!allow_text_field_p && (wv->type == TEXT_TYPE)) 441 if (!allow_text_field_p && (wv->type == TEXT_TYPE))
536 signal_simple_error ("Text field not allowed in this context", desc); 442 signal_simple_error ("Text field not allowed in this context", gui_item);
537 443
538 if (selected_spec && EQ (style, Qtext)) 444 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
539 signal_simple_error ( 445 signal_simple_error (
540 ":selected only makes sense with :style toggle, radio or button", 446 ":selected only makes sense with :style toggle, radio or button",
541 desc); 447 gui_item);
542 return 1; 448 return 1;
543 } 449 }
544 450
545 #endif /* HAVE_POPUPS */
546 451
547 /* This is a kludge to make sure emacs can only link against a version of 452 /* This is a kludge to make sure emacs can only link against a version of
548 lwlib that was compiled in the right way. Emacs references symbols which 453 lwlib that was compiled in the right way. Emacs references symbols which
549 correspond to the way it thinks lwlib was compiled, and if lwlib wasn't 454 correspond to the way it thinks lwlib was compiled, and if lwlib wasn't
550 compiled in that way, then somewhat meaningful link errors will result. 455 compiled in that way, then somewhat meaningful link errors will result.
598 } 503 }
599 504
600 void 505 void
601 syms_of_gui_x (void) 506 syms_of_gui_x (void)
602 { 507 {
603 #ifdef HAVE_POPUPS
604 defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); 508 defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
605 #endif
606 } 509 }
607 510
608 void 511 void
609 vars_of_gui_x (void) 512 vars_of_gui_x (void)
610 { 513 {
611 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ 514 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */
612 515
613 #ifdef HAVE_POPUPS
614 popup_up_p = 0; 516 popup_up_p = 0;
615 517
616 Vpopup_callbacks = Qnil; 518 Vpopup_callbacks = Qnil;
617 staticpro (&Vpopup_callbacks); 519 staticpro (&Vpopup_callbacks);
618 520
623 Function or functions to call when a menu or dialog box is dismissed 525 Function or functions to call when a menu or dialog box is dismissed
624 without a selection having been made. 526 without a selection having been made.
625 */ ); 527 */ );
626 #endif 528 #endif
627 Fset (Qmenu_no_selection_hook, Qnil); 529 Fset (Qmenu_no_selection_hook, Qnil);
628 #endif /* HAVE_POPUPS */
629 530
630 /* this makes only safe calls as in emacs.c */ 531 /* this makes only safe calls as in emacs.c */
631 sanity_check_lwlib (); 532 sanity_check_lwlib ();
632 } 533 }