X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fdialog-x.c;h=9b32e5adc62a2f5d093a204be9d247f25a62a050;hb=2003d10ed3d849e2e973337bb4adf43fa769e6ae;hp=a61eee8e01d6cbfc90fe2224859a25ae7ccb307f;hpb=1c97bf160520f9e0b193236a902eb4b73d59d134;p=chise%2Fxemacs-chise.git.1 diff --git a/src/dialog-x.c b/src/dialog-x.c index a61eee8..9b32e5a 100644 --- a/src/dialog-x.c +++ b/src/dialog-x.c @@ -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 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ +/* This file Mule-ized by Ben Wing, 7-8-00. */ + #include #include "lisp.h" @@ -40,26 +43,32 @@ Boston, MA 02111-1307, USA. */ 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 (); - wv->name = (char *) "value"; + wv->name = xstrdup ("value"); got_some = lw_get_some_values (id, wv); 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); - xfree (text_field_value); } } - free_widget_value (wv); + /* This code tried to optimize, newing/freeing. This is generally + unsafe so we will always strdup and always use + free_widget_value_tree. */ + free_widget_value_tree (wv); } static void @@ -86,6 +95,9 @@ dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) 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 @@ -93,26 +105,21 @@ dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) ourselves. */ #ifdef EXTERNAL_WIDGET /* #### Not sure if this special case is necessary. */ - if (!FRAME_X_EXTERNAL_WINDOW_P (f) && f) + if (f && !FRAME_X_EXTERNAL_WINDOW_P (f)) #else if (f) #endif 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; @@ -121,13 +128,35 @@ dbox_descriptor_to_widget_value (Lisp_Object desc) int n = 0; int count = specpdl_depth (); Lisp_Object wv_closure, gui_item; + Lisp_Object question = Qnil; + Lisp_Object title = Qnil; /* #### currently unused */ + Lisp_Object 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 @@ -144,65 +173,74 @@ dbox_descriptor_to_widget_value (Lisp_Object desc) wv_closure = make_opaque_ptr (kids); record_unwind_protect (widget_value_unwind, wv_closure); - prev->name = (char *) "message"; - prev->value = xstrdup (name); + prev->name = xstrdup ("message"); + 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 (gui_item, wv, allow_text_p, 1)) - { - free_widget_value (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 */ - wv->value = xstrdup (wv->name); /* what a mess... */ - wv->name = (char *) 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 (); - dbox->name = tmp_dbox_name; + dbox->name = xstrdup (tmp_dbox_name); dbox->contents = kids; /* No more need to free the half-filled-in structures. */ @@ -212,14 +250,18 @@ dbox_descriptor_to_widget_value (Lisp_Object desc) } } -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); @@ -249,6 +291,10 @@ x_popup_dialog_box (struct frame* f, Lisp_Object dbox_desc) 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 @@ -259,7 +305,7 @@ syms_of_dialog_x (void) void console_type_create_dialog_x (void) { - CONSOLE_HAS_METHOD (x, popup_dialog_box); + CONSOLE_HAS_METHOD (x, make_dialog_box_internal); } void