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