(o-UU+4EDE): Use U+4EBB instead of <CJK RADICAL PERSON> in
[chise/xemacs-chise.git.1] / src / gui.c
1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs)
2    Copyright (C) 1995 Board of Trustees, University of Illinois.
3    Copyright (C) 1995, 1996 Ben Wing.
4    Copyright (C) 1995 Sun Microsystems, Inc.
5    Copyright (C) 1998 Free Software Foundation, Inc.
6
7 This file is part of XEmacs.
8
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
12 later version.
13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING.  If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA.  */
23
24 /* Synched up with: Not in FSF. */
25
26 /* This file not quite Mule-ized yet but will be when merged with my
27    Mule workspace. --ben */
28
29 #include <config.h>
30 #include "lisp.h"
31 #include "gui.h"
32 #include "elhash.h"
33 #include "buffer.h"
34 #include "bytecode.h"
35
36 Lisp_Object Qmenu_no_selection_hook;
37 Lisp_Object Vmenu_no_selection_hook;
38
39 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list);
40 Lisp_Object find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword);
41
42 #ifdef HAVE_POPUPS
43
44 /* count of menus/dboxes currently up */
45 int popup_up_p;
46
47 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
48 Return t if a popup menu or dialog box is up, nil otherwise.
49 See `popup-menu' and `popup-dialog-box'.
50 */
51        ())
52 {
53   return popup_up_p ? Qt : Qnil;
54 }
55 #endif /* HAVE_POPUPS */
56
57 int
58 separator_string_p (const Bufbyte *s)
59 {
60   const Bufbyte *p;
61   Bufbyte first;
62
63   if (!s || s[0] == '\0')
64     return 0;
65   first = s[0];
66   if (first != '-' && first != '=')
67     return 0;
68   for (p = s; *p == first; p++)
69     ;
70
71   return (*p == '!' || *p == ':' || *p == '\0');
72 }
73
74 /* Massage DATA to find the correct function and argument.  Used by
75    popup_selection_callback() and the msw code. */
76 void
77 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
78 {
79   if (EQ (data, Qquit))
80     {
81       *fn = Qeval;
82       *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil);
83       Vquit_flag = Qt;
84     }
85   else if (SYMBOLP (data)
86            || (COMPILED_FUNCTIONP (data)
87                && XCOMPILED_FUNCTION (data)->flags.interactivep)
88            || (CONSP (data) && (EQ (XCAR (data), Qlambda))
89                && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
90     {
91       *fn = Qcall_interactively;
92       *arg = data;
93     }
94   else if (CONSP (data))
95     {
96       *fn = Qeval;
97       *arg = data;
98     }
99   else
100     {
101       *fn = Qeval;
102       *arg = list3 (Qsignal,
103                     list2 (Qquote, Qerror),
104                     list2 (Qquote, list2 (build_translated_string
105                                           ("illegal callback"),
106                                           data)));
107     }
108 }
109
110 /*
111  * Add a value VAL associated with keyword KEY into PGUI_ITEM
112  * structure. If KEY is not a keyword, or is an unknown keyword, then
113  * error is signaled.
114  */
115 int
116 gui_item_add_keyval_pair (Lisp_Object gui_item,
117                           Lisp_Object key, Lisp_Object val,
118                           Error_behavior errb)
119 {
120   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
121   int retval = 0;
122
123   if (!KEYWORDP (key))
124     syntax_error_2 ("Non-keyword in gui item", key, pgui_item->name);
125
126   if (EQ (key, Q_descriptor))
127     {
128       if (!EQ (pgui_item->name, val))
129         {
130           retval = 1;
131           pgui_item->name   = val;
132         }
133     }
134 #define FROB(slot) \
135   else if (EQ (key, Q_##slot))                  \
136   {                                             \
137     if (!EQ (pgui_item->slot, val))                     \
138       {                                         \
139         retval = 1;                             \
140         pgui_item->slot   = val;                        \
141       }                                         \
142   }
143   FROB (suffix)
144   FROB (active)
145   FROB (included)
146   FROB (config)
147   FROB (filter)
148   FROB (style)
149   FROB (selected)
150   FROB (keys)
151   FROB (callback)
152   FROB (callback_ex)
153   FROB (value)
154 #undef FROB
155   else if (EQ (key, Q_key_sequence)) ;   /* ignored for FSF compatibility */
156   else if (EQ (key, Q_label)) ;   /* ignored for 21.0 implement in 21.2  */
157   else if (EQ (key, Q_accelerator))
158     {
159       if (!EQ (pgui_item->accelerator, val))
160         {
161           retval = 1;
162           if (SYMBOLP (val) || CHARP (val))
163             pgui_item->accelerator = val;
164           else if (ERRB_EQ (errb, ERROR_ME))
165             syntax_error ("Bad keyboard accelerator", val);
166         }
167     }
168   else if (ERRB_EQ (errb, ERROR_ME))
169     syntax_error_2 ("Unknown keyword in gui item", key,
170                            pgui_item->name);
171   return retval;
172 }
173
174 void
175 gui_item_init (Lisp_Object gui_item)
176 {
177   Lisp_Gui_Item *lp = XGUI_ITEM (gui_item);
178
179   lp->name     = Qnil;
180   lp->callback = Qnil;
181   lp->callback_ex = Qnil;
182   lp->suffix   = Qnil;
183   lp->active   = Qt;
184   lp->included = Qt;
185   lp->config   = Qnil;
186   lp->filter   = Qnil;
187   lp->style    = Qnil;
188   lp->selected = Qnil;
189   lp->keys     = Qnil;
190   lp->accelerator     = Qnil;
191   lp->value = Qnil;
192 }
193
194 Lisp_Object
195 allocate_gui_item (void)
196 {
197   Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item);
198   Lisp_Object val;
199
200   zero_lcrecord (lp);
201   XSETGUI_ITEM (val, lp);
202
203   gui_item_init (val);
204
205   return val;
206 }
207
208 /*
209  * ITEM is a lisp vector, describing a menu item or a button. The
210  * function extracts the description of the item into the PGUI_ITEM
211  * structure.
212  */
213 static Lisp_Object
214 make_gui_item_from_keywords_internal (Lisp_Object item,
215                                       Error_behavior errb)
216 {
217   int length, plist_p, start;
218   Lisp_Object *contents;
219   Lisp_Object gui_item = allocate_gui_item ();
220   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
221
222   CHECK_VECTOR (item);
223   length = XVECTOR_LENGTH (item);
224   contents = XVECTOR_DATA (item);
225
226   if (length < 1)
227     syntax_error ("GUI item descriptors must be at least 1 elts long", item);
228
229   /* length 1:                  [ "name" ]
230      length 2:          [ "name" callback ]
231      length 3:          [ "name" callback active-p ]
232                    or   [ "name" keyword  value  ]
233      length 4:          [ "name" callback active-p suffix ]
234                    or   [ "name" callback keyword  value  ]
235      length 5+:         [ "name" callback [ keyword value ]+ ]
236                    or   [ "name" [ keyword value ]+ ]
237   */
238   plist_p = (length > 2 && (KEYWORDP (contents [1])
239                             || KEYWORDP (contents [2])));
240
241   pgui_item->name = contents [0];
242   if (length > 1 && !KEYWORDP (contents [1]))
243     {
244       pgui_item->callback = contents [1];
245       start = 2;
246     }
247   else
248     start =1;
249
250   if (!plist_p && length > 2)
251     /* the old way */
252     {
253       pgui_item->active = contents [2];
254       if (length == 4)
255         pgui_item->suffix = contents [3];
256     }
257   else
258     /* the new way */
259     {
260       int i;
261       if ((length - start) & 1)
262         syntax_error (
263                 "GUI item descriptor has an odd number of keywords and values",
264                              item);
265
266       for (i = start; i < length;)
267         {
268           Lisp_Object key = contents [i++];
269           Lisp_Object val = contents [i++];
270           gui_item_add_keyval_pair (gui_item, key, val, errb);
271         }
272     }
273   return gui_item;
274 }
275
276 /* This will only work with descriptors in the new format. */
277 Lisp_Object
278 widget_gui_parse_item_keywords (Lisp_Object item)
279 {
280   int i, length;
281   Lisp_Object *contents;
282   Lisp_Object gui_item = allocate_gui_item ();
283   Lisp_Object desc = find_keyword_in_vector (item, Q_descriptor);
284
285   CHECK_VECTOR (item);
286   length = XVECTOR_LENGTH (item);
287   contents = XVECTOR_DATA (item);
288
289   if (!NILP (desc) && !STRINGP (desc) && !VECTORP (desc))
290     syntax_error ("Invalid GUI item descriptor", item);
291
292   if (length & 1)
293     {
294       if (!SYMBOLP (contents [0]))
295         syntax_error ("Invalid GUI item descriptor", item);
296       contents++;                       /* Ignore the leading symbol. */
297       length--;
298     }
299
300   for (i = 0; i < length;)
301     {
302       Lisp_Object key = contents [i++];
303       Lisp_Object val = contents [i++];
304       gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME_NOT);
305     }
306
307   return gui_item;
308 }
309
310 /* Update a gui item from a partial descriptor. */
311 int
312 update_gui_item_keywords (Lisp_Object gui_item, Lisp_Object item)
313 {
314   int i, length, retval = 0;
315   Lisp_Object *contents;
316
317   CHECK_VECTOR (item);
318   length = XVECTOR_LENGTH (item);
319   contents = XVECTOR_DATA (item);
320
321  if (length & 1)
322     {
323       if (!SYMBOLP (contents [0]))
324         syntax_error ("Invalid GUI item descriptor", item);
325       contents++;                       /* Ignore the leading symbol. */
326       length--;
327     }
328
329   for (i = 0; i < length;)
330     {
331       Lisp_Object key = contents [i++];
332       Lisp_Object val = contents [i++];
333       if (gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME_NOT))
334         retval = 1;
335     }
336   return retval;
337 }
338
339 Lisp_Object
340 gui_parse_item_keywords (Lisp_Object item)
341 {
342   return make_gui_item_from_keywords_internal (item, ERROR_ME);
343 }
344
345 Lisp_Object
346 gui_parse_item_keywords_no_errors (Lisp_Object item)
347 {
348   return make_gui_item_from_keywords_internal (item, ERROR_ME_NOT);
349 }
350
351 /* convert a gui item into plist properties */
352 void
353 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item)
354 {
355   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
356
357   if (!NILP (pgui_item->callback))
358     Fplist_put (plist, Q_callback, pgui_item->callback);
359   if (!NILP (pgui_item->callback_ex))
360     Fplist_put (plist, Q_callback_ex, pgui_item->callback_ex);
361   if (!NILP (pgui_item->suffix))
362     Fplist_put (plist, Q_suffix, pgui_item->suffix);
363   if (!NILP (pgui_item->active))
364     Fplist_put (plist, Q_active, pgui_item->active);
365   if (!NILP (pgui_item->included))
366     Fplist_put (plist, Q_included, pgui_item->included);
367   if (!NILP (pgui_item->config))
368     Fplist_put (plist, Q_config, pgui_item->config);
369   if (!NILP (pgui_item->filter))
370     Fplist_put (plist, Q_filter, pgui_item->filter);
371   if (!NILP (pgui_item->style))
372     Fplist_put (plist, Q_style, pgui_item->style);
373   if (!NILP (pgui_item->selected))
374     Fplist_put (plist, Q_selected, pgui_item->selected);
375   if (!NILP (pgui_item->keys))
376     Fplist_put (plist, Q_keys, pgui_item->keys);
377   if (!NILP (pgui_item->accelerator))
378     Fplist_put (plist, Q_accelerator, pgui_item->accelerator);
379   if (!NILP (pgui_item->value))
380     Fplist_put (plist, Q_value, pgui_item->value);
381 }
382
383 /*
384  * Decide whether a GUI item is active by evaluating its :active form
385  * if any
386  */
387 int
388 gui_item_active_p (Lisp_Object gui_item)
389 {
390   /* This function can call lisp */
391
392   /* Shortcut to avoid evaluating Qt each time */
393   return (EQ (XGUI_ITEM (gui_item)->active, Qt)
394           || !NILP (Feval (XGUI_ITEM (gui_item)->active)));
395 }
396
397 /* set menu accelerator key to first underlined character in menu name */
398 Lisp_Object
399 gui_item_accelerator (Lisp_Object gui_item)
400 {
401   Lisp_Gui_Item *pgui = XGUI_ITEM (gui_item);
402
403   if (!NILP (pgui->accelerator))
404     return pgui->accelerator;
405
406   else
407     return gui_name_accelerator (pgui->name);
408 }
409
410 Lisp_Object
411 gui_name_accelerator (Lisp_Object nm)
412 {
413   Bufbyte *name = XSTRING_DATA (nm);
414
415   while (*name)
416     {
417       if (*name == '%')
418         {
419           ++name;
420           if (!(*name))
421             return Qnil;
422           if (*name == '_' && *(name + 1))
423             {
424               Emchar accelerator = charptr_emchar (name + 1);
425               /* #### bogus current_buffer dependency */
426               return make_char (DOWNCASE (current_buffer, accelerator));
427             }
428         }
429         INC_CHARPTR (name);
430     }
431   return make_char (DOWNCASE (current_buffer,
432                               charptr_emchar (XSTRING_DATA (nm))));
433 }
434
435 /*
436  * Decide whether a GUI item is selected by evaluating its :selected form
437  * if any
438  */
439 int
440 gui_item_selected_p (Lisp_Object gui_item)
441 {
442   /* This function can call lisp */
443
444   /* Shortcut to avoid evaluating Qt each time */
445   return (EQ (XGUI_ITEM (gui_item)->selected, Qt)
446           || !NILP (Feval (XGUI_ITEM (gui_item)->selected)));
447 }
448
449 Lisp_Object
450 gui_item_list_find_selected (Lisp_Object gui_item_list)
451 {
452   /* This function can GC. */
453   Lisp_Object rest;
454   LIST_LOOP (rest, gui_item_list)
455     {
456       if (gui_item_selected_p (XCAR (rest)))
457         return XCAR (rest);
458     }
459   return XCAR (gui_item_list);
460 }
461
462 /*
463  * Decide whether a GUI item is included by evaluating its :included
464  * form if given, and testing its :config form against supplied CONFLIST
465  * configuration variable
466  */
467 int
468 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist)
469 {
470   /* This function can call lisp */
471   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
472
473   /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
474   if (!EQ (pgui_item->included, Qt)
475       && NILP (Feval (pgui_item->included)))
476     return 0;
477
478   /* Do :config if conflist is given */
479   if (!NILP (conflist) && !NILP (pgui_item->config)
480       && NILP (Fmemq (pgui_item->config, conflist)))
481     return 0;
482
483   return 1;
484 }
485
486 static DOESNT_RETURN
487 signal_too_long_error (Lisp_Object name)
488 {
489   syntax_error ("GUI item produces too long displayable string", name);
490 }
491
492 #ifdef HAVE_WINDOW_SYSTEM
493 /*
494  * Format "left flush" display portion of an item into BUF, guarded by
495  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
496  * null character, so actual maximum size of buffer consumed is
497  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
498  * signaled.
499  * Return value is the offset to the terminating null character into the
500  * buffer.
501  */
502 unsigned int
503 gui_item_display_flush_left (Lisp_Object gui_item,
504                              char *buf, Bytecount buf_len)
505 {
506   /* This function can call lisp */
507   char *p = buf;
508   Bytecount len;
509   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
510
511   /* Copy item name first */
512   CHECK_STRING (pgui_item->name);
513   len = XSTRING_LENGTH (pgui_item->name);
514   if (len > buf_len)
515     signal_too_long_error (pgui_item->name);
516   memcpy (p, XSTRING_DATA (pgui_item->name), len);
517   p += len;
518
519   /* Add space and suffix, if there is a suffix.
520    * If suffix is not string evaluate it */
521   if (!NILP (pgui_item->suffix))
522     {
523       Lisp_Object suffix = pgui_item->suffix;
524       /* Shortcut to avoid evaluating suffix each time */
525       if (!STRINGP (suffix))
526         {
527           suffix = Feval (suffix);
528           CHECK_STRING (suffix);
529         }
530
531       len = XSTRING_LENGTH (suffix);
532       if (p + len + 1 > buf + buf_len)
533         signal_too_long_error (pgui_item->name);
534       *(p++) = ' ';
535       memcpy (p, XSTRING_DATA (suffix), len);
536       p += len;
537     }
538   *p = '\0';
539   return p - buf;
540 }
541
542 /*
543  * Format "right flush" display portion of an item into BUF, guarded by
544  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
545  * null character, so actual maximum size of buffer consumed is
546  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
547  * signaled.
548  * Return value is the offset to the terminating null character into the
549  * buffer.
550  */
551 unsigned int
552 gui_item_display_flush_right (Lisp_Object gui_item,
553                               char *buf, Bytecount buf_len)
554 {
555   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
556   *buf = 0;
557
558 #ifdef HAVE_MENUBARS
559   /* Have keys? */
560   if (!menubar_show_keybindings)
561     return 0;
562 #endif
563
564   /* Try :keys first */
565   if (!NILP (pgui_item->keys))
566     {
567       CHECK_STRING (pgui_item->keys);
568       if (XSTRING_LENGTH (pgui_item->keys) + 1 > buf_len)
569         signal_too_long_error (pgui_item->name);
570       memcpy (buf, XSTRING_DATA (pgui_item->keys),
571               XSTRING_LENGTH (pgui_item->keys) + 1);
572       return XSTRING_LENGTH (pgui_item->keys);
573     }
574
575   /* See if we can derive keys out of callback symbol */
576   if (SYMBOLP (pgui_item->callback))
577     {
578       char buf2[1024]; /* #### */
579       Bytecount len;
580
581       where_is_to_char (pgui_item->callback, buf2);
582       len = strlen (buf2);
583       if (len > buf_len)
584         signal_too_long_error (pgui_item->name);
585       strcpy (buf, buf2);
586       return len;
587     }
588
589   /* No keys - no right flush display */
590   return 0;
591 }
592 #endif /* HAVE_WINDOW_SYSTEM */
593
594 static Lisp_Object
595 mark_gui_item (Lisp_Object obj)
596 {
597   Lisp_Gui_Item *p = XGUI_ITEM (obj);
598
599   mark_object (p->name);
600   mark_object (p->callback);
601   mark_object (p->callback_ex);
602   mark_object (p->config);
603   mark_object (p->suffix);
604   mark_object (p->active);
605   mark_object (p->included);
606   mark_object (p->config);
607   mark_object (p->filter);
608   mark_object (p->style);
609   mark_object (p->selected);
610   mark_object (p->keys);
611   mark_object (p->accelerator);
612   mark_object (p->value);
613
614   return Qnil;
615 }
616
617 static unsigned long
618 gui_item_hash (Lisp_Object obj, int depth)
619 {
620   Lisp_Gui_Item *p = XGUI_ITEM (obj);
621
622   return HASH2 (HASH6 (internal_hash (p->name, depth + 1),
623                        internal_hash (p->callback, depth + 1),
624                        internal_hash (p->callback_ex, depth + 1),
625                        internal_hash (p->suffix, depth + 1),
626                        internal_hash (p->active, depth + 1),
627                        internal_hash (p->included, depth + 1)),
628                 HASH6 (internal_hash (p->config, depth + 1),
629                        internal_hash (p->filter, depth + 1),
630                        internal_hash (p->style, depth + 1),
631                        internal_hash (p->selected, depth + 1),
632                        internal_hash (p->keys, depth + 1),
633                        internal_hash (p->value, depth + 1)));
634 }
635
636 int
637 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot)
638 {
639   int hashid = gui_item_hash (gitem, 0);
640   int id = GUI_ITEM_ID_BITS (hashid, slot);
641   while (!NILP (Fgethash (make_int (id),
642                           hashtable, Qnil)))
643     {
644       id = GUI_ITEM_ID_BITS (id + 1, slot);
645     }
646   return id;
647 }
648
649 int
650 gui_item_equal_sans_selected (Lisp_Object obj1, Lisp_Object obj2, int depth)
651 {
652   Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
653   Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
654
655   if (!(internal_equal (p1->name, p2->name, depth + 1)
656         &&
657         internal_equal (p1->callback, p2->callback, depth + 1)
658         &&
659         internal_equal (p1->callback_ex, p2->callback_ex, depth + 1)
660         &&
661         EQ (p1->suffix, p2->suffix)
662         &&
663         EQ (p1->active, p2->active)
664         &&
665         EQ (p1->included, p2->included)
666         &&
667         EQ (p1->config, p2->config)
668         &&
669         EQ (p1->filter, p2->filter)
670         &&
671         EQ (p1->style, p2->style)
672         &&
673         EQ (p1->accelerator, p2->accelerator)
674         &&
675         EQ (p1->keys, p2->keys)
676         &&
677         EQ (p1->value, p2->value)))
678     return 0;
679   return 1;
680 }
681
682 static int
683 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
684 {
685   Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
686   Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
687
688   if (!(gui_item_equal_sans_selected (obj1, obj2, depth)
689         &&
690         EQ (p1->selected, p2->selected)))
691     return 0;
692   return 1;
693 }
694
695 static void
696 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
697 {
698   Lisp_Gui_Item *g = XGUI_ITEM (obj);
699   char buf[20];
700
701   if (print_readably)
702     error ("printing unreadable object #<gui-item 0x%x>", g->header.uid);
703
704   write_c_string ("#<gui-item ", printcharfun);
705   sprintf (buf, "0x%x>", g->header.uid);
706   write_c_string (buf, printcharfun);
707 }
708
709 Lisp_Object
710 copy_gui_item (Lisp_Object gui_item)
711 {
712   Lisp_Object  ret = allocate_gui_item ();
713   Lisp_Gui_Item *lp, *g = XGUI_ITEM (gui_item);
714
715   lp = XGUI_ITEM (ret);
716   lp->name     = g->name;
717   lp->callback = g->callback;
718   lp->callback_ex = g->callback_ex;
719   lp->suffix   = g->suffix;
720   lp->active   = g->active;
721   lp->included = g->included;
722   lp->config   = g->config;
723   lp->filter   = g->filter;
724   lp->style    = g->style;
725   lp->selected = g->selected;
726   lp->keys     = g->keys;
727   lp->accelerator     = g->accelerator;
728   lp->value = g->value;
729
730   return ret;
731 }
732
733 Lisp_Object
734 copy_gui_item_tree (Lisp_Object arg)
735 {
736   if (CONSP (arg))
737     {
738       Lisp_Object rest = arg = Fcopy_sequence (arg);
739       while (CONSP (rest))
740         {
741           XCAR (rest) = copy_gui_item_tree (XCAR (rest));
742           rest = XCDR (rest);
743         }
744       return arg;
745     }
746   else if (GUI_ITEMP (arg))
747     return copy_gui_item (arg);
748   else
749     return arg;
750 }
751
752 /* parse a glyph descriptor into a tree of gui items.
753
754    The gui_item slot of an image instance can be a single item or an
755    arbitrarily nested hierarchy of item lists. */
756
757 static Lisp_Object
758 parse_gui_item_tree_item (Lisp_Object entry)
759 {
760   Lisp_Object ret = entry;
761   struct gcpro gcpro1;
762
763   GCPRO1 (ret);
764
765   if (VECTORP (entry))
766     {
767       ret = gui_parse_item_keywords_no_errors (entry);
768     }
769   else if (STRINGP (entry))
770     {
771       CHECK_STRING (entry);
772     }
773   else
774     syntax_error ("item must be a vector or a string", entry);
775
776   RETURN_UNGCPRO (ret);
777 }
778
779 Lisp_Object
780 parse_gui_item_tree_children (Lisp_Object list)
781 {
782   Lisp_Object rest, ret = Qnil, sub = Qnil;
783   struct gcpro gcpro1, gcpro2;
784
785   GCPRO2 (ret, sub);
786   CHECK_CONS (list);
787   /* recursively add items to the tree view */
788   LIST_LOOP (rest, list)
789     {
790       if (CONSP (XCAR (rest)))
791         sub = parse_gui_item_tree_list (XCAR (rest));
792       else
793         sub = parse_gui_item_tree_item (XCAR (rest));
794
795       ret = Fcons (sub, ret);
796     }
797   /* make the order the same as the items we have parsed */
798   RETURN_UNGCPRO (Fnreverse (ret));
799 }
800
801 static Lisp_Object
802 parse_gui_item_tree_list (Lisp_Object list)
803 {
804   Lisp_Object ret;
805   struct gcpro gcpro1;
806   CHECK_CONS (list);
807   /* first one can never be a list */
808   ret = parse_gui_item_tree_item (XCAR (list));
809   GCPRO1 (ret);
810   ret = Fcons (ret, parse_gui_item_tree_children (XCDR (list)));
811   RETURN_UNGCPRO (ret);
812 }
813
814 static void
815 finalize_gui_item (void* header, int for_disksave)
816 {
817 }
818
819 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item,
820                                mark_gui_item, print_gui_item,
821                                finalize_gui_item, gui_item_equal,
822                                gui_item_hash,
823                                0,
824                                Lisp_Gui_Item);
825
826 void
827 syms_of_gui (void)
828 {
829   INIT_LRECORD_IMPLEMENTATION (gui_item);
830
831   DEFSYMBOL (Qmenu_no_selection_hook);
832
833 #ifdef HAVE_POPUPS
834   DEFSUBR (Fpopup_up_p);
835 #endif
836 }
837
838 void
839 vars_of_gui (void)
840 {
841   DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /*
842 Function or functions to call when a menu or dialog box is dismissed
843 without a selection having been made.
844 */ );
845   Vmenu_no_selection_hook = Qnil;
846 }