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

74
c/xlib/color.c
View File

@ -2,20 +2,20 @@
Generic_Predicate (Color) 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; register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c;
return p->red == q->red && p->green == q->green && p->blue == q->blue; return p->red == q->red && p->green == q->green && p->blue == q->blue;
} }
Generic_Print (Color, "#[color %lu]", POINTER(x)) Generic_Print (Color, "#[color %lu]", POINTER(x))
Object Make_Color (r, g, b) unsigned int r, g, b; { s48_value Make_Color (r, g, b) unsigned int r, g, b; {
Object c; s48_value c;
c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b); 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); 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.red = r;
COLOR(c)->c.green = g; COLOR(c)->c.green = g;
COLOR(c)->c.blue = b; COLOR(c)->c.blue = b;
@ -24,43 +24,43 @@ Object Make_Color (r, g, b) unsigned int r, g, b; {
return c; return c;
} }
XColor *Get_Color (c) Object c; { XColor *Get_Color (c) s48_value c; {
Check_Type (c, T_Color); Check_Type (c, T_Color);
return &COLOR(c)->c; 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; double d;
d = Get_Double (x); d = s48_extract_double (x);
if (d < 0.0 || d > 1.0) if (d < 0.0 || d > 1.0)
Primitive_Error ("bad RGB value: ~s", x); Primitive_Error ("bad RGB value: ~s", x);
return (unsigned short)(d * 65535); 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)); return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value (b));
} }
static Object P_Color_Rgb_Values (c) Object c; { static s48_value P_Color_Rgb_Values (c) s48_value c; {
Object ret, t, x; s48_value ret, t, x;
GC_Node3; S48_DECLARE_GC_PROTECT(3);
Check_Type (c, T_Color); Check_Type (c, T_Color);
ret = t = Null; ret = t = S48_NULL;
GC_Link3 (c, ret, t); S48_GC_PROTECT_3 (c, ret, t);
t = ret = P_Make_List (Make_Integer (3), Null); t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
GC_Unlink; S48_GC_UNPROTECT;
x = Make_Reduced_Flonum ((double)COLOR(c)->c.red / 65535.0); 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); 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); x = Make_Reduced_Flonum ((double)COLOR(c)->c.blue / 65535.0);
Car (t) = x; S48_CAR (t) = x;
return ret; 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; XColor c;
Colormap cm = Get_Colormap (cmap); 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); 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); Colormap cm = Get_Colormap (cmap);
register i, n; register i, n;
Object ret; s48_value ret;
register XColor *p; register XColor *p;
GC_Node; S48_DECLARE_GC_PROTECT(1);
Alloca_Begin; Alloca_Begin;
Check_Type (v, T_Vector); Check_Type (v, T_Vector);
n = VECTOR(v)->size; n = S48_VECTOR_LENGTH(v);
Alloca (p, XColor*, n * sizeof (XColor)); Alloca (p, XColor*, n * sizeof (XColor));
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
p[i].pixel = Get_Pixel (VECTOR(v)->data[i]); p[i].pixel = Get_Pixel (VECTOR(v)->data[i]);
Disable_Interrupts; Disable_Interrupts;
XQueryColors (COLORMAP(cmap)->dpy, cm, p, n); XQueryColors (COLORMAP(cmap)->dpy, cm, p, n);
Enable_Interrupts; Enable_Interrupts;
ret = Make_Vector (n, Null); ret = s48_make_vector (n, S48_NULL);
GC_Link (ret); S48_GC_PROTECT_1 (ret);
for (i = 0; i < n; i++, p++) { for (i = 0; i < n; i++, p++) {
Object x; s48_value x;
x = Make_Color (p->red, p->green, p->blue); 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; Alloca_End;
return ret; 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; XColor visual, exact;
Colormap cm = Get_Colormap (cmap); Colormap cm = Get_Colormap (cmap);
Object ret, x; s48_value ret, x;
GC_Node; S48_DECLARE_GC_PROTECT(1);
if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
&visual, &exact)) &visual, &exact))
Primitive_Error ("no such color: ~s", name); Primitive_Error ("no such color: ~s", name);
ret = Cons (Null, Null); ret = s48_cons (S48_NULL, S48_NULL);
GC_Link (ret); S48_GC_PROTECT_1 (ret);
x = Make_Color (visual.red, visual.green, visual.blue); 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); x = Make_Color (exact.red, exact.green, exact.blue);
Cdr (ret) = x; S48_CDR (ret) = x;
GC_Unlink; S48_GC_UNPROTECT;
return ret; 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) Generic_Get_Display (Colormap, COLORMAP)
Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; { s48_value Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
Object cm; s48_value cm;
if (cmap == None) if (cmap == None)
return Sym_None; return Sym_None;
cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap); 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); 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)->cm = cmap;
COLORMAP(cm)->dpy = dpy; COLORMAP(cm)->dpy = dpy;
COLORMAP(cm)->free = 0; COLORMAP(cm)->free = 0;
@ -26,12 +26,12 @@ Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
return cm; return cm;
} }
Colormap Get_Colormap (c) Object c; { Colormap Get_Colormap (c) s48_value c; {
Check_Type (c, T_Colormap); Check_Type (c, T_Colormap);
return COLORMAP(c)->cm; 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); Check_Type (c, T_Colormap);
if (!COLORMAP(c)->free) if (!COLORMAP(c)->free)
XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
@ -40,7 +40,7 @@ Object P_Free_Colormap (c) Object c; {
return Void; 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; XColor c;
Colormap cm = Get_Colormap (cmap); Colormap cm = Get_Colormap (cmap);
int r; int r;
@ -50,32 +50,32 @@ static Object P_Alloc_Color (cmap, color) Object cmap, color; {
r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c); r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c);
Enable_Interrupts; Enable_Interrupts;
if (!r) if (!r)
return False; return S48_FALSE;
return Make_Pixel (c.pixel); 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); Colormap cm = Get_Colormap (cmap);
XColor screen, exact; XColor screen, exact;
int r; int r;
Object ret, t, x; s48_value ret, t, x;
GC_Node2; S48_DECLARE_GC_PROTECT(2);
Disable_Interrupts; Disable_Interrupts;
r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
&screen, &exact); &screen, &exact);
Enable_Interrupts; Enable_Interrupts;
if (!r) if (!r)
return False; return S48_FALSE;
t = ret = P_Make_List (Make_Integer (3), Null); t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
GC_Link2 (t, ret); S48_GC_PROTECT_2 (t, ret);
x = Make_Pixel (screen.pixel); 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); 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); x = Make_Color (exact.red, exact.green, exact.blue);
Car (t) = x; S48_CAR (t) = x;
GC_Unlink; S48_GC_UNPROTECT;
return ret; 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) 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; { Display *dpy; Cursor cursor; {
Object c; s48_value c;
if (cursor == None) if (cursor == None)
return Sym_None; return Sym_None;
c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor); 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); 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)->cursor = cursor;
CURSOR(c)->dpy = dpy; CURSOR(c)->dpy = dpy;
CURSOR(c)->free = 0; CURSOR(c)->free = 0;
@ -28,22 +28,22 @@ static Object Internal_Make_Cursor (finalize, dpy, cursor)
} }
/* Backwards compatibility: */ /* 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); 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); return Internal_Make_Cursor (0, dpy, cursor);
} }
Cursor Get_Cursor (c) Object c; { Cursor Get_Cursor (c) s48_value c; {
if (EQ(c, Sym_None)) if (S48_EQ_P(c, Sym_None))
return None; return None;
Check_Type (c, T_Cursor); Check_Type (c, T_Cursor);
return CURSOR(c)->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); Check_Type (c, T_Cursor);
if (!CURSOR(c)->free) if (!CURSOR(c)->free)
XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor); XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
@ -52,28 +52,28 @@ Object P_Free_Cursor (c) Object c; {
return Void; return Void;
} }
static Object P_Create_Cursor (srcp, maskp, x, y, f, b) static s48_value P_Create_Cursor (srcp, maskp, x, y, f, b)
Object srcp, maskp, x, y, f, b; { s48_value srcp, maskp, x, y, f, b; {
Pixmap sp = Get_Pixmap (srcp), mp; Pixmap sp = Get_Pixmap (srcp), mp;
Display *d = PIXMAP(srcp)->dpy; 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, 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) static s48_value P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
Object srcf, srcc, maskf, maskc, f, b; { s48_value srcf, srcc, maskf, maskc, f, b; {
Font sf = Get_Font (srcf), mf; Font sf = Get_Font (srcf), mf;
Display *d = FONT(srcf)->dpy; 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, 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))); 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); Check_Type (c, T_Cursor);
XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f), XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f),
Get_Color (b)); Get_Color (b));

144
c/xlib/display.c
View File

@ -1,6 +1,6 @@
#include "xlib.h" #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); (*f)(&DISPLAY(*dp)->after);
} }
@ -8,27 +8,27 @@ Generic_Predicate (Display)
Generic_Equal (Display, DISPLAY, dpy) 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, Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy,
DisplayString (DISPLAY(d)->dpy)); DisplayString (DISPLAY(d)->dpy));
} }
Object Make_Display (finalize, dpy) Display *dpy; { s48_value Make_Display (finalize, dpy) Display *dpy; {
Object d; s48_value d;
d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj); 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); d = Alloc_Object (sizeof (struct S_Display), T_Display, 0);
DISPLAY(d)->dpy = dpy; DISPLAY(d)->dpy = dpy;
DISPLAY(d)->free = 0; DISPLAY(d)->free = 0;
DISPLAY(d)->after = False; DISPLAY(d)->after = S48_FALSE;
Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display : Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
(PFO)0, 1); (PFO)0, 1);
} }
return d; 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; register char *s;
Display *dpy; Display *dpy;
@ -43,7 +43,7 @@ static Object P_Open_Display (argc, argv) Object *argv; {
return Make_Display (1, dpy); 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; register struct S_Display *p;
Check_Type (d, T_Display); Check_Type (d, T_Display);
@ -57,13 +57,13 @@ Object P_Close_Display (d) Object d; {
return Void; 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); Check_Type (d, T_Display);
return Make_Window (0, DISPLAY(d)->dpy, return Make_Window (0, DISPLAY(d)->dpy,
DefaultRootWindow (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; register Display *dpy;
Check_Type (d, T_Display); 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))); 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; register Display *dpy;
Check_Type (d, T_Display); 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))); 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; register Display *dpy;
Check_Type (d, T_Display); Check_Type (d, T_Display);
dpy = DISPLAY(d)->dpy; 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); 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; 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"); Primitive_Error ("invalid screen number");
return s; 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); 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))); 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); 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))); 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; register char *s;
Check_Type (d, T_Display); Check_Type (d, T_Display);
@ -120,140 +120,140 @@ static Object P_Display_String (d) Object d; {
return Make_String (s, strlen (s)); 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; register char *s;
Object ret, name; s48_value ret, name;
GC_Node; S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display); Check_Type (d, T_Display);
s = ServerVendor (DISPLAY(d)->dpy); s = ServerVendor (DISPLAY(d)->dpy);
name = Make_String (s, strlen (s)); name = Make_String (s, strlen (s));
GC_Link (name); S48_GC_PROTECT_1 (name);
ret = Cons (Null, Make_Integer (VendorRelease (DISPLAY(d)->dpy))); ret = s48_cons (S48_NULL, s48_enter_integer (VendorRelease (DISPLAY(d)->dpy)));
Car (ret) = name; S48_CAR (ret) = name;
GC_Unlink; S48_GC_UNPROTECT;
return ret; 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); Check_Type (d, T_Display);
return Cons (Make_Integer (ProtocolVersion (DISPLAY(d)->dpy)), return s48_cons (s48_enter_integer (ProtocolVersion (DISPLAY(d)->dpy)),
Make_Integer (ProtocolRevision (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); 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); Check_Type (d, T_Display);
return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy), return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy),
0, Byte_Order_Syms); 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); 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); Check_Type (d, T_Display);
return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy), return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy),
0, Byte_Order_Syms); 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); 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); Check_Type (d, T_Display);
return Make_Integer (DisplayWidth (DISPLAY(d)->dpy, return s48_enter_integer (DisplayWidth (DISPLAY(d)->dpy,
DefaultScreen (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); Check_Type (d, T_Display);
return Make_Integer (DisplayHeight (DISPLAY(d)->dpy, return s48_enter_integer (DisplayHeight (DISPLAY(d)->dpy,
DefaultScreen (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); Check_Type (d, T_Display);
return Make_Integer (DisplayWidthMM (DISPLAY(d)->dpy, return s48_enter_integer (DisplayWidthMM (DISPLAY(d)->dpy,
DefaultScreen (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); Check_Type (d, T_Display);
return Make_Integer (DisplayHeightMM (DISPLAY(d)->dpy, return s48_enter_integer (DisplayHeightMM (DISPLAY(d)->dpy,
DefaultScreen (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); 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); Check_Type (d, T_Display);
XFlush (DISPLAY(d)->dpy); XFlush (DISPLAY(d)->dpy);
return Void; 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 (d, T_Display);
Check_Type (discard, T_Boolean); Check_Type (discard, T_Boolean);
XSync (DISPLAY(d)->dpy, EQ(discard, True)); XSync (DISPLAY(d)->dpy, S48_EQ_P(discard, S48_TRUE));
return Void; 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); Check_Type (d, T_Display);
XNoOp (DISPLAY(d)->dpy); XNoOp (DISPLAY(d)->dpy);
return Void; 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; int num;
register *p, i; register *p, i;
Object ret; s48_value ret;
Check_Type (d, T_Display); Check_Type (d, T_Display);
if (!(p = XListDepths (DISPLAY(d)->dpy, if (!(p = XListDepths (DISPLAY(d)->dpy,
Get_Screen_Number (DISPLAY(d)->dpy, scr), &num))) Get_Screen_Number (DISPLAY(d)->dpy, scr), &num)))
return False; return S48_FALSE;
ret = Make_Vector (num, Null); ret = s48_make_vector (num, S48_NULL);
for (i = 0; i < num; i++) 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); XFree ((char *)p);
return ret; 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; register XPixmapFormatValues *p;
int num; int num;
register i; register i;
Object ret; s48_value ret;
GC_Node; S48_DECLARE_GC_PROTECT(1);
Check_Type (d, T_Display); Check_Type (d, T_Display);
if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num))) if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num)))
return False; return S48_FALSE;
ret = Make_Vector (num, Null); ret = s48_make_vector (num, S48_NULL);
GC_Link (ret); S48_GC_PROTECT_1 (ret);
for (i = 0; i < num; i++) { for (i = 0; i < num; i++) {
Object t; s48_value t;
t = P_Make_List (Make_Integer (3), Null); t = P_Make_List (s48_enter_integer (3), S48_NULL);
VECTOR(ret)->data[i] = t; S48_VECTOR_SET(ret, i, t;)
Car (t) = Make_Integer (p[i].depth); t = Cdr (t); S48_CAR (t) = s48_enter_integer (p[i].depth); t = S48_CDR (t);
Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t); S48_CAR (t) = s48_enter_integer (p[i].bits_per_pixel); t = S48_CDR (t);
Car (t) = Make_Integer (p[i].scanline_pad); S48_CAR (t) = s48_enter_integer (p[i].scanline_pad);
} }
GC_Unlink; S48_GC_UNPROTECT;
XFree ((char *)p); XFree ((char *)p);
return ret; return ret;
} }

68
c/xlib/error.c
View File

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

36
c/xlib/extension.c
View File

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

126
c/xlib/font.c
View File

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

56
c/xlib/gcontext.c
View File

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

58
c/xlib/grab.c
View File

@ -1,120 +1,120 @@
#include "xlib.h" #include "xlib.h"
static Object Sym_Any; static s48_value Sym_Any;
Time Get_Time (time) Object time; { Time Get_Time (time) s48_value time; {
if (EQ(time, Sym_Now)) if (S48_EQ_P(time, Sym_Now))
return CurrentTime; 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); 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, static s48_value P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to,
cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to, cursor, time) s48_value win, ownerp, events, psyncp, ksyncp, confine_to,
cursor, time; { cursor, time; {
Check_Type (win, T_Window); Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean); Check_Type (ownerp, T_Boolean);
return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy, return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy,
WINDOW(win)->win, 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_Mode (psyncp), Get_Mode (ksyncp),
Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)), Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)),
0, Grabstatus_Syms); 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); Check_Type (d, T_Display);
XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time)); XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time));
return Void; return Void;
} }
static Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp, static s48_value P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp,
confine_to, cursor) Object win, button, mods, ownerp, events, confine_to, cursor) s48_value win, button, mods, ownerp, events,
psyncp, ksyncp, confine_to, cursor; { psyncp, ksyncp, confine_to, cursor; {
Check_Type (win, T_Window); Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean); Check_Type (ownerp, T_Boolean);
XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win, 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_Mode (psyncp), Get_Mode (ksyncp),
Get_Window (confine_to), Get_Cursor (cursor)); Get_Window (confine_to), Get_Cursor (cursor));
return Void; 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); Check_Type (win, T_Window);
XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
return Void; return Void;
} }
static Object P_Change_Active_Pointer_Grab (d, events, cursor, time) static s48_value P_Change_Active_Pointer_Grab (d, events, cursor, time)
Object d, events, cursor, time; { s48_value d, events, cursor, time; {
Check_Type (d, T_Display); Check_Type (d, T_Display);
XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1, XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1,
Event_Syms), Get_Cursor (cursor), Get_Time (time)); Event_Syms), Get_Cursor (cursor), Get_Time (time));
return Void; 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; { ownerp, psyncp, ksyncp, time; {
Check_Type (win, T_Window); Check_Type (win, T_Window);
Check_Type (ownerp, T_Boolean); Check_Type (ownerp, T_Boolean);
return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy, 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)), Get_Mode (ksyncp), Get_Time (time)),
0, Grabstatus_Syms); 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); Check_Type (d, T_Display);
XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time)); XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time));
return Void; 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; { key, mods, ownerp, psyncp, ksyncp; {
int keycode = AnyKey; int keycode = AnyKey;
Check_Type (win, T_Window); Check_Type (win, T_Window);
if (!EQ(key, Sym_Any)) if (!S48_EQ_P(key, Sym_Any))
keycode = Get_Integer (key); keycode = (int)s48_extract_integer (key);
Check_Type (ownerp, T_Boolean); Check_Type (ownerp, T_Boolean);
XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms), 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)); Get_Mode (ksyncp));
return Void; 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; int keycode = AnyKey;
Check_Type (win, T_Window); Check_Type (win, T_Window);
if (!EQ(key, Sym_Any)) if (!S48_EQ_P(key, Sym_Any))
keycode = Get_Integer (key); keycode = (int)s48_extract_integer (key);
XUngrabKey (WINDOW(win)->dpy, keycode, XUngrabKey (WINDOW(win)->dpy, keycode,
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
return Void; 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); Check_Type (d, T_Display);
XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0, XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0,
Allow_Events_Syms), Get_Time (time)); Allow_Events_Syms), Get_Time (time));
return Void; 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); Check_Type (d, T_Display);
XGrabServer (DISPLAY(d)->dpy); XGrabServer (DISPLAY(d)->dpy);
return Void; 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); Check_Type (d, T_Display);
XUngrabServer (DISPLAY(d)->dpy); XUngrabServer (DISPLAY(d)->dpy);
return Void; return Void;

156
c/xlib/graphics.c
View File

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

64
c/xlib/key.c
View File

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

4
c/xlib/objects.c
View File

@ -2,9 +2,9 @@
#include "xlib.h" #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); register type = TYPE(x);
if (type == T_Display) { 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) Generic_Print (Pixel, "#[pixel 0x%lx]", PIXEL(x)->pix)
Object Make_Pixel (val) unsigned long val; { s48_value Make_Pixel (val) unsigned long val; {
Object pix; s48_value pix;
pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val); 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); pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0);
PIXEL(pix)->tag = Null; PIXEL(pix)->tag = S48_NULL;
PIXEL(pix)->pix = val; PIXEL(pix)->pix = val;
Register_Object (pix, (GENERIC)0, (PFO)0, 0); Register_Object (pix, (GENERIC)0, (PFO)0, 0);
} }
return pix; return pix;
} }
unsigned long Get_Pixel (p) Object p; { unsigned long Get_Pixel (p) s48_value p; {
Check_Type (p, T_Pixel); Check_Type (p, T_Pixel);
return PIXEL(p)->pix; return PIXEL(p)->pix;
} }
static Object P_Pixel_Value (p) Object p; { static s48_value P_Pixel_Value (p) s48_value p; {
return Make_Unsigned_Long (Get_Pixel (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); Check_Type (d, T_Display);
return Make_Pixel (BlackPixel (DISPLAY(d)->dpy, return Make_Pixel (BlackPixel (DISPLAY(d)->dpy,
DefaultScreen (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); Check_Type (d, T_Display);
return Make_Pixel (WhitePixel (DISPLAY(d)->dpy, return Make_Pixel (WhitePixel (DISPLAY(d)->dpy,
DefaultScreen (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) 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; { Display *dpy; Pixmap pix; {
Object pm; s48_value pm;
if (pix == None) if (pix == None)
return Sym_None; return Sym_None;
pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix); 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); 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)->pm = pix;
PIXMAP(pm)->dpy = dpy; PIXMAP(pm)->dpy = dpy;
PIXMAP(pm)->free = 0; PIXMAP(pm)->free = 0;
@ -28,20 +28,20 @@ static Object Internal_Make_Pixmap (finalize, dpy, pix)
} }
/* Backwards compatibility: */ /* 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); 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); 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); Check_Type (p, T_Pixmap);
return PIXMAP(p)->pm; 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); Check_Type (p, T_Pixmap);
if (!PIXMAP(p)->free) if (!PIXMAP(p)->free)
XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm); XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm);
@ -50,22 +50,22 @@ Object P_Free_Pixmap (p) Object p; {
return Void; 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; Display *dpy;
Drawable dr = Get_Drawable (d, &dpy); Drawable dr = Get_Drawable (d, &dpy);
return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w), return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, (int)s48_extract_integer (w),
Get_Integer (h), Get_Integer (depth))); (int)s48_extract_integer (h), (int)s48_extract_integer (depth)));
} }
static Object P_Create_Bitmap_From_Data (win, data, pw, ph) static s48_value P_Create_Bitmap_From_Data (win, data, pw, ph)
Object win, data, pw, ph; { s48_value win, data, pw, ph; {
register w, h; register w, h;
Check_Type (win, T_Window); Check_Type (win, T_Window);
Check_Type (data, T_String); Check_Type (data, T_String);
w = Get_Integer (pw); w = (int)s48_extract_integer (pw);
h = Get_Integer (ph); h = (int)s48_extract_integer (ph);
if (w * h > 8 * STRING(data)->size) if (w * h > 8 * STRING(data)->size)
Primitive_Error ("bitmap too small"); Primitive_Error ("bitmap too small");
return Make_Pixmap (WINDOW(win)->dpy, 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)); STRING(data)->data, w, h));
} }
static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg, static s48_value P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg,
depth) Object win, data, pw, ph, fg, bg, depth; { depth) s48_value win, data, pw, ph, fg, bg, depth; {
register w, h; register w, h;
Check_Type (win, T_Window); Check_Type (win, T_Window);
Check_Type (data, T_String); Check_Type (data, T_String);
w = Get_Integer (pw); w = (int)s48_extract_integer (pw);
h = Get_Integer (ph); h = (int)s48_extract_integer (ph);
if (w * h > 8 * STRING(data)->size) if (w * h > 8 * STRING(data)->size)
Primitive_Error ("bitmap too small"); Primitive_Error ("bitmap too small");
return Make_Pixmap (WINDOW(win)->dpy, return Make_Pixmap (WINDOW(win)->dpy,
XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win, XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win,
STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg), 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; Display *dpy;
Drawable dr = Get_Drawable (d, &dpy); Drawable dr = Get_Drawable (d, &dpy);
unsigned width, height; unsigned width, height;
int r, xhot, yhot; int r, xhot, yhot;
Pixmap bitmap; Pixmap bitmap;
Object t, ret, x; s48_value t, ret, x;
GC_Node2; S48_DECLARE_GC_PROTECT(2);
Disable_Interrupts; Disable_Interrupts;
r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap, 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; Enable_Interrupts;
if (r != BitmapSuccess) if (r != BitmapSuccess)
return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms); return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms);
t = ret = P_Make_List (Make_Integer (5), Null); t = ret = P_Make_List (s48_enter_integer (5), S48_NULL);
GC_Link2 (ret, t); S48_GC_PROTECT_2 (ret, t);
x = Make_Pixmap (dpy, bitmap); x = Make_Pixmap (dpy, bitmap);
Car (t) = x; t = Cdr (t); S48_CAR (t) = x; t = S48_CDR (t);
Car (t) = Make_Integer (width); t = Cdr (t); S48_CAR (t) = s48_enter_integer (width); t = S48_CDR (t);
Car (t) = Make_Integer (height); t = Cdr (t); S48_CAR (t) = s48_enter_integer (height); t = S48_CDR (t);
Car (t) = Make_Integer (xhot); t = Cdr (t); S48_CAR (t) = s48_enter_integer (xhot); t = S48_CDR (t);
Car (t) = Make_Integer (yhot); S48_CAR (t) = s48_enter_integer (yhot);
GC_Unlink; S48_GC_UNPROTECT;
return ret; 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; Pixmap pm;
int ret, xhot = -1, yhot = -1; int ret, xhot = -1, yhot = -1;
@ -124,12 +124,12 @@ static Object P_Write_Bitmap_File (argc, argv) Object *argv; {
if (argc == 5) if (argc == 5)
Primitive_Error ("both x-hot and y-hot must be specified"); Primitive_Error ("both x-hot and y-hot must be specified");
if (argc == 6) { if (argc == 6) {
xhot = Get_Integer (argv[4]); xhot = (int)s48_extract_integer (argv[4]);
yhot = Get_Integer (argv[5]); yhot = (int)s48_extract_integer (argv[5]);
} }
Disable_Interrupts; Disable_Interrupts;
ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm, 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; Enable_Interrupts;
return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms); return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms);
} }

120
c/xlib/property.c
View File

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

50
c/xlib/text.c
View File

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

100
c/xlib/type.c
View File

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

30
c/xlib/util.c
View File

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

122
c/xlib/window.c
View File

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

84
c/xlib/wm.c
View File

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

100
c/xlib/xlib.h
View File

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