Mercurial > hg > xemacs-beta

comparison src/gui.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 501cfd01ee6d
children e804706bfb8c
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
25 25
26 #include <config.h> 26 #include <config.h>
27 #include "lisp.h" 27 #include "lisp.h"
28 #include "gui.h" 28 #include "gui.h"
29 #include "elhash.h" 29 #include "elhash.h"
30 #include "buffer.h"
31 #include "bytecode.h" 30 #include "bytecode.h"
32 31
33 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;
34 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; 33 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence;
35 Lisp_Object Q_accelerator, Q_label, Q_callback, Q_callback_ex, Q_value; 34 Lisp_Object Q_accelerator, Q_label, Q_callback;
36 Lisp_Object Qtoggle, Qradio; 35 Lisp_Object Qtoggle, Qradio;
37
38 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list);
39 36
40 #ifdef HAVE_POPUPS 37 #ifdef HAVE_POPUPS
41 38
42 /* count of menus/dboxes currently up */ 39 /* count of menus/dboxes currently up */
43 int popup_up_p; 40 int popup_up_p;
51 return popup_up_p ? Qt : Qnil; 48 return popup_up_p ? Qt : Qnil;
52 } 49 }
53 #endif /* HAVE_POPUPS */ 50 #endif /* HAVE_POPUPS */
54 51
55 int 52 int
56 separator_string_p (const char *s) 53 separator_string_p (CONST char *s)
57 { 54 {
58 const char *p; 55 CONST char *p;
59 char first; 56 char first;
60 57
61 if (!s || s[0] == '\0') 58 if (!s || s[0] == '\0')
62 return 0; 59 return 0;
63 first = s[0]; 60 first = s[0];
72 /* Massage DATA to find the correct function and argument. Used by 69 /* Massage DATA to find the correct function and argument. Used by
73 popup_selection_callback() and the msw code. */ 70 popup_selection_callback() and the msw code. */
74 void 71 void
75 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) 72 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
76 { 73 {
77 if (EQ (data, Qquit)) 74 if (SYMBOLP (data)
78 { 75 || (COMPILED_FUNCTIONP (data)
79 *fn = Qeval; 76 && XCOMPILED_FUNCTION (data)->flags.interactivep)
80 *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil); 77 || (EQ (XCAR (data), Qlambda)
81 Vquit_flag = Qt; 78 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
82 }
83 else if (SYMBOLP (data)
84 || (COMPILED_FUNCTIONP (data)
85 && XCOMPILED_FUNCTION (data)->flags.interactivep)
86 || (CONSP (data) && (EQ (XCAR (data), Qlambda))
87 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
88 { 79 {
89 *fn = Qcall_interactively; 80 *fn = Qcall_interactively;
90 *arg = data; 81 *arg = data;
91 } 82 }
92 else if (CONSP (data)) 83 else if (CONSP (data))
104 data))); 95 data)));
105 } 96 }
106 } 97 }
107 98
108 /* 99 /*
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 /*
109 * Add a value VAL associated with keyword KEY into PGUI_ITEM 120 * Add a value VAL associated with keyword KEY into PGUI_ITEM
110 * structure. If KEY is not a keyword, or is an unknown keyword, then 121 * structure. If KEY is not a keyword, or is an unknown keyword, then
111 * error is signaled. 122 * error is signaled.
112 */ 123 */
113 void 124 void
114 gui_item_add_keyval_pair (Lisp_Object gui_item, 125 gui_item_add_keyval_pair (struct gui_item *pgui_item,
115 Lisp_Object key, Lisp_Object val, 126 Lisp_Object key, Lisp_Object val,
116 Error_behavior errb) 127 Error_behavior errb)
117 { 128 {
118 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
119
120 if (!KEYWORDP (key)) 129 if (!KEYWORDP (key))
121 signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); 130 signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name);
122 131
123 if (EQ (key, Q_suffix)) pgui_item->suffix = val; 132 if (EQ (key, Q_suffix)) pgui_item->suffix = val;
124 else if (EQ (key, Q_active)) pgui_item->active = val; 133 else if (EQ (key, Q_active)) pgui_item->active = val;
126 else if (EQ (key, Q_config)) pgui_item->config = val; 135 else if (EQ (key, Q_config)) pgui_item->config = val;
127 else if (EQ (key, Q_filter)) pgui_item->filter = val; 136 else if (EQ (key, Q_filter)) pgui_item->filter = val;
128 else if (EQ (key, Q_style)) pgui_item->style = val; 137 else if (EQ (key, Q_style)) pgui_item->style = val;
129 else if (EQ (key, Q_selected)) pgui_item->selected = val; 138 else if (EQ (key, Q_selected)) pgui_item->selected = val;
130 else if (EQ (key, Q_keys)) pgui_item->keys = val; 139 else if (EQ (key, Q_keys)) pgui_item->keys = val;
131 else if (EQ (key, Q_callback)) pgui_item->callback = val; 140 else if (EQ (key, Q_callback)) pgui_item->callback = val;
132 else if (EQ (key, Q_callback_ex)) pgui_item->callback_ex = val; 141 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */
133 else if (EQ (key, Q_value)) pgui_item->value = val;
134 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */
135 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ 142 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */
136 else if (EQ (key, Q_accelerator))
137 {
138 if (SYMBOLP (val) || CHARP (val))
139 pgui_item->accelerator = val;
140 else if (ERRB_EQ (errb, ERROR_ME))
141 signal_simple_error ("Bad keyboard accelerator", val);
142 }
143 else if (ERRB_EQ (errb, ERROR_ME)) 143 else if (ERRB_EQ (errb, ERROR_ME))
144 signal_simple_error_2 ("Unknown keyword in gui item", key, 144 signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name);
145 pgui_item->name);
146 }
147
148 void
149 gui_item_init (Lisp_Object gui_item)
150 {
151 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item);
152
153 lp->name = Qnil;
154 lp->callback = Qnil;
155 lp->callback_ex = Qnil;
156 lp->suffix = Qnil;
157 lp->active = Qt;
158 lp->included = Qt;
159 lp->config = Qnil;
160 lp->filter = Qnil;
161 lp->style = Qnil;
162 lp->selected = Qnil;
163 lp->keys = Qnil;
164 lp->accelerator = Qnil;
165 lp->value = Qnil;
166 }
167
168 Lisp_Object
169 allocate_gui_item (void)
170 {
171 Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item);
172 Lisp_Object val;
173
174 zero_lcrecord (lp);
175 XSETGUI_ITEM (val, lp);
176
177 gui_item_init (val);
178
179 return val;
180 } 145 }
181 146
182 /* 147 /*
183 * ITEM is a lisp vector, describing a menu item or a button. The 148 * ITEM is a lisp vector, describing a menu item or a button. The
184 * function extracts the description of the item into the PGUI_ITEM 149 * function extracts the description of the item into the PGUI_ITEM
185 * structure. 150 * structure.
186 */ 151 */
187 static Lisp_Object 152 static void
188 make_gui_item_from_keywords_internal (Lisp_Object item, 153 gui_parse_item_keywords_internal (Lisp_Object item, struct gui_item *pgui_item,
189 Error_behavior errb) 154 Error_behavior errb)
190 { 155 {
191 int length, plist_p, start; 156 int length, plist_p, start;
192 Lisp_Object *contents; 157 Lisp_Object *contents;
193 Lisp_Object gui_item = allocate_gui_item ();
194 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
195 158
196 CHECK_VECTOR (item); 159 CHECK_VECTOR (item);
197 length = XVECTOR_LENGTH (item); 160 length = XVECTOR_LENGTH (item);
198 contents = XVECTOR_DATA (item); 161 contents = XVECTOR_DATA (item);
199 162
216 if (length > 1 && !KEYWORDP (contents [1])) 179 if (length > 1 && !KEYWORDP (contents [1]))
217 { 180 {
218 pgui_item->callback = contents [1]; 181 pgui_item->callback = contents [1];
219 start = 2; 182 start = 2;
220 } 183 }
221 else 184 else
222 start =1; 185 start =1;
223 186
224 if (!plist_p && length > 2) 187 if (!plist_p && length > 2)
225 /* the old way */ 188 /* the old way */
226 { 189 {
239 202
240 for (i = start; i < length;) 203 for (i = start; i < length;)
241 { 204 {
242 Lisp_Object key = contents [i++]; 205 Lisp_Object key = contents [i++];
243 Lisp_Object val = contents [i++]; 206 Lisp_Object val = contents [i++];
244 gui_item_add_keyval_pair (gui_item, key, val, errb); 207 gui_item_add_keyval_pair (pgui_item, key, val, errb);
245 } 208 }
246 } 209 }
247 return gui_item; 210 }
248 } 211
249 212 void
250 Lisp_Object 213 gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item)
251 gui_parse_item_keywords (Lisp_Object item) 214 {
252 { 215 gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME);
253 return make_gui_item_from_keywords_internal (item, ERROR_ME); 216 }
254 } 217
255 218 void
256 Lisp_Object 219 gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item)
257 gui_parse_item_keywords_no_errors (Lisp_Object item) 220 {
258 { 221 gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME_NOT);
259 return make_gui_item_from_keywords_internal (item, ERROR_ME_NOT);
260 }
261
262 /* convert a gui item into plist properties */
263 void
264 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item)
265 {
266 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
267
268 if (!NILP (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);
272 if (!NILP (pgui_item->suffix))
273 Fplist_put (plist, Q_suffix, pgui_item->suffix);
274 if (!NILP (pgui_item->active))
275 Fplist_put (plist, Q_active, pgui_item->active);
276 if (!NILP (pgui_item->included))
277 Fplist_put (plist, Q_included, pgui_item->included);
278 if (!NILP (pgui_item->config))
279 Fplist_put (plist, Q_config, pgui_item->config);
280 if (!NILP (pgui_item->filter))
281 Fplist_put (plist, Q_filter, pgui_item->filter);
282 if (!NILP (pgui_item->style))
283 Fplist_put (plist, Q_style, pgui_item->style);
284 if (!NILP (pgui_item->selected))
285 Fplist_put (plist, Q_selected, pgui_item->selected);
286 if (!NILP (pgui_item->keys))
287 Fplist_put (plist, Q_keys, pgui_item->keys);
288 if (!NILP (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);
292 } 222 }
293 223
294 /* 224 /*
295 * Decide whether a GUI item is active by evaluating its :active form 225 * Decide whether a GUI item is active by evaluating its :active form
296 * if any 226 * if any
297 */ 227 */
298 int 228 int
299 gui_item_active_p (Lisp_Object gui_item) 229 gui_item_active_p (CONST struct gui_item *pgui_item)
300 { 230 {
301 /* This function can call lisp */ 231 /* This function can call lisp */
302 232
303 /* Shortcut to avoid evaluating Qt each time */ 233 /* Shortcut to avoid evaluating Qt each time */
304 return (EQ (XGUI_ITEM (gui_item)->active, Qt) 234 return (EQ (pgui_item->active, Qt)
305 || !NILP (Feval (XGUI_ITEM (gui_item)->active))); 235 || !NILP (Feval (pgui_item->active)));
306 }
307
308 /* set menu accelerator key to first underlined character in menu name */
309 Lisp_Object
310 gui_item_accelerator (Lisp_Object gui_item)
311 {
312 Lisp_Gui_Item *pgui = XGUI_ITEM (gui_item);
313
314 if (!NILP (pgui->accelerator))
315 return pgui->accelerator;
316
317 else
318 return gui_name_accelerator (pgui->name);
319 }
320
321 Lisp_Object
322 gui_name_accelerator (Lisp_Object nm)
323 {
324 Bufbyte *name = XSTRING_DATA (nm);
325
326 while (*name)
327 {
328 if (*name == '%')
329 {
330 ++name;
331 if (!(*name))
332 return Qnil;
333 if (*name == '_' && *(name + 1))
334 {
335 Emchar accelerator = charptr_emchar (name + 1);
336 /* #### bogus current_buffer dependency */
337 return make_char (DOWNCASE (current_buffer, accelerator));
338 }
339 }
340 INC_CHARPTR (name);
341 }
342 return make_char (DOWNCASE (current_buffer,
343 charptr_emchar (XSTRING_DATA (nm))));
344 } 236 }
345 237
346 /* 238 /*
347 * Decide whether a GUI item is selected by evaluating its :selected form 239 * Decide whether a GUI item is selected by evaluating its :selected form
348 * if any 240 * if any
349 */ 241 */
350 int 242 int
351 gui_item_selected_p (Lisp_Object gui_item) 243 gui_item_selected_p (CONST struct gui_item *pgui_item)
352 { 244 {
353 /* This function can call lisp */ 245 /* This function can call lisp */
354 246
355 /* Shortcut to avoid evaluating Qt each time */ 247 /* Shortcut to avoid evaluating Qt each time */
356 return (EQ (XGUI_ITEM (gui_item)->selected, Qt) 248 return (EQ (pgui_item->selected, Qt)
357 || !NILP (Feval (XGUI_ITEM (gui_item)->selected))); 249 || !NILP (Feval (pgui_item->selected)));
358 } 250 }
359 251
360 /* 252 /*
361 * Decide whether a GUI item is included by evaluating its :included 253 * Decide whether a GUI item is included by evaluating its :included
362 * form if given, and testing its :config form against supplied CONFLIST 254 * form if given, and testing its :config form against supplied CONFLIST
363 * configuration variable 255 * configuration variable
364 */ 256 */
365 int 257 int
366 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) 258 gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist)
367 { 259 {
368 /* This function can call lisp */ 260 /* This function can call lisp */
369 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
370 261
371 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ 262 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
372 if (!EQ (pgui_item->included, Qt) 263 if (!EQ (pgui_item->included, Qt)
373 && NILP (Feval (pgui_item->included))) 264 && NILP (Feval (pgui_item->included)))
374 return 0; 265 return 0;
396 * signaled. 287 * signaled.
397 * Return value is the offset to the terminating null character into the 288 * Return value is the offset to the terminating null character into the
398 * buffer. 289 * buffer.
399 */ 290 */
400 unsigned int 291 unsigned int
401 gui_item_display_flush_left (Lisp_Object gui_item, 292 gui_item_display_flush_left (CONST struct gui_item *pgui_item,
402 char *buf, Bytecount buf_len) 293 char* buf, Bytecount buf_len)
403 { 294 {
404 /* This function can call lisp */
405 char *p = buf; 295 char *p = buf;
406 Bytecount len; 296 Bytecount len;
407 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
408 297
409 /* Copy item name first */ 298 /* Copy item name first */
410 CHECK_STRING (pgui_item->name); 299 CHECK_STRING (pgui_item->name);
411 len = XSTRING_LENGTH (pgui_item->name); 300 len = XSTRING_LENGTH (pgui_item->name);
412 if (len > buf_len) 301 if (len > buf_len)
445 * signaled. 334 * signaled.
446 * Return value is the offset to the terminating null character into the 335 * Return value is the offset to the terminating null character into the
447 * buffer. 336 * buffer.
448 */ 337 */
449 unsigned int 338 unsigned int
450 gui_item_display_flush_right (Lisp_Object gui_item, 339 gui_item_display_flush_right (CONST struct gui_item *pgui_item,
451 char *buf, Bytecount buf_len) 340 char* buf, Bytecount buf_len)
452 { 341 {
453 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
454 *buf = 0; 342 *buf = 0;
455 343
456 #ifdef HAVE_MENUBARS
457 /* Have keys? */ 344 /* Have keys? */
458 if (!menubar_show_keybindings) 345 if (!menubar_show_keybindings)
459 return 0; 346 return 0;
460 #endif
461 347
462 /* Try :keys first */ 348 /* Try :keys first */
463 if (!NILP (pgui_item->keys)) 349 if (!NILP (pgui_item->keys))
464 { 350 {
465 CHECK_STRING (pgui_item->keys); 351 CHECK_STRING (pgui_item->keys);
466 if (XSTRING_LENGTH (pgui_item->keys) + 1 > buf_len) 352 if (XSTRING_LENGTH (pgui_item->keys) > buf_len)
467 signal_too_long_error (pgui_item->name); 353 signal_too_long_error (pgui_item->name);
468 memcpy (buf, XSTRING_DATA (pgui_item->keys), 354 strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys));
469 XSTRING_LENGTH (pgui_item->keys) + 1);
470 return XSTRING_LENGTH (pgui_item->keys); 355 return XSTRING_LENGTH (pgui_item->keys);
471 } 356 }
472 357
473 /* See if we can derive keys out of callback symbol */ 358 /* See if we can derive keys out of callback symbol */
474 if (SYMBOLP (pgui_item->callback)) 359 if (SYMBOLP (pgui_item->callback))
475 { 360 {
476 char buf2[1024]; /* #### */ 361 char buf2 [1024];
477 Bytecount len; 362 Bytecount len;
478 363
479 where_is_to_char (pgui_item->callback, buf2); 364 where_is_to_char (pgui_item->callback, buf2);
480 len = strlen (buf2); 365 len = strlen (buf2);
481 if (len > buf_len) 366 if (len > buf_len)
487 /* No keys - no right flush display */ 372 /* No keys - no right flush display */
488 return 0; 373 return 0;
489 } 374 }
490 #endif /* HAVE_WINDOW_SYSTEM */ 375 #endif /* HAVE_WINDOW_SYSTEM */
491 376
492 static Lisp_Object 377 Lisp_Object
493 mark_gui_item (Lisp_Object obj) 378 mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object))
494 { 379 {
495 Lisp_Gui_Item *p = XGUI_ITEM (obj); 380 markobj (p->name);
496 381 markobj (p->callback);
497 mark_object (p->name); 382 markobj (p->suffix);
498 mark_object (p->callback); 383 markobj (p->active);
499 mark_object (p->callback_ex); 384 markobj (p->included);
500 mark_object (p->config); 385 markobj (p->config);
501 mark_object (p->suffix); 386 markobj (p->filter);
502 mark_object (p->active); 387 markobj (p->style);
503 mark_object (p->included); 388 markobj (p->selected);
504 mark_object (p->config); 389 markobj (p->keys);
505 mark_object (p->filter);
506 mark_object (p->style);
507 mark_object (p->selected);
508 mark_object (p->keys);
509 mark_object (p->accelerator);
510 mark_object (p->value);
511 390
512 return Qnil; 391 return Qnil;
513 } 392 }
514 393
515 static unsigned long
516 gui_item_hash (Lisp_Object obj, int depth)
517 {
518 Lisp_Gui_Item *p = XGUI_ITEM (obj);
519
520 return HASH2 (HASH6 (internal_hash (p->name, depth + 1),
521 internal_hash (p->callback, depth + 1),
522 internal_hash (p->callback_ex, depth + 1),
523 internal_hash (p->suffix, depth + 1),
524 internal_hash (p->active, depth + 1),
525 internal_hash (p->included, depth + 1)),
526 HASH6 (internal_hash (p->config, depth + 1),
527 internal_hash (p->filter, depth + 1),
528 internal_hash (p->style, depth + 1),
529 internal_hash (p->selected, depth + 1),
530 internal_hash (p->keys, depth + 1),
531 internal_hash (p->value, depth + 1)));
532 }
533
534 int 394 int
535 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) 395 gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot)
536 { 396 {
537 int hashid = gui_item_hash (gitem, 0); 397 int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0));
538 int id = GUI_ITEM_ID_BITS (hashid, slot); 398 int id = GUI_ITEM_ID_BITS (hashid, slot);
539 while (!NILP (Fgethash (make_int (id), 399 while (!NILP (Fgethash (make_int (id),
540 hashtable, Qnil))) 400 hashtable, Qnil)))
541 { 401 {
542 id = GUI_ITEM_ID_BITS (id + 1, slot); 402 id = GUI_ITEM_ID_BITS (id + 1, slot);
543 } 403 }
544 return id; 404 return id;
545 } 405 }
546 406
547 static int
548 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
549 {
550 Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
551 Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
552
553 if (!(internal_equal (p1->name, p2->name, depth + 1)
554 &&
555 internal_equal (p1->callback, p2->callback, depth + 1)
556 &&
557 internal_equal (p1->callback_ex, p2->callback_ex, depth + 1)
558 &&
559 EQ (p1->suffix, p2->suffix)
560 &&
561 EQ (p1->active, p2->active)
562 &&
563 EQ (p1->included, p2->included)
564 &&
565 EQ (p1->config, p2->config)
566 &&
567 EQ (p1->filter, p2->filter)
568 &&
569 EQ (p1->style, p2->style)
570 &&
571 EQ (p1->selected, p2->selected)
572 &&
573 EQ (p1->accelerator, p2->accelerator)
574 &&
575 EQ (p1->keys, p2->keys)
576 &&
577 EQ (p1->value, p2->value)))
578 return 0;
579 return 1;
580 }
581
582 static void
583 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
584 {
585 Lisp_Gui_Item *g = XGUI_ITEM (obj);
586 char buf[20];
587
588 if (print_readably)
589 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid);
590
591 write_c_string ("#<gui-item ", printcharfun);
592 sprintf (buf, "0x%x>", g->header.uid);
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;
637 }
638
639 /* parse a glyph descriptor into a tree of gui items.
640
641 The gui_item slot of an image instance can be a single item or an
642 arbitrarily nested hierarchy of item lists. */
643
644 static Lisp_Object
645 parse_gui_item_tree_item (Lisp_Object entry)
646 {
647 Lisp_Object ret = entry;
648 struct gcpro gcpro1;
649
650 GCPRO1 (ret);
651
652 if (VECTORP (entry))
653 {
654 ret = gui_parse_item_keywords_no_errors (entry);
655 }
656 else if (STRINGP (entry))
657 {
658 CHECK_STRING (entry);
659 }
660 else
661 signal_simple_error ("item must be a vector or a string", entry);
662
663 RETURN_UNGCPRO (ret);
664 }
665
666 Lisp_Object
667 parse_gui_item_tree_children (Lisp_Object list)
668 {
669 Lisp_Object rest, ret = Qnil, sub = Qnil;
670 struct gcpro gcpro1, gcpro2;
671
672 GCPRO2 (ret, sub);
673 CHECK_CONS (list);
674 /* recursively add items to the tree view */
675 LIST_LOOP (rest, list)
676 {
677 if (CONSP (XCAR (rest)))
678 sub = parse_gui_item_tree_list (XCAR (rest));
679 else
680 sub = parse_gui_item_tree_item (XCAR (rest));
681
682 ret = Fcons (sub, ret);
683 }
684 /* make the order the same as the items we have parsed */
685 RETURN_UNGCPRO (Fnreverse (ret));
686 }
687
688 static Lisp_Object
689 parse_gui_item_tree_list (Lisp_Object list)
690 {
691 Lisp_Object ret;
692 struct gcpro gcpro1;
693 CHECK_CONS (list);
694 /* first one can never be a list */
695 ret = parse_gui_item_tree_item (XCAR (list));
696 GCPRO1 (ret);
697 ret = Fcons (ret, parse_gui_item_tree_children (XCDR (list)));
698 RETURN_UNGCPRO (ret);
699 }
700
701 static void
702 finalize_gui_item (void* header, int for_disksave)
703 {
704 }
705
706 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item,
707 mark_gui_item, print_gui_item,
708 finalize_gui_item, gui_item_equal,
709 gui_item_hash,
710 0,
711 Lisp_Gui_Item);
712
713 void 407 void
714 syms_of_gui (void) 408 syms_of_gui (void)
715 { 409 {
716 INIT_LRECORD_IMPLEMENTATION (gui_item);
717
718 defkeyword (&Q_active, ":active"); 410 defkeyword (&Q_active, ":active");
719 defkeyword (&Q_suffix, ":suffix"); 411 defkeyword (&Q_suffix, ":suffix");
720 defkeyword (&Q_keys, ":keys"); 412 defkeyword (&Q_keys, ":keys");
721 defkeyword (&Q_key_sequence,":key-sequence"); 413 defkeyword (&Q_key_sequence,":key-sequence");
722 defkeyword (&Q_style, ":style"); 414 defkeyword (&Q_style, ":style");
725 defkeyword (&Q_config, ":config"); 417 defkeyword (&Q_config, ":config");
726 defkeyword (&Q_included, ":included"); 418 defkeyword (&Q_included, ":included");
727 defkeyword (&Q_accelerator, ":accelerator"); 419 defkeyword (&Q_accelerator, ":accelerator");
728 defkeyword (&Q_label, ":label"); 420 defkeyword (&Q_label, ":label");
729 defkeyword (&Q_callback, ":callback"); 421 defkeyword (&Q_callback, ":callback");
730 defkeyword (&Q_callback_ex, ":callback-ex");
731 defkeyword (&Q_value, ":value");
732 422
733 defsymbol (&Qtoggle, "toggle"); 423 defsymbol (&Qtoggle, "toggle");
734 defsymbol (&Qradio, "radio"); 424 defsymbol (&Qradio, "radio");
735 425
736 #ifdef HAVE_POPUPS 426 #ifdef HAVE_POPUPS