/* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs)
Copyright (C) 1995 Board of Trustees, University of Illinois.
- Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1995, 1996, 2000 Ben Wing.
Copyright (C) 1995 Sun Microsystems, Inc.
Copyright (C) 1998 Free Software Foundation, Inc.
/* Synched up with: Not in FSF. */
+/* This file Mule-ized by Ben Wing, 7-8-00. */
+
#include <config.h>
#include "lisp.h"
#include "gui-x.h"
#include "buffer.h"
#include "device.h"
+#include "events.h"
#include "frame.h"
#include "gui.h"
+#include "glyphs.h"
+#include "redisplay.h"
#include "opaque.h"
-#ifdef HAVE_POPUPS
-Lisp_Object Qmenu_no_selection_hook;
-#endif
-
/* we need a unique id for each popup menu, dialog box, and scrollbar */
static unsigned int lwlib_id_tick;
}
\f
-#ifdef HAVE_POPUPS
-
-struct mark_widget_value_closure
-{
- void (*markobj) (Lisp_Object);
-};
-
static int
mark_widget_value_mapper (widget_value *val, void *closure)
{
Lisp_Object markee;
-
- struct mark_widget_value_closure *cl =
- (struct mark_widget_value_closure *) closure;
if (val->call_data)
{
VOID_TO_LISP (markee, val->call_data);
- (cl->markobj) (markee);
+ mark_object (markee);
}
if (val->accel)
{
VOID_TO_LISP (markee, val->accel);
- (cl->markobj) (markee);
+ mark_object (markee);
}
return 0;
}
static Lisp_Object
-mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_popup_data (Lisp_Object obj)
{
struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
call-data */
if (data->id)
- {
- struct mark_widget_value_closure closure;
-
- closure.markobj = markobj;
- lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
- }
+ lw_map_widget_values (data->id, mark_widget_value_mapper, 0);
return data->last_menubar_buffer;
}
DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
mark_popup_data, internal_object_printer,
- 0, 0, 0, struct popup_data);
+ 0, 0, 0, 0, struct popup_data);
\f
/* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
(id . popup-data) for GCPRO'ing the callbacks of the popup menus
widget_value *wv = (widget_value *) get_opaque_ptr (closure);
free_opaque_ptr (closure);
if (wv)
- free_widget_value (wv);
+ free_widget_value_tree (wv);
return Qnil;
}
static void
print_widget_value (widget_value *wv, int depth)
{
- /* !!#### This function has not been Mule-ized */
- char d [200];
+ /* strings in wv are in external format; use printf not stdout_out
+ because the latter takes internal-format strings */
+ Extbyte d [200];
int i;
for (i = 0; i < depth; i++) d[i] = ' ';
d[depth]=0;
if (! wv) return;
if (wv->key) xfree (wv->key);
if (wv->value) xfree (wv->value);
+ if (wv->name) xfree (wv->name);
wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
XtPointer client_data)
{
- Lisp_Object fn, arg;
- Lisp_Object data;
- Lisp_Object frame;
+ Lisp_Object data, image_instance, callback, callback_ex;
+ Lisp_Object frame, event;
+ int update_subwindows_p = 0;
struct device *d = get_device_from_display (XtDisplay (widget));
struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
if (((EMACS_INT) client_data) == -1)
{
- fn = Qrun_hooks;
- arg = Qmenu_no_selection_hook;
+ event = Fmake_event (Qnil, Qnil);
+
+ XEVENT (event)->event_type = misc_user_event;
+ XEVENT (event)->channel = frame;
+ XEVENT (event)->event.eval.function = Qrun_hooks;
+ XEVENT (event)->event.eval.object = Qmenu_no_selection_hook;
}
else
- get_gui_callback (data, &fn, &arg);
+ {
+ image_instance = XCAR (data);
+ callback = XCAR (XCDR (data));
+ callback_ex = XCDR (XCDR (data));
+ update_subwindows_p = 1;
+ /* It is possible for a widget action to cause it to get out of
+ sync with its instantiator. Thus it is necessary to signal
+ this possibility. */
+ if (IMAGE_INSTANCEP (image_instance))
+ XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1;
+
+ if (!NILP (callback_ex) && !UNBOUNDP (callback_ex))
+ {
+ event = Fmake_event (Qnil, Qnil);
+
+ XEVENT (event)->event_type = misc_user_event;
+ XEVENT (event)->channel = frame;
+ XEVENT (event)->event.eval.function = Qeval;
+ XEVENT (event)->event.eval.object =
+ list4 (Qfuncall, callback_ex, image_instance, event);
+ }
+ else if (NILP (callback) || UNBOUNDP (callback))
+ event = Qnil;
+ else
+ {
+ Lisp_Object fn, arg;
+
+ event = Fmake_event (Qnil, Qnil);
+
+ get_gui_callback (callback, &fn, &arg);
+ XEVENT (event)->event_type = misc_user_event;
+ XEVENT (event)->channel = frame;
+ XEVENT (event)->event.eval.function = fn;
+ XEVENT (event)->event.eval.object = arg;
+ }
+ }
/* This is the timestamp used for asserting focus so we need to get an
up-to-date value event if no events has been dispatched to emacs
#else
DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
#endif
- signal_special_Xt_user_event (frame, fn, arg);
+ if (!NILP (event))
+ enqueue_Xt_dispatch_event (event);
+ /* The result of this evaluation could cause other instances to change so
+ enqueue an update callback to check this. */
+ if (update_subwindows_p && !NILP (event))
+ enqueue_magic_eval_event (update_widget_instances, frame);
}
#if 1
((void) (slot = (!NILP (form))))
#endif
-char *
-menu_separator_style (CONST char *s)
+Extbyte *
+menu_separator_style_and_to_external (const Bufbyte *s)
{
- CONST char *p;
- char first;
+ const Bufbyte *p;
+ Bufbyte first;
if (!s || s[0] == '\0')
return NULL;
? NULL /* single etched is the default */
: xstrdup ("shadowDoubleEtchedIn"));
else if (*p == ':')
- return xstrdup (p+1);
+ {
+ Extbyte *retval;
+
+ C_STRING_TO_EXTERNAL_MALLOC (p + 1, retval, Qlwlib_encoding);
+ return retval;
+ }
return NULL;
}
-/* set menu accelerator key to first underlined character in menu name */
-
-Lisp_Object
-menu_name_to_accelerator (char *name)
+Extbyte *
+add_accel_and_to_external (Lisp_Object string)
{
- while (*name) {
- if (*name=='%') {
- ++name;
- if (!(*name))
- return Qnil;
- if (*name=='_' && *(name+1))
- {
- int accelerator = (int) (unsigned char) (*(name+1));
- return make_char (tolower (accelerator));
- }
+ int i;
+ int found_accel = 0;
+ Extbyte *retval;
+ Bufbyte *name = XSTRING_DATA (string);
+
+ for (i = 0; name[i]; ++i)
+ if (name[i] == '%' && name[i+1] == '_')
+ {
+ found_accel = 1;
+ break;
+ }
+
+ if (found_accel)
+ LISP_STRING_TO_EXTERNAL_MALLOC (string, retval, Qlwlib_encoding);
+ else
+ {
+ size_t namelen = XSTRING_LENGTH (string);
+ Bufbyte *chars = (Bufbyte *) alloca (namelen + 3);
+ chars[0] = '%';
+ chars[1] = '_';
+ memcpy (chars + 2, name, namelen + 1);
+ C_STRING_TO_EXTERNAL_MALLOC (chars, retval, Qlwlib_encoding);
}
- ++name;
- }
- return Qnil;
+
+ return retval;
}
/* This does the dirty work. gc_currently_forbidden is 1 when this is called.
*/
-
int
-button_item_to_widget_value (Lisp_Object desc, widget_value *wv,
- int allow_text_field_p, int no_keys_p)
+button_item_to_widget_value (Lisp_Object gui_object_instance,
+ Lisp_Object gui_item, widget_value *wv,
+ int allow_text_field_p, int no_keys_p,
+ int menu_entry_p, int accel_p)
{
- /* !!#### This function has not been Mule-ized */
/* This function cannot GC because gc_currently_forbidden is set when
it's called */
- Lisp_Object name = Qnil;
- Lisp_Object callback = Qnil;
- Lisp_Object suffix = Qnil;
- Lisp_Object active_p = Qt;
- Lisp_Object include_p = Qt;
- Lisp_Object selected_p = Qnil;
- Lisp_Object keys = Qnil;
- Lisp_Object style = Qnil;
- Lisp_Object config_tag = Qnil;
- Lisp_Object accel = Qnil;
- int length = XVECTOR_LENGTH (desc);
- Lisp_Object *contents = XVECTOR_DATA (desc);
- int plist_p;
- int selected_spec = 0, included_spec = 0;
-
- if (length < 2)
- signal_simple_error ("Button descriptors must be at least 2 long", desc);
-
- /* length 2: [ "name" callback ]
- length 3: [ "name" callback active-p ]
- length 4: [ "name" callback active-p suffix ]
- or [ "name" callback keyword value ]
- length 5+: [ "name" callback [ keyword value ]+ ]
- */
- plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2])));
-
- if (!plist_p && length > 2)
- /* the old way */
- {
- name = contents [0];
- callback = contents [1];
- active_p = contents [2];
- if (length == 4)
- suffix = contents [3];
- }
- else
+ Lisp_Gui_Item* pgui = 0;
+
+ /* degenerate case */
+ if (STRINGP (gui_item))
{
- /* the new way */
- int i;
- if (length & 1)
- signal_simple_error (
- "Button descriptor has an odd number of keywords and values",
- desc);
-
- name = contents [0];
- callback = contents [1];
- for (i = 2; i < length;)
- {
- Lisp_Object key = contents [i++];
- Lisp_Object val = contents [i++];
- if (!KEYWORDP (key))
- signal_simple_error_2 ("Not a keyword", key, desc);
-
- if (EQ (key, Q_active)) active_p = val;
- else if (EQ (key, Q_suffix)) suffix = val;
- else if (EQ (key, Q_keys)) keys = val;
- else if (EQ (key, Q_style)) style = val;
- else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1;
- else if (EQ (key, Q_included)) include_p = val, included_spec = 1;
- else if (EQ (key, Q_config)) config_tag = val;
- else if (EQ (key, Q_accelerator))
- {
- if ( SYMBOLP (val)
- || CHARP (val))
- accel = val;
- else
- signal_simple_error ("Bad keyboard accelerator", val);
- }
- else if (EQ (key, Q_filter))
- signal_simple_error(":filter keyword not permitted on leaf nodes", desc);
- else
- signal_simple_error_2 ("Unknown menu item keyword", key, desc);
- }
+ wv->type = TEXT_TYPE;
+ if (accel_p)
+ wv->name = add_accel_and_to_external (gui_item);
+ else
+ LISP_STRING_TO_EXTERNAL_MALLOC (gui_item, wv->name, Qlwlib_encoding);
+ return 1;
}
+ else if (!GUI_ITEMP (gui_item))
+ syntax_error ("need a string or a gui_item here", gui_item);
+
+ pgui = XGUI_ITEM (gui_item);
+
+ if (!NILP (pgui->filter))
+ syntax_error (":filter keyword not permitted on leaf nodes", gui_item);
#ifdef HAVE_MENUBARS
- if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration)))
- || (included_spec && NILP (Feval (include_p))))
+ if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
{
/* the include specification says to ignore this item. */
return 0;
}
#endif /* HAVE_MENUBARS */
- CHECK_STRING (name);
- wv->name = (char *) XSTRING_DATA (name);
+ if (!STRINGP (pgui->name))
+ pgui->name = Feval (pgui->name);
- if (NILP (accel))
- accel = menu_name_to_accelerator (wv->name);
- wv->accel = LISP_TO_VOID (accel);
+ CHECK_STRING (pgui->name);
+ if (accel_p)
+ {
+ wv->name = add_accel_and_to_external (pgui->name);
+ wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
+ }
+ else
+ {
+ LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, wv->name, Qlwlib_encoding);
+ wv->accel = LISP_TO_VOID (Qnil);
+ }
- if (!NILP (suffix))
+ if (!NILP (pgui->suffix))
{
- CONST char *const_bogosity;
Lisp_Object suffix2;
/* Shortcut to avoid evaluating suffix each time */
- if (STRINGP (suffix))
- suffix2 = suffix;
+ if (STRINGP (pgui->suffix))
+ suffix2 = pgui->suffix;
else
{
- suffix2 = Feval (suffix);
+ suffix2 = Feval (pgui->suffix);
CHECK_STRING (suffix2);
}
- GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity);
- wv->value = (char *) const_bogosity;
- wv->value = xstrdup (wv->value);
+ LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
}
- wv_set_evalable_slot (wv->enabled, active_p);
- wv_set_evalable_slot (wv->selected, selected_p);
+ wv_set_evalable_slot (wv->enabled, pgui->active);
+ wv_set_evalable_slot (wv->selected, pgui->selected);
- wv->call_data = LISP_TO_VOID (callback);
+ if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
+ wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
+ pgui->callback,
+ pgui->callback_ex));
if (no_keys_p
#ifdef HAVE_MENUBARS
- || !menubar_show_keybindings
+ || (menu_entry_p && !menubar_show_keybindings)
#endif
)
wv->key = 0;
- else if (!NILP (keys)) /* Use this string to generate key bindings */
+ else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */
{
- CHECK_STRING (keys);
- keys = Fsubstitute_command_keys (keys);
- if (XSTRING_LENGTH (keys) > 0)
- wv->key = xstrdup ((char *) XSTRING_DATA (keys));
+ CHECK_STRING (pgui->keys);
+ pgui->keys = Fsubstitute_command_keys (pgui->keys);
+ if (XSTRING_LENGTH (pgui->keys) > 0)
+ LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding);
else
wv->key = 0;
}
- else if (SYMBOLP (callback)) /* Show the binding of this command. */
+ else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */
{
- char buf [1024];
+ char buf[1024]; /* #### */
/* #### Warning, dependency here on current_buffer and point */
- where_is_to_char (callback, buf);
+ where_is_to_char (pgui->callback, buf);
if (buf [0])
- wv->key = xstrdup (buf);
+ C_STRING_TO_EXTERNAL_MALLOC (buf, wv->key, Qlwlib_encoding);
else
wv->key = 0;
}
- CHECK_SYMBOL (style);
- if (NILP (style))
+ CHECK_SYMBOL (pgui->style);
+ if (NILP (pgui->style))
{
+ Bufbyte *intname;
/* If the callback is nil, treat this item like unselectable text.
This way, dashes will show up as a separator. */
if (!wv->enabled)
wv->type = BUTTON_TYPE;
- if (separator_string_p (wv->name))
+ EXTERNAL_TO_C_STRING (wv->name, intname, Qlwlib_encoding);
+ if (separator_string_p (intname))
{
wv->type = SEPARATOR_TYPE;
- wv->value = menu_separator_style (wv->name);
+ wv->value = menu_separator_style_and_to_external (intname);
}
else
{
wv->type = BUTTON_TYPE;
}
}
- else if (EQ (style, Qbutton))
+ else if (EQ (pgui->style, Qbutton))
wv->type = BUTTON_TYPE;
- else if (EQ (style, Qtoggle))
+ else if (EQ (pgui->style, Qtoggle))
wv->type = TOGGLE_TYPE;
- else if (EQ (style, Qradio))
+ else if (EQ (pgui->style, Qradio))
wv->type = RADIO_TYPE;
- else if (EQ (style, Qtext))
+ else if (EQ (pgui->style, Qtext))
{
wv->type = TEXT_TYPE;
#if 0
#endif
}
else
- signal_simple_error_2 ("Unknown style", style, desc);
+ syntax_error_2 ("Unknown style", pgui->style, gui_item);
if (!allow_text_field_p && (wv->type == TEXT_TYPE))
- signal_simple_error ("Text field not allowed in this context", desc);
+ syntax_error ("Text field not allowed in this context", gui_item);
- if (selected_spec && EQ (style, Qtext))
- signal_simple_error (
- ":selected only makes sense with :style toggle, radio or button",
- desc);
+ if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
+ syntax_error
+ (":selected only makes sense with :style toggle, radio or button",
+ gui_item);
return 1;
}
-#endif /* HAVE_POPUPS */
+/* parse tree's of gui items into widget_value hierarchies */
+static void gui_item_children_to_widget_values (Lisp_Object
+ gui_object_instance,
+ Lisp_Object items,
+ widget_value* parent,
+ int accel_p);
+
+static widget_value *
+gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
+ Lisp_Object items, widget_value* parent,
+ widget_value* prev, int accel_p)
+{
+ widget_value* wv = 0;
+
+ assert ((parent || prev) && !(parent && prev));
+ /* now walk the tree creating widget_values as appropriate */
+ if (!CONSP (items))
+ {
+ wv = xmalloc_widget_value ();
+ if (parent)
+ parent->contents = wv;
+ else
+ prev->next = wv;
+ if (!button_item_to_widget_value (gui_object_instance,
+ items, wv, 0, 1, 0, accel_p))
+ {
+ free_widget_value_tree (wv);
+ if (parent)
+ parent->contents = 0;
+ else
+ prev->next = 0;
+ }
+ else
+ wv->value = xstrdup (wv->name); /* what a mess... */
+ }
+ else
+ {
+ /* first one is the parent */
+ if (CONSP (XCAR (items)))
+ syntax_error ("parent item must not be a list", XCAR (items));
+
+ if (parent)
+ wv = gui_items_to_widget_values_1 (gui_object_instance,
+ XCAR (items), parent, 0, accel_p);
+ else
+ wv = gui_items_to_widget_values_1 (gui_object_instance,
+ XCAR (items), 0, prev, accel_p);
+ /* the rest are the children */
+ gui_item_children_to_widget_values (gui_object_instance,
+ XCDR (items), wv, accel_p);
+ }
+ return wv;
+}
+
+static void
+gui_item_children_to_widget_values (Lisp_Object gui_object_instance,
+ Lisp_Object items, widget_value* parent,
+ int accel_p)
+{
+ widget_value* wv = 0, *prev = 0;
+ Lisp_Object rest;
+ CHECK_CONS (items);
+
+ /* first one is master */
+ prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items),
+ parent, 0, accel_p);
+ /* the rest are the children */
+ LIST_LOOP (rest, XCDR (items))
+ {
+ Lisp_Object tab = XCAR (rest);
+ wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev,
+ accel_p);
+ prev = wv;
+ }
+}
+
+widget_value *
+gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
+ int accel_p)
+{
+ /* This function can GC */
+ widget_value *control = 0, *tmp = 0;
+ int count = specpdl_depth ();
+ Lisp_Object wv_closure;
+
+ if (NILP (items))
+ syntax_error ("must have some items", items);
+
+ /* Inhibit GC during this conversion. The reasons for this are
+ the same as in menu_item_descriptor_to_widget_value(); see
+ the large comment above that function. */
+ record_unwind_protect (restore_gc_inhibit,
+ make_int (gc_currently_forbidden));
+ gc_currently_forbidden = 1;
+
+ /* Also make sure that we free the partially-created widget_value
+ tree on Lisp error. */
+ control = xmalloc_widget_value ();
+ wv_closure = make_opaque_ptr (control);
+ record_unwind_protect (widget_value_unwind, wv_closure);
+
+ gui_items_to_widget_values_1 (gui_object_instance, items, control, 0,
+ accel_p);
+
+ /* mess about getting the data we really want */
+ tmp = control;
+ control = control->contents;
+ tmp->next = 0;
+ tmp->contents = 0;
+ free_widget_value_tree (tmp);
+
+ /* No more need to free the half-filled-in structures. */
+ set_opaque_ptr (wv_closure, 0);
+ unbind_to (count, Qnil);
+
+ return control;
+}
/* This is a kludge to make sure emacs can only link against a version of
lwlib that was compiled in the right way. Emacs references symbols which
#elif defined (HAVE_DIALOGS)
MACROLET (lwlib_dialogs_athena);
#endif
+#ifdef LWLIB_WIDGETS_MOTIF
+ MACROLET (lwlib_widgets_motif);
+#elif defined (HAVE_WIDGETS)
+ MACROLET (lwlib_widgets_athena);
+#endif
#undef MACROLET
}
void
syms_of_gui_x (void)
{
-#ifdef HAVE_POPUPS
- defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
-#endif
+ INIT_LRECORD_IMPLEMENTATION (popup_data);
}
void
-vars_of_gui_x (void)
+reinit_vars_of_gui_x (void)
{
lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */
-
#ifdef HAVE_POPUPS
popup_up_p = 0;
-
- Vpopup_callbacks = Qnil;
- staticpro (&Vpopup_callbacks);
-
-#if 0
- /* This DEFVAR_LISP is just for the benefit of make-docfile. */
- /* #### misnamed */
- DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /*
-Function or functions to call when a menu or dialog box is dismissed
-without a selection having been made.
-*/ );
#endif
- Fset (Qmenu_no_selection_hook, Qnil);
-#endif /* HAVE_POPUPS */
/* this makes only safe calls as in emacs.c */
sanity_check_lwlib ();
}
+
+void
+vars_of_gui_x (void)
+{
+ reinit_vars_of_gui_x ();
+
+ Vpopup_callbacks = Qnil;
+ staticpro (&Vpopup_callbacks);
+}
projects / chise / xemacs-chise.git.1 / blobdiff