diff src/gui-x.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 501cfd01ee6d
children 41dbb7a9d5f2
line wrap: on
line diff
--- a/src/gui-x.c	Mon Aug 13 11:19:22 2007 +0200
+++ b/src/gui-x.c	Mon Aug 13 11:20:41 2007 +0200
@@ -33,14 +33,13 @@
 #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;
@@ -60,26 +59,36 @@
 }
 
 
+#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);
-      mark_object (markee);
+      (cl->markobj) (markee);
     }
 
   if (val->accel)
     {
       VOID_TO_LISP (markee, val->accel);
-      mark_object (markee);
+      (cl->markobj) (markee);
     }
   return 0;
 }
 
 static Lisp_Object
-mark_popup_data (Lisp_Object obj)
+mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
   struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
 
@@ -87,14 +96,19 @@
      call-data */
 
   if (data->id)
-    lw_map_widget_values (data->id, mark_widget_value_mapper, 0);
+    {
+      struct mark_widget_value_closure closure;
+
+      closure.markobj = markobj;
+      lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
+    }
 
   return data->last_menubar_buffer;
 }
 
 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
                                mark_popup_data, internal_object_printer,
-			       0, 0, 0, 0, struct popup_data);
+			       0, 0, 0, struct popup_data);
 
 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
    (id . popup-data) for GCPRO'ing the callbacks of the popup menus
@@ -145,7 +159,7 @@
   widget_value *wv = (widget_value *) get_opaque_ptr (closure);
   free_opaque_ptr (closure);
   if (wv)
-    free_widget_value_tree (wv);
+    free_widget_value (wv);
   return Qnil;
 }
 
@@ -188,7 +202,6 @@
   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;
 
@@ -212,9 +225,9 @@
 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
 			  XtPointer client_data)
 {
-  Lisp_Object data, image_instance, callback, callback_ex;
-  Lisp_Object frame, event;
-  int update_subwindows_p = 0;
+  Lisp_Object fn, arg;
+  Lisp_Object data;
+  Lisp_Object frame;
   struct device *d = get_device_from_display (XtDisplay (widget));
   struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
 
@@ -242,45 +255,11 @@
 
   if (((EMACS_INT) client_data) == -1)
     {
-      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;
+      fn = Qrun_hooks;
+      arg = Qmenu_no_selection_hook;
     }
   else
-    {
-      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;
-	}
-    }
+    get_gui_callback (data, &fn, &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
@@ -290,12 +269,7 @@
 #else
   DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
 #endif
-  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);
+  signal_special_Xt_user_event (frame, fn, arg);
 }
 
 #if 1
@@ -313,9 +287,9 @@
 #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')
@@ -341,133 +315,180 @@
   return NULL;
 }
 
-char *
-strdup_and_add_accel (char *name)
-{
-  int i;
-  int found_accel = 0;
+/* set menu accelerator key to first underlined character in menu name */
 
-  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);
+Lisp_Object
+menu_name_to_accelerator (char *name)
+{
+  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));
+	}
     }
+    ++name;
+  }
+  return Qnil;
 }
 
 /* This does the dirty work.  gc_currently_forbidden is 1 when this is called.
  */
+
 int
-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)
+button_item_to_widget_value (Lisp_Object desc, widget_value *wv,
+			     int allow_text_field_p, int no_keys_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;
+  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);
 
-  /* degenerate case */
-  if (STRINGP (gui_item))
+  /* 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
     {
-      wv->type = TEXT_TYPE;
-      wv->name = (char *) XSTRING_DATA (gui_item);
-      wv->name = strdup_and_add_accel (wv->name);
-      return 1;
+      /* 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);
+	}
     }
-  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 (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
+  if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration)))
+      || (included_spec && NILP (Feval (include_p))))
     {
       /* the include specification says to ignore this item. */
       return 0;
     }
 #endif /* HAVE_MENUBARS */
 
-  if (!STRINGP (pgui->name))
-    pgui->name = Feval (pgui->name);
+  CHECK_STRING (name);
+  wv->name = (char *) XSTRING_DATA (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 (accel))
+    accel = menu_name_to_accelerator (wv->name);
+  wv->accel = LISP_TO_VOID (accel);
 
