/* 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.
/* Synched up with: Not in FSF. */
+/* This file Mule-ized by Ben Wing, 7-8-00. */
+
#include <config.h>
#include "lisp.h"
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 ();
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 (cons3 (Qnil,
list2 (text_field_callback,
- build_string (text_field_value)),
+ 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);
}
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
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;
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
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;
-
- 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 ();
-
- gui_item = gui_parse_item_keywords (button);
- if (!button_item_to_widget_value (Qdialog,
- gui_item, wv, allow_text_p, 1, 0))
- {
- 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 (partition_seen)
- rbuttons++;
- else
- lbuttons++;
- n++;
-
- if (lbuttons > 9 || rbuttons > 9)
- error ("too many buttons (9)"); /* #### this leaks */
- }
-
- prev->next = wv;
- prev = wv;
- }
+ {
+ EXTERNAL_LIST_LOOP_2 (button, buttons)
+ {
+ widget_value *wv;
+
+ 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 (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 (partition_seen)
+ rbuttons++;
+ else
+ lbuttons++;
+ n++;
+
+ if (lbuttons > 9 || rbuttons > 9)
+ syntax_error ("Too many buttons (9)",
+ keys); /* #### this leaks */
+ }
+
+ 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 ();
}
}
-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);
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
void
console_type_create_dialog_x (void)
{
- CONSOLE_HAS_METHOD (x, popup_dialog_box);
+ CONSOLE_HAS_METHOD (x, make_dialog_box_internal);
}
void
projects / chise / xemacs-chise.git.1 / blobdiff