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 #include <config.h>
  27 #include "lisp.h"
  28 #include "gui.h"
  29 #include "elhash.h"
  30 #include "buffer.h"
  31 #include "bytecode.h"
  32
  33 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
  34 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;
  36 Lisp_Object Qtoggle, Qradio;
  37
  38 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list);
  39
  40 #ifdef HAVE_POPUPS
  41
  42 /* count of menus/dboxes currently up */
  43 int popup_up_p;
  44
  45 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
  46 Return t if a popup menu or dialog box is up, nil otherwise.
  47 See `popup-menu' and `popup-dialog-box'.
  48 */
  49        ())
  50 {
  51   return popup_up_p ? Qt : Qnil;
  52 }
  53 #endif /* HAVE_POPUPS */
  54
  55 int
  56 separator_string_p (const char *s)
  57 {
  58   const char *p;
  59   char first;
  60
  61   if (!s || s[0] == '\0')
  62     return 0;
  63   first = s[0];
  64   if (first != '-' && first != '=')
  65     return 0;
  66   for (p = s; *p == first; p++)
  67     ;
  68
  69   return (*p == '!' || *p == ':' || *p == '\0');
  70 }
  71
  72 /* Massage DATA to find the correct function and argument.  Used by
  73    popup_selection_callback() and the msw code. */
  74 void
  75 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
  76 {
  77   if (EQ (data, Qquit))
  78     {
  79       *fn = Qeval;
  80       *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil);
  81       Vquit_flag = Qt;
  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     {
  89       *fn = Qcall_interactively;
  90       *arg = data;
  91     }
  92   else if (CONSP (data))
  93     {
  94       *fn = Qeval;
  95       *arg = data;
  96     }
  97   else
  98     {
  99       *fn = Qeval;
 100       *arg = list3 (Qsignal,
 101                     list2 (Qquote, Qerror),
 102                     list2 (Qquote, list2 (build_translated_string
 103                                           ("illegal callback"),
 104                                           data)));
 105     }
 106 }
 107
 108 /*
 109  * 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
 111  * error is signaled.
 112  */
 113 void
 114 gui_item_add_keyval_pair (Lisp_Object gui_item,
 115                           Lisp_Object key, Lisp_Object val,
 116                           Error_behavior errb)
 117 {
 118   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
 119
 120   if (!KEYWORDP (key))
 121     signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name);
 122
 123   if      (EQ (key, Q_suffix))   pgui_item->suffix   = val;
 124   else if (EQ (key, Q_active))   pgui_item->active   = val;
 125   else if (EQ (key, Q_included)) pgui_item->included = val;
 126   else if (EQ (key, Q_config))   pgui_item->config   = val;
 127   else if (EQ (key, Q_filter))   pgui_item->filter   = val;
 128   else if (EQ (key, Q_style))    pgui_item->style    = val;
 129   else if (EQ (key, Q_selected)) pgui_item->selected = val;
 130   else if (EQ (key, Q_keys))     pgui_item->keys     = val;
 131   else if (EQ (key, Q_callback)) pgui_item->callback = val;
 132   else if (EQ (key, Q_callback_ex)) pgui_item->callback_ex = val;
 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  */
 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))
 144     signal_simple_error_2 ("Unknown keyword in gui item", key,
 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 }
 181
 182 /*
 183  * 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
 185  * structure.
 186  */
 187 static Lisp_Object
 188 make_gui_item_from_keywords_internal (Lisp_Object item,
 189                                       Error_behavior errb)
 190 {
 191   int length, plist_p, start;
 192   Lisp_Object *contents;
 193   Lisp_Object gui_item = allocate_gui_item ();
 194   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
 195
 196   CHECK_VECTOR (item);
 197   length = XVECTOR_LENGTH (item);
 198   contents = XVECTOR_DATA (item);
 199
 200   if (length < 1)
 201     signal_simple_error ("GUI item descriptors must be at least 1 elts long", item);
 202
 203   /* length 1:                  [ "name" ]
 204      length 2:          [ "name" callback ]
 205      length 3:          [ "name" callback active-p ]
 206                    or   [ "name" keyword  value  ]
 207      length 4:          [ "name" callback active-p suffix ]
 208                    or   [ "name" callback keyword  value  ]
 209      length 5+:         [ "name" callback [ keyword value ]+ ]
 210                    or   [ "name" [ keyword value ]+ ]
 211   */
 212   plist_p = (length > 2 && (KEYWORDP (contents [1])
 213                             || KEYWORDP (contents [2])));
 214
 215   pgui_item->name = contents [0];
 216   if (length > 1 && !KEYWORDP (contents [1]))
 217     {
 218       pgui_item->callback = contents [1];
 219       start = 2;
 220     }
 221   else
 222     start =1;
 223
 224   if (!plist_p && length > 2)
 225     /* the old way */
 226     {
 227       pgui_item->active = contents [2];
 228       if (length == 4)
 229         pgui_item->suffix = contents [3];
 230     }
 231   else
 232     /* the new way */
 233     {
 234       int i;
 235       if ((length - start) & 1)
 236         signal_simple_error (
 237                 "GUI item descriptor has an odd number of keywords and values",
 238                              item);
 239
 240       for (i = start; i < length;)
 241         {
 242           Lisp_Object key = contents [i++];
 243           Lisp_Object val = contents [i++];
 244           gui_item_add_keyval_pair (gui_item, key, val, errb);
 245         }
 246     }
 247   return gui_item;
 248 }
 249
 250 Lisp_Object
 251 gui_parse_item_keywords (Lisp_Object item)
 252 {
 253   return make_gui_item_from_keywords_internal (item, ERROR_ME);
 254 }
 255
 256 Lisp_Object
 257 gui_parse_item_keywords_no_errors (Lisp_Object item)
 258 {
 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 }
 293
 294 /*
 295  * Decide whether a GUI item is active by evaluating its :active form
 296  * if any
 297  */
 298 int
 299 gui_item_active_p (Lisp_Object gui_item)
 300 {
 301   /* This function can call lisp */
 302
 303   /* Shortcut to avoid evaluating Qt each time */
 304   return (EQ (XGUI_ITEM (gui_item)->active, Qt)
 305           || !NILP (Feval (XGUI_ITEM (gui_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 }
 345
 346 /*
 347  * Decide whether a GUI item is selected by evaluating its :selected form
 348  * if any
 349  */
 350 int
 351 gui_item_selected_p (Lisp_Object gui_item)
 352 {
 353   /* This function can call lisp */
 354
 355   /* Shortcut to avoid evaluating Qt each time */
 356   return (EQ (XGUI_ITEM (gui_item)->selected, Qt)
 357           || !NILP (Feval (XGUI_ITEM (gui_item)->selected)));
 358 }
 359
 360 /*
 361  * Decide whether a GUI item is included by evaluating its :included
 362  * form if given, and testing its :config form against supplied CONFLIST
 363  * configuration variable
 364  */
 365 int
 366 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist)
 367 {
 368   /* This function can call lisp */
 369   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
 370
 371   /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
 372   if (!EQ (pgui_item->included, Qt)
 373       && NILP (Feval (pgui_item->included)))
 374     return 0;
 375
 376   /* Do :config if conflist is given */
 377   if (!NILP (conflist) && !NILP (pgui_item->config)
 378       && NILP (Fmemq (pgui_item->config, conflist)))
 379     return 0;
 380
 381   return 1;
 382 }
 383
 384 static DOESNT_RETURN
 385 signal_too_long_error (Lisp_Object name)
 386 {
 387   signal_simple_error ("GUI item produces too long displayable string", name);
 388 }
 389
 390 #ifdef HAVE_WINDOW_SYSTEM
 391 /*
 392  * Format "left flush" display portion of an item into BUF, guarded by
 393  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 394  * null character, so actual maximum size of buffer consumed is
 395  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 396  * signaled.
 397  * Return value is the offset to the terminating null character into the
 398  * buffer.
 399  */
 400 unsigned int
 401 gui_item_display_flush_left (Lisp_Object gui_item,
 402                              char *buf, Bytecount buf_len)
 403 {
 404   /* This function can call lisp */
 405   char *p = buf;
 406   Bytecount len;
 407   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
 408
 409   /* Copy item name first */
 410   CHECK_STRING (pgui_item->name);
 411   len = XSTRING_LENGTH (pgui_item->name);
 412   if (len > buf_len)
 413     signal_too_long_error (pgui_item->name);
 414   memcpy (p, XSTRING_DATA (pgui_item->name), len);
 415   p += len;
 416
 417   /* Add space and suffix, if there is a suffix.
 418    * If suffix is not string evaluate it */
 419   if (!NILP (pgui_item->suffix))
 420     {
 421       Lisp_Object suffix = pgui_item->suffix;
 422       /* Shortcut to avoid evaluating suffix each time */
 423       if (!STRINGP (suffix))
 424         {
 425           suffix = Feval (suffix);
 426           CHECK_STRING (suffix);
 427         }
 428
 429       len = XSTRING_LENGTH (suffix);
 430       if (p + len + 1 > buf + buf_len)
 431         signal_too_long_error (pgui_item->name);
 432       *(p++) = ' ';
 433       memcpy (p, XSTRING_DATA (suffix), len);
 434       p += len;
 435     }
 436   *p = '\0';
 437   return p - buf;
 438 }
 439
 440 /*
 441  * Format "right flush" display portion of an item into BUF, guarded by
 442  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 443  * null character, so actual maximum size of buffer consumed is
 444  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 445  * signaled.
 446  * Return value is the offset to the terminating null character into the
 447  * buffer.
 448  */
 449 unsigned int
 450 gui_item_display_flush_right (Lisp_Object gui_item,
 451                               char *buf, Bytecount buf_len)
 452 {
 453   Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
 454   *buf = 0;
 455
 456 #ifdef HAVE_MENUBARS
 457   /* Have keys? */
 458   if (!menubar_show_keybindings)
 459     return 0;
 460 #endif
 461
 462   /* Try :keys first */
 463   if (!NILP (pgui_item->keys))
 464     {
 465       CHECK_STRING (pgui_item->keys);
 466       if (XSTRING_LENGTH (pgui_item->keys) + 1 > buf_len)
 467         signal_too_long_error (pgui_item->name);
 468       memcpy (buf, XSTRING_DATA (pgui_item->keys),
 469               XSTRING_LENGTH (pgui_item->keys) + 1);
 470       return XSTRING_LENGTH (pgui_item->keys);
 471     }
 472
 473   /* See if we can derive keys out of callback symbol */
 474   if (SYMBOLP (pgui_item->callback))
 475     {
 476       char buf2[1024]; /* #### */
 477       Bytecount len;
 478
 479       where_is_to_char (pgui_item->callback, buf2);
 480       len = strlen (buf2);
 481       if (len > buf_len)
 482         signal_too_long_error (pgui_item->name);
 483       strcpy (buf, buf2);
 484       return len;
 485     }
 486
 487   /* No keys - no right flush display */
 488   return 0;
 489 }
 490 #endif /* HAVE_WINDOW_SYSTEM */
 491
 492 static Lisp_Object
 493 mark_gui_item (Lisp_Object obj)
 494 {
 495   Lisp_Gui_Item *p = XGUI_ITEM (obj);
 496
 497   mark_object (p->name);
 498   mark_object (p->callback);
 499   mark_object (p->callback_ex);
 500   mark_object (p->config);
 501   mark_object (p->suffix);
 502   mark_object (p->active);
 503   mark_object (p->included);
 504   mark_object (p->config);
 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
 512   return Qnil;
 513 }
 514
 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
 535 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot)
 536 {
 537   int hashid = gui_item_hash (gitem, 0);
 538   int id = GUI_ITEM_ID_BITS (hashid, slot);
 539   while (!NILP (Fgethash (make_int (id),
 540                           hashtable, Qnil)))
 541     {
 542       id = GUI_ITEM_ID_BITS (id + 1, slot);
 543     }
 544   return id;
 545 }
 546
 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
 714 syms_of_gui (void)
 715 {
 716   INIT_LRECORD_IMPLEMENTATION (gui_item);
 717
 718   defkeyword (&Q_active,   ":active");
 719   defkeyword (&Q_suffix,   ":suffix");
 720   defkeyword (&Q_keys,     ":keys");
 721   defkeyword (&Q_key_sequence,":key-sequence");
 722   defkeyword (&Q_style,    ":style");
 723   defkeyword (&Q_selected, ":selected");
 724   defkeyword (&Q_filter,   ":filter");
 725   defkeyword (&Q_config,   ":config");
 726   defkeyword (&Q_included, ":included");
 727   defkeyword (&Q_accelerator, ":accelerator");
 728   defkeyword (&Q_label, ":label");
 729   defkeyword (&Q_callback, ":callback");
 730   defkeyword (&Q_callback_ex, ":callback-ex");
 731   defkeyword (&Q_value, ":value");
 732
 733   defsymbol (&Qtoggle, "toggle");
 734   defsymbol (&Qradio, "radio");
 735
 736 #ifdef HAVE_POPUPS
 737   DEFSUBR (Fpopup_up_p);
 738 #endif
 739 }
 740
 741 void
 742 vars_of_gui (void)
 743 {
 744 }