diff src/dialog-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 080151679be2
children 576fb035e263
line wrap: on
line diff
--- a/src/dialog-x.c	Mon Aug 13 11:33:40 2007 +0200
+++ b/src/dialog-x.c	Mon Aug 13 11:35:02 2007 +0200
@@ -1,6 +1,7 @@
 /* Implements elisp-programmable dialog boxes -- X interface.
    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
    Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+   Copyright (C) 2000 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -21,6 +22,8 @@
 
 /* Synched up with: Not in FSF. */
 
+/* This file Mule-ized by Ben Wing, 7-8-00. */
+
 #include <config.h>
 #include "lisp.h"
 
@@ -40,7 +43,6 @@
 static void
 maybe_run_dbox_text_callback (LWLIB_ID id)
 {
-  /* !!#### This function has not been Mule-ized */
   widget_value *wv;
   int got_some;
   wv = xmalloc_widget_value ();
@@ -49,17 +51,22 @@
   if (got_some)
     {
       Lisp_Object text_field_callback;
-      char *text_field_value = wv->value;
+      Extbyte *text_field_value = wv->value;
       VOID_TO_LISP (text_field_callback, wv->call_data);
+      text_field_callback = XCAR (XCDR (text_field_callback));
       if (text_field_value)
 	{
-	  void *tmp = LISP_TO_VOID (list2 (text_field_callback,
-                                           build_string (text_field_value)));
+	  void *tmp =
+	    LISP_TO_VOID (cons3 (Qnil,
+				 list2 (text_field_callback,
+					build_ext_string (text_field_value,
+							  Qlwlib_encoding)),
+				 Qnil));
 	  popup_selection_callback (0, id, (XtPointer) tmp);
 	}
     }
   /* This code tried to optimize, newing/freeing. This is generally
-     unsafe so we will alwats strdup and always use
+     unsafe so we will always strdup and always use
      free_widget_value_tree. */
   free_widget_value_tree (wv);
 }
@@ -88,6 +95,9 @@
   popup_up_p--;
   maybe_run_dbox_text_callback (id);
   popup_selection_callback (widget, id, client_data);
+  /* #### need to error-protect!  will do so when i merge in
+     my working ws */
+  va_run_hook_with_args (Qdelete_dialog_box_hook, 1, make_int (id));
   lw_destroy_all_widgets (id);
 
   /* The Motif dialog box sets the keyboard focus to itself.  When it
@@ -102,19 +112,14 @@
     lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f));
 }
 
-static CONST char * CONST button_names [] = {
+static const Extbyte * const button_names [] = {
   "button1", "button2", "button3", "button4", "button5",
   "button6", "button7", "button8", "button9", "button10" };
 
-/* can't have static frame locals because of some broken compilers */
-static char tmp_dbox_name [255];
-
 static widget_value *
