git.chise.org Git - chise/xemacs-chise.git-/blob - src/gui-x.c

   1 /* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs)
   2    Copyright (C) 1995 Board of Trustees, University of Illinois.
   3    Copyright (C) 1995, 1996, 2000 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 Mule-ized by Ben Wing, 7-8-00. */
  27
  28 #include <config.h>
  29 #include "lisp.h"
  30
  31 #include "console-x.h"
  32 #ifdef LWLIB_USES_MOTIF
  33 #include <Xm/Xm.h> /* for XmVersion */
  34 #endif
  35 #include "gui-x.h"
  36 #include "buffer.h"
  37 #include "device.h"
  38 #include "events.h"
  39 #include "frame.h"
  40 #include "gui.h"
  41 #include "glyphs.h"
  42 #include "redisplay.h"
  43 #include "opaque.h"
  44
  45 /* we need a unique id for each popup menu, dialog box, and scrollbar */
  46 static unsigned int lwlib_id_tick;
  47
  48 LWLIB_ID
  49 new_lwlib_id (void)
  50 {
  51   return ++lwlib_id_tick;
  52 }
  53
  54 widget_value *
  55 xmalloc_widget_value (void)
  56 {
  57   widget_value *tmp = malloc_widget_value ();
  58   if (!tmp) memory_full ();
  59   return tmp;
  60 }
  61
  62 \f
  63 static int
  64 mark_widget_value_mapper (widget_value *val, void *closure)
  65 {
  66   Lisp_Object markee;
  67   if (val->call_data)
  68     {
  69       VOID_TO_LISP (markee, val->call_data);
  70       mark_object (markee);
  71     }
  72
  73   if (val->accel)
  74     {
  75       VOID_TO_LISP (markee, val->accel);
  76       mark_object (markee);
  77     }
  78   return 0;
  79 }
  80
  81 static Lisp_Object
  82 mark_popup_data (Lisp_Object obj)
  83 {
  84   struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
  85
  86   /* Now mark the callbacks and such that are hidden in the lwlib
  87      call-data */
  88
  89   if (data->id)
  90     lw_map_widget_values (data->id, mark_widget_value_mapper, 0);
  91
  92   return data->last_menubar_buffer;
  93 }
  94
  95 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
  96                                mark_popup_data, internal_object_printer,
  97                                0, 0, 0, 0, struct popup_data);
  98 \f
  99 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
 100    (id . popup-data) for GCPRO'ing the callbacks of the popup menus
 101    and dialog boxes. */
 102 static Lisp_Object Vpopup_callbacks;
 103
 104 void
 105 gcpro_popup_callbacks (LWLIB_ID id)
 106 {
 107   struct popup_data *pdata;
 108   Lisp_Object lid = make_int (id);
 109   Lisp_Object lpdata;
 110
 111   assert (NILP (assq_no_quit (lid, Vpopup_callbacks)));
 112   pdata = alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
 113   pdata->id = id;
 114   pdata->last_menubar_buffer = Qnil;
 115   pdata->menubar_contents_up_to_date = 0;
 116   XSETPOPUP_DATA (lpdata, pdata);
 117   Vpopup_callbacks = Fcons (Fcons (lid, lpdata), Vpopup_callbacks);
 118 }
 119
 120 void
 121 ungcpro_popup_callbacks (LWLIB_ID id)
 122 {
 123   Lisp_Object lid = make_int (id);
 124   Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks);
 125   assert (!NILP (this));
 126   Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks);
 127 }
 128
 129 int
 130 popup_handled_p (LWLIB_ID id)
 131 {
 132   return NILP (assq_no_quit (make_int (id), Vpopup_callbacks));
 133 }
 134
 135 /* menu_item_descriptor_to_widget_value() et al. mallocs a
 136    widget_value, but then may signal lisp errors.  If an error does
 137    not occur, the opaque ptr we have here has had its pointer set to 0
 138    to tell us not to do anything.  Otherwise we free the widget value.
 139    (This has nothing to do with GC, it's just about not dropping
 140    pointers to malloc'd data when errors happen.) */
 141
 142 Lisp_Object
 143 widget_value_unwind (Lisp_Object closure)
 144 {
 145   widget_value *wv = (widget_value *) get_opaque_ptr (closure);
 146   free_opaque_ptr (closure);
 147   if (wv)
 148     free_widget_value_tree (wv);
 149   return Qnil;
 150 }
 151
 152 #if 0
 153 static void
 154 print_widget_value (widget_value *wv, int depth)
 155 {
 156   /* strings in wv are in external format; use printf not stdout_out
 157      because the latter takes internal-format strings */
 158   Extbyte d [200];
 159   int i;
 160   for (i = 0; i < depth; i++) d[i] = ' ';
 161   d[depth]=0;
 162   /* #### - print type field */
 163   printf ("%sname:    %s\n", d, (wv->name ? wv->name : "(null)"));
 164   if (wv->value) printf ("%svalue:   %s\n", d, wv->value);
 165   if (wv->key)   printf ("%skey:     %s\n", d, wv->key);
 166   printf ("%senabled: %d\n", d, wv->enabled);
 167   if (wv->contents)
 168     {
 169       printf ("\n%scontents: \n", d);
 170       print_widget_value (wv->contents, depth + 5);
 171     }
 172   if (wv->next)
 173     {
 174       printf ("\n");
 175       print_widget_value (wv->next, depth);
 176     }
 177 }
 178 #endif
 179
 180 /* This recursively calls free_widget_value() on the tree of widgets.
 181    It must free all data that was malloc'ed for these widget_values.
 182
 183    It used to be that emacs only allocated new storage for the `key' slot.
 184    All other slots are pointers into the data of Lisp_Strings, and must be
 185    left alone.  */
 186 void
 187 free_popup_widget_value_tree (widget_value *wv)
 188 {
 189   if (! wv) return;
 190   if (wv->key) xfree (wv->key);
 191   if (wv->value) xfree (wv->value);
 192   if (wv->name) xfree (wv->name);
 193
 194   wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
 195
 196   if (wv->contents && (wv->contents != (widget_value*)1))
 197     {
 198       free_popup_widget_value_tree (wv->contents);
 199       wv->contents = (widget_value *) 0xDEADBEEF;
 200     }
 201   if (wv->next)
 202     {
 203       free_popup_widget_value_tree (wv->next);
 204       wv->next = (widget_value *) 0xDEADBEEF;
 205     }
 206   free_widget_value (wv);
 207 }
 208
 209 /* The following is actually called from somewhere within XtDispatchEvent(),
 210    called from XtAppProcessEvent() in event-Xt.c
 211
 212    Callback function for widgets and menus.
 213  */
 214
 215 void
 216 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 217                           XtPointer client_data)
 218 {
 219   Lisp_Object data, image_instance, callback, callback_ex;
 220   Lisp_Object frame, event;
 221   int update_subwindows_p = 0;
 222   struct device *d = get_device_from_display (XtDisplay (widget));
 223   struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
 224
 225   /* set in lwlib to the time stamp associated with the most recent menu
 226      operation */
 227   extern Time x_focus_timestamp_really_sucks_fix_me_better;
 228
 229   if (!f)
 230     return;
 231   if (((EMACS_INT) client_data) == 0)
 232     return;
 233   VOID_TO_LISP (data, client_data);
 234   XSETFRAME (frame, f);
 235
 236 #if 0
 237   /* #### What the hell?  I can't understand why this call is here,
 238      and doing it is really courting disaster in the new event
 239      model, since popup_selection_callback is called from
 240      within next_event_internal() and Faccept_process_output()
 241      itself calls next_event_internal().  --Ben */
 242
 243   /* Flush the X and process input */
 244   Faccept_process_output (Qnil, Qnil, Qnil);
 245 #endif
 246
 247   if (((EMACS_INT) client_data) == -1)
 248     {
 249       event = Fmake_event (Qnil, Qnil);
 250
 251       XEVENT (event)->event_type = misc_user_event;
 252       XEVENT (event)->channel = frame;
 253       XEVENT (event)->event.eval.function = Qrun_hooks;
 254       XEVENT (event)->event.eval.object = Qmenu_no_selection_hook;
 255     }
 256   else
 257     {
 258       image_instance = XCAR (data);
 259       callback = XCAR (XCDR (data));
 260       callback_ex = XCDR (XCDR (data));
 261       update_subwindows_p = 1;
 262       /* It is possible for a widget action to cause it to get out of
 263          sync with its instantiator. Thus it is necessary to signal
 264          this possibility. */
 265       if (IMAGE_INSTANCEP (image_instance))
 266         XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1;
 267
 268       if (!NILP (callback_ex) && !UNBOUNDP (callback_ex))
 269         {
 270           event = Fmake_event (Qnil, Qnil);
 271
 272           XEVENT (event)->event_type = misc_user_event;
 273           XEVENT (event)->channel = frame;
 274           XEVENT (event)->event.eval.function = Qeval;
 275           XEVENT (event)->event.eval.object =
 276             list4 (Qfuncall, callback_ex, image_instance, event);
 277         }
 278       else if (NILP (callback) || UNBOUNDP (callback))
 279         event = Qnil;
 280       else
 281         {
 282           Lisp_Object fn, arg;
 283
 284           event = Fmake_event (Qnil, Qnil);
 285
 286           get_gui_callback (callback, &fn, &arg);
 287           XEVENT (event)->event_type = misc_user_event;
 288           XEVENT (event)->channel = frame;
 289           XEVENT (event)->event.eval.function = fn;
 290           XEVENT (event)->event.eval.object = arg;
 291         }
 292     }
 293
 294   /* This is the timestamp used for asserting focus so we need to get an
 295      up-to-date value event if no events have been dispatched to emacs
 296      */
 297 #if defined(HAVE_MENUBARS)
 298   DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better;
 299 #else
 300   DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
 301 #endif
 302   if (!NILP (event))
 303     enqueue_Xt_dispatch_event (event);
 304   /* The result of this evaluation could cause other instances to change so
 305      enqueue an update callback to check this. */
 306   if (update_subwindows_p && !NILP (event))
 307     enqueue_magic_eval_event (update_widget_instances, frame);
 308 }
 309
 310 #if 1
 311   /* Eval the activep slot of the menu item */
 312 # define wv_set_evalable_slot(slot,form) do {   \
 313   Lisp_Object wses_form = (form);               \
 314   (slot) = (NILP (wses_form) ? 0 :              \
 315             EQ (wses_form, Qt) ? 1 :            \
 316             !NILP (Feval (wses_form)));         \
 317 } while (0)
 318 #else
 319   /* Treat the activep slot of the menu item as a boolean */
 320 # define wv_set_evalable_slot(slot,form)        \
 321       ((void) (slot = (!NILP (form))))
 322 #endif
 323
 324 Extbyte *
 325 menu_separator_style_and_to_external (const Bufbyte *s)
 326 {
 327   const Bufbyte *p;
 328   Bufbyte first;
 329
 330   if (!s || s[0] == '\0')
 331     return NULL;
 332   first = s[0];
 333   if (first != '-' && first != '=')
 334     return NULL;
 335   for (p = s; *p == first; p++)
 336     DO_NOTHING;
 337
 338   /* #### - cannot currently specify a separator tag "--!tag" and a
 339      separator style "--:style" at the same time. */
 340   /* #### - Also, the motif menubar code doesn't deal with the
 341      double etched style yet, so it's not good to get into the habit of
 342      using "===" in menubars to get double-etched lines */
 343   if (*p == '!' || *p == '\0')
 344     return ((first == '-')
 345             ? NULL                      /* single etched is the default */
 346             : xstrdup ("shadowDoubleEtchedIn"));
 347   else if (*p == ':')
 348     {
 349       Extbyte *retval;
 350
 351       C_STRING_TO_EXTERNAL_MALLOC (p + 1, retval, Qlwlib_encoding);
 352       return retval;
 353     }
 354
 355   return NULL;
 356 }
 357
 358 Extbyte *
 359 add_accel_and_to_external (Lisp_Object string)
 360 {
 361   int i;
 362   int found_accel = 0;
 363   Extbyte *retval;
 364   Bufbyte *name = XSTRING_DATA (string);
 365
 366   for (i = 0; name[i]; ++i)
 367     if (name[i] == '%' && name[i+1] == '_')
 368       {
 369         found_accel = 1;
 370         break;
 371       }
 372
 373   if (found_accel)
 374     LISP_STRING_TO_EXTERNAL_MALLOC (string, retval, Qlwlib_encoding);
 375   else
 376     {
 377       size_t namelen = XSTRING_LENGTH (string);
 378       Bufbyte *chars = (Bufbyte *) alloca (namelen + 3);
 379       chars[0] = '%';
 380       chars[1] = '_';
 381       memcpy (chars + 2, name, namelen + 1);
 382       C_STRING_TO_EXTERNAL_MALLOC (chars, retval, Qlwlib_encoding);
 383     }
 384
 385   return retval;
 386 }
 387
 388 /* This does the dirty work.  gc_currently_forbidden is 1 when this is called.
 389  */
 390 int
 391 button_item_to_widget_value (Lisp_Object gui_object_instance,
 392                              Lisp_Object gui_item, widget_value *wv,
 393                              int allow_text_field_p, int no_keys_p,
 394                              int menu_entry_p, int accel_p)
 395 {
 396   /* This function cannot GC because gc_currently_forbidden is set when
 397      it's called */
 398   Lisp_Gui_Item* pgui = 0;
 399
 400   /* degenerate case */
 401   if (STRINGP (gui_item))
 402     {
 403       wv->type = TEXT_TYPE;
 404       if (accel_p)
 405         wv->name = add_accel_and_to_external (gui_item);
 406       else
 407         LISP_STRING_TO_EXTERNAL_MALLOC (gui_item, wv->name, Qlwlib_encoding);
 408       return 1;
 409     }
 410   else if (!GUI_ITEMP (gui_item))
 411     syntax_error ("need a string or a gui_item here", gui_item);
 412
 413   pgui = XGUI_ITEM (gui_item);
 414
 415   if (!NILP (pgui->filter))
 416     syntax_error (":filter keyword not permitted on leaf nodes", gui_item);
 417
 418 #ifdef HAVE_MENUBARS
 419   if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
 420     {
 421       /* the include specification says to ignore this item. */
 422       return 0;
 423     }
 424 #endif /* HAVE_MENUBARS */
 425
 426   if (!STRINGP (pgui->name))
 427     pgui->name = Feval (pgui->name);
 428
 429   CHECK_STRING (pgui->name);
 430   if (accel_p)
 431     {
 432       wv->name = add_accel_and_to_external (pgui->name);
 433       wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
 434     }
 435   else
 436     {
 437       LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, wv->name, Qlwlib_encoding);
 438       wv->accel = LISP_TO_VOID (Qnil);
 439     }
 440
 441   if (!NILP (pgui->suffix))
 442     {
 443       Lisp_Object suffix2;
 444
 445       /* Shortcut to avoid evaluating suffix each time */
 446       if (STRINGP (pgui->suffix))
 447         suffix2 = pgui->suffix;
 448       else
 449         {
 450           suffix2 = Feval (pgui->suffix);
 451           CHECK_STRING (suffix2);
 452         }
 453
 454       LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
 455     }
 456
 457   wv_set_evalable_slot (wv->enabled, pgui->active);
 458   wv_set_evalable_slot (wv->selected, pgui->selected);
 459
 460   if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
 461     wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
 462                                          pgui->callback,
 463                                          pgui->callback_ex));
 464
 465   if (no_keys_p
 466 #ifdef HAVE_MENUBARS
 467       || (menu_entry_p && !menubar_show_keybindings)
 468 #endif
 469       )
 470     wv->key = 0;
 471   else if (!NILP (pgui->keys))  /* Use this string to generate key bindings */
 472     {
 473       CHECK_STRING (pgui->keys);
 474       pgui->keys = Fsubstitute_command_keys (pgui->keys);
 475       if (XSTRING_LENGTH (pgui->keys) > 0)
 476         LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding);
 477       else
 478         wv->key = 0;
 479     }
 480   else if (SYMBOLP (pgui->callback))    /* Show the binding of this command. */
 481     {
 482       char buf[1024]; /* #### */
 483       /* #### Warning, dependency here on current_buffer and point */
 484       where_is_to_char (pgui->callback, buf);
 485       if (buf [0])
 486         C_STRING_TO_EXTERNAL_MALLOC (buf, wv->key, Qlwlib_encoding);
 487       else
 488         wv->key = 0;
 489     }
 490
 491   CHECK_SYMBOL (pgui->style);
 492   if (NILP (pgui->style))
 493     {
 494       Bufbyte *intname;
 495       Bytecount intlen;
 496       /* If the callback is nil, treat this item like unselectable text.
 497          This way, dashes will show up as a separator. */
 498       if (!wv->enabled)
 499         wv->type = BUTTON_TYPE;
 500       TO_INTERNAL_FORMAT (C_STRING, wv->name,
 501                           ALLOCA, (intname, intlen),
 502                           Qlwlib_encoding);
 503       if (separator_string_p (intname))
 504         {
 505           wv->type = SEPARATOR_TYPE;
 506           wv->value = menu_separator_style_and_to_external (intname);
 507         }
 508       else
 509         {
 510 #if 0
 511           /* #### - this is generally desirable for menubars, but it breaks
 512              a package that uses dialog boxes and next_command_event magic
 513              to use the callback slot in dialog buttons for data instead of
 514              a real callback.
 515
 516              Code is data, right?  The beauty of LISP abuse.   --Stig */
 517           if (NILP (callback))
 518             wv->type = TEXT_TYPE;
 519           else
 520 #endif
 521             wv->type = BUTTON_TYPE;
 522         }
 523     }
 524   else if (EQ (pgui->style, Qbutton))
 525     wv->type = BUTTON_TYPE;
 526   else if (EQ (pgui->style, Qtoggle))
 527     wv->type = TOGGLE_TYPE;
 528   else if (EQ (pgui->style, Qradio))
 529     wv->type = RADIO_TYPE;
 530   else if (EQ (pgui->style, Qtext))
 531     {
 532       wv->type = TEXT_TYPE;
 533 #if 0
 534       wv->value = wv->name;
 535       wv->name = "value";
 536 #endif
 537     }
 538   else
 539     syntax_error_2 ("Unknown style", pgui->style, gui_item);
 540
 541   if (!allow_text_field_p && (wv->type == TEXT_TYPE))
 542     syntax_error ("Text field not allowed in this context", gui_item);
 543
 544   if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
 545     syntax_error
 546       (":selected only makes sense with :style toggle, radio or button",
 547        gui_item);
 548   return 1;
 549 }
 550
 551 /* parse tree's of gui items into widget_value hierarchies */
 552 static void gui_item_children_to_widget_values (Lisp_Object
 553                                                 gui_object_instance,
 554                                                 Lisp_Object items,
 555                                                 widget_value* parent,
 556                                                 int accel_p);
 557
 558 static widget_value *
 559 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
 560                               Lisp_Object items, widget_value* parent,
 561                               widget_value* prev, int accel_p)
 562 {
 563   widget_value* wv = 0;
 564
 565   assert ((parent || prev) && !(parent && prev));
 566   /* now walk the tree creating widget_values as appropriate */
 567   if (!CONSP (items))
 568     {
 569       wv = xmalloc_widget_value ();
 570       if (parent)
 571         parent->contents = wv;
 572       else
 573         prev->next = wv;
 574       if (!button_item_to_widget_value (gui_object_instance,
 575                                         items, wv, 0, 1, 0, accel_p))
 576         {
 577           free_widget_value_tree (wv);
 578           if (parent)
 579             parent->contents = 0;
 580           else
 581             prev->next = 0;
 582         }
 583       else
 584         wv->value = xstrdup (wv->name); /* what a mess... */
 585     }
 586   else
 587     {
 588       /* first one is the parent */
 589       if (CONSP (XCAR (items)))
 590         syntax_error ("parent item must not be a list", XCAR (items));
 591
 592       if (parent)
 593         wv = gui_items_to_widget_values_1 (gui_object_instance,
 594                                            XCAR (items), parent, 0, accel_p);
 595       else
 596         wv = gui_items_to_widget_values_1 (gui_object_instance,
 597                                            XCAR (items), 0, prev, accel_p);
 598       /* the rest are the children */
 599       gui_item_children_to_widget_values (gui_object_instance,
 600                                           XCDR (items), wv, accel_p);
 601     }
 602   return wv;
 603 }
 604
 605 static void
 606 gui_item_children_to_widget_values (Lisp_Object gui_object_instance,
 607                                     Lisp_Object items, widget_value* parent,
 608                                     int accel_p)
 609 {
 610   widget_value* wv = 0, *prev = 0;
 611   Lisp_Object rest;
 612   CHECK_CONS (items);
 613
 614   /* first one is master */
 615   prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items),
 616                                        parent, 0, accel_p);
 617   /* the rest are the children */
 618   LIST_LOOP (rest, XCDR (items))
 619     {
 620       Lisp_Object tab = XCAR (rest);
 621       wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev,
 622                                          accel_p);
 623       prev = wv;
 624     }
 625 }
 626
 627 widget_value *
 628 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
 629                             int accel_p)
 630 {
 631   /* This function can GC */
 632   widget_value *control = 0, *tmp = 0;
 633   int count = specpdl_depth ();
 634   Lisp_Object wv_closure;
 635
 636   if (NILP (items))
 637     syntax_error ("must have some items", items);
 638
 639   /* Inhibit GC during this conversion.  The reasons for this are
 640      the same as in menu_item_descriptor_to_widget_value(); see
 641      the large comment above that function. */
 642   record_unwind_protect (restore_gc_inhibit,
 643                          make_int (gc_currently_forbidden));
 644   gc_currently_forbidden = 1;
 645
 646   /* Also make sure that we free the partially-created widget_value
 647      tree on Lisp error. */
 648   control = xmalloc_widget_value ();
 649   wv_closure = make_opaque_ptr (control);
 650   record_unwind_protect (widget_value_unwind, wv_closure);
 651
 652   gui_items_to_widget_values_1 (gui_object_instance, items, control, 0,
 653                                 accel_p);
 654
 655   /* mess about getting the data we really want */
 656   tmp = control;
 657   control = control->contents;
 658   tmp->next = 0;
 659   tmp->contents = 0;
 660   free_widget_value_tree (tmp);
 661
 662   /* No more need to free the half-filled-in structures. */
 663   set_opaque_ptr (wv_closure, 0);
 664   unbind_to (count, Qnil);
 665
 666   return control;
 667 }
 668
 669 /* This is a kludge to make sure emacs can only link against a version of
 670    lwlib that was compiled in the right way.  Emacs references symbols which
 671    correspond to the way it thinks lwlib was compiled, and if lwlib wasn't
 672    compiled in that way, then somewhat meaningful link errors will result.
 673    The alternatives to this range from obscure link errors, to obscure
 674    runtime errors that look a lot like bugs.
 675  */
 676
 677 static void
 678 sanity_check_lwlib (void)
 679 {
 680 #define MACROLET(v) { extern int v; v = 1; }
 681
 682 #if (XlibSpecificationRelease == 4)
 683   MACROLET (lwlib_uses_x11r4);
 684 #elif (XlibSpecificationRelease == 5)
 685   MACROLET (lwlib_uses_x11r5);
 686 #elif (XlibSpecificationRelease == 6)
 687   MACROLET (lwlib_uses_x11r6);
 688 #else
 689   MACROLET (lwlib_uses_unknown_x11);
 690 #endif
 691 #ifdef LWLIB_USES_MOTIF
 692   MACROLET (lwlib_uses_motif);
 693 #else
 694   MACROLET (lwlib_does_not_use_motif);
 695 #endif
 696 #if (XmVersion >= 1002)
 697   MACROLET (lwlib_uses_motif_1_2);
 698 #else
 699   MACROLET (lwlib_does_not_use_motif_1_2);
 700 #endif
 701 #ifdef LWLIB_MENUBARS_LUCID
 702   MACROLET (lwlib_menubars_lucid);
 703 #elif defined (HAVE_MENUBARS)
 704   MACROLET (lwlib_menubars_motif);
 705 #endif
 706 #ifdef LWLIB_SCROLLBARS_LUCID
 707   MACROLET (lwlib_scrollbars_lucid);
 708 #elif defined (LWLIB_SCROLLBARS_MOTIF)
 709   MACROLET (lwlib_scrollbars_motif);
 710 #elif defined (HAVE_SCROLLBARS)
 711   MACROLET (lwlib_scrollbars_athena);
 712 #endif
 713 #ifdef LWLIB_DIALOGS_MOTIF
 714   MACROLET (lwlib_dialogs_motif);
 715 #elif defined (HAVE_DIALOGS)
 716   MACROLET (lwlib_dialogs_athena);
 717 #endif
 718 #ifdef LWLIB_WIDGETS_MOTIF
 719   MACROLET (lwlib_widgets_motif);
 720 #elif defined (HAVE_WIDGETS)
 721   MACROLET (lwlib_widgets_athena);
 722 #endif
 723
 724 #undef MACROLET
 725 }
 726
 727 void
 728 syms_of_gui_x (void)
 729 {
 730   INIT_LRECORD_IMPLEMENTATION (popup_data);
 731 }
 732
 733 void
 734 reinit_vars_of_gui_x (void)
 735 {
 736   lwlib_id_tick = (1<<16);      /* start big, to not conflict with Energize */
 737 #ifdef HAVE_POPUPS
 738   popup_up_p = 0;
 739 #endif
 740
 741   /* this makes only safe calls as in emacs.c */
 742   sanity_check_lwlib ();
 743 }
 744
 745 void
 746 vars_of_gui_x (void)
 747 {
 748   reinit_vars_of_gui_x ();
 749
 750   Vpopup_callbacks = Qnil;
 751   staticpro (&Vpopup_callbacks);
 752 }