/* resource.c * * $Id$ * * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin * Copyright 2002, 2003 Sam Hocevar , Paris * * This software was derived from Elk 1.2, which was Copyright 1987, 1988, * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project * between TELES and Nixdorf Microprocessor Engineering, Berlin). * * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co- * owners or individual owners of copyright in this software, grant to any * person or company a worldwide, royalty free, license to * * i) copy this software, * ii) prepare derivative works based on this software, * iii) distribute copies of this software or derivative works, * iv) perform this software, or * v) display this software, * * provided that this notice is not removed and that neither Oliver Laumann * nor Teles nor Nixdorf are deemed to have made any representations as to * the suitability of this software for any purpose nor are held responsible * for any defects of this software. * * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE. */ #include "xt.h" #include #define XtRChar "Char" #define XtRGC "GC" #define XtRBackingStore "BackingStore" #define T_Unknown -1 #define T_String_Or_Symbol -2 #define T_Callbacklist -3 #define T_Float -4 #define T_Backing_Store -5 #define T_Dimension -6 #define T_Translations -7 #define T_Position -8 #define T_Bitmap -9 #define T_Cardinal -10 #define T_Accelerators -11 static int Resource_To_Scheme_Type (register char *t) { if (streq (XtRAcceleratorTable, t)) return T_Accelerators; else if (streq (XtRBackingStore, t)) return T_Backing_Store; else if (streq (XtRBitmap, t)) return T_Bitmap; else if (streq (XtRBoolean, t)) return T_Boolean; else if (streq (XtRCallback, t)) return T_Callbacklist; else if (streq (XtRCardinal, t)) return T_Cardinal; else if (streq (XtRColormap, t)) return T_Colormap; else if (streq (XtRCursor, t)) return T_Cursor; else if (streq (XtRDimension, t)) return T_Dimension; else if (streq (XtRDisplay, t)) return T_Display; else if (streq (XtRFloat, t)) return T_Float; else if (streq (XtRFont, t)) return T_Font; else if (streq (XtRFontStruct, t)) return T_Font; else if (streq (XtRGC, t)) return T_Gc; else if (streq (XtRInt, t)) return T_Fixnum; else if (streq (XtRPixel, t)) return T_Pixel; else if (streq (XtRPixmap, t)) return T_Pixmap; else if (streq (XtRPosition, t)) return T_Position; else if (streq (XtRShort, t)) return T_Fixnum; else if (streq (XtRString, t)) return T_String_Or_Symbol; else if (streq (XtRTranslationTable, t)) return T_Translations; else if (streq (XtRUnsignedChar, t)) return T_Character; else if (streq (XtRChar, t)) return T_Character; else if (streq (XtRWidget, t)) return T_Widget; else if (streq (XtRWindow, t)) return T_Window; return T_Unknown; } void Get_All_Resources (int sub, Widget w, WidgetClass c, XtResource **rp, int *np, int *cp) { XtResource *r, *sr, *cr; int nr, snr = 0, cnr = 0; XtGetResourceList (c, &r, (Cardinal *)&nr); if (sub) Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr); if (w && XtParent (w)) XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, (Cardinal *)&cnr); *np = nr + snr + cnr; *cp = cnr; *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource)); memcpy ((char *)*rp, (char *)r, nr * sizeof (XtResource)); XtFree ((char *)r); if (snr) memcpy ((char *)(*rp + nr), (char *)sr, snr * sizeof (XtResource)); if (cnr) { memcpy ((char *)(*rp + nr+snr), (char *)cr, cnr * sizeof (XtResource)); XtFree ((char *)cr); } } void Convert_Args (int ac, Object *av, ArgList to, Widget widget, WidgetClass class) { register char *name, *res; register int i, j, k; Object arg, val; XtResource *r; int nr, nc; int st, dt; char key[128]; PFS2X converter; char *stmp; XrmValue src, dst; Alloca_Begin; if (ac & 1) Primitive_Error ("missing argument value"); Get_All_Resources (1, widget, class, &r, &nr, &nc); /* Note: * `r' is not freed in case of error. */ for (i = k = 0; k < ac; i++, k++) { arg = av[k]; Get_Strsym_Stack (arg, name); Make_Resource_Name (name); for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) ; if (j == nr) Primitive_Error ("no such resource: ~s", arg); if (streq (r[j].resource_class, XtCReadOnly)) Primitive_Error ("resource is read-only: ~s", arg); res = r[j].resource_name; val = av[++k]; st = TYPE(val); dt = Resource_To_Scheme_Type (r[j].resource_type); /* First look for widget class specific converter for * this resource, then look for a general converter * (first try the name of the resource, then the type): */ if (widget && j >= nr-nc) class = XtClass (XtParent (widget)); sprintf (key, "%s-%s", Class_Name (class), name); converter = Find_Converter_To_C (key); if (converter || (converter = Find_Converter_To_C (res)) || (converter = Find_Converter_To_C (r[j].resource_type))) { XtArgVal ret = converter (val); XtSetArg (to[i], res, ret); } else if (dt == T_String_Or_Symbol) { Get_Strsym_Stack (val, stmp); XtSetArg (to[i], res, XtNewString (stmp)); /* Never freed! */ } else if (dt == T_Callbacklist) { int n; XtCallbackList callbacks; Check_Callback_List (val); n = Fast_Length (val); callbacks = (XtCallbackRec *) /* Never freed! */ XtMalloc ((n+1) * sizeof (XtCallbackRec)); callbacks[n].callback = 0; callbacks[n].closure = 0; Fill_Callbacks (val, callbacks, n, Find_Callback_Converter (class, name, arg)); XtSetArg (to[i], res, callbacks); } else if (dt == T_Float) { float f = (float)Get_Double (val); to[i].name = res; memcpy ((char *)&to[i].value, (char *)&f, sizeof f); } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal || dt == T_Fixnum) { XtSetArg (to[i], res, Get_Integer (val)); } else if (dt == T_Backing_Store) { XtSetArg (to[i], res, Symbols_To_Bits (val, 0, Backing_Store_Syms)); } else if (dt == T_Translations) { XtSetArg (to[i], res, Get_Translations (val)); } else if (dt == T_Accelerators) { XtSetArg (to[i], res, Get_Accelerators (val)); } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) { XtSetArg (to[i], res, None); } else if (dt == T_Bitmap) { /* Should check depth here (must be 1), but how? */ XtSetArg (to[i], res, Get_Pixmap (val)); } else { if (st != dt) { char msg[128]; /* Try to let XtConvert() do the conversion. */ if (widget && (st == T_String || st == T_Symbol)) { Get_Strsym_Stack (val, stmp); src.size = strlen (stmp); src.addr = (caddr_t)stmp; XtConvert (widget, (String)XtRString, &src, r[j].resource_type, &dst); if (dst.addr) { if (dst.size == (sizeof (unsigned char))) { XtSetArg (to[i], res, *(unsigned char *)dst.addr); } else if (dst.size == sizeof (int)) { XtSetArg (to[i], res, *(int *)dst.addr); } else if (dst.size == sizeof (XtArgVal)) { XtSetArg (to[i], res, *(XtArgVal *)dst.addr); } else { sprintf (msg, "%s: converter for %s returned weird size %d", name, r[j].resource_type, dst.size); Primitive_Error (msg); } goto done; } } sprintf (msg, "%s: can't convert %s ~s to %s", name, Types[st].name, r[j].resource_type); Primitive_Error (msg, val); } if (dt == T_Boolean) { XtSetArg (to[i], res, EQ(val, True)); } else if (dt == T_Colormap) { XtSetArg (to[i], res, COLORMAP(val)->cm); } else if (dt == T_Cursor) { XtSetArg (to[i], res, CURSOR(val)->cursor); } else if (dt == T_Display) { XtSetArg (to[i], res, DISPLAY(val)->dpy); } else if (dt == T_Font) { Open_Font_Maybe (val); if (streq (r[j].resource_type, XtRFontStruct)) XtSetArg (to[i], res, FONT(val)->info); else XtSetArg (to[i], res, FONT(val)->id); } else if (dt == T_Pixel) { XtSetArg (to[i], res, PIXEL(val)->pix); } else if (dt == T_Pixmap) { XtSetArg (to[i], res, PIXMAP(val)->pm); } else if (dt == T_Gc) { XtSetArg (to[i], res, GCONTEXT(val)->gc); } else if (dt == T_Character) { XtSetArg (to[i], res, CHAR(val)); } else if (dt == T_Widget) { XtSetArg (to[i], res, WIDGET(val)->widget); } else if (dt == T_Window) { XtSetArg (to[i], res, WINDOW(val)->win); } else Panic ("bad conversion type"); } done: ; } Alloca_End; XtFree ((char *)r); } Object Get_Values (Widget w, int ac, Object *av) { register char *name; register int i, j; Object arg; XtResource *r; int nr, nc; int t; ArgList argl; Object ret, tail; Display *dpy; char key[128]; PFX2S converter; Widget w2; GC_Node2; Alloca_Begin; Alloca (argl, Arg*, ac * sizeof (Arg)); Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc); /* Note: * `r' is not freed in case of error. */ for (i = 0; i < ac; i++) { XtArgVal argval; arg = av[i]; Check_Type (arg, T_Symbol); Get_Strsym_Stack (arg, name); Make_Resource_Name (name); for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) ; if (j == nr) Primitive_Error ("no such resource: ~s", arg); argl[i].name = name; Alloca (argval, XtArgVal, r[j].resource_size); argl[i].value = argval; } XtGetValues (w, argl, (Cardinal)ac); ret = tail = P_Make_List (Make_Integer (ac), Null); GC_Link2 (ret, tail); /* * Display is needed for resources like cursor and pixmap. * XtDisplayOfObject(w) is not necessarily the right one! */ dpy = XtDisplayOfObject (w); for (i = 0; i < ac; i++, tail = Cdr (tail)) { Object o; XtArgVal val = argl[i].value; for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++) ; t = Resource_To_Scheme_Type (r[j].resource_type); /* Look for a widget class specific converter, then for a * general converter (first try the resource name, then the type): */ w2 = (j >= nr-nc) ? XtParent (w) : w; sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name); converter = Find_Converter_To_Scheme (key); if (converter) { o = converter (*(XtArgVal *)val); } else if ((converter = Find_Converter_To_Scheme (argl[i].name))) { o = converter (*(XtArgVal *)val); } else if ((converter = Find_Converter_To_Scheme (r[j].resource_type))) { o = converter (*(XtArgVal *)val); } else if (t == T_String_Or_Symbol) { char *s = *(char **)val; if (s == 0) s = ""; o = Make_String (s, strlen (s)); } else if (t == T_Callbacklist) { register int i, n; Object ret, tail; XtCallbackList callbacks = *(XtCallbackList *)val; GC_Node; for (n = 0; callbacks[n].callback; n++) ; ret = tail = P_Make_List (Make_Integer (n), Null); GC_Link2 (ret, tail); for (i = 0; i < n; i++, tail = Cdr (tail)) Car (tail) = Get_Callbackfun (callbacks[i].closure); GC_Unlink; o = ret; } else if (t == T_Float) { o = Make_Reduced_Flonum ((double)*(float *)val); } else if (t == T_Backing_Store) { o = Bits_To_Symbols ((unsigned long)*(int *)val, 0, Backing_Store_Syms); if (Nullp (o)) Primitive_Error ("invalid backing-store (Xt bug)"); } else if (t == T_Boolean) { o = (Boolean)*(Boolean *)val ? True : False; } else if (t == T_Colormap) { o = Make_Colormap (0, dpy, *(Colormap *)val); } else if (t == T_Cursor) { o = Make_Cursor_Foreign (dpy, *(Cursor *)val); } else if (t == T_Gc) { o = Make_Gc (0, dpy, *(GC *)val); } else if (t == T_Dimension) { o = Make_Integer (*(Dimension *)val); } else if (t == T_Position) { o = Make_Integer (*(Position *)val); } else if (t == T_Cardinal) { o = Make_Unsigned (*(Cardinal *)val); } else if (t == T_Fixnum) { if (streq (r[j].resource_type, XtRInt)) o = Make_Integer (*(int *)val); else o = Make_Integer (*(short *)val); } else if (t == T_Display) { o = Make_Display (0, dpy); } else if (t == T_Font) { if (streq (r[j].resource_type, XtRFontStruct)) { o = Make_Font_Foreign (dpy, False, (Font)0, *(XFontStruct **)val); } else { XFontStruct *info; Disable_Interrupts; info = XQueryFont (dpy, *(Font *)val); Enable_Interrupts; o = Make_Font_Foreign (dpy, False, *(Font *)val, info); } } else if (t == T_Pixel) { o = Make_Pixel (*(unsigned long *)val); } else if (t == T_Pixmap || t == T_Bitmap) { o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val); } else if (t == T_Character) { o = Make_Char (*(unsigned char *)val); } else if (t == T_Widget) { o = Make_Widget_Foreign (*(Widget *)val); } else if (t == T_Window) { o = Make_Window (0, dpy, *(Window *)val); } else { char s[128]; sprintf (s, "%s: no converter for %s", argl[i].name, r[j].resource_type); Primitive_Error (s); } Car (tail) = o; } XtFree ((char *)r); GC_Unlink; return ret; } /* Convert `mapped-when-managed' to `mappedWhenManaged'. */ void Make_Resource_Name (register char *s) { register char *p; for (p = s; *s; ) { if (*s == '-') { if (*++s) { if (islower (*s)) *s = toupper (*s); *p++ = *s++; } } else *p++ = *s++; } *p = '\0'; } Object Get_Resources (WidgetClass c, void (*fun)(), int freeit) { XtResource *r; register XtResource *p; int nr; Object ret, tail, tail2, x; GC_Node3; fun (c, &r, &nr); /* Note: * `r' is not freed in case of error. */ ret = tail = tail2 = P_Make_List (Make_Integer (nr), Null); GC_Link3 (ret, tail, tail2); for (p = r; p < r+nr; p++, tail = Cdr (tail)) { x = tail2 = P_Make_List (Make_Integer (3), Null); Car (tail) = tail2 = x; x = Intern (p->resource_name); Car (tail2) = x; tail2 = Cdr (tail2); x = Intern (p->resource_class); Car (tail2) = x; tail2 = Cdr (tail2); x = Intern (p->resource_type); Car (tail2) = x; } GC_Unlink; if (freeit) XtFree ((char *)r); return ret; }