-  if (!NILP (pgui->suffix))
+  if (!NILP (suffix))
     {
-      const char *const_bogosity;
+      CONST char *const_bogosity;
       Lisp_Object suffix2;
 
       /* Shortcut to avoid evaluating suffix each time */
-      if (STRINGP (pgui->suffix))
-	suffix2 = pgui->suffix;
+      if (STRINGP (suffix))
+	suffix2 = suffix;
       else
 	{
-	  suffix2 = Feval (pgui->suffix);
+	  suffix2 = Feval (suffix);
 	  CHECK_STRING (suffix2);
 	}
 
-      TO_EXTERNAL_FORMAT (LISP_STRING, suffix2,
-			  C_STRING_ALLOCA, const_bogosity,
-			  Qfile_name);
+      GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity);
       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);
+  wv_set_evalable_slot (wv->enabled, active_p);
+  wv_set_evalable_slot (wv->selected, selected_p);
 
-  if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
-    wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
-					 pgui->callback,
-					 pgui->callback_ex));
+  wv->call_data = LISP_TO_VOID (callback);
 
   if (no_keys_p
 #ifdef HAVE_MENUBARS
-      || (menu_entry_p && !menubar_show_keybindings)
+      || !menubar_show_keybindings
 #endif
       )
     wv->key = 0;
-  else if (!NILP (pgui->keys))	/* Use this string to generate key bindings */
+  else if (!NILP (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));
+      CHECK_STRING (keys);
+      keys = Fsubstitute_command_keys (keys);
+      if (XSTRING_LENGTH (keys) > 0)
+	wv->key = xstrdup ((char *) XSTRING_DATA (keys));
       else
 	wv->key = 0;
     }
-  else if (SYMBOLP (pgui->callback))	/* Show the binding of this command. */
+  else if (SYMBOLP (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);
+      where_is_to_char (callback, buf);
       if (buf [0])
 	wv->key = xstrdup (buf);
       else
 	wv->key = 0;
     }
 
-  CHECK_SYMBOL (pgui->style);
-  if (NILP (pgui->style))
+  CHECK_SYMBOL (style);
+  if (NILP (style))
     {
       /* If the callback is nil, treat this item like unselectable text.
 	 This way, dashes will show up as a separator. */
@@ -494,13 +515,13 @@
 	    wv->type = BUTTON_TYPE;
 	}
     }
-  else if (EQ (pgui->style, Qbutton))
+  else if (EQ (style, Qbutton))
     wv->type = BUTTON_TYPE;
-  else if (EQ (pgui->style, Qtoggle))
+  else if (EQ (style, Qtoggle))
     wv->type = TOGGLE_TYPE;
-  else if (EQ (pgui->style, Qradio))
+  else if (EQ (style, Qradio))
     wv->type = RADIO_TYPE;
-  else if (EQ (pgui->style, Qtext))
+  else if (EQ (style, Qtext))
     {
       wv->type = TEXT_TYPE;
 #if 0
@@ -509,132 +530,19 @@
 #endif
     }
   else
-    signal_simple_error_2 ("Unknown style", pgui->style, gui_item);
+    signal_simple_error_2 ("Unknown style", style, desc);
 
   if (!allow_text_field_p && (wv->type == TEXT_TYPE))
-    signal_simple_error ("Text field not allowed in this context", gui_item);
+    signal_simple_error ("Text field not allowed in this context", desc);
 
-  if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
+  if (selected_spec && EQ (style, Qtext))
     signal_simple_error (
-			 ":selected only makes sense with :style toggle, radio or button",
-			 gui_item);
+         ":selected only makes sense with :style toggle, radio or button",
+			 desc);
   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;
-}
+#endif /* HAVE_POPUPS */
 
 /* 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
@@ -685,11 +593,6 @@
 #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
 }
@@ -697,27 +600,18 @@
 void
 syms_of_gui_x (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (popup_data);
-
+#ifdef HAVE_POPUPS
   defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
-}
-
-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 ();
+  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);
@@ -731,4 +625,8 @@
 */ );
 #endif
   Fset (Qmenu_no_selection_hook, Qnil);
+#endif /* HAVE_POPUPS */
+
+  /* this makes only safe calls as in emacs.c */
+  sanity_check_lwlib ();
 }