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 Ben Wing.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1998 Free Software Foundation, Inc.
7 This file is part of XEmacs.
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
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
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. */
24 /* Synched up with: Not in FSF. */
29 #include "console-x.h"
30 #ifdef LWLIB_USES_MOTIF
31 #include <Xm/Xm.h> /* for XmVersion */
38 #include "redisplay.h"
41 Lisp_Object Qmenu_no_selection_hook;
43 /* we need a unique id for each popup menu, dialog box, and scrollbar */
44 static unsigned int lwlib_id_tick;
49 return ++lwlib_id_tick;
53 xmalloc_widget_value (void)
55 widget_value *tmp = malloc_widget_value ();
56 if (!tmp) memory_full ();
61 struct mark_widget_value_closure
63 void (*markobj) (Lisp_Object);
67 mark_widget_value_mapper (widget_value *val, void *closure)
71 struct mark_widget_value_closure *cl =
72 (struct mark_widget_value_closure *) closure;
75 VOID_TO_LISP (markee, val->call_data);
76 (cl->markobj) (markee);
81 VOID_TO_LISP (markee, val->accel);
82 (cl->markobj) (markee);
88 mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
90 struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
92 /* Now mark the callbacks and such that are hidden in the lwlib
97 struct mark_widget_value_closure closure;
99 closure.markobj = markobj;
100 lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
103 return data->last_menubar_buffer;
106 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
107 mark_popup_data, internal_object_printer,
108 0, 0, 0, 0, struct popup_data);
110 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
111 (id . popup-data) for GCPRO'ing the callbacks of the popup menus
113 static Lisp_Object Vpopup_callbacks;
116 gcpro_popup_callbacks (LWLIB_ID id)
118 struct popup_data *pdata;
119 Lisp_Object lid = make_int (id);
122 assert (NILP (assq_no_quit (lid, Vpopup_callbacks)));
123 pdata = alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
125 pdata->last_menubar_buffer = Qnil;
126 pdata->menubar_contents_up_to_date = 0;
127 XSETPOPUP_DATA (lpdata, pdata);
128 Vpopup_callbacks = Fcons (Fcons (lid, lpdata), Vpopup_callbacks);
132 ungcpro_popup_callbacks (LWLIB_ID id)
134 Lisp_Object lid = make_int (id);
135 Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks);
136 assert (!NILP (this));
137 Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks);
141 popup_handled_p (LWLIB_ID id)
143 return NILP (assq_no_quit (make_int (id), Vpopup_callbacks));
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.) */
154 widget_value_unwind (Lisp_Object closure)
156 widget_value *wv = (widget_value *) get_opaque_ptr (closure);
157 free_opaque_ptr (closure);
159 free_widget_value (wv);
165 print_widget_value (widget_value *wv, int depth)
167 /* !!#### This function has not been Mule-ized */
170 for (i = 0; i < depth; i++) d[i] = ' ';
172 /* #### - print type field */
173 printf ("%sname: %s\n", d, (wv->name ? wv->name : "(null)"));
174 if (wv->value) printf ("%svalue: %s\n", d, wv->value);
175 if (wv->key) printf ("%skey: %s\n", d, wv->key);
176 printf ("%senabled: %d\n", d, wv->enabled);
179 printf ("\n%scontents: \n", d);
180 print_widget_value (wv->contents, depth + 5);
185 print_widget_value (wv->next, depth);
190 /* This recursively calls free_widget_value() on the tree of widgets.
191 It must free all data that was malloc'ed for these widget_values.
193 It used to be that emacs only allocated new storage for the `key' slot.
194 All other slots are pointers into the data of Lisp_Strings, and must be
197 free_popup_widget_value_tree (widget_value *wv)
200 if (wv->key) xfree (wv->key);
201 if (wv->value) xfree (wv->value);
203 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
205 if (wv->contents && (wv->contents != (widget_value*)1))
207 free_popup_widget_value_tree (wv->contents);
208 wv->contents = (widget_value *) 0xDEADBEEF;
212 free_popup_widget_value_tree (wv->next);
213 wv->next = (widget_value *) 0xDEADBEEF;
215 free_widget_value (wv);
218 /* The following is actually called from somewhere within XtDispatchEvent(),
219 called from XtAppProcessEvent() in event-Xt.c */
222 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
223 XtPointer client_data)
228 struct device *d = get_device_from_display (XtDisplay (widget));
229 struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
231 /* set in lwlib to the time stamp associated with the most recent menu
233 extern Time x_focus_timestamp_really_sucks_fix_me_better;
237 if (((EMACS_INT) client_data) == 0)
239 VOID_TO_LISP (data, client_data);
240 XSETFRAME (frame, f);
243 /* #### What the hell? I can't understand why this call is here,
244 and doing it is really courting disaster in the new event
245 model, since popup_selection_callback is called from
246 within next_event_internal() and Faccept_process_output()
247 itself calls next_event_internal(). --Ben */
249 /* Flush the X and process input */
250 Faccept_process_output (Qnil, Qnil, Qnil);
253 if (((EMACS_INT) client_data) == -1)
256 arg = Qmenu_no_selection_hook;
260 MARK_SUBWINDOWS_CHANGED;
261 get_gui_callback (data, &fn, &arg);
264 /* This is the timestamp used for asserting focus so we need to get an
265 up-to-date value event if no events has been dispatched to emacs
267 #if defined(HAVE_MENUBARS)
268 DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better;
270 DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
272 signal_special_Xt_user_event (frame, fn, arg);
276 /* Eval the activep slot of the menu item */
277 # define wv_set_evalable_slot(slot,form) do { \
278 Lisp_Object wses_form = (form); \
279 (slot) = (NILP (wses_form) ? 0 : \
280 EQ (wses_form, Qt) ? 1 : \
281 !NILP (Feval (wses_form))); \
284 /* Treat the activep slot of the menu item as a boolean */
285 # define wv_set_evalable_slot(slot,form) \
286 ((void) (slot = (!NILP (form))))
290 menu_separator_style (CONST char *s)
295 if (!s || s[0] == '\0')
298 if (first != '-' && first != '=')
300 for (p = s; *p == first; p++)
303 /* #### - cannot currently specify a separator tag "--!tag" and a
304 separator style "--:style" at the same time. */
305 /* #### - Also, the motif menubar code doesn't deal with the
306 double etched style yet, so it's not good to get into the habit of
307 using "===" in menubars to get double-etched lines */
308 if (*p == '!' || *p == '\0')
309 return ((first == '-')
310 ? NULL /* single etched is the default */
311 : xstrdup ("shadowDoubleEtchedIn"));
313 return xstrdup (p+1);
319 /* This does the dirty work. gc_currently_forbidden is 1 when this is called.
322 button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
323 int allow_text_field_p, int no_keys_p)
325 /* !!#### This function has not been Mule-ized */
326 /* This function cannot GC because gc_currently_forbidden is set when
328 struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item);
330 if (!NILP (pgui->filter))
331 signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item);
334 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
336 /* the include specification says to ignore this item. */
339 #endif /* HAVE_MENUBARS */
341 CHECK_STRING (pgui->name);
342 wv->name = (char *) XSTRING_DATA (pgui->name);
343 wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
345 if (!NILP (pgui->suffix))
347 CONST char *const_bogosity;
350 /* Shortcut to avoid evaluating suffix each time */
351 if (STRINGP (pgui->suffix))
352 suffix2 = pgui->suffix;
355 suffix2 = Feval (pgui->suffix);
356 CHECK_STRING (suffix2);
359 GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity);
360 wv->value = (char *) const_bogosity;
361 wv->value = xstrdup (wv->value);
364 wv_set_evalable_slot (wv->enabled, pgui->active);
365 wv_set_evalable_slot (wv->selected, pgui->selected);
367 if (!NILP (pgui->callback))
368 wv->call_data = LISP_TO_VOID (pgui->callback);
372 || !menubar_show_keybindings
376 else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */
378 CHECK_STRING (pgui->keys);
379 pgui->keys = Fsubstitute_command_keys (pgui->keys);
380 if (XSTRING_LENGTH (pgui->keys) > 0)
381 wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys));
385 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */
388 /* #### Warning, dependency here on current_buffer and point */
389 where_is_to_char (pgui->callback, buf);
391 wv->key = xstrdup (buf);
396 CHECK_SYMBOL (pgui->style);
397 if (NILP (pgui->style))
399 /* If the callback is nil, treat this item like unselectable text.
400 This way, dashes will show up as a separator. */
402 wv->type = BUTTON_TYPE;
403 if (separator_string_p (wv->name))
405 wv->type = SEPARATOR_TYPE;
406 wv->value = menu_separator_style (wv->name);
411 /* #### - this is generally desirable for menubars, but it breaks
412 a package that uses dialog boxes and next_command_event magic
413 to use the callback slot in dialog buttons for data instead of
416 Code is data, right? The beauty of LISP abuse. --Stig */
418 wv->type = TEXT_TYPE;
421 wv->type = BUTTON_TYPE;
424 else if (EQ (pgui->style, Qbutton))
425 wv->type = BUTTON_TYPE;
426 else if (EQ (pgui->style, Qtoggle))
427 wv->type = TOGGLE_TYPE;
428 else if (EQ (pgui->style, Qradio))
429 wv->type = RADIO_TYPE;
430 else if (EQ (pgui->style, Qtext))
432 wv->type = TEXT_TYPE;
434 wv->value = wv->name;
439 signal_simple_error_2 ("Unknown style", pgui->style, gui_item);
441 if (!allow_text_field_p && (wv->type == TEXT_TYPE))
442 signal_simple_error ("Text field not allowed in this context", gui_item);
444 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
445 signal_simple_error (
446 ":selected only makes sense with :style toggle, radio or button",
452 /* This is a kludge to make sure emacs can only link against a version of
453 lwlib that was compiled in the right way. Emacs references symbols which
454 correspond to the way it thinks lwlib was compiled, and if lwlib wasn't
455 compiled in that way, then somewhat meaningful link errors will result.
456 The alternatives to this range from obscure link errors, to obscure
457 runtime errors that look a lot like bugs.
461 sanity_check_lwlib (void)
463 #define MACROLET(v) { extern int v; v = 1; }
465 #if (XlibSpecificationRelease == 4)
466 MACROLET (lwlib_uses_x11r4);
467 #elif (XlibSpecificationRelease == 5)
468 MACROLET (lwlib_uses_x11r5);
469 #elif (XlibSpecificationRelease == 6)
470 MACROLET (lwlib_uses_x11r6);
472 MACROLET (lwlib_uses_unknown_x11);
474 #ifdef LWLIB_USES_MOTIF
475 MACROLET (lwlib_uses_motif);
477 MACROLET (lwlib_does_not_use_motif);
479 #if (XmVersion >= 1002)
480 MACROLET (lwlib_uses_motif_1_2);
482 MACROLET (lwlib_does_not_use_motif_1_2);
484 #ifdef LWLIB_MENUBARS_LUCID
485 MACROLET (lwlib_menubars_lucid);
486 #elif defined (HAVE_MENUBARS)
487 MACROLET (lwlib_menubars_motif);
489 #ifdef LWLIB_SCROLLBARS_LUCID
490 MACROLET (lwlib_scrollbars_lucid);
491 #elif defined (LWLIB_SCROLLBARS_MOTIF)
492 MACROLET (lwlib_scrollbars_motif);
493 #elif defined (HAVE_SCROLLBARS)
494 MACROLET (lwlib_scrollbars_athena);
496 #ifdef LWLIB_DIALOGS_MOTIF
497 MACROLET (lwlib_dialogs_motif);
498 #elif defined (HAVE_DIALOGS)
499 MACROLET (lwlib_dialogs_athena);
508 defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
514 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */
518 Vpopup_callbacks = Qnil;
519 staticpro (&Vpopup_callbacks);
522 /* This DEFVAR_LISP is just for the benefit of make-docfile. */
524 DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /*
525 Function or functions to call when a menu or dialog box is dismissed
526 without a selection having been made.
529 Fset (Qmenu_no_selection_hook, Qnil);
531 /* this makes only safe calls as in emacs.c */
532 sanity_check_lwlib ();