(byte_table_same_value_p): Use `internal_equal' instead of `EQ'.
[chise/xemacs-chise.git-] / src / gui-x.c
index e35e65e..8aebe30 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"
 
@@ -58,34 +60,26 @@ xmalloc_widget_value (void)
 }
 
 \f
-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);
 
@@ -93,12 +87,7 @@ mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
      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;
 }
@@ -156,7 +145,7 @@ widget_value_unwind (Lisp_Object closure)
   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;
 }
 
@@ -199,6 +188,7 @@ free_popup_widget_value_tree (widget_value *wv)
   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;
 
@@ -222,9 +212,9 @@ 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);
 
@@ -252,13 +242,44 @@ 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
     {
-      MARK_SUBWINDOWS_CHANGED;
-      get_gui_callback (data, &fn, &arg);
+      image_instance = XCAR (data);
+      callback = XCAR (XCDR (data));
+      callback_ex = XCDR (XCDR (data));
+      update_subwindows_p = 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
@@ -269,7 +290,12 @@ 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 && !NILP (event))
+    enqueue_magic_eval_event (update_widget_instances, frame);
 }
 
 #if 1
@@ -287,9 +313,9 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 #endif
 
 char *
-menu_separator_style (CONST char *s)
+menu_separator_style (const char *s)
 {
-  CONST char *p;
+  const char *p;
   char first;
 
   if (!s || s[0] == '\0')
@@ -315,36 +341,79 @@ menu_separator_style (CONST char *s)
   return NULL;
 }
 
+char *
+strdup_and_add_accel (char *name)
+{
+  int i;
+  int found_accel = 0;
+
+  for (i=0; name[i]; ++i)
+    if (name[i] == '%' && name[i+1] == '_')
+      {
+       found_accel = 1;
+       break;
+      }
+
+  if (found_accel)
+    return xstrdup (name);
+  else
+    {
+      char *chars = (char *) alloca (strlen (name) + 3);
+      chars[0] = '%';
+      chars[1] = '_';
+      memcpy (chars+2, name, strlen (name) + 1);
+      return xstrdup (chars);
+    }
+}
 
 /* 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
      it's called */
-  struct Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item);
+  Lisp_Gui_Item* pgui = 0;
+
+  /* degenerate case */
+  if (STRINGP (gui_item))
+    {
+      wv->type = TEXT_TYPE;
+      wv->name = (char *) XSTRING_DATA (gui_item);
+      wv->name = strdup_and_add_accel (wv->name);
+      return 1;
+    }
+  else if (!GUI_ITEMP (gui_item))
+    signal_simple_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);
 
 #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);
+  wv->name = xstrdup (wv->name);
   wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
 
   if (!NILP (pgui->suffix))
     {
-      CONST char *const_bogosity;
+      const char *const_bogosity;
       Lisp_Object suffix2;
 
       /* Shortcut to avoid evaluating suffix each time */
@@ -356,7 +425,9 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
          CHECK_STRING (suffix2);
        }
 
-      GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity);
+      TO_EXTERNAL_FORMAT (LISP_STRING, suffix2,
+                         C_STRING_ALLOCA, const_bogosity,
+                         Qfile_name);
       wv->value = (char *) const_bogosity;
       wv->value = xstrdup (wv->value);
     }
@@ -364,12 +435,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;
@@ -384,7 +457,7 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
     }
   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])
@@ -448,6 +521,120 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv,
   return 1;
 }
 
+/* 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);
+
+static widget_value *
+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));
+  /* 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))
+       {
+         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)))
+       signal_simple_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);
+      else
+       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 (gui_object_instance,
+                                         XCDR (items), wv);
+    }
+  return wv;
+}
+
+static void
+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 (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 (gui_object_instance, tab, 0, prev);
+      prev = wv;
+    }
+}
+
+widget_value *
+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 ();
+  Lisp_Object wv_closure;
+
+  if (NILP (items))
+    signal_simple_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);
+
+  /* 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
@@ -498,6 +685,11 @@ sanity_check_lwlib (void)
 #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
 }
@@ -505,15 +697,27 @@ sanity_check_lwlib (void)
 void
 syms_of_gui_x (void)
 {
+  INIT_LRECORD_IMPLEMENTATION (popup_data);
+
   defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
 }
 
 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;
+#endif
+
+  /* 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);
@@ -527,7 +731,4 @@ without a selection having been made.
 */ );
 #endif
   Fset (Qmenu_no_selection_hook, Qnil);
-
-  /* this makes only safe calls as in emacs.c */
-  sanity_check_lwlib ();
 }