1800 lines
46 KiB
C
1800 lines
46 KiB
C
/*
|
|
* 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.20tsi Exp $ */
|
|
|
|
#include <stdlib.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
#include <X11/Intrinsic.h>
|
|
#include <X11/StringDefs.h>
|
|
#include <X11/Shell.h>
|
|
#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));
|
|
}
|