428
+ − 1 /* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs)
+ − 2 Copyright (C) 1995 Board of Trustees, University of Illinois.
793
+ − 3 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
428
+ − 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
442
+ − 26 /* This file Mule-ized by Ben Wing, 7-8-00. */
+ − 27
428
+ − 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"
442
+ − 38 #include "events.h"
428
+ − 39 #include "frame.h"
+ − 40 #include "gui.h"
442
+ − 41 #include "glyphs.h"
428
+ − 42 #include "redisplay.h"
+ − 43 #include "opaque.h"
+ − 44
+ − 45 /* we need a unique id for each popup menu, dialog box, and scrollbar */
647
+ − 46 static LWLIB_ID lwlib_id_tick;
428
+ − 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
+ − 63 static int
+ − 64 mark_widget_value_mapper (widget_value *val, void *closure)
+ − 65 {
+ − 66 Lisp_Object markee;
+ − 67 if (val->call_data)
+ − 68 {
826
+ − 69 markee = VOID_TO_LISP (val->call_data);
428
+ − 70 mark_object (markee);
+ − 71 }
+ − 72
+ − 73 if (val->accel)
+ − 74 {
826
+ − 75 markee = VOID_TO_LISP (val->accel);
428
+ − 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
+ − 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;
793
+ − 116 lpdata = wrap_popup_data (pdata);
428
+ − 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)
436
+ − 148 free_widget_value_tree (wv);
428
+ − 149 return Qnil;
+ − 150 }
+ − 151
+ − 152 #if 0
+ − 153 static void
+ − 154 print_widget_value (widget_value *wv, int depth)
+ − 155 {
442
+ − 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];
428
+ − 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);
436
+ − 192 if (wv->name) xfree (wv->name);
428
+ − 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 {
442
+ − 216 Lisp_Object data, image_instance, callback, callback_ex;
+ − 217 Lisp_Object frame, event;
+ − 218 int update_subwindows_p = 0;
428
+ − 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;
826
+ − 230 data = VOID_TO_LISP (client_data);
793
+ − 231 frame = wrap_frame (f);
428
+ − 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 {
442
+ − 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;
428
+ − 252 }
+ − 253 else
+ − 254 {
442
+ − 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 }
428
+ − 289 }
+ − 290
+ − 291 /* This is the timestamp used for asserting focus so we need to get an
444
+ − 292 up-to-date value event if no events have been dispatched to emacs
428
+ − 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
442
+ − 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);
428
+ − 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
442
+ − 321 Extbyte *
665
+ − 322 menu_separator_style_and_to_external (const Intbyte *s)
428
+ − 323 {
665
+ − 324 const Intbyte *p;
+ − 325 Intbyte first;
428
+ − 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 == ':')
442
+ − 345 {
+ − 346 Extbyte *retval;
+ − 347
+ − 348 C_STRING_TO_EXTERNAL_MALLOC (p + 1, retval, Qlwlib_encoding);
+ − 349 return retval;
+ − 350 }
428
+ − 351
+ − 352 return NULL;
+ − 353 }
+ − 354
442
+ − 355 Extbyte *
+ − 356 add_accel_and_to_external (Lisp_Object string)
+ − 357 {
+ − 358 int i;
+ − 359 int found_accel = 0;
+ − 360 Extbyte *retval;
665
+ − 361 Intbyte *name = XSTRING_DATA (string);
442
+ − 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 {
647
+ − 374 Bytecount namelen = XSTRING_LENGTH (string);
851
+ − 375 Intbyte *chars = (Intbyte *) ALLOCA (namelen + 3);
442
+ − 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 }
428
+ − 384
771
+ − 385 /* This does the dirty work. begin_gc_forbidden() is active when this is
+ − 386 called. */
428
+ − 387 int
442
+ − 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)
428
+ − 392 {
771
+ − 393 /* This function cannot GC because begin_gc_forbidden() is active when
+ − 394 it's called. */
440
+ − 395 Lisp_Gui_Item* pgui = 0;
428
+ − 396
+ − 397 /* degenerate case */
+ − 398 if (STRINGP (gui_item))
+ − 399 {
+ − 400 wv->type = TEXT_TYPE;
442
+ − 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);
428
+ − 405 return 1;
+ − 406 }
+ − 407 else if (!GUI_ITEMP (gui_item))
563
+ − 408 invalid_argument ("need a string or a gui_item here", gui_item);
428
+ − 409
+ − 410 pgui = XGUI_ITEM (gui_item);
+ − 411
+ − 412 if (!NILP (pgui->filter))
563
+ − 413 sferror (":filter keyword not permitted on leaf nodes", gui_item);
428
+ − 414
+ − 415 #ifdef HAVE_MENUBARS
442
+ − 416 if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
428
+ − 417 {
+ − 418 /* the include specification says to ignore this item. */
+ − 419 return 0;
+ − 420 }
+ − 421 #endif /* HAVE_MENUBARS */
+ − 422
442
+ − 423 if (!STRINGP (pgui->name))
+ − 424 pgui->name = Feval (pgui->name);
+ − 425
428
+ − 426 CHECK_STRING (pgui->name);
442
+ − 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 }
428
+ − 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
442
+ − 451 LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
428
+ − 452 }
+ − 453
+ − 454 wv_set_evalable_slot (wv->enabled, pgui->active);
+ − 455 wv_set_evalable_slot (wv->selected, pgui->selected);
+ − 456
442
+ − 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));
428
+ − 461
+ − 462 if (no_keys_p
+ − 463 #ifdef HAVE_MENUBARS
442
+ − 464 || (menu_entry_p && !menubar_show_keybindings)
428
+ − 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)
442
+ − 473 LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding);
428
+ − 474 else
+ − 475 wv->key = 0;
+ − 476 }
+ − 477 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */
+ − 478 {
793
+ − 479 DECLARE_EISTRING_MALLOC (buf);
428
+ − 480 /* #### Warning, dependency here on current_buffer and point */
+ − 481 where_is_to_char (pgui->callback, buf);
793
+ − 482 if (eilen (buf) > 0)
+ − 483 C_STRING_TO_EXTERNAL_MALLOC (eidata (buf), wv->key, Qlwlib_encoding);
428
+ − 484 else
+ − 485 wv->key = 0;
793
+ − 486 eifree (buf);
428
+ − 487 }
+ − 488
+ − 489 CHECK_SYMBOL (pgui->style);
+ − 490 if (NILP (pgui->style))
+ − 491 {
665
+ − 492 Intbyte *intname;
444
+ − 493 Bytecount intlen;
428
+ − 494 /* If the callback is nil, treat this item like unselectable text.
+ − 495 This way, dashes will show up as a separator. */
+ − 496 if (!wv->enabled)
+ − 497 wv->type = BUTTON_TYPE;
444
+ − 498 TO_INTERNAL_FORMAT (C_STRING, wv->name,
+ − 499 ALLOCA, (intname, intlen),
+ − 500 Qlwlib_encoding);
442
+ − 501 if (separator_string_p (intname))
428
+ − 502 {
+ − 503 wv->type = SEPARATOR_TYPE;
442
+ − 504 wv->value = menu_separator_style_and_to_external (intname);
428
+ − 505 }
+ − 506 else
+ − 507 {
+ − 508 #if 0
+ − 509 /* #### - this is generally desirable for menubars, but it breaks
+ − 510 a package that uses dialog boxes and next_command_event magic
+ − 511 to use the callback slot in dialog buttons for data instead of
+ − 512 a real callback.
+ − 513
+ − 514 Code is data, right? The beauty of LISP abuse. --Stig */
+ − 515 if (NILP (callback))
+ − 516 wv->type = TEXT_TYPE;
+ − 517 else
+ − 518 #endif
+ − 519 wv->type = BUTTON_TYPE;
+ − 520 }
+ − 521 }
+ − 522 else if (EQ (pgui->style, Qbutton))
+ − 523 wv->type = BUTTON_TYPE;
+ − 524 else if (EQ (pgui->style, Qtoggle))
+ − 525 wv->type = TOGGLE_TYPE;
+ − 526 else if (EQ (pgui->style, Qradio))
+ − 527 wv->type = RADIO_TYPE;
+ − 528 else if (EQ (pgui->style, Qtext))
+ − 529 {
+ − 530 wv->type = TEXT_TYPE;
+ − 531 #if 0
+ − 532 wv->value = wv->name;
+ − 533 wv->name = "value";
+ − 534 #endif
+ − 535 }
+ − 536 else
563
+ − 537 invalid_constant_2 ("Unknown style", pgui->style, gui_item);
428
+ − 538
+ − 539 if (!allow_text_field_p && (wv->type == TEXT_TYPE))
563
+ − 540 sferror ("Text field not allowed in this context", gui_item);
428
+ − 541
+ − 542 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
563
+ − 543 sferror
442
+ − 544 (":selected only makes sense with :style toggle, radio or button",
+ − 545 gui_item);
428
+ − 546 return 1;
+ − 547 }
+ − 548
+ − 549 /* parse tree's of gui items into widget_value hierarchies */
442
+ − 550 static void gui_item_children_to_widget_values (Lisp_Object
+ − 551 gui_object_instance,
+ − 552 Lisp_Object items,
+ − 553 widget_value* parent,
+ − 554 int accel_p);
428
+ − 555
+ − 556 static widget_value *
442
+ − 557 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
+ − 558 Lisp_Object items, widget_value* parent,
+ − 559 widget_value* prev, int accel_p)
428
+ − 560 {
+ − 561 widget_value* wv = 0;
+ − 562
+ − 563 assert ((parent || prev) && !(parent && prev));
+ − 564 /* now walk the tree creating widget_values as appropriate */
+ − 565 if (!CONSP (items))
+ − 566 {
442
+ − 567 wv = xmalloc_widget_value ();
428
+ − 568 if (parent)
+ − 569 parent->contents = wv;
440
+ − 570 else
428
+ − 571 prev->next = wv;
442
+ − 572 if (!button_item_to_widget_value (gui_object_instance,
+ − 573 items, wv, 0, 1, 0, accel_p))
428
+ − 574 {
436
+ − 575 free_widget_value_tree (wv);
428
+ − 576 if (parent)
+ − 577 parent->contents = 0;
440
+ − 578 else
428
+ − 579 prev->next = 0;
+ − 580 }
440
+ − 581 else
442
+ − 582 wv->value = xstrdup (wv->name); /* what a mess... */
428
+ − 583 }
+ − 584 else
+ − 585 {
+ − 586 /* first one is the parent */
+ − 587 if (CONSP (XCAR (items)))
563
+ − 588 sferror ("parent item must not be a list", XCAR (items));
428
+ − 589
+ − 590 if (parent)
442
+ − 591 wv = gui_items_to_widget_values_1 (gui_object_instance,
+ − 592 XCAR (items), parent, 0, accel_p);
428
+ − 593 else
442
+ − 594 wv = gui_items_to_widget_values_1 (gui_object_instance,
+ − 595 XCAR (items), 0, prev, accel_p);
428
+ − 596 /* the rest are the children */
442
+ − 597 gui_item_children_to_widget_values (gui_object_instance,
+ − 598 XCDR (items), wv, accel_p);
428
+ − 599 }
+ − 600 return wv;
+ − 601 }
+ − 602
+ − 603 static void
442
+ − 604 gui_item_children_to_widget_values (Lisp_Object gui_object_instance,
+ − 605 Lisp_Object items, widget_value* parent,
+ − 606 int accel_p)
428
+ − 607 {
+ − 608 widget_value* wv = 0, *prev = 0;
+ − 609 Lisp_Object rest;
+ − 610 CHECK_CONS (items);
+ − 611
+ − 612 /* first one is master */
442
+ − 613 prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items),
+ − 614 parent, 0, accel_p);
428
+ − 615 /* the rest are the children */
+ − 616 LIST_LOOP (rest, XCDR (items))
+ − 617 {
+ − 618 Lisp_Object tab = XCAR (rest);
442
+ − 619 wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev,
+ − 620 accel_p);
428
+ − 621 prev = wv;
+ − 622 }
+ − 623 }
+ − 624
+ − 625 widget_value *
442
+ − 626 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
+ − 627 int accel_p)
428
+ − 628 {
+ − 629 /* This function can GC */
+ − 630 widget_value *control = 0, *tmp = 0;
771
+ − 631 int count;
428
+ − 632 Lisp_Object wv_closure;
+ − 633
+ − 634 if (NILP (items))
563
+ − 635 sferror ("must have some items", items);
428
+ − 636
+ − 637 /* Inhibit GC during this conversion. The reasons for this are
+ − 638 the same as in menu_item_descriptor_to_widget_value(); see
+ − 639 the large comment above that function. */
771
+ − 640 count = begin_gc_forbidden ();
428
+ − 641
+ − 642 /* Also make sure that we free the partially-created widget_value
+ − 643 tree on Lisp error. */
442
+ − 644 control = xmalloc_widget_value ();
428
+ − 645 wv_closure = make_opaque_ptr (control);
+ − 646 record_unwind_protect (widget_value_unwind, wv_closure);
+ − 647
442
+ − 648 gui_items_to_widget_values_1 (gui_object_instance, items, control, 0,
+ − 649 accel_p);
428
+ − 650
+ − 651 /* mess about getting the data we really want */
+ − 652 tmp = control;
+ − 653 control = control->contents;
+ − 654 tmp->next = 0;
+ − 655 tmp->contents = 0;
436
+ − 656 free_widget_value_tree (tmp);
428
+ − 657
+ − 658 /* No more need to free the half-filled-in structures. */
+ − 659 set_opaque_ptr (wv_closure, 0);
771
+ − 660 unbind_to (count);
428
+ − 661
+ − 662 return control;
+ − 663 }
+ − 664
+ − 665 void
+ − 666 syms_of_gui_x (void)
+ − 667 {
442
+ − 668 INIT_LRECORD_IMPLEMENTATION (popup_data);
428
+ − 669 }
+ − 670
+ − 671 void
+ − 672 reinit_vars_of_gui_x (void)
+ − 673 {
+ − 674 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */
+ − 675 #ifdef HAVE_POPUPS
+ − 676 popup_up_p = 0;
+ − 677 #endif
+ − 678 }
+ − 679
+ − 680 void
+ − 681 vars_of_gui_x (void)
+ − 682 {
+ − 683 reinit_vars_of_gui_x ();
+ − 684
+ − 685 Vpopup_callbacks = Qnil;
+ − 686 staticpro (&Vpopup_callbacks);
+ − 687 }
