Update node listing.
[emacs.git] / lwlib / lwlib-Xaw.c
blobbe1990ed6fe67b8a2396852be4d6643737017946
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 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>
29 #include "../src/lisp.h"
31 #include "lwlib-Xaw.h"
33 #include <X11/StringDefs.h>
34 #include <X11/IntrinsicP.h>
35 #include <X11/CoreP.h>
36 #include <X11/Shell.h>
38 #include <X11/Xaw/Scrollbar.h>
39 #include <X11/Xaw/Paned.h>
40 #include <X11/Xaw/Dialog.h>
41 #include <X11/Xaw/Form.h>
42 #include <X11/Xaw/Command.h>
43 #include <X11/Xaw/Label.h>
45 #include <X11/Xatom.h>
47 static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/);
50 Boolean
51 lw_xaw_widget_p (widget)
52 Widget widget;
54 return (XtIsSubclass (widget, scrollbarWidgetClass) ||
55 XtIsSubclass (widget, dialogWidgetClass));
58 #if 0
59 static void
60 xaw_update_scrollbar (instance, widget, val)
61 widget_instance *instance;
62 Widget widget;
63 widget_value *val;
65 if (val->scrollbar_data)
67 scrollbar_values *data = val->scrollbar_data;
68 Dimension height, width;
69 Dimension pos_x, pos_y;
70 int widget_shown, widget_topOfThumb;
71 float new_shown, new_topOfThumb;
73 XtVaGetValues (widget,
74 XtNheight, &height,
75 XtNwidth, &width,
76 XtNx, &pos_x,
77 XtNy, &pos_y,
78 XtNtopOfThumb, &widget_topOfThumb,
79 XtNshown, &widget_shown,
80 NULL);
83 * First size and position the scrollbar widget.
84 * We need to position it to second-guess the Paned widget's notion
85 * of what should happen when the WMShell gets resized.
87 if (height != data->scrollbar_height || pos_y != data->scrollbar_pos)
89 XtConfigureWidget (widget, pos_x, data->scrollbar_pos,
90 width, data->scrollbar_height, 0);
92 XtVaSetValues (widget,
93 XtNlength, data->scrollbar_height,
94 XtNthickness, width,
95 NULL);
99 * Now the size the scrollbar's slider.
101 new_shown = (float) data->slider_size /
102 (float) (data->maximum - data->minimum);
104 new_topOfThumb = (float) (data->slider_position - data->minimum) /
105 (float) (data->maximum - data->minimum);
107 if (new_shown > 1.0)
108 new_shown = 1.0;
109 if (new_shown < 0)
110 new_shown = 0;
112 if (new_topOfThumb > 1.0)
113 new_topOfThumb = 1.0;
114 if (new_topOfThumb < 0)
115 new_topOfThumb = 0;
117 if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb)
118 XawScrollbarSetThumb (widget, new_topOfThumb, new_shown);
121 #endif
123 void
124 #ifdef PROTOTYPES
125 xaw_update_one_widget (widget_instance *instance, Widget widget,
126 widget_value *val, Boolean deep_p)
127 #else
128 xaw_update_one_widget (instance, widget, val, deep_p)
129 widget_instance *instance;
130 Widget widget;
131 widget_value *val;
132 Boolean deep_p;
133 #endif
135 #if 0
136 if (XtIsSubclass (widget, scrollbarWidgetClass))
138 xaw_update_scrollbar (instance, widget, val);
140 #endif
141 if (XtIsSubclass (widget, dialogWidgetClass))
143 Arg al[1];
144 int ac = 0;
145 XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
146 XtSetValues (widget, al, ac);
148 else if (XtIsSubclass (widget, commandWidgetClass))
150 Dimension bw = 0;
151 Arg al[3];
153 XtVaGetValues (widget, XtNborderWidth, &bw, NULL);
154 if (bw == 0)
155 /* Don't let buttons end up with 0 borderwidth, that's ugly...
156 Yeah, all this should really be done through app-defaults files
157 or fallback resources, but that's a whole different can of worms
158 that I don't feel like opening right now. Making Athena widgets
159 not look like shit is just entirely too much work.
162 XtSetArg (al[0], XtNborderWidth, 1);
163 XtSetValues (widget, al, 1);
166 XtSetSensitive (widget, val->enabled);
167 XtSetArg (al[0], XtNlabel, val->value);
168 /* Force centered button text. Se above. */
169 XtSetArg (al[1], XtNjustify, XtJustifyCenter);
170 XtSetValues (widget, al, 2);
171 XtRemoveAllCallbacks (widget, XtNcallback);
172 XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance);
176 void
177 xaw_update_one_value (instance, widget, val)
178 widget_instance *instance;
179 Widget widget;
180 widget_value *val;
182 /* This function is not used by the scrollbars and those are the only
183 Athena widget implemented at the moment so do nothing. */
184 return;
187 void
188 xaw_destroy_instance (instance)
189 widget_instance *instance;
191 if (XtIsSubclass (instance->widget, dialogWidgetClass))
192 /* Need to destroy the Shell too. */
193 XtDestroyWidget (XtParent (instance->widget));
194 else
195 XtDestroyWidget (instance->widget);
198 void
199 xaw_popup_menu (widget, event)
200 Widget widget;
201 XEvent *event;
203 /* An Athena menubar has not been implemented. */
204 return;
207 void
208 #ifdef PROTOTYPES
209 xaw_pop_instance (widget_instance *instance, Boolean up)
210 #else
211 xaw_pop_instance (instance, up)
212 widget_instance *instance;
213 Boolean up;
214 #endif
216 Widget widget = instance->widget;
218 if (up)
220 if (XtIsSubclass (widget, dialogWidgetClass))
222 /* For dialogs, we need to call XtPopup on the parent instead
223 of calling XtManageChild on the widget.
224 Also we need to hack the shell's WM_PROTOCOLS to get it to
225 understand what the close box is supposed to do!!
227 Display *dpy = XtDisplay (widget);
228 Widget shell = XtParent (widget);
229 Atom props [2];
230 int i = 0;
231 props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False);
232 XChangeProperty (dpy, XtWindow (shell),
233 XInternAtom (dpy, "WM_PROTOCOLS", False),
234 XA_ATOM, 32, PropModeAppend,
235 (unsigned char *) props, i);
237 /* Center the widget in its parent. Why isn't this kind of crap
238 done automatically? I thought toolkits were supposed to make
239 life easier?
242 unsigned int x, y, w, h;
243 Widget topmost = instance->parent;
244 Arg args[2];
246 w = shell->core.width;
247 h = shell->core.height;
248 while (topmost->core.parent && XtIsRealized (topmost->core.parent))
249 topmost = topmost->core.parent;
250 if (topmost->core.width < w) x = topmost->core.x;
251 else x = topmost->core.x + ((topmost->core.width - w) / 2);
252 if (topmost->core.height < h) y = topmost->core.y;
253 else y = topmost->core.y + ((topmost->core.height - h) / 2);
254 /* Using XtMoveWidget caused the widget to come
255 out in the wrong place with vtwm.
256 Question of virtual vs real coords, perhaps. */
257 XtSetArg (args[0], XtNx, x);
258 XtSetArg (args[1], XtNy, y);
259 XtSetValues (shell, args, 2);
262 /* Finally, pop it up. */
263 XtPopup (shell, XtGrabNonexclusive);
265 else
266 XtManageChild (widget);
268 else
270 if (XtIsSubclass (widget, dialogWidgetClass))
271 XtUnmanageChild (XtParent (widget));
272 else
273 XtUnmanageChild (widget);
278 /* Dialog boxes */
280 static char overrideTrans[] =
281 "<Message>WM_PROTOCOLS: lwlib_delete_dialog()";
282 /* Dialogs pop down on any key press */
283 static char dialogOverride[] =
284 "<KeyPress>Escape: lwlib_delete_dialog()";
285 static void wm_delete_window();
286 static XtActionsRec xaw_actions [] = {
287 {"lwlib_delete_dialog", wm_delete_window}
289 static Boolean actions_initted = False;
291 static Widget
292 make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons)
293 char* name;
294 Widget parent;
295 Boolean pop_up_p;
296 char* shell_title;
297 char* icon_name;
298 Boolean text_input_slot;
299 Boolean radio_box;
300 Boolean list;
301 int left_buttons;
302 int right_buttons;
304 Arg av [20];
305 int ac = 0;
306 int i, bc;
307 char button_name [255];
308 Widget shell;
309 Widget dialog;
310 Widget button;
311 XtTranslations override;
313 if (! pop_up_p) abort (); /* not implemented */
314 if (text_input_slot) abort (); /* not implemented */
315 if (radio_box) abort (); /* not implemented */
316 if (list) abort (); /* not implemented */
318 if (! actions_initted)
320 XtAppContext app = XtWidgetToApplicationContext (parent);
321 XtAppAddActions (app, xaw_actions,
322 sizeof (xaw_actions) / sizeof (xaw_actions[0]));
323 actions_initted = True;
326 override = XtParseTranslationTable (overrideTrans);
328 ac = 0;
329 XtSetArg (av[ac], XtNtitle, shell_title); ac++;
330 XtSetArg (av[ac], XtNallowShellResize, True); ac++;
332 /* Don't allow any geometry request from the user. */
333 XtSetArg (av[ac], XtNgeometry, 0); ac++;
335 shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
336 parent, av, ac);
337 XtOverrideTranslations (shell, override);
339 ac = 0;
340 dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
341 override = XtParseTranslationTable (dialogOverride);
342 XtOverrideTranslations (dialog, override);
344 bc = 0;
345 button = 0;
346 for (i = 0; i < left_buttons; i++)
348 ac = 0;
349 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
350 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
351 XtSetArg (av [ac], XtNright, XtChainLeft); ac++;
352 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
353 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
354 XtSetArg (av [ac], XtNresizable, True); ac++;
355 sprintf (button_name, "button%d", ++bc);
356 button = XtCreateManagedWidget (button_name, commandWidgetClass,
357 dialog, av, ac);
359 if (right_buttons)
361 /* Create a separator
363 I want the separator to take up the slack between the buttons on
364 the right and the buttons on the left (that is I want the buttons
365 after the separator to be packed against the right edge of the
366 window) but I can't seem to make it do it.
368 ac = 0;
369 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
370 /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */
371 XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
372 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
373 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
374 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
375 XtSetArg (av [ac], XtNlabel, ""); ac++;
376 XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */
377 XtSetArg (av [ac], XtNborderWidth, 0); ac++;
378 XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++;
379 XtSetArg (av [ac], XtNresizable, False); ac++;
380 XtSetArg (av [ac], XtNsensitive, False); ac++;
381 button = XtCreateManagedWidget ("separator",
382 /* labelWidgetClass, */
383 /* This has to be Command to fake out
384 the Dialog widget... */
385 commandWidgetClass,
386 dialog, av, ac);
388 for (i = 0; i < right_buttons; i++)
390 ac = 0;
391 XtSetArg (av [ac], XtNfromHoriz, button); ac++;
392 XtSetArg (av [ac], XtNleft, XtChainRight); ac++;
393 XtSetArg (av [ac], XtNright, XtChainRight); ac++;
394 XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
395 XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
396 XtSetArg (av [ac], XtNresizable, True); ac++;
397 sprintf (button_name, "button%d", ++bc);
398 button = XtCreateManagedWidget (button_name, commandWidgetClass,
399 dialog, av, ac);
402 return dialog;
405 Widget
406 xaw_create_dialog (instance)
407 widget_instance* instance;
409 char *name = instance->info->type;
410 Widget parent = instance->parent;
411 Widget widget;
412 Boolean pop_up_p = instance->pop_up_p;
413 char *shell_name = 0;
414 char *icon_name = 0;
415 Boolean text_input_slot = False;
416 Boolean radio_box = False;
417 Boolean list = False;
418 int total_buttons;
419 int left_buttons = 0;
420 int right_buttons = 1;
422 switch (name [0]) {
423 case 'E': case 'e':
424 icon_name = "dbox-error";
425 shell_name = "Error";
426 break;
428 case 'I': case 'i':
429 icon_name = "dbox-info";
430 shell_name = "Information";
431 break;
433 case 'L': case 'l':
434 list = True;
435 icon_name = "dbox-question";
436 shell_name = "Prompt";
437 break;
439 case 'P': case 'p':
440 text_input_slot = True;
441 icon_name = "dbox-question";
442 shell_name = "Prompt";
443 break;
445 case 'Q': case 'q':
446 icon_name = "dbox-question";
447 shell_name = "Question";
448 break;
451 total_buttons = name [1] - '0';
453 if (name [3] == 'T' || name [3] == 't')
455 text_input_slot = False;
456 radio_box = True;
458 else if (name [3])
459 right_buttons = name [4] - '0';
461 left_buttons = total_buttons - right_buttons;
463 widget = make_dialog (name, parent, pop_up_p,
464 shell_name, icon_name, text_input_slot, radio_box,
465 list, left_buttons, right_buttons);
467 return widget;
471 static void
472 xaw_generic_callback (widget, closure, call_data)
473 Widget widget;
474 XtPointer closure;
475 XtPointer call_data;
477 widget_instance *instance = (widget_instance *) closure;
478 Widget instance_widget;
479 LWLIB_ID id;
480 XtPointer user_data;
482 lw_internal_update_other_instances (widget, closure, call_data);
484 if (! instance)
485 return;
486 if (widget->core.being_destroyed)
487 return;
489 instance_widget = instance->widget;
490 if (!instance_widget)
491 return;
493 id = instance->info->id;
495 #if 0
496 user_data = NULL;
497 XtVaGetValues (widget, XtNuserData, &user_data, NULL);
498 #else
499 /* Damn! Athena doesn't give us a way to hang our own data on the
500 buttons, so we have to go find it... I guess this assumes that
501 all instances of a button have the same call data. */
503 widget_value *val = instance->info->val->contents;
504 char *name = XtName (widget);
505 while (val)
507 if (val->name && !strcmp (val->name, name))
508 break;
509 val = val->next;
511 if (! val) abort ();
512 user_data = val->call_data;
514 #endif
516 if (instance->info->selection_cb)
517 instance->info->selection_cb (widget, id, user_data);
520 static void
521 wm_delete_window (w, closure, call_data)
522 Widget w;
523 XtPointer closure;
524 XtPointer call_data;
526 LWLIB_ID id;
527 Cardinal nkids;
528 int i;
529 Widget *kids = 0;
530 Widget widget, shell;
532 if (XtIsSubclass (w, dialogWidgetClass))
533 shell = XtParent (w);
534 else
535 shell = w;
537 if (! XtIsSubclass (shell, shellWidgetClass))
538 abort ();
539 XtVaGetValues (shell, XtNnumChildren, &nkids, NULL);
540 XtVaGetValues (shell, XtNchildren, &kids, NULL);
541 if (!kids || !*kids)
542 abort ();
543 for (i = 0; i < nkids; i++)
545 widget = kids[i];
546 if (XtIsSubclass (widget, dialogWidgetClass))
547 break;
549 id = lw_get_widget_id (widget);
550 if (! id) abort ();
553 widget_info *info = lw_get_widget_info (id);
554 if (! info) abort ();
555 if (info->selection_cb)
556 info->selection_cb (widget, id, (XtPointer) -1);
559 lw_destroy_all_widgets (id);
563 /* Scrollbars */
565 #if 0
566 static void
567 xaw_scrollbar_scroll (widget, closure, call_data)
568 Widget widget;
569 XtPointer closure;
570 XtPointer call_data;
572 widget_instance *instance = (widget_instance *) closure;
573 LWLIB_ID id;
574 scroll_event event_data;
576 if (!instance || widget->core.being_destroyed)
577 return;
579 id = instance->info->id;
580 event_data.slider_value = 0;
581 event_data.time = 0;
583 if ((int) call_data > 0)
584 event_data.action = SCROLLBAR_PAGE_DOWN;
585 else
586 event_data.action = SCROLLBAR_PAGE_UP;
588 if (instance->info->pre_activate_cb)
589 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
591 #endif
593 #if 0
594 static void
595 xaw_scrollbar_jump (widget, closure, call_data)
596 Widget widget;
597 XtPointer closure;
598 XtPointer call_data;
600 widget_instance *instance = (widget_instance *) closure;
601 LWLIB_ID id;
602 scroll_event event_data;
603 scrollbar_values *val =
604 (scrollbar_values *) instance->info->val->scrollbar_data;
605 float percent;
607 if (!instance || widget->core.being_destroyed)
608 return;
610 id = instance->info->id;
612 percent = * (float *) call_data;
613 event_data.slider_value =
614 (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum;
616 event_data.time = 0;
617 event_data.action = SCROLLBAR_DRAG;
619 if (instance->info->pre_activate_cb)
620 instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
622 #endif
624 static Widget
625 xaw_create_scrollbar (instance)
626 widget_instance *instance;
628 #if 0
629 Arg av[20];
630 int ac = 0;
631 Dimension width;
632 Widget scrollbar;
634 XtVaGetValues (instance->parent, XtNwidth, &width, NULL);
636 XtSetArg (av[ac], XtNshowGrip, 0); ac++;
637 XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++;
638 XtSetArg (av[ac], XtNallowResize, True); ac++;
639 XtSetArg (av[ac], XtNskipAdjust, True); ac++;
640 XtSetArg (av[ac], XtNwidth, width); ac++;
641 XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++;
643 scrollbar =
644 XtCreateWidget (instance->info->name, scrollbarWidgetClass,
645 instance->parent, av, ac);
647 /* We have to force the border width to be 0 otherwise the
648 geometry manager likes to start looping for awhile... */
649 XtVaSetValues (scrollbar, XtNborderWidth, 0, NULL);
651 XtRemoveAllCallbacks (scrollbar, "jumpProc");
652 XtRemoveAllCallbacks (scrollbar, "scrollProc");
654 XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump,
655 (XtPointer) instance);
656 XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll,
657 (XtPointer) instance);
659 return scrollbar;
660 #else
661 return NULL;
662 #endif
665 static Widget
666 xaw_create_main (instance)
667 widget_instance *instance;
669 Arg al[1];
670 int ac;
672 /* Create a vertical Paned to hold menubar */
673 ac = 0;
674 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
675 return XtCreateWidget (instance->info->name, panedWidgetClass,
676 instance->parent, al, ac);
679 widget_creation_entry
680 xaw_creation_table [] =
682 {"scrollbar", xaw_create_scrollbar},
683 {"main", xaw_create_main},
684 {NULL, NULL}
687 /* arch-tag: fbbd3589-ae1c-41a0-9142-f628cfee6564
688 (do not change this comment) */