Mercurial > hg > xemacs-beta
comparison src/gui.c @ 440:8de8e3f6228a r21-2-28
Import from CVS: tag r21-2-28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:33:38 +0200 |
parents | 84b14dcb0985 |
children | abe6d1db359e |
comparison
equal
deleted
inserted
replaced
439:357dd071b03c | 440:8de8e3f6228a |
---|---|
103 * structure. If KEY is not a keyword, or is an unknown keyword, then | 103 * structure. If KEY is not a keyword, or is an unknown keyword, then |
104 * error is signaled. | 104 * error is signaled. |
105 */ | 105 */ |
106 void | 106 void |
107 gui_item_add_keyval_pair (Lisp_Object gui_item, | 107 gui_item_add_keyval_pair (Lisp_Object gui_item, |
108 Lisp_Object key, Lisp_Object val, | 108 Lisp_Object key, Lisp_Object val, |
109 Error_behavior errb) | 109 Error_behavior errb) |
110 { | 110 { |
111 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 111 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
112 | 112 |
113 if (!KEYWORDP (key)) | 113 if (!KEYWORDP (key)) |
114 signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); | 114 signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); |
115 | 115 |
116 if (EQ (key, Q_suffix)) pgui_item->suffix = val; | 116 if (EQ (key, Q_suffix)) pgui_item->suffix = val; |
120 else if (EQ (key, Q_filter)) pgui_item->filter = val; | 120 else if (EQ (key, Q_filter)) pgui_item->filter = val; |
121 else if (EQ (key, Q_style)) pgui_item->style = val; | 121 else if (EQ (key, Q_style)) pgui_item->style = val; |
122 else if (EQ (key, Q_selected)) pgui_item->selected = val; | 122 else if (EQ (key, Q_selected)) pgui_item->selected = val; |
123 else if (EQ (key, Q_keys)) pgui_item->keys = val; | 123 else if (EQ (key, Q_keys)) pgui_item->keys = val; |
124 else if (EQ (key, Q_callback)) pgui_item->callback = val; | 124 else if (EQ (key, Q_callback)) pgui_item->callback = val; |
125 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */ | 125 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ |
126 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ | 126 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ |
127 else if (EQ (key, Q_accelerator)) | 127 else if (EQ (key, Q_accelerator)) |
128 { | 128 { |
129 if (SYMBOLP (val) || CHARP (val)) | 129 if (SYMBOLP (val) || CHARP (val)) |
130 pgui_item->accelerator = val; | 130 pgui_item->accelerator = val; |
136 } | 136 } |
137 | 137 |
138 void | 138 void |
139 gui_item_init (Lisp_Object gui_item) | 139 gui_item_init (Lisp_Object gui_item) |
140 { | 140 { |
141 struct Lisp_Gui_Item *lp = XGUI_ITEM (gui_item); | 141 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item); |
142 | 142 |
143 lp->name = Qnil; | 143 lp->name = Qnil; |
144 lp->callback = Qnil; | 144 lp->callback = Qnil; |
145 lp->suffix = Qnil; | 145 lp->suffix = Qnil; |
146 lp->active = Qt; | 146 lp->active = Qt; |
154 } | 154 } |
155 | 155 |
156 Lisp_Object | 156 Lisp_Object |
157 allocate_gui_item (void) | 157 allocate_gui_item (void) |
158 { | 158 { |
159 struct Lisp_Gui_Item *lp = | 159 Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item); |
160 alloc_lcrecord_type (struct Lisp_Gui_Item, &lrecord_gui_item); | |
161 Lisp_Object val; | 160 Lisp_Object val; |
162 | 161 |
163 zero_lcrecord (lp); | 162 zero_lcrecord (lp); |
164 XSETGUI_ITEM (val, lp); | 163 XSETGUI_ITEM (val, lp); |
165 | 164 |
178 Error_behavior errb) | 177 Error_behavior errb) |
179 { | 178 { |
180 int length, plist_p, start; | 179 int length, plist_p, start; |
181 Lisp_Object *contents; | 180 Lisp_Object *contents; |
182 Lisp_Object gui_item = allocate_gui_item (); | 181 Lisp_Object gui_item = allocate_gui_item (); |
183 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 182 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
184 | 183 |
185 CHECK_VECTOR (item); | 184 CHECK_VECTOR (item); |
186 length = XVECTOR_LENGTH (item); | 185 length = XVECTOR_LENGTH (item); |
187 contents = XVECTOR_DATA (item); | 186 contents = XVECTOR_DATA (item); |
188 | 187 |
205 if (length > 1 && !KEYWORDP (contents [1])) | 204 if (length > 1 && !KEYWORDP (contents [1])) |
206 { | 205 { |
207 pgui_item->callback = contents [1]; | 206 pgui_item->callback = contents [1]; |
208 start = 2; | 207 start = 2; |
209 } | 208 } |
210 else | 209 else |
211 start =1; | 210 start =1; |
212 | 211 |
213 if (!plist_p && length > 2) | 212 if (!plist_p && length > 2) |
214 /* the old way */ | 213 /* the old way */ |
215 { | 214 { |
250 | 249 |
251 /* convert a gui item into plist properties */ | 250 /* convert a gui item into plist properties */ |
252 void | 251 void |
253 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) | 252 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) |
254 { | 253 { |
255 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 254 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
256 | 255 |
257 if (!NILP (pgui_item->callback)) | 256 if (!NILP (pgui_item->callback)) |
258 Fplist_put (plist, Q_callback, pgui_item->callback); | 257 Fplist_put (plist, Q_callback, pgui_item->callback); |
259 if (!NILP (pgui_item->suffix)) | 258 if (!NILP (pgui_item->suffix)) |
260 Fplist_put (plist, Q_suffix, pgui_item->suffix); | 259 Fplist_put (plist, Q_suffix, pgui_item->suffix); |
261 if (!NILP (pgui_item->active)) | 260 if (!NILP (pgui_item->active)) |
292 | 291 |
293 /* set menu accelerator key to first underlined character in menu name */ | 292 /* set menu accelerator key to first underlined character in menu name */ |
294 Lisp_Object | 293 Lisp_Object |
295 gui_item_accelerator (Lisp_Object gui_item) | 294 gui_item_accelerator (Lisp_Object gui_item) |
296 { | 295 { |
297 struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item); | 296 Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item); |
298 | 297 |
299 if (!NILP (pgui->accelerator)) | 298 if (!NILP (pgui->accelerator)) |
300 return pgui->accelerator; | 299 return pgui->accelerator; |
301 | 300 |
302 else | 301 else |
303 return pgui->name; | 302 return pgui->name; |
346 */ | 345 */ |
347 int | 346 int |
348 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) | 347 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) |
349 { | 348 { |
350 /* This function can call lisp */ | 349 /* This function can call lisp */ |
351 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 350 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
352 | 351 |
353 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ | 352 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ |
354 if (!EQ (pgui_item->included, Qt) | 353 if (!EQ (pgui_item->included, Qt) |
355 && NILP (Feval (pgui_item->included))) | 354 && NILP (Feval (pgui_item->included))) |
356 return 0; | 355 return 0; |
384 char* buf, Bytecount buf_len) | 383 char* buf, Bytecount buf_len) |
385 { | 384 { |
386 /* This function can call lisp */ | 385 /* This function can call lisp */ |
387 char *p = buf; | 386 char *p = buf; |
388 Bytecount len; | 387 Bytecount len; |
389 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 388 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
390 | 389 |
391 /* Copy item name first */ | 390 /* Copy item name first */ |
392 CHECK_STRING (pgui_item->name); | 391 CHECK_STRING (pgui_item->name); |
393 len = XSTRING_LENGTH (pgui_item->name); | 392 len = XSTRING_LENGTH (pgui_item->name); |
394 if (len > buf_len) | 393 if (len > buf_len) |
430 */ | 429 */ |
431 unsigned int | 430 unsigned int |
432 gui_item_display_flush_right (Lisp_Object gui_item, | 431 gui_item_display_flush_right (Lisp_Object gui_item, |
433 char* buf, Bytecount buf_len) | 432 char* buf, Bytecount buf_len) |
434 { | 433 { |
435 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | 434 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
436 *buf = 0; | 435 *buf = 0; |
437 | 436 |
438 #ifdef HAVE_MENUBARS | 437 #ifdef HAVE_MENUBARS |
439 /* Have keys? */ | 438 /* Have keys? */ |
440 if (!menubar_show_keybindings) | 439 if (!menubar_show_keybindings) |
471 #endif /* HAVE_WINDOW_SYSTEM */ | 470 #endif /* HAVE_WINDOW_SYSTEM */ |
472 | 471 |
473 static Lisp_Object | 472 static Lisp_Object |
474 mark_gui_item (Lisp_Object obj) | 473 mark_gui_item (Lisp_Object obj) |
475 { | 474 { |
476 struct Lisp_Gui_Item *p = XGUI_ITEM (obj); | 475 Lisp_Gui_Item *p = XGUI_ITEM (obj); |
477 | 476 |
478 mark_object (p->name); | 477 mark_object (p->name); |
479 mark_object (p->callback); | 478 mark_object (p->callback); |
480 mark_object (p->config); | 479 mark_object (p->config); |
481 mark_object (p->suffix); | 480 mark_object (p->suffix); |
492 } | 491 } |
493 | 492 |
494 static unsigned long | 493 static unsigned long |
495 gui_item_hash (Lisp_Object obj, int depth) | 494 gui_item_hash (Lisp_Object obj, int depth) |
496 { | 495 { |
497 struct Lisp_Gui_Item *p = XGUI_ITEM (obj); | 496 Lisp_Gui_Item *p = XGUI_ITEM (obj); |
498 | 497 |
499 return HASH2 (HASH5 (internal_hash (p->name, depth + 1), | 498 return HASH2 (HASH5 (internal_hash (p->name, depth + 1), |
500 internal_hash (p->callback, depth + 1), | 499 internal_hash (p->callback, depth + 1), |
501 internal_hash (p->suffix, depth + 1), | 500 internal_hash (p->suffix, depth + 1), |
502 internal_hash (p->active, depth + 1), | 501 internal_hash (p->active, depth + 1), |
522 } | 521 } |
523 | 522 |
524 static int | 523 static int |
525 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | 524 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) |
526 { | 525 { |
527 struct Lisp_Gui_Item *p1 = XGUI_ITEM (obj1); | 526 Lisp_Gui_Item *p1 = XGUI_ITEM (obj1); |
528 struct Lisp_Gui_Item *p2 = XGUI_ITEM (obj2); | 527 Lisp_Gui_Item *p2 = XGUI_ITEM (obj2); |
529 | 528 |
530 if (!(internal_equal (p1->name, p2->name, depth + 1) | 529 if (!(internal_equal (p1->name, p2->name, depth + 1) |
531 && | 530 && |
532 internal_equal (p1->callback, p2->callback, depth + 1) | 531 internal_equal (p1->callback, p2->callback, depth + 1) |
533 && | 532 && |
553 } | 552 } |
554 | 553 |
555 static void | 554 static void |
556 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 555 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
557 { | 556 { |
558 struct Lisp_Gui_Item *g = XGUI_ITEM (obj); | 557 Lisp_Gui_Item *g = XGUI_ITEM (obj); |
559 char buf[20]; | 558 char buf[20]; |
560 | 559 |
561 if (print_readably) | 560 if (print_readably) |
562 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid); | 561 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid); |
563 | 562 |
598 Lisp_Object sub; | 597 Lisp_Object sub; |
599 if (CONSP (XCAR (rest))) | 598 if (CONSP (XCAR (rest))) |
600 sub = parse_gui_item_tree_list (XCAR (rest)); | 599 sub = parse_gui_item_tree_list (XCAR (rest)); |
601 else | 600 else |
602 sub = parse_gui_item_tree_item (XCAR (rest)); | 601 sub = parse_gui_item_tree_item (XCAR (rest)); |
603 | 602 |
604 ret = Fcons (sub, ret); | 603 ret = Fcons (sub, ret); |
605 } | 604 } |
606 /* make the order the same as the items we have parsed */ | 605 /* make the order the same as the items we have parsed */ |
607 return Fnreverse (ret); | 606 return Fnreverse (ret); |
608 } | 607 } |
619 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, | 618 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, |
620 mark_gui_item, print_gui_item, | 619 mark_gui_item, print_gui_item, |
621 0, gui_item_equal, | 620 0, gui_item_equal, |
622 gui_item_hash, | 621 gui_item_hash, |
623 0, | 622 0, |
624 struct Lisp_Gui_Item); | 623 Lisp_Gui_Item); |
625 | 624 |
626 void | 625 void |
627 syms_of_gui (void) | 626 syms_of_gui (void) |
628 { | 627 { |
629 defkeyword (&Q_active, ":active"); | 628 defkeyword (&Q_active, ":active"); |