xemacs-beta: src/gui-x.c comparison

comparison src/gui-x.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 /* 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.
 This file is part of XEmacs.
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 /* Synched up with: Not in FSF. */
+/* This file Mule-ized by Ben Wing, 7-8-00. */
 #include <config.h>
 #include "lisp.h"
 #include "console-x.h"
 #ifdef LWLIB_USES_MOTIF
 #include <Xm/Xm.h> /* for XmVersion */
 #endif
 #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"
-Lisp_Object Qmenu_no_selection_hook;
 /* we need a unique id for each popup menu, dialog box, and scrollbar */
 static unsigned int lwlib_id_tick;
 LWLIB_ID
 #if 0
 static void
 print_widget_value (widget_value *wv, int depth)
 {
-/* !!#### This function has not been Mule-ized */
+/* strings in wv are in external format; use printf not stdout_out
-char d [200];
+because the latter takes internal-format strings */
+Extbyte d [200];
 int i;
 for (i = 0; i < depth; i++) d[i] = ' ';
 d[depth]=0;
 /* #### - print type field */
 printf ("%sname:    %s\n", d, (wv->name ? wv->name : "(null)"));
 void
 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 			  XtPointer client_data)
 {
-Lisp_Object fn, arg;
+Lisp_Object data, image_instance, callback, callback_ex;
-Lisp_Object data;
+Lisp_Object frame, event;
-Lisp_Object frame;
+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);
 /* set in lwlib to the time stamp associated with the most recent menu
 operation */
 Faccept_process_output (Qnil, Qnil, Qnil);
 #endif
 if (((EMACS_INT) client_data) == -1)
 {
-fn = Qrun_hooks;
+event = Fmake_event (Qnil, Qnil);
-arg = Qmenu_no_selection_hook;
+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
 {
-MARK_SUBWINDOWS_STATE_CHANGED;
+image_instance = XCAR (data);
-get_gui_callback (data, &fn, &arg);
+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
 */
 #if defined(HAVE_MENUBARS)
 DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better;
 #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
 /* Eval the activep slot of the menu item */
 # define wv_set_evalable_slot(slot,form) do {	\
 /* Treat the activep slot of the menu item as a boolean */
 # define wv_set_evalable_slot(slot,form)	\
 ((void) (slot = (!NILP (form))))
 #endif
-char *
+Extbyte *
-menu_separator_style (CONST char *s)
+menu_separator_style_and_to_external (const Bufbyte *s)
 {
-CONST char *p;
+const Bufbyte *p;
-char first;
+Bufbyte first;
 if (!s || s[0] == '\0')
 return NULL;
 first = s[0];
 if (first != '-' && first != '=')
 if (*p == '!' || *p == '\0')
 return ((first == '-')
 	    ? 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;
 }
+Extbyte *
+add_accel_and_to_external (Lisp_Object string)
+{
+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);
+}
+return retval;
+}
 /* This does the dirty work.  gc_currently_forbidden is 1 when this is called.
 */
 int
-button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
+button_item_to_widget_value (Lisp_Object gui_object_instance,
-			     int allow_text_field_p, int no_keys_p)
+			     Lisp_Object gui_item, widget_value *wv,
-{
+			     int allow_text_field_p, int no_keys_p,
-/* !!#### This function has not been Mule-ized */
+			     int menu_entry_p, int accel_p)
+{
 /* This function cannot GC because gc_currently_forbidden is set when
 it's called */
 Lisp_Gui_Item* pgui = 0;
 /* degenerate case */
 if (STRINGP (gui_item))
 {
 wv->type = TEXT_TYPE;
-wv->name = (char *) XSTRING_DATA (gui_item);
+if (accel_p)
-wv->name = xstrdup (wv->name);
+	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))
-signal_simple_error("need a string or a gui_item here", gui_item);
+syntax_error ("need a string or a gui_item here", gui_item);
 pgui = XGUI_ITEM (gui_item);
 if (!NILP (pgui->filter))
-signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item);
+syntax_error (":filter keyword not permitted on leaf nodes", gui_item);
 #ifdef HAVE_MENUBARS
-if (!gui_item_included_p (gui_item, Vmenubar_configuration))
+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 */
+if (!STRINGP (pgui->name))
+pgui->name = Feval (pgui->name);
 CHECK_STRING (pgui->name);
