code.delx.au - gnu-emacs/blob - lwlib/lwlib-Xaw.c

   1 /* The lwlib interface to Athena widgets.
   2    Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu>
   3
   4 This file is part of the Lucid Widget Library.
   5
   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.
  10
  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.
  15
  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.  */
  20
  21 #ifdef HAVE_CONFIG_H
  22 #include <config.h>
  23 #endif
  24
  25 #include <stdio.h>
  26
  27 #include "../src/lisp.h"
  28
  29 #include "lwlib-Xaw.h"
  30
  31 #include <X11/StringDefs.h>
  32 #include <X11/IntrinsicP.h>
  33 #include <X11/CoreP.h>
  34 #include <X11/Shell.h>
  35
  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>
  42
  43 #include <X11/Xatom.h>
  44
  45 static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/);
  46
  47
  48 Boolean
  49 lw_xaw_widget_p (widget)
  50      Widget widget;
  51 {
  52   return (XtIsSubclass (widget, scrollbarWidgetClass) ||
  53           XtIsSubclass (widget, dialogWidgetClass));
  54 }
  55
  56 #if 0
  57 static void
  58 xaw_update_scrollbar (instance, widget, val)
  59      widget_instance *instance;
  60      Widget widget;
  61      widget_value *val;
  62 {
  63   if (val->scrollbar_data)
  64     {
  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;
  70
  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);
  79
  80       /*
  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.
  84        */
  85       if (height != data->scrollbar_height || pos_y != data->scrollbar_pos)
  86         {
  87           XtConfigureWidget (widget, pos_x, data->scrollbar_pos,
  88                              width, data->scrollbar_height, 0);
  89
  90           XtVaSetValues (widget,
  91                          XtNlength, data->scrollbar_height,
  92                          XtNthickness, width,
  93                          NULL);
  94         }
  95
  96       /*
  97        * Now the size the scrollbar's slider.
  98        */
  99       new_shown = (float) data->slider_size /
 100         (float) (data->maximum - data->minimum);
 101
 102       new_topOfThumb = (float) (data->slider_position - data->minimum) /
 103         (float) (data->maximum - data->minimum);
 104
 105       if (new_shown > 1.0)
 106         new_shown = 1.0;
 107       if (new_shown < 0)
 108         new_shown = 0;
 109
 110       if (new_topOfThumb > 1.0)
 111         new_topOfThumb = 1.0;
 112       if (new_topOfThumb < 0)
 113         new_topOfThumb = 0;
 114
 115       if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb)
 116         XawScrollbarSetThumb (widget, new_topOfThumb, new_shown);
 117     }
 118 }
 119 #endif
 120
 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
 132 {
 133 #if 0
 134   if (XtIsSubclass (widget, scrollbarWidgetClass))
 135     {
 136       xaw_update_scrollbar (instance, widget, val);
 137     }
 138 #endif
 139   if (XtIsSubclass (widget, dialogWidgetClass))
 140     {
 141       Arg al[1];
 142       int ac = 0;
 143       XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
 144       XtSetValues (widget,  al, ac);
 145     }
 146   else if (XtIsSubclass (widget, commandWidgetClass))
 147     {
 148       Dimension bw = 0;
 149       Arg al[3];
 150
 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.
 158          */
 159         {
 160           XtSetArg (al[0], XtNborderWidth, 1);
 161           XtSetValues (widget, al, 1);
 162         }
 163
 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);
 171     }
 172 }
 173
 174 void
 175 xaw_update_one_value (instance, widget, val)
 176      widget_instance *instance;
 177      Widget widget;
 178      widget_value *val;
 179 {
 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;
 183 }
 184
 185 void
 186 xaw_destroy_instance (instance)
 187      widget_instance *instance;
 188 {
 189   if (XtIsSubclass (instance->widget, dialogWidgetClass))
 190     /* Need to destroy the Shell too. */
 191     XtDestroyWidget (XtParent (instance->widget));
 192   else
 193     XtDestroyWidget (instance->widget);
 194 }
 195
 196 void
 197 xaw_popup_menu (widget, event)
 198      Widget widget;
 199      XEvent *event;
 200 {
 201   /* An Athena menubar has not been implemented. */
 202   return;
 203 }
 204
 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
 213 {
 214   Widget widget = instance->widget;
 215
 216   if (up)
 217     {
 218       if (XtIsSubclass (widget, dialogWidgetClass))
 219         {
 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!!
 224            */
 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);
 234
 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?
 238            */
 239           {
 240             unsigned int x, y, w, h;
 241             Widget topmost = instance->parent;
 242             Arg args[2];
 243
 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);
 258           }
 259
 260           /* Finally, pop it up. */
 261           XtPopup (shell, XtGrabNonexclusive);
 262         }
 263       else
 264         XtManageChild (widget);
 265     }
 266   else
 267     {
 268       if (XtIsSubclass (widget, dialogWidgetClass))
 269         XtUnmanageChild (XtParent (widget));
 270       else
 271         XtUnmanageChild (widget);
 272     }
 273 }
 274
 275 \f
 276 /* Dialog boxes */
 277
 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}
 286 };
 287 static Boolean actions_initted = False;
 288
 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;
 301 {
 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;
 310
 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 */
 315
 316   if (! actions_initted)
 317     {
 318       XtAppContext app = XtWidgetToApplicationContext (parent);
 319       XtAppAddActions (app, xaw_actions,
 320                        sizeof (xaw_actions) / sizeof (xaw_actions[0]));
 321       actions_initted = True;
 322     }
 323
 324   override = XtParseTranslationTable (overrideTrans);
 325
 326   ac = 0;
 327   XtSetArg (av[ac], XtNtitle, shell_title); ac++;
 328   XtSetArg (av[ac], XtNallowShellResize, True); ac++;
 329
 330   /* Don't allow any geometry request from the user.  */
 331   XtSetArg (av[ac], XtNgeometry, 0); ac++;
 332
 333   shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
 334                               parent, av, ac);
 335   XtOverrideTranslations (shell, override);
 336
 337   ac = 0;
 338   dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
 339   override = XtParseTranslationTable (dialogOverride);
 340   XtOverrideTranslations (dialog, override);
 341
 342   bc = 0;
 343   button = 0;
 344   for (i = 0; i < left_buttons; i++)
 345     {
 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);
 356     }
 357   if (right_buttons)
 358     {
 359       /* Create a separator
 360
 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.
 365        */
 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);
 385     }
 386   for (i = 0; i < right_buttons; i++)
 387     {
 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);
 398     }
 399
 400   return dialog;
 401 }
 402
 403 Widget
 404 xaw_create_dialog (instance)
 405      widget_instance* instance;
 406 {
 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;
 419
 420   switch (name [0]) {
 421   case 'E': case 'e':
 422     icon_name = "dbox-error";
 423     shell_name = "Error";
 424     break;
 425
 426   case 'I': case 'i':
 427     icon_name = "dbox-info";
 428     shell_name = "Information";
 429     break;
 430
 431   case 'L': case 'l':
 432     list = True;
 433     icon_name = "dbox-question";
 434     shell_name = "Prompt";
 435     break;
 436
 437   case 'P': case 'p':
 438     text_input_slot = True;
 439     icon_name = "dbox-question";
 440     shell_name = "Prompt";
 441     break;
 442
 443   case 'Q': case 'q':
 444     icon_name = "dbox-question";
 445     shell_name = "Question";
 446     break;
 447   }
 448
 449   total_buttons = name [1] - '0';
 450
 451   if (name [3] == 'T' || name [3] == 't')
 452     {
 453       text_input_slot = False;
 454       radio_box = True;
 455     }
 456   else if (name [3])
 457     right_buttons = name [4] - '0';
 458
 459   left_buttons = total_buttons - right_buttons;
 460
 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);
 464
 465   return widget;
 466 }
 467
 468
 469 static void
 470 xaw_generic_callback (widget, closure, call_data)
 471      Widget widget;
 472      XtPointer closure;
 473      XtPointer call_data;
 474 {
 475   widget_instance *instance = (widget_instance *) closure;
 476   Widget instance_widget;
 477   LWLIB_ID id;
 478   XtPointer user_data;
 479
 480   lw_internal_update_other_instances (widget, closure, call_data);
 481
 482   if (! instance)
 483     return;
 484   if (widget->core.being_destroyed)
 485     return;
 486
 487   instance_widget = instance->widget;
 488   if (!instance_widget)
 489     return;
 490
 491   id = instance->info->id;
 492
 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. */
 500   {
 501     widget_value *val = instance->info->val->contents;
 502     char *name = XtName (widget);
 503     while (val)
 504       {
 505         if (val->name && !strcmp (val->name, name))
 506           break;
 507         val = val->next;
 508       }
 509     if (! val) abort ();
 510     user_data = val->call_data;
 511   }
 512 #endif
 513
 514   if (instance->info->selection_cb)
 515     instance->info->selection_cb (widget, id, user_data);
 516 }
 517
 518 static void
 519 wm_delete_window (w, closure, call_data)
 520      Widget w;
 521      XtPointer closure;
 522      XtPointer call_data;
 523 {
 524   LWLIB_ID id;
 525   Cardinal nkids;
 526   int i;
 527   Widget *kids = 0;
 528   Widget widget, shell;
 529
 530   if (XtIsSubclass (w, dialogWidgetClass))
 531     shell = XtParent (w);
 532   else
 533     shell = w;
 534
 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++)
 542     {
 543       widget = kids[i];
 544       if (XtIsSubclass (widget, dialogWidgetClass))
 545         break;
 546     }
 547   id = lw_get_widget_id (widget);
 548   if (! id) abort ();
 549
 550   {
 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);
 555   }
 556
 557   lw_destroy_all_widgets (id);
 558 }
 559
 560 \f
 561 /* Scrollbars */
 562
 563 #if 0
 564 static void
 565 xaw_scrollbar_scroll (widget, closure, call_data)
 566      Widget widget;
 567      XtPointer closure;
 568      XtPointer call_data;
 569 {
 570   widget_instance *instance = (widget_instance *) closure;
 571   LWLIB_ID id;
 572   scroll_event event_data;
 573
 574   if (!instance || widget->core.being_destroyed)
 575     return;
 576
 577   id = instance->info->id;
 578   event_data.slider_value = 0;
 579   event_data.time = 0;
 580
 581   if ((int) call_data > 0)
 582     event_data.action = SCROLLBAR_PAGE_DOWN;
 583   else
 584     event_data.action = SCROLLBAR_PAGE_UP;
 585
 586   if (instance->info->pre_activate_cb)
 587     instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
 588 }
 589 #endif
 590
 591 #if 0
 592 static void
 593 xaw_scrollbar_jump (widget, closure, call_data)
 594      Widget widget;
 595      XtPointer closure;
 596      XtPointer call_data;
 597 {
 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;
 604
 605   if (!instance || widget->core.being_destroyed)
 606     return;
 607
 608   id = instance->info->id;
 609
 610   percent = * (float *) call_data;
 611   event_data.slider_value =
 612     (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum;
 613
 614   event_data.time = 0;
 615   event_data.action = SCROLLBAR_DRAG;
 616
 617   if (instance->info->pre_activate_cb)
 618     instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
 619 }
 620 #endif
 621
 622 static Widget
 623 xaw_create_scrollbar (instance)
 624      widget_instance *instance;
 625 {
 626 #if 0
 627   Arg av[20];
 628   int ac = 0;
 629   Dimension width;
 630   Widget scrollbar;
 631
 632   XtVaGetValues (instance->parent, XtNwidth, &width, NULL);
 633
 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++;
 640
 641   scrollbar =
 642     XtCreateWidget (instance->info->name, scrollbarWidgetClass,
 643                     instance->parent, av, ac);
 644
 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);
 648
 649   XtRemoveAllCallbacks (scrollbar, "jumpProc");
 650   XtRemoveAllCallbacks (scrollbar, "scrollProc");
 651
 652   XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump,
 653                  (XtPointer) instance);
 654   XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll,
 655                  (XtPointer) instance);
 656
 657   return scrollbar;
 658 #else
 659   return NULL;
 660 #endif
 661 }
 662
 663 static Widget
 664 xaw_create_main (instance)
 665      widget_instance *instance;
 666 {
 667   Arg al[1];
 668   int ac;
 669
 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);
 675 }
 676
 677 widget_creation_entry
 678 xaw_creation_table [] =
 679 {
 680   {"scrollbar",                 xaw_create_scrollbar},
 681   {"main",                      xaw_create_main},
 682   {NULL, NULL}
 683 };
 684
 685 /* arch-tag: fbbd3589-ae1c-41a0-9142-f628cfee6564
 686    (do not change this comment) */