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