1 /* resource.c
2 *
3 * $Id$
4 *
5 * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
6 * Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
7 *
8 * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
9 * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
10 * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
11 * between TELES and Nixdorf Microprocessor Engineering, Berlin).
12 *
13 * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
14 * owners or individual owners of copyright in this software, grant to any
15 * person or company a worldwide, royalty free, license to
16 *
17 * i) copy this software,
18 * ii) prepare derivative works based on this software,
19 * iii) distribute copies of this software or derivative works,
20 * iv) perform this software, or
21 * v) display this software,
22 *
23 * provided that this notice is not removed and that neither Oliver Laumann
24 * nor Teles nor Nixdorf are deemed to have made any representations as to
25 * the suitability of this software for any purpose nor are held responsible
26 * for any defects of this software.
27 *
28 * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
29 */
30
31 #include "xt.h"
32
33 #include <ctype.h>
34
35 #define XtRChar "Char"
36 #define XtRGC "GC"
37 #define XtRBackingStore "BackingStore"
38
39 #define T_Unknown -1
40 #define T_String_Or_Symbol -2
41 #define T_Callbacklist -3
42 #define T_Float -4
43 #define T_Backing_Store -5
44 #define T_Dimension -6
45 #define T_Translations -7
46 #define T_Position -8
47 #define T_Bitmap -9
48 #define T_Cardinal -10
49 #define T_Accelerators -11
50
Resource_To_Scheme_Type(register char * t)51 static int Resource_To_Scheme_Type (register char *t) {
52 if (streq (XtRAcceleratorTable, t))
53 return T_Accelerators;
54 else if (streq (XtRBackingStore, t))
55 return T_Backing_Store;
56 else if (streq (XtRBitmap, t))
57 return T_Bitmap;
58 else if (streq (XtRBoolean, t))
59 return T_Boolean;
60 else if (streq (XtRCallback, t))
61 return T_Callbacklist;
62 else if (streq (XtRCardinal, t))
63 return T_Cardinal;
64 else if (streq (XtRColormap, t))
65 return T_Colormap;
66 else if (streq (XtRCursor, t))
67 return T_Cursor;
68 else if (streq (XtRDimension, t))
69 return T_Dimension;
70 else if (streq (XtRDisplay, t))
71 return T_Display;
72 else if (streq (XtRFloat, t))
73 return T_Float;
74 else if (streq (XtRFont, t))
75 return T_Font;
76 else if (streq (XtRFontStruct, t))
77 return T_Font;
78 else if (streq (XtRGC, t))
79 return T_Gc;
80 else if (streq (XtRInt, t))
81 return T_Fixnum;
82 else if (streq (XtRPixel, t))
83 return T_Pixel;
84 else if (streq (XtRPixmap, t))
85 return T_Pixmap;
86 else if (streq (XtRPosition, t))
87 return T_Position;
88 else if (streq (XtRShort, t))
89 return T_Fixnum;
90 else if (streq (XtRString, t))
91 return T_String_Or_Symbol;
92 else if (streq (XtRTranslationTable, t))
93 return T_Translations;
94 else if (streq (XtRUnsignedChar, t))
95 return T_Character;
96 else if (streq (XtRChar, t))
97 return T_Character;
98 else if (streq (XtRWidget, t))
99 return T_Widget;
100 else if (streq (XtRWindow, t))
101 return T_Window;
102 return T_Unknown;
103 }
104
Get_All_Resources(int sub,Widget w,WidgetClass c,XtResource ** rp,int * np,int * cp)105 void Get_All_Resources (int sub, Widget w, WidgetClass c, XtResource **rp,
106 int *np, int *cp) {
107 XtResource *r, *sr, *cr;
108 int nr, snr = 0, cnr = 0;
109
110 XtGetResourceList (c, &r, (Cardinal *)&nr);
111 if (sub)
112 Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr);
113 if (w && XtParent (w))
114 XtGetConstraintResourceList (XtClass (XtParent (w)), &cr,
115 (Cardinal *)&cnr);
116 *np = nr + snr + cnr;
117 *cp = cnr;
118 *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource));
119 memcpy ((char *)*rp, (char *)r, nr * sizeof (XtResource));
120 XtFree ((char *)r);
121 if (snr)
122 memcpy ((char *)(*rp + nr), (char *)sr, snr * sizeof (XtResource));
123 if (cnr) {
124 memcpy ((char *)(*rp + nr+snr), (char *)cr, cnr * sizeof (XtResource));
125 XtFree ((char *)cr);
126 }
127 }
128
Convert_Args(int ac,Object * av,ArgList to,Widget widget,WidgetClass class)129 void Convert_Args (int ac, Object *av, ArgList to, Widget widget,
130 WidgetClass class) {
131 register char *name, *res;
132 register int i, j, k;
133 Object arg, val;
134 XtResource *r;
135 int nr, nc;
136 int st, dt;
137 char key[128];
138 PFS2X converter;
139 char *stmp;
140 XrmValue src, dst;
141 Alloca_Begin;
142
143 if (ac & 1)
144 Primitive_Error ("missing argument value");
145 Get_All_Resources (1, widget, class, &r, &nr, &nc);
146 /* Note:
147 * `r' is not freed in case of error.
148 */
149 for (i = k = 0; k < ac; i++, k++) {
150 arg = av[k];
151 Get_Strsym_Stack (arg, name);
152 Make_Resource_Name (name);
153 for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
154 ;
155 if (j == nr)
156 Primitive_Error ("no such resource: ~s", arg);
157 if (streq (r[j].resource_class, XtCReadOnly))
158 Primitive_Error ("resource is read-only: ~s", arg);
159 res = r[j].resource_name;
160 val = av[++k];
161 st = TYPE(val);
162 dt = Resource_To_Scheme_Type (r[j].resource_type);
163
164 /* First look for widget class specific converter for
165 * this resource, then look for a general converter
166 * (first try the name of the resource, then the type):
167 */
168 if (widget && j >= nr-nc)
169 class = XtClass (XtParent (widget));
170 sprintf (key, "%s-%s", Class_Name (class), name);
171 converter = Find_Converter_To_C (key);
172 if (converter || (converter = Find_Converter_To_C (res))
173 || (converter = Find_Converter_To_C (r[j].resource_type))) {
174 XtArgVal ret = converter (val);
175 XtSetArg (to[i], res, ret);
176 } else if (dt == T_String_Or_Symbol) {
177 Get_Strsym_Stack (val, stmp);
178 XtSetArg (to[i], res, XtNewString (stmp)); /* Never freed! */
179 } else if (dt == T_Callbacklist) {
180 int n;
181 XtCallbackList callbacks;
182
183 Check_Callback_List (val);
184 n = Fast_Length (val);
185 callbacks = (XtCallbackRec *) /* Never freed! */
186 XtMalloc ((n+1) * sizeof (XtCallbackRec));
187 callbacks[n].callback = 0;
188 callbacks[n].closure = 0;
189 Fill_Callbacks (val, callbacks, n,
190 Find_Callback_Converter (class, name, arg));
191 XtSetArg (to[i], res, callbacks);
192 } else if (dt == T_Float) {
193 float f = (float)Get_Double (val);
194 to[i].name = res;
195 memcpy ((char *)&to[i].value, (char *)&f, sizeof f);
196 } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal
197 || dt == T_Fixnum) {
198 XtSetArg (to[i], res, Get_Integer (val));
199 } else if (dt == T_Backing_Store) {
200 XtSetArg (to[i], res, Symbols_To_Bits (val, 0,
201 Backing_Store_Syms));
202 } else if (dt == T_Translations) {
203 XtSetArg (to[i], res, Get_Translations (val));
204 } else if (dt == T_Accelerators) {
205 XtSetArg (to[i], res, Get_Accelerators (val));
206 } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) {
207 XtSetArg (to[i], res, None);
208 } else if (dt == T_Bitmap) {
209 /* Should check depth here (must be 1), but how? */
210 XtSetArg (to[i], res, Get_Pixmap (val));
211 } else {
212 if (st != dt) {
213 char msg[128];
214
215 /* Try to let XtConvert() do the conversion.
216 */
217 if (widget && (st == T_String || st == T_Symbol)) {
218 Get_Strsym_Stack (val, stmp);
219 src.size = strlen (stmp);
220 src.addr = (caddr_t)stmp;
221 XtConvert (widget, (String)XtRString, &src,
222 r[j].resource_type, &dst);
223 if (dst.addr) {
224 if (dst.size == (sizeof (unsigned char))) {
225 XtSetArg (to[i], res, *(unsigned char *)dst.addr);
226 } else if (dst.size == sizeof (int)) {
227 XtSetArg (to[i], res, *(int *)dst.addr);
228 } else if (dst.size == sizeof (XtArgVal)) {
229 XtSetArg (to[i], res, *(XtArgVal *)dst.addr);
230 } else {
231 sprintf (msg,
232 "%s: converter for %s returned weird size %d",
233 name, r[j].resource_type, dst.size);
234 Primitive_Error (msg);
235 }
236 goto done;
237 }
238 }
239 sprintf (msg, "%s: can't convert %s ~s to %s", name,
240 Types[st].name, r[j].resource_type);
241 Primitive_Error (msg, val);
242 }
243 if (dt == T_Boolean) {
244 XtSetArg (to[i], res, EQ(val, True));
245 } else if (dt == T_Colormap) {
246 XtSetArg (to[i], res, COLORMAP(val)->cm);
247 } else if (dt == T_Cursor) {
248 XtSetArg (to[i], res, CURSOR(val)->cursor);
249 } else if (dt == T_Display) {
250 XtSetArg (to[i], res, DISPLAY(val)->dpy);
251 } else if (dt == T_Font) {
252 Open_Font_Maybe (val);
253 if (streq (r[j].resource_type, XtRFontStruct))
254 XtSetArg (to[i], res, FONT(val)->info);
255 else
256 XtSetArg (to[i], res, FONT(val)->id);
257 } else if (dt == T_Pixel) {
258 XtSetArg (to[i], res, PIXEL(val)->pix);
259 } else if (dt == T_Pixmap) {
260 XtSetArg (to[i], res, PIXMAP(val)->pm);
261 } else if (dt == T_Gc) {
262 XtSetArg (to[i], res, GCONTEXT(val)->gc);
263 } else if (dt == T_Character) {
264 XtSetArg (to[i], res, CHAR(val));
265 } else if (dt == T_Widget) {
266 XtSetArg (to[i], res, WIDGET(val)->widget);
267 } else if (dt == T_Window) {
268 XtSetArg (to[i], res, WINDOW(val)->win);
269 } else Panic ("bad conversion type");
270 }
271 done: ;
272 }
273 Alloca_End;
274 XtFree ((char *)r);
275 }
276
Get_Values(Widget w,int ac,Object * av)277 Object Get_Values (Widget w, int ac, Object *av) {
278 register char *name;
279 register int i, j;
280 Object arg;
281 XtResource *r;
282 int nr, nc;
283 int t;
284 ArgList argl;
285 Object ret, tail;
286 Display *dpy;
287 char key[128];
288 PFX2S converter;
289 Widget w2;
290 GC_Node2;
291 Alloca_Begin;
292
293 Alloca (argl, Arg*, ac * sizeof (Arg));
294 Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc);
295 /* Note:
296 * `r' is not freed in case of error.
297 */
298 for (i = 0; i < ac; i++) {
299 XtArgVal argval;
300
301 arg = av[i];
302 Check_Type (arg, T_Symbol);
303 Get_Strsym_Stack (arg, name);
304 Make_Resource_Name (name);
305 for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
306 ;
307 if (j == nr)
308 Primitive_Error ("no such resource: ~s", arg);
309 argl[i].name = name;
310 Alloca (argval, XtArgVal, r[j].resource_size);
311 argl[i].value = argval;
312 }
313 XtGetValues (w, argl, (Cardinal)ac);
314 ret = tail = P_Make_List (Make_Integer (ac), Null);
315 GC_Link2 (ret, tail);
316 /*
317 * Display is needed for resources like cursor and pixmap.
318 * XtDisplayOfObject(w) is not necessarily the right one!
319 */
320 dpy = XtDisplayOfObject (w);
321 for (i = 0; i < ac; i++, tail = Cdr (tail)) {
322 Object o;
323 XtArgVal val = argl[i].value;
324 for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++)
325 ;
326 t = Resource_To_Scheme_Type (r[j].resource_type);
327
328 /* Look for a widget class specific converter, then for a
329 * general converter (first try the resource name, then the type):
330 */
331 w2 = (j >= nr-nc) ? XtParent (w) : w;
332 sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name);
333 converter = Find_Converter_To_Scheme (key);
334
335 if (converter) {
336 o = converter (*(XtArgVal *)val);
337 } else if ((converter = Find_Converter_To_Scheme (argl[i].name))) {
338 o = converter (*(XtArgVal *)val);
339 } else if ((converter = Find_Converter_To_Scheme (r[j].resource_type))) {
340 o = converter (*(XtArgVal *)val);
341 } else if (t == T_String_Or_Symbol) {
342 char *s = *(char **)val;
343
344 if (s == 0) s = "";
345 o = Make_String (s, strlen (s));
346 } else if (t == T_Callbacklist) {
347 register int i, n;
348 Object ret, tail;
349 XtCallbackList callbacks = *(XtCallbackList *)val;
350 GC_Node;
351
352 for (n = 0; callbacks[n].callback; n++)
353 ;
354 ret = tail = P_Make_List (Make_Integer (n), Null);
355 GC_Link2 (ret, tail);
356 for (i = 0; i < n; i++, tail = Cdr (tail))
357 Car (tail) = Get_Callbackfun (callbacks[i].closure);
358 GC_Unlink;
359 o = ret;
360 } else if (t == T_Float) {
361 o = Make_Reduced_Flonum ((double)*(float *)val);
362 } else if (t == T_Backing_Store) {
363 o = Bits_To_Symbols ((unsigned long)*(int *)val, 0,
364 Backing_Store_Syms);
365 if (Nullp (o))
366 Primitive_Error ("invalid backing-store (Xt bug)");
367 } else if (t == T_Boolean) {
368 o = (Boolean)*(Boolean *)val ? True : False;
369 } else if (t == T_Colormap) {
370 o = Make_Colormap (0, dpy, *(Colormap *)val);
371 } else if (t == T_Cursor) {
372 o = Make_Cursor_Foreign (dpy, *(Cursor *)val);
373 } else if (t == T_Gc) {
374 o = Make_Gc (0, dpy, *(GC *)val);
375 } else if (t == T_Dimension) {
376 o = Make_Integer (*(Dimension *)val);
377 } else if (t == T_Position) {
378 o = Make_Integer (*(Position *)val);
379 } else if (t == T_Cardinal) {
380 o = Make_Unsigned (*(Cardinal *)val);
381 } else if (t == T_Fixnum) {
382 if (streq (r[j].resource_type, XtRInt))
383 o = Make_Integer (*(int *)val);
384 else
385 o = Make_Integer (*(short *)val);
386 } else if (t == T_Display) {
387 o = Make_Display (0, dpy);
388 } else if (t == T_Font) {
389 if (streq (r[j].resource_type, XtRFontStruct)) {
390 o = Make_Font_Foreign (dpy, False, (Font)0,
391 *(XFontStruct **)val);
392 } else {
393 XFontStruct *info;
394 Disable_Interrupts;
395 info = XQueryFont (dpy, *(Font *)val);
396 Enable_Interrupts;
397 o = Make_Font_Foreign (dpy, False, *(Font *)val, info);
398 }
399 } else if (t == T_Pixel) {
400 o = Make_Pixel (*(unsigned long *)val);
401 } else if (t == T_Pixmap || t == T_Bitmap) {
402 o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val);
403 } else if (t == T_Character) {
404 o = Make_Char (*(unsigned char *)val);
405 } else if (t == T_Widget) {
406 o = Make_Widget_Foreign (*(Widget *)val);
407 } else if (t == T_Window) {
408 o = Make_Window (0, dpy, *(Window *)val);
409 } else {
410 char s[128];
411
412 sprintf (s, "%s: no converter for %s", argl[i].name,
413 r[j].resource_type);
414 Primitive_Error (s);
415 }
416 Car (tail) = o;
417 }
418 XtFree ((char *)r);
419 GC_Unlink;
420 return ret;
421 }
422
423 /* Convert `mapped-when-managed' to `mappedWhenManaged'.
424 */
Make_Resource_Name(register char * s)425 void Make_Resource_Name (register char *s) {
426 register char *p;
427
428 for (p = s; *s; ) {
429 if (*s == '-') {
430 if (*++s) {
431 if (islower (*s))
432 *s = toupper (*s);
433 *p++ = *s++;
434 }
435 } else *p++ = *s++;
436 }
437 *p = '\0';
438 }
439
Get_Resources(WidgetClass c,void (* fun)(),int freeit)440 Object Get_Resources (WidgetClass c, void (*fun)(), int freeit) {
441 XtResource *r;
442 register XtResource *p;
443 int nr;
444 Object ret, tail, tail2, x;
445 GC_Node3;
446
447 fun (c, &r, &nr);
448 /* Note:
449 * `r' is not freed in case of error.
450 */
451 ret = tail = tail2 = P_Make_List (Make_Integer (nr), Null);
452 GC_Link3 (ret, tail, tail2);
453 for (p = r; p < r+nr; p++, tail = Cdr (tail)) {
454 x = tail2 = P_Make_List (Make_Integer (3), Null);
455 Car (tail) = tail2 = x;
456 x = Intern (p->resource_name);
457 Car (tail2) = x; tail2 = Cdr (tail2);
458 x = Intern (p->resource_class);
459 Car (tail2) = x; tail2 = Cdr (tail2);
460 x = Intern (p->resource_type);
461 Car (tail2) = x;
462 }
463 GC_Unlink;
464 if (freeit) XtFree ((char *)r);
465 return ret;
466 }
467