X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fdialog-x.c;h=9b32e5adc62a2f5d093a204be9d247f25a62a050;hb=8b6b965da075da197b3d654db3405aa6846bd3d8;hp=3d1acc356ce915b09f71ab41c0b30b8305fc45e0;hpb=a1655b870904de973c366d85ebdc8adde4ef5e1e;p=chise%2Fxemacs-chise.git.1 diff --git a/src/dialog-x.c b/src/dialog-x.c index 3d1acc3..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,7 +43,6 @@ 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 (); @@ -49,7 +51,7 @@ maybe_run_dbox_text_callback (LWLIB_ID id) 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) @@ -57,13 +59,14 @@ maybe_run_dbox_text_callback (LWLIB_ID id) 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); } @@ -92,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 @@ -99,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; @@ -127,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 @@ -151,62 +174,69 @@ dbox_descriptor_to_widget_value (Lisp_Object desc) 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 (); @@ -220,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); @@ -257,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 @@ -267,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