First, imperfect version of the resource-conversion: scheme48<->XtResource. Some
additional work has to be done, e.g. the callback-converter code.
This commit is contained in:
nofreude
parent
963be1ec84
commit
44d7ea81e6
|
|
@ -0,0 +1,373 @@
|
|||
#include "xt.h"
|
||||
|
||||
/* needed in elk, also in s48? */
|
||||
#include <ctype.h>
|
||||
|
||||
|
||||
/* some additional macros */
|
||||
#define XtRChar "Char"
|
||||
#define XtRGC "GC"
|
||||
#define XtRBackingStore "BackingStore"
|
||||
|
||||
|
||||
/* enumerated definition of the different res-types */
|
||||
|
||||
#define SCXT_Unknown -1
|
||||
#define SCXT_String -2
|
||||
#define SCXT_Callbacklist -3
|
||||
#define SCXT_Float -4
|
||||
#define SCXT_Backing_Store -5
|
||||
#define SCXT_Dimension -6
|
||||
#define SCXT_Translations -7
|
||||
#define SCXT_Position -8
|
||||
#define SCXT_Bitmap -9
|
||||
#define SCXT_Cardinal -10
|
||||
#define SCXT_Accelerators -11
|
||||
#define SCXT_Boolean -12
|
||||
#define SCXT_Colormap -13
|
||||
#define SCXT_Cursor -14
|
||||
#define SCXT_Display -15
|
||||
#define SCXT_Font -16
|
||||
#define SCXT_Gc -17
|
||||
#define SCXT_Fixnum -18
|
||||
#define SCXT_Pixel -19
|
||||
#define SCXT_Pixmap -20
|
||||
#define SCXT_Character -21
|
||||
#define SCXT_Widget -22
|
||||
#define SCXT_Window -23
|
||||
|
||||
|
||||
/* scxt_I_Resource_To_Scheme_Type: */
|
||||
|
||||
static scxt_intern_Resource_To_Scheme_Type (char* t) {
|
||||
if (streq (XtRAcceleratorTable, t))
|
||||
return SCXT_Accelerators;
|
||||
else if (streq (XtRBackingStore, t))
|
||||
return SCXT_Backing_Store;
|
||||
else if (streq (XtRBitmap, t))
|
||||
return SCXT_Bitmap;
|
||||
else if (streq (XtRBoolean, t))
|
||||
return SCXT_Boolean;
|
||||
else if (streq (XtRCallback, t))
|
||||
return SCXT_Callbacklist;
|
||||
else if (streq (XtRCardinal, t))
|
||||
return SCXT_Cardinal;
|
||||
else if (streq (XtRColormap, t))
|
||||
return SCXT_Colormap;
|
||||
else if (streq (XtRCursor, t))
|
||||
return SCXT_Cursor;
|
||||
else if (streq (XtRDimension, t))
|
||||
return SCXT_Dimension;
|
||||
else if (streq (XtRDisplay, t))
|
||||
return SCXT_Display;
|
||||
else if (streq (XtRFloat, t))
|
||||
return SCXT_Float;
|
||||
else if (streq (XtRFont, t))
|
||||
return SCXT_Font;
|
||||
else if (streq (XtRFontStruct, t))
|
||||
return SCXT_Font;
|
||||
else if (streq (XtRGC, t))
|
||||
return SCXT_Gc;
|
||||
else if (streq (XtRInt, t))
|
||||
return SCXT_Fixnum;
|
||||
else if (streq (XtRPixel, t))
|
||||
return SCXT_Pixel;
|
||||
else if (streq (XtRPixmap, t))
|
||||
return SCXT_Pixmap;
|
||||
else if (streq (XtRPosition, t))
|
||||
return SCXT_Position;
|
||||
else if (streq (XtRShort, t))
|
||||
return SCXT_Fixnum;
|
||||
else if (streq (XtRString, t))
|
||||
return SCXT_String;
|
||||
else if (streq (XtRTranslationTable, t))
|
||||
return SCXT_Translations;
|
||||
else if (streq (XtRUnsignedChar, t))
|
||||
return SCXT_Character;
|
||||
else if (streq (XtRChar, t))
|
||||
return SCXT_Character;
|
||||
else if (streq (XtRWidget, t))
|
||||
return SCXT_Widget;
|
||||
else if (streq (XtRWindow, t))
|
||||
return SCXT_Window;
|
||||
return SCXT_Unknown;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
void scxt_intern_Get_All_Resources(int sub, Widget widget,
|
||||
WidgetClass widgetc, XtResource** rp,
|
||||
int* np, int* cp){
|
||||
XtResource *r, *sr, *cr;
|
||||
int nr, snr = 0, cnr = 0;
|
||||
XtGetResourceList(widgetc, &r, (Cardinal*)&nr);
|
||||
if (sub)
|
||||
scxt_intern_Get_Sub_Resource_List(widgetc, &sr, (Cardinal*)&snr);
|
||||
if (XtParent(widget))
|
||||
XtGetConstraintResourceList(XtClass(XtParent(widget)), &cr,
|
||||
(Cardinal*)&cnr);
|
||||
*np = nr + snr + cnr;
|
||||
*cp = cnr;
|
||||
XfFree((char*)r);
|
||||
if (snr)
|
||||
bcopy((char*)sr, (char*)(*rp + nr), snr * sizeof (XtResource));
|
||||
if (cnr) {
|
||||
bcopy ((char*)cr, (char*)(*rp+nr+snr), cnr * sizeof (XtResource));
|
||||
XtFree((char*)cr);
|
||||
}
|
||||
}
|
||||
|
||||
/* scxt_intern_Convert_Args converts scheme-values (arg_list) in their */
|
||||
/* corresponding XResource-values (dest_list) */
|
||||
|
||||
void scxt_intern_Convert_Args (s48_value arg_list, Widget widget, int alist_len,
|
||||
WidgetClass class, ArgList dest_list) {
|
||||
char* name, stmp;
|
||||
int i, j, k;
|
||||
s48_value val;
|
||||
XtResource* all_res;
|
||||
int n_res, n_con;
|
||||
int res_type;
|
||||
char key[128];
|
||||
XrmValue src, dst;
|
||||
/* Getting the resource data-base for the given widget: */
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
S48_GC_PROTECT_2(arg_list, val);
|
||||
scxt_intern_Get_All_Resources(1, widget, class, &all_res, &n_res, &n_con);
|
||||
for (i = k = 0; k < alist_len; i++, k++){
|
||||
/* take the next scheme-argument to convert: */
|
||||
name = s48_extract_string(S48_CAR(arg_list));
|
||||
arg_list = S48_CDR(arg_list);
|
||||
for( j = 0; j < n_res && !sreq(name, all_res[j].resource_name); j++)
|
||||
;
|
||||
if(j == n_res){
|
||||
/* XtFree((char*)all_res); ?*/
|
||||
s48_raise_scheme_exception(S48_EXCEPTION_BAD_PROCEDURE, 0);
|
||||
}
|
||||
if(streq(all_res[j].resource_class, XtCReadOnly)){
|
||||
/*XtFree((char*)all_res); ?*/
|
||||
s48_raise_scheme_exception(S48_EXCEPTION_BAD_PROCEDURE, 0);
|
||||
}
|
||||
val = S48_CAR(arg_list);
|
||||
arg_list = S48_CDR(arg_list);
|
||||
res_type = scxt_intern_Resource_To_Scheme_Type(all_res[j].resource_type);
|
||||
if (j >= n_res - n_con)
|
||||
class = XtClass (XtParent(widget));
|
||||
/* todo: widget class specific converters... */
|
||||
|
||||
if(res_type == SCXT_String){
|
||||
XtSetArg(dest_list[i], name, XtNewString(s48_extract_string(val)));
|
||||
}else if (res_type == SCXT_Callbacklist){
|
||||
/* todo: callback converter */
|
||||
;
|
||||
}else if (res_type == SCXT_Float){
|
||||
XtSetArg(dest_list[i], name, (s48_extract_double(val)));
|
||||
}else if (res_type == SCXT_Dimension || res_type == SCXT_Position
|
||||
|| res_type == SCXT_Cardinal || SCXT_Fixnum) {
|
||||
XtSetArg(dest_list[i], name, (int)s48_extract_integer(val));
|
||||
}else if (res_type == SCXT_Backing_Store) {
|
||||
XtSetArg(dest_list[i], name, s48_extract_integer(val));
|
||||
}else if (res_type == SCXT_Translations){
|
||||
XtSetArg(dest_list[i], name, scxt_intern_Get_Translations(val));
|
||||
}else if (res_type == SCXT_Accelerators){
|
||||
XtSetArg(dest_list[i], name, scxt_intern_Get_Accelerators(val));
|
||||
}else if (res_type == SCXT_Bitmap || res_type == SCXT_Pixmap){
|
||||
/* could also be a pointer, needs a better implementation*/
|
||||
stmp = s48_extract_string(S48_SYMBOL_TO_STRING(val));
|
||||
if (streq (None, stmp))
|
||||
XtSetArg(dest_list[i], name, None);
|
||||
} else if (res_type == SCXT_Bitmap){
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_PIXMAP(val));
|
||||
} else if (res_type == SCXT_Boolean){
|
||||
XtSetArg(dest_list[i], name, S48_EXTRACT_BOOLEAN(val));
|
||||
} else if (res_type == SCXT_Colormap){
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_COLORMAP(val));
|
||||
} else if (res_type == SCXT_Cursor){
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_CURSOR(val));
|
||||
} else if (res_type == SCXT_Display){
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_DISPLAY(val));
|
||||
} else if (res_type == SCXT_Font){
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_FONT(val));
|
||||
} else if (res_type == SCXT_Pixel) {
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_PIXEL(val));
|
||||
} else if (res_type == SCXT_Pixmap) {
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_PIXMAP(val));
|
||||
} else if (res_type == SCXT_Gc) {
|
||||
XtSetArg(dest_list[i], name, SCX_EXTRACT_GCONTEXT(val));
|
||||
} else if (res_type == SCXT_Character) {
|
||||
XtSetArg(dest_list[i], name, s48_extract_char(val));
|
||||
} else if (res_type == SCXT_Widget) {
|
||||
XtSetArg(dest_list[i], name, SCXT_EXTRACT_WIDGET(val));
|
||||
} else if (res_type == SCXT_Window) {
|
||||
XtSetArg(dest_list[i], name, SCXT_EXTACT_WINDOW(val));
|
||||
/* Try XtConvert if no matching type is found: */
|
||||
} else if (S48_STRING_P(val) || S48_SYMBOL_P(val)) {
|
||||
if (S48_SYMBOL_P(val)) {
|
||||
stmp = s48_extract_string(S48_SYMBOL_TO_STRING(val));
|
||||
} else {
|
||||
stmp = s48_extract_string(val);
|
||||
}
|
||||
/* addr: XPointer */
|
||||
/* size: unsigned int */
|
||||
src.size = strlen(stmp);
|
||||
src.addr = &stmp;
|
||||
XtConvert (widget, (String)XtRString, &src, all_res[j].resource_type,
|
||||
&dst);
|
||||
if(dst.addr) {
|
||||
if (dst.size == (sizeof (unsigned char))) {
|
||||
XtSetArg (dest_list[i], name, *(unsigned char*)dst.addr);
|
||||
} else if (dst.size == sizeof (int)) {
|
||||
XtSetArg (dest_list[i], name, *(int*)dst.addr);
|
||||
} else if (dst.size == sizeof (XtArgVal)) {
|
||||
XtSetArg (dest_list[i], name, *(XtArgVal*)dst.addr);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
s48_raise_scheme_exception(S48_EXCEPTION_BAD_PROCEDURE, 0);
|
||||
}
|
||||
}
|
||||
/* now it's save to free all_res: */
|
||||
XtFree((char*)all_res);
|
||||
S48_GC_UNPROTECT();
|
||||
S48_GC_UNPROTECT();
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* scxt_intern_Get_Values: */
|
||||
/* converts the requested values to a list consisting of the scheme-representation */
|
||||
/* and a type-flag, e.g. '(-2 "hello world" -12 #f) */
|
||||
|
||||
s48_value scxt_intern_Get_Values(Widget widget, s48_value arg_list, int n_args){
|
||||
char* name;
|
||||
int i, j, n_res, n_con, type;
|
||||
XtResource* res;
|
||||
ArgList alist;
|
||||
XtArgVal val;
|
||||
s48_value res_list, s_res;
|
||||
Display* dpy;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
S48_GC_PROTECT_2(res_list, s_res);
|
||||
res_list = S48_NULL;
|
||||
s_res = S48_NULL;
|
||||
|
||||
Get_All_Resources(0, widget, XtClass(widget), &res, &n_res, &n_con);
|
||||
|
||||
for(i=0; i < n_args; i++) {
|
||||
XtArgVal argval;
|
||||
name = s48_extract_string(S48_CAR(arg_list));
|
||||
arg_list = S48_CDR(arg_list);
|
||||
|
||||
for (j = 0; j < n_res && !streq (name, res[j].resource_name); j++)
|
||||
;
|
||||
if (j == n_res)
|
||||
s48_raise_scheme_exception(S48_EXCEPTION_BAD_PROCEDURE, 0);
|
||||
alist[i].name = name;
|
||||
alist[i].value = argval;
|
||||
}
|
||||
XtGetValues(widget, alist, (Cardinal)n_args);
|
||||
|
||||
|
||||
/* Display is needed for resources like cursor and pixmap. */
|
||||
/* XtDisplayOfObject(w) is not necessarily the right one! */
|
||||
dpy = XtDisplayOfObject(widget);
|
||||
for(i=0; i < n_args; i++) {
|
||||
val = alist[i].value;
|
||||
for (j=0; j < n_res && !streq (alist[i].name, res[j].resource_name); j++)
|
||||
;
|
||||
type = scxt_intern_Resource_To_Scheme_Type (res[j].resource_type);
|
||||
/* todo: converters */
|
||||
if (type == SCXT_String) {
|
||||
s_res = s48_enter_string(*(char**)val);
|
||||
} else if (type == SCXT_Callbacklist) {
|
||||
; /* todo: callbacklist-converters */
|
||||
} else if (type == SCXT_Float) {
|
||||
s_res = s48_enter_double((double)*(float *)val);
|
||||
} else if (type == SCXT_Backing_Store) {
|
||||
s_res = s48_enter_integer((unsigned long)*(int*)val);
|
||||
} else if (type == SCXT_Boolean) {
|
||||
s_res = S48_ENTER_BOOLEAN(*(int*)val);
|
||||
} else if (type == SCXT_Colormap) {
|
||||
s_res = s48_cons(SCX_ENTER_COLORMAP(*(Colormap*)val),
|
||||
SCX_ENTER_DISPLAY(dpy));
|
||||
} else if (type == SCXT_Cursor) {
|
||||
s_res = s48_cons(SCX_ENTER_CURSOR(*(Cursor*)val),
|
||||
SCX_ENTER_DISPLAY(dpy));
|
||||
} else if (type == SCXT_Gc) {
|
||||
s_res = s48_cons(SCX_ENTER_GCONTEXT(*(GC*)val),
|
||||
SCX_ENTER_DISPLAY(dpy));
|
||||
} else if (type == SCXT_Dimension) {
|
||||
s_res = s48_enter_integer(*(Dimension*)val);
|
||||
} else if (type == SCXT_Position) {
|
||||
s_res = s48_enter_integer(*(Position*)val);
|
||||
} else if (type == SCXT_Cardinal) {
|
||||
s_res = s48_enter_integer(*(Cardinal*)val);
|
||||
} else if (type == SCXT_Fixnum) {
|
||||
if (streq (res[j].resource_type, XtRInt))
|
||||
s_res = s48_enter_integer(*(int*)val);
|
||||
else
|
||||
s_res = e48_enter_integer(*(short*)val);
|
||||
} else if (type == SCXT_Display) {
|
||||
s_res = SCX_ENTER_DISPLAY(dpy);
|
||||
} else if (type == SCXT_Font) {
|
||||
if (streq(res[j].resource_type, XtRFontStruct)) {
|
||||
s_res = s48_cons(SCX_ENTER_FONTSTRUCT(*(XFontStruct*)val),
|
||||
s48_cons(S48_TRUE,
|
||||
S48_ENTER_DISPLAY(dpy)));
|
||||
} else {
|
||||
s_res = s48_cons(SCX_ENTER_FONT(*(Font*)val),
|
||||
s48_cons(S48_FALSE,
|
||||
S48_ENTER_DISPLAY(dpy)));
|
||||
}
|
||||
} else if (type == SCXT_Pixel) {
|
||||
s_res = SCX_ENTER_PIXEL(*(unsigned long*)val);
|
||||
} else if (type == SCXT_Pixmap || type == SCXT_Bitmap) {
|
||||
s_res = s48_cons(SCX_ENTER_PIXMAP(*(Pixmap*)val),
|
||||
SCX_ENTER_DISPLAY(dpy));
|
||||
} else if (type == SCXT_Character){
|
||||
s_res = s48_enter_char(*(unsigned char*)val);
|
||||
} else if (type == SCXT_Widget) {
|
||||
s_res = SCXT_ENTER_WIDGET(*(Widget *)val);
|
||||
} else if (type == SCXT_Window) {
|
||||
s_res = s48_cons(SCX_ENTER_WINDOW(*(Window*)val),
|
||||
SCX_ENTER_DISPLAY(dpy));
|
||||
} else {
|
||||
s48_raise_scheme_exception(S48_EXCEPTION_BAD_PROCEDURE, 0);
|
||||
}
|
||||
res_list = s48_cons(s_res, res_list);
|
||||
res_list = s48_cons(s48_enter_integer((long)type), res_list);
|
||||
}
|
||||
XtFree((char*)res);
|
||||
S48_GC_UNPROTECT();
|
||||
S48_GC_UNPROTECT();
|
||||
return res_list;
|
||||
}
|
||||
|
||||
/* scxt_intern_Get_Resources */
|
||||
/* fun is one of the follow: XtGetResourceList(), XtGetConstrainedR..*/
|
||||
/* and scxt_intern_Get_Sub_Resource_List() */
|
||||
|
||||
s48_value scxt_intern_Get_Resources (WidgetClass c, void (*fun)(),
|
||||
char flag) {
|
||||
XtResource * xres, p;
|
||||
int n_res, i;
|
||||
s48_value res_list, strg_list;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
S48_GC_PROTECT_2(res_list, strg_list);
|
||||
strg_list = S48_NULL;
|
||||
res_list = S48_NULL;
|
||||
|
||||
fun(c, &xres, &n_res);
|
||||
for (i=0; i<n_res; i++) {
|
||||
strg_list = s48_cons(s48_enter_string(xres[i].resource_type), strg_list);
|
||||
strg_list = s48_cons(s48_enter_string(xres[i].resource_class), strg_list);
|
||||
strg_list = s48_cons(s48_enter_string(xres[i].resource_name), strg_list);
|
||||
res_list = s48_cons(strg_list, res_list);
|
||||
}
|
||||
if (flag) XtFree((char*)xres);
|
||||
S48_GC_UNPROTECT();
|
||||
S48_GC_UNPROTECT();
|
||||
return res_list;
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue