Mercurial > hg > xemacs-beta
annotate src/dialog-x.c @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 05 Aug 2013 10:05:32 +0100 |
| parents | 56144c8593a8 |
| children |
| rev | line source |
|---|---|
| 428 | 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. | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
4 Copyright (C) 2000, 2002, 2003, 2010 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
11 option) any later version. |
| 428 | 12 |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: Not in FSF. */ | |
| 22 | |
| 442 | 23 /* This file Mule-ized by Ben Wing, 7-8-00. */ |
| 24 | |
| 428 | 25 #include <config.h> |
| 26 #include "lisp.h" | |
| 27 | |
| 28 #include "buffer.h" | |
| 29 #include "commands.h" /* zmacs_regions */ | |
| 30 #include "events.h" | |
| 872 | 31 #include "frame-impl.h" |
| 428 | 32 #include "gui.h" |
| 33 #include "opaque.h" | |
| 34 #include "window.h" | |
| 35 | |
| 872 | 36 #include "console-x-impl.h" |
| 37 | |
| 38 #include "EmacsFrame.h" | |
| 428 | 39 |
| 40 static void | |
| 41 maybe_run_dbox_text_callback (LWLIB_ID id) | |
| 42 { | |
| 43 widget_value *wv; | |
| 44 int got_some; | |
| 45 wv = xmalloc_widget_value (); | |
| 436 | 46 wv->name = xstrdup ("value"); |
| 428 | 47 got_some = lw_get_some_values (id, wv); |
| 48 if (got_some) | |
| 49 { | |
| 50 Lisp_Object text_field_callback; | |
| 442 | 51 Extbyte *text_field_value = wv->value; |
| 5013 | 52 text_field_callback = GET_LISP_FROM_VOID (wv->call_data); |
| 442 | 53 text_field_callback = XCAR (XCDR (text_field_callback)); |
| 428 | 54 if (text_field_value) |
| 55 { | |
| 442 | 56 void *tmp = |
| 5013 | 57 STORE_LISP_IN_VOID (cons3 (Qnil, |
| 442 | 58 list2 (text_field_callback, |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3466
diff
changeset
|
59 build_extstring (text_field_value, |
| 442 | 60 Qlwlib_encoding)), |
| 61 Qnil)); | |
| 428 | 62 popup_selection_callback (0, id, (XtPointer) tmp); |
| 63 } | |
| 64 } | |
| 436 | 65 /* This code tried to optimize, newing/freeing. This is generally |
| 442 | 66 unsafe so we will always strdup and always use |
| 436 | 67 free_widget_value_tree. */ |
| 68 free_widget_value_tree (wv); | |
| 428 | 69 } |
| 70 | |
| 71 static void | |
| 72 dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) | |
| 73 { | |
| 74 /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent | |
| 75 instead of a button being selected. */ | |
| 76 struct device *d = get_device_from_display (XtDisplay (widget)); | |
| 77 struct frame *f = 0; | |
| 78 Widget cur_widget = widget; | |
| 79 | |
| 80 /* The parent which is actually connected to our EmacsFrame may be a | |
| 81 ways up the tree. */ | |
| 82 while (!f && cur_widget) | |
| 83 { | |
| 84 f = x_any_window_to_frame (d, XtWindow (cur_widget)); | |
| 85 cur_widget = XtParent (cur_widget); | |
| 86 } | |
| 87 | |
| 88 if (popup_handled_p (id)) | |
| 89 return; | |
| 90 assert (popup_up_p != 0); | |
| 91 ungcpro_popup_callbacks (id); | |
| 92 popup_up_p--; | |
| 93 maybe_run_dbox_text_callback (id); | |
| 94 popup_selection_callback (widget, id, client_data); | |
| 442 | 95 /* #### need to error-protect! will do so when i merge in |
| 96 my working ws */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
97 va_run_hook_with_args (Qdelete_dialog_box_hook, 1, make_fixnum (id)); |
| 428 | 98 lw_destroy_all_widgets (id); |
| 99 | |
| 100 /* The Motif dialog box sets the keyboard focus to itself. When it | |
| 101 goes away we have to take care of getting the focus back | |
| 102 ourselves. */ | |
| 103 #ifdef EXTERNAL_WIDGET | |
| 104 /* #### Not sure if this special case is necessary. */ | |
| 3466 | 105 if (f && !FRAME_X_EXTERNAL_WINDOW_P (f)) |
| 428 | 106 #else |
| 107 if (f) | |
| 108 #endif | |
| 109 lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f)); | |
| 110 } | |
| 111 | |
| 442 | 112 static const Extbyte * const button_names [] = { |
| 428 | 113 "button1", "button2", "button3", "button4", "button5", |
| 114 "button6", "button7", "button8", "button9", "button10" }; | |
| 115 | |
| 116 static widget_value * | |
| 442 | 117 dbox_descriptor_to_widget_value (Lisp_Object keys) |
| 428 | 118 { |
| 119 /* This function can GC */ | |
| 120 int lbuttons = 0, rbuttons = 0; | |
| 121 int partition_seen = 0; | |
| 122 int text_field_p = 0; | |
| 123 int allow_text_p = 1; | |
| 124 widget_value *prev = 0, *kids = 0; | |
| 125 int n = 0; | |
| 853 | 126 int count; |
| 428 | 127 Lisp_Object wv_closure, gui_item; |
| 444 | 128 Lisp_Object question = Qnil; |
| 129 Lisp_Object buttons = Qnil; | |
| 2286 | 130 /* Lisp_Object title = Qnil; #### currently unused */ |
| 428 | 131 |
| 442 | 132 { |
| 133 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) | |
| 134 { | |
| 135 if (EQ (key, Q_question)) | |
| 136 { | |
| 137 CHECK_STRING (value); | |
| 138 question = value; | |
| 139 } | |
| 140 else if (EQ (key, Q_title)) | |
| 141 { | |
| 142 CHECK_STRING (value); | |
| 2286 | 143 /* title = value; */ |
| 442 | 144 } |
| 145 else if (EQ (key, Q_buttons)) | |
| 146 { | |
| 147 CHECK_LIST (value); | |
| 148 buttons = value; | |
| 149 } | |
| 150 else | |
| 563 | 151 invalid_constant ("Unrecognized question-dialog keyword", key); |
| 442 | 152 } |
| 153 } | |
| 154 | |
| 155 if (NILP (question)) | |
| 563 | 156 sferror ("Dialog descriptor provides no question", keys); |
| 428 | 157 |
| 158 /* Inhibit GC during this conversion. The reasons for this are | |
| 159 the same as in menu_item_descriptor_to_widget_value(); see | |
| 160 the large comment above that function. */ | |
| 161 | |
| 853 | 162 count = begin_gc_forbidden (); |
| 428 | 163 |
| 164 kids = prev = xmalloc_widget_value (); | |
| 165 | |
| 166 /* Also make sure that we free the partially-created widget_value | |
| 167 tree on Lisp error. */ | |
| 168 | |
| 169 wv_closure = make_opaque_ptr (kids); | |
| 170 record_unwind_protect (widget_value_unwind, wv_closure); | |
| 436 | 171 prev->name = xstrdup ("message"); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
172 prev->value = LISP_STRING_TO_EXTERNAL_MALLOC (question, Qlwlib_encoding); |
| 428 | 173 prev->enabled = 1; |
| 174 | |
| 442 | 175 { |
| 176 EXTERNAL_LIST_LOOP_2 (button, buttons) | |
| 177 { | |
| 178 widget_value *wv; | |
| 428 | 179 |
| 442 | 180 if (NILP (button)) |
| 181 { | |
| 182 if (partition_seen) | |
| 563 | 183 sferror ("More than one partition (nil) seen in dbox spec", |
| 442 | 184 keys); |
| 185 partition_seen = 1; | |
| 186 continue; | |
| 187 } | |
| 188 CHECK_VECTOR (button); | |
| 189 wv = xmalloc_widget_value (); | |
| 428 | 190 |
| 442 | 191 gui_item = gui_parse_item_keywords (button); |
| 192 if (!button_item_to_widget_value (Qdialog, | |
| 193 gui_item, wv, allow_text_p, 1, 0, 1)) | |
| 194 { | |
| 195 free_widget_value_tree (wv); | |
| 196 continue; | |
| 197 } | |
| 428 | 198 |
| 442 | 199 if (wv->type == TEXT_TYPE) |
| 200 { | |
| 201 text_field_p = 1; | |
| 202 allow_text_p = 0; /* only allow one */ | |
| 203 } | |
| 204 else /* it's a button */ | |
| 205 { | |
| 206 allow_text_p = 0; /* only allow text field at the front */ | |
| 207 if (wv->value) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
208 xfree (wv->value); |
| 442 | 209 wv->value = wv->name; /* what a mess... */ |
| 210 wv->name = xstrdup (button_names [n]); | |
| 428 | 211 |
| 442 | 212 if (partition_seen) |
| 213 rbuttons++; | |
| 214 else | |
| 215 lbuttons++; | |
| 216 n++; | |
| 428 | 217 |
| 442 | 218 if (lbuttons > 9 || rbuttons > 9) |
| 563 | 219 sferror ("Too many buttons (9)", |
| 442 | 220 keys); /* #### this leaks */ |
| 221 } | |
| 428 | 222 |
| 442 | 223 prev->next = wv; |
| 224 prev = wv; | |
| 225 } | |
| 226 } | |
| 428 | 227 |
| 228 if (n == 0) | |
| 563 | 229 sferror ("Dialog boxes must have some buttons", keys); |
| 442 | 230 |
| 428 | 231 { |
| 442 | 232 Extbyte type = (text_field_p ? 'P' : 'Q'); |
| 233 static Extbyte tmp_dbox_name [255]; | |
| 234 | |
| 428 | 235 widget_value *dbox; |
| 236 sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons); | |
| 237 dbox = xmalloc_widget_value (); | |
| 436 | 238 dbox->name = xstrdup (tmp_dbox_name); |
| 428 | 239 dbox->contents = kids; |
| 240 | |
| 241 /* No more need to free the half-filled-in structures. */ | |
| 242 set_opaque_ptr (wv_closure, 0); | |
| 771 | 243 unbind_to (count); |
| 428 | 244 return dbox; |
| 245 } | |
| 246 } | |
| 247 | |
| 442 | 248 static Lisp_Object |
| 249 x_make_dialog_box_internal (struct frame* f, Lisp_Object type, | |
| 250 Lisp_Object keys) | |
| 428 | 251 { |
| 252 int dbox_id; | |
| 253 widget_value *data; | |
| 2286 | 254 Widget parent; |
| 428 | 255 |
| 442 | 256 if (!EQ (type, Qquestion)) |
| 563 | 257 signal_error (Qunimplemented, "Dialog box type", type); |
| 442 | 258 |
| 259 data = dbox_descriptor_to_widget_value (keys); | |
| 428 | 260 |
| 261 parent = FRAME_X_SHELL_WIDGET (f); | |
| 262 | |
| 263 dbox_id = new_lwlib_id (); | |
| 2286 | 264 (void) lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0, |
| 428 | 265 dbox_selection_callback, 0); |
| 266 lw_modify_all_widgets (dbox_id, data, True); | |
| 267 lw_modify_all_widgets (dbox_id, data->contents, True); | |
| 268 free_popup_widget_value_tree (data); | |
| 269 | |
| 270 gcpro_popup_callbacks (dbox_id); | |
| 271 | |
| 272 /* Setting zmacs-region-stays is necessary here because executing a | |
| 273 command from a dialog is really a two-command process: the first | |
| 274 command (bound to the button-click) simply pops up the dialog, | |
| 275 and returns. This causes a sequence of magic-events (destined | |
| 276 for the dialog widget) to begin. Eventually, a dialog item is | |
| 277 selected, and a misc-user-event blip is pushed onto the end of | |
| 278 the input stream, which is then executed by the event loop. | |
| 279 | |
| 280 So there are two command-events, with a bunch of magic-events | |
| 281 between them. We don't want the *first* command event to alter | |
| 282 the state of the region, so that the region can be available as | |
| 283 an argument for the second command. */ | |
| 284 if (zmacs_regions) | |
| 285 zmacs_region_stays = 1; | |
| 286 | |
| 287 popup_up_p++; | |
| 288 lw_pop_up_all_widgets (dbox_id); | |
| 442 | 289 |
| 290 /* #### this could (theoretically) cause problems if we are up for | |
| 291 a REALLY REALLY long time -- too big to fit into lisp integer. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
292 return make_fixnum (dbox_id); |
| 428 | 293 } |
| 294 | |
| 295 void | |
| 296 syms_of_dialog_x (void) | |
| 297 { | |
| 298 } | |
| 299 | |
| 300 void | |
| 301 console_type_create_dialog_x (void) | |
| 302 { | |
| 442 | 303 CONSOLE_HAS_METHOD (x, make_dialog_box_internal); |
| 428 | 304 } |
| 305 | |
| 306 void | |
| 307 vars_of_dialog_x (void) | |
| 308 { | |
| 309 #if defined (LWLIB_DIALOGS_LUCID) | |
| 310 Fprovide (intern ("lucid-dialogs")); | |
| 311 #elif defined (LWLIB_DIALOGS_MOTIF) | |
| 312 Fprovide (intern ("motif-dialogs")); | |
| 313 #elif defined (LWLIB_DIALOGS_ATHENA) | |
| 314 Fprovide (intern ("athena-dialogs")); | |
| 315 #endif | |
| 316 } |