-wv->name = (char *) XSTRING_DATA (pgui->name);
+if (accel_p)
-wv->name = xstrdup (wv->name);
+{
-wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
+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 (pgui->suffix))
 {
-CONST char *const_bogosity;
 Lisp_Object suffix2;
 /* Shortcut to avoid evaluating suffix each time */
 if (STRINGP (pgui->suffix))
 	suffix2 = pgui->suffix;
 	{
 	  suffix2 = Feval (pgui->suffix);
 	  CHECK_STRING (suffix2);
 	}
-TO_EXTERNAL_FORMAT (LISP_STRING, suffix2,
+LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
-			  C_STRING_ALLOCA, const_bogosity,
-			  Qfile_name);
-wv->value = (char *) const_bogosity;
-wv->value = xstrdup (wv->value);
 }
 wv_set_evalable_slot (wv->enabled, pgui->active);
 wv_set_evalable_slot (wv->selected, pgui->selected);
-if (!NILP (pgui->callback))
+if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
-wv->call_data = LISP_TO_VOID (pgui->callback);
+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 (pgui->keys))	/* Use this string to generate key bindings */
 {
 CHECK_STRING (pgui->keys);
 pgui->keys = Fsubstitute_command_keys (pgui->keys);
 if (XSTRING_LENGTH (pgui->keys) > 0)
-	wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys));
+	LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding);
 else
 	wv->key = 0;
 }
 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 (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 (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
 	{
 #if 0
 	  /* #### - this is generally desirable for menubars, but it breaks
 wv->value = wv->name;
 wv->name = "value";
 #endif
 }
 else
-signal_simple_error_2 ("Unknown style", pgui->style, gui_item);
+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", gui_item);
+syntax_error ("Text field not allowed in this context", gui_item);
 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
-signal_simple_error (
+syntax_error
-			 ":selected only makes sense with :style toggle, radio or button",
+(":selected only makes sense with :style toggle, radio or button",
-			 gui_item);
+gui_item);
 return 1;
 }
 /* parse tree's of gui items into widget_value hierarchies */
-static void gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent);
+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 items, widget_value* parent,
+gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
-			      widget_value* prev)
+			      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();
+wv = xmalloc_widget_value ();
 if (parent)
 	parent->contents = wv;
 else
 	prev->next = wv;
-if (!button_item_to_widget_value (items, wv, 0, 1))
+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... */
-	  wv->value = xstrdup (wv->name);	/* what a mess... */
-	}
 }
 else
 {
 /* first one is the parent */
 if (CONSP (XCAR (items)))
-	signal_simple_error ("parent item must not be a list", XCAR (items));
+	syntax_error ("parent item must not be a list", XCAR (items));
 if (parent)
-	wv = gui_items_to_widget_values_1 (XCAR (items), parent, 0);
+	wv = gui_items_to_widget_values_1 (gui_object_instance,
-else
+					   XCAR (items), parent, 0, accel_p);
-	wv = gui_items_to_widget_values_1 (XCAR (items), 0, prev);
+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 (XCDR (items), wv);
+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 items, widget_value* parent)
+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 (XCAR (items), parent, 0);
+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 (tab, 0, prev);
+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 items)
+gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
-{
+			    int accel_p)
-/* !!#### This function has not been Mule-ized */
+{
 /* This function can GC */
 widget_value *control = 0, *tmp = 0;
 int count = specpdl_depth ();
 Lisp_Object wv_closure;
 if (NILP (items))
-signal_simple_error ("must have some items", 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();
+control = xmalloc_widget_value ();
 wv_closure = make_opaque_ptr (control);
 record_unwind_protect (widget_value_unwind, wv_closure);
-gui_items_to_widget_values_1 (items, control, 0);
+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;
 }
 void
 syms_of_gui_x (void)
 {
-defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
+INIT_LRECORD_IMPLEMENTATION (popup_data);
 }
 void
 reinit_vars_of_gui_x (void)
 {
 {
 reinit_vars_of_gui_x ();
 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);
-}

Mercurial > hg > xemacs-beta

comparison src/gui-x.c @ 442:abe6d1db359e r21-2-36