Mercurial > hg > xemacs-beta
comparison src/gui-x.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 501cfd01ee6d |
children | 41dbb7a9d5f2 |
comparison
equal
deleted
inserted
replaced
411:12e008d41344 | 412:697ef44129c6 |
---|---|
31 #include <Xm/Xm.h> /* for XmVersion */ | 31 #include <Xm/Xm.h> /* for XmVersion */ |
32 #endif | 32 #endif |
33 #include "gui-x.h" | 33 #include "gui-x.h" |
34 #include "buffer.h" | 34 #include "buffer.h" |
35 #include "device.h" | 35 #include "device.h" |
36 #include "events.h" | |
37 #include "frame.h" | 36 #include "frame.h" |
38 #include "gui.h" | 37 #include "gui.h" |
39 #include "glyphs.h" | |
40 #include "redisplay.h" | |
41 #include "opaque.h" | 38 #include "opaque.h" |
42 | 39 |
40 #ifdef HAVE_POPUPS | |
43 Lisp_Object Qmenu_no_selection_hook; | 41 Lisp_Object Qmenu_no_selection_hook; |
42 #endif | |
44 | 43 |
45 /* we need a unique id for each popup menu, dialog box, and scrollbar */ | 44 /* we need a unique id for each popup menu, dialog box, and scrollbar */ |
46 static unsigned int lwlib_id_tick; | 45 static unsigned int lwlib_id_tick; |
47 | 46 |
48 LWLIB_ID | 47 LWLIB_ID |
58 if (!tmp) memory_full (); | 57 if (!tmp) memory_full (); |
59 return tmp; | 58 return tmp; |
60 } | 59 } |
61 | 60 |
62 | 61 |
62 #ifdef HAVE_POPUPS | |
63 | |
64 struct mark_widget_value_closure | |
65 { | |
66 void (*markobj) (Lisp_Object); | |
67 }; | |
68 | |
63 static int | 69 static int |
64 mark_widget_value_mapper (widget_value *val, void *closure) | 70 mark_widget_value_mapper (widget_value *val, void *closure) |
65 { | 71 { |
66 Lisp_Object markee; | 72 Lisp_Object markee; |
73 | |
74 struct mark_widget_value_closure *cl = | |
75 (struct mark_widget_value_closure *) closure; | |
67 if (val->call_data) | 76 if (val->call_data) |
68 { | 77 { |
69 VOID_TO_LISP (markee, val->call_data); | 78 VOID_TO_LISP (markee, val->call_data); |
70 mark_object (markee); | 79 (cl->markobj) (markee); |
71 } | 80 } |
72 | 81 |
73 if (val->accel) | 82 if (val->accel) |
74 { | 83 { |
75 VOID_TO_LISP (markee, val->accel); | 84 VOID_TO_LISP (markee, val->accel); |
76 mark_object (markee); | 85 (cl->markobj) (markee); |
77 } | 86 } |
78 return 0; | 87 return 0; |
79 } | 88 } |
80 | 89 |
81 static Lisp_Object | 90 static Lisp_Object |
82 mark_popup_data (Lisp_Object obj) | 91 mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
83 { | 92 { |
84 struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj); | 93 struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj); |
85 | 94 |
86 /* Now mark the callbacks and such that are hidden in the lwlib | 95 /* Now mark the callbacks and such that are hidden in the lwlib |
87 call-data */ | 96 call-data */ |
88 | 97 |
89 if (data->id) | 98 if (data->id) |
90 lw_map_widget_values (data->id, mark_widget_value_mapper, 0); | 99 { |
100 struct mark_widget_value_closure closure; | |
101 | |
102 closure.markobj = markobj; | |
103 lw_map_widget_values (data->id, mark_widget_value_mapper, &closure); | |
104 } | |
91 | 105 |
92 return data->last_menubar_buffer; | 106 return data->last_menubar_buffer; |
93 } | 107 } |
94 | 108 |
95 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, | 109 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, |
96 mark_popup_data, internal_object_printer, | 110 mark_popup_data, internal_object_printer, |
97 0, 0, 0, 0, struct popup_data); | 111 0, 0, 0, struct popup_data); |
98 | 112 |
99 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of | 113 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of |
100 (id . popup-data) for GCPRO'ing the callbacks of the popup menus | 114 (id . popup-data) for GCPRO'ing the callbacks of the popup menus |
101 and dialog boxes. */ | 115 and dialog boxes. */ |
102 static Lisp_Object Vpopup_callbacks; | 116 static Lisp_Object Vpopup_callbacks; |
143 widget_value_unwind (Lisp_Object closure) | 157 widget_value_unwind (Lisp_Object closure) |
144 { | 158 { |
145 widget_value *wv = (widget_value *) get_opaque_ptr (closure); | 159 widget_value *wv = (widget_value *) get_opaque_ptr (closure); |
146 free_opaque_ptr (closure); | 160 free_opaque_ptr (closure); |
147 if (wv) | 161 if (wv) |
148 free_widget_value_tree (wv); | 162 free_widget_value (wv); |
149 return Qnil; | 163 return Qnil; |
150 } | 164 } |
151 | 165 |
152 #if 0 | 166 #if 0 |
153 static void | 167 static void |
186 free_popup_widget_value_tree (widget_value *wv) | 200 free_popup_widget_value_tree (widget_value *wv) |
187 { | 201 { |
188 if (! wv) return; | 202 if (! wv) return; |
189 if (wv->key) xfree (wv->key); | 203 if (wv->key) xfree (wv->key); |
190 if (wv->value) xfree (wv->value); | 204 if (wv->value) xfree (wv->value); |
191 if (wv->name) xfree (wv->name); | |
192 | 205 |
193 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; | 206 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; |
194 | 207 |
195 if (wv->contents && (wv->contents != (widget_value*)1)) | 208 if (wv->contents && (wv->contents != (widget_value*)1)) |
196 { | 209 { |
210 | 223 |
211 void | 224 void |
212 popup_selection_callback (Widget widget, LWLIB_ID ignored_id, | 225 popup_selection_callback (Widget widget, LWLIB_ID ignored_id, |
213 XtPointer client_data) | 226 XtPointer client_data) |
214 { | 227 { |
215 Lisp_Object data, image_instance, callback, callback_ex; | 228 Lisp_Object fn, arg; |
216 Lisp_Object frame, event; | 229 Lisp_Object data; |
217 int update_subwindows_p = 0; | 230 Lisp_Object frame; |
218 struct device *d = get_device_from_display (XtDisplay (widget)); | 231 struct device *d = get_device_from_display (XtDisplay (widget)); |
219 struct frame *f = x_any_widget_or_parent_to_frame (d, widget); | 232 struct frame *f = x_any_widget_or_parent_to_frame (d, widget); |
220 | 233 |
221 /* set in lwlib to the time stamp associated with the most recent menu | 234 /* set in lwlib to the time stamp associated with the most recent menu |
222 operation */ | 235 operation */ |
240 Faccept_process_output (Qnil, Qnil, Qnil); | 253 Faccept_process_output (Qnil, Qnil, Qnil); |
241 #endif | 254 #endif |
242 | 255 |
243 if (((EMACS_INT) client_data) == -1) | 256 if (((EMACS_INT) client_data) == -1) |
244 { | 257 { |
245 event = Fmake_event (Qnil, Qnil); | 258 fn = Qrun_hooks; |
246 | 259 arg = Qmenu_no_selection_hook; |
247 XEVENT (event)->event_type = misc_user_event; | |
248 XEVENT (event)->channel = frame; | |
249 XEVENT (event)->event.eval.function = Qrun_hooks; | |
250 XEVENT (event)->event.eval.object = Qmenu_no_selection_hook; | |
251 } | 260 } |
252 else | 261 else |
253 { | 262 get_gui_callback (data, &fn, &arg); |
254 image_instance = XCAR (data); | |
255 callback = XCAR (XCDR (data)); | |
256 callback_ex = XCDR (XCDR (data)); | |
257 update_subwindows_p = 1; | |
258 | |
259 if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) | |
260 { | |
261 event = Fmake_event (Qnil, Qnil); | |
262 | |
263 XEVENT (event)->event_type = misc_user_event; | |
264 XEVENT (event)->channel = frame; | |
265 XEVENT (event)->event.eval.function = Qeval; | |
266 XEVENT (event)->event.eval.object = | |
267 list4 (Qfuncall, callback_ex, image_instance, event); | |
268 } | |
269 else if (NILP (callback) || UNBOUNDP (callback)) | |
270 event = Qnil; | |
271 else | |
272 { | |
273 Lisp_Object fn, arg; | |
274 | |
275 event = Fmake_event (Qnil, Qnil); | |
276 | |
277 get_gui_callback (callback, &fn, &arg); | |
278 XEVENT (event)->event_type = misc_user_event; | |
279 XEVENT (event)->channel = frame; | |
280 XEVENT (event)->event.eval.function = fn; | |
281 XEVENT (event)->event.eval.object = arg; | |
282 } | |
283 } | |
284 | 263 |
285 /* This is the timestamp used for asserting focus so we need to get an | 264 /* This is the timestamp used for asserting focus so we need to get an |
286 up-to-date value event if no events has been dispatched to emacs | 265 up-to-date value event if no events has been dispatched to emacs |
287 */ | 266 */ |
288 #if defined(HAVE_MENUBARS) | 267 #if defined(HAVE_MENUBARS) |
289 DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; | 268 DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; |
290 #else | 269 #else |
291 DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); | 270 DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); |
292 #endif | 271 #endif |
293 if (!NILP (event)) | 272 signal_special_Xt_user_event (frame, fn, arg); |
294 enqueue_Xt_dispatch_event (event); | |
295 /* The result of this evaluation could cause other instances to change so | |
296 enqueue an update callback to check this. */ | |
297 if (update_subwindows_p && !NILP (event)) | |
298 enqueue_magic_eval_event (update_widget_instances, frame); | |
299 } | 273 } |
300 | 274 |
301 #if 1 | 275 #if 1 |
302 /* Eval the activep slot of the menu item */ | 276 /* Eval the activep slot of the menu item */ |
303 # define wv_set_evalable_slot(slot,form) do { \ | 277 # define wv_set_evalable_slot(slot,form) do { \ |
311 # define wv_set_evalable_slot(slot,form) \ | 285 # define wv_set_evalable_slot(slot,form) \ |
312 ((void) (slot = (!NILP (form)))) | 286 ((void) (slot = (!NILP (form)))) |
313 #endif | 287 #endif |
314 | 288 |
315 char * | 289 char * |
316 menu_separator_style (const char *s) | 290 menu_separator_style (CONST char *s) |
317 { | 291 { |
318 const char *p; | 292 CONST char *p; |
319 char first; | 293 char first; |
320 | 294 |
321 if (!s || s[0] == '\0') | 295 if (!s || s[0] == '\0') |
322 return NULL; | 296 return NULL; |
323 first = s[0]; | 297 first = s[0]; |
339 return xstrdup (p+1); | 313 return xstrdup (p+1); |
340 | 314 |
341 return NULL; | 315 return NULL; |
342 } | 316 } |
343 | 317 |
344 char * | 318 /* set menu accelerator key to first underlined character in menu name */ |
345 strdup_and_add_accel (char *name) | 319 |
346 { | 320 Lisp_Object |
347 int i; | 321 menu_name_to_accelerator (char *name) |
348 int found_accel = 0; | 322 { |
349 | 323 while (*name) { |
350 for (i=0; name[i]; ++i) | 324 if (*name=='%') { |
351 if (name[i] == '%' && name[i+1] == '_') | 325 ++name; |
352 { | 326 if (!(*name)) |
353 found_accel = 1; | 327 return Qnil; |
354 break; | 328 if (*name=='_' && *(name+1)) |
355 } | 329 { |
356 | 330 int accelerator = (int) (unsigned char) (*(name+1)); |
357 if (found_accel) | 331 return make_char (tolower (accelerator)); |
358 return xstrdup (name); | 332 } |
359 else | 333 } |
360 { | 334 ++name; |
361 char *chars = (char *) alloca (strlen (name) + 3); | 335 } |
362 chars[0] = '%'; | 336 return Qnil; |
363 chars[1] = '_'; | |
364 memcpy (chars+2, name, strlen (name) + 1); | |
365 return xstrdup (chars); | |
366 } | |
367 } | 337 } |
368 | 338 |
369 /* This does the dirty work. gc_currently_forbidden is 1 when this is called. | 339 /* This does the dirty work. gc_currently_forbidden is 1 when this is called. |
370 */ | 340 */ |
341 | |
371 int | 342 int |
372 button_item_to_widget_value (Lisp_Object gui_object_instance, | 343 button_item_to_widget_value (Lisp_Object desc, widget_value *wv, |
373 Lisp_Object gui_item, widget_value *wv, | 344 int allow_text_field_p, int no_keys_p) |
374 int allow_text_field_p, int no_keys_p, | |
375 int menu_entry_p) | |
376 { | 345 { |
377 /* !!#### This function has not been Mule-ized */ | 346 /* !!#### This function has not been Mule-ized */ |
378 /* This function cannot GC because gc_currently_forbidden is set when | 347 /* This function cannot GC because gc_currently_forbidden is set when |
379 it's called */ | 348 it's called */ |
380 Lisp_Gui_Item* pgui = 0; | 349 Lisp_Object name = Qnil; |
381 | 350 Lisp_Object callback = Qnil; |
382 /* degenerate case */ | 351 Lisp_Object suffix = Qnil; |
383 if (STRINGP (gui_item)) | 352 Lisp_Object active_p = Qt; |
384 { | 353 Lisp_Object include_p = Qt; |
385 wv->type = TEXT_TYPE; | 354 Lisp_Object selected_p = Qnil; |
386 wv->name = (char *) XSTRING_DATA (gui_item); | 355 Lisp_Object keys = Qnil; |
387 wv->name = strdup_and_add_accel (wv->name); | 356 Lisp_Object style = Qnil; |
388 return 1; | 357 Lisp_Object config_tag = Qnil; |
389 } | 358 Lisp_Object accel = Qnil; |
390 else if (!GUI_ITEMP (gui_item)) | 359 int length = XVECTOR_LENGTH (desc); |
391 signal_simple_error("need a string or a gui_item here", gui_item); | 360 Lisp_Object *contents = XVECTOR_DATA (desc); |
392 | 361 int plist_p; |
393 pgui = XGUI_ITEM (gui_item); | 362 int selected_spec = 0, included_spec = 0; |
394 | 363 |
395 if (!NILP (pgui->filter)) | 364 if (length < 2) |
396 signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item); | 365 signal_simple_error ("Button descriptors must be at least 2 long", desc); |
366 | |
367 /* length 2: [ "name" callback ] | |
368 length 3: [ "name" callback active-p ] | |
369 length 4: [ "name" callback active-p suffix ] | |
370 or [ "name" callback keyword value ] | |
371 length 5+: [ "name" callback [ keyword value ]+ ] | |
372 */ | |
373 plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); | |
374 | |
375 if (!plist_p && length > 2) | |
376 /* the old way */ | |
377 { | |
378 name = contents [0]; | |
379 callback = contents [1]; | |
380 active_p = contents [2]; | |
381 if (length == 4) | |
382 suffix = contents [3]; | |
383 } | |
384 else | |
385 { | |
386 /* the new way */ | |
387 int i; | |
388 if (length & 1) | |
389 signal_simple_error ( | |
390 "Button descriptor has an odd number of keywords and values", | |
391 desc); | |
392 | |
393 name = contents [0]; | |
394 callback = contents [1]; | |
395 for (i = 2; i < length;) | |
396 { | |
397 Lisp_Object key = contents [i++]; | |
398 Lisp_Object val = contents [i++]; | |
399 if (!KEYWORDP (key)) | |
400 signal_simple_error_2 ("Not a keyword", key, desc); | |
401 | |
402 if (EQ (key, Q_active)) active_p = val; | |
403 else if (EQ (key, Q_suffix)) suffix = val; | |
404 else if (EQ (key, Q_keys)) keys = val; | |
405 else if (EQ (key, Q_style)) style = val; | |
406 else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; | |
407 else if (EQ (key, Q_included)) include_p = val, included_spec = 1; | |
408 else if (EQ (key, Q_config)) config_tag = val; | |
409 else if (EQ (key, Q_accelerator)) | |
410 { | |
411 if ( SYMBOLP (val) | |
412 || CHARP (val)) | |
413 accel = val; | |
414 else | |
415 signal_simple_error ("Bad keyboard accelerator", val); | |
416 } | |
417 else if (EQ (key, Q_filter)) | |
418 signal_simple_error(":filter keyword not permitted on leaf nodes", desc); | |
419 else | |
420 signal_simple_error_2 ("Unknown menu item keyword", key, desc); | |
421 } | |
422 } | |
397 | 423 |
398 #ifdef HAVE_MENUBARS | 424 #ifdef HAVE_MENUBARS |
399 if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration)) | 425 if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) |
426 || (included_spec && NILP (Feval (include_p)))) | |
400 { | 427 { |
401 /* the include specification says to ignore this item. */ | 428 /* the include specification says to ignore this item. */ |
402 return 0; | 429 return 0; |
403 } | 430 } |
404 #endif /* HAVE_MENUBARS */ | 431 #endif /* HAVE_MENUBARS */ |
405 | 432 |
406 if (!STRINGP (pgui->name)) | 433 CHECK_STRING (name); |
407 pgui->name = Feval (pgui->name); | 434 wv->name = (char *) XSTRING_DATA (name); |
408 | 435 |
409 CHECK_STRING (pgui->name); | 436 if (NILP (accel)) |
410 wv->name = (char *) XSTRING_DATA (pgui->name); | 437 accel = menu_name_to_accelerator (wv->name); |
411 wv->name = xstrdup (wv->name); | 438 wv->accel = LISP_TO_VOID (accel); |
412 wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item)); | 439 |
413 | 440 if (!NILP (suffix)) |
414 if (!NILP (pgui->suffix)) | 441 { |
415 { | 442 CONST char *const_bogosity; |
416 const char *const_bogosity; | |
417 Lisp_Object suffix2; | 443 Lisp_Object suffix2; |
418 | 444 |
419 /* Shortcut to avoid evaluating suffix each time */ | 445 /* Shortcut to avoid evaluating suffix each time */ |
420 if (STRINGP (pgui->suffix)) | 446 if (STRINGP (suffix)) |
421 suffix2 = pgui->suffix; | 447 suffix2 = suffix; |
422 else | 448 else |
423 { | 449 { |
424 suffix2 = Feval (pgui->suffix); | 450 suffix2 = Feval (suffix); |
425 CHECK_STRING (suffix2); | 451 CHECK_STRING (suffix2); |
426 } | 452 } |
427 | 453 |
428 TO_EXTERNAL_FORMAT (LISP_STRING, suffix2, | 454 GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity); |
429 C_STRING_ALLOCA, const_bogosity, | |
430 Qfile_name); | |
431 wv->value = (char *) const_bogosity; | 455 wv->value = (char *) const_bogosity; |
432 wv->value = xstrdup (wv->value); | 456 wv->value = xstrdup (wv->value); |
433 } | 457 } |
434 | 458 |
435 wv_set_evalable_slot (wv->enabled, pgui->active); | 459 wv_set_evalable_slot (wv->enabled, active_p); |
436 wv_set_evalable_slot (wv->selected, pgui->selected); | 460 wv_set_evalable_slot (wv->selected, selected_p); |
437 | 461 |
438 if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) | 462 wv->call_data = LISP_TO_VOID (callback); |
439 wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, | |
440 pgui->callback, | |
441 pgui->callback_ex)); | |
442 | 463 |
443 if (no_keys_p | 464 if (no_keys_p |
444 #ifdef HAVE_MENUBARS | 465 #ifdef HAVE_MENUBARS |
445 || (menu_entry_p && !menubar_show_keybindings) | 466 || !menubar_show_keybindings |
446 #endif | 467 #endif |
447 ) | 468 ) |
448 wv->key = 0; | 469 wv->key = 0; |
449 else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */ | 470 else if (!NILP (keys)) /* Use this string to generate key bindings */ |
450 { | 471 { |
451 CHECK_STRING (pgui->keys); | 472 CHECK_STRING (keys); |
452 pgui->keys = Fsubstitute_command_keys (pgui->keys); | 473 keys = Fsubstitute_command_keys (keys); |
453 if (XSTRING_LENGTH (pgui->keys) > 0) | 474 if (XSTRING_LENGTH (keys) > 0) |
454 wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys)); | 475 wv->key = xstrdup ((char *) XSTRING_DATA (keys)); |
455 else | 476 else |
456 wv->key = 0; | 477 wv->key = 0; |
457 } | 478 } |
458 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */ | 479 else if (SYMBOLP (callback)) /* Show the binding of this command. */ |
459 { | 480 { |
460 char buf[1024]; /* #### */ | 481 char buf [1024]; |
461 /* #### Warning, dependency here on current_buffer and point */ | 482 /* #### Warning, dependency here on current_buffer and point */ |
462 where_is_to_char (pgui->callback, buf); | 483 where_is_to_char (callback, buf); |
463 if (buf [0]) | 484 if (buf [0]) |
464 wv->key = xstrdup (buf); | 485 wv->key = xstrdup (buf); |
465 else | 486 else |
466 wv->key = 0; | 487 wv->key = 0; |
467 } | 488 } |
468 | 489 |
469 CHECK_SYMBOL (pgui->style); | 490 CHECK_SYMBOL (style); |
470 if (NILP (pgui->style)) | 491 if (NILP (style)) |
471 { | 492 { |
472 /* If the callback is nil, treat this item like unselectable text. | 493 /* If the callback is nil, treat this item like unselectable text. |
473 This way, dashes will show up as a separator. */ | 494 This way, dashes will show up as a separator. */ |
474 if (!wv->enabled) | 495 if (!wv->enabled) |
475 wv->type = BUTTON_TYPE; | 496 wv->type = BUTTON_TYPE; |
492 else | 513 else |
493 #endif | 514 #endif |
494 wv->type = BUTTON_TYPE; | 515 wv->type = BUTTON_TYPE; |
495 } | 516 } |
496 } | 517 } |
497 else if (EQ (pgui->style, Qbutton)) | 518 else if (EQ (style, Qbutton)) |
498 wv->type = BUTTON_TYPE; | 519 wv->type = BUTTON_TYPE; |
499 else if (EQ (pgui->style, Qtoggle)) | 520 else if (EQ (style, Qtoggle)) |
500 wv->type = TOGGLE_TYPE; | 521 wv->type = TOGGLE_TYPE; |
501 else if (EQ (pgui->style, Qradio)) | 522 else if (EQ (style, Qradio)) |
502 wv->type = RADIO_TYPE; | 523 wv->type = RADIO_TYPE; |
503 else if (EQ (pgui->style, Qtext)) | 524 else if (EQ (style, Qtext)) |
504 { | 525 { |
505 wv->type = TEXT_TYPE; | 526 wv->type = TEXT_TYPE; |
506 #if 0 | 527 #if 0 |
507 wv->value = wv->name; | 528 wv->value = wv->name; |
508 wv->name = "value"; | 529 wv->name = "value"; |
509 #endif | 530 #endif |
510 } | 531 } |
511 else | 532 else |
512 signal_simple_error_2 ("Unknown style", pgui->style, gui_item); | 533 signal_simple_error_2 ("Unknown style", style, desc); |
513 | 534 |
514 if (!allow_text_field_p && (wv->type == TEXT_TYPE)) | 535 if (!allow_text_field_p && (wv->type == TEXT_TYPE)) |
515 signal_simple_error ("Text field not allowed in this context", gui_item); | 536 signal_simple_error ("Text field not allowed in this context", desc); |
516 | 537 |
517 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext)) | 538 if (selected_spec && EQ (style, Qtext)) |
518 signal_simple_error ( | 539 signal_simple_error ( |
519 ":selected only makes sense with :style toggle, radio or button", | 540 ":selected only makes sense with :style toggle, radio or button", |
520 gui_item); | 541 desc); |
521 return 1; | 542 return 1; |
522 } | 543 } |
523 | 544 |
524 /* parse tree's of gui items into widget_value hierarchies */ | 545 #endif /* HAVE_POPUPS */ |
525 static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, | |
526 Lisp_Object items, | |
527 widget_value* parent); | |
528 | |
529 static widget_value * | |
530 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, | |
531 Lisp_Object items, widget_value* parent, | |
532 widget_value* prev) | |
533 { | |
534 widget_value* wv = 0; | |
535 | |
536 assert ((parent || prev) && !(parent && prev)); | |
537 /* now walk the tree creating widget_values as appropriate */ | |
538 if (!CONSP (items)) | |
539 { | |
540 wv = xmalloc_widget_value(); | |
541 if (parent) | |
542 parent->contents = wv; | |
543 else | |
544 prev->next = wv; | |
545 if (!button_item_to_widget_value (gui_object_instance, | |
546 items, wv, 0, 1, 0)) | |
547 { | |
548 free_widget_value_tree (wv); | |
549 if (parent) | |
550 parent->contents = 0; | |
551 else | |
552 prev->next = 0; | |
553 } | |
554 else | |
555 { | |
556 wv->value = xstrdup (wv->name); /* what a mess... */ | |
557 } | |
558 } | |
559 else | |
560 { | |
561 /* first one is the parent */ | |
562 if (CONSP (XCAR (items))) | |
563 signal_simple_error ("parent item must not be a list", XCAR (items)); | |
564 | |
565 if (parent) | |
566 wv = gui_items_to_widget_values_1 (gui_object_instance, | |
567 XCAR (items), parent, 0); | |
568 else | |
569 wv = gui_items_to_widget_values_1 (gui_object_instance, | |
570 XCAR (items), 0, prev); | |
571 /* the rest are the children */ | |
572 gui_item_children_to_widget_values (gui_object_instance, | |
573 XCDR (items), wv); | |
574 } | |
575 return wv; | |
576 } | |
577 | |
578 static void | |
579 gui_item_children_to_widget_values (Lisp_Object gui_object_instance, | |
580 Lisp_Object items, widget_value* parent) | |
581 { | |
582 widget_value* wv = 0, *prev = 0; | |
583 Lisp_Object rest; | |
584 CHECK_CONS (items); | |
585 | |
586 /* first one is master */ | |
587 prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items), | |
588 parent, 0); | |
589 /* the rest are the children */ | |
590 LIST_LOOP (rest, XCDR (items)) | |
591 { | |
592 Lisp_Object tab = XCAR (rest); | |
593 wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev); | |
594 prev = wv; | |
595 } | |
596 } | |
597 | |
598 widget_value * | |
599 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items) | |
600 { | |
601 /* !!#### This function has not been Mule-ized */ | |
602 /* This function can GC */ | |
603 widget_value *control = 0, *tmp = 0; | |
604 int count = specpdl_depth (); | |
605 Lisp_Object wv_closure; | |
606 | |
607 if (NILP (items)) | |
608 signal_simple_error ("must have some items", items); | |
609 | |
610 /* Inhibit GC during this conversion. The reasons for this are | |
611 the same as in menu_item_descriptor_to_widget_value(); see | |
612 the large comment above that function. */ | |
613 record_unwind_protect (restore_gc_inhibit, | |
614 make_int (gc_currently_forbidden)); | |
615 gc_currently_forbidden = 1; | |
616 | |
617 /* Also make sure that we free the partially-created widget_value | |
618 tree on Lisp error. */ | |
619 control = xmalloc_widget_value(); | |
620 wv_closure = make_opaque_ptr (control); | |
621 record_unwind_protect (widget_value_unwind, wv_closure); | |
622 | |
623 gui_items_to_widget_values_1 (gui_object_instance, items, control, 0); | |
624 | |
625 /* mess about getting the data we really want */ | |
626 tmp = control; | |
627 control = control->contents; | |
628 tmp->next = 0; | |
629 tmp->contents = 0; | |
630 free_widget_value_tree (tmp); | |
631 | |
632 /* No more need to free the half-filled-in structures. */ | |
633 set_opaque_ptr (wv_closure, 0); | |
634 unbind_to (count, Qnil); | |
635 | |
636 return control; | |
637 } | |
638 | 546 |
639 /* This is a kludge to make sure emacs can only link against a version of | 547 /* This is a kludge to make sure emacs can only link against a version of |
640 lwlib that was compiled in the right way. Emacs references symbols which | 548 lwlib that was compiled in the right way. Emacs references symbols which |
641 correspond to the way it thinks lwlib was compiled, and if lwlib wasn't | 549 correspond to the way it thinks lwlib was compiled, and if lwlib wasn't |
642 compiled in that way, then somewhat meaningful link errors will result. | 550 compiled in that way, then somewhat meaningful link errors will result. |
683 #ifdef LWLIB_DIALOGS_MOTIF | 591 #ifdef LWLIB_DIALOGS_MOTIF |
684 MACROLET (lwlib_dialogs_motif); | 592 MACROLET (lwlib_dialogs_motif); |
685 #elif defined (HAVE_DIALOGS) | 593 #elif defined (HAVE_DIALOGS) |
686 MACROLET (lwlib_dialogs_athena); | 594 MACROLET (lwlib_dialogs_athena); |
687 #endif | 595 #endif |
688 #ifdef LWLIB_WIDGETS_MOTIF | |
689 MACROLET (lwlib_widgets_motif); | |
690 #elif defined (HAVE_WIDGETS) | |
691 MACROLET (lwlib_widgets_athena); | |
692 #endif | |
693 | 596 |
694 #undef MACROLET | 597 #undef MACROLET |
695 } | 598 } |
696 | 599 |
697 void | 600 void |
698 syms_of_gui_x (void) | 601 syms_of_gui_x (void) |
699 { | 602 { |
700 INIT_LRECORD_IMPLEMENTATION (popup_data); | 603 #ifdef HAVE_POPUPS |
701 | |
702 defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); | 604 defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); |
605 #endif | |
703 } | 606 } |
704 | 607 |
705 void | 608 void |
706 reinit_vars_of_gui_x (void) | 609 vars_of_gui_x (void) |
707 { | 610 { |
708 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ | 611 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ |
612 | |
709 #ifdef HAVE_POPUPS | 613 #ifdef HAVE_POPUPS |
710 popup_up_p = 0; | 614 popup_up_p = 0; |
711 #endif | |
712 | |
713 /* this makes only safe calls as in emacs.c */ | |
714 sanity_check_lwlib (); | |
715 } | |
716 | |
717 void | |
718 vars_of_gui_x (void) | |
719 { | |
720 reinit_vars_of_gui_x (); | |
721 | 615 |
722 Vpopup_callbacks = Qnil; | 616 Vpopup_callbacks = Qnil; |
723 staticpro (&Vpopup_callbacks); | 617 staticpro (&Vpopup_callbacks); |
724 | 618 |
725 #if 0 | 619 #if 0 |
729 Function or functions to call when a menu or dialog box is dismissed | 623 Function or functions to call when a menu or dialog box is dismissed |
730 without a selection having been made. | 624 without a selection having been made. |
731 */ ); | 625 */ ); |
732 #endif | 626 #endif |
733 Fset (Qmenu_no_selection_hook, Qnil); | 627 Fset (Qmenu_no_selection_hook, Qnil); |
734 } | 628 #endif /* HAVE_POPUPS */ |
629 | |
630 /* this makes only safe calls as in emacs.c */ | |
631 sanity_check_lwlib (); | |
632 } |