XEmacs 21.2.33 "Melpomene".
[chise/xemacs-chise.git.1] / src / gui-x.c
index 2099351..2cade75 100644 (file)
@@ -33,8 +33,10 @@ Boston, MA 02111-1307, USA.  */
 #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"
 
@@ -210,9 +212,8 @@ void
 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);
@@ -228,6 +229,10 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
   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
@@ -241,13 +246,41 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 
   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
     {
       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
@@ -258,12 +291,19 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 #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)
+     enqueue an update callback to check this. We also have to make sure that
+     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
@@ -337,8 +377,10 @@ strdup_and_add_accel (char *name)
 /* 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,
-                            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)
 {
   /* !!#### This function has not been Mule-ized */
   /* This function cannot GC because gc_currently_forbidden is set when
@@ -362,7 +404,7 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
     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;
@@ -401,12 +443,14 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
   wv_set_evalable_slot (wv->enabled, pgui->active);
   wv_set_evalable_slot (wv->selected, pgui->selected);
 
-  if (!NILP (pgui->callback))
-    wv->call_data = LISP_TO_VOID (pgui->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;
@@ -486,10 +530,13 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
 }
 
 /* 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;
@@ -503,7 +550,8 @@ gui_items_to_widget_values_1 (Lisp_Object items, widget_value* 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)
@@ -523,35 +571,40 @@ gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent,
        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 */
@@ -575,7 +628,7 @@ gui_items_to_widget_values (Lisp_Object items)
   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;