Initial revision

1 files changed, 1797 insertions, 0 deletions

diff --git a/lisp/modules/xt.c b/lisp/modules/xt.c
new file mode 100644
index 0000000..13c7ae7
--- /dev/null
+++ b/lisp/modules/xt.c
@@ -0,0 +1,1797 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/xt.c,v 1.19 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#include <X11/Shell.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Types
+ */
+typedef struct {
+    XrmQuark qname;
+    XrmQuark qtype;
+    Cardinal size;
+} ResourceInfo;
+
+typedef struct {
+    WidgetClass widget_class;
+    ResourceInfo **resources;
+    Cardinal num_resources;
+    Cardinal num_cons_resources;
+} ResourceList;
+
+typedef struct {
+    Arg *args;
+    Cardinal num_args;
+} Resources;
+
+typedef struct {
+    LispObj *data;
+    /* data is => (list* widget callback argument) */
+} CallbackArgs;
+
+/*
+ * Prototypes
+ */
+int xtLoadModule(LispMac*);
+void LispXtCleanupCallback(Widget, XtPointer, XtPointer);
+
+void LispXtCallback(Widget, XtPointer, XtPointer);
+void LispXtInputCallback(XtPointer, int*, XtInputId*);
+
+/* a hack... */
+LispObj *Lisp_XtCoerceToWidgetList(LispBuiltin*);
+
+LispObj *Lisp_XtAddCallback(LispBuiltin*);
+LispObj *Lisp_XtAppInitialize(LispBuiltin*);
+LispObj *Lisp_XtAppMainLoop(LispBuiltin*);
+LispObj *Lisp_XtAppAddInput(LispBuiltin*);
+LispObj *Lisp_XtAppPending(LispBuiltin*);
+LispObj *Lisp_XtAppProcessEvent(LispBuiltin*);
+LispObj *Lisp_XtCreateWidget(LispBuiltin*);
+LispObj *Lisp_XtCreateManagedWidget(LispBuiltin*);
+LispObj *Lisp_XtCreatePopupShell(LispBuiltin*);
+LispObj *Lisp_XtDestroyWidget(LispBuiltin*);
+LispObj *Lisp_XtGetKeyboardFocusWidget(LispBuiltin*);
+LispObj *Lisp_XtGetValues(LispBuiltin*);
+LispObj *Lisp_XtManageChild(LispBuiltin*);
+LispObj *Lisp_XtUnmanageChild(LispBuiltin*);
+LispObj *Lisp_XtSetMappedWhenManaged(LispBuiltin*);
+LispObj *Lisp_XtMapWidget(LispBuiltin*);
+LispObj *Lisp_XtName(LispBuiltin*);
+LispObj *Lisp_XtParent(LispBuiltin*);
+LispObj *Lisp_XtUnmapWidget(LispBuiltin*);
+LispObj *Lisp_XtPopup(LispBuiltin*);
+LispObj *Lisp_XtPopdown(LispBuiltin*);
+LispObj *Lisp_XtIsRealized(LispBuiltin*);
+LispObj *Lisp_XtRealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtUnrealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtRemoveInput(LispBuiltin*);
+LispObj *Lisp_XtSetSensitive(LispBuiltin*);
+LispObj *Lisp_XtSetValues(LispBuiltin*);
+LispObj *Lisp_XtWidgetToApplicationContext(LispBuiltin*);
+LispObj *Lisp_XtDisplay(LispBuiltin*);
+LispObj *Lisp_XtDisplayOfObject(LispBuiltin*);
+LispObj *Lisp_XtScreen(LispBuiltin*);
+LispObj *Lisp_XtScreenOfObject(LispBuiltin*);
+LispObj *Lisp_XtSetKeyboardFocus(LispBuiltin*);
+LispObj *Lisp_XtWindow(LispBuiltin*);
+LispObj *Lisp_XtWindowOfObject(LispBuiltin*);
+LispObj *Lisp_XtAddGrab(LispBuiltin*);
+LispObj *Lisp_XtRemoveGrab(LispBuiltin*);
+LispObj *Lisp_XtAppGetExitFlag(LispBuiltin*);
+LispObj *Lisp_XtAppSetExitFlag(LispBuiltin*);
+
+LispObj *LispXtCreateWidget(LispBuiltin*, int);
+
+static Resources *LispConvertResources(LispObj*, Widget,
+				       ResourceList*, ResourceList*);
+static void LispFreeResources(Resources*);
+
+static int bcmp_action_resource(_Xconst void*, _Xconst void*);
+static ResourceInfo *GetResourceInfo(char*, ResourceList*, ResourceList*);
+static ResourceList *GetResourceList(WidgetClass);
+static int bcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *FindResourceList(WidgetClass);
+static int qcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *CreateResourceList(WidgetClass);
+static int qcmp_action_resource(_Xconst void*, _Xconst void*);
+static void BindResourceList(ResourceList*);
+
+static void PopdownAction(Widget, XEvent*, String*, Cardinal*);
+static void QuitAction(Widget, XEvent*, String*, Cardinal*);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XtCoerceToWidgetList, "xt-coerce-to-widget-list number opaque"},
+
+    {LispFunction, Lisp_XtAddGrab, "xt-add-grab widget exclusive spring-loaded"},
+    {LispFunction, Lisp_XtAddCallback, "xt-add-callback widget callback-name callback &optional client-data"},
+    {LispFunction, Lisp_XtAppAddInput, "xt-app-add-input app-context fileno condition function &optional client-data"},
+    {LispFunction, Lisp_XtAppInitialize, "xt-app-initialize app-context-return application-class &optional options fallback-resources"},
+    {LispFunction, Lisp_XtAppPending, "xt-app-pending app-context"},
+    {LispFunction, Lisp_XtAppMainLoop, "xt-app-main-loop app-context"},
+    {LispFunction, Lisp_XtAppProcessEvent, "xt-app-process-event app-context &optional mask"},
+    {LispFunction, Lisp_XtAppGetExitFlag, "xt-app-get-exit-flag app-context"},
+    {LispFunction, Lisp_XtAppSetExitFlag, "xt-app-set-exit-flag app-context"},
+    {LispFunction, Lisp_XtCreateManagedWidget, "xt-create-managed-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreateWidget, "xt-create-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreatePopupShell, "xt-create-popup-shell name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtDestroyWidget, "xt-destroy-widget widget"},
+    {LispFunction, Lisp_XtGetKeyboardFocusWidget, "xt-get-keyboard-focus-widget widget"},
+    {LispFunction, Lisp_XtGetValues, "xt-get-values widget arguments"},
+    {LispFunction, Lisp_XtManageChild, "xt-manage-child widget"},
+    {LispFunction, Lisp_XtName, "xt-name widget"},
+    {LispFunction, Lisp_XtUnmanageChild, "xt-unmanage-child widget"},
+    {LispFunction, Lisp_XtMapWidget, "xt-map-widget widget"},
+    {LispFunction, Lisp_XtUnmapWidget, "xt-unmap-widget widget"},
+    {LispFunction, Lisp_XtSetMappedWhenManaged, "xt-set-mapped-when-managed widget map-when-managed"},
+    {LispFunction, Lisp_XtParent, "xt-parent widget"},
+    {LispFunction, Lisp_XtPopup, "xt-popup widget grab-kind"},
+    {LispFunction, Lisp_XtPopdown, "xt-popdown widget"},
+    {LispFunction, Lisp_XtIsRealized, "xt-is-realized widget"},
+    {LispFunction, Lisp_XtRealizeWidget, "xt-realize-widget widget"},
+    {LispFunction, Lisp_XtUnrealizeWidget, "xt-unrealize-widget widget"},
+    {LispFunction, Lisp_XtRemoveInput, "xt-remove-input input"},
+    {LispFunction, Lisp_XtRemoveGrab, "xt-remove-grab widget"},
+    {LispFunction, Lisp_XtSetKeyboardFocus, "xt-set-keyboard-focus widget descendant"},
+    {LispFunction, Lisp_XtSetSensitive, "xt-set-sensitive widget sensitive"},
+    {LispFunction, Lisp_XtSetValues, "xt-set-values widget arguments"},
+    {LispFunction, Lisp_XtWidgetToApplicationContext, "xt-widget-to-application-context widget"},
+    {LispFunction, Lisp_XtDisplay, "xt-display widget"},
+    {LispFunction, Lisp_XtDisplayOfObject, "xt-display-of-object object"},
+    {LispFunction, Lisp_XtScreen, "xt-screen widget"},
+    {LispFunction, Lisp_XtScreenOfObject, "xt-screen-of-object object"},
+    {LispFunction, Lisp_XtWindow, "xt-window widget"},
+    {LispFunction, Lisp_XtWindowOfObject, "xt-window-of-object object"},
+};
+
+LispModuleData xtLispModuleData = {
+    LISP_MODULE_VERSION,
+    xtLoadModule,
+};
+
+static ResourceList **resource_list;
+static Cardinal num_resource_list;
+
+static Atom delete_window;
+static int xtAppContext_t, xtWidget_t, xtWidgetClass_t, xtWidgetList_t,
+	   xtInputId_t, xtDisplay_t, xtScreen_t, xtWindow_t;
+
+static XtActionsRec actions[] = {
+    {"xt-popdown",	PopdownAction},
+    {"xt-quit",		QuitAction},
+};
+
+static XrmQuark qCardinal, qInt, qString, qWidget, qFloat;
+
+static CallbackArgs **input_list;
+static Cardinal num_input_list, size_input_list;
+
+/*
+ * Implementation
+ */
+int
+xtLoadModule(void)
+{
+    int i;
+    char *fname = "XT-LOAD-MODULE";
+
+    xtAppContext_t = LispRegisterOpaqueType("XtAppContext");
+    xtWidget_t = LispRegisterOpaqueType("Widget");
+    xtWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
+    xtWidgetList_t = LispRegisterOpaqueType("WidgetList");
+    xtInputId_t = LispRegisterOpaqueType("XtInputId");
+    xtDisplay_t = LispRegisterOpaqueType("Display*");
+    xtScreen_t = LispRegisterOpaqueType("Screen*");
+    xtWindow_t = LispRegisterOpaqueType("Window");
+
+    LispExecute("(DEFSTRUCT XT-WIDGET-LIST NUM-CHILDREN CHILDREN)\n");
+
+    GCDisable();
+    (void)LispSetVariable(ATOM2("CORE-WIDGET-CLASS"),
+			  OPAQUE(coreWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("COMPOSITE-WIDGET-CLASS"),
+			  OPAQUE(compositeWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("CONSTRAINT-WIDGET-CLASS"),
+			  OPAQUE(constraintWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TRANSIENT-SHELL-WIDGET-CLASS"),
+			  OPAQUE(transientShellWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+
+    /* parameters for XtPopup */
+    (void)LispSetVariable(ATOM2("XT-GRAB-EXCLUSIVE"),
+			  INTEGER(XtGrabExclusive), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE"),
+			  INTEGER(XtGrabNone), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE-EXCLUSIVE"),
+			  INTEGER(XtGrabNonexclusive), fname, 0);
+
+    /* parameters for XtAppProcessEvent */
+    (void)LispSetVariable(ATOM2("XT-IM-XEVENT"),
+			  INTEGER(XtIMXEvent), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-TIMER"),
+			  INTEGER(XtIMTimer), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALTERNATE-INPUT"),
+			  INTEGER(XtIMAlternateInput), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-SIGNAL"),
+			  INTEGER(XtIMSignal), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALL"),
+			  INTEGER(XtIMAll), fname, 0);
+
+    /* parameters for XtAppAddInput */
+    (void)LispSetVariable(ATOM2("XT-INPUT-READ-MASK"),
+			  INTEGER(XtInputReadMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-WRITE-MASK"),
+			  INTEGER(XtInputWriteMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-EXCEPT-MASK"),
+			  INTEGER(XtInputExceptMask), fname, 0);
+    GCEnable();
+
+    qCardinal = XrmPermStringToQuark(XtRCardinal);
+    qInt = XrmPermStringToQuark(XtRInt);
+    qString = XrmPermStringToQuark(XtRString);
+    qWidget = XrmPermStringToQuark(XtRWidget);
+    qFloat = XrmPermStringToQuark(XtRFloat);
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+void
+LispXtCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	   /* reall caller */
+    code = CONS(CDR(CDR(args->data)), CONS(OPAQUE(w, xtWidget_t),
+		CONS(CAR(CDR(args->data)), CONS(OPAQUE(call_data, 0), NIL))));
+		     /* user arguments */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+
+void
+LispXtCleanupCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+
+    UPROTECT(CAR(args->data), args->data);
+    XtFree((XtPointer)args);
+}
+
+void
+LispXtInputCallback(XtPointer closure, int *source, XtInputId *id)
+{
+    CallbackArgs *args = (CallbackArgs*)closure;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	  /* user arguments */
+    code = CONS(CDR(CDR(args->data)), CONS(CAR(CDR(args->data)),
+		CONS(INTEGER(*source), CONS(CAR(args->data), NIL))));
+		     /* input source */	   /* input id */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+LispObj *
+Lisp_XtCoerceToWidgetList(LispBuiltin *builtin)
+/*
+ xt-coerce-to-widget-list number opaque
+ */
+{
+    int i;
+    WidgetList children;
+    Cardinal num_children;
+    LispObj *cons, *widget_list, *result;
+
+    LispObj *onumber, *opaque;
+
+    opaque = ARGUMENT(1);
+    onumber = ARGUMENT(0);
+
+    CHECK_INDEX(onumber);
+    num_children = FIXNUM_VALUE(onumber);
+
+    if (!CHECKO(opaque, xtWidgetList_t))
+	LispDestroy("%s: cannot convert %s to WidgetList",
+		    STRFUN(builtin), STROBJ(opaque));
+    children = (WidgetList)(opaque->data.opaque.data);
+
+    GCDisable();
+    widget_list = cons = NIL;
+    for (i = 0; i < num_children; i++) {
+	result = CONS(OPAQUE(children[i], xtWidget_t), NIL);
+	if (widget_list == NIL)
+	    widget_list = cons = result;
+	else {
+	    RPLACD(cons, result);
+	    cons = CDR(cons);
+	}
+    }
+
+    result = APPLY(ATOM("MAKE-XT-WIDGET-LIST"),
+		   CONS(KEYWORD("NUM-CHILDREN"),
+			CONS(INTEGER(num_children),
+			     CONS(KEYWORD("CHILDREN"),
+				  CONS(widget_list, NIL)))));
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtAddCallback(LispBuiltin *builtin)
+/*
+ xt-add-callback widget callback-name callback &optional client-data
+ */
+{
+    CallbackArgs *arguments;
+    LispObj *data;
+
+    LispObj *widget, *callback_name, *callback, *client_data;
+
+    client_data = ARGUMENT(3);
+    callback = ARGUMENT(2);
+    callback_name = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    CHECK_STRING(callback_name);
+    if (!SYMBOLP(callback) && callback->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(callback));
+
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(widget, CONS(client_data, callback));
+    PROTECT(widget, data);
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    XtAddCallback((Widget)(widget->data.opaque.data), THESTR(callback_name),
+		  LispXtCallback, (XtPointer)arguments);
+    XtAddCallback((Widget)(widget->data.opaque.data), XtNdestroyCallback,
+		  LispXtCleanupCallback, (XtPointer)arguments);
+
+    return (client_data);
+}
+
+LispObj *
+Lisp_XtAppAddInput(LispBuiltin *builtin)
+/*
+  xt-app-add-input app-context fileno condition function &optional client-data
+ */
+{
+    LispObj *data, *input;
+    XtAppContext appcon;
+    int source, condition;
+    CallbackArgs *arguments;
+    XtInputId id;
+
+    LispObj *app_context, *fileno, *ocondition, *function, *client_data;
+
+    client_data = ARGUMENT(4);
+    function = ARGUMENT(3);
+    ocondition = ARGUMENT(2);
+    fileno = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+
+    CHECK_LONGINT(fileno);
+    source = LONGINT_VALUE(fileno);
+
+    CHECK_FIXNUM(ocondition);
+    condition = FIXNUM_VALUE(ocondition);
+
+    if (!SYMBOLP(function) && function->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(function));
+
+    /* client data optional */
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(NIL, CONS(client_data, function));
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    id = XtAppAddInput(appcon, source, (XtPointer)condition,
+		       LispXtInputCallback, (XtPointer)arguments);
+    GCDisable();
+    input = OPAQUE(id, xtInputId_t);
+    GCEnable();
+    RPLACA(data, input);
+    PROTECT(input, data);
+
+    if (num_input_list + 1 >= size_input_list) {
+	++size_input_list;
+	input_list = (CallbackArgs**)
+	    XtRealloc((XtPointer)input_list,
+		      sizeof(CallbackArgs*) * size_input_list);
+    }
+    input_list[num_input_list++] = arguments;
+
+    return (input);
+}
+
+LispObj *
+Lisp_XtRemoveInput(LispBuiltin *builtin)
+/*
+ xt-remove-input input
+ */
+{
+    int i;
+    XtInputId id;
+    CallbackArgs *args;
+
+    LispObj *input;
+
+    input = ARGUMENT(0);
+
+    if (!CHECKO(input, xtInputId_t))
+	LispDestroy("%s: cannot convert %s to XtInputId",
+		    STRFUN(builtin), STROBJ(input));
+
+    id = (XtInputId)(input->data.opaque.data);
+    for (i = 0; i < num_input_list; i++) {
+	args = input_list[i];
+	if (id == (XtInputId)(CAR(args->data)->data.opaque.data)) {
+	    UPROTECT(CAR(args->data), args->data);
+	    XtFree((XtPointer)args);
+
+	    if (i + 1 < num_input_list)
+		memmove(input_list + i, input_list + i + 1,
+			sizeof(CallbackArgs*) * (num_input_list - i - 1));
+	    --num_input_list;
+
+	    XtRemoveInput(id);
+
+	    return (T);
+	}
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppInitialize(LispBuiltin *builtin)
+/*
+ xt-app-initialize app-context-return application-class &optional options fallback-resources
+ */
+{
+    XtAppContext appcon;
+    Widget shell;
+    int zero = 0;
+    Resources *resources = NULL;
+    String *fallback = NULL;
+
+    LispObj *app_context_return, *application_class,
+	    *options, *fallback_resources;
+
+    fallback_resources = ARGUMENT(3);
+    options = ARGUMENT(2);
+    application_class = ARGUMENT(1);
+    app_context_return = ARGUMENT(0);
+
+    CHECK_SYMBOL(app_context_return);
+    CHECK_STRING(application_class);
+    CHECK_LIST(options);
+
+    /* check fallback resources, if given */
+    if (fallback_resources != UNSPEC) {
+	LispObj *string;
+	int count;
+
+	CHECK_CONS(fallback_resources);
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    CHECK_STRING(CAR(string));
+
+	/* fallback resources was correctly specified */
+	fallback = LispMalloc(sizeof(String) * (count + 1));
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    fallback[count] = THESTR(CAR(string));
+	fallback[count] = NULL;
+    }
+
+    shell = XtAppInitialize(&appcon, THESTR(application_class), NULL,
+			    0, &zero, NULL, fallback, NULL, 0);
+    if (fallback)
+	LispFree(fallback);
+    (void)LispSetVariable(app_context_return,
+			  OPAQUE(appcon, xtAppContext_t),
+			  STRFUN(builtin), 0);
+
+    XtAppAddActions(appcon, actions, XtNumber(actions));
+
+    if (options != UNSPEC) {
+	resources = LispConvertResources(options, shell,
+					 GetResourceList(XtClass(shell)),
+					 NULL);
+	if (resources) {
+	    XtSetValues(shell, resources->args, resources->num_args);
+	    LispFreeResources(resources);
+	}
+    }
+
+    return (OPAQUE(shell, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppMainLoop(LispBuiltin *builtin)
+/*
+ xt-app-main-loop app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppMainLoop((XtAppContext)(app_context->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppPending(LispBuiltin *builtin)
+/*
+ xt-app-pending app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (INTEGER(
+	    XtAppPending((XtAppContext)(app_context->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtAppProcessEvent(LispBuiltin *builtin)
+/*
+ xt-app-process-event app-context &optional mask
+ */
+{
+    XtInputMask mask;
+    XtAppContext appcon;
+
+    LispObj *app_context, *omask;
+
+    omask = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+    if (omask == UNSPEC)
+	mask = XtIMAll;
+    else {
+	CHECK_FIXNUM(omask);
+	mask = FIXNUM_VALUE(omask);
+    }
+
+    if (mask != (mask & XtIMAll))
+	LispDestroy("%s: %d does not fit in XtInputMask %d",
+		    STRFUN(builtin), mask);
+
+    if (mask)
+	XtAppProcessEvent(appcon, mask);
+
+    return (omask == NIL ? FIXNUM(mask) : omask);
+}
+
+LispObj *
+Lisp_XtRealizeWidget(LispBuiltin *builtin)
+/*
+ xt-realize-widget widget
+ */
+{
+    Widget widget;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    XtRealizeWidget(widget);
+
+    if (XtIsSubclass(widget, shellWidgetClass)) {
+	if (!delete_window)
+	    delete_window = XInternAtom(XtDisplay(widget),
+					"WM_DELETE_WINDOW", False);
+	(void)XSetWMProtocols(XtDisplay(widget), XtWindow(widget),
+			      &delete_window, 1);
+    }
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtUnrealizeWidget(LispBuiltin *builtin)
+/*
+ xt-unrealize-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtUnrealizeWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtIsRealized(LispBuiltin *builtin)
+/*
+ xt-is-realized widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (XtIsRealized((Widget)(widget->data.opaque.data)) ? T : NIL);
+}
+
+LispObj *
+Lisp_XtDestroyWidget(LispBuiltin *builtin)
+/*
+ xt-destroy-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtDestroyWidget((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+#define UNMANAGED	0
+#define MANAGED		1
+#define SHELL		2
+LispObj *
+Lisp_XtCreateWidget(LispBuiltin *builtin)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, UNMANAGED));
+}
+
+LispObj *
+Lisp_XtCreateManagedWidget(LispBuiltin *builtin)
+/*
+ xt-create-managed-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, MANAGED));
+}
+
+LispObj *
+Lisp_XtCreatePopupShell(LispBuiltin *builtin)
+/*
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, SHELL));
+}
+
+LispObj *
+LispXtCreateWidget(LispBuiltin *builtin, int options)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ xt-create-managed-widget name widget-class parent &optional arguments
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    char *name;
+    WidgetClass widget_class;
+    Widget widget, parent;
+    Resources *resources = NULL;
+
+    LispObj *oname, *owidget_class, *oparent, *arguments;
+
+    arguments = ARGUMENT(3);
+    oparent = ARGUMENT(2);
+    owidget_class = ARGUMENT(1);
+    oname = ARGUMENT(0);
+
+    CHECK_STRING(oname);
+    name = THESTR(oname);
+
+    if (!CHECKO(owidget_class, xtWidgetClass_t))
+	LispDestroy("%s: cannot convert %s to WidgetClass",
+		    STRFUN(builtin), STROBJ(owidget_class));
+    widget_class = (WidgetClass)(owidget_class->data.opaque.data);
+
+    if (!CHECKO(oparent, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(oparent));
+    parent = (Widget)(oparent->data.opaque.data);
+
+    CHECK_LIST(arguments);
+
+    if (options == SHELL)
+	widget = XtCreatePopupShell(name, widget_class, parent, NULL, 0);
+    else
+	widget = XtCreateWidget(name, widget_class, parent, NULL, 0);
+
+    if (arguments == UNSPEC || arguments == NIL)
+	resources = NULL;
+    else {
+	resources = LispConvertResources(arguments, widget,
+					 GetResourceList(widget_class),
+					 GetResourceList(XtClass(parent)));
+	XtSetValues(widget, resources->args, resources->num_args);
+    }
+    if (options == MANAGED)
+	XtManageChild(widget);
+    if (resources)
+	LispFreeResources(resources);
+
+    return (OPAQUE(widget, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetKeyboardFocusWidget(LispBuiltin *builtin)
+/*
+ xt-get-keyboard-focus-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    return (OPAQUE(XtGetKeyboardFocusWidget((Widget)(widget->data.opaque.data)),
+		   xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetValues(LispBuiltin *builtin)
+/*
+ xt-get-values widget arguments
+ */
+{
+    Arg args[1];
+    Widget widget;
+    ResourceList *rlist, *plist;
+    ResourceInfo *resource;
+    LispObj *list, *object = NIL, *result, *cons = NIL;
+    char c1;
+    short c2;
+    int c4;
+#ifdef LONG64
+    long c8;
+#endif
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (NIL);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+
+    rlist = GetResourceList(XtClass(widget));
+    plist =  XtParent(widget) ?
+	     GetResourceList(XtClass(XtParent(widget))) : NULL;
+
+    GCDisable();
+    result = NIL;
+    for (list = arguments; CONS_P(list); list = CDR(list)) {
+	CHECK_STRING(CAR(list));
+	if ((resource = GetResourceInfo(THESTR(CAR(list)), rlist, plist))
+	     == NULL) {
+	    int i;
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(CAR(list)),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    STRFUN(builtin), THESTR(CAR(list)));
+		continue;
+	    }
+	}
+	switch (resource->size) {
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c1);
+		break;
+	    case 2:
+		XtSetArg(args[0], THESTR(CAR(list)), &c2);
+		break;
+	    case 4:
+		XtSetArg(args[0], THESTR(CAR(list)), &c4);
+		break;
+#ifdef LONG64
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c8);
+		break;
+#endif
+	}
+	XtGetValues(widget, args, 1);
+
+	/* special resources */
+	if (resource->qtype == qString) {
+#ifdef LONG64
+	    object = CONS(CAR(list), STRING(c8));
+#else
+	    object = CONS(CAR(list), STRING(c4));
+#endif
+	}
+	else if (resource->qtype == qCardinal || resource->qtype == qInt) {
+#ifdef LONG64
+	    if (sizeof(int) == 8)
+		object = CONS(CAR(list), INTEGER(c8));
+	    else
+#endif
+	    object = CONS(CAR(list), INTEGER(c4));
+	}
+	else {
+	    switch (resource->size) {
+		case 1:
+		    object = CONS(CAR(list), OPAQUE(c1, 0));
+		    break;
+		case 2:
+		    object = CONS(CAR(list), OPAQUE(c2, 0));
+		    break;
+		case 4:
+		    object = CONS(CAR(list), OPAQUE(c4, 0));
+		    break;
+#ifdef LONG64
+		case 8:
+		    object = CONS(CAR(list), OPAQUE(c8, 0));
+		    break;
+#endif
+	    }
+	}
+
+	if (result == NIL)
+	    result = cons = CONS(object, NIL);
+	else {
+	    RPLACD(cons, CONS(object, NIL));
+	    cons = CDR(cons);
+	}
+    }
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtManageChild(LispBuiltin *builtin)
+/*
+ xt-manage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtManageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmanageChild(LispBuiltin *builtin)
+/*
+ xt-unmanage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmanageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtMapWidget(LispBuiltin *builtin)
+/*
+ xt-map-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtMapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmapWidget(LispBuiltin *builtin)
+/*
+ xt-unmap-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetMappedWhenManaged(LispBuiltin *builtin)
+/*
+ xt-set-mapped-when-managed widget map-when-managed
+ */
+{
+    LispObj *widget, *map_when_managed;
+
+    map_when_managed = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtSetMappedWhenManaged((Widget)(widget->data.opaque.data),
+			   map_when_managed != NIL);
+
+    return (map_when_managed);
+}
+
+LispObj *
+Lisp_XtPopup(LispBuiltin *builtin)
+/*
+ xt-popup widget grab-kind
+ */
+{
+    XtGrabKind kind;
+
+    LispObj *widget, *grab_kind;
+
+    grab_kind = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    CHECK_INDEX(grab_kind);
+    kind = (XtGrabKind)FIXNUM_VALUE(grab_kind);
+    if (kind != XtGrabExclusive && kind != XtGrabNone &&
+	kind != XtGrabNonexclusive)
+	LispDestroy("%s: %d does not fit in XtGrabKind",
+		    STRFUN(builtin), kind);
+    XtPopup((Widget)(widget->data.opaque.data), kind);
+
+    return (grab_kind);
+}
+
+LispObj *
+Lisp_XtPopdown(LispBuiltin *builtin)
+/*
+ xt-popdown widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtPopdown((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetKeyboardFocus(LispBuiltin *builtin)
+/*
+ xt-set-keyboard-focus widget descendant
+ */
+{
+    LispObj *widget, *descendant;
+
+    descendant = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    if (!CHECKO(descendant, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(descendant));
+    XtSetKeyboardFocus((Widget)(widget->data.opaque.data),
+		       (Widget)(descendant->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetSensitive(LispBuiltin *builtin)
+/*
+ xt-set-sensitive widget sensitive
+ */
+{
+    LispObj *widget, *sensitive;
+
+    sensitive = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtSetSensitive((Widget)(widget->data.opaque.data), sensitive != NIL);
+
+    return (sensitive);
+}
+
+LispObj *
+Lisp_XtSetValues(LispBuiltin *builtin)
+/*
+ xt-set-values widget arguments
+ */
+{
+    Widget widget;
+    Resources *resources;
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (owidget);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+    resources = LispConvertResources(arguments, widget,
+				     GetResourceList(XtClass(widget)),
+				     XtParent(widget) ?
+					GetResourceList(XtClass(XtParent(widget))) :
+					NULL);
+    XtSetValues(widget, resources->args, resources->num_args);
+    LispFreeResources(resources);
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtWidgetToApplicationContext(LispBuiltin *builtin)
+/*
+ xt-widget-to-application-context widget
+ */
+{
+    Widget widget;
+    XtAppContext appcon;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    appcon = XtWidgetToApplicationContext(widget);
+
+    return (OPAQUE(appcon, xtAppContext_t));
+}
+
+LispObj *
+Lisp_XtDisplay(LispBuiltin *builtin)
+/*
+ xt-display widget
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    display = XtDisplay(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtDisplayOfObject(LispBuiltin *builtin)
+/*
+ xt-display-of-object object
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    display = XtDisplayOfObject(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtScreen(LispBuiltin *builtin)
+/*
+ xt-screen widget
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    screen = XtScreen(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtScreenOfObject(LispBuiltin *builtin)
+/*
+ xt-screen-of-object object
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    screen = XtScreenOfObject(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtWindow(LispBuiltin *builtin)
+/*
+ xt-window widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    window = XtWindow(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtWindowOfObject(LispBuiltin *builtin)
+/*
+ xt-window-of-object widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    window = XtWindowOfObject(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtAddGrab(LispBuiltin *builtin)
+/*
+ xt-add-grab widget exclusive spring-loaded
+ */
+{
+    Widget widget;
+    Bool exclusive, spring_loaded;
+
+    LispObj *owidget, *oexclusive, *ospring_loaded;
+
+    ospring_loaded = ARGUMENT(2);
+    oexclusive = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    exclusive = oexclusive != NIL;
+    spring_loaded = ospring_loaded != NIL;
+
+    XtAddGrab(widget, exclusive, spring_loaded);
+
+    return (T);
+}
+
+LispObj *
+Lisp_XtRemoveGrab(LispBuiltin *builtin)
+/*
+ xt-remove-grab widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtRemoveGrab((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtName(LispBuiltin *builtin)
+/*
+ xt-name widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (STRING(XtName((Widget)(widget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtParent(LispBuiltin *builtin)
+/*
+ xt-parent widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (OPAQUE(XtParent((Widget)widget->data.opaque.data), xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppGetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (XtAppGetExitFlag((XtAppContext)(app_context->data.opaque.data)) ?
+	    T : NIL);
+}
+
+LispObj *
+Lisp_XtAppSetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppSetExitFlag((XtAppContext)(app_context->data.opaque.data));
+
+    return (T);
+}
+
+static Resources *
+LispConvertResources(LispObj *list, Widget widget,
+		     ResourceList *rlist, ResourceList *plist)
+{
+    char c1;
+    short c2;
+    int c4;   
+#ifdef LONG64
+    long c8;
+#endif
+    XrmValue from, to;
+    LispObj *arg, *val;
+    ResourceInfo *resource;
+    char *fname = "XT-CONVERT-RESOURCES";
+    Resources *resources = (Resources*)XtCalloc(1, sizeof(Resources));
+
+    for (; CONSP(list); list = CDR(list)) {
+	if (!CONSP(CAR(list))) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a cons", fname, STROBJ(CAR(list)));
+	}
+	arg = CAR(CAR(list));
+	val = CDR(CAR(list));
+
+	if (!STRINGP(arg)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a string", fname, STROBJ(arg));
+	}
+
+	if ((resource = GetResourceInfo(THESTR(arg), rlist, plist)) == NULL) {
+	    int i;
+	    Arg args[1];
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(arg),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    fname, THESTR(arg));
+		continue;
+	    }
+	}
+
+	if (LONGINTP(val) || DFLOATP(val) || OPAQUEP(val)) {
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    if (!OPAQUEP(val)) {
+		float fvalue;
+
+		if (DFLOATP(val))
+		    fvalue = DFLOAT_VALUE(val);
+		else
+		    fvalue = LONGINT_VALUE(val);
+		if (resource->qtype == qFloat) {
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname), fvalue);
+		}
+		else
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname),
+			     (int)fvalue);
+	    }
+	    else
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), val->data.opaque.data);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == NIL) {
+	    /* XXX assume it is a pointer or a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a pointer or boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), NULL);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == T) {
+	    /* XXX assume it is a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), True);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (!STRINGP(val)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: resource value must be string, number or opaque, not %s",
+			fname, STROBJ(val));
+	}
+
+	from.size = val == NIL ? 1 : strlen(THESTR(val)) + 1;
+	from.addr = val == NIL ? "" : THESTR(val);
+	switch (to.size = resource->size) {
+	    case 1:
+		to.addr = (XtPointer)&c1;
+		break;
+	    case 2:
+		to.addr = (XtPointer)&c2;
+		break;
+	    case 4:
+		to.addr = (XtPointer)&c4;
+		break;
+#ifdef LONG64
+	    case 8:
+		to.addr = (XtPointer)&c8;
+		break;
+#endif
+	    default:
+		LispWarning("%s: bad resource size %d for %s",
+			    fname, to.size, THESTR(arg));
+		continue;
+	}
+
+	if (qString == resource->qtype)
+#ifdef LONG64
+	    c8 = (long)from.addr;
+#else
+	    c4 = (long)from.addr;
+#endif
+	else if (!XtConvertAndStore(widget, XtRString, &from,
+				    XrmQuarkToString(resource->qtype), &to))
+	    /* The type converter already have printed an error message */
+	    continue;
+
+	resources->args = (Arg*)
+	    XtRealloc((XtPointer)resources->args,
+		      sizeof(Arg) * (resources->num_args + 1));
+	switch (to.size) {
+	    case 1:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c1);
+		break;
+	    case 2:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c2);
+		break;
+	    case 4:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c4);
+		break;
+#ifdef LONG64
+	    case 8:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c8);
+		break;
+#endif
+	}
+	++resources->num_args;
+    }
+
+    return (resources);
+}
+
+static void
+LispFreeResources(Resources *resources)
+{
+    if (resources) {
+	XtFree((XtPointer)resources->args);
+	XtFree((XtPointer)resources);
+    }
+}
+
+static int
+bcmp_action_resource(_Xconst void *string, _Xconst void *resource)
+{
+    return (strcmp((String)string,
+		   XrmQuarkToString((*(ResourceInfo**)resource)->qname)));
+}   
+
+static ResourceInfo *
+GetResourceInfo(char *name, ResourceList *rlist, ResourceList *plist)
+{
+    ResourceInfo **resource = NULL;
+
+    if (rlist->resources)
+	resource = (ResourceInfo**)
+	    bsearch(name, rlist->resources, rlist->num_resources,
+		    sizeof(ResourceInfo*), bcmp_action_resource);
+
+    if (resource == NULL && plist) {
+	resource = (ResourceInfo**)
+	  bsearch(name, &plist->resources[plist->num_resources],
+		  plist->num_cons_resources, sizeof(ResourceInfo*),
+		  bcmp_action_resource);
+    }
+
+    return (resource ? *resource : NULL);
+}
+
+static ResourceList *
+GetResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    if ((list = FindResourceList(wc)) == NULL)
+	list = CreateResourceList(wc);
+
+    return (list);
+}
+
+static int
+bcmp_action_resource_list(_Xconst void *wc, _Xconst void *list)
+{
+    return ((char*)wc - (char*)((*(ResourceList**)list)->widget_class));
+}
+
+static ResourceList *
+FindResourceList(WidgetClass wc)
+{  
+    ResourceList **list;
+
+    if (!resource_list)
+	return (NULL);
+
+    list = (ResourceList**)
+	bsearch(wc, resource_list, num_resource_list,
+		sizeof(ResourceList*),  bcmp_action_resource_list);
+
+    return (list ? *list : NULL);
+}
+
+static int
+qcmp_action_resource_list(_Xconst void *left, _Xconst void *right)
+{
+    return ((char*)((*(ResourceList**)left)->widget_class) -
+	    (char*)((*(ResourceList**)right)->widget_class));
+}
+
+static ResourceList *
+CreateResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    list = (ResourceList*)XtMalloc(sizeof(ResourceList));
+    list->widget_class = wc;
+    list->num_resources = list->num_cons_resources = 0;
+    list->resources = NULL;
+
+    resource_list = (ResourceList**)
+	XtRealloc((XtPointer)resource_list, sizeof(ResourceList*) *
+		  (num_resource_list + 1));
+    resource_list[num_resource_list++] = list;
+    qsort(resource_list, num_resource_list, sizeof(ResourceList*),
+	  qcmp_action_resource_list);
+    BindResourceList(list);
+
+    return (list);
+}
+
+static int
+qcmp_action_resource(_Xconst void *left, _Xconst void *right)
+{
+    return (strcmp(XrmQuarkToString((*(ResourceInfo**)left)->qname),
+		   XrmQuarkToString((*(ResourceInfo**)right)->qname)));
+}
+
+static void
+BindResourceList(ResourceList *list)
+{
+    XtResourceList xt_list, cons_list;
+    Cardinal i, num_xt, num_cons;
+
+    XtGetResourceList(list->widget_class, &xt_list, &num_xt);
+    XtGetConstraintResourceList(list->widget_class, &cons_list, &num_cons);
+    list->num_resources = num_xt;
+    list->num_cons_resources = num_cons;
+
+    list->resources = (ResourceInfo**)
+	XtMalloc(sizeof(ResourceInfo*) * (num_xt + num_cons));
+
+    for (i = 0; i < num_xt; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(xt_list[i].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(xt_list[i].resource_type);
+	list->resources[i]->size = xt_list[i].resource_size;
+    }
+
+    for (; i < num_xt + num_cons; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_type);
+	list->resources[i]->size = cons_list[i - num_xt].resource_size;
+    }
+
+    XtFree((XtPointer)xt_list);
+    if (cons_list)
+	XtFree((XtPointer)cons_list);
+
+    qsort(list->resources, list->num_resources, sizeof(ResourceInfo*),
+	  qcmp_action_resource);
+    if (num_cons)
+	qsort(&list->resources[num_xt], list->num_cons_resources,
+	      sizeof(ResourceInfo*), qcmp_action_resource);
+}
+
+/*ARGSUSED*/
+static void
+PopdownAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtPopdown(w);
+}
+
+/*ARGSUSED*/
+static void
+QuitAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtAppSetExitFlag(XtWidgetToApplicationContext(w));
+}