Move with-no-threads inside the let body block.
[emacs.git] / lwlib / lwlib-Xaw.c
blob2af44cd2e1d8d89c626065c9ff4c3490328cabf8
1 /* The lwlib interface to Athena widgets.
2 Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu>
3 Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of the Lucid Widget Library.
8 The Lucid Widget Library is free software; you can redistribute it and/or
9 modify it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 1, or (at your option)
11 any later version.
13 The Lucid Widget Library 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 GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
27 #include <stdio.h>
28 #include <setjmp.h>
30 #include "../src/lisp.h"
32 #include "lwlib-Xaw.h"
34 #include <X11/StringDefs.h>
35 #include <X11/IntrinsicP.h>
36 #include <X11/CoreP.h>
37 #include <X11/Shell.h>
39 #ifdef HAVE_XAW3D
40 #include <X11/Xaw3d/Scrollbar.h>
41 #include <X11/Xaw3d/Paned.h>
42 #include <X11/Xaw3d/Dialog.h>
43 #include <X11/Xaw3d/Form.h>
44 #include <X11/Xaw3d/Command.h>
45 #include <X11/Xaw3d/Label.h>
46 #else /* !HAVE_XAW3D */
47 #include <X11/Xaw/Scrollbar.h>
48 #include <X11/Xaw/Paned.h>
49 #include <X11/Xaw/Dialog.h>
50 #include <X11/Xaw/Form.h>
51 #include <X11/Xaw/Command.h>
52 #include <X11/Xaw/Label.h>
53 #endif /* HAVE_XAW3D */
55 #include <X11/Xatom.h>
57 static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/);
60 Boolean
61 lw_xaw_widget_p (widget)
62 Widget widget;
64 return (XtIsSubclass (widget, scrollbarWidgetClass) ||
65 XtIsSubclass (widget, dialogWidgetClass));
68 #if 0
69 static void
70 xaw_update_scrollbar (instance, widget, val)
71 widget_instance *instance;
72 Widget widget;
73 widget_value *val;
75 if (val->scrollbar_data)
77 scrollbar_values *data = val->scrollbar_data;
78 Dimension height, width;
79 Dimension pos_x, pos_y;
80 int widget_shown, widget_topOfThumb;
81 float new_shown, new_topOfThumb;
83 XtVaGetValues (widget,
84 XtNheight, &height,
85 XtNwidth, &width,
86 XtNx, &pos_x,
87 XtNy, &pos_y,
88 XtNtopOfThumb, &widget_topOfThumb,
89 XtNshown, &widget_shown,
90 NULL);
93 * First size and position the scrollbar widget.
94 * We need to position it to second-guess the Paned widget's notion
95 * of what should happen when the WMShell gets resized.
97 if (height != data->scrollbar_height || pos_y != data->scrollbar_pos)
99 XtConfigureWidget (widget, pos_x, data->scrollbar_pos,
100 width, data->scrollbar_height, 0);
102 XtVaSetValues (widget,
103 XtNlength, data->scrollbar_height,
104 XtNthickness, width,
105 NULL);
109 * Now the size the scrollbar's slider.
111 new_shown = (float) data->slider_size /
112 (float) (data->maximum - data->minimum);
114 new_topOfThumb = (float) (data->slider_position - data->minimum) /
115 (float) (data->maximum - data->minimum);
117 if (new_shown > 1.0)
118 new_shown = 1.0;
119 if (new_shown < 0)
120 new_shown = 0;
122 if (new_topOfThumb > 1.0)
123 new_topOfThumb = 1.0;
124 if (new_topOfThumb < 0)
125 new_topOfThumb = 0;
127 if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb)
128 XawScrollbarSetThumb (widget, new_topOfThumb, new_shown);
131 #endif
133 void
134 #ifdef PROTOTYPES
135 xaw_update_one_widget (widget_instance *instance, Widget widget,
136 widget_value *val, Boolean deep_p)
137 #else
138 xaw_update_one_widget (instance, widget, val, deep_p)
139 widget_instance *instance;
140 Widget widget;
141 widget_value *val;
142 Boolean deep_p;
143 #endif
145 #if 0
146 if (XtIsSubclass (widget, scrollbarWidgetClass))
148 xaw_update_scrollbar (instance, widget, val);
150 #endif
151 if (XtIsSubclass (widget, dialogWidgetClass))
153 Arg al[1];
154 int ac = 0;
155 XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
156 XtSetValues (widget, al, ac);
158 else if (XtIsSubclass (widget, commandWidgetClass))
160 Dimension bw = 0;
161 Arg al[3];
163 XtVaGetValues (widget, XtNborderWidth, &bw, NULL);
164 if (bw == 0)
165 /* Don't let buttons end up with 0 borderwidth, that's ugly...
166 Yeah, all this should really be done through app-defaults files
167 or fallback resources, but that's a whole different can of worms
168 that I don't feel like opening right now. Making Athena widgets
169 not look like shit is just entirely too much work.
172 XtSetArg (al[0], XtNborderWidth, 1);
173 XtSetValues (widget, al, 1);
176 XtSetSensitive (widget, val->enabled);
177 XtSetArg (al[0], XtNlabel, val->value);
178 /* Force centered button text. Se above. */
179 XtSetArg (al[1], XtNjustify, XtJustifyCenter);
180 XtSetValues (widget, al, 2);
181 XtRemoveAllCallbacks (widget, XtNcallback);
182 XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance);
186 void
187 xaw_update_one_value (instance, widget, val)
188 widget_instance *instance;
189 Widget widget;
190 widget_value *val;
192 /* This function is not used by the scrollbars and those are the only
193 Athena widget implemented at the moment so do nothing. */
194 return;
197 void
198 xaw_destroy_instance (instance)
199 widget_instance *instance;
201 if (XtIsSubclass (instance->widget, dialogWidgetClass))
202 /* Need to destroy the Shell too. */
203 XtDestroyWidget (XtParent (instance->widget));
204 else
205 XtDestroyWidget (instance->widget);
208 void
209 xaw_popup_menu (widget, event)
210 Widget widget;
211 XEvent *event;
213 /* An Athena menubar has not been implemented. */
214 return;
217 void
218 #ifdef PROTOTYPES
219 xaw_pop_instance (widget_instance *instance, Boolean up)
220 #else
221 xaw_pop_instance (instance, up)
222 widget_instance *instance;
223 Boolean up;
224 #endif
226 Widget widget = instance->widget;
228 if (up)
230 if (XtIsSubclass (widget, dialogWidgetClass))
232 /* For dialogs, we need to call XtPopup on the parent instead
233 of calling XtManageChild on the widget.
234 Also we need to hack the shell's WM_PROTOCOLS to get it to
235 understand what the close box is supposed to do!!
237 Display *dpy = XtDisplay (widget);
238 Widget shell = XtParent (widget);
239 Atom props [2];
240 int i = 0;
241 props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False);
242 XChangeProperty (dpy, XtWindow (shell),
243 XInternAtom (dpy, "WM_PROTOCOLS", False),
244 XA_ATOM, 32, PropModeAppend,
245 (unsigned char *) props, i);
247 /* Center the widget in its parent. Why isn't this kind of crap
248 done automatically? I thought toolkits were supposed to make
249 life easier?
252 unsigned int x, y, w, h;
253 Widget topmost = instance->parent;
254 Arg args[2];
256 w = shell->core.width;
257 h = shell->core.height;
258 while (topmost->core.parent && XtIsRealized (topmost->core.parent))
259 topmost = topmost->core.parent;
260 if (topmost->core.width < w) x = topmost->core.x;
261 else x = topmost->core.x + ((topmost->core.width - w) / 2);
262 if (topmost->core.height < h) y = topmost->core.y;
263 else y = topmost->core.y + ((topmost->core.height - h) / 2);
264 /* Using XtMoveWidget caused the widget to come
265 out in the wrong place with vtwm.
266 Question of virtual vs real coords, perhaps. */
267 XtSetArg (args[0], XtNx, x);
268 XtSetArg (args[1], XtNy, y);
269 XtSetValues (shell, args, 2);
272 /* Finally, pop it up. */
273 XtPopup (shell, XtGrabNonexclusive);
275 else
276 XtManageChild (widget);
278 else
280 if (XtIsSubclass (widget, dialogWidgetClass))
281 XtUnmanageChild (XtParent (widget));
282 else
283 XtUnmanageChild (widget);
288 /* Dialog boxes */
290 static char overrideTrans[] =
291 "<Message>WM_PROTOCOLS: lwlib_delete_dialog()";
292 /* Dialogs pop down on any key press */
293 static char dialogOverride[] =
294 "<KeyPress>Escape: lwlib_delete_dialog()";
295 static void wm_delete_window();
296 static XtActionsRec xaw_actions [] = {
297 {"lwlib_delete_dialog", wm_delete_window}
299 static Boolean actions_initted = False;
301 static Widget
302 make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons)
303 char* name;
304 Widget parent;
305 Boolean pop_up_p;
306 char* shell_title;
307 char* icon_name;
308 Boolean text_input_slot;
309 Boolean radio_box;
310 Boolean list;
311 int left_buttons;
312 int right_buttons;
314 Arg av [20];
315 int ac = 0;
316 int i, bc;
317 char button_name [255];
318 Widget shell;
319 Widget dialog;
320 Widget button;
321 XtTranslations override;
323 if (! pop_up_p) abort (); /* not implemented */
324 if (text_input_slot) abort (); /* not implemented */
325 if (radio_box) abort (); /* not implemented */
326 if (list) abort (); /* not implemented */
328 if (! actions_initted)
330 XtAppContext app = XtWidgetToApplicationContext (parent);
331 XtAppAddActions (app, xaw_actions,
332 sizeof (xaw_actions) / sizeof (xaw_actions[0]));
333 actions_initted = True;
336 override = XtParseTranslationTable (overrideTrans);
338 ac = 0;
339 XtSetArg (av[ac], XtNtitle, shell_title); ac++;
340 XtSetArg (av[ac], XtNallowShellResize, True); ac++;
342 /* Don't allow any geometry request from the user. */
343 XtSetArg (av[ac], XtNgeometry, 0); ac++;
345 shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
346 parent, av, ac);
347 XtOverrideTranslations (shell, override);
349 ac = 0;
350 dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
351 override = XtParseTranslationTable (dialogOverride);
352 XtOverrideTranslations (dialog, override);
354 bc = 0;
355 button = 0;
356 for (i = 0; i < left_buttons; i++)
358 ac = 0;
359 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
360 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
361 XtSetArg (av [ac], XtNright, XtChainLeft); ac++;
362 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
363 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
364 XtSetArg (av [ac], XtNresizable, True); ac++;
365 sprintf (button_name, "button%d", ++bc);
366 button = XtCreateManagedWidget (button_name, commandWidgetClass,
367 dialog, av, ac);
369 if (right_buttons)
371 /* Create a separator
373 I want the separator to take up the slack between the buttons on
374 the right and the buttons on the left (that is I want the buttons
375 after the separator to be packed against the right edge of the
376 window) but I can't seem to make it do it.
378 ac = 0;
379 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
380 /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */
381 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
382 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
383 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
384 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
385 XtSetArg (av [ac], XtNlabel, ""); ac++;
386 XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */
387 XtSetArg (av [ac], XtNborderWidth, 0); ac++;
388 XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++;
389 XtSetArg (av [ac], XtNresizable, False); ac++;
390 XtSetArg (av [ac], XtNsensitive, False); ac++;
391 button = XtCreateManagedWidget ("separator",
392 /* labelWidgetClass, */
393 /* This has to be Command to fake out
394 the Dialog widget... */
395 commandWidgetClass,
396 dialog, av, ac);
398 for (i = 0; i < right_buttons; i++)
400 ac = 0;
401 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
402 XtSetArg (av [ac], XtNleft, XtChainRight); ac++;
403 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
404 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
405 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
406 XtSetArg (av [ac], XtNresizable, True); ac++;
407 sprintf (button_name, "button%d", ++bc);
408 button = XtCreateManagedWidget (button_name, commandWidgetClass,
409 dialog, av, ac);
412 return dialog;
415 Widget
416 xaw_create_dialog (instance)
417 widget_instance* instance;
419 char *name = instance->info->type;
420 Widget parent = instance->parent;
421 Widget widget;
422 Boolean pop_up_p = instance->pop_up_p;
423 char *shell_name = 0;
424 char *icon_name = 0;
425 Boolean text_input_slot = False;
426 Boolean radio_box = False;
427 Boolean list = False;
428 int total_buttons;
429 int left_buttons = 0;
430 int right_buttons = 1;
432 switch (name [0]) {
433 case 'E': case 'e':
434 icon_name = "dbox-error";
435 shell_name = "Error";
436 break;
438 case 'I': case 'i':
439 icon_name = "dbox-info";
440 shell_name = "Information";
441 break;
443 case 'L': case 'l':
444 list = True;
445 icon_name = "dbox-question";
446 shell_name = "Prompt";
447 break;
449 case 'P': case 'p':
450 text_input_slot = True;
451 icon_name = "dbox-question";
452 shell_name = "Prompt";
453 break;
455 case 'Q': case 'q':
456 icon_name = "dbox-question";
457 shell_name = "Question";
458 break;
461 total_buttons = name [1] - '0';
463 if (name [3] == 'T' || name [3] == 't')
465 text_input_slot = False;
466 radio_box = True;
468 else if (name [3])
469 right_buttons = name [4] - '0';
471 left_buttons = total_buttons - right_buttons;
473 widget = make_dialog (name, parent, pop_up_p,
474 shell_name, icon_name, text_input_slot, radio_box,
475 list, left_buttons, right_buttons);
477 return widget;
481 static void
482 xaw_generic_callback (widget, closure, call_data)
483 Widget widget;
484 XtPointer closure;
485 XtPointer call_data;
487 widget_instance *instance = (widget_instance *) closure;
488 Widget instance_widget;
489 LWLIB_ID id;
490 XtPointer user_data;
492 lw_internal_update_other_instances (widget, closure, call_data);
494 if (! instance)
495 return;
496 if (widget->core.being_destroyed)
497 return;
499 instance_widget = instance->widget;
500 if (!instance_widget)
501 return;
503 id = instance->info->id;
505 #if 0
506 user_data = NULL;
507 XtVaGetValues (widget, XtNuserData, &user_data, NULL);
508 #else
509 /* Damn! Athena doesn't give us a way to hang our own data on the
510 buttons, so we have to go find it... I guess this assumes that
511 all instances of a button have the same call data. */
513 widget_value *val = instance->info->val->contents;
514 char *name = XtName (widget);
515 while (val)
517 if (val->name && !strcmp (val->name, name))
518 break;
519 val = val->next;
521 if (! val) abort ();
522 user_data = val->call_data;
524 #endif
526 if (instance->info->selection_cb)
527 instance->info->selection_cb (widget, id, user_data);
530 static void
531 wm_delete_window (w, closure, call_data)
532 Widget w;
533 XtPointer closure;
534 XtPointer call_data;
536 LWLIB_ID id;
537 Cardinal nkids;
538 int i;
539 Widget *kids = 0;
540 Widget widget, shell;
542 if (XtIsSubclass (w, dialogWidgetClass))
543 shell = XtParent (w);
544 else
545 shell = w;
547 if (! XtIsSubclass (shell, shellWidgetClass))
548 abort ();
549 XtVaGetValues (shell, XtNnumChildren, &nkids, NULL);
550 XtVaGetValues (shell, XtNchildren, &kids, NULL);
551 if (!kids || !*kids)
552 abort ();
553 for (i = 0; i < nkids; i++)
555 widget = kids[i];
556 if (XtIsSubclass (widget, dialogWidgetClass))
557 break;
559 id = lw_get_widget_id (widget);
560 if (! id) abort ();
563 widget_info *info = lw_get_widget_info (id);
564 if (! info) abort ();
565 if (info->selection_cb)
566 info->selection_cb (widget, id, (XtPointer) -1);
569 lw_destroy_all_widgets (id);
573 /* Scrollbars */
575 #if 0
576 static void
577 xaw_scrollbar_scroll (widget, closure, call_data)
578 Widget widget;
579 XtPointer closure;
580 XtPointer call_data;
582 widget_instance *instance = (widget_instance *) closure;
583 LWLIB_ID id;
584 scroll_event event_data;
586 if (!instance || widget->core.being_destroyed)
587 return;
589 id = instance->info->id;
590 event_data.slider_value = 0;
591 event_data.time = 0;
593 if ((int) call_data > 0)
594 event_data.action = SCROLLBAR_PAGE_DOWN;
595 else
596 event_data.action = SCROLLBAR_PAGE_UP;
598 if (instance->info->pre_activate_cb)
599 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
601 #endif
603 #if 0
604 static void
605 xaw_scrollbar_jump (widget, closure, call_data)
606 Widget widget;
607 XtPointer closure;
608 XtPointer call_data;
610 widget_instance *instance = (widget_instance *) closure;
611 LWLIB_ID id;
612 scroll_event event_data;
613 scrollbar_values *val =
614 (scrollbar_values *) instance->info->val->scrollbar_data;
615 float percent;
617 if (!instance || widget->core.being_destroyed)
618 return;
620 id = instance->info->id;
622 percent = * (float *) call_data;
623 event_data.slider_value =
624 (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum;
626 event_data.time = 0;
627 event_data.action = SCROLLBAR_DRAG;
629 if (instance->info->pre_activate_cb)
630 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
632 #endif
634 static Widget
635 xaw_create_scrollbar (instance)
636 widget_instance *instance;
638 #if 0
639 Arg av[20];
640 int ac = 0;
641 Dimension width;
642 Widget scrollbar;
644 XtVaGetValues (instance->parent, XtNwidth, &width, NULL);
646 XtSetArg (av[ac], XtNshowGrip, 0); ac++;
647 XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++;
648 XtSetArg (av[ac], XtNallowResize, True); ac++;
649 XtSetArg (av[ac], XtNskipAdjust, True); ac++;
650 XtSetArg (av[ac], XtNwidth, width); ac++;
651 XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++;
653 scrollbar =
654 XtCreateWidget (instance->info->name, scrollbarWidgetClass,
655 instance->parent, av, ac);
657 /* We have to force the border width to be 0 otherwise the
658 geometry manager likes to start looping for awhile... */
659 XtVaSetValues (scrollbar, XtNborderWidth, 0, NULL);
661 XtRemoveAllCallbacks (scrollbar, "jumpProc");
662 XtRemoveAllCallbacks (scrollbar, "scrollProc");
664 XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump,
665 (XtPointer) instance);
666 XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll,
667 (XtPointer) instance);
669 return scrollbar;
670 #else
671 return NULL;
672 #endif
675 static Widget
676 xaw_create_main (instance)
677 widget_instance *instance;
679 Arg al[1];
680 int ac;
682 /* Create a vertical Paned to hold menubar */
683 ac = 0;
684 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
685 return XtCreateWidget (instance->info->name, panedWidgetClass,
686 instance->parent, al, ac);
689 widget_creation_entry
690 xaw_creation_table [] =
692 {"scrollbar", xaw_create_scrollbar},
693 {"main", xaw_create_main},
694 {NULL, NULL}
697 /* arch-tag: fbbd3589-ae1c-41a0-9142-f628cfee6564
698 (do not change this comment) */