/* * 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.21 2003/04/27 18:17:38 tsi Exp $ */ #include #include #include #include #include #include #include "lisp/internal.h" #include "lisp/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(void); 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; CONSP(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; CONSP(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: %ld does not fit in XtInputMask %ld", STRFUN(builtin), (long)mask, (long)XtIMAll); 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); if (arguments == UNSPEC) arguments = NIL; 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 == 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; CONSP(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((char*)c8)); #else object = CONS(CAR(list), STRING((char*)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)); }