#include "xt.h" /* needed in elk, also in s48? */ #include /* some additional macros */ #define XtRChar "Char" #define XtRGC "GC" #define XtRBackingStore "BackingStore" /* enumerated definition of the different res-types */ #define SCXT_Unknown 0 #define SCXT_String 1 #define SCXT_Callbacklist 2 #define SCXT_Float 3 #define SCXT_Backing_Store 4 #define SCXT_Dimension 5 #define SCXT_Translations 6 #define SCXT_Position 7 #define SCXT_Bitmap 8 #define SCXT_Cardinal 9 #define SCXT_Accelerators 10 #define SCXT_Boolean 11 #define SCXT_Colormap 12 #define SCXT_Cursor 13 #define SCXT_Display 14 #define SCXT_Font 15 #define SCXT_Gc 16 #define SCXT_Fixnum 17 #define SCXT_Pixel 18 #define SCXT_Pixmap 19 #define SCXT_Character 20 #define SCXT_Widget 21 #define SCXT_Window 22 /* 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