1 /* Implements elisp-programmable dialog boxes -- X interface.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4 Copyright (C) 2000 Ben Wing.
6 This file is part of SXEmacs
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 /* Synched up with: Not in FSF. */
24 /* This file Mule-ized by Ben Wing, 7-8-00. */
29 #include "console-x.h"
30 #include "EmacsFrame.h"
34 #include "commands.h" /* zmacs_regions */
35 #include "events/events.h"
39 #include "ui/window.h"
41 static void maybe_run_dbox_text_callback(LWLIB_ID id)
45 wv = xmalloc_widget_value();
46 wv->name = xstrdup("value");
47 got_some = lw_get_some_values(id, wv);
49 Lisp_Object text_field_callback;
50 Extbyte *text_field_value = wv->value;
51 VOID_TO_LISP(text_field_callback, wv->call_data);
52 text_field_callback = XCAR(XCDR(text_field_callback));
53 if (text_field_value) {
56 list2(text_field_callback,
57 build_ext_string(text_field_value,
60 void *tmp2 = LISP_TO_VOID(tmp1);
61 popup_selection_callback(0, id, (XtPointer)tmp2);
64 /* This code tried to optimize, newing/freeing. This is generally
65 unsafe so we will always strdup and always use
66 free_widget_value_tree. */
67 free_widget_value_tree(wv);
71 dbox_selection_callback(Widget widget, LWLIB_ID id, XtPointer client_data)
73 /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent
74 instead of a button being selected. */
75 struct device *d = get_device_from_display(XtDisplay(widget));
77 Widget cur_widget = widget;
79 /* The parent which is actually connected to our EmacsFrame may be a
81 while (!f && cur_widget) {
82 f = x_any_window_to_frame(d, XtWindow(cur_widget));
83 cur_widget = XtParent(cur_widget);
86 if (popup_handled_p(id))
88 assert(popup_up_p != 0);
89 ungcpro_popup_callbacks(id);
91 maybe_run_dbox_text_callback(id);
92 popup_selection_callback(widget, id, client_data);
93 /* #### need to error-protect! will do so when i merge in
95 va_run_hook_with_args(Qdelete_dialog_box_hook, 1, make_int(id));
96 lw_destroy_all_widgets(id);
98 /* The Motif dialog box sets the keyboard focus to itself. When it
99 goes away we have to take care of getting the focus back
101 #ifdef EXTERNAL_WIDGET
102 /* #### Not sure if this special case is necessary. */
103 if (f && !FRAME_X_EXTERNAL_WINDOW_P(f) )
107 lw_set_keyboard_focus(FRAME_X_SHELL_WIDGET(f),
108 FRAME_X_TEXT_WIDGET(f));
111 static const Extbyte *const button_names[] = {
112 "button1", "button2", "button3", "button4", "button5",
113 "button6", "button7", "button8", "button9", "button10"
116 static widget_value *dbox_descriptor_to_widget_value(Lisp_Object keys)
118 /* This function can GC */
119 int lbuttons = 0, rbuttons = 0;
120 int partition_seen = 0;
121 int text_field_p = 0;
122 int allow_text_p = 1;
123 widget_value *prev = 0, *kids = 0;
125 int count = specpdl_depth();
126 Lisp_Object wv_closure, gui_item;
127 Lisp_Object question = Qnil;
128 Lisp_Object title = Qnil; /* #### currently unused */
129 Lisp_Object buttons = Qnil;
132 EXTERNAL_PROPERTY_LIST_LOOP_3(key, value, keys) {
133 if (EQ(key, Q_question)) {
136 } else if (EQ(key, Q_title)) {
139 } else if (EQ(key, Q_buttons)) {
144 ("Unrecognized question-dialog keyword",
149 SXE_SET_UNUSED(title);
152 syntax_error("Dialog descriptor provides no question", keys);
154 /* Inhibit GC during this conversion. The reasons for this are
155 the same as in menu_item_descriptor_to_widget_value(); see
156 the large comment above that function. */
158 record_unwind_protect(restore_gc_inhibit,
159 make_int(gc_currently_forbidden));
160 gc_currently_forbidden = 1;
162 kids = prev = xmalloc_widget_value();
164 /* Also make sure that we free the partially-created widget_value
165 tree on Lisp error. */
167 wv_closure = make_opaque_ptr(kids);
168 record_unwind_protect(widget_value_unwind, wv_closure);
169 prev->name = xstrdup("message");
170 LISP_STRING_TO_EXTERNAL_MALLOC(question, prev->value, Qlwlib_encoding);
174 EXTERNAL_LIST_LOOP_2(button, buttons) {
180 ("More than one partition (nil) seen in dbox spec",
185 CHECK_VECTOR(button);
186 wv = xmalloc_widget_value();
188 gui_item = gui_parse_item_keywords(button);
189 if (!button_item_to_widget_value(Qdialog,
193 free_widget_value_tree(wv);
197 if (wv->type == TEXT_TYPE) {
199 allow_text_p = 0; /* only allow one */
200 } else { /* it's a button */
202 allow_text_p = 0; /* only allow text field at the front */
205 wv->value = wv->name; /* what a mess... */
206 wv->name = xstrdup(button_names[n]);
214 if (lbuttons > 9 || rbuttons > 9)
215 syntax_error("Too many buttons (9)", keys); /* #### this leaks */
224 syntax_error("Dialog boxes must have some buttons", keys);
227 Extbyte type = (text_field_p ? 'P' : 'Q');
228 static Extbyte tmp_dbox_name[255];
230 int sz = snprintf(tmp_dbox_name, sizeof(tmp_dbox_name),
231 "%c%dBR%d", type, lbuttons + rbuttons,
234 assert(sz >= 0 && (size_t)sz < sizeof(tmp_dbox_name));
235 dbox = xmalloc_widget_value();
236 dbox->name = xstrdup(tmp_dbox_name);
237 dbox->contents = kids;
239 /* No more need to free the half-filled-in structures. */
240 set_opaque_ptr(wv_closure, 0);
241 unbind_to(count, Qnil);
247 x_make_dialog_box_internal(struct frame *f, Lisp_Object type, Lisp_Object keys)
253 if (!EQ(type, Qquestion))
254 signal_type_error(Qunimplemented, "Dialog box type", type);
256 data = dbox_descriptor_to_widget_value(keys);
258 parent = FRAME_X_SHELL_WIDGET(f);
260 dbox_id = new_lwlib_id();
262 (void)lw_create_widget(data->name, "dialog", dbox_id, data, parent, 1, 0,
263 dbox_selection_callback, 0);
264 lw_modify_all_widgets(dbox_id, data, True);
265 lw_modify_all_widgets(dbox_id, data->contents, True);
266 free_popup_widget_value_tree(data);
268 gcpro_popup_callbacks(dbox_id);
270 /* Setting zmacs-region-stays is necessary here because executing a
271 command from a dialog is really a two-command process: the first
272 command (bound to the button-click) simply pops up the dialog,
273 and returns. This causes a sequence of magic-events (destined
274 for the dialog widget) to begin. Eventually, a dialog item is
275 selected, and a misc-user-event blip is pushed onto the end of
276 the input stream, which is then executed by the event loop.
278 So there are two command-events, with a bunch of magic-events
279 between them. We don't want the *first* command event to alter
280 the state of the region, so that the region can be available as
281 an argument for the second command. */
283 zmacs_region_stays = 1;
286 lw_pop_up_all_widgets(dbox_id);
288 /* #### this could (theoretically) cause problems if we are up for
289 a REALLY REALLY long time -- too big to fit into lisp integer. */
290 return make_int(dbox_id);
293 void syms_of_dialog_x(void)
297 void console_type_create_dialog_x(void)
299 CONSOLE_HAS_METHOD(x, make_dialog_box_internal);
302 void vars_of_dialog_x(void)
304 #if defined (LWLIB_DIALOGS_MOTIF)
305 Fprovide(intern("motif-dialogs"));
306 #elif defined (LWLIB_DIALOGS_ATHENA)
307 Fprovide(intern("athena-dialogs"));