git.chise.org Git - chise/xemacs-chise.git.1/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 void
 213 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 214                           XtPointer client_data)
 215 {
 216   Lisp_Object data, image_instance, callback, callback_ex;
 217   Lisp_Object frame, event;
 218   int update_subwindows_p = 0;
 219   struct device *d = get_device_from_display (XtDisplay (widget));
 220   struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
 221
 222   /* set in lwlib to the time stamp associated with the most recent menu
 223      operation */
 224   extern Time x_focus_timestamp_really_sucks_fix_me_better;
 225
 226   if (!f)
 227     return;
 228   if (((EMACS_INT) client_data) == 0)
 229     return;
 230   VOID_TO_LISP (data, client_data);
 231   XSETFRAME (frame, f);
 232
 233 #if 0
 234   /* #### What the hell?  I can't understand why this call is here,
 235      and doing it is really courting disaster in the new event
 236      model, since popup_selection_callback is called from
 237      within next_event_internal() and Faccept_process_output()
 238      itself calls next_event_internal().  --Ben */
 239
 240   /* Flush the X and process input */
 241   Faccept_process_output (Qnil, Qnil, Qnil);
 242 #endif
 243
 244   if (((EMACS_INT) client_data) == -1)
 245     {
 246       event = Fmake_event (Qnil, Qnil);
 247
 248       XEVENT (event)->event_type = misc_user_event;
 249       XEVENT (event)->channel = frame;
 250       XEVENT (event)->event.eval.function = Qrun_hooks;
 251       XEVENT (event)->event.eval.object = Qmenu_no_selection_hook;
 252     }
 253   else
 254     {
 255       image_instance = XCAR (data);
 256       callback = XCAR (XCDR (data));
 257       callback_ex = XCDR (XCDR (data));
 258       update_subwindows_p = 1;
 259       /* It is possible for a widget action to cause it to get out of
 260          sync with its instantiator. Thus it is necessary to signal
 261          this possibility. */
 262       if (IMAGE_INSTANCEP (image_instance))
 263         XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1;
 264
 265       if (!NILP (callback_ex) && !UNBOUNDP (callback_ex))
 266         {
 267           event = Fmake_event (Qnil, Qnil);
 268
 269           XEVENT (event)->event_type = misc_user_event;
 270           XEVENT (event)->channel = frame;
 271           XEVENT (event)->event.eval.function = Qeval;
 272           XEVENT (event)->event.eval.object =
 273             list4 (Qfuncall, callback_ex, image_instance, event);
 274         }
 275       else if (NILP (callback) || UNBOUNDP (callback))
 276         event = Qnil;
 277       else
 278         {
 279           Lisp_Object fn, arg;
 280
 281           event = Fmake_event (Qnil, Qnil);
 282
 283           get_gui_callback (callback, &fn, &arg);
 284           XEVENT (event)->event_type = misc_user_event;
 285           XEVENT (event)->channel = frame;
 286           XEVENT (event)->event.eval.function = fn;
 287           XEVENT (event)->event.eval.object = arg;
 288         }
 289     }
 290
 291   /* This is the timestamp used for asserting focus so we need to get an
 292      up-to-date value event if no events have been dispatched to emacs
 293      */
 294 #if defined(HAVE_MENUBARS)
 295   DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better;
 296 #else
 297   DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
 298 #endif
 299   if (!NILP (event))
 300     enqueue_Xt_dispatch_event (event);
 301   /* The result of this evaluation could cause other instances to change so
 302      enqueue an update callback to check this. */
 303   if (update_subwindows_p && !NILP (event))
 304     enqueue_magic_eval_event (update_widget_instances, frame);
 305 }
 306
 307 #if 1
 308   /* Eval the activep slot of the menu item */
 309 # define wv_set_evalable_slot(slot,form) do {   \
 310   Lisp_Object wses_form = (form);               \
 311   (slot) = (NILP (wses_form) ? 0 :              \
 312             EQ (wses_form, Qt) ? 1 :            \
 313             !NILP (Feval (wses_form)));         \
 314 } while (0)
 315 #else
 316   /* Treat the activep slot of the menu item as a boolean */
 317 # define wv_set_evalable_slot(slot,form)        \
 318       ((void) (slot = (!NILP (form))))
 319 #endif
 320
 321 Extbyte *
 322 menu_separator_style_and_to_external (const Bufbyte *s)
 323 {
 324   const Bufbyte *p;
 325   Bufbyte first;
 326
 327   if (!s || s[0] == '\0')
 328     return NULL;
 329   first = s[0];
 330   if (first != '-' && first != '=')
 331     return NULL;
 332   for (p = s; *p == first; p++)
 333     DO_NOTHING;
 334
 335   /* #### - cannot currently specify a separator tag "--!tag" and a
 336      separator style "--:style" at the same time. */
 337   /* #### - Also, the motif menubar code doesn't deal with the
 338      double etched style yet, so it's not good to get into the habit of
 339      using "===" in menubars to get double-etched lines */
 340   if (*p == '!' || *p == '\0')
 341     return ((first == '-')
 342             ? NULL                      /* single etched is the default */
 343             : xstrdup ("shadowDoubleEtchedIn"));
 344   else if (*p == ':')
 345     {
 346       Extbyte *retval;
 347
 348       C_STRING_TO_EXTERNAL_MALLOC (p + 1, retval, Qlwlib_encoding);
 349       return retval;
 350     }
 351
 352   return NULL;
 353 }
 354
 355 Extbyte *
 356 add_accel_and_to_external (Lisp_Object string)
 357 {
 358   int i;
 359   int found_accel = 0;
 360   Extbyte *retval;
 361   Bufbyte *name = XSTRING_DATA (string);
 362
 363   for (i = 0; name[i]; ++i)
 364     if (name[i] == '%' && name[i+1] == '_')
 365       {
 366         found_accel = 1;
 367         break;
 368       }
 369
 370   if (found_accel)
 371     LISP_STRING_TO_EXTERNAL_MALLOC (string, retval, Qlwlib_encoding);
 372   else
 373     {
 374       size_t namelen = XSTRING_LENGTH (string);
 375       Bufbyte *chars = (Bufbyte *) alloca (namelen + 3);
 376       chars[0] = '%';
 377       chars[1] = '_';
 378       memcpy (chars + 2, name, namelen + 1);
 379       C_STRING_TO_EXTERNAL_MALLOC (chars, retval, Qlwlib_encoding);
 380     }
 381
 382   return retval;
 383 }
 384
 385 /* This does the dirty work.  gc_currently_forbidden is 1 when this is called.
 386  */
 387 int
 388 button_item_to_widget_value (Lisp_Object gui_object_instance,
 389                              Lisp_Object gui_item, widget_value *wv,
 390                              int allow_text_field_p, int no_keys_p,
 391                              int menu_entry_p, int accel_p)
 392 {
 393   /* This function cannot GC because gc_currently_forbidden is set when
 394      it's called */
 395   Lisp_Gui_Item* pgui = 0;
 396
 397   /* degenerate case */
 398   if (STRINGP (gui_item))
 399     {
 400       wv->type = TEXT_TYPE;
 401       if (accel_p)
 402         wv->name = add_accel_and_to_external (gui_item);
 403       else
 404         LISP_STRING_TO_EXTERNAL_MALLOC (gui_item, wv->name, Qlwlib_encoding);
 405       return 1;
 406     }
 407   else if (!GUI_ITEMP (gui_item))
 408     syntax_error ("need a string or a gui_item here", gui_item);
 409
 410   pgui = XGUI_ITEM (gui_item);
 411
 412   if (!NILP (pgui->filter))
 413     syntax_error (":filter keyword not permitted on leaf nodes", gui_item);
 414
 415 #ifdef HAVE_MENUBARS
 416   if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
 417     {
 418       /* the include specification says to ignore this item. */
 419       return 0;
 420     }
 421 #endif /* HAVE_MENUBARS */
 422
 423   if (!STRINGP (pgui->name))
 424     pgui->name = Feval (pgui->name);
 425
 426   CHECK_STRING (pgui->name);
 427   if (accel_p)
 428     {
 429       wv->name = add_accel_and_to_external (pgui->name);
 430       wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
 431     }
 432   else
 433     {
 434       LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, wv->name, Qlwlib_encoding);
 435       wv->accel = LISP_TO_VOID (Qnil);
 436     }
 437
 438   if (!NILP (pgui->suffix))
 439     {
 440       Lisp_Object suffix2;
 441
 442       /* Shortcut to avoid evaluating suffix each time */
 443       if (STRINGP (pgui->suffix))
 444         suffix2 = pgui->suffix;
 445       else
 446         {
 447           suffix2 = Feval (pgui->suffix);
 448           CHECK_STRING (suffix2);
 449         }
 450
 451       LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
 452     }
 453
 454   wv_set_evalable_slot (wv->enabled, pgui->active);
 455   wv_set_evalable_slot (wv->selected, pgui->selected);
 456
 457   if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
 458     wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
 459                                          pgui->callback,
 460                                          pgui->callback_ex));
 461
 462   if (no_keys_p
 463 #ifdef HAVE_MENUBARS
 464       || (menu_entry_p && !menubar_show_keybindings)
 465 #endif
 466       )
 467     wv->key = 0;
 468   else if (!NILP (pgui->keys))  /* Use this string to generate key bindings */
 469     {
 470       CHECK_STRING (pgui->keys);
 471       pgui->keys = Fsubstitute_command_keys (pgui->keys);
 472       if (XSTRING_LENGTH (pgui->keys) > 0)
 473         LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding);
 474       else
 475         wv->key = 0;
 476     }
 477   else if (SYMBOLP (pgui->callback))    /* Show the binding of this command. */
 478     {
 479       char buf[1024]; /* #### */
 480       /* #### Warning, dependency here on current_buffer and point */
 481       where_is_to_char (pgui->callback, buf);
 482       if (buf [0])
 483         C_STRING_TO_EXTERNAL_MALLOC (buf, wv->key, Qlwlib_encoding);
 484       else
 485         wv->key = 0;
 486     }
 487
 488   CHECK_SYMBOL (pgui->style);
 489   if (NILP (pgui->style))
 490     {
 491       Bufbyte *intname;
 492       Bytecount intlen;
 493       /* If the callback is nil, treat this item like unselectable text.
 494          This way, dashes will show up as a separator. */
 495       if (!wv->enabled)
 496         wv->type = BUTTON_TYPE;
 497       TO_INTERNAL_FORMAT (C_STRING, wv->name,
 498                           ALLOCA, (intname, intlen),
 499                           Qlwlib_encoding);
 500       if (separator_string_p (intname))
 501         {
 502           wv->type = SEPARATOR_TYPE;
 503           wv->value = menu_separator_style_and_to_external (intname);
 504         }
 505       else
 506         {
 507 #if 0
 508           /* #### - this is generally desirable for menubars, but it breaks
 509              a package that uses dialog boxes and next_command_event magic
 510              to use the callback slot in dialog buttons for data instead of
 511              a real callback.
 512
 513              Code is data, right?  The beauty of LISP abuse.   --Stig */
 514           if (NILP (callback))
 515             wv->type = TEXT_TYPE;
 516           else
 517 #endif
 518             wv->type = BUTTON_TYPE;
 519         }
 520     }
 521   else if (EQ (pgui->style, Qbutton))
 522     wv->type = BUTTON_TYPE;
 523   else if (EQ (pgui->style, Qtoggle))
 524     wv->type = TOGGLE_TYPE;
 525   else if (EQ (pgui->style, Qradio))
 526     wv->type = RADIO_TYPE;
 527   else if (EQ (pgui->style, Qtext))
 528     {
 529       wv->type = TEXT_TYPE;
 530 #if 0
 531       wv->value = wv->name;
 532       wv->name = "value";
 533 #endif
 534     }
 535   else
 536     syntax_error_2 ("Unknown style", pgui->style, gui_item);
 537
 538   if (!allow_text_field_p && (wv->type == TEXT_TYPE))
 539     syntax_error ("Text field not allowed in this context", gui_item);
 540
 541   if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
 542     syntax_error
 543       (":selected only makes sense with :style toggle, radio or button",
 544        gui_item);
 545   return 1;
 546 }
 547
 548 /* parse tree's of gui items into widget_value hierarchies */
 549 static void gui_item_children_to_widget_values (Lisp_Object
 550                                                 gui_object_instance,
 551                                                 Lisp_Object items,
 552                                                 widget_value* parent,
 553                                                 int accel_p);
 554
 555 static widget_value *
 556 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
 557                               Lisp_Object items, widget_value* parent,
 558                               widget_value* prev, int accel_p)
 559 {
 560   widget_value* wv = 0;
 561
 562   assert ((parent || prev) && !(parent && prev));
 563   /* now walk the tree creating widget_values as appropriate */
 564   if (!CONSP (items))
 565     {
 566       wv = xmalloc_widget_value ();
 567       if (parent)
 568         parent->contents = wv;
 569       else
 570         prev->next = wv;
 571       if (!button_item_to_widget_value (gui_object_instance,
 572                                         items, wv, 0, 1, 0, accel_p))
 573         {
 574           free_widget_value_tree (wv);
 575           if (parent)
 576             parent->contents = 0;
 577           else
 578             prev->next = 0;
 579         }
 580       else
 581         wv->value = xstrdup (wv->name); /* what a mess... */
 582     }
 583   else
 584     {
 585       /* first one is the parent */
 586       if (CONSP (XCAR (items)))
 587         syntax_error ("parent item must not be a list", XCAR (items));
 588
 589       if (parent)
 590         wv = gui_items_to_widget_values_1 (gui_object_instance,
 591                                            XCAR (items), parent, 0, accel_p);
 592       else
 593         wv = gui_items_to_widget_values_1 (gui_object_instance,
 594                                            XCAR (items), 0, prev, accel_p);
 595       /* the rest are the children */
 596       gui_item_children_to_widget_values (gui_object_instance,
 597                                           XCDR (items), wv, accel_p);
 598     }
 599   return wv;
 600 }
 601
 602 static void
 603 gui_item_children_to_widget_values (Lisp_Object gui_object_instance,
 604                                     Lisp_Object items, widget_value* parent,
 605                                     int accel_p)
 606 {
 607   widget_value* wv = 0, *prev = 0;
 608   Lisp_Object rest;
 609   CHECK_CONS (items);
 610
 611   /* first one is master */
 612   prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items),
 613                                        parent, 0, accel_p);
 614   /* the rest are the children */
 615   LIST_LOOP (rest, XCDR (items))
 616     {
 617       Lisp_Object tab = XCAR (rest);
 618       wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev,
 619                                          accel_p);
 620       prev = wv;
 621     }
 622 }
 623
 624 widget_value *
 625 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
 626                             int accel_p)
 627 {
 628   /* This function can GC */
 629   widget_value *control = 0, *tmp = 0;
 630   int count = specpdl_depth ();
 631   Lisp_Object wv_closure;
 632
 633   if (NILP (items))
 634     syntax_error ("must have some items", items);
 635
 636   /* Inhibit GC during this conversion.  The reasons for this are
 637      the same as in menu_item_descriptor_to_widget_value(); see
 638      the large comment above that function. */
 639   record_unwind_protect (restore_gc_inhibit,
 640                          make_int (gc_currently_forbidden));
 641   gc_currently_forbidden = 1;
 642
 643   /* Also make sure that we free the partially-created widget_value
 644      tree on Lisp error. */
 645   control = xmalloc_widget_value ();
 646   wv_closure = make_opaque_ptr (control);
 647   record_unwind_protect (widget_value_unwind, wv_closure);
 648
 649   gui_items_to_widget_values_1 (gui_object_instance, items, control, 0,
 650                                 accel_p);
 651
 652   /* mess about getting the data we really want */
 653   tmp = control;
 654   control = control->contents;
 655   tmp->next = 0;
 656   tmp->contents = 0;
 657   free_widget_value_tree (tmp);
 658
 659   /* No more need to free the half-filled-in structures. */
 660   set_opaque_ptr (wv_closure, 0);
 661   unbind_to (count, Qnil);
 662
 663   return control;
 664 }
 665
 666 /* This is a kludge to make sure emacs can only link against a version of
 667    lwlib that was compiled in the right way.  Emacs references symbols which
 668    correspond to the way it thinks lwlib was compiled, and if lwlib wasn't
 669    compiled in that way, then somewhat meaningful link errors will result.
 670    The alternatives to this range from obscure link errors, to obscure
 671    runtime errors that look a lot like bugs.
 672  */
 673
 674 static void
 675 sanity_check_lwlib (void)
 676 {
 677 #define MACROLET(v) { extern int v; v = 1; }
 678
 679 #if (XlibSpecificationRelease == 4)
 680   MACROLET (lwlib_uses_x11r4);
 681 #elif (XlibSpecificationRelease == 5)
 682   MACROLET (lwlib_uses_x11r5);
 683 #elif (XlibSpecificationRelease == 6)
 684   MACROLET (lwlib_uses_x11r6);
 685 #else
 686   MACROLET (lwlib_uses_unknown_x11);
 687 #endif
 688 #ifdef LWLIB_USES_MOTIF
 689   MACROLET (lwlib_uses_motif);
 690 #else
 691   MACROLET (lwlib_does_not_use_motif);
 692 #endif
 693 #if (XmVersion >= 1002)
 694   MACROLET (lwlib_uses_motif_1_2);
 695 #else
 696   MACROLET (lwlib_does_not_use_motif_1_2);
 697 #endif
 698 #ifdef LWLIB_MENUBARS_LUCID
 699   MACROLET (lwlib_menubars_lucid);
 700 #elif defined (HAVE_MENUBARS)
 701   MACROLET (lwlib_menubars_motif);
 702 #endif
 703 #ifdef LWLIB_SCROLLBARS_LUCID
 704   MACROLET (lwlib_scrollbars_lucid);
 705 #elif defined (LWLIB_SCROLLBARS_MOTIF)
 706   MACROLET (lwlib_scrollbars_motif);
 707 #elif defined (HAVE_SCROLLBARS)
 708   MACROLET (lwlib_scrollbars_athena);
 709 #endif
 710 #ifdef LWLIB_DIALOGS_MOTIF
 711   MACROLET (lwlib_dialogs_motif);
 712 #elif defined (HAVE_DIALOGS)
 713   MACROLET (lwlib_dialogs_athena);
 714 #endif
 715 #ifdef LWLIB_WIDGETS_MOTIF
 716   MACROLET (lwlib_widgets_motif);
 717 #elif defined (HAVE_WIDGETS)
 718   MACROLET (lwlib_widgets_athena);
 719 #endif
 720
 721 #undef MACROLET
 722 }
 723
 724 void
 725 syms_of_gui_x (void)
 726 {
 727   INIT_LRECORD_IMPLEMENTATION (popup_data);
 728 }
 729
 730 void
 731 reinit_vars_of_gui_x (void)
 732 {
 733   lwlib_id_tick = (1<<16);      /* start big, to not conflict with Energize */
 734 #ifdef HAVE_POPUPS
 735   popup_up_p = 0;
 736 #endif
 737
 738   /* this makes only safe calls as in emacs.c */
 739   sanity_check_lwlib ();
 740 }
 741
 742 void
 743 vars_of_gui_x (void)
 744 {
 745   reinit_vars_of_gui_x ();
 746
 747   Vpopup_callbacks = Qnil;
 748   staticpro (&Vpopup_callbacks);
 749 }