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., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, 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 xaw_update_one_widget (instance, widget, val, deep_p)
 123      widget_instance *instance;
 124      Widget widget;
 125      widget_value *val;
 126      Boolean deep_p;
 127 {
 128 #if 0
 129   if (XtIsSubclass (widget, scrollbarWidgetClass))
 130     {
 131       xaw_update_scrollbar (instance, widget, val);
 132     }
 133 #endif
 134   if (XtIsSubclass (widget, dialogWidgetClass))
 135     {
 136       Arg al[1];
 137       int ac = 0;
 138       XtSetArg (al[ac], XtNlabel, val->contents->value); ac++;
 139       XtSetValues (widget,  al, ac);
 140     }
 141   else if (XtIsSubclass (widget, commandWidgetClass))
 142     {
 143       Dimension bw = 0;
 144       Arg al[3];
 145
 146       XtVaGetValues (widget, XtNborderWidth, &bw, NULL);
 147       if (bw == 0)
 148         /* Don't let buttons end up with 0 borderwidth, that's ugly...
 149            Yeah, all this should really be done through app-defaults files
 150            or fallback resources, but that's a whole different can of worms
 151            that I don't feel like opening right now.  Making Athena widgets
 152            not look like shit is just entirely too much work.
 153          */
 154         {
 155           XtSetArg (al[0], XtNborderWidth, 1);
 156           XtSetValues (widget, al, 1);
 157         }
 158
 159       XtSetSensitive (widget, val->enabled);
 160       XtSetArg (al[0], XtNlabel, val->value);
 161       /* Force centered button text.  Se above. */
 162       XtSetArg (al[1], XtNjustify, XtJustifyCenter);
 163       XtSetValues (widget, al, 2);
 164       XtRemoveAllCallbacks (widget, XtNcallback);
 165       XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance);
 166     }
 167 }
 168
 169 void
 170 xaw_update_one_value (instance, widget, val)
 171      widget_instance *instance;
 172      Widget widget;
 173      widget_value *val;
 174 {
 175   /* This function is not used by the scrollbars and those are the only
 176      Athena widget implemented at the moment so do nothing. */
 177   return;
 178 }
 179
 180 void
 181 xaw_destroy_instance (instance)
 182      widget_instance *instance;
 183 {
 184   if (XtIsSubclass (instance->widget, dialogWidgetClass))
 185     /* Need to destroy the Shell too. */
 186     XtDestroyWidget (XtParent (instance->widget));
 187   else
 188     XtDestroyWidget (instance->widget);
 189 }
 190
 191 void
 192 xaw_popup_menu (widget, event)
 193      Widget widget;
 194      XEvent *event;
 195 {
 196   /* An Athena menubar has not been implemented. */
 197   return;
 198 }
 199
 200 void
 201 xaw_pop_instance (instance, up)
 202      widget_instance *instance;
 203      Boolean up;
 204 {
 205   Widget widget = instance->widget;
 206
 207   if (up)
 208     {
 209       if (XtIsSubclass (widget, dialogWidgetClass))
 210         {
 211           /* For dialogs, we need to call XtPopup on the parent instead
 212              of calling XtManageChild on the widget.
 213              Also we need to hack the shell's WM_PROTOCOLS to get it to
 214              understand what the close box is supposed to do!!
 215            */
 216           Display *dpy = XtDisplay (widget);
 217           Widget shell = XtParent (widget);
 218           Atom props [2];
 219           int i = 0;
 220           props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False);
 221           XChangeProperty (dpy, XtWindow (shell),
 222                            XInternAtom (dpy, "WM_PROTOCOLS", False),
 223                            XA_ATOM, 32, PropModeAppend,
 224                            (unsigned char *) props, i);
 225
 226           /* Center the widget in its parent.  Why isn't this kind of crap
 227              done automatically?  I thought toolkits were supposed to make
 228              life easier?
 229            */
 230           {
 231             unsigned int x, y, w, h;
 232             Widget topmost = instance->parent;
 233             Arg args[2];
 234
 235             w = shell->core.width;
 236             h = shell->core.height;
 237             while (topmost->core.parent && XtIsRealized (topmost->core.parent))
 238               topmost = topmost->core.parent;
 239             if (topmost->core.width < w) x = topmost->core.x;
 240             else x = topmost->core.x + ((topmost->core.width - w) / 2);
 241             if (topmost->core.height < h) y = topmost->core.y;
 242             else y = topmost->core.y + ((topmost->core.height - h) / 2);
 243             /* Using XtMoveWidget caused the widget to come
 244                out in the wrong place with vtwm.
 245                Question of virtual vs real coords, perhaps.  */
 246             XtSetArg (args[0], XtNx, x);
 247             XtSetArg (args[1], XtNy, y);
 248             XtSetValues (shell, args, 2);
 249           }
 250
 251           /* Finally, pop it up. */
 252           XtPopup (shell, XtGrabNonexclusive);
 253         }
 254       else
 255         XtManageChild (widget);
 256     }
 257   else
 258     {
 259       if (XtIsSubclass (widget, dialogWidgetClass))
 260         XtUnmanageChild (XtParent (widget));
 261       else
 262         XtUnmanageChild (widget);
 263     }
 264 }
 265
 266 \f
 267 /* Dialog boxes */
 268
 269 static char overrideTrans[] =
 270         "<Message>WM_PROTOCOLS: lwlib_delete_dialog()";
 271 static void wm_delete_window();
 272 static XtActionsRec xaw_actions [] = {
 273   {"lwlib_delete_dialog", wm_delete_window}
 274 };
 275 static Boolean actions_initted = False;
 276
 277 static Widget
 278 make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons)
 279      char* name;
 280      Widget parent;
 281      Boolean pop_up_p;
 282      char* shell_title;
 283      char* icon_name;
 284      Boolean text_input_slot;
 285      Boolean radio_box;
 286      Boolean list;
 287      int left_buttons;
 288      int right_buttons;
 289 {
 290   Arg av [20];
 291   int ac = 0;
 292   int i, bc;
 293   char button_name [255];
 294   Widget shell;
 295   Widget dialog;
 296   Widget button;
 297   XtTranslations override;
 298
 299   if (! pop_up_p) abort (); /* not implemented */
 300   if (text_input_slot) abort (); /* not implemented */
 301   if (radio_box) abort (); /* not implemented */
 302   if (list) abort (); /* not implemented */
 303
 304   if (! actions_initted)
 305     {
 306       XtAppContext app = XtWidgetToApplicationContext (parent);
 307       XtAppAddActions (app, xaw_actions,
 308                        sizeof (xaw_actions) / sizeof (xaw_actions[0]));
 309       actions_initted = True;
 310     }
 311
 312   override = XtParseTranslationTable (overrideTrans);
 313
 314   ac = 0;
 315   XtSetArg (av[ac], XtNtitle, shell_title); ac++;
 316   XtSetArg (av[ac], XtNallowShellResize, True); ac++;
 317
 318   /* Don't allow any geometry request from the user.  */
 319   XtSetArg (av[ac], XtNgeometry, 0); ac++;
 320
 321   shell = XtCreatePopupShell ("dialog", transientShellWidgetClass,
 322                               parent, av, ac);
 323   XtOverrideTranslations (shell, override);
 324
 325   ac = 0;
 326   dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac);
 327
 328   bc = 0;
 329   button = 0;
 330   for (i = 0; i < left_buttons; i++)
 331     {
 332       ac = 0;
 333       XtSetArg (av [ac], XtNfromHoriz, button); ac++;
 334       XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
 335       XtSetArg (av [ac], XtNright, XtChainLeft); ac++;
 336       XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
 337       XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
 338       XtSetArg (av [ac], XtNresizable, True); ac++;
 339       sprintf (button_name, "button%d", ++bc);
 340       button = XtCreateManagedWidget (button_name, commandWidgetClass,
 341                                       dialog, av, ac);
 342     }
 343   if (right_buttons)
 344     {
 345       /* Create a separator
 346
 347          I want the separator to take up the slack between the buttons on
 348          the right and the buttons on the left (that is I want the buttons
 349          after the separator to be packed against the right edge of the
 350          window) but I can't seem to make it do it.
 351        */
 352       ac = 0;
 353       XtSetArg (av [ac], XtNfromHoriz, button); ac++;
 354 /*  XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */
 355       XtSetArg (av [ac], XtNleft, XtChainLeft); ac++;
 356       XtSetArg (av [ac], XtNright, XtChainRight); ac++;
 357       XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
 358       XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
 359       XtSetArg (av [ac], XtNlabel, ""); ac++;
 360       XtSetArg (av [ac], XtNwidth, 30); ac++;   /* #### aaack!! */
 361       XtSetArg (av [ac], XtNborderWidth, 0); ac++;
 362       XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++;
 363       XtSetArg (av [ac], XtNresizable, False); ac++;
 364       XtSetArg (av [ac], XtNsensitive, False); ac++;
 365       button = XtCreateManagedWidget ("separator",
 366                                       /* labelWidgetClass, */
 367                                       /* This has to be Command to fake out
 368                                          the Dialog widget... */
 369                                       commandWidgetClass,
 370                                       dialog, av, ac);
 371     }
 372   for (i = 0; i < right_buttons; i++)
 373     {
 374       ac = 0;
 375       XtSetArg (av [ac], XtNfromHoriz, button); ac++;
 376       XtSetArg (av [ac], XtNleft, XtChainRight); ac++;
 377       XtSetArg (av [ac], XtNright, XtChainRight); ac++;
 378       XtSetArg (av [ac], XtNtop, XtChainBottom); ac++;
 379       XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++;
 380       XtSetArg (av [ac], XtNresizable, True); ac++;
 381       sprintf (button_name, "button%d", ++bc);
 382       button = XtCreateManagedWidget (button_name, commandWidgetClass,
 383                                       dialog, av, ac);
 384     }
 385
 386   return dialog;
 387 }
 388
 389 Widget
 390 xaw_create_dialog (instance)
 391      widget_instance* instance;
 392 {
 393   char *name = instance->info->type;
 394   Widget parent = instance->parent;
 395   Widget widget;
 396   Boolean pop_up_p = instance->pop_up_p;
 397   char *shell_name = 0;
 398   char *icon_name = 0;
 399   Boolean text_input_slot = False;
 400   Boolean radio_box = False;
 401   Boolean list = False;
 402   int total_buttons;
 403   int left_buttons = 0;
 404   int right_buttons = 1;
 405
 406   switch (name [0]) {
 407   case 'E': case 'e':
 408     icon_name = "dbox-error";
 409     shell_name = "Error";
 410     break;
 411
 412   case 'I': case 'i':
 413     icon_name = "dbox-info";
 414     shell_name = "Information";
 415     break;
 416
 417   case 'L': case 'l':
 418     list = True;
 419     icon_name = "dbox-question";
 420     shell_name = "Prompt";
 421     break;
 422
 423   case 'P': case 'p':
 424     text_input_slot = True;
 425     icon_name = "dbox-question";
 426     shell_name = "Prompt";
 427     break;
 428
 429   case 'Q': case 'q':
 430     icon_name = "dbox-question";
 431     shell_name = "Question";
 432     break;
 433   }
 434
 435   total_buttons = name [1] - '0';
 436
 437   if (name [3] == 'T' || name [3] == 't')
 438     {
 439       text_input_slot = False;
 440       radio_box = True;
 441     }
 442   else if (name [3])
 443     right_buttons = name [4] - '0';
 444
 445   left_buttons = total_buttons - right_buttons;
 446
 447   widget = make_dialog (name, parent, pop_up_p,
 448                         shell_name, icon_name, text_input_slot, radio_box,
 449                         list, left_buttons, right_buttons);
 450
 451   return widget;
 452 }
 453
 454
 455 static void
 456 xaw_generic_callback (widget, closure, call_data)
 457      Widget widget;
 458      XtPointer closure;
 459      XtPointer call_data;
 460 {
 461   widget_instance *instance = (widget_instance *) closure;
 462   Widget instance_widget;
 463   LWLIB_ID id;
 464   XtPointer user_data;
 465
 466   lw_internal_update_other_instances (widget, closure, call_data);
 467
 468   if (! instance)
 469     return;
 470   if (widget->core.being_destroyed)
 471     return;
 472
 473   instance_widget = instance->widget;
 474   if (!instance_widget)
 475     return;
 476
 477   id = instance->info->id;
 478
 479 #if 0
 480   user_data = NULL;
 481   XtVaGetValues (widget, XtNuserData, &user_data, NULL);
 482 #else
 483   /* Damn!  Athena doesn't give us a way to hang our own data on the
 484      buttons, so we have to go find it...  I guess this assumes that
 485      all instances of a button have the same call data. */
 486   {
 487     widget_value *val = instance->info->val->contents;
 488     char *name = XtName (widget);
 489     while (val)
 490       {
 491         if (val->name && !strcmp (val->name, name))
 492           break;
 493         val = val->next;
 494       }
 495     if (! val) abort ();
 496     user_data = val->call_data;
 497   }
 498 #endif
 499
 500   if (instance->info->selection_cb)
 501     instance->info->selection_cb (widget, id, user_data);
 502 }
 503
 504 static void
 505 wm_delete_window (shell, closure, call_data)
 506      Widget shell;
 507      XtPointer closure;
 508      XtPointer call_data;
 509 {
 510   LWLIB_ID id;
 511   Cardinal nkids;
 512   int i;
 513   Widget *kids = 0;
 514   Widget widget;
 515   if (! XtIsSubclass (shell, shellWidgetClass))
 516     abort ();
 517   XtVaGetValues (shell, XtNnumChildren, &nkids, NULL);
 518   XtVaGetValues (shell, XtNchildren, &kids, NULL);
 519   if (!kids || !*kids)
 520     abort ();
 521   for (i = 0; i < nkids; i++)
 522     {
 523       widget = kids[i];
 524       if (XtIsSubclass (widget, dialogWidgetClass))
 525         break;
 526     }
 527   id = lw_get_widget_id (widget);
 528   if (! id) abort ();
 529
 530   {
 531     widget_info *info = lw_get_widget_info (id);
 532     if (! info) abort ();
 533     if (info->selection_cb)
 534       info->selection_cb (widget, id, (XtPointer) -1);
 535   }
 536
 537   lw_destroy_all_widgets (id);
 538 }
 539
 540 \f
 541 /* Scrollbars */
 542
 543 #if 0
 544 static void
 545 xaw_scrollbar_scroll (widget, closure, call_data)
 546      Widget widget;
 547      XtPointer closure;
 548      XtPointer call_data;
 549 {
 550   widget_instance *instance = (widget_instance *) closure;
 551   LWLIB_ID id;
 552   scroll_event event_data;
 553
 554   if (!instance || widget->core.being_destroyed)
 555     return;
 556
 557   id = instance->info->id;
 558   event_data.slider_value = 0;
 559   event_data.time = 0;
 560
 561   if ((int) call_data > 0)
 562     event_data.action = SCROLLBAR_PAGE_DOWN;
 563   else
 564     event_data.action = SCROLLBAR_PAGE_UP;
 565
 566   if (instance->info->pre_activate_cb)
 567     instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
 568 }
 569 #endif
 570
 571 #if 0
 572 static void
 573 xaw_scrollbar_jump (widget, closure, call_data)
 574      Widget widget;
 575      XtPointer closure;
 576      XtPointer call_data;
 577 {
 578   widget_instance *instance = (widget_instance *) closure;
 579   LWLIB_ID id;
 580   scroll_event event_data;
 581   scrollbar_values *val =
 582     (scrollbar_values *) instance->info->val->scrollbar_data;
 583   float percent;
 584
 585   if (!instance || widget->core.being_destroyed)
 586     return;
 587
 588   id = instance->info->id;
 589
 590   percent = * (float *) call_data;
 591   event_data.slider_value =
 592     (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum;
 593
 594   event_data.time = 0;
 595   event_data.action = SCROLLBAR_DRAG;
 596
 597   if (instance->info->pre_activate_cb)
 598     instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data);
 599 }
 600 #endif
 601
 602 static Widget
 603 xaw_create_scrollbar (instance)
 604      widget_instance *instance;
 605 {
 606 #if 0
 607   Arg av[20];
 608   int ac = 0;
 609   Dimension width;
 610   Widget scrollbar;
 611
 612   XtVaGetValues (instance->parent, XtNwidth, &width, NULL);
 613
 614   XtSetArg (av[ac], XtNshowGrip, 0); ac++;
 615   XtSetArg (av[ac], XtNresizeToPreferred, 1); ac++;
 616   XtSetArg (av[ac], XtNallowResize, True); ac++;
 617   XtSetArg (av[ac], XtNskipAdjust, True); ac++;
 618   XtSetArg (av[ac], XtNwidth, width); ac++;
 619   XtSetArg (av[ac], XtNmappedWhenManaged, True); ac++;
 620
 621   scrollbar =
 622     XtCreateWidget (instance->info->name, scrollbarWidgetClass,
 623                     instance->parent, av, ac);
 624
 625   /* We have to force the border width to be 0 otherwise the
 626      geometry manager likes to start looping for awhile... */
 627   XtVaSetValues (scrollbar, XtNborderWidth, 0, NULL);
 628
 629   XtRemoveAllCallbacks (scrollbar, "jumpProc");
 630   XtRemoveAllCallbacks (scrollbar, "scrollProc");
 631
 632   XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump,
 633                  (XtPointer) instance);
 634   XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll,
 635                  (XtPointer) instance);
 636
 637   return scrollbar;
 638 #else
 639   return NULL;
 640 #endif
 641 }
 642
 643 static Widget
 644 xaw_create_main (instance)
 645      widget_instance *instance;
 646 {
 647   Arg al[1];
 648   int ac;
 649
 650   /* Create a vertical Paned to hold menubar */
 651   ac = 0;
 652   XtSetArg (al[ac], XtNborderWidth, 0); ac++;
 653   return XtCreateWidget (instance->info->name, panedWidgetClass,
 654                          instance->parent, al, ac);
 655 }
 656
 657 widget_creation_entry
 658 xaw_creation_table [] =
 659 {
 660   {"scrollbar",                 xaw_create_scrollbar},
 661   {"main",                      xaw_create_main},
 662   {NULL, NULL}
 663 };