-dbox_descriptor_to_widget_value (Lisp_Object desc)
+dbox_descriptor_to_widget_value (Lisp_Object keys)
 {
-  /* !!#### This function has not been Mule-ized */
   /* This function can GC */
-  char *name;
   int lbuttons = 0, rbuttons = 0;
   int partition_seen = 0;
   int text_field_p = 0;
@@ -123,13 +128,33 @@
   int n = 0;
   int count = specpdl_depth ();
   Lisp_Object wv_closure, gui_item;
+  Lisp_Object question = Qnil, title = Qnil, buttons = Qnil;
 
-  CHECK_CONS (desc);
-  CHECK_STRING (XCAR (desc));
-  name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
-  desc = XCDR (desc);
-  if (!CONSP (desc))
-    error ("dialog boxes must have some buttons");
+  {
+    EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
+      {
+	if (EQ (key, Q_question))
+	  {
+	    CHECK_STRING (value);
+	    question = value;
+	  }
+	else if (EQ (key, Q_title))
+	  {
+	    CHECK_STRING (value);
+	    title = value;
+	  }
+	else if (EQ (key, Q_buttons))
+	  {
+	    CHECK_LIST (value);
+	    buttons = value;
+	  }
+	else
+	  syntax_error ("Unrecognized question-dialog keyword", key);
+      }
+  }
+
+  if (NILP (question))
+    syntax_error ("Dialog descriptor provides no question", keys);
 
   /* Inhibit GC during this conversion.  The reasons for this are
      the same as in menu_item_descriptor_to_widget_value(); see
@@ -147,61 +172,69 @@
   wv_closure = make_opaque_ptr (kids);
   record_unwind_protect (widget_value_unwind, wv_closure);
   prev->name = xstrdup ("message");
-  prev->value = xstrdup (name);
+  LISP_STRING_TO_EXTERNAL_MALLOC (question, prev->value, Qlwlib_encoding);
   prev->enabled = 1;
 
-  for (; !NILP (desc); desc = Fcdr (desc))
-    {
-      Lisp_Object button = XCAR (desc);
-      widget_value *wv;
+  {
+    EXTERNAL_LIST_LOOP_2 (button, buttons)
+      {
+	widget_value *wv;
 
-      if (NILP (button))
-	{
-	  if (partition_seen)
-	    error ("more than one partition (nil) seen in dbox spec");
-	  partition_seen = 1;
-	  continue;
-	}
-      CHECK_VECTOR (button);
-      wv = xmalloc_widget_value ();
+	if (NILP (button))
+	  {
+	    if (partition_seen)
+	      syntax_error ("More than one partition (nil) seen in dbox spec",
+			    keys);
+	    partition_seen = 1;
+	    continue;
+	  }
+	CHECK_VECTOR (button);
+	wv = xmalloc_widget_value ();
 
-      gui_item = gui_parse_item_keywords (button);
-      if (!button_item_to_widget_value (gui_item, wv, allow_text_p, 1))
-	{
-	  free_widget_value_tree (wv);
-	  continue;
-	}
+	gui_item = gui_parse_item_keywords (button);
+	if (!button_item_to_widget_value (Qdialog,
+					  gui_item, wv, allow_text_p, 1, 0, 1))
+	  {
+	    free_widget_value_tree (wv);
+	    continue;
+	  }
 
-      if (wv->type == TEXT_TYPE)
-	{
-	  text_field_p = 1;
-	  allow_text_p = 0;	 /* only allow one */
-	}
-      else			/* it's a button */
-	{
-	  allow_text_p = 0;	 /* only allow text field at the front */
-	  if (wv->value)	xfree (wv->value);
-	  wv->value = wv->name;	/* what a mess... */
-	  wv->name = xstrdup (button_names [n]);
+	if (wv->type == TEXT_TYPE)
+	  {
+	    text_field_p = 1;
+	    allow_text_p = 0;	 /* only allow one */
+	  }
+	else			/* it's a button */
+	  {
+	    allow_text_p = 0;	 /* only allow text field at the front */
+	    if (wv->value)
+	      xfree (wv->value);
+	    wv->value = wv->name;	/* what a mess... */
+	    wv->name = xstrdup (button_names [n]);
 
-	  if (partition_seen)
-	    rbuttons++;
-	  else
-	    lbuttons++;
-	  n++;
+	    if (partition_seen)
+	      rbuttons++;
+	    else
+	      lbuttons++;
+	    n++;
 
-	  if (lbuttons > 9 || rbuttons > 9)
-	    error ("too many buttons (9)"); /* #### this leaks */
-	}
+	    if (lbuttons > 9 || rbuttons > 9)
+	      syntax_error ("Too many buttons (9)",
+			    keys); /* #### this leaks */
+	  }
 
-      prev->next = wv;
-      prev = wv;
-    }
+	prev->next = wv;
+	prev = wv;
+      }
+  }
 
   if (n == 0)
-    error ("dialog boxes must have some buttons");
+    syntax_error ("Dialog boxes must have some buttons", keys);
+
   {
-    char type = (text_field_p ? 'P' : 'Q');
+    Extbyte type = (text_field_p ? 'P' : 'Q');
+    static Extbyte tmp_dbox_name [255];
+
     widget_value *dbox;
     sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons);
     dbox = xmalloc_widget_value ();
@@ -215,14 +248,18 @@
   }
 }
 
-static void
-x_popup_dialog_box (struct frame* f, Lisp_Object dbox_desc)
+static Lisp_Object
+x_make_dialog_box_internal (struct frame* f, Lisp_Object type,
+			    Lisp_Object keys)
 {
   int dbox_id;
   widget_value *data;
   Widget parent, dbox;
 
-  data = dbox_descriptor_to_widget_value (dbox_desc);
+  if (!EQ (type, Qquestion))
+    signal_type_error (Qunimplemented, "Dialog box type", type);
+
+  data = dbox_descriptor_to_widget_value (keys);
 
   parent = FRAME_X_SHELL_WIDGET (f);
 
@@ -252,6 +289,10 @@
 
   popup_up_p++;
   lw_pop_up_all_widgets (dbox_id);
+
+  /* #### this could (theoretically) cause problems if we are up for
+     a REALLY REALLY long time -- too big to fit into lisp integer. */
+  return make_int (dbox_id);
 }
 
 void
@@ -262,7 +303,7 @@
 void
 console_type_create_dialog_x (void)
 {
-  CONSOLE_HAS_METHOD (x, popup_dialog_box);
+  CONSOLE_HAS_METHOD (x, make_dialog_box_internal);
 }
 
 void