diff 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
line wrap: on
line diff
--- a/src/gui-x.c	Mon Aug 13 11:33:40 2007 +0200
+++ b/src/gui-x.c	Mon Aug 13 11:35:02 2007 +0200
@@ -1,6 +1,6 @@
 /* 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.
 
@@ -23,6 +23,8 @@
 
 /* Synched up with: Not in FSF. */
 
+/* This file Mule-ized by Ben Wing, 7-8-00. */
+
 #include <config.h>
 #include "lisp.h"
 
@@ -33,13 +35,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"
 
-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;
 
@@ -151,8 +153,9 @@
 static void
 print_widget_value (widget_value *wv, int depth)
 {
-  /* !!#### This function has not been Mule-ized */
-  char d [200];
+  /* strings in wv are in external format; use printf not stdout_out
+     because the latter takes internal-format strings */
+  Extbyte d [200];
   int i;
   for (i = 0; i < depth; i++) d[i] = ' ';
   d[depth]=0;
@@ -210,9 +213,9 @@
 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);
 
@@ -240,13 +243,49 @@
 
   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_STATE_CHANGED;
-      get_gui_callback (data, &fn, &arg);
+      image_instance = XCAR (data);
+      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
@@ -257,7 +296,12 @@
 #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
@@ -274,11 +318,11 @@
       ((void) (slot = (!NILP (form))))
 #endif
 
-char *
-menu_separator_style (CONST char *s)
+Extbyte *
+menu_separator_style_and_to_external (const Bufbyte *s)
 {
-  CONST char *p;
-  char first;
+  const Bufbyte *p;
+  Bufbyte first;
 
   if (!s || s[0] == '\0')
     return NULL;
@@ -298,19 +342,54 @@
 	    ? 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,
-			     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, int accel_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;
@@ -319,34 +398,45 @@
   if (STRINGP (gui_item))
     {
       wv->type = TEXT_TYPE;
-      wv->name = (char *) XSTRING_DATA (gui_item);
-      wv->name = xstrdup (wv->name);
+      if (accel_p)
+	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);
-  wv->name = xstrdup (wv->name);
-  wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
+  if (accel_p)
+    {
+      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 */
@@ -358,22 +448,20 @@
 	  CHECK_STRING (suffix2);
 	}
 
-      TO_EXTERNAL_FORMAT (LISP_STRING, suffix2,
-			  C_STRING_ALLOCA, const_bogosity,
-			  Qfile_name);
-      wv->value = (char *) const_bogosity;
-      wv->value = xstrdup (wv->value);
+      LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding);
     }
 
   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;
@@ -382,17 +470,17 @@
       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;
     }
@@ -400,14 +488,16 @@
   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
 	{
@@ -440,24 +530,29 @@
 #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 (
-			 ":selected only makes sense with :style toggle, radio or button",
-			 gui_item);
+    syntax_error
+      (":selected only makes sense with :style toggle, radio or button",
+       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,
-			      widget_value* prev)
+gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
+			      Lisp_Object items, widget_value* parent,
+			      widget_value* prev, int accel_p)
 {
   widget_value* wv = 0;
 
@@ -465,12 +560,13 @@
   /* 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)
@@ -479,55 +575,60 @@
 	    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,
+					   XCAR (items), parent, 0, accel_p);
       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, 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
@@ -538,11 +639,12 @@
 
   /* 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;
@@ -619,7 +721,7 @@
 void
 syms_of_gui_x (void)
 {
-  defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook");
+  INIT_LRECORD_IMPLEMENTATION (popup_data);
 }
 
 void
@@ -641,14 +743,4 @@
 
   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);
 }