(jka-compr-install): Use push and dolist.
[emacs.git] / lwlib / lwlib-Xaw.c
blob1369ed26f72e8f67095f702ceb81ff5f75bfbe14
1 /* The lwlib interface to Athena widgets.
2 Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu>
4 This file is part of the Lucid Widget Library.
6 The Lucid Widget Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
11 The Lucid Widget Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
21 #ifdef HAVE_CONFIG_H
22 #include <config.h>
23 #endif
25 #include <stdio.h>
27 #include "../src/lisp.h"
29 #include "lwlib-Xaw.h"
31 #include <X11/StringDefs.h>
32 #include <X11/IntrinsicP.h>
33 #include <X11/CoreP.h>
34 #include <X11/Shell.h>
36 #include <X11/Xaw/Scrollbar.h>
37 #include <X11/Xaw/Paned.h>
38 #include <X11/Xaw/Dialog.h>
39 #include <X11/Xaw/Form.h>
40 #include <X11/Xaw/Command.h>
41 #include <X11/Xaw/Label.h>
43 #include <X11/Xatom.h>
45 static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/);
48 Boolean
49 lw_xaw_widget_p (widget)
50 Widget widget;
52 return (XtIsSubclass (widget, scrollbarWidgetClass) ||
53 XtIsSubclass (widget, dialogWidgetClass));
56 #if 0
57 static void
58 xaw_update_scrollbar (instance, widget, val)
59 widget_instance *instance;
60 Widget widget;
61 widget_value *val;
63 if (val->scrollbar_data)
65 scrollbar_values *data = val->scrollbar_data;
66 Dimension height, width;
67 Dimension pos_x, pos_y;
68 int widget_shown, widget_topOfThumb;
69 float new_shown, new_topOfThumb;
71 XtVaGetValues (widget,
72 XtNheight, &height,
73 XtNwidth, &width,
74 XtNx, &pos_x,
75 XtNy, &pos_y,
76 XtNtopOfThumb, &widget_topOfThumb,
77 XtNshown, &widget_shown,
78 NULL);
81 * First size and position the scrollbar widget.
82 * We need to position it to second-guess the Paned widget's notion
83 * of what should happen when the WMShell gets resized.
85 if (height != data->scrollbar_height || pos_y != data->scrollbar_pos)
87 XtConfigureWidget (widget, pos_x, data->scrollbar_pos,
88 width, data->scrollbar_height, 0);
90 XtVaSetValues (widget,
91 XtNlength, data->scrollbar_height,
92 XtNthickness, width,
93 NULL);
97 * Now the size the scrollbar's slider.
99 new_shown = (float) data->slider_size /
100 (float) (data->maximum - data->minimum);
102 new_topOfThumb = (float) (data->slider_position - data->minimum) /
103 (float) (data->maximum - data->minimum);
105 if (new_shown > 1.0)
106 new_shown = 1.0;
107 if (new_shown < 0)
108 new_shown = 0;
110 if (new_topOfThumb > 1.0)
111 new_topOfThumb = 1.0;
112 if (new_topOfThumb < 0)
113 new_topOfThumb = 0;
115 if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb)
116 XawScrollbarSetThumb (widget, new_topOfThumb, new_shown);
119 #endif
121 void
122 #ifdef PROTOTYPES
123 xaw_update_one_widget (widget_instance *instance, Widget widget,
124 widget_value *val, Boolean deep_p)
125 #else
126 xaw_update_one_widget (instance, widget, val, deep_p)
127 widget_instance *instance;
128 Widget widget;
129 widget_value *val;
130 Boolean deep_p;
131 #endif
133 #if 0
134 if (XtIsSubclass (widget, scrollbarWidgetClass))
136 xaw_update_scrollbar (instance, widget, val);
138 #endif
139 if (XtIsSubclass (widget, dialogWidgetClass))
141 Arg al[1];
142 int ac = 0;
143 XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
144 XtSetValues (widget, al, ac);
146 else if (XtIsSubclass (widget, commandWidgetClass))
148 Dimension bw = 0;
149 Arg al[3];
151 XtVaGetValues (widget, XtNborderWidth, &bw, NULL);
152 if (bw == 0)
153 /* Don't let buttons end up with 0 borderwidth, that's ugly...
154 Yeah, all this should really be done through app-defaults files
155 or fallback resources, but that's a whole different can of worms
156 that I don't feel like opening right now. Making Athena widgets
157 not look like shit is just entirely too much work.
160 XtSetArg (al[0], XtNborderWidth, 1);
161 XtSetValues (widget, al, 1);
164 XtSetSensitive (widget, val->enabled);
165 XtSetArg (al[0], XtNlabel, val->value);
166 /* Force centered button text. Se above. */
167 XtSetArg (al[1], XtNjustify, XtJustifyCenter);
168 XtSetValues (widget, al, 2);
169 XtRemoveAllCallbacks (widget, XtNcallback);
170 XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance);
174 void
175 xaw_update_one_value (instance, widget, val)
176 widget_instance *instance;
177 Widget widget;
178 widget_value *val;
180 /* This function is not used by the scrollbars and those are the only
181 Athena widget implemented at the moment so do nothing. */
182 return;
185 void
186 xaw_destroy_instance (instance)
187 widget_instance *instance;
189 if (XtIsSubclass (instance->widget, dialogWidgetClass))
190 /* Need to destroy the Shell too. */
191 XtDestroyWidget (XtParent (instance->widget));
192 else
193 XtDestroyWidget (instance->widget);
196 void
197 xaw_popup_menu (widget, event)
198 Widget widget;
199 XEvent *event;
201 /* An Athena menubar has not been implemented. */
202 return;
205 void
206 #ifdef PROTOTYPES
207 xaw_pop_instance (widget_instance *instance, Boolean up)
208 #else
209 xaw_pop_instance (instance, up)
210 widget_instance *instance;
211 Boolean up;
212 #endif
214 Widget widget = instance->widget;
216 if (up)
218 if (XtIsSubclass (widget, dialogWidgetClass))
220 /* For dialogs, we need to call XtPopup on the parent instead
221 of calling XtManageChild on the widget.
222 Also we need to hack the shell's WM_PROTOCOLS to get it to
223 understand what the close box is supposed to do!!
225 Display *dpy = XtDisplay (widget);
226 Widget shell = XtParent (widget);
227 Atom props [2];
228 int i = 0;
229 props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False);
230 XChangeProperty (dpy, XtWindow (shell),
231 XInternAtom (dpy, "WM_PROTOCOLS", False),
232 XA_ATOM, 32, PropModeAppend,
233 (unsigned char *) props, i);
235 /* Center the widget in its parent. Why isn't this kind of crap
236 done automatically? I thought toolkits were supposed to make
237 life easier?
240 unsigned int x, y, w, h;
241 Widget topmost = instance->parent;
242 Arg args[2];
244 w = shell->core.width;
245 h = shell->core.height;
246 while (topmost->core.parent && XtIsRealized (topmost->core.parent))
247 topmost = topmost->core.parent;
248 if (topmost->core.width < w) x = topmost->core.x;
249 else x = topmost->core.x + ((topmost->core.width - w) / 2);
250 if (topmost->core.height < h) y = topmost->core.y;
251 else y = topmost->core.y + ((topmost->core.height - h) / 2);
252 /* Using XtMoveWidget caused the widget to come
253 out in the wrong place with vtwm.
254 Question of virtual vs real coords, perhaps. */
255 XtSetArg (args[0], XtNx, x);
256 XtSetArg (args[1], XtNy, y);
257 XtSetValues (shell, args, 2);
260 /* Finally, pop it up. */
261 XtPopup (shell, XtGrabNonexclusive);
263 else
264 XtManageChild (widget);
266 else
268 if (XtIsSubclass (widget, dialogWidgetClass))
269 XtUnmanageChild (XtParent (widget));
270 else
271 XtUnmanageChild (widget);
276 /* Dialog boxes */
278 static char overrideTrans[] =
279 "<Message>WM_PROTOCOLS: lwlib_delete_dialog()";
280 /* Dialogs pop down on any key press */
281 static char dialogOverride[] =
282 "<KeyPress>Escape: lwlib_delete_dialog()";
283 static void wm_delete_window();
284 static XtActionsRec xaw_actions [] = {
285 {"lwlib_delete_dialog", wm_delete_window}
287 static Boolean actions_initted = False;
289 static Widget
290 make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons)
291 char* name;
292 Widget parent;
293 Boolean pop_up_p;
294 char* shell_title;
295 char* icon_name;
296 Boolean text_input_slot;
297 Boolean radio_box;
298 Boolean list;
299 int left_buttons;
300 int right_buttons;
302 Arg av [20];
303 int ac = 0;
304 int i, bc;
305 char button_name [255];
306 Widget shell;
307 Widget dialog;
308 Widget button;
309 XtTranslations override;
311 if (! pop_up_p) abort (); /* not implemented */
312 if (text_input_slot) abort (); /* not implemented */
313 if (radio_box) abort (); /* not implemented */
314 if (list) abort (); /* not implemented */
316 if (! actions_initted)
318 XtAppContext app = XtWidgetToApplicationContext (parent);
319 XtAppAddActions (app, xaw_actions,
320 sizeof (xaw_actions) / sizeof (xaw_actions[0]));
321 actions_initted = True;
324 override = XtParseTranslationTable (overrideTrans);
326 ac = 0;
327 XtSetArg (av[ac], XtNtitle, shell_title); ac++;
328 XtSetArg (av[ac], XtNallowShellResize, True); ac++;
330 /* Don't allow any geometry request from the user. */
331 XtSetArg (av[ac], XtNgeometry, 0); ac++;
333 shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
334 parent, av, ac);
335 XtOverrideTranslations (shell, override);
337 ac = 0;
338 dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
339 override = XtParseTranslationTable (dialogOverride);
340 XtOverrideTranslations (dialog, override);
342 bc = 0;
343 button = 0;
344 for (i = 0; i < left_buttons; i++)
346 ac = 0;
347 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
348 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
349 XtSetArg (av [ac], XtNright, XtChainLeft); ac++;
350 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
351 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
352 XtSetArg (av [ac], XtNresizable, True); ac++;
353 sprintf (button_name, "button%d", ++bc);
354 button = XtCreateManagedWidget (button_name, commandWidgetClass,
355 dialog, av, ac);
357 if (right_buttons)
359 /* Create a separator
361 I want the separator to take up the slack between the buttons on
362 the right and the buttons on the left (that is I want the buttons
363 after the separator to be packed against the right edge of the
364 window) but I can't seem to make it do it.
366 ac = 0;
367 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
368 /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */
369 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
370 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
371 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
372 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
373 XtSetArg (av [ac], XtNlabel, ""); ac++;
374 XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */
375 XtSetArg (av [ac], XtNborderWidth, 0); ac++;
376 XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++;
377 XtSetArg (av [ac], XtNresizable, False); ac++;
378 XtSetArg (av [ac], XtNsensitive, False); ac++;
379 button = XtCreateManagedWidget ("separator",
380 /* labelWidgetClass, */
381 /* This has to be Command to fake out
382 the Dialog widget... */
383 commandWidgetClass,
384 dialog, av, ac);
386 for (i = 0; i < right_buttons; i++)
388 ac = 0;
389 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
390 XtSetArg (av [ac], XtNleft, XtChainRight); ac++;
391 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
392 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
393 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
394 XtSetArg (av [ac], XtNresizable, True); ac++;
395 sprintf (button_name, "button%d", ++bc);
396 button = XtCreateManagedWidget (button_name, commandWidgetClass,
397 dialog, av, ac);
400 return dialog;
403 Widget
404 xaw_create_dialog (instance)
405 widget_instance* instance;
407 char *name = instance->info->type;
408 Widget parent = instance->parent;
409 Widget widget;
410 Boolean pop_up_p = instance->pop_up_p;
411 char *shell_name = 0;
412 char *icon_name = 0;
413 Boolean text_input_slot = False;
414 Boolean radio_box = False;
415 Boolean list = False;
416 int total_buttons;
417 int left_buttons = 0;
418 int right_buttons = 1;
420 switch (name [0]) {
421 case 'E': case 'e':
422 icon_name = "dbox-error";
423 shell_name = "Error";
424 break;
426 case 'I': case 'i':
427 icon_name = "dbox-info";
428 shell_name = "Information";
429 break;
431 case 'L': case 'l':
432 list = True;
433 icon_name = "dbox-question";
434 shell_name = "Prompt";
435 break;
437 case 'P': case 'p':
438 text_input_slot = True;
439 icon_name = "dbox-question";
440 shell_name = "Prompt";
441 break;
443 case 'Q': case 'q':
444 icon_name = "dbox-question";
445 shell_name = "Question";
446 break;
449 total_buttons = name [1] - '0';
451 if (name [3] == 'T' || name [3] == 't')
453 text_input_slot = False;
454 radio_box = True;
456 else if (name [3])
457 right_buttons = name [4] - '0';
459 left_buttons = total_buttons - right_buttons;
461 widget = make_dialog (name, parent, pop_up_p,
462 shell_name, icon_name, text_input_slot, radio_box,
463 list, left_buttons, right_buttons);
465 return widget;
469 static void
470 xaw_generic_callback (widget, closure, call_data)
471 Widget widget;
472 XtPointer closure;
473 XtPointer call_data;
475 widget_instance *instance = (widget_instance *) closure;
476 Widget instance_widget;
477 LWLIB_ID id;
478 XtPointer user_data;
480 lw_internal_update_other_instances (widget, closure, call_data);
482 if (! instance)
483 return;
484 if (widget->core.being_destroyed)
485 return;
487 instance_widget = instance->widget;
488 if (!instance_widget)
489 return;
491 id = instance->info->id;
493 #if 0
494 user_data = NULL;
495 XtVaGetValues (widget, XtNuserData, &user_data, NULL);
496 #else
497 /* Damn! Athena doesn't give us a way to hang our own data on the
498 buttons, so we have to go find it... I guess this assumes that
499 all instances of a button have the same call data. */
501 widget_value *val = instance->info->val->contents;
502 char *name = XtName (widget);
503 while (val)
505 if (val->name && !strcmp (val->name, name))
506 break;
507 val = val->next;
509 if (! val) abort ();
510 user_data = val->call_data;
512 #endif
514 if (instance->info->selection_cb)
515 instance->info->selection_cb (widget, id, user_data);
518 static void
519 wm_delete_window (w, closure, call_data)
520 Widget w;
521 XtPointer closure;
522 XtPointer call_data;
524 LWLIB_ID id;
525 Cardinal nkids;
526 int i;
527 Widget *kids = 0;
528 Widget widget, shell;
530 if (XtIsSubclass (w, dialogWidgetClass))
531 shell = XtParent (w);
532 else
533 shell = w;
535 if (! XtIsSubclass (shell, shellWidgetClass))
536 abort ();
537 XtVaGetValues (shell, XtNnumChildren, &nkids, NULL);
538 XtVaGetValues (shell, XtNchildren, &kids, NULL);
539 if (!kids || !*kids)
540 abort ();
541 for (i = 0; i < nkids; i++)
543 widget = kids[i];
544 if (XtIsSubclass (widget, dialogWidgetClass))
545 break;
547 id = lw_get_widget_id (widget);
548 if (! id) abort ();
551 widget_info *info = lw_get_widget_info (id);
552 if (! info) abort ();
553 if (info->selection_cb)
554 info->selection_cb (widget, id, (XtPointer) -1);
557 lw_destroy_all_widgets (id);
561 /* Scrollbars */
563 #if 0
564 static void
565 xaw_scrollbar_scroll (widget, closure, call_data)
566 Widget widget;
567 XtPointer closure;
568 XtPointer call_data;
570 widget_instance *instance = (widget_instance *) closure;
571 LWLIB_ID id;
572 scroll_event event_data;
574 if (!instance || widget->core.being_destroyed)
575 return;
577 id = instance->info->id;
578 event_data.slider_value = 0;
579 event_data.time = 0;
581 if ((int) call_data > 0)
582 event_data.action = SCROLLBAR_PAGE_DOWN;
583 else
584 event_data.action = SCROLLBAR_PAGE_UP;
586 if (instance->info->pre_activate_cb)
587 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
589 #endif
591 #if 0
592 static void
593 xaw_scrollbar_jump (widget, closure, call_data)
594 Widget widget;
595 XtPointer closure;
596 XtPointer call_data;
598 widget_instance *instance = (widget_instance *) closure;
599 LWLIB_ID id;
600 scroll_event event_data;
601 scrollbar_values *val =
602 (scrollbar_values *) instance->info->val->scrollbar_data;
603 float percent;
605 if (!instance || widget->core.being_destroyed)
606 return;
608 id = instance->info->id;
610 percent = * (float *) call_data;
611 event_data.slider_value =
612 (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum;
614 event_data.time = 0;
615 event_data.action = SCROLLBAR_DRAG;
617 if (instance->info->pre_activate_cb)
618 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
620 #endif
622 static Widget
623 xaw_create_scrollbar (instance)
624 widget_instance *instance;
626 #if 0
627 Arg av[20];
628 int ac = 0;
629 Dimension width;
630 Widget scrollbar;
632 XtVaGetValues (instance->parent, XtNwidth, &width, NULL);
634 XtSetArg (av[ac], XtNshowGrip, 0); ac++;
635 XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++;
636 XtSetArg (av[ac], XtNallowResize, True); ac++;
637 XtSetArg (av[ac], XtNskipAdjust, True); ac++;
638 XtSetArg (av[ac], XtNwidth, width); ac++;
639 XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++;
641 scrollbar =
642 XtCreateWidget (instance->info->name, scrollbarWidgetClass,
643 instance->parent, av, ac);
645 /* We have to force the border width to be 0 otherwise the
646 geometry manager likes to start looping for awhile... */
647 XtVaSetValues (scrollbar, XtNborderWidth, 0, NULL);
649 XtRemoveAllCallbacks (scrollbar, "jumpProc");
650 XtRemoveAllCallbacks (scrollbar, "scrollProc");
652 XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump,
653 (XtPointer) instance);
654 XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll,
655 (XtPointer) instance);
657 return scrollbar;
658 #else
659 return NULL;
660 #endif
663 static Widget
664 xaw_create_main (instance)
665 widget_instance *instance;
667 Arg al[1];
668 int ac;
670 /* Create a vertical Paned to hold menubar */
671 ac = 0;
672 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
673 return XtCreateWidget (instance->info->name, panedWidgetClass,
674 instance->parent, al, ac);
677 widget_creation_entry
678 xaw_creation_table [] =
680 {"scrollbar", xaw_create_scrollbar},
681 {"main", xaw_create_main},
682 {NULL, NULL}
685 /* arch-tag: fbbd3589-ae1c-41a0-9142-f628cfee6564
686 (do not change this comment) */