scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First automatic conversion to scheme48 names.

This commit is contained in:
frese 2001-05-14 13:48:37 +00:00
parent 52a0e4dcc3
commit e87ee02ee9
24 changed files with 1007 additions and 1007 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
c/xlib/client.c
View File

@ -1,8 +1,8 @@
#include "xlib.h"
static Object Sym_Wm_Hints, Sym_Size_Hints;
static s48_value Sym_Wm_Hints, Sym_Size_Hints;
static Object P_Iconify_Window (w, scr) Object w, scr; {
static s48_value P_Iconify_Window (w, scr) s48_value w, scr; {
Check_Type (w, T_Window);
if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win,
Get_Screen_Number (WINDOW(w)->dpy, scr)))
@ -10,7 +10,7 @@ static Object P_Iconify_Window (w, scr) Object w, scr; {
return Void;
}
static Object P_Withdraw_Window (w, scr) Object w, scr; {
static s48_value P_Withdraw_Window (w, scr) s48_value w, scr; {
Check_Type (w, T_Window);
if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win,
Get_Screen_Number (WINDOW(w)->dpy, scr)))
@ -18,7 +18,7 @@ static Object P_Withdraw_Window (w, scr) Object w, scr; {
return Void;
}
static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; {
static s48_value P_Reconfigure_Wm_Window (w, scr, conf) s48_value w, scr, conf; {
unsigned long mask;
Check_Type (w, T_Window);
@ -29,39 +29,39 @@ static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; {
return Void;
}
static Object P_Wm_Command (w) Object w; {
static s48_value P_Wm_Command (w) s48_value w; {
int i, ac;
char **av;
Object s, ret, t;
GC_Node2;
s48_value s, ret, t;
S48_DECLARE_GC_PROTECT(2);
Check_Type (w, T_Window);
Disable_Interrupts;
if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac))
ac = 0;
Enable_Interrupts;
ret = t = P_Make_List (Make_Integer (ac), Null);
GC_Link2 (ret, t);
for (i = 0; i < ac; i++, t = Cdr (t)) {
ret = t = P_Make_List (s48_enter_integer (ac), S48_NULL);
S48_GC_PROTECT_2 (ret, t);
for (i = 0; i < ac; i++, t = S48_CDR (t)) {
s = Make_String (av[i], strlen (av[i]));
Car (t) = s;
S48_CAR (t) = s;
}
GC_Unlink;
S48_GC_UNPROTECT;
if (ac) XFreeStringList (av);
return ret;
}
static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; {
static String_List_To_Text_Property (x, ret) s48_value x; XTextProperty *ret; {
register i, n;
register char **s;
Object t;
s48_value t;
Alloca_Begin;
Check_List (x);
n = Fast_Length (x);
Alloca (s, char**, n * sizeof (char *));
for (i = 0; i < n; i++, x = Cdr (x)) {
t = Car (x);
for (i = 0; i < n; i++, x = S48_CDR (x)) {
t = S48_CAR (x);
Get_Strsym_Stack (t, s[i]);
}
if (!XStringListToTextProperty (s, n, ret))
@ -69,27 +69,27 @@ static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; {
Alloca_End;
}
static Object Text_Property_To_String_List (p) XTextProperty *p; {
static s48_value Text_Property_To_String_List (p) XTextProperty *p; {
int n;
register i;
char **s;
Object x, ret, t;
GC_Node2;
s48_value x, ret, t;
S48_DECLARE_GC_PROTECT(2);
if (!XTextPropertyToStringList (p, &s, &n))
Primitive_Error ("cannot convert from text property");
ret = t = P_Make_List (Make_Integer (n), Null);
GC_Link2 (ret, t);
for (i = 0; i < n; i++, t = Cdr (t)) {
ret = t = P_Make_List (s48_enter_integer (n), S48_NULL);
S48_GC_PROTECT_2 (ret, t);
for (i = 0; i < n; i++, t = S48_CDR (t)) {
x = Make_String (s[i], strlen (s[i]));
Car (t) = x;
S48_CAR (t) = x;
}
GC_Unlink;
S48_GC_UNPROTECT;
XFreeStringList (s);
return ret;
}
static Object P_Get_Text_Property (w, a) Object w, a; {
static s48_value P_Get_Text_Property (w, a) s48_value w, a; {
XTextProperty ret;
Check_Type (w, T_Window);
@ -98,13 +98,13 @@ static Object P_Get_Text_Property (w, a) Object w, a; {
if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret,
ATOM(a)->atom)) {
Enable_Interrupts;
return False;
return S48_FALSE;
}
Enable_Interrupts;
return Text_Property_To_String_List (&ret);
}
static Object P_Set_Text_Property (w, prop, a) Object w, prop, a; {
static s48_value P_Set_Text_Property (w, prop, a) s48_value w, prop, a; {
XTextProperty p;
Check_Type (w, T_Window);
@ -115,42 +115,42 @@ static Object P_Set_Text_Property (w, prop, a) Object w, prop, a; {
return Void;
}
static Object P_Wm_Protocols (w) Object w; {
static s48_value P_Wm_Protocols (w) s48_value w; {
Atom *p;
int i, n;
Object ret;
GC_Node;
s48_value ret;
S48_DECLARE_GC_PROTECT(1);
Check_Type (w, T_Window);
Disable_Interrupts;
if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
Primitive_Error ("cannot get WM protocols");
Enable_Interrupts;
ret = Make_Vector (n, Null);
GC_Link (ret);
ret = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (ret);
for (i = 0; i < n; i++) {
Object a;
s48_value a;
a = Make_Atom (p[i]);
VECTOR(ret)->data[i] = a;
S48_VECTOR_SET(ret, i, a;)
}
XFree ((char *)p);
GC_Unlink;
S48_GC_UNPROTECT;
return ret;
}
static Object P_Set_Wm_Protocols (w, v) Object w, v; {
static s48_value P_Set_Wm_Protocols (w, v) s48_value w, v; {
Atom *p;
int i, n;
Alloca_Begin;
Check_Type (w, T_Window);
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, Atom*, n * sizeof (Atom));
for (i = 0; i < n; i++) {
Object a;
a = VECTOR(v)->data[i];
s48_value a;
a = S48_VECTOR_REF(v, i);
Check_Type (a, T_Atom);
p[i] = ATOM(a)->atom;
}
@ -160,10 +160,10 @@ static Object P_Set_Wm_Protocols (w, v) Object w, v; {
return Void;
}
static Object P_Wm_Class (w) Object w; {
Object ret, x;
static s48_value P_Wm_Class (w) s48_value w; {
s48_value ret, x;
XClassHint c;
GC_Node;
S48_DECLARE_GC_PROTECT(1);
Check_Type (w, T_Window);
/*
@ -175,23 +175,23 @@ static Object P_Wm_Class (w) Object w; {
Disable_Interrupts;
(void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
Enable_Interrupts;
ret = Cons (False, False);
GC_Link (ret);
ret = s48_cons (S48_FALSE, S48_FALSE);
S48_GC_PROTECT_1 (ret);
if (c.res_name) {
x = Make_String (c.res_name, strlen (c.res_name));
Car (ret) = x;
S48_CAR (ret) = x;
XFree (c.res_name);
}
if (c.res_class) {
x = Make_String (c.res_class, strlen (c.res_class));
Cdr (ret) = x;
S48_CDR (ret) = x;
XFree (c.res_class);
}
GC_Unlink;
S48_GC_UNPROTECT;
return ret;
}
static Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
static s48_value P_Set_Wm_Class (w, name, class) s48_value w, name, class; {
XClassHint c;
Check_Type (w, T_Window);
@ -201,18 +201,18 @@ static Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
return Void;
}
static Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
static s48_value P_Set_Wm_Command (w, cmd) s48_value w, cmd; {
register i, n;
register char **argv;
Object c;
s48_value c;
Alloca_Begin;
Check_Type (w, T_Window);
Check_List (cmd);
n = Fast_Length (cmd);
Alloca (argv, char**, n * sizeof (char *));
for (i = 0; i < n; i++, cmd = Cdr (cmd)) {
c = Car (cmd);
for (i = 0; i < n; i++, cmd = S48_CDR (cmd)) {
c = S48_CAR (cmd);
Get_Strsym_Stack (c, argv[i]);
}
XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n);
@ -220,7 +220,7 @@ static Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
return Void;
}
static Object P_Wm_Hints (w) Object w; {
static s48_value P_Wm_Hints (w) s48_value w; {
XWMHints *p;
Check_Type (w, T_Window);
@ -237,7 +237,7 @@ static Object P_Wm_Hints (w) Object w; {
WINDOW(w)->dpy, (unsigned long)WMH.flags);
}
static Object P_Set_Wm_Hints (w, h) Object w, h; {
static s48_value P_Set_Wm_Hints (w, h) s48_value w, h; {
unsigned long mask;
Check_Type (w, T_Window);
@ -247,7 +247,7 @@ static Object P_Set_Wm_Hints (w, h) Object w, h; {
return Void;
}
static Object P_Size_Hints (w, a) Object w, a; {
static s48_value P_Size_Hints (w, a) s48_value w, a; {
long supplied;
Check_Type (w, T_Window);
@ -269,7 +269,7 @@ static Object P_Size_Hints (w, a) Object w, a; {
WINDOW(w)->dpy, (unsigned long)SZH.flags);
}
static Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
static s48_value P_Set_Size_Hints (w, a, h) s48_value w, a, h; {
unsigned long mask;
Check_Type (w, T_Window);
@ -286,68 +286,68 @@ static Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
return Void;
}
static Object P_Icon_Sizes (w) Object w; {
static s48_value P_Icon_Sizes (w) s48_value w; {
XIconSize *p;
int i, n;
Object v;
GC_Node;
s48_value v;
S48_DECLARE_GC_PROTECT(1);
Check_Type (w, T_Window);
Disable_Interrupts;
if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
n = 0;
Enable_Interrupts;
v = Make_Vector (n, Null);
GC_Link (v);
v = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (v);
for (i = 0; i < n; i++) {
register XIconSize *q = &p[i];
Object t;
s48_value t;
t = P_Make_List (Make_Integer (6), Null);
VECTOR(v)->data[i] = t;
Car (t) = Make_Integer (q->min_width); t = Cdr (t);
Car (t) = Make_Integer (q->min_height); t = Cdr (t);
Car (t) = Make_Integer (q->max_width); t = Cdr (t);
Car (t) = Make_Integer (q->max_height); t = Cdr (t);
Car (t) = Make_Integer (q->width_inc); t = Cdr (t);
Car (t) = Make_Integer (q->height_inc);
t = P_Make_List (s48_enter_integer (6), S48_NULL);
S48_VECTOR_SET(v, i, t;)
S48_CAR (t) = s48_enter_integer (q->min_width); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (q->min_height); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (q->max_width); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (q->max_height); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (q->width_inc); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (q->height_inc);
}
GC_Unlink;
S48_GC_UNPROTECT;
if (n > 0)
XFree ((char *)p);
return v;
}
static Object P_Set_Icon_Sizes (w, v) Object w, v; {
static s48_value P_Set_Icon_Sizes (w, v) s48_value w, v; {
register i, n;
XIconSize *p;
Alloca_Begin;
Check_Type (w, T_Window);
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XIconSize*, n * sizeof (XIconSize));
for (i = 0; i < n; i++) {
register XIconSize *q = &p[i];
Object t;
s48_value t;
t = VECTOR(v)->data[i];
t = S48_VECTOR_REF(v, i);
Check_List (t);
if (Fast_Length (t) != 6)
Primitive_Error ("invalid argument: ~s", t);
q->min_width = Get_Integer (Car (t)); t = Cdr (t);
q->min_height = Get_Integer (Car (t)); t = Cdr (t);
q->max_width = Get_Integer (Car (t)); t = Cdr (t);
q->max_height = Get_Integer (Car (t)); t = Cdr (t);
q->width_inc = Get_Integer (Car (t)); t = Cdr (t);
q->height_inc = Get_Integer (Car (t));
q->min_width = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t);
q->min_height = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t);
q->max_width = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t);
q->max_height = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t);
q->width_inc = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t);
q->height_inc = (int)s48_extract_integer (S48_CAR (t));
}
XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n);
Alloca_End;
return Void;
}
static Object P_Transient_For (w) Object w; {
static s48_value P_Transient_For (w) s48_value w; {
Window win;
Disable_Interrupts;
@ -357,7 +357,7 @@ static Object P_Transient_For (w) Object w; {
return Make_Window (0, WINDOW(w)->dpy, win);
}
static Object P_Set_Transient_For (w, pw) Object w, pw; {
static s48_value P_Set_Transient_For (w, pw) s48_value w, pw; {
Check_Type (w, T_Window);
XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw));
return Void;

74
c/xlib/color.c
View File

@ -2,20 +2,20 @@
Generic_Predicate (Color)
static Color_Equal (x, y) Object x, y; {
static Color_Equal (x, y) s48_value x, y; {
register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c;
return p->red == q->red && p->green == q->green && p->blue == q->blue;
}
Generic_Print (Color, "#[color %lu]", POINTER(x))
Object Make_Color (r, g, b) unsigned int r, g, b; {
Object c;
s48_value Make_Color (r, g, b) unsigned int r, g, b; {
s48_value c;
c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b);
if (Nullp (c)) {
if (S48_NULL_P (c)) {
c = Alloc_Object (sizeof (struct S_Color), T_Color, 0);
COLOR(c)->tag = Null;
COLOR(c)->tag = S48_NULL;
COLOR(c)->c.red = r;
COLOR(c)->c.green = g;
COLOR(c)->c.blue = b;
@ -24,43 +24,43 @@ Object Make_Color (r, g, b) unsigned int r, g, b; {
return c;
}
XColor *Get_Color (c) Object c; {
XColor *Get_Color (c) s48_value c; {
Check_Type (c, T_Color);
return &COLOR(c)->c;
}
static unsigned short Get_RGB_Value (x) Object x; {
static unsigned short Get_RGB_Value (x) s48_value x; {
double d;
d = Get_Double (x);
d = s48_extract_double (x);
if (d < 0.0 || d > 1.0)
Primitive_Error ("bad RGB value: ~s", x);
return (unsigned short)(d * 65535);
}
static Object P_Make_Color (r, g, b) Object r, g, b; {
static s48_value P_Make_Color (r, g, b) s48_value r, g, b; {
return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value (b));
}
static Object P_Color_Rgb_Values (c) Object c; {
Object ret, t, x;
GC_Node3;
static s48_value P_Color_Rgb_Values (c) s48_value c; {
s48_value ret, t, x;
S48_DECLARE_GC_PROTECT(3);
Check_Type (c, T_Color);
ret = t = Null;
GC_Link3 (c, ret, t);
t = ret = P_Make_List (Make_Integer (3), Null);
GC_Unlink;
ret = t = S48_NULL;
S48_GC_PROTECT_3 (c, ret, t);
t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_GC_UNPROTECT;
x = Make_Reduced_Flonum ((double)COLOR(c)->c.red / 65535.0);
Car (t) = x; t = Cdr (t);
S48_CAR (t) = x; t = S48_CDR (t);
x = Make_Reduced_Flonum ((double)COLOR(c)->c.green / 65535.0);
Car (t) = x; t = Cdr (t);
S48_CAR (t) = x; t = S48_CDR (t);
x = Make_Reduced_Flonum ((double)COLOR(c)->c.blue / 65535.0);
Car (t) = x;
S48_CAR (t) = x;
return ret;
}
static Object P_Query_Color (cmap, p) Object cmap, p; {
static s48_value P_Query_Color (cmap, p) s48_value cmap, p; {
XColor c;
Colormap cm = Get_Colormap (cmap);
@ -71,51 +71,51 @@ static Object P_Query_Color (cmap, p) Object cmap, p; {
return Make_Color (c.red, c.green, c.blue);
}
static Object P_Query_Colors (cmap, v) Object cmap, v; {
static s48_value P_Query_Colors (cmap, v) s48_value cmap, v; {
Colormap cm = Get_Colormap (cmap);
register i, n;
Object ret;
s48_value ret;
register XColor *p;
GC_Node;
S48_DECLARE_GC_PROTECT(1);
Alloca_Begin;
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XColor*, n * sizeof (XColor));
for (i = 0; i < n; i++)
p[i].pixel = Get_Pixel (VECTOR(v)->data[i]);
Disable_Interrupts;
XQueryColors (COLORMAP(cmap)->dpy, cm, p, n);
Enable_Interrupts;
ret = Make_Vector (n, Null);
GC_Link (ret);
ret = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (ret);
for (i = 0; i < n; i++, p++) {
Object x;
s48_value x;
x = Make_Color (p->red, p->green, p->blue);
VECTOR(ret)->data[i] = x;
S48_VECTOR_SET(ret, i, x;)
}
GC_Unlink;
S48_GC_UNPROTECT;
Alloca_End;
return ret;
}
static Object P_Lookup_Color (cmap, name) Object cmap, name; {
static s48_value P_Lookup_Color (cmap, name) s48_value cmap, name; {
XColor visual, exact;
Colormap cm = Get_Colormap (cmap);
Object ret, x;
GC_Node;
s48_value ret, x;
S48_DECLARE_GC_PROTECT(1);
if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
&visual, &exact))
Primitive_Error ("no such color: ~s", name);
ret = Cons (Null, Null);
GC_Link (ret);
ret = s48_cons (S48_NULL, S48_NULL);
S48_GC_PROTECT_1 (ret);
x = Make_Color (visual.red, visual.green, visual.blue);
Car (ret) = x;
S48_CAR (ret) = x;
x = Make_Color (exact.red, exact.green, exact.blue);
Cdr (ret) = x;
GC_Unlink;
S48_CDR (ret) = x;
S48_GC_UNPROTECT;
return ret;
}

36
c/xlib/colormap.c
View File

@ -8,15 +8,15 @@ Generic_Print (Colormap, "#[colormap %lu]", COLORMAP(x)->cm)
Generic_Get_Display (Colormap, COLORMAP)
Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
Object cm;
s48_value Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
s48_value cm;
if (cmap == None)
return Sym_None;
cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap);
if (Nullp (cm)) {
if (S48_NULL_P (cm)) {
cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0);
COLORMAP(cm)->tag = Null;
COLORMAP(cm)->tag = S48_NULL;
COLORMAP(cm)->cm = cmap;
COLORMAP(cm)->dpy = dpy;
COLORMAP(cm)->free = 0;
@ -26,12 +26,12 @@ Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
return cm;
}
Colormap Get_Colormap (c) Object c; {
Colormap Get_Colormap (c) s48_value c; {
Check_Type (c, T_Colormap);
return COLORMAP(c)->cm;
}
Object P_Free_Colormap (c) Object c; {
s48_value P_Free_Colormap (c) s48_value c; {
Check_Type (c, T_Colormap);
if (!COLORMAP(c)->free)
XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
@ -40,7 +40,7 @@ Object P_Free_Colormap (c) Object c; {
return Void;
}
static Object P_Alloc_Color (cmap, color) Object cmap, color; {
static s48_value P_Alloc_Color (cmap, color) s48_value cmap, color; {
XColor c;
Colormap cm = Get_Colormap (cmap);
int r;
@ -50,32 +50,32 @@ static Object P_Alloc_Color (cmap, color) Object cmap, color; {
r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c);
Enable_Interrupts;
if (!r)
return False;
return S48_FALSE;
return Make_Pixel (c.pixel);
}
static Object P_Alloc_Named_Color (cmap, name) Object cmap, name; {
static s48_value P_Alloc_Named_Color (cmap, name) s48_value cmap, name; {
Colormap cm = Get_Colormap (cmap);
XColor screen, exact;
int r;
Object ret, t, x;
GC_Node2;
s48_value ret, t, x;
S48_DECLARE_GC_PROTECT(2);
Disable_Interrupts;
r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
&screen, &exact);
Enable_Interrupts;
if (!r)
return False;
t = ret = P_Make_List (Make_Integer (3), Null);
GC_Link2 (t, ret);
return S48_FALSE;
t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_GC_PROTECT_2 (t, ret);
x = Make_Pixel (screen.pixel);
Car (t) = x; t = Cdr (t);
S48_CAR (t) = x; t = S48_CDR (t);
x = Make_Color (screen.red, screen.green, screen.blue);
Car (t) = x; t = Cdr (t);
S48_CAR (t) = x; t = S48_CDR (t);
x = Make_Color (exact.red, exact.green, exact.blue);
Car (t) = x;
GC_Unlink;
S48_CAR (t) = x;
S48_GC_UNPROTECT;
return ret;
}

36
c/xlib/cursor.c
View File

@ -8,16 +8,16 @@ Generic_Print (Cursor, "#[cursor %lu]", CURSOR(x)->cursor)
Generic_Get_Display (Cursor, CURSOR)
static Object Internal_Make_Cursor (finalize, dpy, cursor)
static s48_value Internal_Make_Cursor (finalize, dpy, cursor)
Display *dpy; Cursor cursor; {
Object c;
s48_value c;
if (cursor == None)
return Sym_None;
c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor);
if (Nullp (c)) {
if (S48_NULL_P (c)) {
c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0);
CURSOR(c)->tag = Null;
CURSOR(c)->tag = S48_NULL;
CURSOR(c)->cursor = cursor;
CURSOR(c)->dpy = dpy;
CURSOR(c)->free = 0;
@ -28,22 +28,22 @@ static Object Internal_Make_Cursor (finalize, dpy, cursor)
}
/* Backwards compatibility: */
Object Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
s48_value Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
return Internal_Make_Cursor (1, dpy, cursor);
}
Object Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; {
s48_value Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; {
return Internal_Make_Cursor (0, dpy, cursor);
}
Cursor Get_Cursor (c) Object c; {
if (EQ(c, Sym_None))
Cursor Get_Cursor (c) s48_value c; {
if (S48_EQ_P(c, Sym_None))
return None;
Check_Type (c, T_Cursor);
return CURSOR(c)->cursor;
}
Object P_Free_Cursor (c) Object c; {
s48_value P_Free_Cursor (c) s48_value c; {
Check_Type (c, T_Cursor);
if (!CURSOR(c)->free)
XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
@ -52,28 +52,28 @@ Object P_Free_Cursor (c) Object c; {
return Void;
}
static Object P_Create_Cursor (srcp, maskp, x, y, f, b)
Object srcp, maskp, x, y, f, b; {
static s48_value P_Create_Cursor (srcp, maskp, x, y, f, b)
s48_value srcp, maskp, x, y, f, b; {
Pixmap sp = Get_Pixmap (srcp), mp;
Display *d = PIXMAP(srcp)->dpy;
mp = EQ(maskp, Sym_None) ? None : Get_Pixmap (maskp);
mp = S48_EQ_P(maskp, Sym_None) ? None : Get_Pixmap (maskp);
return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp,
Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y)));
Get_Color (f), Get_Color (b), (int)s48_extract_integer (x), (int)s48_extract_integer (y)));
}
static Object P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
Object srcf, srcc, maskf, maskc, f, b; {
static s48_value P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
s48_value srcf, srcc, maskf, maskc, f, b; {
Font sf = Get_Font (srcf), mf;
Display *d = FONT(srcf)->dpy;
mf = EQ(maskf, Sym_None) ? None : Get_Font (maskf);
mf = S48_EQ_P(maskf, Sym_None) ? None : Get_Font (maskf);
return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf,
Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc),
(int)s48_extract_integer (srcc), mf == None ? 0 : (int)s48_extract_integer (maskc),
Get_Color (f), Get_Color (b)));
}
static Object P_Recolor_Cursor (c, f, b) Object c, f, b; {
static s48_value P_Recolor_Cursor (c, f, b) s48_value c, f, b; {
Check_Type (c, T_Cursor);
XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f),
Get_Color (b));

144
c/xlib/display.c
View File

@ -1,6 +1,6 @@
#include "xlib.h"
static Display_Visit (dp, f) Object *dp; int (*f)(); {
static Display_Visit (dp, f) s48_value *dp; int (*f)(); {
(*f)(&DISPLAY(*dp)->after);
}
@ -8,27 +8,27 @@ Generic_Predicate (Display)
Generic_Equal (Display, DISPLAY, dpy)
static Display_Print (d, port, raw, depth, length) Object d, port; {
static Display_Print (d, port, raw, depth, length) s48_value d, port; {
Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy,
DisplayString (DISPLAY(d)->dpy));
}
Object Make_Display (finalize, dpy) Display *dpy; {
Object d;
s48_value Make_Display (finalize, dpy) Display *dpy; {
s48_value d;
d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj);
if (Nullp (d)) {
if (S48_NULL_P (d)) {
d = Alloc_Object (sizeof (struct S_Display), T_Display, 0);
DISPLAY(d)->dpy = dpy;
DISPLAY(d)->free = 0;
DISPLAY(d)->after = False;
DISPLAY(d)->after = S48_FALSE;
Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
(PFO)0, 1);
}
return d;
}
static Object P_Open_Display (argc, argv) Object *argv; {
static s48_value P_Open_Display (argc, argv) s48_value *argv; {
register char *s;
Display *dpy;
@ -43,7 +43,7 @@ static Object P_Open_Display (argc, argv) Object *argv; {
return Make_Display (1, dpy);
}
Object P_Close_Display (d) Object d; {
s48_value P_Close_Display (d) s48_value d; {
register struct S_Display *p;
Check_Type (d, T_Display);
@ -57,13 +57,13 @@ Object P_Close_Display (d) Object d; {
return Void;
}
static Object P_Display_Default_Root_Window (d) Object d; {
static s48_value P_Display_Default_Root_Window (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Window (0, DISPLAY(d)->dpy,
DefaultRootWindow (DISPLAY(d)->dpy));
}
static Object P_Display_Default_Colormap (d) Object d; {
static s48_value P_Display_Default_Colormap (d) s48_value d; {
register Display *dpy;
Check_Type (d, T_Display);
@ -71,7 +71,7 @@ static Object P_Display_Default_Colormap (d) Object d; {
return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy)));
}
static Object P_Display_Default_Gcontext (d) Object d; {
static s48_value P_Display_Default_Gcontext (d) s48_value d; {
register Display *dpy;
Check_Type (d, T_Display);
@ -79,40 +79,40 @@ static Object P_Display_Default_Gcontext (d) Object d; {
return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy)));
}
static Object P_Display_Default_Depth (d) Object d; {
static s48_value P_Display_Default_Depth (d) s48_value d; {
register Display *dpy;
Check_Type (d, T_Display);
dpy = DISPLAY(d)->dpy;
return Make_Integer (DefaultDepth (dpy, DefaultScreen (dpy)));
return s48_enter_integer (DefaultDepth (dpy, DefaultScreen (dpy)));
}
static Object P_Display_Default_Screen_Number (d) Object d; {
static s48_value P_Display_Default_Screen_Number (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DefaultScreen (DISPLAY(d)->dpy));
return s48_enter_integer (DefaultScreen (DISPLAY(d)->dpy));
}
int Get_Screen_Number (dpy, scr) Display *dpy; Object scr; {
int Get_Screen_Number (dpy, scr) Display *dpy; s48_value scr; {
register s;
if ((s = Get_Integer (scr)) < 0 || s > ScreenCount (dpy)-1)
if ((s = (int)s48_extract_integer (scr)) < 0 || s > ScreenCount (dpy)-1)
Primitive_Error ("invalid screen number");
return s;
}
static Object P_Display_Cells (d, scr) Object d, scr; {
static s48_value P_Display_Cells (d, scr) s48_value d, scr; {
Check_Type (d, T_Display);
return Make_Integer (DisplayCells (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayCells (DISPLAY(d)->dpy,
Get_Screen_Number (DISPLAY(d)->dpy, scr)));
}
static Object P_Display_Planes (d, scr) Object d, scr; {
static s48_value P_Display_Planes (d, scr) s48_value d, scr; {
Check_Type (d, T_Display);
return Make_Integer (DisplayPlanes (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayPlanes (DISPLAY(d)->dpy,
Get_Screen_Number (DISPLAY(d)->dpy, scr)));
}
static Object P_Display_String (d) Object d; {
static s48_value P_Display_String (d) s48_value d; {
register char *s;
Check_Type (d, T_Display);
@ -120,140 +120,140 @@ static Object P_Display_String (d) Object d; {
return Make_String (s, strlen (s));
}
static Object P_Display_Vendor (d) Object d; {
static s48_value P_Display_Vendor (d) s48_value d; {
register char *s;
Object ret, name;
GC_Node;
s48_value ret, name;
S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display);
s = ServerVendor (DISPLAY(d)->dpy);
name = Make_String (s, strlen (s));
GC_Link (name);
ret = Cons (Null, Make_Integer (VendorRelease (DISPLAY(d)->dpy)));
Car (ret) = name;
GC_Unlink;
S48_GC_PROTECT_1 (name);
ret = s48_cons (S48_NULL, s48_enter_integer (VendorRelease (DISPLAY(d)->dpy)));
S48_CAR (ret) = name;
S48_GC_UNPROTECT;
return ret;
}
static Object P_Display_Protocol_Version (d) Object d; {
static s48_value P_Display_Protocol_Version (d) s48_value d; {
Check_Type (d, T_Display);
return Cons (Make_Integer (ProtocolVersion (DISPLAY(d)->dpy)),
Make_Integer (ProtocolRevision (DISPLAY(d)->dpy)));
return s48_cons (s48_enter_integer (ProtocolVersion (DISPLAY(d)->dpy)),
s48_enter_integer (ProtocolRevision (DISPLAY(d)->dpy)));
}
static Object P_Display_Screen_Count (d) Object d; {
static s48_value P_Display_Screen_Count (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (ScreenCount (DISPLAY(d)->dpy));
return s48_enter_integer (ScreenCount (DISPLAY(d)->dpy));
}
static Object P_Display_Image_Byte_Order (d) Object d; {
static s48_value P_Display_Image_Byte_Order (d) s48_value d; {
Check_Type (d, T_Display);
return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy),
0, Byte_Order_Syms);
}
static Object P_Display_Bitmap_Unit (d) Object d; {
static s48_value P_Display_Bitmap_Unit (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (BitmapUnit (DISPLAY(d)->dpy));
return s48_enter_integer (BitmapUnit (DISPLAY(d)->dpy));
}
static Object P_Display_Bitmap_Bit_Order (d) Object d; {
static s48_value P_Display_Bitmap_Bit_Order (d) s48_value d; {
Check_Type (d, T_Display);
return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy),
0, Byte_Order_Syms);
}
static Object P_Display_Bitmap_Pad (d) Object d; {
static s48_value P_Display_Bitmap_Pad (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (BitmapPad (DISPLAY(d)->dpy));
return s48_enter_integer (BitmapPad (DISPLAY(d)->dpy));
}
static Object P_Display_Width (d) Object d; {
static s48_value P_Display_Width (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DisplayWidth (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayWidth (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));
}
static Object P_Display_Height (d) Object d; {
static s48_value P_Display_Height (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DisplayHeight (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayHeight (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));
}
static Object P_Display_Width_Mm (d) Object d; {
static s48_value P_Display_Width_Mm (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DisplayWidthMM (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayWidthMM (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));
}
static Object P_Display_Height_Mm (d) Object d; {
static s48_value P_Display_Height_Mm (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DisplayHeightMM (DISPLAY(d)->dpy,
return s48_enter_integer (DisplayHeightMM (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));
}
static Object P_Display_Motion_Buffer_Size (d) Object d; {
static s48_value P_Display_Motion_Buffer_Size (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Unsigned_Long (XDisplayMotionBufferSize (DISPLAY(d)->dpy));
return s48_enter_integer (XDisplayMotionBufferSize (DISPLAY(d)->dpy));
}
static Object P_Display_Flush_Output (d) Object d; {
static s48_value P_Display_Flush_Output (d) s48_value d; {
Check_Type (d, T_Display);
XFlush (DISPLAY(d)->dpy);
return Void;
}
static Object P_Display_Wait_Output (d, discard) Object d, discard; {
static s48_value P_Display_Wait_Output (d, discard) s48_value d, discard; {
Check_Type (d, T_Display);
Check_Type (discard, T_Boolean);
XSync (DISPLAY(d)->dpy, EQ(discard, True));
XSync (DISPLAY(d)->dpy, S48_EQ_P(discard, S48_TRUE));
return Void;
}
static Object P_No_Op (d) Object d; {
static s48_value P_No_Op (d) s48_value d; {
Check_Type (d, T_Display);
XNoOp (DISPLAY(d)->dpy);
return Void;
}
static Object P_List_Depths (d, scr) Object d, scr; {
static s48_value P_List_Depths (d, scr) s48_value d, scr; {
int num;
register *p, i;
Object ret;
s48_value ret;
Check_Type (d, T_Display);
if (!(p = XListDepths (DISPLAY(d)->dpy,
Get_Screen_Number (DISPLAY(d)->dpy, scr), &num)))
return False;
ret = Make_Vector (num, Null);
return S48_FALSE;
ret = s48_make_vector (num, S48_NULL);
for (i = 0; i < num; i++)
VECTOR(ret)->data[i] = Make_Integer (p[i]);
S48_VECTOR_SET(ret, i, s48_enter_integer (p[i]);)
XFree ((char *)p);
return ret;
}
static Object P_List_Pixmap_Formats (d) Object d; {
static s48_value P_List_Pixmap_Formats (d) s48_value d; {
register XPixmapFormatValues *p;
int num;
register i;
Object ret;
GC_Node;
s48_value ret;
S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display);
if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num)))
return False;
ret = Make_Vector (num, Null);
GC_Link (ret);
return S48_FALSE;
ret = s48_make_vector (num, S48_NULL);
S48_GC_PROTECT_1 (ret);
for (i = 0; i < num; i++) {
Object t;
s48_value t;
t = P_Make_List (Make_Integer (3), Null);
VECTOR(ret)->data[i] = t;
Car (t) = Make_Integer (p[i].depth); t = Cdr (t);
Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t);
Car (t) = Make_Integer (p[i].scanline_pad);
t = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_VECTOR_SET(ret, i, t;)
S48_CAR (t) = s48_enter_integer (p[i].depth); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (p[i].bits_per_pixel); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (p[i].scanline_pad);
}
GC_Unlink;
S48_GC_UNPROTECT;
XFree ((char *)p);
return ret;
}

68
c/xlib/error.c
View File

@ -1,20 +1,20 @@
#include "xlib.h"
static Object V_X_Error_Handler, V_X_Fatal_Error_Handler;
static s48_value V_X_Error_Handler, V_X_Fatal_Error_Handler;
/* Default error handlers of the Xlib */
extern int _XDefaultIOError();
extern int _XDefaultError();
static X_Fatal_Error (d) Display *d; {
Object args, fun;
GC_Node;
s48_value args, fun;
S48_DECLARE_GC_PROTECT(1);
Reset_IO (0);
args = Make_Display (0, d);
GC_Link (args);
args = Cons (args, Null);
GC_Unlink;
S48_GC_PROTECT_1 (args);
args = s48_cons (args, S48_NULL);
S48_GC_UNPROTECT;
fun = Var_Get (V_X_Fatal_Error_Handler);
if (TYPE(fun) == T_Compound)
(void)Funcall (fun, args, 0);
@ -24,26 +24,26 @@ static X_Fatal_Error (d) Display *d; {
}
static X_Error (d, ep) Display *d; XErrorEvent *ep; {
Object args, a, fun;
GC_Node;
s48_value args, a, fun;
S48_DECLARE_GC_PROTECT(1);
Reset_IO (0);
args = Make_Unsigned_Long ((unsigned long)ep->resourceid);
GC_Link (args);
args = Cons (args, Null);
a = Make_Unsigned (ep->minor_code);
args = Cons (a, args);
a = Make_Unsigned (ep->request_code);
args = Cons (a, args);
args = s48_enter_integer ((unsigned long)ep->resourceid);
S48_GC_PROTECT_1 (args);
args = s48_cons (args, S48_NULL);
a = s48_enter_integer (ep->minor_code);
args = s48_cons (a, args);
a = s48_enter_integer (ep->request_code);
args = s48_cons (a, args);
a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms);
if (Nullp (a))
a = Make_Unsigned (ep->error_code);
args = Cons (a, args);
a = Make_Unsigned_Long (ep->serial);
args = Cons (a, args);
if (S48_NULL_P (a))
a = s48_enter_integer (ep->error_code);
args = s48_cons (a, args);
a = s48_enter_integer (ep->serial);
args = s48_cons (a, args);
a = Make_Display (0, ep->display);
args = Cons (a, args);
GC_Unlink;
args = s48_cons (a, args);
S48_GC_UNPROTECT;
fun = Var_Get (V_X_Error_Handler);
if (TYPE(fun) == T_Compound)
(void)Funcall (fun, args, 0);
@ -52,21 +52,21 @@ static X_Error (d, ep) Display *d; XErrorEvent *ep; {
}
static X_After_Function (d) Display *d; {
Object args;
GC_Node;
s48_value args;
S48_DECLARE_GC_PROTECT(1);
args = Make_Display (0, d);
GC_Link (args);
args = Cons (args, Null);
GC_Unlink;
(void)Funcall (DISPLAY(Car (args))->after, args, 0);
S48_GC_PROTECT_1 (args);
args = s48_cons (args, S48_NULL);
S48_GC_UNPROTECT;
(void)Funcall (DISPLAY(S48_CAR (args))->after, args, 0);
}
static Object P_Set_After_Function (d, f) Object d, f; {
Object old;
static s48_value P_Set_After_Function (d, f) s48_value d, f; {
s48_value old;
Check_Type (d, T_Display);
if (EQ(f, False)) {
if (S48_EQ_P(f, S48_FALSE)) {
(void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0);
} else {
Check_Procedure (f);
@ -77,14 +77,14 @@ static Object P_Set_After_Function (d, f) Object d, f; {
return old;
}
static Object P_After_Function (d) Object d; {
static s48_value P_After_Function (d) s48_value d; {
Check_Type (d, T_Display);
return DISPLAY(d)->after;
}
elk_init_xlib_error () {
Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", Null);
Define_Variable (&V_X_Error_Handler, "x-error-handler", Null);
Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", S48_NULL);
Define_Variable (&V_X_Error_Handler, "x-error-handler", S48_NULL);
(void)XSetIOErrorHandler (X_Fatal_Error);
(void)XSetErrorHandler (X_Error);
Define_Primitive (P_Set_After_Function, "set-after-function!", 2, 2, EVAL);

280
c/xlib/event.c
View File

@ -2,7 +2,7 @@
#define MAX_ARGS 14
static Object Argl, Argv;
static s48_value Argl, Argv;
static struct event_desc {
char *name;
@ -47,8 +47,8 @@ static struct event_desc {
};
struct predicate_arg {
Object *funcs;
Object *ret;
s48_value *funcs;
s48_value *ret;
};
/*ARGSUSED*/
@ -60,17 +60,17 @@ static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep;
#endif
struct predicate_arg *ap = (struct predicate_arg *)ptr;
register i;
Object args;
GC_Node;
s48_value args;
S48_DECLARE_GC_PROTECT(1);
if ((i = ep->type) < LASTEvent && !Nullp (ap->funcs[i])) {
if ((i = ep->type) < LASTEvent && !S48_NULL_P (ap->funcs[i])) {
args = Get_Event_Args (ep);
GC_Link (args);
S48_GC_PROTECT_1 (args);
*ap->ret = Funcall (ap->funcs[i], args, 0);
Destroy_Event_Args (args);
GC_Unlink;
S48_GC_UNPROTECT;
}
return Truep (*ap->ret);
return S48_TRUE_P (*ap->ret);
}
/* (handle-events display discard? peek? clause...)
@ -80,64 +80,64 @@ static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep;
* peek?: don't discard processed events.
*/
static Object P_Handle_Events (argl) Object argl; {
Object next, clause, func, ret, funcs[LASTEvent], args;
static s48_value P_Handle_Events (argl) s48_value argl; {
s48_value next, clause, func, ret, funcs[LASTEvent], args;
register i, discard, peek;
Display *dpy;
char *errmsg = "event occurs more than once";
GC_Node3; struct gcnode gcv;
S48_DECLARE_GC_PROTECT(3); struct gcnode gcv;
TC_Prolog;
TC_Disable;
clause = args = Null;
GC_Link3 (argl, clause, args);
next = Eval (Car (argl));
clause = args = S48_NULL;
S48_GC_PROTECT_3 (argl, clause, args);
next = Eval (S48_CAR (argl));
Check_Type (next, T_Display);
dpy = DISPLAY(next)->dpy;
argl = Cdr (argl);
next = Eval (Car (argl));
argl = S48_CDR (argl);
next = Eval (S48_CAR (argl));
Check_Type (next, T_Boolean);
discard = Truep (next);
argl = Cdr (argl);
next = Eval (Car (argl));
discard = S48_TRUE_P (next);
argl = S48_CDR (argl);
next = Eval (S48_CAR (argl));
Check_Type (next, T_Boolean);
peek = Truep (next);
peek = S48_TRUE_P (next);
for (i = 0; i < LASTEvent; i++)
funcs[i] = Null;
funcs[i] = S48_NULL;
gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv;
for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) {
clause = Car (argl);
for (argl = S48_CDR (argl); !S48_NULL_P (argl); argl = S48_CDR (argl)) {
clause = S48_CAR (argl);
Check_List (clause);
if (Fast_Length (clause) != 2)
Primitive_Error ("badly formed event clause");
func = Eval (Car (Cdr (clause)));
func = Eval (S48_CAR (S48_CDR (clause)));
Check_Procedure (func);
clause = Car (clause);
if (EQ(clause, Sym_Else)) {
clause = S48_CAR (clause);
if (S48_EQ_P(clause, Sym_Else)) {
for (i = 0; i < LASTEvent; i++)
if (Nullp (funcs[i])) funcs[i] = func;
if (S48_NULL_P (funcs[i])) funcs[i] = func;
} else {
if (TYPE(clause) == T_Pair) {
for (; !Nullp (clause); clause = Cdr (clause)) {
i = Encode_Event (Car (clause));
if (!Nullp (funcs[i]))
if (S48_PAIR_P(clause)) {
for (; !S48_NULL_P (clause); clause = S48_CDR (clause)) {
i = Encode_Event (S48_CAR (clause));
if (!S48_NULL_P (funcs[i]))
Primitive_Error (errmsg);
funcs[i] = func;
}
} else {
i = Encode_Event (clause);
if (!Nullp (funcs[i]))
if (!S48_NULL_P (funcs[i]))
Primitive_Error (errmsg);
funcs[i] = func;
}
}
}
ret = False;
while (!Truep (ret)) {
ret = S48_FALSE;
while (!S48_TRUE_P (ret)) {
XEvent e;
if (discard) {
(peek ? XPeekEvent : XNextEvent) (dpy, &e);
if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) {
if ((i = e.type) < LASTEvent && !S48_NULL_P (funcs[i])) {
args = Get_Event_Args (&e);
ret = Funcall (funcs[i], args, 0);
Destroy_Event_Args (args);
@ -157,29 +157,29 @@ static Object P_Handle_Events (argl) Object argl; {
#endif
}
}
GC_Unlink;
S48_GC_UNPROTECT;
TC_Enable;
return ret;
}
static Object Get_Time_Arg (t) Time t; {
return t == CurrentTime ? Sym_Now : Make_Unsigned_Long ((unsigned long)t);
static s48_value Get_Time_Arg (t) Time t; {
return t == CurrentTime ? Sym_Now : s48_enter_integer ((unsigned long)t);
}
Object Get_Event_Args (ep) XEvent *ep; {
Object tmpargs[MAX_ARGS];
s48_value Get_Event_Args (ep) XEvent *ep; {
s48_value tmpargs[MAX_ARGS];
register e, i;
register Object *a, *vp;
register s48_value *a, *vp;
struct gcnode gcv;
Object dummy;
GC_Node;
s48_value dummy;
S48_DECLARE_GC_PROTECT(1);
e = ep->type;
dummy = Null;
dummy = S48_NULL;
a = tmpargs;
for (i = 0; i < MAX_ARGS; i++)
a[i] = Null;
GC_Link (dummy);
a[i] = S48_NULL;
S48_GC_PROTECT_1 (dummy);
gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv;
switch (e) {
case KeyPress: case KeyRelease:
@ -191,31 +191,31 @@ Object Get_Event_Args (ep) XEvent *ep; {
a[2] = Make_Window (0, p->display, p->root);
a[3] = Make_Window (0, p->display, p->subwindow);
a[4] = Get_Time_Arg (p->time);
a[5] = Make_Integer (p->x);
a[6] = Make_Integer (p->y);
a[7] = Make_Integer (p->x_root);
a[8] = Make_Integer (p->y_root);
a[5] = s48_enter_integer (p->x);
a[6] = s48_enter_integer (p->y);
a[7] = s48_enter_integer (p->x_root);
a[8] = s48_enter_integer (p->y_root);
if (e == KeyPress || e == KeyRelease) {
a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms);
a[10] = Make_Integer (p->keycode);
a[11] = p->same_screen ? True : False;
a[10] = s48_enter_integer (p->keycode);
a[11] = p->same_screen ? S48_TRUE : S48_FALSE;
} else if (e == ButtonPress || e == ButtonRelease) {
register XButtonEvent *q = (XButtonEvent *)ep;
a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms);
a[11] = q->same_screen ? True : False;
a[11] = q->same_screen ? S48_TRUE : S48_FALSE;
} else if (e == MotionNotify) {
register XMotionEvent *q = (XMotionEvent *)ep;
a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
a[10] = q->is_hint ? True : False;
a[11] = q->same_screen ? True : False;
a[10] = q->is_hint ? S48_TRUE : S48_FALSE;
a[11] = q->same_screen ? S48_TRUE : S48_FALSE;
} else {
register XCrossingEvent *q = (XCrossingEvent *)ep;
a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms);
a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0,
Cross_Detail_Syms);
a[11] = q->same_screen ? True : False;
a[12] = q->focus ? True : False;
a[11] = q->same_screen ? S48_TRUE : S48_FALSE;
a[12] = q->focus ? S48_TRUE : S48_FALSE;
a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms);
}
} break;
@ -233,28 +233,28 @@ Object Get_Event_Args (ep) XEvent *ep; {
case Expose: {
register XExposeEvent *p = (XExposeEvent *)ep;
a[1] = Make_Window (0, p->display, p->window);
a[2] = Make_Integer (p->x);
a[3] = Make_Integer (p->y);
a[4] = Make_Integer (p->width);
a[5] = Make_Integer (p->height);
a[6] = Make_Integer (p->count);
a[2] = s48_enter_integer (p->x);
a[3] = s48_enter_integer (p->y);
a[4] = s48_enter_integer (p->width);
a[5] = s48_enter_integer (p->height);
a[6] = s48_enter_integer (p->count);
} break;
case GraphicsExpose: {
register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep;
a[1] = Make_Window (0, p->display, p->drawable);
a[2] = Make_Integer (p->x);
a[3] = Make_Integer (p->y);
a[4] = Make_Integer (p->width);
a[5] = Make_Integer (p->height);
a[6] = Make_Integer (p->count);
a[7] = Make_Integer (p->major_code);
a[8] = Make_Integer (p->minor_code);
a[2] = s48_enter_integer (p->x);
a[3] = s48_enter_integer (p->y);
a[4] = s48_enter_integer (p->width);
a[5] = s48_enter_integer (p->height);
a[6] = s48_enter_integer (p->count);
a[7] = s48_enter_integer (p->major_code);
a[8] = s48_enter_integer (p->minor_code);
} break;
case NoExpose: {
register XNoExposeEvent *p = (XNoExposeEvent *)ep;
a[1] = Make_Window (0, p->display, p->drawable);
a[2] = Make_Integer (p->major_code);
a[3] = Make_Integer (p->minor_code);
a[2] = s48_enter_integer (p->major_code);
a[3] = s48_enter_integer (p->minor_code);
} break;
case VisibilityNotify: {
register XVisibilityEvent *p = (XVisibilityEvent *)ep;
@ -265,12 +265,12 @@ Object Get_Event_Args (ep) XEvent *ep; {
register XCreateWindowEvent *p = (XCreateWindowEvent *)ep;
a[1] = Make_Window (0, p->display, p->parent);
a[2] = Make_Window (0, p->display, p->window);
a[3] = Make_Integer (p->x);
a[4] = Make_Integer (p->y);
a[5] = Make_Integer (p->width);
a[6] = Make_Integer (p->height);
a[7] = Make_Integer (p->border_width);
a[8] = p->override_redirect ? True : False;
a[3] = s48_enter_integer (p->x);
a[4] = s48_enter_integer (p->y);
a[5] = s48_enter_integer (p->width);
a[6] = s48_enter_integer (p->height);
a[7] = s48_enter_integer (p->border_width);
a[8] = p->override_redirect ? S48_TRUE : S48_FALSE;
} break;
case DestroyNotify: {
register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep;
@ -281,13 +281,13 @@ Object Get_Event_Args (ep) XEvent *ep; {
register XUnmapEvent *p = (XUnmapEvent *)ep;
a[1] = Make_Window (0, p->display, p->event);
a[2] = Make_Window (0, p->display, p->window);
a[3] = p->from_configure ? True : False;
a[3] = p->from_configure ? S48_TRUE : S48_FALSE;
} break;
case MapNotify: {
register XMapEvent *p = (XMapEvent *)ep;
a[1] = Make_Window (0, p->display, p->event);
a[2] = Make_Window (0, p->display, p->window);
a[3] = p->override_redirect ? True : False;
a[3] = p->override_redirect ? S48_TRUE : S48_FALSE;
} break;
case MapRequest: {
register XMapRequestEvent *p = (XMapRequestEvent *)ep;
@ -299,47 +299,47 @@ Object Get_Event_Args (ep) XEvent *ep; {
a[1] = Make_Window (0, p->display, p->event);
a[2] = Make_Window (0, p->display, p->window);
a[3] = Make_Window (0, p->display, p->parent);
a[4] = Make_Integer (p->x);
a[5] = Make_Integer (p->y);
a[6] = p->override_redirect ? True : False;
a[4] = s48_enter_integer (p->x);
a[5] = s48_enter_integer (p->y);
a[6] = p->override_redirect ? S48_TRUE : S48_FALSE;
} break;
case ConfigureNotify: {
register XConfigureEvent *p = (XConfigureEvent *)ep;
a[1] = Make_Window (0, p->display, p->event);
a[2] = Make_Window (0, p->display, p->window);
a[3] = Make_Integer (p->x);
a[4] = Make_Integer (p->y);
a[5] = Make_Integer (p->width);
a[6] = Make_Integer (p->height);
a[7] = Make_Integer (p->border_width);
a[3] = s48_enter_integer (p->x);
a[4] = s48_enter_integer (p->y);
a[5] = s48_enter_integer (p->width);
a[6] = s48_enter_integer (p->height);
a[7] = s48_enter_integer (p->border_width);
a[8] = Make_Window (0, p->display, p->above);
a[9] = p->override_redirect ? True : False;
a[9] = p->override_redirect ? S48_TRUE : S48_FALSE;
} break;
case ConfigureRequest: {
register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep;
a[1] = Make_Window (0, p->display, p->parent);
a[2] = Make_Window (0, p->display, p->window);
a[3] = Make_Integer (p->x);
a[4] = Make_Integer (p->y);
a[5] = Make_Integer (p->width);
a[6] = Make_Integer (p->height);
a[7] = Make_Integer (p->border_width);
a[3] = s48_enter_integer (p->x);
a[4] = s48_enter_integer (p->y);
a[5] = s48_enter_integer (p->width);
a[6] = s48_enter_integer (p->height);
a[7] = s48_enter_integer (p->border_width);
a[8] = Make_Window (0, p->display, p->above);
a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms);
a[10] = Make_Unsigned_Long (p->value_mask);
a[10] = s48_enter_integer (p->value_mask);
} break;
case GravityNotify: {
register XGravityEvent *p = (XGravityEvent *)ep;
a[1] = Make_Window (0, p->display, p->event);
a[2] = Make_Window (0, p->display, p->window);
a[3] = Make_Integer (p->x);
a[4] = Make_Integer (p->y);
a[3] = s48_enter_integer (p->x);
a[4] = s48_enter_integer (p->y);
} break;
case ResizeRequest: {
register XResizeRequestEvent *p = (XResizeRequestEvent *)ep;
a[1] = Make_Window (0, p->display, p->window);
a[2] = Make_Integer (p->width);
a[3] = Make_Integer (p->height);
a[2] = s48_enter_integer (p->width);
a[3] = s48_enter_integer (p->height);
} break;
case CirculateNotify: {
register XCirculateEvent *p = (XCirculateEvent *)ep;
@ -387,8 +387,8 @@ Object Get_Event_Args (ep) XEvent *ep; {
register XColormapEvent *p = (XColormapEvent *)ep;
a[1] = Make_Window (0, p->display, p->window);
a[2] = Make_Colormap (0, p->display, p->colormap);
a[3] = p->new ? True : False;
a[4] = p->state == ColormapInstalled ? True : False;
a[3] = p->new ? S48_TRUE : S48_FALSE;
a[4] = p->state == ColormapInstalled ? S48_TRUE : S48_FALSE;
} break;
case ClientMessage: {
register XClientMessageEvent *p = (XClientMessageEvent *)ep;
@ -401,53 +401,53 @@ Object Get_Event_Args (ep) XEvent *ep; {
a[3] = Make_String (p->data.b, 20);
break;
case 16:
a[3] = Make_Vector (10, Null);
a[3] = s48_make_vector (10, S48_NULL);
for (i = 0; i < 10; i++)
VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]);
S48_VECTOR_SET(a[3], i, s48_enter_integer (p->data.s[i]);)
break;
case 32:
a[3] = Make_Vector (5, Null);
a[3] = s48_make_vector (5, S48_NULL);
for (i = 0; i < 5; i++)
VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]);
S48_VECTOR_SET(a[3], i, s48_enter_integer (p->data.l[i]);)
break;
default:
a[3] = Make_Integer (p->format); /* ??? */
a[3] = s48_enter_integer (p->format); /* ??? */
}
} break;
case MappingNotify: {
register XMappingEvent *p = (XMappingEvent *)ep;
a[1] = Make_Window (0, p->display, p->window);
a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms);
a[3] = Make_Integer (p->first_keycode);
a[4] = Make_Integer (p->count);
a[3] = s48_enter_integer (p->first_keycode);
a[4] = s48_enter_integer (p->count);
} break;
}
a[0] = Intern (Event_Table[e].name);
for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) {
if (i) vp++;
Car (*vp) = a[i];
Cdr (*vp) = vp[1];
S48_CAR (*vp) = a[i];
S48_CDR (*vp) = vp[1];
}
Cdr (*vp) = Null;
GC_Unlink;
S48_CDR (*vp) = S48_NULL;
S48_GC_UNPROTECT;
return Argl;
}
void Destroy_Event_Args (args) Object args; {
Object t;
void Destroy_Event_Args (args) s48_value args; {
s48_value t;
for (t = args; !Nullp (t); t = Cdr (t))
Car (t) = Null;
for (t = args; !S48_NULL_P (t); t = S48_CDR (t))
S48_CAR (t) = S48_NULL;
}
Encode_Event (e) Object e; {
Object s;
Encode_Event (e) s48_value e; {
s48_value s;
register char *p;
register struct event_desc *ep;
register n;
Check_Type (e, T_Symbol);
s = SYMBOL(e)->name;
s = s48_extract_string(S48_SYMBOL_TO_STRING(e));
p = STRING(s)->data;
n = STRING(s)->size;
for (ep = Event_Table; ep->name; ep++)
@ -457,31 +457,31 @@ Encode_Event (e) Object e; {
return ep-Event_Table;
}
static Object P_Get_Motion_Events (w, from, to) Object w, from, to; {
static s48_value P_Get_Motion_Events (w, from, to) s48_value w, from, to; {
XTimeCoord *p;
int n;
register i;
Object e, ret;
GC_Node2;
s48_value e, ret;
S48_DECLARE_GC_PROTECT(2);
Check_Type (w, T_Window);
p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from),
Get_Time (to), &n);
e = ret = Make_Vector (n, Null);
GC_Link2 (ret, e);
e = ret = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_2 (ret, e);
for (i = 0; i < n; i++) {
e = P_Make_List (Make_Integer (3), Null);
VECTOR(ret)->data[i] = e;
Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e);
Car (e) = Make_Integer (p[i].x); e = Cdr (e);
Car (e) = Make_Integer (p[i].y);
e = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_VECTOR_SET(ret, i, e;)
S48_CAR (e) = Get_Time_Arg (p[i].time); e = S48_CDR (e);
S48_CAR (e) = s48_enter_integer (p[i].x); e = S48_CDR (e);
S48_CAR (e) = s48_enter_integer (p[i].y);
}
GC_Unlink;
S48_GC_UNPROTECT;
XFree ((char *)p);
return ret;
}
static Object P_Event_Listen (d, wait_flag) Object d, wait_flag; {
static s48_value P_Event_Listen (d, wait_flag) s48_value d, wait_flag; {
Display *dpy;
register n;
XEvent e;
@ -490,23 +490,23 @@ static Object P_Event_Listen (d, wait_flag) Object d, wait_flag; {
Check_Type (wait_flag, T_Boolean);
dpy = DISPLAY(d)->dpy;
n = XPending (dpy);
if (n == 0 && EQ(wait_flag, True)) {
if (n == 0 && S48_EQ_P(wait_flag, S48_TRUE)) {
XPeekEvent (dpy, &e);
n = XPending (dpy);
}
return Make_Integer (n);
return s48_enter_integer (n);
}
elk_init_xlib_event () {
Object t;
s48_value t;
register i;
Argl = P_Make_List (Make_Integer (MAX_ARGS), Null);
Global_GC_Link (Argl);
Argv = Make_Vector (MAX_ARGS, Null);
Global_GC_Link (Argv);
for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t))
VECTOR(Argv)->data[i] = t;
Argl = P_Make_List (s48_enter_integer (MAX_ARGS), S48_NULL);
Global_S48_GC_PROTECT_1 (Argl);
Argv = s48_make_vector (MAX_ARGS, S48_NULL);
Global_S48_GC_PROTECT_1 (Argv);
for (i = 0, t = Argl; i < MAX_ARGS; i++, t = S48_CDR (t))
S48_VECTOR_SET(Argv, i, t;)
Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL);
Define_Primitive (P_Get_Motion_Events,
"get-motion-events", 3, 3, EVAL);

36
c/xlib/extension.c
View File

@ -1,44 +1,44 @@
#include "xlib.h"
static Object P_List_Extensions (d) Object d; {
Object ret;
static s48_value P_List_Extensions (d) s48_value d; {
s48_value ret;
int n;
register i;
register char **p;
GC_Node;
S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display);
Disable_Interrupts;
p = XListExtensions (DISPLAY(d)->dpy, &n);
Enable_Interrupts;
ret = Make_Vector (n, Null);
GC_Link (ret);
ret = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (ret);
for (i = 0; i < n; i++) {
Object e;
s48_value e;
e = Make_String (p[i], strlen (p[i]));
VECTOR(ret)->data[i] = e;
S48_VECTOR_SET(ret, i, e;)
}
GC_Unlink;
S48_GC_UNPROTECT;
XFreeExtensionList (p);
return ret;
}
static Object P_Query_Extension (d, name) Object d, name; {
static s48_value P_Query_Extension (d, name) s48_value d, name; {
int opcode, event, error;
Object ret, t;
GC_Node2;
s48_value ret, t;
S48_DECLARE_GC_PROTECT(2);
Check_Type (d, T_Display);
if (!XQueryExtension (DISPLAY(d)->dpy, Get_Strsym (name), &opcode,
&event, &error))
return False;
t = ret = P_Make_List (Make_Integer (3), Null);
GC_Link2 (ret, t);
Car (t) = (opcode ? Make_Integer (opcode) : False); t = Cdr (t);
Car (t) = (event ? Make_Integer (event) : False); t = Cdr (t);
Car (t) = (error ? Make_Integer (error) : False);
GC_Unlink;
return S48_FALSE;
t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_GC_PROTECT_2 (ret, t);
S48_CAR (t) = (opcode ? s48_enter_integer (opcode) : S48_FALSE); t = S48_CDR (t);
S48_CAR (t) = (event ? s48_enter_integer (event) : S48_FALSE); t = S48_CDR (t);
S48_CAR (t) = (error ? s48_enter_integer (error) : S48_FALSE);
S48_GC_UNPROTECT;
return ret;
}

126
c/xlib/font.c
View File

@ -1,11 +1,11 @@
#include "xlib.h"
Object Sym_Char_Info;
static Object Sym_Font_Info, Sym_Min, Sym_Max;
s48_value Sym_Char_Info;
static s48_value Sym_Font_Info, Sym_Min, Sym_Max;
Generic_Predicate (Font)
static Font_Equal (x, y) Object x, y; {
static Font_Equal (x, y) s48_value x, y; {
Font id1 = FONT(x)->id, id2 = FONT(y)->id;
if (id1 && id2)
return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy;
@ -15,49 +15,49 @@ static Font_Equal (x, y) Object x, y; {
Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id : POINTER(x))
static Font_Visit (fp, f) Object *fp; int (*f)(); {
static Font_Visit (fp, f) s48_value *fp; int (*f)(); {
(*f)(&FONT(*fp)->name);
}
Generic_Get_Display (Font, FONT)
static Object Internal_Make_Font (finalize, dpy, name, id, info)
Display *dpy; Object name; Font id; XFontStruct *info; {
Object f;
GC_Node;
static s48_value Internal_Make_Font (finalize, dpy, name, id, info)
Display *dpy; s48_value name; Font id; XFontStruct *info; {
s48_value f;
S48_DECLARE_GC_PROTECT(1);
GC_Link (name);
S48_GC_PROTECT_1 (name);
f = Alloc_Object (sizeof (struct S_Font), T_Font, 0);
FONT(f)->dpy = dpy;
if (TYPE(name) == T_Symbol)
name = SYMBOL(name)->name;
name = s48_extract_string(S48_SYMBOL_TO_STRING(name));
FONT(f)->name = name;
FONT(f)->id = id;
FONT(f)->info = info;
if (id)
Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0);
GC_Unlink;
S48_GC_UNPROTECT;
return f;
}
/* Backwards compatibility: */
Object Make_Font (dpy, name, id, info)
Display *dpy; Object name; Font id; XFontStruct *info; {
s48_value Make_Font (dpy, name, id, info)
Display *dpy; s48_value name; Font id; XFontStruct *info; {
return Internal_Make_Font (1, dpy, name, id, info);
}
Object Make_Font_Foreign (dpy, name, id, info)
Display *dpy; Object name; Font id; XFontStruct *info; {
s48_value Make_Font_Foreign (dpy, name, id, info)
Display *dpy; s48_value name; Font id; XFontStruct *info; {
return Internal_Make_Font (0, dpy, name, id, info);
}
Font Get_Font (f) Object f; {
Font Get_Font (f) s48_value f; {
Check_Type (f, T_Font);
Open_Font_Maybe (f);
return FONT(f)->id;
}
static XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; {
static XFontStruct *Internal_Open_Font (d, name) Display *d; s48_value name; {
register char *s;
XFontStruct *p;
Alloca_Begin;
@ -71,7 +71,7 @@ static XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; {
return p;
}
static Object P_Open_Font (d, name) Object d, name; {
static s48_value P_Open_Font (d, name) s48_value d, name; {
XFontStruct *p;
Check_Type (d, T_Display)
@ -79,12 +79,12 @@ static Object P_Open_Font (d, name) Object d, name; {
return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
}
void Open_Font_Maybe (f) Object f; {
Object name;
void Open_Font_Maybe (f) s48_value f; {
s48_value name;
XFontStruct *p;
name = FONT(f)->name;
if (!Truep (name))
if (!S48_TRUE_P (name))
Primitive_Error ("invalid font");
if (FONT(f)->id == 0) {
p = Internal_Open_Font (FONT(f)->dpy, name);
@ -94,7 +94,7 @@ void Open_Font_Maybe (f) Object f; {
}
}
Object P_Close_Font (f) Object f; {
s48_value P_Close_Font (f) s48_value f; {
Check_Type (f, T_Font);
if (FONT(f)->id)
XUnloadFont (FONT(f)->dpy, FONT(f)->id);
@ -103,12 +103,12 @@ Object P_Close_Font (f) Object f; {
return Void;
}
static Object P_Font_Name (f) Object f; {
static s48_value P_Font_Name (f) s48_value f; {
Check_Type (f, T_Font);
return FONT(f)->name;
}
static Object P_Gcontext_Font (g) Object g; {
static s48_value P_Gcontext_Font (g) s48_value g; {
register struct S_Gc *p;
register XFontStruct *info;
@ -117,17 +117,17 @@ static Object P_Gcontext_Font (g) Object g; {
Disable_Interrupts;
info = XQueryFont (p->dpy, XGContextFromGC (p->gc));
Enable_Interrupts;
return Make_Font_Foreign (p->dpy, False, (Font)0, info);
return Make_Font_Foreign (p->dpy, S48_FALSE, (Font)0, info);
}
static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; {
static s48_value Internal_List_Fonts (d, pat, with_info) s48_value d, pat; {
char **ret;
int n;
XFontStruct *iret;
register i;
Object f, v;
s48_value f, v;
Display *dpy;
GC_Node2;
S48_DECLARE_GC_PROTECT(2);
Check_Type (d, T_Display);
dpy = DISPLAY(d)->dpy;
@ -137,16 +137,16 @@ static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; {
else
ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n);
Enable_Interrupts;
v = Make_Vector (n, Null);
f = Null;
GC_Link2 (f, v);
v = s48_make_vector (n, S48_NULL);
f = S48_NULL;
S48_GC_PROTECT_2 (f, v);
for (i = 0; i < n; i++) {
f = Make_String (ret[i], strlen (ret[i]));
if (with_info)
f = Make_Font (dpy, f, (Font)0, &iret[i]);
VECTOR(v)->data[i] = f;
S48_VECTOR_SET(v, i, f;)
}
GC_Unlink;
S48_GC_UNPROTECT;
if (with_info)
XFreeFontInfo (ret, (XFontStruct *)0, 0);
else
@ -154,22 +154,22 @@ static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; {
return v;
}
static Object P_List_Font_Names (d, pat) Object d, pat; {
static s48_value P_List_Font_Names (d, pat) s48_value d, pat; {
return Internal_List_Fonts (d, pat, 0);
}
static Object P_List_Fonts (d, pat) Object d, pat; {
static s48_value P_List_Fonts (d, pat) s48_value d, pat; {
return Internal_List_Fonts (d, pat, 1);
}
static Object P_Font_Info (f) Object f; {
static s48_value P_Font_Info (f) s48_value f; {
Check_Type (f, T_Font);
FI = *FONT(f)->info;
return Record_To_Vector (Font_Info_Rec, Font_Info_Size,
Sym_Font_Info, FONT(f)->dpy, ~0L);
}
static Object P_Char_Info (f, index) Object f, index; {
static s48_value P_Char_Info (f, index) s48_value f, index; {
register t = TYPE(index);
register unsigned i;
register XCharStruct *cp;
@ -181,15 +181,15 @@ static Object P_Char_Info (f, index) Object f, index; {
p = FONT(f)->info;
cp = &p->max_bounds;
if (t == T_Symbol) {
if (EQ(index, Sym_Min))
if (S48_EQ_P(index, Sym_Min))
cp = &p->min_bounds;
else if (!EQ(index, Sym_Max))
else if (!S48_EQ_P(index, Sym_Max))
Primitive_Error (msg);
} else {
if (t == T_Character)
i = CHAR(index);
i = s48_extract_char(index);
else if (t == T_Fixnum || t == T_Bignum)
i = (unsigned)Get_Integer (index);
i = (unsigned)(int)s48_extract_integer (index);
else
Primitive_Error (msg);
if (!p->min_byte1 && !p->max_byte1) {
@ -213,62 +213,62 @@ static Object P_Char_Info (f, index) Object f, index; {
Sym_Char_Info, FONT(f)->dpy, ~0L);
}
static Object P_Font_Properties (f) Object f; {
static s48_value P_Font_Properties (f) s48_value f; {
register i, n;
Object v, a, val, x;
GC_Node4;
s48_value v, a, val, x;
S48_DECLARE_GC_PROTECT(4);
Check_Type (f, T_Font);
n = FONT(f)->info->n_properties;
v = Make_Vector (n, Null);
a = val = Null;
GC_Link4 (v, a, val, f);
v = s48_make_vector (n, S48_NULL);
a = val = S48_NULL;
S48_GC_PROTECT_4 (v, a, val, f);
for (i = 0; i < n; i++) {
register XFontProp *p = FONT(f)->info->properties+i;
a = Make_Atom (p->name);
val = Make_Unsigned_Long ((unsigned long)p->card32);
x = Cons (a, val);
VECTOR(v)->data[i] = x;
val = s48_enter_integer ((unsigned long)p->card32);
x = s48_cons (a, val);
S48_VECTOR_SET(v, i, x;)
}
GC_Unlink;
S48_GC_UNPROTECT;
return v;
}
static Object P_Font_Path (d) Object d; {
Object v;
static s48_value P_Font_Path (d) s48_value d; {
s48_value v;
int i, n;
char **ret;
GC_Node;
S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display);
Disable_Interrupts;
ret = XGetFontPath (DISPLAY(d)->dpy, &n);
Enable_Interrupts;
v = Make_Vector (n, Null);
GC_Link (v);
v = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (v);
for (i = 0; i < n; i++) {
Object x;
s48_value x;
x = Make_String (ret[i], strlen (ret[i]));
VECTOR(v)->data[i] = x;
S48_VECTOR_SET(v, i, x;)
}
GC_Unlink;
S48_GC_UNPROTECT;
XFreeFontPath (ret);
return P_Vector_To_List (v);
}
static Object P_Set_Font_Path (d, p) Object d, p; {
static s48_value P_Set_Font_Path (d, p) s48_value d, p; {
register char **path;
register i, n;
Object c;
s48_value c;
Alloca_Begin;
Check_Type (d, T_Display);
Check_List (p);
n = Fast_Length (p);
Alloca (path, char**, n * sizeof (char *));
for (i = 0; i < n; i++, p = Cdr (p)) {
c = Car (p);
for (i = 0; i < n; i++, p = S48_CDR (p)) {
c = S48_CAR (p);
Get_Strsym_Stack (c, path[i]);
}
XSetFontPath (DISPLAY(d)->dpy, path, n);

56
c/xlib/gcontext.c
View File

@ -1,6 +1,6 @@
#include "xlib.h"
static Object Sym_Gc;
static s48_value Sym_Gc;
Generic_Predicate (Gc)
@ -10,15 +10,15 @@ Generic_Print (Gc, "#[gcontext %lu]", GCONTEXT(x)->gc)
Generic_Get_Display (Gc, GCONTEXT)
Object Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
Object gc;
s48_value Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
s48_value gc;
if (g == None)
return Sym_None;
gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
if (Nullp (gc)) {
if (S48_NULL_P (gc)) {
gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0);
GCONTEXT(gc)->tag = Null;
GCONTEXT(gc)->tag = S48_NULL;
GCONTEXT(gc)->gc = g;
GCONTEXT(gc)->dpy = dpy;
GCONTEXT(gc)->free = 0;
@ -28,7 +28,7 @@ Object Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
return gc;
}
static Object P_Create_Gc (w, g) Object w, g; {
static s48_value P_Create_Gc (w, g) s48_value w, g; {
unsigned long mask;
Display *dpy;
Drawable dr;
@ -38,7 +38,7 @@ static Object P_Create_Gc (w, g) Object w, g; {
return Make_Gc (1, dpy, XCreateGC (dpy, dr, mask, &GCV));
}
static Object P_Copy_Gc (gc, w) Object gc, w; {
static s48_value P_Copy_Gc (gc, w) s48_value gc, w; {
GC dst;
Display *dpy;
Drawable dr;
@ -50,7 +50,7 @@ static Object P_Copy_Gc (gc, w) Object gc, w; {
return Make_Gc (1, dpy, dst);
}
static Object P_Change_Gc (gc, g) Object gc, g; {
static s48_value P_Change_Gc (gc, g) s48_value gc, g; {
unsigned long mask;
Check_Type (gc, T_Gc);
@ -59,7 +59,7 @@ static Object P_Change_Gc (gc, g) Object gc, g; {
return Void;
}
Object P_Free_Gc (g) Object g; {
s48_value P_Free_Gc (g) s48_value g; {
Check_Type (g, T_Gc);
if (!GCONTEXT(g)->free)
XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc);
@ -68,61 +68,61 @@ Object P_Free_Gc (g) Object g; {
return Void;
}
static Object P_Query_Best_Size (d, w, h, shape) Object d, w, h, shape; {
static s48_value P_Query_Best_Size (d, w, h, shape) s48_value d, w, h, shape; {
unsigned int rw, rh;
Check_Type (d, T_Display);
if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0,
Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy),
Get_Integer (w), Get_Integer (h), &rw, &rh))
(int)s48_extract_integer (w), (int)s48_extract_integer (h), &rw, &rh))
Primitive_Error ("cannot query best shape");
return Cons (Make_Integer (rw), Make_Integer (rh));
return s48_cons (s48_enter_integer (rw), s48_enter_integer (rh));
}
static Object P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord)
Object gc, x, y, v, ord; {
static s48_value P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord)
s48_value gc, x, y, v, ord; {
register XRectangle *p;
register i, n;
Alloca_Begin;
Check_Type (gc, T_Gc);
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XRectangle*, n * sizeof (XRectangle));
for (i = 0; i < n; i++) {
Object rect;
s48_value rect;
rect = VECTOR(v)->data[i];
rect = S48_VECTOR_REF(v, i);
Check_Type (rect, T_Pair);
if (Fast_Length (rect) != 4)
Primitive_Error ("invalid rectangle: ~s", rect);
p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].height = Get_Integer (Car (rect));
p[i].x = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].y = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].width = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].height = (int)s48_extract_integer (S48_CAR (rect));
}
XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (x),
Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms));
XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
(int)s48_extract_integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms));
Alloca_End;
return Void;
}
static Object P_Set_Gcontext_Dashlist (gc, off, v) Object gc, off, v; {
static s48_value P_Set_Gcontext_Dashlist (gc, off, v) s48_value gc, off, v; {
register char *p;
register i, n, d;
Alloca_Begin;
Check_Type (gc, T_Gc);
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, char*, n);
for (i = 0; i < n; i++) {
d = Get_Integer (VECTOR(v)->data[i]);
d = (int)s48_extract_integer (VECTOR(v)->data[i]);
if (d < 0 || d > 255)
Range_Error (VECTOR(v)->data[i]);
p[i] = d;
}
XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (off), p, n);
XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (off), p, n);
Alloca_End;
return Void;
}
@ -134,7 +134,7 @@ static Object P_Set_Gcontext_Dashlist (gc, off, v) Object gc, off, v; {
GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\
GCDashOffset | GCArcMode)
static Object P_Get_Gc_Values (gc) Object gc; {
static s48_value P_Get_Gc_Values (gc) s48_value gc; {
unsigned long mask = ValidGCValuesBits;
Check_Type (gc, T_Gc);

58
c/xlib/grab.c
View File

@ -1,120 +1,120 @@
#include "xlib.h"
static Object Sym_Any;
static s48_value Sym_Any;
Time Get_Time (time) Object time; {
if (EQ(time, Sym_Now))
Time Get_Time (time) s48_value time; {
if (S48_EQ_P(time, Sym_Now))
return CurrentTime;
return (Time)Get_Long (time);
return (Time)s48_extract_integer (time);
}
static Get_Mode (m) Object m; {
static Get_Mode (m) s48_value m; {
Check_Type (m, T_Boolean);
return EQ(m, True) ? GrabModeSync : GrabModeAsync;
return S48_EQ_P(m, S48_TRUE) ? GrabModeSync : GrabModeAsync;
}
static Object P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to,
cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to,
static s48_value P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to,
cursor, time) s48_value win, ownerp, events, psyncp, ksyncp, confine_to,
cursor, time; {
Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean);
return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy,
WINDOW(win)->win,
EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
S48_EQ_P(ownerp, S48_TRUE), Symbols_To_Bits (events, 1, Event_Syms),
Get_Mode (psyncp), Get_Mode (ksyncp),
Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)),
0, Grabstatus_Syms);
}
static Object P_Ungrab_Pointer (d, time) Object d, time; {
static s48_value P_Ungrab_Pointer (d, time) s48_value d, time; {
Check_Type (d, T_Display);
XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time));
return Void;
}
static Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp,
confine_to, cursor) Object win, button, mods, ownerp, events,
static s48_value P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp,
confine_to, cursor) s48_value win, button, mods, ownerp, events,
psyncp, ksyncp, confine_to, cursor; {
Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean);
XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win,
EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
S48_EQ_P(ownerp, S48_TRUE), Symbols_To_Bits (events, 1, Event_Syms),
Get_Mode (psyncp), Get_Mode (ksyncp),
Get_Window (confine_to), Get_Cursor (cursor));
return Void;
}
static Object P_Ungrab_Button (win, button, mods) Object win, button, mods; {
static s48_value P_Ungrab_Button (win, button, mods) s48_value win, button, mods; {
Check_Type (win, T_Window);
XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
return Void;
}
static Object P_Change_Active_Pointer_Grab (d, events, cursor, time)
Object d, events, cursor, time; {
static s48_value P_Change_Active_Pointer_Grab (d, events, cursor, time)
s48_value d, events, cursor, time; {
Check_Type (d, T_Display);
XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1,
Event_Syms), Get_Cursor (cursor), Get_Time (time));
return Void;
}
static Object P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) Object win,
static s48_value P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) s48_value win,
ownerp, psyncp, ksyncp, time; {
Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean);
return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy,
WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
WINDOW(win)->win, S48_EQ_P(ownerp, S48_TRUE), Get_Mode (psyncp),
Get_Mode (ksyncp), Get_Time (time)),
0, Grabstatus_Syms);
}
static Object P_Ungrab_Keyboard (d, time) Object d, time; {
static s48_value P_Ungrab_Keyboard (d, time) s48_value d, time; {
Check_Type (d, T_Display);
XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time));
return Void;
}
static Object P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) Object win,
static s48_value P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) s48_value win,
key, mods, ownerp, psyncp, ksyncp; {
int keycode = AnyKey;
Check_Type (win, T_Window);
if (!EQ(key, Sym_Any))
keycode = Get_Integer (key);
if (!S48_EQ_P(key, Sym_Any))
keycode = (int)s48_extract_integer (key);
Check_Type (ownerp, T_Boolean);
XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms),
WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
WINDOW(win)->win, S48_EQ_P(ownerp, S48_TRUE), Get_Mode (psyncp),
Get_Mode (ksyncp));
return Void;
}
static Object P_Ungrab_Key (win, key, mods) Object win, key, mods; {
static s48_value P_Ungrab_Key (win, key, mods) s48_value win, key, mods; {
int keycode = AnyKey;
Check_Type (win, T_Window);
if (!EQ(key, Sym_Any))
keycode = Get_Integer (key);
if (!S48_EQ_P(key, Sym_Any))
keycode = (int)s48_extract_integer (key);
XUngrabKey (WINDOW(win)->dpy, keycode,
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
return Void;
}
static Object P_Allow_Events (d, mode, time) Object d, mode, time; {
static s48_value P_Allow_Events (d, mode, time) s48_value d, mode, time; {
Check_Type (d, T_Display);
XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0,
Allow_Events_Syms), Get_Time (time));
return Void;
}
static Object P_Grab_Server (d) Object d; {
static s48_value P_Grab_Server (d) s48_value d; {
Check_Type (d, T_Display);
XGrabServer (DISPLAY(d)->dpy);
return Void;
}
static Object P_Ungrab_Server (d) Object d; {
static s48_value P_Ungrab_Server (d) s48_value d; {
Check_Type (d, T_Display);
XUngrabServer (DISPLAY(d)->dpy);
return Void;

156
c/xlib/graphics.c
View File

@ -4,53 +4,53 @@ extern XDrawPoints(), XDrawLines(), XDrawRectangle(), XFillRectangle();
extern XDrawRectangles(), XFillRectangles(), XDrawArc(), XFillArc();
extern XDrawArcs(), XFillArcs(), XFillPolygon();
static Object P_Clear_Area (win, x, y, w, h, e) Object win, x, y, w, h, e; {
static s48_value P_Clear_Area (win, x, y, w, h, e) s48_value win, x, y, w, h, e; {
Check_Type (win, T_Window);
Check_Type (e, T_Boolean);
XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, Get_Integer (x),
Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True));
XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, (int)s48_extract_integer (x),
(int)s48_extract_integer (y), (int)s48_extract_integer (w), (int)s48_extract_integer (h), S48_EQ_P(e, S48_TRUE));
return Void;
}
static Object P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) Object src, gc,
static s48_value P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) s48_value src, gc,
sx, sy, w, h, dst, dx, dy; {
Display *dpy;
Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
Check_Type (gc, T_Gc);
XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
Get_Integer (sy), Get_Integer (w), Get_Integer (h),
Get_Integer (dx), Get_Integer (dy));
XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, (int)s48_extract_integer (sx),
(int)s48_extract_integer (sy), (int)s48_extract_integer (w), (int)s48_extract_integer (h),
(int)s48_extract_integer (dx), (int)s48_extract_integer (dy));
return Void;
}
static Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy)
Object src, gc, plane, sx, sy, w, h, dst, dx, dy; {
static s48_value P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy)
s48_value src, gc, plane, sx, sy, w, h, dst, dx, dy; {
Display *dpy;
Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
register unsigned long p;
Check_Type (gc, T_Gc);
p = (unsigned long)Get_Long (plane);
p = (unsigned long)s48_extract_integer (plane);
if (p & (p-1))
Primitive_Error ("invalid plane: ~s", plane);
XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
Get_Integer (sy), Get_Integer (w), Get_Integer (h),
Get_Integer (dx), Get_Integer (dy), p);
XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, (int)s48_extract_integer (sx),
(int)s48_extract_integer (sy), (int)s48_extract_integer (w), (int)s48_extract_integer (h),
(int)s48_extract_integer (dx), (int)s48_extract_integer (dy), p);
return Void;
}
static Object P_Draw_Point (d, gc, x, y) Object d, gc, x, y; {
static s48_value P_Draw_Point (d, gc, x, y) s48_value d, gc, x, y; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Check_Type (gc, T_Gc);
XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y));
XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), (int)s48_extract_integer (y));
return Void;
}
static Object Internal_Draw_Points (d, gc, v, relative, func, shape)
Object d, gc, v, relative, shape; int (*func)(); {
static s48_value Internal_Draw_Points (d, gc, v, relative, func, shape)
s48_value d, gc, v, relative, shape; int (*func)(); {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
register XPoint *p;
@ -60,18 +60,18 @@ static Object Internal_Draw_Points (d, gc, v, relative, func, shape)
Check_Type (gc, T_Gc);
Check_Type (relative, T_Boolean);
rel = EQ(relative, True) ? CoordModePrevious : CoordModeOrigin;
rel = S48_EQ_P(relative, S48_TRUE) ? CoordModePrevious : CoordModeOrigin;
if (func == XFillPolygon)
sh = Symbols_To_Bits (shape, 0, Polyshape_Syms);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XPoint*, n * sizeof (XPoint));
for (i = 0; i < n; i++) {
Object point;
s48_value point;
point = VECTOR(v)->data[i];
point = S48_VECTOR_REF(v, i);
Check_Type (point, T_Pair);
p[i].x = Get_Integer (Car (point));
p[i].y = Get_Integer (Cdr (point));
p[i].x = (int)s48_extract_integer (S48_CAR (point));
p[i].y = (int)s48_extract_integer (S48_CDR (point));
}
if (func == XFillPolygon)
XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel);
@ -81,26 +81,26 @@ static Object Internal_Draw_Points (d, gc, v, relative, func, shape)
return Void;
}
static Object P_Draw_Points (d, gc, v, relative) Object d, gc, v, relative; {
return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, Null);
static s48_value P_Draw_Points (d, gc, v, relative) s48_value d, gc, v, relative; {
return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, S48_NULL);
}
static Object P_Draw_Line (d, gc, x1, y1, x2, y2)
Object d, gc, x1, y1, x2, y2; {
static s48_value P_Draw_Line (d, gc, x1, y1, x2, y2)
s48_value d, gc, x1, y1, x2, y2; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Check_Type (gc, T_Gc);
XDrawLine (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x1), Get_Integer (y1),
Get_Integer (x2), Get_Integer (y2));
XDrawLine (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x1), (int)s48_extract_integer (y1),
(int)s48_extract_integer (x2), (int)s48_extract_integer (y2));
return Void;
}
static Object P_Draw_Lines (d, gc, v, relative) Object d, gc, v, relative; {
return Internal_Draw_Points (d, gc, v, relative, XDrawLines, Null);
static s48_value P_Draw_Lines (d, gc, v, relative) s48_value d, gc, v, relative; {
return Internal_Draw_Points (d, gc, v, relative, XDrawLines, S48_NULL);
}
static Object P_Draw_Segments (d, gc, v) Object d, gc, v; {
static s48_value P_Draw_Segments (d, gc, v) s48_value d, gc, v; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
register XSegment *p;
@ -108,46 +108,46 @@ static Object P_Draw_Segments (d, gc, v) Object d, gc, v; {
Alloca_Begin;
Check_Type (gc, T_Gc);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XSegment*, n * sizeof (XSegment));
for (i = 0; i < n; i++) {
Object seg;
s48_value seg;
seg = VECTOR(v)->data[i];
seg = S48_VECTOR_REF(v, i);
Check_Type (seg, T_Pair);
if (Fast_Length (seg) != 4)
Primitive_Error ("invalid segment: ~s", seg);
p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg);
p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg);
p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg);
p[i].y2 = Get_Integer (Car (seg));
p[i].x1 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg);
p[i].y1 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg);
p[i].x2 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg);
p[i].y2 = (int)s48_extract_integer (S48_CAR (seg));
}
XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n);
Alloca_End;
return Void;
}
static Object Internal_Draw_Rectangle (d, gc, x, y, w, h, func)
Object d, gc, x, y, w, h; int (*func)(); {
static s48_value Internal_Draw_Rectangle (d, gc, x, y, w, h, func)
s48_value d, gc, x, y, w, h; int (*func)(); {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Check_Type (gc, T_Gc);
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
Get_Integer (y), Get_Integer (w), Get_Integer (h));
(*func)(dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
(int)s48_extract_integer (y), (int)s48_extract_integer (w), (int)s48_extract_integer (h));
return Void;
}
static Object P_Draw_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
static s48_value P_Draw_Rectangle (d, gc, x, y, w, h) s48_value d, gc, x, y, w, h; {
return Internal_Draw_Rectangle (d, gc, x, y, w, h, XDrawRectangle);
}
static Object P_Fill_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
static s48_value P_Fill_Rectangle (d, gc, x, y, w, h) s48_value d, gc, x, y, w, h; {
return Internal_Draw_Rectangle (d, gc, x, y, w, h, XFillRectangle);
}
static Object Internal_Draw_Rectangles (d, gc, v, func)
Object d, gc, v; int (*func)(); {
static s48_value Internal_Draw_Rectangles (d, gc, v, func)
s48_value d, gc, v; int (*func)(); {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
register XRectangle *p;
@ -155,55 +155,55 @@ static Object Internal_Draw_Rectangles (d, gc, v, func)
Alloca_Begin;
Check_Type (gc, T_Gc);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XRectangle*, n * sizeof (XRectangle));
for (i = 0; i < n; i++) {
Object rect;
s48_value rect;
rect = VECTOR(v)->data[i];
rect = S48_VECTOR_REF(v, i);
Check_Type (rect, T_Pair);
if (Fast_Length (rect) != 4)
Primitive_Error ("invalid rectangle: ~s", rect);
p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
p[i].height = Get_Integer (Car (rect));
p[i].x = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].y = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].width = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect);
p[i].height = (int)s48_extract_integer (S48_CAR (rect));
}
(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
Alloca_End;
return Void;
}
static Object P_Draw_Rectangles (d, gc, v) Object d, gc, v; {
static s48_value P_Draw_Rectangles (d, gc, v) s48_value d, gc, v; {
return Internal_Draw_Rectangles (d, gc, v, XDrawRectangles);
}
static Object P_Fill_Rectangles (d, gc, v) Object d, gc, v; {
static s48_value P_Fill_Rectangles (d, gc, v) s48_value d, gc, v; {
return Internal_Draw_Rectangles (d, gc, v, XFillRectangles);
}
static Object Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func)
Object d, gc, x, y, w, h, a1, a2; int (*func)(); {
static s48_value Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func)
s48_value d, gc, x, y, w, h, a1, a2; int (*func)(); {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Check_Type (gc, T_Gc);
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2));
(*func)(dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), (int)s48_extract_integer (y),
(int)s48_extract_integer (w), (int)s48_extract_integer (h), (int)s48_extract_integer (a1), (int)s48_extract_integer (a2));
return Void;
}
static Object P_Draw_Arc (d, gc, x, y, w, h, a1, a2)
Object d, gc, x, y, w, h, a1, a2; {
static s48_value P_Draw_Arc (d, gc, x, y, w, h, a1, a2)
s48_value d, gc, x, y, w, h, a1, a2; {
return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc);
}
static Object P_Fill_Arc (d, gc, x, y, w, h, a1, a2)
Object d, gc, x, y, w, h, a1, a2; {
static s48_value P_Fill_Arc (d, gc, x, y, w, h, a1, a2)
s48_value d, gc, x, y, w, h, a1, a2; {
return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XFillArc);
}
static Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v;
static s48_value Internal_Draw_Arcs (d, gc, v, func) s48_value d, gc, v;
int (*func)(); {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
@ -212,37 +212,37 @@ static Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v;
Alloca_Begin;
Check_Type (gc, T_Gc);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, XArc*, n * sizeof (XArc));
for (i = 0; i < n; i++) {
Object arc;
s48_value arc;
arc = VECTOR(v)->data[i];
arc = S48_VECTOR_REF(v, i);
Check_Type (arc, T_Pair);
if (Fast_Length (arc) != 6)
Primitive_Error ("invalid arc: ~s", arc);
p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc);
p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc);
p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc);
p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc);
p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc);
p[i].angle2 = Get_Integer (Car (arc));
p[i].x = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
p[i].y = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
p[i].width = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
p[i].height = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
p[i].angle1 = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
p[i].angle2 = (int)s48_extract_integer (S48_CAR (arc));
}
(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
Alloca_End;
return Void;
}
static Object P_Draw_Arcs (d, gc, v) Object d, gc, v; {
static s48_value P_Draw_Arcs (d, gc, v) s48_value d, gc, v; {
return Internal_Draw_Arcs (d, gc, v, XDrawArcs);
}
static Object P_Fill_Arcs (d, gc, v) Object d, gc, v; {
static s48_value P_Fill_Arcs (d, gc, v) s48_value d, gc, v; {
return Internal_Draw_Arcs (d, gc, v, XFillArcs);
}
static Object P_Fill_Polygon (d, gc, v, relative, shape)
Object d, gc, v, relative, shape; {
static s48_value P_Fill_Polygon (d, gc, v, relative, shape)
s48_value d, gc, v, relative, shape; {
return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape);
}

16
c/xlib/init.c
View File

@ -1,22 +1,22 @@
#include "xlib.h"
static Object P_Xlib_Release_4_Or_Laterp () {
return True;
static s48_value P_Xlib_Release_4_Or_Laterp () {
return S48_TRUE;
}
static Object P_Xlib_Release_5_Or_Laterp () {
static s48_value P_Xlib_Release_5_Or_Laterp () {
#ifdef XLIB_RELEASE_5_OR_LATER
return True;
return S48_TRUE;
#else
return False;
return S48_FALSE;
#endif
}
static Object P_Xlib_Release_6_Or_Laterp () {
static s48_value P_Xlib_Release_6_Or_Laterp () {
#ifdef XLIB_RELEASE_6_OR_LATER
return True;
return S48_TRUE;
#else
return False;
return S48_FALSE;
#endif
}

64
c/xlib/key.c
View File

@ -4,31 +4,31 @@
/* I don't know if XDisplayKeycodes() was already there in X11R4.
*/
static Object P_Display_Min_Keycode (d) Object d; {
static s48_value P_Display_Min_Keycode (d) s48_value d; {
int mink, maxk;
Check_Type (d, T_Display);
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
return Make_Integer (mink);
return s48_enter_integer (mink);
}
static Object P_Display_Max_Keycode (d) Object d; {
static s48_value P_Display_Max_Keycode (d) s48_value d; {
int mink, maxk;
Check_Type (d, T_Display);
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
return Make_Integer (maxk);
return s48_enter_integer (maxk);
}
#else
static Object P_Display_Min_Keycode (d) Object d; {
static s48_value P_Display_Min_Keycode (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DISPLAY(d)->dpy->min_keycode);
return s48_enter_integer (DISPLAY(d)->dpy->min_keycode);
}
static Object P_Display_Max_Keycode (d) Object d; {
static s48_value P_Display_Max_Keycode (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Integer (DISPLAY(d)->dpy->max_keycode);
return s48_enter_integer (DISPLAY(d)->dpy->max_keycode);
}
#endif
@ -36,7 +36,7 @@ static Object P_Display_Max_Keycode (d) Object d; {
/* I'm not sure if this works correctly in X11R4:
*/
static Object P_Display_Keysyms_Per_Keycode (d) Object d; {
static s48_value P_Display_Keysyms_Per_Keycode (d) s48_value d; {
KeySym *ksyms;
int mink, maxk, ksyms_per_kode;
@ -44,57 +44,57 @@ static Object P_Display_Keysyms_Per_Keycode (d) Object d; {
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
ksyms = XGetKeyboardMapping(DISPLAY(d)->dpy, (KeyCode)mink,
maxk - mink + 1, &ksyms_per_kode);
return Make_Integer (ksyms_per_kode);
return s48_enter_integer (ksyms_per_kode);
}
#else
static Object P_Display_Keysyms_Per_Keycode (d) Object d; {
static s48_value P_Display_Keysyms_Per_Keycode (d) s48_value d; {
Check_Type (d, T_Display);
/* Force initialization: */
Disable_Interrupts;
(void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0);
Enable_Interrupts;
return Make_Integer (DISPLAY(d)->dpy->keysyms_per_keycode);
return s48_enter_integer (DISPLAY(d)->dpy->keysyms_per_keycode);
}
#endif
static Object P_String_To_Keysym (s) Object s; {
static s48_value P_String_To_Keysym (s) s48_value s; {
KeySym k;
k = XStringToKeysym (Get_Strsym (s));
return k == NoSymbol ? False : Make_Unsigned_Long ((unsigned long)k);
return k == NoSymbol ? S48_FALSE : s48_enter_integer ((unsigned long)k);
}
static Object P_Keysym_To_String (k) Object k; {
static s48_value P_Keysym_To_String (k) s48_value k; {
register char *s;
s = XKeysymToString ((KeySym)Get_Long (k));
return s ? Make_String (s, strlen (s)) : False;
s = XKeysymToString ((KeySym)s48_extract_integer (k));
return s ? Make_String (s, strlen (s)) : S48_FALSE;
}
static Object P_Keycode_To_Keysym (d, k, index) Object d, k, index; {
Object ret;
static s48_value P_Keycode_To_Keysym (d, k, index) s48_value d, k, index; {
s48_value ret;
Check_Type (d, T_Display);
Disable_Interrupts;
ret = Make_Unsigned_Long ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy,
Get_Integer (k), Get_Integer (index)));
ret = s48_enter_integer ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy,
(int)s48_extract_integer (k), (int)s48_extract_integer (index)));
Enable_Interrupts;
return ret;
}
static Object P_Keysym_To_Keycode (d, k) Object d, k; {
Object ret;
static s48_value P_Keysym_To_Keycode (d, k) s48_value d, k; {
s48_value ret;
Check_Type (d, T_Display);
Disable_Interrupts;
ret = Make_Unsigned (XKeysymToKeycode (DISPLAY(d)->dpy,
(KeySym)Get_Long (k)));
ret = s48_enter_integer (XKeysymToKeycode (DISPLAY(d)->dpy,
(KeySym)s48_extract_integer (k)));
Enable_Interrupts;
return ret;
}
static Object P_Lookup_String (d, k, mask) Object d, k, mask; {
static s48_value P_Lookup_String (d, k, mask) s48_value d, k, mask; {
XKeyEvent e;
char buf[1024];
register len;
@ -103,7 +103,7 @@ static Object P_Lookup_String (d, k, mask) Object d, k, mask; {
Check_Type (d, T_Display);
e.display = DISPLAY(d)->dpy;
e.keycode = Get_Integer (k);
e.keycode = (int)s48_extract_integer (k);
e.state = Symbols_To_Bits (mask, 1, State_Syms);
Disable_Interrupts;
len = XLookupString (&e, buf, 1024, &keysym_return, &status_return);
@ -111,7 +111,7 @@ static Object P_Lookup_String (d, k, mask) Object d, k, mask; {
return Make_String (buf, len);
}
static Object P_Rebind_Keysym (d, k, mods, str) Object d, k, mods, str; {
static s48_value P_Rebind_Keysym (d, k, mods, str) s48_value d, k, mods, str; {
KeySym *p;
register i, n;
Alloca_Begin;
@ -119,17 +119,17 @@ static Object P_Rebind_Keysym (d, k, mods, str) Object d, k, mods, str; {
Check_Type (d, T_Display);
Check_Type (str, T_String);
Check_Type (mods, T_Vector);
n = VECTOR(mods)->size;
n = S48_VECTOR_LENGTH(mods);
Alloca (p, KeySym*, n * sizeof (KeySym));
for (i = 0; i < n; i++)
p[i] = (KeySym)Get_Long (VECTOR(mods)->data[i]);
XRebindKeysym (DISPLAY(d)->dpy, (KeySym)Get_Long (k), p, n,
p[i] = (KeySym)s48_extract_integer (VECTOR(mods)->data[i]);
XRebindKeysym (DISPLAY(d)->dpy, (KeySym)s48_extract_integer (k), p, n,
(unsigned char *)STRING(str)->data, STRING(str)->size);
Alloca_End;
return Void;
}
static Object P_Refresh_Keyboard_Mapping (w, event) Object w, event; {
static s48_value P_Refresh_Keyboard_Mapping (w, event) s48_value w, event; {
static XMappingEvent fake;
Check_Type (w, T_Window);

4
c/xlib/objects.c
View File

@ -2,9 +2,9 @@
#include "xlib.h"
Object Sym_None;
s48_value Sym_None;
int Match_X_Obj (x, v) Object x; va_list v; {
int Match_X_Obj (x, v) s48_value x; va_list v; {
register type = TYPE(x);
if (type == T_Display) {

18
c/xlib/pixel.c
View File

@ -6,35 +6,35 @@ Generic_Simple_Equal (Pixel, PIXEL, pix)
Generic_Print (Pixel, "#[pixel 0x%lx]", PIXEL(x)->pix)
Object Make_Pixel (val) unsigned long val; {
Object pix;
s48_value Make_Pixel (val) unsigned long val; {
s48_value pix;
pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val);
if (Nullp (pix)) {
if (S48_NULL_P (pix)) {
pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0);
PIXEL(pix)->tag = Null;
PIXEL(pix)->tag = S48_NULL;
PIXEL(pix)->pix = val;
Register_Object (pix, (GENERIC)0, (PFO)0, 0);
}
return pix;
}
unsigned long Get_Pixel (p) Object p; {
unsigned long Get_Pixel (p) s48_value p; {
Check_Type (p, T_Pixel);
return PIXEL(p)->pix;
}
static Object P_Pixel_Value (p) Object p; {
return Make_Unsigned_Long (Get_Pixel (p));
static s48_value P_Pixel_Value (p) s48_value p; {
return s48_enter_integer (Get_Pixel (p));
}
static Object P_Black_Pixel (d) Object d; {
static s48_value P_Black_Pixel (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Pixel (BlackPixel (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));
}
static Object P_White_Pixel (d) Object d; {
static s48_value P_White_Pixel (d) s48_value d; {
Check_Type (d, T_Display);
return Make_Pixel (WhitePixel (DISPLAY(d)->dpy,
DefaultScreen (DISPLAY(d)->dpy)));

70
c/xlib/pixmap.c
View File

@ -8,16 +8,16 @@ Generic_Print (Pixmap, "#[pixmap %lu]", PIXMAP(x)->pm)
Generic_Get_Display (Pixmap, PIXMAP)
static Object Internal_Make_Pixmap (finalize, dpy, pix)
static s48_value Internal_Make_Pixmap (finalize, dpy, pix)
Display *dpy; Pixmap pix; {
Object pm;
s48_value pm;
if (pix == None)
return Sym_None;
pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix);
if (Nullp (pm)) {
if (S48_NULL_P (pm)) {
pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0);
PIXMAP(pm)->tag = Null;
PIXMAP(pm)->tag = S48_NULL;
PIXMAP(pm)->pm = pix;
PIXMAP(pm)->dpy = dpy;
PIXMAP(pm)->free = 0;
@ -28,20 +28,20 @@ static Object Internal_Make_Pixmap (finalize, dpy, pix)
}
/* Backwards compatibility: */
Object Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; {
s48_value Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; {
return Internal_Make_Pixmap (1, dpy, pix);
}
Object Make_Pixmap_Foreign (dpy, pix) Display *dpy; Pixmap pix; {
s48_value Make_Pixmap_Foreign (dpy, pix) Display *dpy; Pixmap pix; {
return Internal_Make_Pixmap (0, dpy, pix);
}
Pixmap Get_Pixmap (p) Object p; {
Pixmap Get_Pixmap (p) s48_value p; {
Check_Type (p, T_Pixmap);
return PIXMAP(p)->pm;
}
Object P_Free_Pixmap (p) Object p; {
s48_value P_Free_Pixmap (p) s48_value p; {
Check_Type (p, T_Pixmap);
if (!PIXMAP(p)->free)
XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm);
@ -50,22 +50,22 @@ Object P_Free_Pixmap (p) Object p; {
return Void;
}
static Object P_Create_Pixmap (d, w, h, depth) Object d, w, h, depth; {
static s48_value P_Create_Pixmap (d, w, h, depth) s48_value d, w, h, depth; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w),
Get_Integer (h), Get_Integer (depth)));
return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, (int)s48_extract_integer (w),
(int)s48_extract_integer (h), (int)s48_extract_integer (depth)));
}
static Object P_Create_Bitmap_From_Data (win, data, pw, ph)
Object win, data, pw, ph; {
static s48_value P_Create_Bitmap_From_Data (win, data, pw, ph)
s48_value win, data, pw, ph; {
register w, h;
Check_Type (win, T_Window);
Check_Type (data, T_String);
w = Get_Integer (pw);
h = Get_Integer (ph);
w = (int)s48_extract_integer (pw);
h = (int)s48_extract_integer (ph);
if (w * h > 8 * STRING(data)->size)
Primitive_Error ("bitmap too small");
return Make_Pixmap (WINDOW(win)->dpy,
@ -73,30 +73,30 @@ static Object P_Create_Bitmap_From_Data (win, data, pw, ph)
STRING(data)->data, w, h));
}
static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg,
depth) Object win, data, pw, ph, fg, bg, depth; {
static s48_value P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg,
depth) s48_value win, data, pw, ph, fg, bg, depth; {
register w, h;
Check_Type (win, T_Window);
Check_Type (data, T_String);
w = Get_Integer (pw);
h = Get_Integer (ph);
w = (int)s48_extract_integer (pw);
h = (int)s48_extract_integer (ph);
if (w * h > 8 * STRING(data)->size)
Primitive_Error ("bitmap too small");
return Make_Pixmap (WINDOW(win)->dpy,
XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win,
STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg),
Get_Integer (depth)));
(int)s48_extract_integer (depth)));
}
static Object P_Read_Bitmap_File (d, fn) Object d, fn; {
static s48_value P_Read_Bitmap_File (d, fn) s48_value d, fn; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
unsigned width, height;
int r, xhot, yhot;
Pixmap bitmap;
Object t, ret, x;
GC_Node2;
s48_value t, ret, x;
S48_DECLARE_GC_PROTECT(2);
Disable_Interrupts;
r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap,
@ -104,19 +104,19 @@ static Object P_Read_Bitmap_File (d, fn) Object d, fn; {
Enable_Interrupts;
if (r != BitmapSuccess)
return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms);
t = ret = P_Make_List (Make_Integer (5), Null);
GC_Link2 (ret, t);
t = ret = P_Make_List (s48_enter_integer (5), S48_NULL);
S48_GC_PROTECT_2 (ret, t);
x = Make_Pixmap (dpy, bitmap);
Car (t) = x; t = Cdr (t);
Car (t) = Make_Integer (width); t = Cdr (t);
Car (t) = Make_Integer (height); t = Cdr (t);
Car (t) = Make_Integer (xhot); t = Cdr (t);
Car (t) = Make_Integer (yhot);
GC_Unlink;
S48_CAR (t) = x; t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (width); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (height); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (xhot); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (yhot);
S48_GC_UNPROTECT;
return ret;
}
static Object P_Write_Bitmap_File (argc, argv) Object *argv; {
static s48_value P_Write_Bitmap_File (argc, argv) s48_value *argv; {
Pixmap pm;
int ret, xhot = -1, yhot = -1;
@ -124,12 +124,12 @@ static Object P_Write_Bitmap_File (argc, argv) Object *argv; {
if (argc == 5)
Primitive_Error ("both x-hot and y-hot must be specified");
if (argc == 6) {
xhot = Get_Integer (argv[4]);
yhot = Get_Integer (argv[5]);
xhot = (int)s48_extract_integer (argv[4]);
yhot = (int)s48_extract_integer (argv[5]);
}
Disable_Interrupts;
ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm,
Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot);
(int)s48_extract_integer (argv[2]), (int)s48_extract_integer (argv[3]), xhot, yhot);
Enable_Interrupts;
return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms);
}

120
c/xlib/property.c
View File

@ -1,6 +1,6 @@
#include "xlib.h"
Object Sym_Now;
s48_value Sym_Now;
Generic_Predicate (Atom)
@ -8,15 +8,15 @@ Generic_Simple_Equal (Atom, ATOM, atom)
Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom)
Object Make_Atom (a) Atom a; {
Object atom;
s48_value Make_Atom (a) Atom a; {
s48_value atom;
if (a == None)
return Sym_None;
atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a);
if (Nullp (atom)) {
if (S48_NULL_P (atom)) {
atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0);
ATOM(atom)->tag = Null;
ATOM(atom)->tag = S48_NULL;
ATOM(atom)->atom = a;
Register_Object (atom, (GENERIC)0, (PFO)0, 0);
}
@ -24,21 +24,21 @@ Object Make_Atom (a) Atom a; {
}
/* Should be used with care */
static Object P_Make_Atom (n) Object n; {
return Make_Atom ((Atom)Get_Long (n));
static s48_value P_Make_Atom (n) s48_value n; {
return Make_Atom ((Atom)s48_extract_integer (n));
}
static Object P_Intern_Atom (d, name) Object d, name; {
static s48_value P_Intern_Atom (d, name) s48_value d, name; {
Check_Type (d, T_Display);
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 0));
}
static Object P_Find_Atom (d, name) Object d, name; {
static s48_value P_Find_Atom (d, name) s48_value d, name; {
Check_Type (d, T_Display);
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 1));
}
static Object P_Atom_Name (d, a) Object d, a; {
static s48_value P_Atom_Name (d, a) s48_value d, a; {
register char *s;
Check_Type (d, T_Display);
@ -49,91 +49,91 @@ static Object P_Atom_Name (d, a) Object d, a; {
return Make_String (s, strlen (s));
}
static Object P_List_Properties (w) Object w; {
static s48_value P_List_Properties (w) s48_value w; {
register i;
int n;
register Atom *ap;
Object v;
GC_Node;
s48_value v;
S48_DECLARE_GC_PROTECT(1);
Check_Type (w, T_Window);
Disable_Interrupts;
ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n);
Enable_Interrupts;
v = Make_Vector (n, Null);
GC_Link (v);
v = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (v);
for (i = 0; i < n; i++) {
Object x;
s48_value x;
x = Make_Atom (ap[i]);
VECTOR(v)->data[i] = x;
S48_VECTOR_SET(v, i, x;)
}
GC_Unlink;
S48_GC_UNPROTECT;
XFree ((char *)ap);
return v;
}
static Object P_Get_Property (w, prop, type, start, len, deletep)
Object w, prop, type, start, len, deletep; {
static s48_value P_Get_Property (w, prop, type, start, len, deletep)
s48_value w, prop, type, start, len, deletep; {
Atom req_type = AnyPropertyType, actual_type;
int format;
unsigned long nitems, bytes_left;
unsigned char *data;
Object ret, t, x;
s48_value ret, t, x;
register i;
GC_Node2;
S48_DECLARE_GC_PROTECT(2);
Check_Type (w, T_Window);
Check_Type (prop, T_Atom);
if (!EQ(type, False)) {
if (!S48_EQ_P(type, S48_FALSE)) {
Check_Type (type, T_Atom);
req_type = ATOM(type)->atom;
}
Check_Type (deletep, T_Boolean);
Disable_Interrupts;
if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
Get_Long (start), Get_Long (len),
EQ(deletep, True), req_type, &actual_type, &format,
s48_extract_integer (start), s48_extract_integer (len),
S48_EQ_P(deletep, S48_TRUE), req_type, &actual_type, &format,
&nitems, &bytes_left, &data) != Success)
Primitive_Error ("cannot get property");
Enable_Interrupts;
ret = t = P_Make_List (Make_Integer (4), Null);
GC_Link2 (ret, t);
ret = t = P_Make_List (s48_enter_integer (4), S48_NULL);
S48_GC_PROTECT_2 (ret, t);
x = Make_Atom (actual_type);
Car (t) = x; t = Cdr (t);
x = Make_Integer (format);
Car (t) = x; t = Cdr (t);
S48_CAR (t) = x; t = S48_CDR (t);
x = s48_enter_integer (format);
S48_CAR (t) = x; t = S48_CDR (t);
if (nitems) {
if (format == 8) {
Object s;
s48_value s;
x = Make_String ((char *)0, (int)nitems);
s = Car (t) = x;
s = S48_CAR (t) = x;
bcopy ((char *)data, STRING(s)->data, (int)nitems);
} else {
Object v;
GC_Node;
s48_value v;
S48_DECLARE_GC_PROTECT(1);
/* Assumes short is 16 bits and int is 32 bits.
*/
v = Make_Vector ((int)nitems, Null);
GC_Link (v);
v = s48_make_vector ((int)nitems, S48_NULL);
S48_GC_PROTECT_1 (v);
for (i = 0; i < nitems; i++) {
x = Make_Unsigned (format == 16 ?
x = s48_enter_integer (format == 16 ?
*((short *)data + i) : *((int *)data + i));
VECTOR(v)->data[i] = x;
S48_VECTOR_SET(v, i, x;)
}
Car (t) = v;
GC_Unlink;
S48_CAR (t) = v;
S48_GC_UNPROTECT;
}
}
t = Cdr (t);
x = Make_Unsigned_Long (bytes_left);
Car (t) = x;
GC_Unlink;
t = S48_CDR (t);
x = s48_enter_integer (bytes_left);
S48_CAR (t) = x;
S48_GC_UNPROTECT;
return ret;
}
static Object P_Change_Property (w, prop, type, format, mode, data)
Object w, prop, type, format, mode, data; {
static s48_value P_Change_Property (w, prop, type, format, mode, data)
s48_value w, prop, type, format, mode, data; {
register i, m, x, nitems, f;
char *buf;
Alloca_Begin;
@ -142,7 +142,7 @@ static Object P_Change_Property (w, prop, type, format, mode, data)
Check_Type (prop, T_Atom);
Check_Type (type, T_Atom);
m = Symbols_To_Bits (mode, 0, Propmode_Syms);
switch (f = Get_Integer (format)) {
switch (f = (int)s48_extract_integer (format)) {
case 8:
Check_Type (data, T_String);
buf = STRING(data)->data;
@ -150,10 +150,10 @@ static Object P_Change_Property (w, prop, type, format, mode, data)
break;
case 16: case 32:
Check_Type (data, T_Vector);
nitems = VECTOR(data)->size;
nitems = S48_VECTOR_LENGTH(data);
Alloca (buf, char*, nitems * (f / sizeof (char)));
for (i = 0; i < nitems; i++) {
x = Get_Integer (VECTOR(data)->data[i]);
x = (int)s48_extract_integer (VECTOR(data)->data[i]);
if (f == 16) {
if (x > 65535)
Primitive_Error ("format mismatch");
@ -170,36 +170,36 @@ static Object P_Change_Property (w, prop, type, format, mode, data)
return Void;
}
static Object P_Delete_Property (w, prop) Object w, prop; {
static s48_value P_Delete_Property (w, prop) s48_value w, prop; {
Check_Type (w, T_Window);
Check_Type (prop, T_Atom);
XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom);
return Void;
}
static Object P_Rotate_Properties (w, v, delta) Object w, v, delta; {
static s48_value P_Rotate_Properties (w, v, delta) s48_value w, v, delta; {
Atom *p;
register i, n;
Alloca_Begin;
Check_Type (w, T_Window);
Check_Type (v, T_Vector);
n = VECTOR(v)->size;
n = S48_VECTOR_LENGTH(v);
Alloca (p, Atom*, n * sizeof (Atom));
for (i = 0; i < n; i++) {
Object a;
s48_value a;
a = VECTOR(v)->data[i];
a = S48_VECTOR_REF(v, i);
Check_Type (a, T_Atom);
p[i] = ATOM(a)->atom;
}
XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n,
Get_Integer (delta));
(int)s48_extract_integer (delta));
Alloca_End;
return Void;
}
static Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner,
static s48_value P_Set_Selection_Owner (d, s, owner, time) s48_value d, s, owner,
time; {
Check_Type (d, T_Display);
Check_Type (s, T_Atom);
@ -208,20 +208,20 @@ static Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner,
return Void;
}
static Object P_Selection_Owner (d, s) Object d, s; {
static s48_value P_Selection_Owner (d, s) s48_value d, s; {
Check_Type (d, T_Display);
Check_Type (s, T_Atom);
return Make_Window (0, DISPLAY(d)->dpy,
XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom));
}
static Object P_Convert_Selection (s, target, prop, w, time)
Object s, target, prop, w, time; {
static s48_value P_Convert_Selection (s, target, prop, w, time)
s48_value s, target, prop, w, time; {
Atom p = None;
Check_Type (s, T_Atom);
Check_Type (target, T_Atom);
if (!EQ(prop, Sym_None)) {
if (!S48_EQ_P(prop, Sym_None)) {
Check_Type (prop, T_Atom);
p = ATOM(prop)->atom;
}

50
c/xlib/text.c
View File

@ -1,27 +1,27 @@
#include "xlib.h"
extern XDrawText(), XDrawText16();
static Object Sym_1byte, Sym_2byte;
static s48_value Sym_1byte, Sym_2byte;
static Two_Byte (format) Object format; {
static Two_Byte (format) s48_value format; {
Check_Type (format, T_Symbol);
if (EQ(format, Sym_1byte))
if (S48_EQ_P(format, Sym_1byte))
return 0;
else if (EQ(format, Sym_2byte))
else if (S48_EQ_P(format, Sym_2byte))
return 1;
Primitive_Error ("index format must be '1-byte or '2-byte");
/*NOTREACHED*/
}
static Get_1_Byte_Char (x) Object x; {
register c = Get_Integer (x);
static Get_1_Byte_Char (x) s48_value x; {
register c = (int)s48_extract_integer (x);
if (c < 0 || c > 255)
Range_Error (x);
return c;
}
static Get_2_Byte_Char (x) Object x; {
register c = Get_Integer (x);
static Get_2_Byte_Char (x) s48_value x; {
register c = (int)s48_extract_integer (x);
if (c < 0 || c > 65535)
Range_Error (x);
return c;
@ -33,11 +33,11 @@ static Get_2_Byte_Char (x) Object x; {
* long strings.
*/
static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; {
static s48_value Internal_Text_Metrics (font, t, f, width) s48_value font, t, f; {
char *s;
XChar2b *s2;
XFontStruct *info;
Object *data;
s48_value *data;
register i, n;
int dir, fasc, fdesc;
Alloca_Begin;
@ -45,7 +45,7 @@ static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; {
Check_Type (font, T_Font);
info = FONT(font)->info;
Check_Type (t, T_Vector);
n = VECTOR(t)->size;
n = S48_VECTOR_LENGTH(t);
data = VECTOR(t)->data;
if (Two_Byte (f)) {
Alloca (s2, XChar2b*, n * sizeof (XChar2b));
@ -68,22 +68,22 @@ static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; {
XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI);
}
Alloca_End;
return width ? Make_Integer (i) : Record_To_Vector (Char_Info_Rec,
return width ? s48_enter_integer (i) : Record_To_Vector (Char_Info_Rec,
Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L);
}
static Object P_Text_Width (font, t, f) Object font, t, f; {
static s48_value P_Text_Width (font, t, f) s48_value font, t, f; {
return Internal_Text_Metrics (font, t, f, 1);
}
static Object P_Text_Extents (font, t, f) Object font, t, f; {
static s48_value P_Text_Extents (font, t, f) s48_value font, t, f; {
return Internal_Text_Metrics (font, t, f, 0);
}
static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
static s48_value P_Draw_Image_Text (d, gc, x, y, t, f) s48_value d, gc, x, y, t, f; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Object *data;
s48_value *data;
register i, n;
char *s;
XChar2b *s2;
@ -91,7 +91,7 @@ static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
Check_Type (gc, T_Gc);
Check_Type (t, T_Vector);
n = VECTOR(t)->size;
n = S48_VECTOR_LENGTH(t);
data = VECTOR(t)->data;
if (Two_Byte (f)) {
Alloca (s2, XChar2b*, n * sizeof (XChar2b));
@ -100,23 +100,23 @@ static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
s2[i].byte1 = (c >> 8) & 0xff;
s2[i].byte2 = c & 0xff;
}
XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
Get_Integer (y), s2, n);
XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
(int)s48_extract_integer (y), s2, n);
} else {
Alloca (s, char*, n);
for (i = 0; i < n; i++)
s[i] = Get_1_Byte_Char (data[i]);
XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
Get_Integer (y), s, n);
XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
(int)s48_extract_integer (y), s, n);
}
Alloca_End;
return Void;
}
static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
static s48_value P_Draw_Poly_Text (d, gc, x, y, t, f) s48_value d, gc, x, y, t, f; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
Object *data;
s48_value *data;
register i, n, j, k;
int twobyte, nitems;
XTextItem *items;
@ -127,7 +127,7 @@ static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
twobyte = Two_Byte (f);
func = twobyte ? (int(*)())XDrawText16 : (int(*)())XDrawText;
Check_Type (t, T_Vector);
if ((n = VECTOR(t)->size) == 0)
if ((n = S48_VECTOR_LENGTH(t)) == 0)
return Void;
for (data = VECTOR(t)->data, i = 0, nitems = 1; i < n; i++)
if (TYPE(data[i]) == T_Font) nitems++;
@ -164,7 +164,7 @@ static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
}
}
}
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
(*func)(dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), (int)s48_extract_integer (y),
items, nitems);
Alloca_End;
return Void;

100
c/xlib/type.c
View File

@ -1,16 +1,16 @@
#include "xlib.h"
static Object Set_Attr_Slots;
static Object Conf_Slots;
static Object GC_Slots;
static Object Geometry_Slots;
static Object Win_Attr_Slots;
static Object Font_Info_Slots;
static Object Char_Info_Slots;
static Object Wm_Hints_Slots;
static Object Size_Hints_Slots;
static s48_value Set_Attr_Slots;
static s48_value Conf_Slots;
static s48_value GC_Slots;
static s48_value Geometry_Slots;
static s48_value Win_Attr_Slots;
static s48_value Font_Info_Slots;
static s48_value Char_Info_Slots;
static s48_value Wm_Hints_Slots;
static s48_value Size_Hints_Slots;
static Object Sym_Parent_Relative, Sym_Copy_From_Parent;
static s48_value Sym_Parent_Relative, Sym_Copy_From_Parent;
XSetWindowAttributes SWA;
RECORD Set_Attr_Rec[] = {
@ -108,7 +108,7 @@ RECORD GC_Rec[] = {
0, GCClipMask },
{ (char *)&GCV.dash_offset, "dash-offset", T_INT,
0, GCDashOffset },
{ (char *)&GCV.dashes, "dashes", T_CHAR,
{ (char *)&GCV.dashes, "dashes", T_s48_extract_char,
0, GCDashList },
{0, 0, T_NONE, 0, 0 }
};
@ -269,38 +269,38 @@ RECORD Size_Hints_Rec[] = {
};
int Size_Hints_Size = sizeof Size_Hints_Rec / sizeof (RECORD);
unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym;
unsigned long Vector_To_Record (v, len, sym, rp) s48_value v, sym;
register RECORD *rp; {
register Object *p;
register s48_value *p;
unsigned long mask = 0;
Check_Type (v, T_Vector);
p = VECTOR(v)->data;
if (VECTOR(v)->size != len && !EQ(p[0], sym))
if (S48_VECTOR_LENGTH(v) != len && !S48_EQ_P(p[0], sym))
Primitive_Error ("invalid argument");
for ( ; rp->slot; rp++) {
++p;
if (rp->type == T_NONE || Nullp (*p))
if (rp->type == T_NONE || S48_NULL_P (*p))
continue;
switch (rp->type) {
case T_INT:
*(int *)rp->slot = Get_Integer (*p); break;
*(int *)rp->slot = (int)s48_extract_integer (*p); break;
case T_SHORT:
*(short *)rp->slot = Get_Integer (*p); break;
case T_CHAR:
*(char *)rp->slot = Get_Integer (*p); break;
*(short *)rp->slot = (int)s48_extract_integer (*p); break;
case T_s48_extract_char:
*(char *)rp->slot = (int)s48_extract_integer (*p); break;
case T_PIXEL:
*(unsigned long *)rp->slot = Get_Pixel (*p); break;
case T_BACKGROUND:
if (EQ(*p, Sym_None))
if (S48_EQ_P(*p, Sym_None))
*(Pixmap *)rp->slot = None;
else if (EQ(*p, Sym_Parent_Relative))
else if (S48_EQ_P(*p, Sym_Parent_Relative))
*(Pixmap *)rp->slot = ParentRelative;
else
*(Pixmap *)rp->slot = Get_Pixmap (*p);
break;
case T_BORDER:
if (EQ(*p, Sym_Copy_From_Parent)) {
if (S48_EQ_P(*p, Sym_Copy_From_Parent)) {
*(Pixmap *)rp->slot = CopyFromParent;
break;
}
@ -309,7 +309,7 @@ unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym;
*(Pixmap *)rp->slot = Get_Pixmap (*p); break;
case T_BOOL:
Check_Type (*p, T_Boolean);
*(Bool *)rp->slot = (Bool)(FIXNUM(*p));
*(Bool *)rp->slot = (Bool)(s48_extract_integer(*p));
break;
case T_FONT:
*(Font *)rp->slot = Get_Font (*p);
@ -335,29 +335,29 @@ unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym;
return mask;
}
Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym;
s48_value Record_To_Vector (rp, len, sym, dpy, flags) s48_value sym;
register RECORD *rp; Display *dpy; unsigned long flags; {
register i;
Object v, x;
GC_Node2;
s48_value v, x;
S48_DECLARE_GC_PROTECT(2);
v = Null;
GC_Link2 (sym, v);
v = Make_Vector (len, Null);
VECTOR(v)->data[0] = sym;
v = S48_NULL;
S48_GC_PROTECT_2 (sym, v);
v = s48_make_vector (len, S48_NULL);
S48_VECTOR_SET(v, 0, sym;)
for (i = 1; rp->slot; i++, rp++) {
if (rp->type == T_NONE)
continue;
if (rp->mask && !(flags & rp->mask))
continue;
x = Null;
x = S48_NULL;
switch (rp->type) {
case T_INT:
x = Make_Integer (*(int *)rp->slot); break;
x = s48_enter_integer (*(int *)rp->slot); break;
case T_SHORT:
x = Make_Integer (*(short *)rp->slot); break;
case T_CHAR:
x = Make_Integer (*(char *)rp->slot); break;
x = s48_enter_integer (*(short *)rp->slot); break;
case T_s48_extract_char:
x = s48_enter_integer (*(char *)rp->slot); break;
case T_PIXEL:
x = Make_Pixel (*(unsigned long *)rp->slot); break;
case T_PIXMAP:
@ -374,11 +374,11 @@ Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym;
Disable_Interrupts;
info = XQueryFont (dpy, *(Font *)rp->slot);
Enable_Interrupts;
x = Make_Font_Foreign (dpy, False, *(Font *)rp->slot, info);
x = Make_Font_Foreign (dpy, S48_FALSE, *(Font *)rp->slot, info);
}
break;
case T_BOOL:
x = *(Bool *)rp->slot ? True : False; break;
x = *(Bool *)rp->slot ? S48_TRUE : S48_FALSE; break;
case T_COLORMAP:
x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break;
case T_WINDOW:
@ -392,9 +392,9 @@ Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym;
default:
Panic ("record->vector");
}
VECTOR(v)->data[i] = x;
S48_VECTOR_SET(v, i, x;)
}
GC_Unlink;
S48_GC_UNPROTECT;
return v;
}
@ -677,7 +677,7 @@ SYMDESCR Shape_Syms[] = {
};
SYMDESCR Initial_State_Syms[] = {
{ "dont-care", DontCareState },
{ "dont-care", DontS48_CAReState },
{ "normal", NormalState },
{ "zoom", ZoomState },
{ "iconic", IconicState },
@ -764,25 +764,25 @@ SYMDESCR Error_Syms[] = {
};
static Init_Record (rec, size, name, var) RECORD *rec; char *name;
Object *var; {
Object list, tail, cell;
s48_value *var; {
s48_value list, tail, cell;
register i;
char buf[128];
GC_Node2;
S48_DECLARE_GC_PROTECT(2);
GC_Link2 (list, tail);
for (list = tail = Null, i = 1; i < size; tail = cell, i++, rec++) {
S48_GC_PROTECT_2 (list, tail);
for (list = tail = S48_NULL, i = 1; i < size; tail = cell, i++, rec++) {
cell = Intern (rec->name);
cell = Cons (cell, Make_Integer (i));
cell = Cons (cell, Null);
if (Nullp (list))
cell = s48_cons (cell, s48_enter_integer (i));
cell = s48_cons (cell, S48_NULL);
if (S48_NULL_P (list))
list = cell;
else
P_Set_Cdr (tail, cell);
P_Set_S48_CDR (tail, cell);
}
sprintf (buf, "%s-slots", name);
Define_Variable (var, buf, list);
GC_Unlink;
S48_GC_UNPROTECT;
}
elk_init_xlib_type () {

30
c/xlib/util.c
View File

@ -1,48 +1,48 @@
#include "xlib.h"
static Object P_Get_Default (d, program, option) Object d, program, option; {
static s48_value P_Get_Default (d, program, option) s48_value d, program, option; {
register char *ret;
Check_Type (d, T_Display);
if (ret = XGetDefault (DISPLAY(d)->dpy, Get_Strsym (program),
Get_Strsym (option)))
return Make_String (ret, strlen (ret));
return False;
return S48_FALSE;
}
static Object P_Resource_Manager_String (d) Object d; {
static s48_value P_Resource_Manager_String (d) s48_value d; {
register char *ret;
Check_Type (d, T_Display);
ret = XResourceManagerString (DISPLAY(d)->dpy);
return ret ? Make_String (ret, strlen (ret)) : False;
return ret ? Make_String (ret, strlen (ret)) : S48_FALSE;
}
static Object P_Parse_Geometry (string) Object string; {
Object ret, t;
static s48_value P_Parse_Geometry (string) s48_value string; {
s48_value ret, t;
register mask;
int x, y;
unsigned w, h;
mask = XParseGeometry (Get_Strsym (string), &x, &y, &w, &h);
t = ret = P_Make_List (Make_Integer (6), False);
if (mask & XNegative) Car (t) = True; t = Cdr (t);
if (mask & YNegative) Car (t) = True; t = Cdr (t);
if (mask & XValue) Car (t) = Make_Integer (x); t = Cdr (t);
if (mask & YValue) Car (t) = Make_Integer (y); t = Cdr (t);
if (mask & WidthValue) Car (t) = Make_Unsigned (w); t = Cdr (t);
if (mask & HeightValue) Car (t) = Make_Unsigned (h);
t = ret = P_Make_List (s48_enter_integer (6), S48_FALSE);
if (mask & XNegative) S48_CAR (t) = S48_TRUE; t = S48_CDR (t);
if (mask & YNegative) S48_CAR (t) = S48_TRUE; t = S48_CDR (t);
if (mask & XValue) S48_CAR (t) = s48_enter_integer (x); t = S48_CDR (t);
if (mask & YValue) S48_CAR (t) = s48_enter_integer (y); t = S48_CDR (t);
if (mask & WidthValue) S48_CAR (t) = s48_enter_integer (w); t = S48_CDR (t);
if (mask & HeightValue) S48_CAR (t) = s48_enter_integer (h);
return ret;
}
static Object P_Parse_Color (d, cmap, spec) Object d, cmap, spec; {
static s48_value P_Parse_Color (d, cmap, spec) s48_value d, cmap, spec; {
XColor ret;
Check_Type (d, T_Display);
if (XParseColor (DISPLAY(d)->dpy, Get_Colormap (cmap), Get_Strsym (spec),
&ret))
return Make_Color (ret.red, ret.green, ret.blue);
return False;
return S48_FALSE;
}
elk_init_xlib_util () {

122
c/xlib/window.c
View File

@ -1,7 +1,7 @@
#include "xlib.h"
static Object Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
Object Sym_Conf;
static s48_value Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
s48_value Sym_Conf;
Generic_Predicate (Window)
@ -11,17 +11,17 @@ Generic_Print (Window, "#[window %lu]", WINDOW(x)->win)
Generic_Get_Display (Window, WINDOW)
Object Make_Window (finalize, dpy, win) Display *dpy; Window win; {
Object w;
s48_value Make_Window (finalize, dpy, win) Display *dpy; Window win; {
s48_value w;
if (win == None)
return Sym_None;
if (win == PointerRoot)
return Intern ("pointer-root");
w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
if (Nullp (w)) {
if (S48_NULL_P (w)) {
w = Alloc_Object (sizeof (struct S_Window), T_Window, 0);
WINDOW(w)->tag = Null;
WINDOW(w)->tag = S48_NULL;
WINDOW(w)->win = win;
WINDOW(w)->dpy = dpy;
WINDOW(w)->free = 0;
@ -32,14 +32,14 @@ Object Make_Window (finalize, dpy, win) Display *dpy; Window win; {
return w;
}
Window Get_Window (w) Object w; {
if (EQ(w, Sym_None))
Window Get_Window (w) s48_value w; {
if (S48_EQ_P(w, Sym_None))
return None;
Check_Type (w, T_Window);
return WINDOW(w)->win;
}
Drawable Get_Drawable (d, dpyp) Object d; Display **dpyp; {
Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
if (TYPE(d) == T_Window) {
*dpyp = WINDOW(d)->dpy;
return (Drawable)WINDOW(d)->win;
@ -51,22 +51,22 @@ Drawable Get_Drawable (d, dpyp) Object d; Display **dpyp; {
/*NOTREACHED*/
}
static Object P_Create_Window (parent, x, y, width, height, border_width, attr)
Object parent, x, y, width, height, border_width, attr; {
static s48_value P_Create_Window (parent, x, y, width, height, border_width, attr)
s48_value parent, x, y, width, height, border_width, attr; {
unsigned long mask;
Window win;
Check_Type (parent, T_Window);
mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
Get_Integer (x), Get_Integer (y), Get_Integer (width),
Get_Integer (height), Get_Integer (border_width),
(int)s48_extract_integer (x), (int)s48_extract_integer (y), (int)s48_extract_integer (width),
(int)s48_extract_integer (height), (int)s48_extract_integer (border_width),
CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
Primitive_Error ("cannot create window");
return Make_Window (1, WINDOW(parent)->dpy, win);
}
static Object P_Configure_Window (w, conf) Object w, conf; {
static s48_value P_Configure_Window (w, conf) s48_value w, conf; {
unsigned long mask;
Check_Type (w, T_Window);
@ -75,7 +75,7 @@ static Object P_Configure_Window (w, conf) Object w, conf; {
return Void;
}
static Object P_Change_Window_Attributes (w, attr) Object w, attr; {
static s48_value P_Change_Window_Attributes (w, attr) s48_value w, attr; {
unsigned long mask;
Check_Type (w, T_Window);
@ -84,14 +84,14 @@ static Object P_Change_Window_Attributes (w, attr) Object w, attr; {
return Void;
}
static Object P_Get_Window_Attributes (w) Object w; {
static s48_value P_Get_Window_Attributes (w) s48_value w; {
Check_Type (w, T_Window);
XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
WINDOW(w)->dpy, ~0L);
}
static Object P_Get_Geometry (d) Object d; {
static s48_value P_Get_Geometry (d) s48_value d; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
@ -103,19 +103,19 @@ static Object P_Get_Geometry (d) Object d; {
return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
}
static Object P_Map_Window (w) Object w; {
static s48_value P_Map_Window (w) s48_value w; {
Check_Type (w, T_Window);
XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
return Void;
}
static Object P_Unmap_Window (w) Object w; {
static s48_value P_Unmap_Window (w) s48_value w; {
Check_Type (w, T_Window);
XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
return Void;
}
Object P_Destroy_Window (w) Object w; {
s48_value P_Destroy_Window (w) s48_value w; {
Check_Type (w, T_Window);
if (!WINDOW(w)->free)
XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
@ -124,109 +124,109 @@ Object P_Destroy_Window (w) Object w; {
return Void;
}
static Object P_Destroy_Subwindows (w) Object w; {
static s48_value P_Destroy_Subwindows (w) s48_value w; {
Check_Type (w, T_Window);
XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
return Void;
}
static Object P_Map_Subwindows (w) Object w; {
static s48_value P_Map_Subwindows (w) s48_value w; {
Check_Type (w, T_Window);
XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
return Void;
}
static Object P_Unmap_Subwindows (w) Object w; {
static s48_value P_Unmap_Subwindows (w) s48_value w; {
Check_Type (w, T_Window);
XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
return Void;
}
static Object P_Circulate_Subwindows (w, dir) Object w, dir; {
static s48_value P_Circulate_Subwindows (w, dir) s48_value w, dir; {
Check_Type (w, T_Window);
XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win,
Symbols_To_Bits (dir, 0, Circulate_Syms));
return Void;
}
static Object P_Query_Tree (w) Object w; {
static s48_value P_Query_Tree (w) s48_value w; {
Window root, parent, *children;
Display *dpy;
int i;
unsigned n;
Object v, ret;
GC_Node2;
s48_value v, ret;
S48_DECLARE_GC_PROTECT(2);
Check_Type (w, T_Window);
dpy = WINDOW(w)->dpy;
Disable_Interrupts;
XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
Enable_Interrupts;
v = ret = Null;
GC_Link2 (v, ret);
v = ret = S48_NULL;
S48_GC_PROTECT_2 (v, ret);
v = Make_Window (0, dpy, root);
ret = Cons (v, Null);
ret = s48_cons (v, S48_NULL);
v = Make_Window (0, dpy, parent);
ret = Cons (v, ret);
v = Make_Vector (n, Null);
ret = s48_cons (v, ret);
v = s48_make_vector (n, S48_NULL);
for (i = 0; i < n; i++) {
Object x;
s48_value x;
x = Make_Window (0, dpy, children[i]);
VECTOR(v)->data[i] = x;
S48_VECTOR_SET(v, i, x;)
}
ret = Cons (v, ret);
GC_Unlink;
ret = s48_cons (v, ret);
S48_GC_UNPROTECT;
return ret;
}
static Object P_Translate_Coordinates (src, x, y, dst) Object src, x, y, dst; {
static s48_value P_Translate_Coordinates (src, x, y, dst) s48_value src, x, y, dst; {
int rx, ry;
Window child;
Object l, t, z;
GC_Node3;
s48_value l, t, z;
S48_DECLARE_GC_PROTECT(3);
Check_Type (src, T_Window);
Check_Type (dst, T_Window);
if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win,
WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry,
WINDOW(dst)->win, (int)s48_extract_integer (x), (int)s48_extract_integer (y), &rx, &ry,
&child))
return False;
l = t = P_Make_List (Make_Integer (3), Null);
GC_Link3 (l, t, dst);
Car (t) = Make_Integer (rx); t = Cdr (t);
Car (t) = Make_Integer (ry), t = Cdr (t);
return S48_FALSE;
l = t = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_GC_PROTECT_3 (l, t, dst);
S48_CAR (t) = s48_enter_integer (rx); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (ry), t = S48_CDR (t);
z = Make_Window (0, WINDOW(dst)->dpy, child);
Car (t) = z;
GC_Unlink;
S48_CAR (t) = z;
S48_GC_UNPROTECT;
return l;
}
static Object P_Query_Pointer (win) Object win; {
Object l, t, z;
static s48_value P_Query_Pointer (win) s48_value win; {
s48_value l, t, z;
Bool ret;
Window root, child;
int r_x, r_y, x, y;
unsigned int mask;
GC_Node3;
S48_DECLARE_GC_PROTECT(3);
Check_Type (win, T_Window);
ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child,
&r_x, &r_y, &x, &y, &mask);
t = l = P_Make_List (Make_Integer (8), Null);
GC_Link3 (l, t, win);
Car (t) = Make_Integer (x); t = Cdr (t);
Car (t) = Make_Integer (y); t = Cdr (t);
Car (t) = ret ? True : False; t = Cdr (t);
t = l = P_Make_List (s48_enter_integer (8), S48_NULL);
S48_GC_PROTECT_3 (l, t, win);
S48_CAR (t) = s48_enter_integer (x); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (y); t = S48_CDR (t);
S48_CAR (t) = ret ? S48_TRUE : S48_FALSE; t = S48_CDR (t);
z = Make_Window (0, WINDOW(win)->dpy, root);
Car (t) = z; t = Cdr (t);
Car (t) = Make_Integer (r_x); t = Cdr (t);
Car (t) = Make_Integer (r_y); t = Cdr (t);
S48_CAR (t) = z; t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (r_x); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (r_y); t = S48_CDR (t);
z = Make_Window (0, WINDOW(win)->dpy, child);
Car (t) = z; t = Cdr (t);
S48_CAR (t) = z; t = S48_CDR (t);
z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
Car (t) = z;
GC_Unlink;
S48_CAR (t) = z;
S48_GC_UNPROTECT;
return l;
}

84
c/xlib/wm.c
View File

@ -1,93 +1,93 @@
#include "xlib.h"
static Object Sym_Pointer_Root;
static s48_value Sym_Pointer_Root;
static Object P_Reparent_Window (w, parent, x, y) Object w, parent, x, y; {
static s48_value P_Reparent_Window (w, parent, x, y) s48_value w, parent, x, y; {
Check_Type (w, T_Window);
Check_Type (parent, T_Window);
XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
Get_Integer (x), Get_Integer (y));
(int)s48_extract_integer (x), (int)s48_extract_integer (y));
return Void;
}
static Object P_Install_Colormap (c) Object c; {
static s48_value P_Install_Colormap (c) s48_value c; {
Check_Type (c, T_Colormap);
XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
return Void;
}
static Object P_Uninstall_Colormap (c) Object c; {
static s48_value P_Uninstall_Colormap (c) s48_value c; {
Check_Type (c, T_Colormap);
XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
return Void;
}
static Object P_List_Installed_Colormaps (w) Object w; {
static s48_value P_List_Installed_Colormaps (w) s48_value w; {
int i, n;
Colormap *ret;
Object v;
GC_Node;
s48_value v;
S48_DECLARE_GC_PROTECT(1);
Check_Type (w, T_Window);
ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n);
v = Make_Vector (n, Null);
GC_Link (v);
v = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (v);
for (i = 0; i < n; i++) {
Object c;
s48_value c;
c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]);
VECTOR(v)->data[i] = c;
S48_VECTOR_SET(v, i, c;)
}
XFree ((char *)ret);
GC_Unlink;
S48_GC_UNPROTECT;
return v;
}
static Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win,
static s48_value P_Set_Input_Focus (d, win, revert_to, time) s48_value d, win,
revert_to, time; {
Window focus = PointerRoot;
Check_Type (d, T_Display);
if (!EQ(win, Sym_Pointer_Root))
if (!S48_EQ_P(win, Sym_Pointer_Root))
focus = Get_Window (win);
XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
Revert_Syms), Get_Time (time));
return Void;
}
static Object P_Input_Focus (d) Object d; {
static s48_value P_Input_Focus (d) s48_value d; {
Window win;
int revert_to;
Object ret, x;
GC_Node;
s48_value ret, x;
S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display);
XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
ret = Cons (Null, Null);
GC_Link (ret);
ret = s48_cons (S48_NULL, S48_NULL);
S48_GC_PROTECT_1 (ret);
x = Make_Window (0, DISPLAY(d)->dpy, win);
Car (ret) = x;
S48_CAR (ret) = x;
x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
Cdr (ret) = x;
GC_Unlink;
S48_CDR (ret) = x;
S48_GC_UNPROTECT;
return ret;
}
static Object P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
static s48_value P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
srcw, srch) s48_value dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
Check_Type (dpy, T_Display);
XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw),
Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty));
(int)s48_extract_integer (srcx), (int)s48_extract_integer (srcy), (int)s48_extract_integer (srcw),
(int)s48_extract_integer (srch), (int)s48_extract_integer (dstx), (int)s48_extract_integer (dsty));
return Void;
}
static Object P_Bell (argc, argv) Object *argv; {
static s48_value P_Bell (argc, argv) s48_value *argv; {
register percent = 0;
Check_Type (argv[0], T_Display);
if (argc == 2) {
percent = Get_Integer (argv[1]);
percent = (int)s48_extract_integer (argv[1]);
if (percent < -100 || percent > 100)
Range_Error (argv[1]);
}
@ -95,54 +95,54 @@ static Object P_Bell (argc, argv) Object *argv; {
return Void;
}
static Object P_Set_Access_Control (dpy, on) Object dpy, on; {
static s48_value P_Set_Access_Control (dpy, on) s48_value dpy, on; {
Check_Type (dpy, T_Display);
Check_Type (on, T_Boolean);
XSetAccessControl (DISPLAY(dpy)->dpy, EQ(on, True));
XSetAccessControl (DISPLAY(dpy)->dpy, S48_EQ_P(on, S48_TRUE));
return Void;
}
static Object P_Change_Save_Set (win, mode) Object win, mode; {
static s48_value P_Change_Save_Set (win, mode) s48_value win, mode; {
Check_Type (win, T_Window);
XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win,
Symbols_To_Bits (mode, 0, Saveset_Syms));
return Void;
}
static Object P_Set_Close_Down_Mode (dpy, mode) Object dpy, mode; {
static s48_value P_Set_Close_Down_Mode (dpy, mode) s48_value dpy, mode; {
Check_Type (dpy, T_Display);
XSetCloseDownMode (DISPLAY(dpy)->dpy,
Symbols_To_Bits (mode, 0, Closemode_Syms));
return Void;
}
static Object P_Get_Pointer_Mapping (dpy) Object dpy; {
static s48_value P_Get_Pointer_Mapping (dpy) s48_value dpy; {
unsigned char map[256];
register i, n;
Object ret;
s48_value ret;
Check_Type (dpy, T_Display);
n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256);
ret = Make_Vector (n, Null);
ret = s48_make_vector (n, S48_NULL);
for (i = 0; i < n; i++)
VECTOR(ret)->data[i] = Make_Integer (map[i]);
S48_VECTOR_SET(ret, i, s48_enter_integer (map[i]);)
return ret;
}
static Object P_Set_Pointer_Mapping (dpy, map) Object dpy, map; {
static s48_value P_Set_Pointer_Mapping (dpy, map) s48_value dpy, map; {
register i, n;
register unsigned char *p;
Object ret;
s48_value ret;
Alloca_Begin;
Check_Type (dpy, T_Display);
Check_Type (map, T_Vector);
n = VECTOR(map)->size;
n = S48_VECTOR_LENGTH(map);
Alloca (p, unsigned char*, n);
for (i = 0; i < n; i++)
p[i] = Get_Integer (VECTOR(map)->data[i]);
p[i] = (int)s48_extract_integer (VECTOR(map)->data[i]);
ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ?
True : False;
S48_TRUE : S48_FALSE;
Alloca_End;
return ret;
}

100
c/xlib/xlib.h
View File

@ -2,8 +2,8 @@
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#undef True
#undef False
#undef S48_TRUE
#undef S48_FALSE
#ifndef NeedFunctionPrototypes /* Kludge */
#error "X11 Release 3 (or earlier) no longer supported"
@ -42,32 +42,32 @@ extern int T_Atom;
#define ATOM(x) ((struct S_Atom *)POINTER(x))
struct S_Display {
Object after;
s48_value after;
Display *dpy;
char free;
};
struct S_Gc {
Object tag;
s48_value tag;
GC gc;
Display *dpy;
char free;
};
struct S_Pixel {
Object tag;
s48_value tag;
unsigned long pix;
};
struct S_Pixmap {
Object tag;
s48_value tag;
Pixmap pm;
Display *dpy;
char free;
};
struct S_Window {
Object tag;
s48_value tag;
Window win;
Display *dpy;
char free;
@ -75,39 +75,39 @@ struct S_Window {
};
struct S_Font {
Object name;
s48_value name;
Font id;
XFontStruct *info;
Display *dpy;
};
struct S_Colormap {
Object tag;
s48_value tag;
Colormap cm;
Display *dpy;
char free;
};
struct S_Color {
Object tag;
s48_value tag;
XColor c;
};
struct S_Cursor {
Object tag;
s48_value tag;
Cursor cursor;
Display *dpy;
char free;
};
struct S_Atom {
Object tag;
s48_value tag;
Atom atom;
};
enum Type {
T_NONE,
T_INT, T_CHAR, T_PIXEL, T_PIXMAP, T_BOOL, T_FONT, T_COLORMAP, T_CURSOR,
T_INT, T_s48_extract_char, T_PIXEL, T_PIXMAP, T_BOOL, T_FONT, T_COLORMAP, T_CURSOR,
T_WINDOW, T_MASK, T_SYM, T_SHORT, T_BACKGROUND, T_BORDER
};
@ -131,7 +131,7 @@ extern Cursor Get_Cursor P_((Object));
extern Drawable Get_Drawable P_((Object, Display**));
extern Font Get_Font P_((Object));
extern int Get_Screen_Number P_((Display*, Object));
extern Object Get_Event_Args P_((XEvent*));
extern s48_value Get_Event_Args P_((XEvent*));
extern Pixmap Get_Pixmap P_((Object));
extern Time Get_Time P_((Object));
extern Window Get_Window P_((Object));
@ -141,28 +141,28 @@ extern void Destroy_Event_Args P_((Object));
extern int Encode_Event P_((Object));
extern int Match_X_Obj P_((ELLIPSIS));
extern void Open_Font_Maybe P_((Object));
extern Object Make_Atom P_((Atom));
extern Object Make_Color P_((unsigned int, unsigned int, unsigned int));
extern Object Make_Colormap P_((int, Display*, Colormap));
extern Object Make_Cursor P_((Display*, Cursor));
extern Object Make_Cursor_Foreign P_((Display*, Cursor));
extern Object Make_Display P_((int, Display*));
extern Object Make_Font P_((Display*, Object, Font, XFontStruct*));
extern Object Make_Font_Foreign P_((Display*, Object, Font, XFontStruct*));
extern Object Make_Gc P_((int, Display*, GC));
extern Object Make_Pixel P_((unsigned long));
extern Object Make_Pixmap P_((Display*, Pixmap));
extern Object Make_Pixmap_Foreign P_((Display*, Pixmap));
extern Object Make_Window P_((int, Display*, Window));
extern Object P_Close_Display P_((Object));
extern Object P_Close_Font P_((Object));
extern Object P_Destroy_Window P_((Object));
extern Object P_Free_Colormap P_((Object));
extern Object P_Free_Cursor P_((Object));
extern Object P_Free_Gc P_((Object));
extern Object P_Free_Pixmap P_((Object));
extern Object P_Window_Unique_Id P_((Object));
extern Object Record_To_Vector
extern s48_value Make_Atom P_((Atom));
extern s48_value Make_Color P_((unsigned int, unsigned int, unsigned int));
extern s48_value Make_Colormap P_((int, Display*, Colormap));
extern s48_value Make_Cursor P_((Display*, Cursor));
extern s48_value Make_Cursor_Foreign P_((Display*, Cursor));
extern s48_value Make_Display P_((int, Display*));
extern s48_value Make_Font P_((Display*, Object, Font, XFontStruct*));
extern s48_value Make_Font_Foreign P_((Display*, Object, Font, XFontStruct*));
extern s48_value Make_Gc P_((int, Display*, GC));
extern s48_value Make_Pixel P_((unsigned long));
extern s48_value Make_Pixmap P_((Display*, Pixmap));
extern s48_value Make_Pixmap_Foreign P_((Display*, Pixmap));
extern s48_value Make_Window P_((int, Display*, Window));
extern s48_value P_Close_Display P_((Object));
extern s48_value P_Close_Font P_((Object));
extern s48_value P_Destroy_Window P_((Object));
extern s48_value P_Free_Colormap P_((Object));
extern s48_value P_Free_Cursor P_((Object));
extern s48_value P_Free_Gc P_((Object));
extern s48_value P_Free_Pixmap P_((Object));
extern s48_value P_Window_Unique_Id P_((Object));
extern s48_value Record_To_Vector
P_((RECORD*, int, Object, Display*, unsigned long));
extern unsigned long Vector_To_Record P_((Object, int, Object, RECORD*));
@ -195,7 +195,7 @@ extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
Initial_State_Syms[], Bitmapstatus_Syms[], Circulate_Syms[],
Ordering_Syms[], Byte_Order_Syms[], Saveset_Syms[], Closemode_Syms[];
extern Object Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf;
extern s48_value Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf;
#if __STDC__ || defined(ANSI_CPP)
@ -212,25 +212,25 @@ extern Object Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf;
*
* int T_Pixmap;
*
* static Object P_Pixmapp (x) Object x; {
* return TYPE(x) == T_Pixmap ? True : False;
* static s48_value P_Pixmapp (x) s48_value x; {
* return TYPE(x) == T_Pixmap ? S48_TRUE : S48_FALSE;
* }
*/
#define Generic_Predicate(type) int conc(T_,type);\
\
static Object conc3(P_,type,p) (x) Object x; {\
return TYPE(x) == conc(T_,type) ? True : False;\
static s48_value conc3(P_,type,p) (x) s48_value x; {\
return TYPE(x) == conc(T_,type) ? S48_TRUE : S48_FALSE;\
}
/* Generic_Equal (Pixmap, PIXMAP, pm) generates:
*
* static Pixmap_Equal (x, y) Object x, y; {
* static Pixmap_Equal (x, y) s48_value x, y; {
* return PIXMAP(x)->pm == PIXMAP(y)->field
* && !PIXMAP(x)->free && !PIXMAP(y)->free;
* }
*/
#define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
Object x, y; {\
s48_value x, y; {\
return cast(x)->field == cast(y)->field\
&& !cast(x)->free && !cast(y)->free;\
}
@ -238,7 +238,7 @@ static Object conc3(P_,type,p) (x) Object x; {\
/* Same as above, but doesn't check for ->free:
*/
#define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
Object x, y; {\
s48_value x, y; {\
return cast(x)->field == cast(y)->field;\
}
@ -246,19 +246,19 @@ static Object conc3(P_,type,p) (x) Object x; {\
*/
#define Generic_Equal_Dpy(type,cast,field) static conc(type,_Equal)\
(x, y)\
Object x, y; {\
s48_value x, y; {\
return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\
&& !cast(x)->free && !cast(y)->free;\
}
/* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates:
*
* static Pixmap_Print (x, port, raw, depth, len) Object x, port; {
* static Pixmap_Print (x, port, raw, depth, len) s48_value x, port; {
* Printf (port, "#[pixmap %u]", PIXMAP(x)->pm);
* }
*/
#define Generic_Print(type,fmt,how) static conc(type,_Print)\
(x, port, raw, depth, len) Object x, port; {\
(x, port, raw, depth, len) s48_value x, port; {\
Printf (port, fmt, (unsigned)how);\
}
@ -275,13 +275,13 @@ static Object conc3(P_,type,p) (x) Object x; {\
/* Generic_Get_Display (Pixmap, PIXMAP) generates:
*
* static Object P_Pixmap_Display (x) Object x; {
* static s48_value P_Pixmap_Display (x) s48_value x; {
* Check_Type (x, T_Pixmap);
* return Make_Display (PIXMAP(x)->dpy);
* }
*/
#define Generic_Get_Display(type,cast) static Object conc3(P_,type,_Display)\
(x) Object x; {\
#define Generic_Get_Display(type,cast) static s48_value conc3(P_,type,_Display)\
(x) s48_value x; {\
Check_Type (x, conc(T_,type));\
return Make_Display (0, cast(x)->dpy);\
}