Mercurial > hg > xemacs-beta

comparison src/gui.c @ 406:b8cc9ab3f761 r21-2-33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-33
author cvs
date Mon, 13 Aug 2007 11:17:09 +0200
parents 2f8bb876ab1d
children 501cfd01ee6d
comparison
equal deleted inserted replaced
405:0e08f63c74d2 406:b8cc9ab3f761
30 #include "buffer.h" 30 #include "buffer.h"
31 #include "bytecode.h" 31 #include "bytecode.h"
32 32
33 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; 33 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
34 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; 34 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence;
35 Lisp_Object Q_accelerator, Q_label, Q_callback; 35 Lisp_Object Q_accelerator, Q_label, Q_callback, Q_callback_ex, Q_value;
36 Lisp_Object Qtoggle, Qradio; 36 Lisp_Object Qtoggle, Qradio;
37 37
38 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); 38 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list);
39 39
40 #ifdef HAVE_POPUPS 40 #ifdef HAVE_POPUPS
72 /* Massage DATA to find the correct function and argument. Used by 72 /* Massage DATA to find the correct function and argument. Used by
73 popup_selection_callback() and the msw code. */ 73 popup_selection_callback() and the msw code. */
74 void 74 void
75 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) 75 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
76 { 76 {
77 if (SYMBOLP (data) 77 if (EQ (data, Qquit))
78 {
79 *fn = Qeval;
80 *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil);
81 Vquit_flag = Qt;
82 }
83 else if (SYMBOLP (data)
78 || (COMPILED_FUNCTIONP (data) 84 || (COMPILED_FUNCTIONP (data)
79 && XCOMPILED_FUNCTION (data)->flags.interactivep) 85 && XCOMPILED_FUNCTION (data)->flags.interactivep)
80 || (CONSP (data) && (EQ (XCAR (data), Qlambda)) 86 || (CONSP (data) && (EQ (XCAR (data), Qlambda))
81 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) 87 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
82 { 88 {
120 else if (EQ (key, Q_config)) pgui_item->config = val; 126 else if (EQ (key, Q_config)) pgui_item->config = val;
121 else if (EQ (key, Q_filter)) pgui_item->filter = val; 127 else if (EQ (key, Q_filter)) pgui_item->filter = val;
122 else if (EQ (key, Q_style)) pgui_item->style = val; 128 else if (EQ (key, Q_style)) pgui_item->style = val;
123 else if (EQ (key, Q_selected)) pgui_item->selected = val; 129 else if (EQ (key, Q_selected)) pgui_item->selected = val;
124 else if (EQ (key, Q_keys)) pgui_item->keys = val; 130 else if (EQ (key, Q_keys)) pgui_item->keys = val;
125 else if (EQ (key, Q_callback)) pgui_item->callback = val; 131 else if (EQ (key, Q_callback)) pgui_item->callback = val;
132 else if (EQ (key, Q_callback_ex)) pgui_item->callback_ex = val;
133 else if (EQ (key, Q_value)) pgui_item->value = val;
126 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ 134 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */
127 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ 135 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */
128 else if (EQ (key, Q_accelerator)) 136 else if (EQ (key, Q_accelerator))
129 { 137 {
130 if (SYMBOLP (val) || CHARP (val)) 138 if (SYMBOLP (val) || CHARP (val))
142 { 150 {
143 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item); 151 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item);
144 152
145 lp->name = Qnil; 153 lp->name = Qnil;
146 lp->callback = Qnil; 154 lp->callback = Qnil;
155 lp->callback_ex = Qnil;
147 lp->suffix = Qnil; 156 lp->suffix = Qnil;
148 lp->active = Qt; 157 lp->active = Qt;
149 lp->included = Qt; 158 lp->included = Qt;
150 lp->config = Qnil; 159 lp->config = Qnil;
151 lp->filter = Qnil; 160 lp->filter = Qnil;
152 lp->style = Qnil; 161 lp->style = Qnil;
153 lp->selected = Qnil; 162 lp->selected = Qnil;
154 lp->keys = Qnil; 163 lp->keys = Qnil;
155 lp->accelerator = Qnil; 164 lp->accelerator = Qnil;
165 lp->value = Qnil;
156 } 166 }
157 167
158 Lisp_Object 168 Lisp_Object
159 allocate_gui_item (void) 169 allocate_gui_item (void)
160 { 170 {
255 { 265 {
256 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); 266 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
257 267
258 if (!NILP (pgui_item->callback)) 268 if (!NILP (pgui_item->callback))
259 Fplist_put (plist, Q_callback, pgui_item->callback); 269 Fplist_put (plist, Q_callback, pgui_item->callback);
270 if (!NILP (pgui_item->callback_ex))
271 Fplist_put (plist, Q_callback_ex, pgui_item->callback_ex);
260 if (!NILP (pgui_item->suffix)) 272 if (!NILP (pgui_item->suffix))
261 Fplist_put (plist, Q_suffix, pgui_item->suffix); 273 Fplist_put (plist, Q_suffix, pgui_item->suffix);
262 if (!NILP (pgui_item->active)) 274 if (!NILP (pgui_item->active))
263 Fplist_put (plist, Q_active, pgui_item->active); 275 Fplist_put (plist, Q_active, pgui_item->active);
264 if (!NILP (pgui_item->included)) 276 if (!NILP (pgui_item->included))
273 Fplist_put (plist, Q_selected, pgui_item->selected); 285 Fplist_put (plist, Q_selected, pgui_item->selected);
274 if (!NILP (pgui_item->keys)) 286 if (!NILP (pgui_item->keys))
275 Fplist_put (plist, Q_keys, pgui_item->keys); 287 Fplist_put (plist, Q_keys, pgui_item->keys);
276 if (!NILP (pgui_item->accelerator)) 288 if (!NILP (pgui_item->accelerator))
277 Fplist_put (plist, Q_accelerator, pgui_item->accelerator); 289 Fplist_put (plist, Q_accelerator, pgui_item->accelerator);
290 if (!NILP (pgui_item->value))
291 Fplist_put (plist, Q_value, pgui_item->value);
278 } 292 }
279 293
280 /* 294 /*
281 * Decide whether a GUI item is active by evaluating its :active form 295 * Decide whether a GUI item is active by evaluating its :active form
282 * if any 296 * if any
480 { 494 {
481 Lisp_Gui_Item *p = XGUI_ITEM (obj); 495 Lisp_Gui_Item *p = XGUI_ITEM (obj);
482 496
483 mark_object (p->name); 497 mark_object (p->name);
484 mark_object (p->callback); 498 mark_object (p->callback);
499 mark_object (p->callback_ex);
485 mark_object (p->config); 500 mark_object (p->config);
486 mark_object (p->suffix); 501 mark_object (p->suffix);
487 mark_object (p->active); 502 mark_object (p->active);
488 mark_object (p->included); 503 mark_object (p->included);
489 mark_object (p->config); 504 mark_object (p->config);
490 mark_object (p->filter); 505 mark_object (p->filter);
491 mark_object (p->style); 506 mark_object (p->style);
492 mark_object (p->selected); 507 mark_object (p->selected);
493 mark_object (p->keys); 508 mark_object (p->keys);
494 mark_object (p->accelerator); 509 mark_object (p->accelerator);
510 mark_object (p->value);
495 511
496 return Qnil; 512 return Qnil;
497 } 513 }
498 514
499 static unsigned long 515 static unsigned long
500 gui_item_hash_internal (Lisp_Object obj, int depth) 516 gui_item_hash (Lisp_Object obj, int depth)
501 { 517 {
502 Lisp_Gui_Item *p = XGUI_ITEM (obj); 518 Lisp_Gui_Item *p = XGUI_ITEM (obj);
503 519
504 return HASH2 (HASH5 (internal_hash (p->name, depth + 1), 520 return HASH2 (HASH6 (internal_hash (p->name, depth + 1),
505 internal_hash (p->callback, depth + 1), 521 internal_hash (p->callback, depth + 1),
522 internal_hash (p->callback_ex, depth + 1),
506 internal_hash (p->suffix, depth + 1), 523 internal_hash (p->suffix, depth + 1),
507 internal_hash (p->active, depth + 1), 524 internal_hash (p->active, depth + 1),
508 internal_hash (p->included, depth + 1)), 525 internal_hash (p->included, depth + 1)),
509 HASH5 (internal_hash (p->config, depth + 1), 526 HASH6 (internal_hash (p->config, depth + 1),
510 internal_hash (p->filter, depth + 1), 527 internal_hash (p->filter, depth + 1),
511 internal_hash (p->style, depth + 1), 528 internal_hash (p->style, depth + 1),
512 internal_hash (p->selected, depth + 1), 529 internal_hash (p->selected, depth + 1),
513 internal_hash (p->keys, depth + 1))); 530 internal_hash (p->keys, depth + 1),
514 } 531 internal_hash (p->value, depth + 1)));
515
516 static unsigned long
517 gui_item_hash (Lisp_Object obj, int depth)
518 {
519 Lisp_Gui_Item *p = XGUI_ITEM (obj);
520
521 /* Note that this evaluates the active and selected slots so that
522 the hash changes when the result of these changes. */
523 return HASH2 (HASH5 (internal_hash (p->name, depth + 1),
524 internal_hash (p->callback, depth + 1),
525 internal_hash (p->suffix, depth + 1),
526 gui_item_active_p (obj),
527 internal_hash (p->included, depth + 1)),
528 HASH5 (internal_hash (p->config, depth + 1),
529 internal_hash (p->filter, depth + 1),
530 internal_hash (p->style, depth + 1),
531 gui_item_selected_p (obj),
532 internal_hash (p->keys, depth + 1)));
533 } 532 }
534 533
535 int 534 int
536 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) 535 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot)
537 { 536 {
538 int hashid = gui_item_hash_internal (gitem, 0); 537 int hashid = gui_item_hash (gitem, 0);
539 int id = GUI_ITEM_ID_BITS (hashid, slot); 538 int id = GUI_ITEM_ID_BITS (hashid, slot);
540 while (!NILP (Fgethash (make_int (id), 539 while (!NILP (Fgethash (make_int (id),
541 hashtable, Qnil))) 540 hashtable, Qnil)))
542 { 541 {
543 id = GUI_ITEM_ID_BITS (id + 1, slot); 542 id = GUI_ITEM_ID_BITS (id + 1, slot);
553 552
554 if (!(internal_equal (p1->name, p2->name, depth + 1) 553 if (!(internal_equal (p1->name, p2->name, depth + 1)
555 && 554 &&
556 internal_equal (p1->callback, p2->callback, depth + 1) 555 internal_equal (p1->callback, p2->callback, depth + 1)
557 && 556 &&
557 internal_equal (p1->callback_ex, p2->callback_ex, depth + 1)
558 &&
558 EQ (p1->suffix, p2->suffix) 559 EQ (p1->suffix, p2->suffix)
559 && 560 &&
560 EQ (p1->active, p2->active) 561 EQ (p1->active, p2->active)
561 && 562 &&
562 EQ (p1->included, p2->included) 563 EQ (p1->included, p2->included)
569 && 570 &&
570 EQ (p1->selected, p2->selected) 571 EQ (p1->selected, p2->selected)
571 && 572 &&
572 EQ (p1->accelerator, p2->accelerator) 573 EQ (p1->accelerator, p2->accelerator)
573 && 574 &&
574 EQ (p1->keys, p2->keys))) 575 EQ (p1->keys, p2->keys)
576 &&
577 EQ (p1->value, p2->value)))
575 return 0; 578 return 0;
576 return 1; 579 return 1;
577 } 580 }
578 581
579 static void 582 static void
586 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid); 589 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid);
587 590
588 write_c_string ("#<gui-item ", printcharfun); 591 write_c_string ("#<gui-item ", printcharfun);
589 sprintf (buf, "0x%x>", g->header.uid); 592 sprintf (buf, "0x%x>", g->header.uid);
590 write_c_string (buf, printcharfun); 593 write_c_string (buf, printcharfun);
594 }
595
596 static Lisp_Object
597 copy_gui_item (Lisp_Object gui_item)
598 {
599 Lisp_Object ret = allocate_gui_item ();
600 Lisp_Gui_Item *lp, *g = XGUI_ITEM (gui_item);
601
602 lp = XGUI_ITEM (ret);
603 lp->name = g->name;
604 lp->callback = g->callback;
605 lp->callback_ex = g->callback_ex;
606 lp->suffix = g->suffix;
607 lp->active = g->active;
608 lp->included = g->included;
609 lp->config = g->config;
610 lp->filter = g->filter;
611 lp->style = g->style;
612 lp->selected = g->selected;
613 lp->keys = g->keys;
614 lp->accelerator = g->accelerator;
615 lp->value = g->value;
616
617 return ret;
618 }
619
620 Lisp_Object
621 copy_gui_item_tree (Lisp_Object arg)
622 {
623 if (CONSP (arg))
624 {
625 Lisp_Object rest = arg = Fcopy_sequence (arg);
626 while (CONSP (rest))
627 {
628 XCAR (rest) = copy_gui_item_tree (XCAR (rest));
629 rest = XCDR (rest);
630 }
631 return arg;
632 }
633 else if (GUI_ITEMP (arg))
634 return copy_gui_item (arg);
635 else
636 return arg;
591 } 637 }
592 638
593 /* parse a glyph descriptor into a tree of gui items. 639 /* parse a glyph descriptor into a tree of gui items.
594 640
595 The gui_item slot of an image instance can be a single item or an 641 The gui_item slot of an image instance can be a single item or an
679 defkeyword (&Q_config, ":config"); 725 defkeyword (&Q_config, ":config");
680 defkeyword (&Q_included, ":included"); 726 defkeyword (&Q_included, ":included");
681 defkeyword (&Q_accelerator, ":accelerator"); 727 defkeyword (&Q_accelerator, ":accelerator");
682 defkeyword (&Q_label, ":label"); 728 defkeyword (&Q_label, ":label");
683 defkeyword (&Q_callback, ":callback"); 729 defkeyword (&Q_callback, ":callback");
730 defkeyword (&Q_callback_ex, ":callback-ex");
731 defkeyword (&Q_value, ":value");
684 732
685 defsymbol (&Qtoggle, "toggle"); 733 defsymbol (&Qtoggle, "toggle");
686 defsymbol (&Qradio, "radio"); 734 defsymbol (&Qradio, "radio");
687 735
688 #ifdef HAVE_POPUPS 736 #ifdef HAVE_POPUPS