home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / src-server / w_libXm.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  24.0 KB  |  628 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         w_libXm.c
  5. * RCS:          $Header: w_libXm.c,v 1.5 91/03/25 04:17:21 mayer Exp $
  6. * Description:  Random XLISP Primitives and Methods for the Motif toolkit.
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Fri Nov 24 00:36:30 1989
  9. * Modified:     Thu Oct  3 20:49:33 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. **
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: w_libXm.c,v 1.5 91/03/25 04:17:21 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>
  46. #include <X11/cursorfont.h>    /* defines XC_num_glyphs */
  47. #include "winterp.h"
  48. #include "user_prefs.h"
  49. #include "xlisp/xlisp.h"
  50.  
  51. #ifdef WINTERP_MOTIF_11
  52. /*
  53.  * <limits.h> defines machine dependent limits on sizes of numbers, if your
  54.  * machine doesn't have this, then your compiler doesn't conform to standards
  55.  * XPG2, XPG3, POSIX.1, FIPS 151-1 and you should complain to the manufacturer.
  56.  * 
  57.  * If for some reason your system isn't standards-conforming, you may work
  58.  * around this problem by using the following definitions (assuming 32 bit machine):
  59.  * 
  60.  * #define INT_MAX 2147483647
  61.  */
  62. #include <limits.h>
  63. #endif                /* WINTERP_MOTIF_11 */
  64.  
  65. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  66.  
  67.  
  68. /*****************************************************************************
  69.  * (send <widget> :UPDATE_DISPLAY)
  70.  *
  71.  * (see XmUpdateDisplay(3X))
  72.  * This function is useful for refreshing winterp's
  73.  * Xwindows displays while inside a callback. Since the X display won't get
  74.  * refreshed until you hit the XtNextEvent/XtDispatchEvent loop you cannot
  75.  * normally change the display inside a callback. Thus, this function is
  76.  * expecally useful for forcing a status message to be seen before a long
  77.  * computation occurs within a callback, timeout, or workproc.
  78.  ****************************************************************************/
  79. LVAL Widget_Class_Method_UPDATE_DISPLAY()
  80. {
  81.   LVAL self;
  82.   Widget widget_id;
  83.  
  84.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  85.   xllastarg();
  86.  
  87.   XmUpdateDisplay(widget_id);
  88.   return (self);
  89. }
  90.  
  91.  
  92. /******************************************************************************
  93.  * (send <widget> :ADD_TAB_GROUP)
  94.  * ==> returns <widget>
  95.  *
  96.  * This method adds <widget> to the list of tab groups associated with a 
  97.  * particular widget hierarchy.
  98.  *
  99.  * void XmAddTabGroup(tabGroup)
  100.  *      Widget tabGroup;
  101.  ******************************************************************************/
  102. LVAL Widget_Class_Method_ADD_TAB_GROUP()
  103. {
  104.   LVAL self;
  105.   Widget widget_id;
  106.  
  107.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  108.   xllastarg();
  109.  
  110.   XmAddTabGroup(widget_id);
  111.   return (self);
  112. }
  113.  
  114.  
  115. /******************************************************************************
  116.  * (send <widget> :REMOVE_TAB_GROUP)
  117.  * ==> returns <widget>
  118.  *
  119.  * This method removes <widget> from the list of tab groups associated with a 
  120.  * particular widget hierarchy.
  121.  *
  122.  * void XmRemoveTabGroup (tabGroup)
  123.  *      Widget tabGroup;
  124.  ******************************************************************************/
  125. LVAL Widget_Class_Method_REMOVE_TAB_GROUP()
  126. {
  127.   LVAL self;
  128.   Widget widget_id;
  129.  
  130.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  131.   xllastarg();
  132.  
  133.   XmRemoveTabGroup(widget_id);
  134.   return (self);
  135. }
  136.  
  137. /******************************************************************************
  138.  * (send <widget> :IS_PRIMITIVE)
  139.  * ==> returns T if <widget> is a motif primitive widget, else NIL.
  140.  *
  141.  * #define XmIsPrimitive(w)    XtIsSubclass(w, xmPrimitiveWidgetClass)
  142.  ******************************************************************************/
  143. LVAL Widget_Class_Method_IS_PRIMITIVE()
  144. {
  145.   extern LVAL true;
  146.   LVAL self;
  147.   Widget widget_id;
  148.  
  149.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  150.   xllastarg();
  151.  
  152.   return (XmIsPrimitive(widget_id) ? true : NIL);
  153. }
  154.  
  155.  
  156. /******************************************************************************
  157.  * (send <widget> :IS_GADGET)
  158.  * ==> returns T if <widget> is a motif gadget, else NIL.
  159.  *
  160.  * #define XmIsGadget(w)    XtIsSubclass(w, xmGadgetClass)
  161.  ******************************************************************************/
  162. LVAL Widget_Class_Method_IS_GADGET()
  163. {
  164.   extern LVAL true;
  165.   LVAL self;
  166.   Widget widget_id;
  167.  
  168.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  169.   xllastarg();
  170.  
  171.   return (XmIsGadget(widget_id) ? true : NIL);
  172. }
  173.  
  174.  
  175. /******************************************************************************
  176.  * (send <widget> :IS_MANAGER)
  177.  * ==> returns T if <widget> is a motif manager widget, else NIL.
  178.  *
  179.  * #define XmIsManager(w)    XtIsSubclass(w, xmManagerWidgetClass)
  180.  ******************************************************************************/
  181. LVAL Widget_Class_Method_IS_MANAGER()
  182. {
  183.   extern LVAL true;
  184.   LVAL self;
  185.   Widget widget_id;
  186.  
  187.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  188.   xllastarg();
  189.  
  190.   return (XmIsManager(widget_id) ? true : NIL);
  191. }
  192.  
  193.  
  194. #ifdef WINTERP_MOTIF_11
  195. /******************************************************************************
  196.  * (XM_GET_COLORS <background-pixel>)
  197.  * returns an array <background> <foreground> <top_shadow> <bot_shadow> <select>
  198.  * pixels.
  199. ******************************************************************************/
  200. LVAL Wxm_Prim_XM_GET_COLORS()
  201. {
  202.   extern Screen* screen;    /* global in winterp.c */
  203.   extern Colormap colormap;    /* global in winterp.c */
  204.   Pixel foreground, top_shadow, bottom_shadow, select;
  205.   LVAL result, background = xlga_pixel();
  206.   xllastarg();
  207.  
  208.   XmGetColors(screen, colormap, get_pixel(background), &foreground, &top_shadow, &bottom_shadow, &select);
  209.  
  210.   xlsave1(result);
  211.   result = newvector(5);
  212.   setelement(result, 0, cv_pixel(background));
  213.   setelement(result, 1, cv_pixel(foreground));
  214.   setelement(result, 2, cv_pixel(top_shadow));
  215.   setelement(result, 3, cv_pixel(bottom_shadow));
  216.   setelement(result, 4, cv_pixel(select));
  217.  
  218.   xlpop();
  219.   return (result);
  220. }
  221. #endif
  222.  
  223.  
  224. #ifdef WINTERP_MOTIF_11
  225. /******************************************************************************
  226.  * (XM_SET_FONT_UNITS <horiz-val> <vert-val>)
  227.  *     ==> Returns NIL.
  228.  *
  229.  * <horiz-val> and <vert-val> are nonngegative FIXNUMS
  230.  *
  231.  * Note: when WINTERP allows for multiple displays, this function will
  232.  * end up changing arg sequences to accomodate a <display> arg.
  233.  *
  234.  *-----------------------------------------------------------------------------
  235.  *           void XmSetFontUnits (display, h_value, v_value)
  236.  *                Display   * display;
  237.  *                int       h_value;
  238.  *                int       v_value;
  239.  ******************************************************************************/
  240. LVAL Wxm_Prim_XM_SET_FONT_UNITS()
  241. {
  242.   extern Display* display;    /* winterp.c */
  243.   LVAL lval_h_value = xlgafixnum();
  244.   LVAL lval_v_value = xlgafixnum();
  245.   long h_value = (long) getfixnum(lval_h_value);
  246.   long v_value = (long) getfixnum(lval_v_value);
  247.   xllastarg();
  248.  
  249.   if ((h_value < 0L) || (h_value > (long) INT_MAX))
  250.     xlerror("Font unit specification out of range", lval_h_value);
  251.   if ((v_value < 0L) || (v_value > (long) INT_MAX))
  252.     xlerror("Font unit specification out of range", lval_v_value);
  253.  
  254.   XmSetFontUnits(display, (int) h_value, (int) v_value);
  255.  
  256.   return (NIL);
  257. }
  258. #endif                /* WINTERP_MOTIF_11 */
  259.  
  260.  
  261. #ifdef WINTERP_MOTIF_11
  262. /******************************************************************************
  263.  * (XM_TRACKING_LOCATE <widget> <fontcursor-FIXNUM> [<confine-to-p>]
  264.  *    ==> Returns a WIDGETOBJ or NIL if the window of the buttonpress is
  265.  *        not a widget.
  266.  *
  267.  * "XmTrackingLocate provides a modal interface for selection of
  268.  * a component.  It is intended to support context help.  The
  269.  * function grabs the pointer and returns the widget in which a
  270.  * button press occurs." (taken from XmTrackingLocate.3X man-page).
  271.  * 
  272.  * <widget> is the widget "to use as the basis of the modal interaction
  273.  *
  274.  * <fontcursor-FIXNUM> specifies the shape of the cursor for this interaction.
  275.  * the value of this FIXNUM specifies a font whose name/value is defined in
  276.  * /usr/include/X11/cursorfont.h.
  277.  *
  278.  * If the last arg supplied, <confine-to-p>, is non-NIL, then the interaction
  279.  * will be confined to <widget>. If this arg is not supplied, <confine-to-p>
  280.  * is treated as NIL.
  281.  *----------------------------------------------------------------------------
  282.  * Widget XmTrackingLocate (widget, cursor, confine_to)
  283.  *      Widget    widget;
  284.  *      Cursor    cursor;
  285.  *      Boolean   confine_to;
  286.  ******************************************************************************/
  287. LVAL Wxm_Prim_XM_TRACKING_LOCATE()
  288. {
  289.   extern LVAL Wcls_WidgetID_To_WIDGETOBJ(); /* w_classes.c */
  290.   LVAL lval_widget;
  291.   Widget widget_id;
  292.   Cursor cursor;
  293.   LVAL lval_fontcursor_shape;
  294.   long fontcursor_shape;
  295.   Boolean confineto_p;
  296.  
  297.   /* get <widget> */
  298.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&lval_widget);
  299.  
  300.   /* get <fontcursor-FIXNUM> */
  301.   lval_fontcursor_shape = xlgafixnum();
  302.   
  303.   /* get optional [<confine-to-p>] */
  304.   if (moreargs())
  305.     confineto_p = nextarg() ? TRUE : FALSE;
  306.   else
  307.     confineto_p = FALSE;
  308.     
  309.   xllastarg();
  310.  
  311.   /* convert <fontcursor-FIXNUM> to a cursor */
  312.   fontcursor_shape = (long) getfixnum(lval_fontcursor_shape);
  313.   if ((fontcursor_shape & 1L) != 0) /* <fontcursor-FIXNUM> can't be an odd number ... */
  314.     xlerror("Font-Cursor fixnum must be an even number", lval_fontcursor_shape);
  315.   if ((fontcursor_shape < 0L) || (fontcursor_shape > (long) (XC_num_glyphs - 2)))
  316.     xlerror("Font-Cursor fixnum out of range", lval_fontcursor_shape);
  317.   cursor = XCreateFontCursor(XtDisplayOfObject(widget_id),
  318.                  (unsigned int) fontcursor_shape);
  319.  
  320.   return (Wcls_WidgetID_To_WIDGETOBJ(XmTrackingLocate(widget_id, cursor, confineto_p)));
  321. }
  322. #endif                /* WINTERP_MOTIF_11 */
  323.  
  324.  
  325. #ifdef WINTERP_MOTIF_11
  326. /******************************************************************************
  327.  * (XM_CONVERT_UNITS <widget> <orientation> <from_unit_type> <from_value> <to_unit_type>)
  328.  *     ==> Returns the converted value, a FIXNUM.
  329.  *
  330.  * "XmConvertUnits - a function that converts a value in one unit type to
  331.  *  another unit type." (quoted from XmConvertUnits.3X manual page).
  332.  *
  333.  * <widget> is a WIDGETOBJ -- "Specifies the widget for which the data is to be
  334.  * converted."
  335.  *
  336.  * <orientation> is a keyword symbol, either :HORIZONTAL or :VERTICAL
  337.  * "Specifies whether the converter uses the horizontal or vertical screen
  338.  *  resolution when performing the conversions."
  339.  *
  340.  * <from_unit_type> and <to_unit_type> are keyword symbols, either
  341.  * :PIXELS, :100TH_MILLIMETERS, :1000TH_INCHES, :100TH_POINTS, :100TH_FONT_UNITS
  342.  *
  343.  * <from_value> is a FIXNUM.
  344.  *
  345.  * Note that functions XmCvtFromHorizontalPixels(), XmCvtFromVerticalPixels(),
  346.  * XmCvtToHorizontalPixels(), XmCvtToVerticalPixels() have not been interfaced
  347.  * since their functionality can be achieved through XmConvertUnits().
  348.  *
  349.  *----------------------------------------------------------------------------
  350.  * int XmConvertUnits (widget, orientation, from_unit_type,
  351.  *                     from_value, to_unit_type)
  352.  *    Widget    widget;
  353.  *    int       orientation;
  354.  *    int       from_unit_type;
  355.  *    int       from_value;
  356.  *    int       to_unit_type;
  357.  ******************************************************************************/
  358. static LVAL k_VERTICAL, k_HORIZONTAL, k_PIXELS, k_100TH_MILLIMETERS,
  359.   k_1000TH_INCHES, k_100TH_POINTS, k_100TH_FONT_UNITS; /* init'd in Wxm_Init() */
  360. LVAL Wxm_Prim_XM_CONVERT_UNITS()
  361. {
  362.   LVAL lval_widget;
  363.   Widget widget_id;
  364.   LVAL lval_orientation, lval_from_unit_type, lval_to_unit_type;
  365.   int orientation, from_unit_type, to_unit_type, from_value;
  366.  
  367.   /* get <widget> */
  368.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&lval_widget);
  369.  
  370.   /* get  <orientation> */
  371.   lval_orientation = xlgetarg();
  372.   if (lval_orientation == k_VERTICAL)
  373.     orientation = XmVERTICAL;
  374.   else if (lval_orientation == k_HORIZONTAL)
  375.     orientation = XmHORIZONTAL;
  376.   else
  377.     xlerror("Invalid orientation value, expected :VERTICAL or :HORIZONTAL",
  378.         lval_orientation);
  379.  
  380.   /* get <from_unit_type> */
  381.   lval_from_unit_type = xlgetarg();
  382.   if (lval_from_unit_type == k_PIXELS)
  383.     from_unit_type = XmPIXELS;
  384.   else if (lval_from_unit_type == k_100TH_MILLIMETERS)
  385.     from_unit_type = Xm100TH_MILLIMETERS;
  386.   else if (lval_from_unit_type == k_1000TH_INCHES)
  387.     from_unit_type = Xm1000TH_INCHES;
  388.   else if (lval_from_unit_type == k_100TH_POINTS)
  389.     from_unit_type = Xm100TH_POINTS;
  390.   else if (lval_from_unit_type == k_100TH_FONT_UNITS)
  391.     from_unit_type = Xm100TH_FONT_UNITS;
  392.   else 
  393.     xlerror("Invalid <from_unit_type> keyword, expected one of [:PIXELS, :100TH_MILLIMETERS, :1000TH_INCHES, :100TH_POINTS, :100TH_FONT_UNITS].",
  394.         lval_from_unit_type);
  395.  
  396.   /* get <from_value> */
  397.   from_value = (long) getfixnum(xlgafixnum());
  398.  
  399.   /* get <to_unit_type> */
  400.   lval_to_unit_type = xlgetarg();
  401.   if (lval_to_unit_type == k_PIXELS)
  402.     to_unit_type = XmPIXELS;
  403.   else if (lval_to_unit_type == k_100TH_MILLIMETERS)
  404.     to_unit_type = Xm100TH_MILLIMETERS;
  405.   else if (lval_to_unit_type == k_1000TH_INCHES)
  406.     to_unit_type = Xm1000TH_INCHES;
  407.   else if (lval_to_unit_type == k_100TH_POINTS)
  408.     to_unit_type = Xm100TH_POINTS;
  409.   else if (lval_to_unit_type == k_100TH_FONT_UNITS)
  410.     to_unit_type = Xm100TH_FONT_UNITS;
  411.   else 
  412.     xlerror("Invalid <to_unit_type> keyword, expected one of [:PIXELS, :100TH_MILLIMETERS, :1000TH_INCHES, :100TH_POINTS, :100TH_FONT_UNITS].",
  413.         lval_to_unit_type);
  414.  
  415.   xllastarg();
  416.  
  417.   return (cvfixnum((FIXTYPE) XmConvertUnits(widget_id,
  418.                         orientation,
  419.                         from_unit_type,
  420.                         from_value,
  421.                         to_unit_type)));
  422. }
  423. #endif                /* WINTERP_MOTIF_11 */
  424.  
  425.  
  426. #ifdef WINTERP_MOTIF_11
  427. /******************************************************************************
  428.  * (send <widget> :PROCESS_TRAVERSAL <direction>)
  429.  *    ==> "Returns T if the setting succeeded.  Returns NIL if the
  430.  *           keyboard focus policy is not :EXPLICIT, if there are no
  431.  *           traversable items, or if the call to the routine has invalid
  432.  *           parameters."
  433.  *
  434.  * "a function that determines which component receives keyboard events
  435.  *  when a widget has the focus." (from XmProcessTraversal.3X manual page)
  436.  *
  437.  * <direction> is a keyword symbol, one of the following:
  438.  * :TRAVERSE_CURRENT
  439.  *    "Finds the hierarchy and the tab group that contain widget.
  440.  *     If this tab group is not the active tab group, makes it the
  441.  *     active tab group.  If widget is an item in the active tab
  442.  *     group, makes it the active item.  If widget is the active
  443.  *     tab group, makes the first traversable item in the tab group
  444.  *     the active item."
  445.  * :TRAVERSE_DOWN
  446.  *     "Finds the hierarchy that contains widget.  Finds the active
  447.  *     item in the active tab group and makes the item below it the
  448.  *     active item.  If there is no item below, wraps."
  449.  * :TRAVERSE_HOME
  450.  *     "Finds the hierarchy that contains widget.  Finds the active item
  451.  *     in the active tab group and makes the first traversable item in
  452.  *     the tab group the active item."
  453.  * :TRAVERSE_LEFT
  454.  *      "Finds the hierarchy that contains widget.  Finds the active item
  455.  *     in the active tab group and makes the item to the left the active
  456.  *     item.  If there is no item to the left, wraps."
  457.  * :TRAVERSE_NEXT
  458.  *      "Finds the hierarchy that contains widget.  Finds the active item
  459.  *      in the active tab group and makes the next item the active item."
  460.  * :TRAVERSE_NEXT_TAB_GROUP
  461.  *      "Finds the hierarchy that contains widget.  Finds the active tab
  462.  *      group (if any) and makes the next tab group the active tab group
  463.  *    in the hierarchy."
  464.  * :TRAVERSE_PREV
  465.  *      "Finds the hierarchy that contains widget.  Finds the active item
  466.  *      in the active tab group and makes the previous item the active item."
  467.  * :TRAVERSE_PREV_TAB_GROUP
  468.  *      "Finds the hierarchy that contains widget.  Finds the active tab
  469.  *      group (if any) and makes the previous tab group the active tab
  470.  *      group in the hierarchy.
  471.  * :TRAVERSE_RIGHT
  472.  *     "Finds the hierarchy that contains widget.  Finds the active item
  473.  *     in the active tab group and makes the item to the right the active
  474.  *     item.  If there is no item to the right, wraps."
  475.  * :TRAVERSE_UP
  476.  *     "Finds the hierarchy that contains widget. Finds the active item
  477.  *    in the active tab group and makes the item above it the active item.
  478.  *      If there is no item above, wraps."
  479.  *----------------------------------------------------------------------------
  480.  *          Boolean XmProcessTraversal (widget, direction)
  481.  *               Widget    widget;
  482.  *               int       direction;
  483.  ******************************************************************************/
  484. static LVAL k_TRAVERSE_CURRENT, k_TRAVERSE_NEXT, k_TRAVERSE_PREV, k_TRAVERSE_HOME,
  485.   k_TRAVERSE_NEXT_TAB_GROUP, k_TRAVERSE_PREV_TAB_GROUP, k_TRAVERSE_UP, k_TRAVERSE_DOWN,
  486.   k_TRAVERSE_LEFT, k_TRAVERSE_RIGHT; /* init'd in Wxm_Init() */
  487. LVAL Widget_Class_Method_PROCESS_TRAVERSAL()
  488. {
  489.   extern LVAL true;
  490.   LVAL self;
  491.   Widget widget_id;
  492.   int direction;
  493.   LVAL lval_direction;
  494.  
  495.   /* get <widget> */
  496.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  497.  
  498.   /* get <direction> */
  499.   lval_direction = xlgetarg();
  500.   if (lval_direction == k_TRAVERSE_CURRENT)
  501.     direction = XmTRAVERSE_CURRENT;
  502.   else if (lval_direction == k_TRAVERSE_NEXT)
  503.     direction = XmTRAVERSE_NEXT;
  504.   else if (lval_direction == k_TRAVERSE_PREV)
  505.     direction = XmTRAVERSE_PREV;
  506.   else if (lval_direction == k_TRAVERSE_HOME)
  507.     direction = XmTRAVERSE_HOME;
  508.   else if (lval_direction == k_TRAVERSE_NEXT_TAB_GROUP)
  509.     direction = XmTRAVERSE_NEXT_TAB_GROUP;
  510.   else if (lval_direction == k_TRAVERSE_PREV_TAB_GROUP)
  511.     direction = XmTRAVERSE_PREV_TAB_GROUP;
  512.   else if (lval_direction == k_TRAVERSE_UP)
  513.     direction = XmTRAVERSE_UP;
  514.   else if (lval_direction == k_TRAVERSE_DOWN)
  515.     direction = XmTRAVERSE_DOWN;
  516.   else if (lval_direction == k_TRAVERSE_LEFT)
  517.     direction = XmTRAVERSE_LEFT;
  518.   else if (lval_direction == k_TRAVERSE_RIGHT)
  519.     direction = XmTRAVERSE_RIGHT;
  520.   else 
  521.     xlerror("Invalid traversal direction keyword, expected one of [:TRAVERSE_CURRENT, :TRAVERSE_NEXT, :TRAVERSE_PREV, :TRAVERSE_HOME, :TRAVERSE_NEXT_TAB_GROUP, :TRAVERSE_PREV_TAB_GROUP, :TRAVERSE_UP, :TRAVERSE_DOWN, :TRAVERSE_LEFT, :TRAVERSE_RIGHT].",
  522.         lval_direction);
  523.  
  524.   xllastarg();
  525.  
  526.   return (XmProcessTraversal(widget_id, direction) ? true : NIL);
  527. }
  528. #endif                /* WINTERP_MOTIF_11 */
  529.  
  530.  
  531. /******************************************************************************
  532.  * (XM_SET_MENU_CURSOR <fontcursor>)
  533.  *    ==> Returns NIL.
  534.  *
  535.  *  "XmSetMenuCursor programmatically modifies the menu cursor for a client;
  536.  *  after the cursor has been created by the client, this function registers
  537.  *  the cursor with the menu system.  After calling this function, the
  538.  *  specified cursor is displayed whenever this client displays a Motif
  539.  *  menu on the indicated display.  The client can then specify different
  540.  *  cursors on different displays." (from XmSetMenuCursor.3X manual page).
  541.  *
  542.  * <fontcursor>> specifies the shape of the cursor for this interaction.
  543.  * The value of this FIXNUM specifies a font whose name/value is defined in
  544.  * /usr/include/X11/cursorfont.h.
  545.  *
  546.  * Note: when WINTERP allows for multiple displays, this function will
  547.  * end up changing arg sequences to accomodate a <display> arg.
  548.  *----------------------------------------------------------------------------
  549.  *           void XmSetMenuCursor (display, cursorId)
  550.  *                Display   * display;
  551.  *                Cursor    cursorId;
  552.  ******************************************************************************/
  553. LVAL Wxm_Prim_XM_SET_MENU_CURSOR()
  554. {
  555.   extern Display* display;    /* from winterp.c -- this'll have to change when WINTERP gets updated for multi-display. */
  556.   Cursor cursor;
  557.   LVAL lval_fontcursor_shape;
  558.   long fontcursor_shape;
  559.  
  560.   /* get <fontcursor> */
  561.   lval_fontcursor_shape = xlgafixnum();
  562.   
  563.   xllastarg();
  564.  
  565.   /* convert <fontcursor> to a cursor */
  566.   fontcursor_shape = (long) getfixnum(lval_fontcursor_shape);
  567.   if ((fontcursor_shape & 1L) != 0) /* <fontcursor-FIXNUM> can't be an odd number ... */
  568.     xlerror("Font-Cursor fixnum must be an even number", lval_fontcursor_shape);
  569.   if ((fontcursor_shape < 0L) || (fontcursor_shape > (long) (XC_num_glyphs - 2)))
  570.     xlerror("Font-Cursor fixnum out of range", lval_fontcursor_shape);
  571.   cursor = XCreateFontCursor(display, (unsigned int) fontcursor_shape);
  572.  
  573.   XmSetMenuCursor(display, cursor);
  574.   return (NIL);
  575. }
  576.  
  577.  
  578. #ifdef THE_FOLLOWING_CODE_IS_COMMENTED_OUT /* punt because XmGetDestination() missing in HP's UEDK Motif 1.1, it's there in OSFMotif 1.1 */
  579. /******************************************************************************
  580.  * (XM_GET_DESTINATION)
  581.  *     ==> Returns a WIDGETOBJ, "the widget to be used as the current
  582.  *        destination for quick paste and certain clipboard operations."
  583.  *        Returns NIL if "there is no current destination".
  584.  *
  585.  * See XmGetDestination.3X manual page for details.
  586.  *-----------------------------------------------------------------------------
  587.  *           Widget XmGetDestination (display)
  588.  *                Display   *display;
  589.  ******************************************************************************/
  590. LVAL Wxm_Prim_XM_GET_DESTINATION()
  591. {
  592.   extern LVAL Wcls_WidgetID_To_WIDGETOBJ(); /* w_classes.c */
  593.   extern Display* display;    /* winterp.c */
  594.   xllastarg();
  595.   return (Wcls_WidgetID_To_WIDGETOBJ(XmGetDestination(display)));
  596. }
  597. #endif                /* THE_FOLLOWING_CODE_IS_COMMENTED_OUT */
  598.  
  599.  
  600. /******************************************************************************
  601.  *
  602.  ******************************************************************************/
  603. Wxm_Init()
  604. {
  605. #ifdef WINTERP_MOTIF_11
  606.   /* these are used by Wxm_Prim_XM_CONVERT_UNITS(), which is Motif 1.1 only */
  607.   k_VERTICAL        = xlenter(":VERTICAL");
  608.   k_HORIZONTAL        = xlenter(":HORIZONTAL");
  609.   k_PIXELS        = xlenter(":PIXELS");
  610.   k_100TH_MILLIMETERS    = xlenter(":100TH_MILLIMETERS");
  611.   k_1000TH_INCHES    = xlenter(":1000TH_INCHES");
  612.   k_100TH_POINTS    = xlenter(":100TH_POINTS");
  613.   k_100TH_FONT_UNITS    = xlenter(":100TH_FONT_UNITS");
  614.  
  615.   /* these are used by Widget_Class_Method_PROCESS_TRAVERSAL(), which is Motif 1.1 only */
  616.   k_TRAVERSE_CURRENT    = xlenter(":TRAVERSE_CURRENT");
  617.   k_TRAVERSE_NEXT    = xlenter(":TRAVERSE_NEXT");
  618.   k_TRAVERSE_PREV    = xlenter(":TRAVERSE_PREV");
  619.   k_TRAVERSE_HOME    = xlenter(":TRAVERSE_HOME");
  620.   k_TRAVERSE_NEXT_TAB_GROUP = xlenter(":TRAVERSE_NEXT_TAB_GROUP");
  621.   k_TRAVERSE_PREV_TAB_GROUP = xlenter(":TRAVERSE_PREV_TAB_GROUP");
  622.   k_TRAVERSE_UP        = xlenter(":TRAVERSE_UP");
  623.   k_TRAVERSE_DOWN    = xlenter(":TRAVERSE_DOWN");
  624.   k_TRAVERSE_LEFT    = xlenter(":TRAVERSE_LEFT");
  625.   k_TRAVERSE_RIGHT    = xlenter(":TRAVERSE_RIGHT");
  626. #endif                /* WINTERP_MOTIF_11 */
  627. }
  628.