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