root/trunk/lwlib/lwlib-Xaw.c

Revision 4220, 17.9 kB (checked in by miyoshi, 6 months ago)

Sync up with Emacs22.2.

  • Property svn:eol-style set to native
Line 
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 Free Software Foundation, Inc.
5
6 This file is part of the Lucid Widget Library.
7
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.
12
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.
17
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.  */
22
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26
27 #include <stdio.h>
28
29 #include "../src/lisp.h"
30
31 #include "lwlib-Xaw.h"
32
33 #include <X11/StringDefs.h>
34 #include <X11/IntrinsicP.h>
35 #include <X11/CoreP.h>
36 #include <X11/Shell.h>
37
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>
44
45 #include <X11/Xatom.h>
46
47 static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/);
48
49
50 Boolean
51 lw_xaw_widget_p (widget)
52      Widget widget;
53 {
54   return (XtIsSubclass (widget, scrollbarWidgetClass) ||
55           XtIsSubclass (widget, dialogWidgetClass));
56 }
57
58 #if 0
59 static void
60 xaw_update_scrollbar (instance, widget, val)
61      widget_instance *instance;
62      Widget widget;
63      widget_value *val;
64 {
65   if (val->scrollbar_data)
66     {
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;
72
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);
81
82       /*
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.
86        */
87       if (height != data->scrollbar_height || pos_y != data->scrollbar_pos)
88         {
89           XtConfigureWidget (widget, pos_x, data->scrollbar_pos,
90                              width, data->scrollbar_height, 0);
91
92           XtVaSetValues (widget,
93                          XtNlength, data->scrollbar_height,
94                          XtNthickness, width,
95                          NULL);
96         }
97
98       /*
99        * Now the size the scrollbar's slider.
100        */
101       new_shown = (float) data->slider_size /
102         (float) (data->maximum - data->minimum);
103
104       new_topOfThumb = (float) (data->slider_position - data->minimum) /
105         (float) (data->maximum - data->minimum);
106
107       if (new_shown > 1.0)
108         new_shown = 1.0;
109       if (new_shown < 0)
110         new_shown = 0;
111
112       if (new_topOfThumb > 1.0)
113         new_topOfThumb = 1.0;
114       if (new_topOfThumb < 0)
115         new_topOfThumb = 0;
116
117       if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb)
118         XawScrollbarSetThumb (widget, new_topOfThumb, new_shown);
119     }
120 }
121 #endif
122
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
134 {
135 #if 0
136   if (XtIsSubclass (widget, scrollbarWidgetClass))
137     {
138       xaw_update_scrollbar (instance, widget, val);
139     }
140 #endif
141   if (XtIsSubclass (widget, dialogWidgetClass))
142     {
143       Arg al[1];
144       int ac = 0;
145       XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
146       XtSetValues (widget,  al, ac);
147     }
148   else if (XtIsSubclass (widget, commandWidgetClass))
149     {
150       Dimension bw = 0;
151       Arg al[3];
152
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.
160          */
161         {
162           XtSetArg (al[0], XtNborderWidth, 1);
163           XtSetValues (widget, al, 1);
164         }
165
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);
173     }
174 }
175
176 void
177 xaw_update_one_value (instance, widget, val)
178      widget_instance *instance;
179      Widget widget;
180      widget_value *val;
181 {
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;
185 }
186
187 void
188 xaw_destroy_instance (instance)
189      widget_instance *instance;
190 {
191   if (XtIsSubclass (instance->widget, dialogWidgetClass))
192     /* Need to destroy the Shell too. */
193     XtDestroyWidget (XtParent (instance->widget));
194   else
195     XtDestroyWidget (instance->widget);
196 }
197
198 void
199 xaw_popup_menu (widget, event)
200      Widget widget;
201      XEvent *event;
202 {
203   /* An Athena menubar has not been implemented. */
204   return;
205 }
206
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
215 {
216   Widget widget = instance->widget;
217
218   if (up)
219     {
220       if (XtIsSubclass (widget, dialogWidgetClass))
221         {
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!!
226            */
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);
236
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?
240            */
241           {
242             unsigned int x, y, w, h;
243             Widget topmost = instance->parent;
244             Arg args[2];
245
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);
260           }
261
262           /* Finally, pop it up. */
263           XtPopup (shell, XtGrabNonexclusive);
264         }
265       else
266         XtManageChild (widget);
267     }
268   else
269     {
270       if (XtIsSubclass (widget, dialogWidgetClass))
271         XtUnmanageChild (XtParent (widget));
272       else
273         XtUnmanageChild (widget);
274     }
275 }
276
277
278 /* Dialog boxes */
279
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}
288 };
289 static Boolean actions_initted = False;
290
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;
303 {
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;
312
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 */
317
318   if (! actions_initted)
319     {
320       XtAppContext app = XtWidgetToApplicationContext (parent);
321       XtAppAddActions (app, xaw_actions,
322                        sizeof (xaw_actions) / sizeof (xaw_actions[0]));
323       actions_initted = True;
324     }
325
326   override = XtParseTranslationTable (overrideTrans);
327
328   ac = 0;
329   XtSetArg (av[ac], XtNtitle, shell_title); ac++;
330   XtSetArg (av[ac], XtNallowShellResize, True); ac++;
331
332   /* Don't allow any geometry request from the user.  */
333   XtSetArg (av[ac], XtNgeometry, 0); ac++;
334
335   shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
336                               parent, av, ac);
337   XtOverrideTranslations (shell, override);
338
339   ac = 0;
340   dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
341   override = XtParseTranslationTable (dialogOverride);
342   XtOverrideTranslations (dialog, override);
343
344   bc = 0;
345   button = 0;
346   for (i = 0; i < left_buttons; i++)
347     {
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);
358     }
359   if (right_buttons)
360     {
361       /* Create a separator
362
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.
367        */
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);
387     }
388   for (i = 0; i < right_buttons; i++)
389     {
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);
400     }
401
402   return dialog;
403 }
404
405 Widget
406 xaw_create_dialog (instance)
407      widget_instance* instance;
408 {
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;
421
422   switch (name [0]) {
423   case 'E': case 'e':
424     icon_name = "dbox-error";
425     shell_name = "Error";
426     break;
427
428   case 'I': case 'i':
429     icon_name = "dbox-info";
430     shell_name = "Information";
431     break;
432
433   case 'L': case 'l':
434     list = True;
435     icon_name = "dbox-question";
436     shell_name = "Prompt";
437     break;
438
439   case 'P': case 'p':
440     text_input_slot = True;
441     icon_name = "dbox-question";
442     shell_name = "Prompt";
443     break;
444
445   case 'Q': case 'q':
446     icon_name = "dbox-question";
447     shell_name = "Question";
448     break;
449   }
450
451   total_buttons = name [1] - '0';
452
453   if (name [3] == 'T' || name [3] == 't')
454     {
455       text_input_slot = False;
456       radio_box = True;
457     }
458   else if (name [3])
459     right_buttons = name [4] - '0';
460
461   left_buttons = total_buttons - right_buttons;
462
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);
466
467   return widget;
468 }
469
470
471 static void
472 xaw_generic_callback (widget, closure, call_data)
473      Widget widget;
474      XtPointer closure;
475      XtPointer call_data;
476 {
477   widget_instance *instance = (widget_instance *) closure;
478   Widget instance_widget;
479   LWLIB_ID id;
480   XtPointer user_data;
481
482   lw_internal_update_other_instances (widget, closure, call_data);
483
484   if (! instance)
485     return;
486   if (widget->core.being_destroyed)
487     return;
488
489   instance_widget = instance->widget;
490   if (!instance_widget)
491     return;
492
493   id = instance->info->id;
494
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. */
502   {
503     widget_value *val = instance->info->val->contents;
504     char *name = XtName (widget);
505     while (val)
506       {
507         if (val->name && !strcmp (val->name, name))
508           break;
509         val = val->next;
510       }
511     if (! val) abort ();
512     user_data = val->call_data;
513   }
514 #endif
515
516   if (instance->info->selection_cb)
517     instance->info->selection_cb (widget, id, user_data);
518 }
519
520 static void
521 wm_delete_window (w, closure, call_data)
522      Widget w;
523      XtPointer closure;
524      XtPointer call_data;
525 {
526   LWLIB_ID id;
527   Cardinal nkids;
528   int i;
529   Widget *kids