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

comparison src/gui-x.c @ 406:b8cc9ab3f761 r21-2-33

Import from CVS: tag r21-2-33

author	cvs
date	Mon, 13 Aug 2007 11:17:09 +0200
parents	2f8bb876ab1d
children	501cfd01ee6d

comparison

equal deleted inserted replaced

-:0e08f63c74d2
+:b8cc9ab3f761
 #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;
 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
 if (((EMACS_INT) client_data) == 0)
 return;
 VOID_TO_LISP (data, client_data);
 XSETFRAME (frame, f);
+image_instance = XCAR (data);
+callback = XCAR (XCDR (data));
+callback_ex = XCDR (XCDR (data));
 #if 0
 /* #### What the hell?  I can't understand why this call is here,
 and doing it is really courting disaster in the new event
 model, since popup_selection_callback is called from
 within next_event_internal() and Faccept_process_output()
 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
 {
 update_subwindows_p = 1;
-get_gui_callback (data, &fn, &arg);
+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. */
+enqueue an update callback to check this. We also have to make sure that
-if (update_subwindows_p)
+the function does not appear in the command history.
+#### I'm sure someone can tell me how to optimize this. */
+if (update_subwindows_p && !NILP (event))
 signal_special_Xt_user_event (frame, Qeval,
-				  list2 (Qupdate_widget_instances, frame));
+				  list3 (Qlet,
+					 list2 (Qthis_command,
+						Qlast_command),
+					 list2 (Qupdate_widget_instances,
+						frame)));
 }
 #if 1
 /* Eval the activep slot of the menu item */
 # define wv_set_evalable_slot(slot,form) do {	\
 }
 /* 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,
+			     int menu_entry_p)
 {
 /* !!#### This function has not been Mule-ized */
 /* This function cannot GC because gc_currently_forbidden is set when
 it's called */
 Lisp_Gui_Item* pgui = 0;
 if (!NILP (pgui->filter))
 signal_simple_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 */
 }
 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 */
 {
 			 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);
 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,
+			      Lisp_Object items, widget_value* parent,
 			      widget_value* prev)
 {
 widget_value* wv = 0;
 assert ((parent || prev) && !(parent && prev));
 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))
 	{
 	  free_widget_value_tree (wv);
 	  if (parent)
 	    parent->contents = 0;
 	  else
 /* first one is the parent */
 if (CONSP (XCAR (items)))
 	signal_simple_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,
+					   XCAR (items), parent, 0);
 else
-	wv = gui_items_to_widget_values_1 (XCAR (items), 0, prev);
+	wv = gui_items_to_widget_values_1 (gui_object_instance,
+					   XCAR (items), 0, prev);
 /* 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);
 }
 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)
 {
 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);
 /* 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);
 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)
 {
 /* !!#### This function has not been Mule-ized */
 /* This function can GC */
 widget_value *control = 0, *tmp = 0;
 int count = specpdl_depth ();
 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 (items, control, 0);
+gui_items_to_widget_values_1 (gui_object_instance, items, control, 0);
 /* mess about getting the data we really want */
 tmp = control;
 control = control->contents;
 tmp->next = 0;

Mercurial > hg > xemacs-beta

comparison src/gui-x.c @ 406:b8cc9ab3f761 r21-2-33