Mercurial > hg > xemacs-beta

comparison src/dialog-x.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 080151679be2
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 /* Implements elisp-programmable dialog boxes -- X interface. 1 /* Implements elisp-programmable dialog boxes -- X interface.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp. 3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4 Copyright (C) 2000 Ben Wing.
4 5
5 This file is part of XEmacs. 6 This file is part of XEmacs.
6 7
7 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
18 along with XEmacs; see the file COPYING. If not, write to 19 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 21 Boston, MA 02111-1307, USA. */
21 22
22 /* Synched up with: Not in FSF. */ 23 /* Synched up with: Not in FSF. */
24
25 /* This file Mule-ized by Ben Wing, 7-8-00. */
23 26
24 #include <config.h> 27 #include <config.h>
25 #include "lisp.h" 28 #include "lisp.h"
26 29
27 #include "console-x.h" 30 #include "console-x.h"
38 41
39 42
40 static void 43 static void
41 maybe_run_dbox_text_callback (LWLIB_ID id) 44 maybe_run_dbox_text_callback (LWLIB_ID id)
42 { 45 {
43 /* !!#### This function has not been Mule-ized */
44 widget_value *wv; 46 widget_value *wv;
45 int got_some; 47 int got_some;
46 wv = xmalloc_widget_value (); 48 wv = xmalloc_widget_value ();
47 wv->name = xstrdup ("value"); 49 wv->name = xstrdup ("value");
48 got_some = lw_get_some_values (id, wv); 50 got_some = lw_get_some_values (id, wv);
49 if (got_some) 51 if (got_some)
50 { 52 {
51 Lisp_Object text_field_callback; 53 Lisp_Object text_field_callback;
52 char *text_field_value = wv->value; 54 Extbyte *text_field_value = wv->value;
53 VOID_TO_LISP (text_field_callback, wv->call_data); 55 VOID_TO_LISP (text_field_callback, wv->call_data);
56 text_field_callback = XCAR (XCDR (text_field_callback));
54 if (text_field_value) 57 if (text_field_value)
55 { 58 {
56 void *tmp = LISP_TO_VOID (list2 (text_field_callback, 59 void *tmp =
57 build_string (text_field_value))); 60 LISP_TO_VOID (cons3 (Qnil,
61 list2 (text_field_callback,
62 build_ext_string (text_field_value,
63 Qlwlib_encoding)),
64 Qnil));
58 popup_selection_callback (0, id, (XtPointer) tmp); 65 popup_selection_callback (0, id, (XtPointer) tmp);
59 } 66 }
60 } 67 }
61 /* This code tried to optimize, newing/freeing. This is generally 68 /* This code tried to optimize, newing/freeing. This is generally
62 unsafe so we will alwats strdup and always use 69 unsafe so we will always strdup and always use
63 free_widget_value_tree. */ 70 free_widget_value_tree. */
64 free_widget_value_tree (wv); 71 free_widget_value_tree (wv);
65 } 72 }
66 73
67 static void 74 static void
86 assert (popup_up_p != 0); 93 assert (popup_up_p != 0);
87 ungcpro_popup_callbacks (id); 94 ungcpro_popup_callbacks (id);
88 popup_up_p--; 95 popup_up_p--;
89 maybe_run_dbox_text_callback (id); 96 maybe_run_dbox_text_callback (id);
90 popup_selection_callback (widget, id, client_data); 97 popup_selection_callback (widget, id, client_data);
98 /* #### need to error-protect! will do so when i merge in
99 my working ws */
100 va_run_hook_with_args (Qdelete_dialog_box_hook, 1, make_int (id));
91 lw_destroy_all_widgets (id); 101 lw_destroy_all_widgets (id);
92 102
93 /* The Motif dialog box sets the keyboard focus to itself. When it 103 /* The Motif dialog box sets the keyboard focus to itself. When it
94 goes away we have to take care of getting the focus back 104 goes away we have to take care of getting the focus back
95 ourselves. */ 105 ourselves. */
100 if (f) 110 if (f)
101 #endif 111 #endif
102 lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f)); 112 lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f));
103 } 113 }
104 114
105 static CONST char * CONST button_names [] = { 115 static const Extbyte * const button_names [] = {
106 "button1", "button2", "button3", "button4", "button5", 116 "button1", "button2", "button3", "button4", "button5",
107 "button6", "button7", "button8", "button9", "button10" }; 117 "button6", "button7", "button8", "button9", "button10" };
108 118
109 /* can't have static frame locals because of some broken compilers */
110 static char tmp_dbox_name [255];
111
112 static widget_value * 119 static widget_value *
113 dbox_descriptor_to_widget_value (Lisp_Object desc) 120 dbox_descriptor_to_widget_value (Lisp_Object keys)
114 { 121 {
115 /* !!#### This function has not been Mule-ized */
116 /* This function can GC */ 122 /* This function can GC */
117 char *name;
118 int lbuttons = 0, rbuttons = 0; 123 int lbuttons = 0, rbuttons = 0;
119 int partition_seen = 0; 124 int partition_seen = 0;
120 int text_field_p = 0; 125 int text_field_p = 0;
121 int allow_text_p = 1; 126 int allow_text_p = 1;
122 widget_value *prev = 0, *kids = 0; 127 widget_value *prev = 0, *kids = 0;
123 int n = 0; 128 int n = 0;
124 int count = specpdl_depth (); 129 int count = specpdl_depth ();
125 Lisp_Object wv_closure, gui_item; 130 Lisp_Object wv_closure, gui_item;
126 131 Lisp_Object question = Qnil, title = Qnil, buttons = Qnil;
127 CHECK_CONS (desc); 132
128 CHECK_STRING (XCAR (desc)); 133 {
129 name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); 134 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
130 desc = XCDR (desc); 135 {
131 if (!CONSP (desc)) 136 if (EQ (key, Q_question))
132 error ("dialog boxes must have some buttons"); 137 {
138 CHECK_STRING (value);
139 question = value;
140 }
141 else if (EQ (key, Q_title))
142 {
143 CHECK_STRING (value);
144 title = value;
145 }
146 else if (EQ (key, Q_buttons))
147 {
148 CHECK_LIST (value);
149 buttons = value;
150 }
151 else
152 syntax_error ("Unrecognized question-dialog keyword", key);
153 }
154 }
155
156 if (NILP (question))
157 syntax_error ("Dialog descriptor provides no question", keys);
133 158
134 /* Inhibit GC during this conversion. The reasons for this are 159 /* Inhibit GC during this conversion. The reasons for this are
135 the same as in menu_item_descriptor_to_widget_value(); see 160 the same as in menu_item_descriptor_to_widget_value(); see
136 the large comment above that function. */ 161 the large comment above that function. */
137 162
145 tree on Lisp error. */ 170 tree on Lisp error. */
146 171
147 wv_closure = make_opaque_ptr (kids); 172 wv_closure = make_opaque_ptr (kids);
148 record_unwind_protect (widget_value_unwind, wv_closure); 173 record_unwind_protect (widget_value_unwind, wv_closure);
149 prev->name = xstrdup ("message"); 174 prev->name = xstrdup ("message");
150 prev->value = xstrdup (name); 175 LISP_STRING_TO_EXTERNAL_MALLOC (question, prev->value, Qlwlib_encoding);
151 prev->enabled = 1; 176 prev->enabled = 1;
152 177
153 for (; !NILP (desc); desc = Fcdr (desc)) 178 {
154 { 179 EXTERNAL_LIST_LOOP_2 (button, buttons)
155 Lisp_Object button = XCAR (desc); 180 {
156 widget_value *wv; 181 widget_value *wv;
157 182
158 if (NILP (button)) 183 if (NILP (button))
159 { 184 {
160 if (partition_seen) 185 if (partition_seen)
161 error ("more than one partition (nil) seen in dbox spec"); 186 syntax_error ("More than one partition (nil) seen in dbox spec",
162 partition_seen = 1; 187 keys);
163 continue; 188 partition_seen = 1;
164 } 189 continue;
165 CHECK_VECTOR (button); 190 }
166 wv = xmalloc_widget_value (); 191 CHECK_VECTOR (button);
167 192 wv = xmalloc_widget_value ();
168 gui_item = gui_parse_item_keywords (button); 193
169 if (!button_item_to_widget_value (gui_item, wv, allow_text_p, 1)) 194 gui_item = gui_parse_item_keywords (button);
170 { 195 if (!button_item_to_widget_value (Qdialog,
171 free_widget_value_tree (wv); 196 gui_item, wv, allow_text_p, 1, 0, 1))
172 continue; 197 {
173 } 198 free_widget_value_tree (wv);
174 199 continue;
175 if (wv->type == TEXT_TYPE) 200 }
176 { 201
177 text_field_p = 1; 202 if (wv->type == TEXT_TYPE)
178 allow_text_p = 0; /* only allow one */ 203 {
179 } 204 text_field_p = 1;
180 else /* it's a button */ 205 allow_text_p = 0; /* only allow one */
181 { 206 }
182 allow_text_p = 0; /* only allow text field at the front */ 207 else /* it's a button */
183 if (wv->value) xfree (wv->value); 208 {
184 wv->value = wv->name; /* what a mess... */ 209 allow_text_p = 0; /* only allow text field at the front */
185 wv->name = xstrdup (button_names [n]); 210 if (wv->value)
186 211 xfree (wv->value);
187 if (partition_seen) 212 wv->value = wv->name; /* what a mess... */
188 rbuttons++; 213 wv->name = xstrdup (button_names [n]);
189 else 214
190 lbuttons++; 215 if (partition_seen)
191 n++; 216 rbuttons++;
192 217 else
193 if (lbuttons > 9 || rbuttons > 9) 218 lbuttons++;
194 error ("too many buttons (9)"); /* #### this leaks */ 219 n++;
195 } 220
196 221 if (lbuttons > 9 || rbuttons > 9)
197 prev->next = wv; 222 syntax_error ("Too many buttons (9)",
198 prev = wv; 223 keys); /* #### this leaks */
199 } 224 }
225
226 prev->next = wv;
227 prev = wv;
228 }
229 }
200 230
201 if (n == 0) 231 if (n == 0)
202 error ("dialog boxes must have some buttons"); 232 syntax_error ("Dialog boxes must have some buttons", keys);
233
203 { 234 {
204 char type = (text_field_p ? 'P' : 'Q'); 235 Extbyte type = (text_field_p ? 'P' : 'Q');
236 static Extbyte tmp_dbox_name [255];
237
205 widget_value *dbox; 238 widget_value *dbox;
206 sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons); 239 sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons);
207 dbox = xmalloc_widget_value (); 240 dbox = xmalloc_widget_value ();
208 dbox->name = xstrdup (tmp_dbox_name); 241 dbox->name = xstrdup (tmp_dbox_name);
209 dbox->contents = kids; 242 dbox->contents = kids;
213 unbind_to (count, Qnil); 246 unbind_to (count, Qnil);
214 return dbox; 247 return dbox;
215 } 248 }
216 } 249 }
217 250
218 static void 251 static Lisp_Object
219 x_popup_dialog_box (struct frame* f, Lisp_Object dbox_desc) 252 x_make_dialog_box_internal (struct frame* f, Lisp_Object type,
253 Lisp_Object keys)
220 { 254 {
221 int dbox_id; 255 int dbox_id;
222 widget_value *data; 256 widget_value *data;
223 Widget parent, dbox; 257 Widget parent, dbox;
224 258
225 data = dbox_descriptor_to_widget_value (dbox_desc); 259 if (!EQ (type, Qquestion))
260 signal_type_error (Qunimplemented, "Dialog box type", type);
261
262 data = dbox_descriptor_to_widget_value (keys);
226 263
227 parent = FRAME_X_SHELL_WIDGET (f); 264 parent = FRAME_X_SHELL_WIDGET (f);
228 265
229 dbox_id = new_lwlib_id (); 266 dbox_id = new_lwlib_id ();
230 dbox = lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0, 267 dbox = lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0,
250 if (zmacs_regions) 287 if (zmacs_regions)
251 zmacs_region_stays = 1; 288 zmacs_region_stays = 1;
252 289
253 popup_up_p++; 290 popup_up_p++;
254 lw_pop_up_all_widgets (dbox_id); 291 lw_pop_up_all_widgets (dbox_id);
292
293 /* #### this could (theoretically) cause problems if we are up for
294 a REALLY REALLY long time -- too big to fit into lisp integer. */
295 return make_int (dbox_id);
255 } 296 }
256 297
257 void 298 void
258 syms_of_dialog_x (void) 299 syms_of_dialog_x (void)
259 { 300 {
260 } 301 }
261 302
262 void 303 void
263 console_type_create_dialog_x (void) 304 console_type_create_dialog_x (void)
264 { 305 {
265 CONSOLE_HAS_METHOD (x, popup_dialog_box); 306 CONSOLE_HAS_METHOD (x, make_dialog_box_internal);
266 } 307 }
267 308
268 void 309 void
269 vars_of_dialog_x (void) 310 vars_of_dialog_x (void)
270 { 311 {