Mercurial > hg > xemacs-beta
comparison src/gui.c @ 398:74fd4e045ea6 r21-2-29
Import from CVS: tag r21-2-29
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:13:30 +0200 |
parents | aabb7f5b1c81 |
children | a86b2b5e0111 |
comparison
equal
deleted
inserted
replaced
397:f4aeb21a5bad | 398:74fd4e045ea6 |
---|---|
32 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; | 32 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; |
33 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; | 33 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; |
34 Lisp_Object Q_accelerator, Q_label, Q_callback; | 34 Lisp_Object Q_accelerator, Q_label, Q_callback; |
35 Lisp_Object Qtoggle, Qradio; | 35 Lisp_Object Qtoggle, Qradio; |
36 | 36 |
37 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); | |
38 | |
37 #ifdef HAVE_POPUPS | 39 #ifdef HAVE_POPUPS |
38 | 40 |
39 /* count of menus/dboxes currently up */ | 41 /* count of menus/dboxes currently up */ |
40 int popup_up_p; | 42 int popup_up_p; |
41 | 43 |
48 return popup_up_p ? Qt : Qnil; | 50 return popup_up_p ? Qt : Qnil; |
49 } | 51 } |
50 #endif /* HAVE_POPUPS */ | 52 #endif /* HAVE_POPUPS */ |
51 | 53 |
52 int | 54 int |
53 separator_string_p (CONST char *s) | 55 separator_string_p (const char *s) |
54 { | 56 { |
55 CONST char *p; | 57 const char *p; |
56 char first; | 58 char first; |
57 | 59 |
58 if (!s || s[0] == '\0') | 60 if (!s || s[0] == '\0') |
59 return 0; | 61 return 0; |
60 first = s[0]; | 62 first = s[0]; |
72 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) | 74 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) |
73 { | 75 { |
74 if (SYMBOLP (data) | 76 if (SYMBOLP (data) |
75 || (COMPILED_FUNCTIONP (data) | 77 || (COMPILED_FUNCTIONP (data) |
76 && XCOMPILED_FUNCTION (data)->flags.interactivep) | 78 && XCOMPILED_FUNCTION (data)->flags.interactivep) |
77 || (EQ (XCAR (data), Qlambda) | 79 || (CONSP (data) && (EQ (XCAR (data), Qlambda)) |
78 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) | 80 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) |
79 { | 81 { |
80 *fn = Qcall_interactively; | 82 *fn = Qcall_interactively; |
81 *arg = data; | 83 *arg = data; |
82 } | 84 } |
95 data))); | 97 data))); |
96 } | 98 } |
97 } | 99 } |
98 | 100 |
99 /* | 101 /* |
100 * Initialize the gui_item structure by setting all (GC-protected) | |
101 * fields to their default values. The defaults are t for :active and | |
102 * :included values, and nil for others. | |
103 */ | |
104 void | |
105 gui_item_init (struct gui_item *pgui_item) | |
106 { | |
107 pgui_item->name = Qnil; | |
108 pgui_item->callback = Qnil; | |
109 pgui_item->suffix = Qnil; | |
110 pgui_item->active = Qt; | |
111 pgui_item->included = Qt; | |
112 pgui_item->config = Qnil; | |
113 pgui_item->filter = Qnil; | |
114 pgui_item->style = Qnil; | |
115 pgui_item->selected = Qnil; | |
116 pgui_item->keys = Qnil; | |
117 } | |
118 | |
119 /* | |
120 * Add a value VAL associated with keyword KEY into PGUI_ITEM | 102 * Add a value VAL associated with keyword KEY into PGUI_ITEM |
121 * 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 |
122 * error is signaled. | 104 * error is signaled. |
123 */ | 105 */ |
124 void | 106 void |
125 gui_item_add_keyval_pair (struct gui_item *pgui_item, | 107 gui_item_add_keyval_pair (Lisp_Object gui_item, |
126 Lisp_Object key, Lisp_Object val, | 108 Lisp_Object key, Lisp_Object val, |
127 Error_behavior errb) | 109 Error_behavior errb) |
128 { | 110 { |
111 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | |
112 | |
129 if (!KEYWORDP (key)) | 113 if (!KEYWORDP (key)) |
130 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); |
131 | 115 |
132 if (EQ (key, Q_suffix)) pgui_item->suffix = val; | 116 if (EQ (key, Q_suffix)) pgui_item->suffix = val; |
133 else if (EQ (key, Q_active)) pgui_item->active = val; | 117 else if (EQ (key, Q_active)) pgui_item->active = val; |
136 else if (EQ (key, Q_filter)) pgui_item->filter = val; | 120 else if (EQ (key, Q_filter)) pgui_item->filter = val; |
137 else if (EQ (key, Q_style)) pgui_item->style = val; | 121 else if (EQ (key, Q_style)) pgui_item->style = val; |
138 else if (EQ (key, Q_selected)) pgui_item->selected = val; | 122 else if (EQ (key, Q_selected)) pgui_item->selected = val; |
139 else if (EQ (key, Q_keys)) pgui_item->keys = val; | 123 else if (EQ (key, Q_keys)) pgui_item->keys = val; |
140 else if (EQ (key, Q_callback)) pgui_item->callback = val; | 124 else if (EQ (key, Q_callback)) pgui_item->callback = val; |
141 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */ | 125 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ |
142 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)) | |
128 { | |
129 if (SYMBOLP (val) || CHARP (val)) | |
130 pgui_item->accelerator = val; | |
131 else if (ERRB_EQ (errb, ERROR_ME)) | |
132 signal_simple_error ("Bad keyboard accelerator", val); | |
133 } | |
143 else if (ERRB_EQ (errb, ERROR_ME)) | 134 else if (ERRB_EQ (errb, ERROR_ME)) |
144 signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); | 135 signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); |
136 } | |
137 | |
138 void | |
139 gui_item_init (Lisp_Object gui_item) | |
140 { | |
141 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item); | |
142 | |
143 lp->name = Qnil; | |
144 lp->callback = Qnil; | |
145 lp->suffix = Qnil; | |
146 lp->active = Qt; | |
147 lp->included = Qt; | |
148 lp->config = Qnil; | |
149 lp->filter = Qnil; | |
150 lp->style = Qnil; | |
151 lp->selected = Qnil; | |
152 lp->keys = Qnil; | |
153 lp->accelerator = Qnil; | |
154 } | |
155 | |
156 Lisp_Object | |
157 allocate_gui_item (void) | |
158 { | |
159 Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item); | |
160 Lisp_Object val; | |
161 | |
162 zero_lcrecord (lp); | |
163 XSETGUI_ITEM (val, lp); | |
164 | |
165 gui_item_init (val); | |
166 | |
167 return val; | |
145 } | 168 } |
146 | 169 |
147 /* | 170 /* |
148 * ITEM is a lisp vector, describing a menu item or a button. The | 171 * ITEM is a lisp vector, describing a menu item or a button. The |
149 * function extracts the description of the item into the PGUI_ITEM | 172 * function extracts the description of the item into the PGUI_ITEM |
150 * structure. | 173 * structure. |
151 */ | 174 */ |
152 static void | 175 static Lisp_Object |
153 gui_parse_item_keywords_internal (Lisp_Object item, struct gui_item *pgui_item, | 176 make_gui_item_from_keywords_internal (Lisp_Object item, |
154 Error_behavior errb) | 177 Error_behavior errb) |
155 { | 178 { |
156 int length, plist_p, start; | 179 int length, plist_p, start; |
157 Lisp_Object *contents; | 180 Lisp_Object *contents; |
181 Lisp_Object gui_item = allocate_gui_item (); | |
182 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | |
158 | 183 |
159 CHECK_VECTOR (item); | 184 CHECK_VECTOR (item); |
160 length = XVECTOR_LENGTH (item); | 185 length = XVECTOR_LENGTH (item); |
161 contents = XVECTOR_DATA (item); | 186 contents = XVECTOR_DATA (item); |
162 | 187 |
179 if (length > 1 && !KEYWORDP (contents [1])) | 204 if (length > 1 && !KEYWORDP (contents [1])) |
180 { | 205 { |
181 pgui_item->callback = contents [1]; | 206 pgui_item->callback = contents [1]; |
182 start = 2; | 207 start = 2; |
183 } | 208 } |
184 else | 209 else |
185 start =1; | 210 start =1; |
186 | 211 |
187 if (!plist_p && length > 2) | 212 if (!plist_p && length > 2) |
188 /* the old way */ | 213 /* the old way */ |
189 { | 214 { |
202 | 227 |
203 for (i = start; i < length;) | 228 for (i = start; i < length;) |
204 { | 229 { |
205 Lisp_Object key = contents [i++]; | 230 Lisp_Object key = contents [i++]; |
206 Lisp_Object val = contents [i++]; | 231 Lisp_Object val = contents [i++]; |
207 gui_item_add_keyval_pair (pgui_item, key, val, errb); | 232 gui_item_add_keyval_pair (gui_item, key, val, errb); |
208 } | 233 } |
209 } | 234 } |
210 } | 235 return gui_item; |
211 | 236 } |
237 | |
238 Lisp_Object | |
239 gui_parse_item_keywords (Lisp_Object item) | |
240 { | |
241 return make_gui_item_from_keywords_internal (item, ERROR_ME); | |
242 } | |
243 | |
244 Lisp_Object | |
245 gui_parse_item_keywords_no_errors (Lisp_Object item) | |
246 { | |
247 return make_gui_item_from_keywords_internal (item, ERROR_ME_NOT); | |
248 } | |
249 | |
250 /* convert a gui item into plist properties */ | |
212 void | 251 void |
213 gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item) | 252 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) |
214 { | 253 { |
215 gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME); | 254 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); |
216 } | 255 |
217 | 256 if (!NILP (pgui_item->callback)) |
218 void | 257 Fplist_put (plist, Q_callback, pgui_item->callback); |
219 gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item) | 258 if (!NILP (pgui_item->suffix)) |
220 { | 259 Fplist_put (plist, Q_suffix, pgui_item->suffix); |
221 gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME_NOT); | 260 if (!NILP (pgui_item->active)) |
261 Fplist_put (plist, Q_active, pgui_item->active); | |
262 if (!NILP (pgui_item->included)) | |
263 Fplist_put (plist, Q_included, pgui_item->included); | |
264 if (!NILP (pgui_item->config)) | |
265 Fplist_put (plist, Q_config, pgui_item->config); | |
266 if (!NILP (pgui_item->filter)) | |
267 Fplist_put (plist, Q_filter, pgui_item->filter); | |
268 if (!NILP (pgui_item->style)) | |
269 Fplist_put (plist, Q_style, pgui_item->style); | |
270 if (!NILP (pgui_item->selected)) | |
271 Fplist_put (plist, Q_selected, pgui_item->selected); | |
272 if (!NILP (pgui_item->keys)) | |
273 Fplist_put (plist, Q_keys, pgui_item->keys); | |
274 if (!NILP (pgui_item->accelerator)) | |
275 Fplist_put (plist, Q_accelerator, pgui_item->accelerator); | |
222 } | 276 } |
223 | 277 |
224 /* | 278 /* |
225 * Decide whether a GUI item is active by evaluating its :active form | 279 * Decide whether a GUI item is active by evaluating its :active form |
226 * if any | 280 * if any |
227 */ | 281 */ |
228 int | 282 int |
229 gui_item_active_p (CONST struct gui_item *pgui_item) | 283 gui_item_active_p (Lisp_Object gui_item) |
230 { | 284 { |
231 /* This function can call lisp */ | 285 /* This function can call lisp */ |
232 | 286 |
233 /* Shortcut to avoid evaluating Qt each time */ | 287 /* Shortcut to avoid evaluating Qt each time */ |
234 return (EQ (pgui_item->active, Qt) | 288 return (EQ (XGUI_ITEM (gui_item)->active, Qt) |
235 || !NILP (Feval (pgui_item->active))); | 289 || !NILP (Feval (XGUI_ITEM (gui_item)->active))); |
290 } | |
291 | |
292 /* set menu accelerator key to first underlined character in menu name */ | |
293 Lisp_Object | |
294 gui_item_accelerator (Lisp_Object gui_item) | |
295 { | |
296 Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item); | |
297 | |
298 if (!NILP (pgui->accelerator)) | |
299 return pgui->accelerator; | |
300 | |
301 else | |
302 return gui_name_accelerator (pgui->name); | |
303 } | |
304 | |
305 Lisp_Object | |
306 gui_name_accelerator (Lisp_Object nm) | |
307 { | |
308 /* !!#### This function has not been Mule-ized */ | |
309 char* name = (char*)XSTRING_DATA (nm); | |
310 | |
311 while (*name) { | |
312 if (*name=='%') { | |
313 ++name; | |
314 if (!(*name)) | |
315 return Qnil; | |
316 if (*name=='_' && *(name+1)) | |
317 { | |
318 int accelerator = (int) (unsigned char) (*(name+1)); | |
319 return make_char (tolower (accelerator)); | |
320 } | |
321 } | |
322 ++name; | |
323 } | |
324 return Qnil; | |
236 } | 325 } |
237 | 326 |
238 /* | 327 /* |
239 * Decide whether a GUI item is selected by evaluating its :selected form | 328 * Decide whether a GUI item is selected by evaluating its :selected form |
240 * if any | 329 * if any |
241 */ | 330 */ |
242 int | 331 int |
243 gui_item_selected_p (CONST struct gui_item *pgui_item) | 332 gui_item_selected_p (Lisp_Object gui_item) |
244 { | 333 { |
245 /* This function can call lisp */ | 334 /* This function can call lisp */ |
246 | 335 |
247 /* Shortcut to avoid evaluating Qt each time */ | 336 /* Shortcut to avoid evaluating Qt each time */ |
248 return (EQ (pgui_item->selected, Qt) | 337 return (EQ (XGUI_ITEM (gui_item)->selected, Qt) |
249 || !NILP (Feval (pgui_item->selected))); | 338 || !NILP (Feval (XGUI_ITEM (gui_item)->selected))); |
250 } | 339 } |
251 | 340 |
252 /* | 341 /* |
253 * Decide whether a GUI item is included by evaluating its :included | 342 * Decide whether a GUI item is included by evaluating its :included |
254 * form if given, and testing its :config form against supplied CONFLIST | 343 * form if given, and testing its :config form against supplied CONFLIST |
255 * configuration variable | 344 * configuration variable |
256 */ | 345 */ |
257 int | 346 int |
258 gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist) | 347 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) |
259 { | 348 { |
260 /* This function can call lisp */ | 349 /* This function can call lisp */ |
350 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | |
261 | 351 |
262 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ | 352 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ |
263 if (!EQ (pgui_item->included, Qt) | 353 if (!EQ (pgui_item->included, Qt) |
264 && NILP (Feval (pgui_item->included))) | 354 && NILP (Feval (pgui_item->included))) |
265 return 0; | 355 return 0; |
287 * signaled. | 377 * signaled. |
288 * Return value is the offset to the terminating null character into the | 378 * Return value is the offset to the terminating null character into the |
289 * buffer. | 379 * buffer. |
290 */ | 380 */ |
291 unsigned int | 381 unsigned int |
292 gui_item_display_flush_left (CONST struct gui_item *pgui_item, | 382 gui_item_display_flush_left (Lisp_Object gui_item, |
293 char* buf, Bytecount buf_len) | 383 char* buf, Bytecount buf_len) |
294 { | 384 { |
385 /* This function can call lisp */ | |
295 char *p = buf; | 386 char *p = buf; |
296 Bytecount len; | 387 Bytecount len; |
388 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | |
297 | 389 |
298 /* Copy item name first */ | 390 /* Copy item name first */ |
299 CHECK_STRING (pgui_item->name); | 391 CHECK_STRING (pgui_item->name); |
300 len = XSTRING_LENGTH (pgui_item->name); | 392 len = XSTRING_LENGTH (pgui_item->name); |
301 if (len > buf_len) | 393 if (len > buf_len) |
334 * signaled. | 426 * signaled. |
335 * Return value is the offset to the terminating null character into the | 427 * Return value is the offset to the terminating null character into the |
336 * buffer. | 428 * buffer. |
337 */ | 429 */ |
338 unsigned int | 430 unsigned int |
339 gui_item_display_flush_right (CONST struct gui_item *pgui_item, | 431 gui_item_display_flush_right (Lisp_Object gui_item, |
340 char* buf, Bytecount buf_len) | 432 char* buf, Bytecount buf_len) |
341 { | 433 { |
434 Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); | |
342 *buf = 0; | 435 *buf = 0; |
343 | 436 |
437 #ifdef HAVE_MENUBARS | |
344 /* Have keys? */ | 438 /* Have keys? */ |
345 if (!menubar_show_keybindings) | 439 if (!menubar_show_keybindings) |
346 return 0; | 440 return 0; |
441 #endif | |
347 | 442 |
348 /* Try :keys first */ | 443 /* Try :keys first */ |
349 if (!NILP (pgui_item->keys)) | 444 if (!NILP (pgui_item->keys)) |
350 { | 445 { |
351 CHECK_STRING (pgui_item->keys); | 446 CHECK_STRING (pgui_item->keys); |
352 if (XSTRING_LENGTH (pgui_item->keys) > buf_len) | 447 if (XSTRING_LENGTH (pgui_item->keys) > buf_len) |
353 signal_too_long_error (pgui_item->name); | 448 signal_too_long_error (pgui_item->name); |
354 strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys)); | 449 strcpy (buf, (const char *) XSTRING_DATA (pgui_item->keys)); |
355 return XSTRING_LENGTH (pgui_item->keys); | 450 return XSTRING_LENGTH (pgui_item->keys); |
356 } | 451 } |
357 | 452 |
358 /* See if we can derive keys out of callback symbol */ | 453 /* See if we can derive keys out of callback symbol */ |
359 if (SYMBOLP (pgui_item->callback)) | 454 if (SYMBOLP (pgui_item->callback)) |
372 /* No keys - no right flush display */ | 467 /* No keys - no right flush display */ |
373 return 0; | 468 return 0; |
374 } | 469 } |
375 #endif /* HAVE_WINDOW_SYSTEM */ | 470 #endif /* HAVE_WINDOW_SYSTEM */ |
376 | 471 |
377 Lisp_Object | 472 static Lisp_Object |
378 mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)) | 473 mark_gui_item (Lisp_Object obj) |
379 { | 474 { |
380 markobj (p->name); | 475 Lisp_Gui_Item *p = XGUI_ITEM (obj); |
381 markobj (p->callback); | 476 |
382 markobj (p->suffix); | 477 mark_object (p->name); |
383 markobj (p->active); | 478 mark_object (p->callback); |
384 markobj (p->included); | 479 mark_object (p->config); |
385 markobj (p->config); | 480 mark_object (p->suffix); |
386 markobj (p->filter); | 481 mark_object (p->active); |
387 markobj (p->style); | 482 mark_object (p->included); |
388 markobj (p->selected); | 483 mark_object (p->config); |
389 markobj (p->keys); | 484 mark_object (p->filter); |
485 mark_object (p->style); | |
486 mark_object (p->selected); | |
487 mark_object (p->keys); | |
488 mark_object (p->accelerator); | |
390 | 489 |
391 return Qnil; | 490 return Qnil; |
392 } | 491 } |
393 | 492 |
493 static unsigned long | |
494 gui_item_hash (Lisp_Object obj, int depth) | |
495 { | |
496 Lisp_Gui_Item *p = XGUI_ITEM (obj); | |
497 | |
498 return HASH2 (HASH5 (internal_hash (p->name, depth + 1), | |
499 internal_hash (p->callback, depth + 1), | |
500 internal_hash (p->suffix, depth + 1), | |
501 internal_hash (p->active, depth + 1), | |
502 internal_hash (p->included, depth + 1)), | |
503 HASH5 (internal_hash (p->config, depth + 1), | |
504 internal_hash (p->filter, depth + 1), | |
505 internal_hash (p->style, depth + 1), | |
506 internal_hash (p->selected, depth + 1), | |
507 internal_hash (p->keys, depth + 1))); | |
508 } | |
509 | |
394 int | 510 int |
395 gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot) | 511 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) |
396 { | 512 { |
397 int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0)); | 513 int hashid = gui_item_hash (gitem, 0); |
398 int id = GUI_ITEM_ID_BITS (hashid, slot); | 514 int id = GUI_ITEM_ID_BITS (hashid, slot); |
399 while (!NILP (Fgethash (make_int (id), | 515 while (!NILP (Fgethash (make_int (id), |
400 hashtable, Qnil))) | 516 hashtable, Qnil))) |
401 { | 517 { |
402 id = GUI_ITEM_ID_BITS (id + 1, slot); | 518 id = GUI_ITEM_ID_BITS (id + 1, slot); |
403 } | 519 } |
404 return id; | 520 return id; |
405 } | 521 } |
522 | |
523 static int | |
524 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
525 { | |
526 Lisp_Gui_Item *p1 = XGUI_ITEM (obj1); | |
527 Lisp_Gui_Item *p2 = XGUI_ITEM (obj2); | |
528 | |
529 if (!(internal_equal (p1->name, p2->name, depth + 1) | |
530 && | |
531 internal_equal (p1->callback, p2->callback, depth + 1) | |
532 && | |
533 EQ (p1->suffix, p2->suffix) | |
534 && | |
535 EQ (p1->active, p2->active) | |
536 && | |
537 EQ (p1->included, p2->included) | |
538 && | |
539 EQ (p1->config, p2->config) | |
540 && | |
541 EQ (p1->filter, p2->filter) | |
542 && | |
543 EQ (p1->style, p2->style) | |
544 && | |
545 EQ (p1->selected, p2->selected) | |
546 && | |
547 EQ (p1->accelerator, p2->accelerator) | |
548 && | |
549 EQ (p1->keys, p2->keys))) | |
550 return 0; | |
551 return 1; | |
552 } | |
553 | |
554 static void | |
555 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
556 { | |
557 Lisp_Gui_Item *g = XGUI_ITEM (obj); | |
558 char buf[20]; | |
559 | |
560 if (print_readably) | |
561 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid); | |
562 | |
563 write_c_string ("#<gui-item ", printcharfun); | |
564 sprintf (buf, "0x%x>", g->header.uid); | |
565 write_c_string (buf, printcharfun); | |
566 } | |
567 | |
568 /* parse a glyph descriptor into a tree of gui items. | |
569 | |
570 The gui_item slot of an image instance can be a single item or an | |
571 arbitrarily nested hierarchy of item lists. */ | |
572 | |
573 static Lisp_Object parse_gui_item_tree_item (Lisp_Object entry) | |
574 { | |
575 Lisp_Object ret = entry; | |
576 if (VECTORP (entry)) | |
577 { | |
578 ret = gui_parse_item_keywords_no_errors (entry); | |
579 } | |
580 else if (STRINGP (entry)) | |
581 { | |
582 CHECK_STRING (entry); | |
583 } | |
584 else | |
585 signal_simple_error ("item must be a vector or a string", entry); | |
586 | |
587 return ret; | |
588 } | |
589 | |
590 Lisp_Object parse_gui_item_tree_children (Lisp_Object list) | |
591 { | |
592 Lisp_Object rest, ret = Qnil; | |
593 CHECK_CONS (list); | |
594 /* recursively add items to the tree view */ | |
595 LIST_LOOP (rest, list) | |
596 { | |
597 Lisp_Object sub; | |
598 if (CONSP (XCAR (rest))) | |
599 sub = parse_gui_item_tree_list (XCAR (rest)); | |
600 else | |
601 sub = parse_gui_item_tree_item (XCAR (rest)); | |
602 | |
603 ret = Fcons (sub, ret); | |
604 } | |
605 /* make the order the same as the items we have parsed */ | |
606 return Fnreverse (ret); | |
607 } | |
608 | |
609 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list) | |
610 { | |
611 Lisp_Object ret; | |
612 CHECK_CONS (list); | |
613 /* first one can never be a list */ | |
614 ret = parse_gui_item_tree_item (XCAR (list)); | |
615 return Fcons (ret, parse_gui_item_tree_children (XCDR (list))); | |
616 } | |
617 | |
618 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, | |
619 mark_gui_item, print_gui_item, | |
620 0, gui_item_equal, | |
621 gui_item_hash, | |
622 0, | |
623 Lisp_Gui_Item); | |
406 | 624 |
407 void | 625 void |
408 syms_of_gui (void) | 626 syms_of_gui (void) |
409 { | 627 { |
410 defkeyword (&Q_active, ":active"); | 628 defkeyword (&Q_active, ":active"); |