Unmodified C files from elk.
This commit is contained in:
frese
commit
f4b9866a6b
|
|
@ -0,0 +1,28 @@
|
|||
# CVS default ignores begin
|
||||
tags
|
||||
TAGS
|
||||
.make.state
|
||||
.nse_depinfo
|
||||
*~
|
||||
\#*
|
||||
.#*
|
||||
,*
|
||||
_$*
|
||||
*$
|
||||
*.old
|
||||
*.bak
|
||||
*.BAK
|
||||
*.orig
|
||||
*.rej
|
||||
.del-*
|
||||
*.a
|
||||
*.olb
|
||||
*.o
|
||||
*.obj
|
||||
*.so
|
||||
*.exe
|
||||
*.Z
|
||||
*.elc
|
||||
*.ln
|
||||
core
|
||||
# CVS default ignores end
|
||||
|
|
@ -0,0 +1,390 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Sym_Wm_Hints, Sym_Size_Hints;
|
||||
|
||||
static Object P_Iconify_Window (w, scr) Object w, scr; {
|
||||
Check_Type (w, T_Window);
|
||||
if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win,
|
||||
Get_Screen_Number (WINDOW(w)->dpy, scr)))
|
||||
Primitive_Error ("cannot iconify window");
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Withdraw_Window (w, scr) Object w, scr; {
|
||||
Check_Type (w, T_Window);
|
||||
if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win,
|
||||
Get_Screen_Number (WINDOW(w)->dpy, scr)))
|
||||
Primitive_Error ("cannot withdraw window");
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
|
||||
if (!XReconfigureWMWindow (WINDOW(w)->dpy, WINDOW(w)->win,
|
||||
Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC))
|
||||
Primitive_Error ("cannot reconfigure window");
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Wm_Command (w) Object w; {
|
||||
int i, ac;
|
||||
char **av;
|
||||
Object s, ret, t;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Disable_Interrupts;
|
||||
if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac))
|
||||
ac = 0;
|
||||
Enable_Interrupts;
|
||||
ret = t = P_Make_List (Make_Integer (ac), Null);
|
||||
GC_Link2 (ret, t);
|
||||
for (i = 0; i < ac; i++, t = Cdr (t)) {
|
||||
s = Make_String (av[i], strlen (av[i]));
|
||||
Car (t) = s;
|
||||
}
|
||||
GC_Unlink;
|
||||
if (ac) XFreeStringList (av);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; {
|
||||
register i, n;
|
||||
register char **s;
|
||||
Object t;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_List (x);
|
||||
n = Fast_Length (x);
|
||||
Alloca (s, char**, n * sizeof (char *));
|
||||
for (i = 0; i < n; i++, x = Cdr (x)) {
|
||||
t = Car (x);
|
||||
Get_Strsym_Stack (t, s[i]);
|
||||
}
|
||||
if (!XStringListToTextProperty (s, n, ret))
|
||||
Primitive_Error ("cannot create text property");
|
||||
Alloca_End;
|
||||
}
|
||||
|
||||
static Object Text_Property_To_String_List (p) XTextProperty *p; {
|
||||
int n;
|
||||
register i;
|
||||
char **s;
|
||||
Object x, ret, t;
|
||||
GC_Node2;
|
||||
|
||||
if (!XTextPropertyToStringList (p, &s, &n))
|
||||
Primitive_Error ("cannot convert from text property");
|
||||
ret = t = P_Make_List (Make_Integer (n), Null);
|
||||
GC_Link2 (ret, t);
|
||||
for (i = 0; i < n; i++, t = Cdr (t)) {
|
||||
x = Make_String (s[i], strlen (s[i]));
|
||||
Car (t) = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
XFreeStringList (s);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Get_Text_Property (w, a) Object w, a; {
|
||||
XTextProperty ret;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (a, T_Atom);
|
||||
Disable_Interrupts;
|
||||
if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret,
|
||||
ATOM(a)->atom)) {
|
||||
Enable_Interrupts;
|
||||
return False;
|
||||
}
|
||||
Enable_Interrupts;
|
||||
return Text_Property_To_String_List (&ret);
|
||||
}
|
||||
|
||||
static Object P_Set_Text_Property (w, prop, a) Object w, prop, a; {
|
||||
XTextProperty p;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (a, T_Atom);
|
||||
String_List_To_Text_Property (prop, &p);
|
||||
XSetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &p, ATOM(a)->atom);
|
||||
XFree ((char *)p.value);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Wm_Protocols (w) Object w; {
|
||||
Atom *p;
|
||||
int i, n;
|
||||
Object ret;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Disable_Interrupts;
|
||||
if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
|
||||
Primitive_Error ("cannot get WM protocols");
|
||||
Enable_Interrupts;
|
||||
ret = Make_Vector (n, Null);
|
||||
GC_Link (ret);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object a;
|
||||
|
||||
a = Make_Atom (p[i]);
|
||||
VECTOR(ret)->data[i] = a;
|
||||
}
|
||||
XFree ((char *)p);
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Set_Wm_Protocols (w, v) Object w, v; {
|
||||
Atom *p;
|
||||
int i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, Atom*, n * sizeof (Atom));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object a;
|
||||
a = VECTOR(v)->data[i];
|
||||
Check_Type (a, T_Atom);
|
||||
p[i] = ATOM(a)->atom;
|
||||
}
|
||||
if (!XSetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, p, n))
|
||||
Primitive_Error ("cannot set WM protocols");
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Wm_Class (w) Object w; {
|
||||
Object ret, x;
|
||||
XClassHint c;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
/*
|
||||
* In X11.2 XGetClassHint() returns either 0 or Success, which happens
|
||||
* to be defined as 0. So until this bug is fixed, we must
|
||||
* explicitly check whether the XClassHint structure has been filled.
|
||||
*/
|
||||
c.res_name = c.res_class = 0;
|
||||
Disable_Interrupts;
|
||||
(void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
|
||||
Enable_Interrupts;
|
||||
ret = Cons (False, False);
|
||||
GC_Link (ret);
|
||||
if (c.res_name) {
|
||||
x = Make_String (c.res_name, strlen (c.res_name));
|
||||
Car (ret) = x;
|
||||
XFree (c.res_name);
|
||||
}
|
||||
if (c.res_class) {
|
||||
x = Make_String (c.res_class, strlen (c.res_class));
|
||||
Cdr (ret) = x;
|
||||
XFree (c.res_class);
|
||||
}
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
|
||||
XClassHint c;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
c.res_name = Get_Strsym (name);
|
||||
c.res_class = Get_Strsym (class);
|
||||
XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
|
||||
register i, n;
|
||||
register char **argv;
|
||||
Object c;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_List (cmd);
|
||||
n = Fast_Length (cmd);
|
||||
Alloca (argv, char**, n * sizeof (char *));
|
||||
for (i = 0; i < n; i++, cmd = Cdr (cmd)) {
|
||||
c = Car (cmd);
|
||||
Get_Strsym_Stack (c, argv[i]);
|
||||
}
|
||||
XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Wm_Hints (w) Object w; {
|
||||
XWMHints *p;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Disable_Interrupts;
|
||||
p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
Enable_Interrupts;
|
||||
if (p) {
|
||||
WMH = *p;
|
||||
XFree ((char *)p);
|
||||
} else {
|
||||
WMH.flags = 0;
|
||||
}
|
||||
return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints,
|
||||
WINDOW(w)->dpy, (unsigned long)WMH.flags);
|
||||
}
|
||||
|
||||
static Object P_Set_Wm_Hints (w, h) Object w, h; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec);
|
||||
WMH.flags = mask;
|
||||
XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Size_Hints (w, a) Object w, a; {
|
||||
long supplied;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (a, T_Atom);
|
||||
Disable_Interrupts;
|
||||
if (!XGetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, &supplied,
|
||||
ATOM(a)->atom))
|
||||
SZH.flags = 0;
|
||||
if (!(supplied & PBaseSize))
|
||||
SZH.flags &= ~PBaseSize;
|
||||
if (!(supplied & PWinGravity))
|
||||
SZH.flags &= ~PWinGravity;
|
||||
Enable_Interrupts;
|
||||
if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition))
|
||||
SZH.flags &= ~PPosition;
|
||||
if ((SZH.flags & (PSize|USSize)) == (PSize|USSize))
|
||||
SZH.flags &= ~PSize;
|
||||
return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints,
|
||||
WINDOW(w)->dpy, (unsigned long)SZH.flags);
|
||||
}
|
||||
|
||||
static Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (a, T_Atom);
|
||||
bzero ((char *)&SZH, sizeof (SZH)); /* Not portable? */
|
||||
mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints,
|
||||
Size_Hints_Rec);
|
||||
if ((mask & (PPosition|USPosition)) == (PPosition|USPosition))
|
||||
mask &= ~PPosition;
|
||||
if ((mask & (PSize|USSize)) == (PSize|USSize))
|
||||
mask &= ~PSize;
|
||||
SZH.flags = mask;
|
||||
XSetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Icon_Sizes (w) Object w; {
|
||||
XIconSize *p;
|
||||
int i, n;
|
||||
Object v;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Disable_Interrupts;
|
||||
if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
|
||||
n = 0;
|
||||
Enable_Interrupts;
|
||||
v = Make_Vector (n, Null);
|
||||
GC_Link (v);
|
||||
for (i = 0; i < n; i++) {
|
||||
register XIconSize *q = &p[i];
|
||||
Object t;
|
||||
|
||||
t = P_Make_List (Make_Integer (6), Null);
|
||||
VECTOR(v)->data[i] = t;
|
||||
Car (t) = Make_Integer (q->min_width); t = Cdr (t);
|
||||
Car (t) = Make_Integer (q->min_height); t = Cdr (t);
|
||||
Car (t) = Make_Integer (q->max_width); t = Cdr (t);
|
||||
Car (t) = Make_Integer (q->max_height); t = Cdr (t);
|
||||
Car (t) = Make_Integer (q->width_inc); t = Cdr (t);
|
||||
Car (t) = Make_Integer (q->height_inc);
|
||||
}
|
||||
GC_Unlink;
|
||||
if (n > 0)
|
||||
XFree ((char *)p);
|
||||
return v;
|
||||
}
|
||||
|
||||
static Object P_Set_Icon_Sizes (w, v) Object w, v; {
|
||||
register i, n;
|
||||
XIconSize *p;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XIconSize*, n * sizeof (XIconSize));
|
||||
for (i = 0; i < n; i++) {
|
||||
register XIconSize *q = &p[i];
|
||||
Object t;
|
||||
|
||||
t = VECTOR(v)->data[i];
|
||||
Check_List (t);
|
||||
if (Fast_Length (t) != 6)
|
||||
Primitive_Error ("invalid argument: ~s", t);
|
||||
q->min_width = Get_Integer (Car (t)); t = Cdr (t);
|
||||
q->min_height = Get_Integer (Car (t)); t = Cdr (t);
|
||||
q->max_width = Get_Integer (Car (t)); t = Cdr (t);
|
||||
q->max_height = Get_Integer (Car (t)); t = Cdr (t);
|
||||
q->width_inc = Get_Integer (Car (t)); t = Cdr (t);
|
||||
q->height_inc = Get_Integer (Car (t));
|
||||
}
|
||||
XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Transient_For (w) Object w; {
|
||||
Window win;
|
||||
|
||||
Disable_Interrupts;
|
||||
if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win))
|
||||
win = None;
|
||||
Enable_Interrupts;
|
||||
return Make_Window (0, WINDOW(w)->dpy, win);
|
||||
}
|
||||
|
||||
static Object P_Set_Transient_For (w, pw) Object w, pw; {
|
||||
Check_Type (w, T_Window);
|
||||
XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw));
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_client () {
|
||||
Define_Symbol (&Sym_Wm_Hints, "wm-hints");
|
||||
Define_Symbol (&Sym_Size_Hints, "size-hints");
|
||||
Define_Primitive (P_Iconify_Window, "iconify-window", 2, 2, EVAL);
|
||||
Define_Primitive (P_Withdraw_Window, "withdraw-window", 2, 2, EVAL);
|
||||
Define_Primitive (P_Reconfigure_Wm_Window,
|
||||
"xlib-reconfigure-wm-window", 3, 3, EVAL);
|
||||
Define_Primitive (P_Wm_Command, "wm-command", 1, 1, EVAL);
|
||||
Define_Primitive (P_Get_Text_Property,"get-text-property", 2, 2, EVAL);
|
||||
Define_Primitive (P_Set_Text_Property,"set-text-property!",3, 3, EVAL);
|
||||
Define_Primitive (P_Wm_Protocols, "wm-protocols", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Wm_Protocols, "set-wm-protocols!", 2, 2, EVAL);
|
||||
Define_Primitive (P_Wm_Class, "wm-class", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Wm_Class, "set-wm-class!", 3, 3, EVAL);
|
||||
Define_Primitive (P_Set_Wm_Command, "set-wm-command!", 2, 2, EVAL);
|
||||
Define_Primitive (P_Wm_Hints, "xlib-wm-hints", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Wm_Hints, "xlib-set-wm-hints!",2, 2, EVAL);
|
||||
Define_Primitive (P_Size_Hints, "xlib-wm-size-hints",2, 2, EVAL);
|
||||
Define_Primitive (P_Set_Size_Hints,
|
||||
"xlib-set-wm-size-hints!", 3, 3, EVAL);
|
||||
Define_Primitive (P_Icon_Sizes, "icon-sizes", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Icon_Sizes, "set-icon-sizes!", 2, 2, EVAL);
|
||||
Define_Primitive (P_Transient_For, "transient-for", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,129 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Generic_Predicate (Color)
|
||||
|
||||
static Color_Equal (x, y) Object x, y; {
|
||||
register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c;
|
||||
return p->red == q->red && p->green == q->green && p->blue == q->blue;
|
||||
}
|
||||
|
||||
Generic_Print (Color, "#[color %lu]", POINTER(x))
|
||||
|
||||
Object Make_Color (r, g, b) unsigned int r, g, b; {
|
||||
Object c;
|
||||
|
||||
c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b);
|
||||
if (Nullp (c)) {
|
||||
c = Alloc_Object (sizeof (struct S_Color), T_Color, 0);
|
||||
COLOR(c)->tag = Null;
|
||||
COLOR(c)->c.red = r;
|
||||
COLOR(c)->c.green = g;
|
||||
COLOR(c)->c.blue = b;
|
||||
Register_Object (c, (GENERIC)0, (PFO)0, 0);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
XColor *Get_Color (c) Object c; {
|
||||
Check_Type (c, T_Color);
|
||||
return &COLOR(c)->c;
|
||||
}
|
||||
|
||||
static unsigned short Get_RGB_Value (x) Object x; {
|
||||
double d;
|
||||
|
||||
d = Get_Double (x);
|
||||
if (d < 0.0 || d > 1.0)
|
||||
Primitive_Error ("bad RGB value: ~s", x);
|
||||
return (unsigned short)(d * 65535);
|
||||
}
|
||||
|
||||
static Object P_Make_Color (r, g, b) Object r, g, b; {
|
||||
return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value (b));
|
||||
}
|
||||
|
||||
static Object P_Color_Rgb_Values (c) Object c; {
|
||||
Object ret, t, x;
|
||||
GC_Node3;
|
||||
|
||||
Check_Type (c, T_Color);
|
||||
ret = t = Null;
|
||||
GC_Link3 (c, ret, t);
|
||||
t = ret = P_Make_List (Make_Integer (3), Null);
|
||||
GC_Unlink;
|
||||
x = Make_Reduced_Flonum ((double)COLOR(c)->c.red / 65535.0);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
x = Make_Reduced_Flonum ((double)COLOR(c)->c.green / 65535.0);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
x = Make_Reduced_Flonum ((double)COLOR(c)->c.blue / 65535.0);
|
||||
Car (t) = x;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Query_Color (cmap, p) Object cmap, p; {
|
||||
XColor c;
|
||||
Colormap cm = Get_Colormap (cmap);
|
||||
|
||||
c.pixel = Get_Pixel (p);
|
||||
Disable_Interrupts;
|
||||
XQueryColor (COLORMAP(cmap)->dpy, cm, &c);
|
||||
Enable_Interrupts;
|
||||
return Make_Color (c.red, c.green, c.blue);
|
||||
}
|
||||
|
||||
static Object P_Query_Colors (cmap, v) Object cmap, v; {
|
||||
Colormap cm = Get_Colormap (cmap);
|
||||
register i, n;
|
||||
Object ret;
|
||||
register XColor *p;
|
||||
GC_Node;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XColor*, n * sizeof (XColor));
|
||||
for (i = 0; i < n; i++)
|
||||
p[i].pixel = Get_Pixel (VECTOR(v)->data[i]);
|
||||
Disable_Interrupts;
|
||||
XQueryColors (COLORMAP(cmap)->dpy, cm, p, n);
|
||||
Enable_Interrupts;
|
||||
ret = Make_Vector (n, Null);
|
||||
GC_Link (ret);
|
||||
for (i = 0; i < n; i++, p++) {
|
||||
Object x;
|
||||
|
||||
x = Make_Color (p->red, p->green, p->blue);
|
||||
VECTOR(ret)->data[i] = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
Alloca_End;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Lookup_Color (cmap, name) Object cmap, name; {
|
||||
XColor visual, exact;
|
||||
Colormap cm = Get_Colormap (cmap);
|
||||
Object ret, x;
|
||||
GC_Node;
|
||||
|
||||
if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
|
||||
&visual, &exact))
|
||||
Primitive_Error ("no such color: ~s", name);
|
||||
ret = Cons (Null, Null);
|
||||
GC_Link (ret);
|
||||
x = Make_Color (visual.red, visual.green, visual.blue);
|
||||
Car (ret) = x;
|
||||
x = Make_Color (exact.red, exact.green, exact.blue);
|
||||
Cdr (ret) = x;
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
elk_init_xlib_color () {
|
||||
Generic_Define (Color, "color", "color?");
|
||||
Define_Primitive (P_Make_Color, "make-color", 3, 3, EVAL);
|
||||
Define_Primitive (P_Color_Rgb_Values, "color-rgb-values", 1, 1, EVAL);
|
||||
Define_Primitive (P_Query_Color, "query-color", 2, 2, EVAL);
|
||||
Define_Primitive (P_Query_Colors, "query-colors", 2, 2, EVAL);
|
||||
Define_Primitive (P_Lookup_Color, "lookup-color", 2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Generic_Predicate (Colormap)
|
||||
|
||||
Generic_Equal_Dpy (Colormap, COLORMAP, cm)
|
||||
|
||||
Generic_Print (Colormap, "#[colormap %lu]", COLORMAP(x)->cm)
|
||||
|
||||
Generic_Get_Display (Colormap, COLORMAP)
|
||||
|
||||
Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
|
||||
Object cm;
|
||||
|
||||
if (cmap == None)
|
||||
return Sym_None;
|
||||
cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap);
|
||||
if (Nullp (cm)) {
|
||||
cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0);
|
||||
COLORMAP(cm)->tag = Null;
|
||||
COLORMAP(cm)->cm = cmap;
|
||||
COLORMAP(cm)->dpy = dpy;
|
||||
COLORMAP(cm)->free = 0;
|
||||
Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap :
|
||||
(PFO)0, 0);
|
||||
}
|
||||
return cm;
|
||||
}
|
||||
|
||||
Colormap Get_Colormap (c) Object c; {
|
||||
Check_Type (c, T_Colormap);
|
||||
return COLORMAP(c)->cm;
|
||||
}
|
||||
|
||||
Object P_Free_Colormap (c) Object c; {
|
||||
Check_Type (c, T_Colormap);
|
||||
if (!COLORMAP(c)->free)
|
||||
XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
|
||||
Deregister_Object (c);
|
||||
COLORMAP(c)->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Alloc_Color (cmap, color) Object cmap, color; {
|
||||
XColor c;
|
||||
Colormap cm = Get_Colormap (cmap);
|
||||
int r;
|
||||
|
||||
c = *Get_Color (color);
|
||||
Disable_Interrupts;
|
||||
r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c);
|
||||
Enable_Interrupts;
|
||||
if (!r)
|
||||
return False;
|
||||
return Make_Pixel (c.pixel);
|
||||
}
|
||||
|
||||
static Object P_Alloc_Named_Color (cmap, name) Object cmap, name; {
|
||||
Colormap cm = Get_Colormap (cmap);
|
||||
XColor screen, exact;
|
||||
int r;
|
||||
Object ret, t, x;
|
||||
GC_Node2;
|
||||
|
||||
Disable_Interrupts;
|
||||
r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
|
||||
&screen, &exact);
|
||||
Enable_Interrupts;
|
||||
if (!r)
|
||||
return False;
|
||||
t = ret = P_Make_List (Make_Integer (3), Null);
|
||||
GC_Link2 (t, ret);
|
||||
x = Make_Pixel (screen.pixel);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
x = Make_Color (screen.red, screen.green, screen.blue);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
x = Make_Color (exact.red, exact.green, exact.blue);
|
||||
Car (t) = x;
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
elk_init_xlib_colormap () {
|
||||
Generic_Define (Colormap, "colormap", "colormap?");
|
||||
Define_Primitive (P_Colormap_Display, "colormap-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Free_Colormap, "free-colormap", 1, 1, EVAL);
|
||||
Define_Primitive (P_Alloc_Color, "alloc-color", 2, 2, EVAL);
|
||||
Define_Primitive (P_Alloc_Named_Color,"alloc-named-color",2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Generic_Predicate (Cursor)
|
||||
|
||||
Generic_Equal_Dpy (Cursor, CURSOR, cursor)
|
||||
|
||||
Generic_Print (Cursor, "#[cursor %lu]", CURSOR(x)->cursor)
|
||||
|
||||
Generic_Get_Display (Cursor, CURSOR)
|
||||
|
||||
static Object Internal_Make_Cursor (finalize, dpy, cursor)
|
||||
Display *dpy; Cursor cursor; {
|
||||
Object c;
|
||||
|
||||
if (cursor == None)
|
||||
return Sym_None;
|
||||
c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor);
|
||||
if (Nullp (c)) {
|
||||
c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0);
|
||||
CURSOR(c)->tag = Null;
|
||||
CURSOR(c)->cursor = cursor;
|
||||
CURSOR(c)->dpy = dpy;
|
||||
CURSOR(c)->free = 0;
|
||||
Register_Object (c, (GENERIC)dpy,
|
||||
finalize ? P_Free_Cursor : (PFO)0, 0);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
Object Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
|
||||
return Internal_Make_Cursor (1, dpy, cursor);
|
||||
}
|
||||
|
||||
Object Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; {
|
||||
return Internal_Make_Cursor (0, dpy, cursor);
|
||||
}
|
||||
|
||||
Cursor Get_Cursor (c) Object c; {
|
||||
if (EQ(c, Sym_None))
|
||||
return None;
|
||||
Check_Type (c, T_Cursor);
|
||||
return CURSOR(c)->cursor;
|
||||
}
|
||||
|
||||
Object P_Free_Cursor (c) Object c; {
|
||||
Check_Type (c, T_Cursor);
|
||||
if (!CURSOR(c)->free)
|
||||
XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
|
||||
Deregister_Object (c);
|
||||
CURSOR(c)->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Create_Cursor (srcp, maskp, x, y, f, b)
|
||||
Object srcp, maskp, x, y, f, b; {
|
||||
Pixmap sp = Get_Pixmap (srcp), mp;
|
||||
Display *d = PIXMAP(srcp)->dpy;
|
||||
|
||||
mp = EQ(maskp, Sym_None) ? None : Get_Pixmap (maskp);
|
||||
return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp,
|
||||
Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y)));
|
||||
}
|
||||
|
||||
static Object P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
|
||||
Object srcf, srcc, maskf, maskc, f, b; {
|
||||
Font sf = Get_Font (srcf), mf;
|
||||
Display *d = FONT(srcf)->dpy;
|
||||
|
||||
mf = EQ(maskf, Sym_None) ? None : Get_Font (maskf);
|
||||
return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf,
|
||||
Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc),
|
||||
Get_Color (f), Get_Color (b)));
|
||||
}
|
||||
|
||||
static Object P_Recolor_Cursor (c, f, b) Object c, f, b; {
|
||||
Check_Type (c, T_Cursor);
|
||||
XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f),
|
||||
Get_Color (b));
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_cursor () {
|
||||
Generic_Define (Cursor, "cursor", "cursor?");
|
||||
Define_Primitive (P_Cursor_Display, "cursor-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Free_Cursor, "free-cursor", 1, 1, EVAL);
|
||||
Define_Primitive (P_Create_Cursor, "create-cursor", 6, 6, EVAL);
|
||||
Define_Primitive (P_Create_Glyph_Cursor, "create-glyph-cursor",
|
||||
6, 6, EVAL);
|
||||
Define_Primitive (P_Recolor_Cursor, "recolor-cursor", 3, 3, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,308 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Display_Visit (dp, f) Object *dp; int (*f)(); {
|
||||
(*f)(&DISPLAY(*dp)->after);
|
||||
}
|
||||
|
||||
Generic_Predicate (Display)
|
||||
|
||||
Generic_Equal (Display, DISPLAY, dpy)
|
||||
|
||||
static Display_Print (d, port, raw, depth, length) Object d, port; {
|
||||
Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy,
|
||||
DisplayString (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
Object Make_Display (finalize, dpy) Display *dpy; {
|
||||
Object d;
|
||||
|
||||
d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj);
|
||||
if (Nullp (d)) {
|
||||
d = Alloc_Object (sizeof (struct S_Display), T_Display, 0);
|
||||
DISPLAY(d)->dpy = dpy;
|
||||
DISPLAY(d)->free = 0;
|
||||
DISPLAY(d)->after = False;
|
||||
Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
|
||||
(PFO)0, 1);
|
||||
}
|
||||
return d;
|
||||
}
|
||||
|
||||
static Object P_Open_Display (argc, argv) Object *argv; {
|
||||
register char *s;
|
||||
Display *dpy;
|
||||
|
||||
if (argc == 1) {
|
||||
if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0)
|
||||
Primitive_Error ("cannot open display ~s", argv[0]);
|
||||
} else if ((dpy = XOpenDisplay ((char *)0)) == 0) {
|
||||
s = XDisplayName ((char *)0);
|
||||
Primitive_Error ("cannot open display ~s",
|
||||
Make_String (s, strlen (s)));
|
||||
}
|
||||
return Make_Display (1, dpy);
|
||||
}
|
||||
|
||||
Object P_Close_Display (d) Object d; {
|
||||
register struct S_Display *p;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
p = DISPLAY(d);
|
||||
if (!p->free) {
|
||||
Terminate_Group ((GENERIC)p->dpy);
|
||||
XCloseDisplay (p->dpy);
|
||||
}
|
||||
Deregister_Object (d);
|
||||
p->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Display_Default_Root_Window (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Window (0, DISPLAY(d)->dpy,
|
||||
DefaultRootWindow (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Display_Default_Colormap (d) Object d; {
|
||||
register Display *dpy;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Default_Gcontext (d) Object d; {
|
||||
register Display *dpy;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Default_Depth (d) Object d; {
|
||||
register Display *dpy;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
return Make_Integer (DefaultDepth (dpy, DefaultScreen (dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Default_Screen_Number (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DefaultScreen (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
int Get_Screen_Number (dpy, scr) Display *dpy; Object scr; {
|
||||
register s;
|
||||
|
||||
if ((s = Get_Integer (scr)) < 0 || s > ScreenCount (dpy)-1)
|
||||
Primitive_Error ("invalid screen number");
|
||||
return s;
|
||||
}
|
||||
|
||||
static Object P_Display_Cells (d, scr) Object d, scr; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayCells (DISPLAY(d)->dpy,
|
||||
Get_Screen_Number (DISPLAY(d)->dpy, scr)));
|
||||
}
|
||||
|
||||
static Object P_Display_Planes (d, scr) Object d, scr; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayPlanes (DISPLAY(d)->dpy,
|
||||
Get_Screen_Number (DISPLAY(d)->dpy, scr)));
|
||||
}
|
||||
|
||||
static Object P_Display_String (d) Object d; {
|
||||
register char *s;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
s = DisplayString (DISPLAY(d)->dpy);
|
||||
return Make_String (s, strlen (s));
|
||||
}
|
||||
|
||||
static Object P_Display_Vendor (d) Object d; {
|
||||
register char *s;
|
||||
Object ret, name;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
s = ServerVendor (DISPLAY(d)->dpy);
|
||||
name = Make_String (s, strlen (s));
|
||||
GC_Link (name);
|
||||
ret = Cons (Null, Make_Integer (VendorRelease (DISPLAY(d)->dpy)));
|
||||
Car (ret) = name;
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Display_Protocol_Version (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Cons (Make_Integer (ProtocolVersion (DISPLAY(d)->dpy)),
|
||||
Make_Integer (ProtocolRevision (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Screen_Count (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (ScreenCount (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Display_Image_Byte_Order (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy),
|
||||
0, Byte_Order_Syms);
|
||||
}
|
||||
|
||||
static Object P_Display_Bitmap_Unit (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (BitmapUnit (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Display_Bitmap_Bit_Order (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy),
|
||||
0, Byte_Order_Syms);
|
||||
}
|
||||
|
||||
static Object P_Display_Bitmap_Pad (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (BitmapPad (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Display_Width (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayWidth (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Height (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayHeight (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Width_Mm (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayWidthMM (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Height_Mm (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DisplayHeightMM (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_Display_Motion_Buffer_Size (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Unsigned_Long (XDisplayMotionBufferSize (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Display_Flush_Output (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
XFlush (DISPLAY(d)->dpy);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Display_Wait_Output (d, discard) Object d, discard; {
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (discard, T_Boolean);
|
||||
XSync (DISPLAY(d)->dpy, EQ(discard, True));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_No_Op (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
XNoOp (DISPLAY(d)->dpy);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_List_Depths (d, scr) Object d, scr; {
|
||||
int num;
|
||||
register *p, i;
|
||||
Object ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (!(p = XListDepths (DISPLAY(d)->dpy,
|
||||
Get_Screen_Number (DISPLAY(d)->dpy, scr), &num)))
|
||||
return False;
|
||||
ret = Make_Vector (num, Null);
|
||||
for (i = 0; i < num; i++)
|
||||
VECTOR(ret)->data[i] = Make_Integer (p[i]);
|
||||
XFree ((char *)p);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_List_Pixmap_Formats (d) Object d; {
|
||||
register XPixmapFormatValues *p;
|
||||
int num;
|
||||
register i;
|
||||
Object ret;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num)))
|
||||
return False;
|
||||
ret = Make_Vector (num, Null);
|
||||
GC_Link (ret);
|
||||
for (i = 0; i < num; i++) {
|
||||
Object t;
|
||||
|
||||
t = P_Make_List (Make_Integer (3), Null);
|
||||
VECTOR(ret)->data[i] = t;
|
||||
Car (t) = Make_Integer (p[i].depth); t = Cdr (t);
|
||||
Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t);
|
||||
Car (t) = Make_Integer (p[i].scanline_pad);
|
||||
}
|
||||
GC_Unlink;
|
||||
XFree ((char *)p);
|
||||
return ret;
|
||||
}
|
||||
|
||||
elk_init_xlib_display () {
|
||||
T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display),
|
||||
Display_Equal, Display_Equal, Display_Print, Display_Visit);
|
||||
Define_Primitive (P_Displayp, "display?", 1, 1, EVAL);
|
||||
Define_Primitive (P_Open_Display, "open-display", 0, 1, VARARGS);
|
||||
Define_Primitive (P_Close_Display, "close-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Default_Root_Window,
|
||||
"display-default-root-window", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Default_Colormap,
|
||||
"display-default-colormap", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Default_Gcontext,
|
||||
"display-default-gcontext", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Default_Depth,
|
||||
"display-default-depth", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Default_Screen_Number,
|
||||
"display-default-screen-number", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Cells, "display-cells", 2, 2, EVAL);
|
||||
Define_Primitive (P_Display_Planes, "display-planes", 2, 2, EVAL);
|
||||
Define_Primitive (P_Display_String, "display-string", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Vendor, "display-vendor", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Protocol_Version,
|
||||
"display-protocol-version", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Screen_Count,
|
||||
"display-screen-count", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Image_Byte_Order,
|
||||
"display-image-byte-order", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Bitmap_Unit,
|
||||
"display-bitmap-unit", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Bitmap_Bit_Order,
|
||||
"display-bitmap-bit-order", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Bitmap_Pad,
|
||||
"display-bitmap-pad", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Width, "display-width", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Height, "display-height", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Width_Mm,"display-width-mm", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Height_Mm,
|
||||
"display-height-mm", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Motion_Buffer_Size,
|
||||
"display-motion-buffer-size", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Flush_Output,
|
||||
"display-flush-output", 1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Wait_Output,
|
||||
"display-wait-output", 2, 2, EVAL);
|
||||
Define_Primitive (P_No_Op, "no-op", 1, 1, EVAL);
|
||||
Define_Primitive (P_List_Depths, "list-depths", 2, 2, EVAL);
|
||||
Define_Primitive (P_List_Pixmap_Formats,
|
||||
"list-pixmap-formats", 1, 1, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object V_X_Error_Handler, V_X_Fatal_Error_Handler;
|
||||
|
||||
/* Default error handlers of the Xlib */
|
||||
extern int _XDefaultIOError();
|
||||
extern int _XDefaultError();
|
||||
|
||||
static X_Fatal_Error (d) Display *d; {
|
||||
Object args, fun;
|
||||
GC_Node;
|
||||
|
||||
Reset_IO (0);
|
||||
args = Make_Display (0, d);
|
||||
GC_Link (args);
|
||||
args = Cons (args, Null);
|
||||
GC_Unlink;
|
||||
fun = Var_Get (V_X_Fatal_Error_Handler);
|
||||
if (TYPE(fun) == T_Compound)
|
||||
(void)Funcall (fun, args, 0);
|
||||
_XDefaultIOError (d);
|
||||
exit (1); /* In case the default handler doesn't exit() */
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
static X_Error (d, ep) Display *d; XErrorEvent *ep; {
|
||||
Object args, a, fun;
|
||||
GC_Node;
|
||||
|
||||
Reset_IO (0);
|
||||
args = Make_Unsigned_Long ((unsigned long)ep->resourceid);
|
||||
GC_Link (args);
|
||||
args = Cons (args, Null);
|
||||
a = Make_Unsigned (ep->minor_code);
|
||||
args = Cons (a, args);
|
||||
a = Make_Unsigned (ep->request_code);
|
||||
args = Cons (a, args);
|
||||
a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms);
|
||||
if (Nullp (a))
|
||||
a = Make_Unsigned (ep->error_code);
|
||||
args = Cons (a, args);
|
||||
a = Make_Unsigned_Long (ep->serial);
|
||||
args = Cons (a, args);
|
||||
a = Make_Display (0, ep->display);
|
||||
args = Cons (a, args);
|
||||
GC_Unlink;
|
||||
fun = Var_Get (V_X_Error_Handler);
|
||||
if (TYPE(fun) == T_Compound)
|
||||
(void)Funcall (fun, args, 0);
|
||||
else
|
||||
_XDefaultError (d, ep);
|
||||
}
|
||||
|
||||
static X_After_Function (d) Display *d; {
|
||||
Object args;
|
||||
GC_Node;
|
||||
|
||||
args = Make_Display (0, d);
|
||||
GC_Link (args);
|
||||
args = Cons (args, Null);
|
||||
GC_Unlink;
|
||||
(void)Funcall (DISPLAY(Car (args))->after, args, 0);
|
||||
}
|
||||
|
||||
static Object P_Set_After_Function (d, f) Object d, f; {
|
||||
Object old;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (EQ(f, False)) {
|
||||
(void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0);
|
||||
} else {
|
||||
Check_Procedure (f);
|
||||
(void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function);
|
||||
}
|
||||
old = DISPLAY(d)->after;
|
||||
DISPLAY(d)->after = f;
|
||||
return old;
|
||||
}
|
||||
|
||||
static Object P_After_Function (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return DISPLAY(d)->after;
|
||||
}
|
||||
|
||||
elk_init_xlib_error () {
|
||||
Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", Null);
|
||||
Define_Variable (&V_X_Error_Handler, "x-error-handler", Null);
|
||||
(void)XSetIOErrorHandler (X_Fatal_Error);
|
||||
(void)XSetErrorHandler (X_Error);
|
||||
Define_Primitive (P_Set_After_Function, "set-after-function!", 2, 2, EVAL);
|
||||
Define_Primitive (P_After_Function, "after-function", 1, 1, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,514 @@
|
|||
#include "xlib.h"
|
||||
|
||||
#define MAX_ARGS 14
|
||||
|
||||
static Object Argl, Argv;
|
||||
|
||||
static struct event_desc {
|
||||
char *name;
|
||||
int argc;
|
||||
} Event_Table[] = {
|
||||
{ "event-0", 1 },
|
||||
{ "event-1", 1 },
|
||||
{ "key-press", 12 },
|
||||
{ "key-release", 12 },
|
||||
{ "button-press", 12 },
|
||||
{ "button-release", 12 },
|
||||
{ "motion-notify", 12 },
|
||||
{ "enter-notify", 14 },
|
||||
{ "leave-notify", 14 },
|
||||
{ "focus-in", 4 },
|
||||
{ "focus-out", 4 },
|
||||
{ "keymap-notify", 3 },
|
||||
{ "expose", 7 },
|
||||
{ "graphics-expose", 9 },
|
||||
{ "no-expose", 4 },
|
||||
{ "visibility-notify", 3 },
|
||||
{ "create-notify", 9 },
|
||||
{ "destroy-notify", 3 },
|
||||
{ "unmap-notify", 4 },
|
||||
{ "map-notify", 4 },
|
||||
{ "map-request", 3 },
|
||||
{ "reparent-notify", 7 },
|
||||
{ "configure-notify", 10 },
|
||||
{ "configure-request", 11 },
|
||||
{ "gravity-notify", 5 },
|
||||
{ "resize-request", 4 },
|
||||
{ "circulate-notify", 4 },
|
||||
{ "circulate-request", 4 },
|
||||
{ "property-notify", 5 },
|
||||
{ "selection-clear", 4 },
|
||||
{ "selection-request", 7 },
|
||||
{ "selection-notify", 6 },
|
||||
{ "colormap-notify", 5 },
|
||||
{ "client-message", 4 },
|
||||
{ "mapping-notify", 4 },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
struct predicate_arg {
|
||||
Object *funcs;
|
||||
Object *ret;
|
||||
};
|
||||
|
||||
/*ARGSUSED*/
|
||||
static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep;
|
||||
#ifdef XLIB_RELEASE_5_OR_LATER
|
||||
XPointer ptr; {
|
||||
#else
|
||||
char *ptr; {
|
||||
#endif
|
||||
struct predicate_arg *ap = (struct predicate_arg *)ptr;
|
||||
register i;
|
||||
Object args;
|
||||
GC_Node;
|
||||
|
||||
if ((i = ep->type) < LASTEvent && !Nullp (ap->funcs[i])) {
|
||||
args = Get_Event_Args (ep);
|
||||
GC_Link (args);
|
||||
*ap->ret = Funcall (ap->funcs[i], args, 0);
|
||||
Destroy_Event_Args (args);
|
||||
GC_Unlink;
|
||||
}
|
||||
return Truep (*ap->ret);
|
||||
}
|
||||
|
||||
/* (handle-events display discard? peek? clause...)
|
||||
* clause = (event function) or ((event...) function) or (else function)
|
||||
* loops/blocks until a function returns x != #f, then returns x.
|
||||
* discard?: discard unprocessed events.
|
||||
* peek?: don't discard processed events.
|
||||
*/
|
||||
|
||||
static Object P_Handle_Events (argl) Object argl; {
|
||||
Object next, clause, func, ret, funcs[LASTEvent], args;
|
||||
register i, discard, peek;
|
||||
Display *dpy;
|
||||
char *errmsg = "event occurs more than once";
|
||||
GC_Node3; struct gcnode gcv;
|
||||
TC_Prolog;
|
||||
|
||||
TC_Disable;
|
||||
clause = args = Null;
|
||||
GC_Link3 (argl, clause, args);
|
||||
next = Eval (Car (argl));
|
||||
Check_Type (next, T_Display);
|
||||
dpy = DISPLAY(next)->dpy;
|
||||
argl = Cdr (argl);
|
||||
next = Eval (Car (argl));
|
||||
Check_Type (next, T_Boolean);
|
||||
discard = Truep (next);
|
||||
argl = Cdr (argl);
|
||||
next = Eval (Car (argl));
|
||||
Check_Type (next, T_Boolean);
|
||||
peek = Truep (next);
|
||||
for (i = 0; i < LASTEvent; i++)
|
||||
funcs[i] = Null;
|
||||
gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv;
|
||||
for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) {
|
||||
clause = Car (argl);
|
||||
Check_List (clause);
|
||||
if (Fast_Length (clause) != 2)
|
||||
Primitive_Error ("badly formed event clause");
|
||||
func = Eval (Car (Cdr (clause)));
|
||||
Check_Procedure (func);
|
||||
clause = Car (clause);
|
||||
if (EQ(clause, Sym_Else)) {
|
||||
for (i = 0; i < LASTEvent; i++)
|
||||
if (Nullp (funcs[i])) funcs[i] = func;
|
||||
} else {
|
||||
if (TYPE(clause) == T_Pair) {
|
||||
for (; !Nullp (clause); clause = Cdr (clause)) {
|
||||
i = Encode_Event (Car (clause));
|
||||
if (!Nullp (funcs[i]))
|
||||
Primitive_Error (errmsg);
|
||||
funcs[i] = func;
|
||||
}
|
||||
} else {
|
||||
i = Encode_Event (clause);
|
||||
if (!Nullp (funcs[i]))
|
||||
Primitive_Error (errmsg);
|
||||
funcs[i] = func;
|
||||
}
|
||||
}
|
||||
}
|
||||
ret = False;
|
||||
while (!Truep (ret)) {
|
||||
XEvent e;
|
||||
if (discard) {
|
||||
(peek ? XPeekEvent : XNextEvent) (dpy, &e);
|
||||
if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) {
|
||||
args = Get_Event_Args (&e);
|
||||
ret = Funcall (funcs[i], args, 0);
|
||||
Destroy_Event_Args (args);
|
||||
} else {
|
||||
if (peek)
|
||||
XNextEvent (dpy, &e); /* discard it */
|
||||
}
|
||||
} else {
|
||||
struct predicate_arg a;
|
||||
a.funcs = funcs;
|
||||
a.ret = &ret;
|
||||
(peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate,
|
||||
#ifdef XLIB_RELEASE_5_OR_LATER
|
||||
(XPointer)&a);
|
||||
#else
|
||||
(char *)&a);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
GC_Unlink;
|
||||
TC_Enable;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object Get_Time_Arg (t) Time t; {
|
||||
return t == CurrentTime ? Sym_Now : Make_Unsigned_Long ((unsigned long)t);
|
||||
}
|
||||
|
||||
Object Get_Event_Args (ep) XEvent *ep; {
|
||||
Object tmpargs[MAX_ARGS];
|
||||
register e, i;
|
||||
register Object *a, *vp;
|
||||
struct gcnode gcv;
|
||||
Object dummy;
|
||||
GC_Node;
|
||||
|
||||
e = ep->type;
|
||||
dummy = Null;
|
||||
a = tmpargs;
|
||||
for (i = 0; i < MAX_ARGS; i++)
|
||||
a[i] = Null;
|
||||
GC_Link (dummy);
|
||||
gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv;
|
||||
switch (e) {
|
||||
case KeyPress: case KeyRelease:
|
||||
case ButtonPress: case ButtonRelease:
|
||||
case MotionNotify:
|
||||
case EnterNotify: case LeaveNotify: {
|
||||
register XKeyEvent *p = (XKeyEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Window (0, p->display, p->root);
|
||||
a[3] = Make_Window (0, p->display, p->subwindow);
|
||||
a[4] = Get_Time_Arg (p->time);
|
||||
a[5] = Make_Integer (p->x);
|
||||
a[6] = Make_Integer (p->y);
|
||||
a[7] = Make_Integer (p->x_root);
|
||||
a[8] = Make_Integer (p->y_root);
|
||||
if (e == KeyPress || e == KeyRelease) {
|
||||
a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms);
|
||||
a[10] = Make_Integer (p->keycode);
|
||||
a[11] = p->same_screen ? True : False;
|
||||
} else if (e == ButtonPress || e == ButtonRelease) {
|
||||
register XButtonEvent *q = (XButtonEvent *)ep;
|
||||
a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
|
||||
a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms);
|
||||
a[11] = q->same_screen ? True : False;
|
||||
} else if (e == MotionNotify) {
|
||||
register XMotionEvent *q = (XMotionEvent *)ep;
|
||||
a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms);
|
||||
a[10] = q->is_hint ? True : False;
|
||||
a[11] = q->same_screen ? True : False;
|
||||
} else {
|
||||
register XCrossingEvent *q = (XCrossingEvent *)ep;
|
||||
a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms);
|
||||
a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0,
|
||||
Cross_Detail_Syms);
|
||||
a[11] = q->same_screen ? True : False;
|
||||
a[12] = q->focus ? True : False;
|
||||
a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms);
|
||||
}
|
||||
} break;
|
||||
case FocusIn: case FocusOut: {
|
||||
register XFocusChangeEvent *p = (XFocusChangeEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms);
|
||||
a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms);
|
||||
} break;
|
||||
case KeymapNotify: {
|
||||
register XKeymapEvent *p = (XKeymapEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_String (p->key_vector, 32);
|
||||
} break;
|
||||
case Expose: {
|
||||
register XExposeEvent *p = (XExposeEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Integer (p->x);
|
||||
a[3] = Make_Integer (p->y);
|
||||
a[4] = Make_Integer (p->width);
|
||||
a[5] = Make_Integer (p->height);
|
||||
a[6] = Make_Integer (p->count);
|
||||
} break;
|
||||
case GraphicsExpose: {
|
||||
register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->drawable);
|
||||
a[2] = Make_Integer (p->x);
|
||||
a[3] = Make_Integer (p->y);
|
||||
a[4] = Make_Integer (p->width);
|
||||
a[5] = Make_Integer (p->height);
|
||||
a[6] = Make_Integer (p->count);
|
||||
a[7] = Make_Integer (p->major_code);
|
||||
a[8] = Make_Integer (p->minor_code);
|
||||
} break;
|
||||
case NoExpose: {
|
||||
register XNoExposeEvent *p = (XNoExposeEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->drawable);
|
||||
a[2] = Make_Integer (p->major_code);
|
||||
a[3] = Make_Integer (p->minor_code);
|
||||
} break;
|
||||
case VisibilityNotify: {
|
||||
register XVisibilityEvent *p = (XVisibilityEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms);
|
||||
} break;
|
||||
case CreateNotify: {
|
||||
register XCreateWindowEvent *p = (XCreateWindowEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->parent);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Make_Integer (p->x);
|
||||
a[4] = Make_Integer (p->y);
|
||||
a[5] = Make_Integer (p->width);
|
||||
a[6] = Make_Integer (p->height);
|
||||
a[7] = Make_Integer (p->border_width);
|
||||
a[8] = p->override_redirect ? True : False;
|
||||
} break;
|
||||
case DestroyNotify: {
|
||||
register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
} break;
|
||||
case UnmapNotify: {
|
||||
register XUnmapEvent *p = (XUnmapEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = p->from_configure ? True : False;
|
||||
} break;
|
||||
case MapNotify: {
|
||||
register XMapEvent *p = (XMapEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = p->override_redirect ? True : False;
|
||||
} break;
|
||||
case MapRequest: {
|
||||
register XMapRequestEvent *p = (XMapRequestEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->parent);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
} break;
|
||||
case ReparentNotify: {
|
||||
register XReparentEvent *p = (XReparentEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Make_Window (0, p->display, p->parent);
|
||||
a[4] = Make_Integer (p->x);
|
||||
a[5] = Make_Integer (p->y);
|
||||
a[6] = p->override_redirect ? True : False;
|
||||
} break;
|
||||
case ConfigureNotify: {
|
||||
register XConfigureEvent *p = (XConfigureEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Make_Integer (p->x);
|
||||
a[4] = Make_Integer (p->y);
|
||||
a[5] = Make_Integer (p->width);
|
||||
a[6] = Make_Integer (p->height);
|
||||
a[7] = Make_Integer (p->border_width);
|
||||
a[8] = Make_Window (0, p->display, p->above);
|
||||
a[9] = p->override_redirect ? True : False;
|
||||
} break;
|
||||
case ConfigureRequest: {
|
||||
register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->parent);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Make_Integer (p->x);
|
||||
a[4] = Make_Integer (p->y);
|
||||
a[5] = Make_Integer (p->width);
|
||||
a[6] = Make_Integer (p->height);
|
||||
a[7] = Make_Integer (p->border_width);
|
||||
a[8] = Make_Window (0, p->display, p->above);
|
||||
a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms);
|
||||
a[10] = Make_Unsigned_Long (p->value_mask);
|
||||
} break;
|
||||
case GravityNotify: {
|
||||
register XGravityEvent *p = (XGravityEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Make_Integer (p->x);
|
||||
a[4] = Make_Integer (p->y);
|
||||
} break;
|
||||
case ResizeRequest: {
|
||||
register XResizeRequestEvent *p = (XResizeRequestEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Integer (p->width);
|
||||
a[3] = Make_Integer (p->height);
|
||||
} break;
|
||||
case CirculateNotify: {
|
||||
register XCirculateEvent *p = (XCirculateEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->event);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
|
||||
} break;
|
||||
case CirculateRequest: {
|
||||
register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->parent);
|
||||
a[2] = Make_Window (0, p->display, p->window);
|
||||
a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms);
|
||||
} break;
|
||||
case PropertyNotify: {
|
||||
register XPropertyEvent *p = (XPropertyEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Atom (p->atom);
|
||||
a[3] = Get_Time_Arg (p->time);
|
||||
a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms);
|
||||
} break;
|
||||
case SelectionClear: {
|
||||
register XSelectionClearEvent *p = (XSelectionClearEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Atom (p->selection);
|
||||
a[3] = Get_Time_Arg (p->time);
|
||||
} break;
|
||||
case SelectionRequest: {
|
||||
register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->owner);
|
||||
a[2] = Make_Window (0, p->display, p->requestor);
|
||||
a[3] = Make_Atom (p->selection);
|
||||
a[4] = Make_Atom (p->target);
|
||||
a[5] = Make_Atom (p->property);
|
||||
a[6] = Get_Time_Arg (p->time);
|
||||
} break;
|
||||
case SelectionNotify: {
|
||||
register XSelectionEvent *p = (XSelectionEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->requestor);
|
||||
a[2] = Make_Atom (p->selection);
|
||||
a[3] = Make_Atom (p->target);
|
||||
a[4] = Make_Atom (p->property);
|
||||
a[5] = Get_Time_Arg (p->time);
|
||||
} break;
|
||||
case ColormapNotify: {
|
||||
register XColormapEvent *p = (XColormapEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Colormap (0, p->display, p->colormap);
|
||||
a[3] = p->new ? True : False;
|
||||
a[4] = p->state == ColormapInstalled ? True : False;
|
||||
} break;
|
||||
case ClientMessage: {
|
||||
register XClientMessageEvent *p = (XClientMessageEvent *)ep;
|
||||
register i;
|
||||
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Make_Atom (p->message_type);
|
||||
switch (p->format) {
|
||||
case 8:
|
||||
a[3] = Make_String (p->data.b, 20);
|
||||
break;
|
||||
case 16:
|
||||
a[3] = Make_Vector (10, Null);
|
||||
for (i = 0; i < 10; i++)
|
||||
VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]);
|
||||
break;
|
||||
case 32:
|
||||
a[3] = Make_Vector (5, Null);
|
||||
for (i = 0; i < 5; i++)
|
||||
VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]);
|
||||
break;
|
||||
default:
|
||||
a[3] = Make_Integer (p->format); /* ??? */
|
||||
}
|
||||
} break;
|
||||
case MappingNotify: {
|
||||
register XMappingEvent *p = (XMappingEvent *)ep;
|
||||
a[1] = Make_Window (0, p->display, p->window);
|
||||
a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms);
|
||||
a[3] = Make_Integer (p->first_keycode);
|
||||
a[4] = Make_Integer (p->count);
|
||||
} break;
|
||||
}
|
||||
a[0] = Intern (Event_Table[e].name);
|
||||
for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) {
|
||||
if (i) vp++;
|
||||
Car (*vp) = a[i];
|
||||
Cdr (*vp) = vp[1];
|
||||
}
|
||||
Cdr (*vp) = Null;
|
||||
GC_Unlink;
|
||||
return Argl;
|
||||
}
|
||||
|
||||
void Destroy_Event_Args (args) Object args; {
|
||||
Object t;
|
||||
|
||||
for (t = args; !Nullp (t); t = Cdr (t))
|
||||
Car (t) = Null;
|
||||
}
|
||||
|
||||
Encode_Event (e) Object e; {
|
||||
Object s;
|
||||
register char *p;
|
||||
register struct event_desc *ep;
|
||||
register n;
|
||||
|
||||
Check_Type (e, T_Symbol);
|
||||
s = SYMBOL(e)->name;
|
||||
p = STRING(s)->data;
|
||||
n = STRING(s)->size;
|
||||
for (ep = Event_Table; ep->name; ep++)
|
||||
if (n && strncmp (ep->name, p, n) == 0) break;
|
||||
if (ep->name == 0)
|
||||
Primitive_Error ("no such event: ~s", e);
|
||||
return ep-Event_Table;
|
||||
}
|
||||
|
||||
static Object P_Get_Motion_Events (w, from, to) Object w, from, to; {
|
||||
XTimeCoord *p;
|
||||
int n;
|
||||
register i;
|
||||
Object e, ret;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from),
|
||||
Get_Time (to), &n);
|
||||
e = ret = Make_Vector (n, Null);
|
||||
GC_Link2 (ret, e);
|
||||
for (i = 0; i < n; i++) {
|
||||
e = P_Make_List (Make_Integer (3), Null);
|
||||
VECTOR(ret)->data[i] = e;
|
||||
Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e);
|
||||
Car (e) = Make_Integer (p[i].x); e = Cdr (e);
|
||||
Car (e) = Make_Integer (p[i].y);
|
||||
}
|
||||
GC_Unlink;
|
||||
XFree ((char *)p);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Event_Listen (d, wait_flag) Object d, wait_flag; {
|
||||
Display *dpy;
|
||||
register n;
|
||||
XEvent e;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (wait_flag, T_Boolean);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
n = XPending (dpy);
|
||||
if (n == 0 && EQ(wait_flag, True)) {
|
||||
XPeekEvent (dpy, &e);
|
||||
n = XPending (dpy);
|
||||
}
|
||||
return Make_Integer (n);
|
||||
}
|
||||
|
||||
elk_init_xlib_event () {
|
||||
Object t;
|
||||
register i;
|
||||
|
||||
Argl = P_Make_List (Make_Integer (MAX_ARGS), Null);
|
||||
Global_GC_Link (Argl);
|
||||
Argv = Make_Vector (MAX_ARGS, Null);
|
||||
Global_GC_Link (Argv);
|
||||
for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t))
|
||||
VECTOR(Argv)->data[i] = t;
|
||||
Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL);
|
||||
Define_Primitive (P_Get_Motion_Events,
|
||||
"get-motion-events", 3, 3, EVAL);
|
||||
Define_Primitive (P_Event_Listen, "event-listen", 2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object P_List_Extensions (d) Object d; {
|
||||
Object ret;
|
||||
int n;
|
||||
register i;
|
||||
register char **p;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Disable_Interrupts;
|
||||
p = XListExtensions (DISPLAY(d)->dpy, &n);
|
||||
Enable_Interrupts;
|
||||
ret = Make_Vector (n, Null);
|
||||
GC_Link (ret);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object e;
|
||||
|
||||
e = Make_String (p[i], strlen (p[i]));
|
||||
VECTOR(ret)->data[i] = e;
|
||||
}
|
||||
GC_Unlink;
|
||||
XFreeExtensionList (p);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Query_Extension (d, name) Object d, name; {
|
||||
int opcode, event, error;
|
||||
Object ret, t;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (!XQueryExtension (DISPLAY(d)->dpy, Get_Strsym (name), &opcode,
|
||||
&event, &error))
|
||||
return False;
|
||||
t = ret = P_Make_List (Make_Integer (3), Null);
|
||||
GC_Link2 (ret, t);
|
||||
Car (t) = (opcode ? Make_Integer (opcode) : False); t = Cdr (t);
|
||||
Car (t) = (event ? Make_Integer (event) : False); t = Cdr (t);
|
||||
Car (t) = (error ? Make_Integer (error) : False);
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
elk_init_xlib_extension () {
|
||||
Define_Primitive (P_List_Extensions, "list-extensions", 1, 1, EVAL);
|
||||
Define_Primitive (P_Query_Extension, "query-extension", 2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,299 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Object Sym_Char_Info;
|
||||
static Object Sym_Font_Info, Sym_Min, Sym_Max;
|
||||
|
||||
Generic_Predicate (Font)
|
||||
|
||||
static Font_Equal (x, y) Object x, y; {
|
||||
Font id1 = FONT(x)->id, id2 = FONT(y)->id;
|
||||
if (id1 && id2)
|
||||
return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy;
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
|
||||
Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id : POINTER(x))
|
||||
|
||||
static Font_Visit (fp, f) Object *fp; int (*f)(); {
|
||||
(*f)(&FONT(*fp)->name);
|
||||
}
|
||||
|
||||
Generic_Get_Display (Font, FONT)
|
||||
|
||||
static Object Internal_Make_Font (finalize, dpy, name, id, info)
|
||||
Display *dpy; Object name; Font id; XFontStruct *info; {
|
||||
Object f;
|
||||
GC_Node;
|
||||
|
||||
GC_Link (name);
|
||||
f = Alloc_Object (sizeof (struct S_Font), T_Font, 0);
|
||||
FONT(f)->dpy = dpy;
|
||||
if (TYPE(name) == T_Symbol)
|
||||
name = SYMBOL(name)->name;
|
||||
FONT(f)->name = name;
|
||||
FONT(f)->id = id;
|
||||
FONT(f)->info = info;
|
||||
if (id)
|
||||
Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0);
|
||||
GC_Unlink;
|
||||
return f;
|
||||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
Object Make_Font (dpy, name, id, info)
|
||||
Display *dpy; Object name; Font id; XFontStruct *info; {
|
||||
return Internal_Make_Font (1, dpy, name, id, info);
|
||||
}
|
||||
|
||||
Object Make_Font_Foreign (dpy, name, id, info)
|
||||
Display *dpy; Object name; Font id; XFontStruct *info; {
|
||||
return Internal_Make_Font (0, dpy, name, id, info);
|
||||
}
|
||||
|
||||
Font Get_Font (f) Object f; {
|
||||
Check_Type (f, T_Font);
|
||||
Open_Font_Maybe (f);
|
||||
return FONT(f)->id;
|
||||
}
|
||||
|
||||
static XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; {
|
||||
register char *s;
|
||||
XFontStruct *p;
|
||||
Alloca_Begin;
|
||||
|
||||
Get_Strsym_Stack (name, s);
|
||||
Disable_Interrupts;
|
||||
if ((p = XLoadQueryFont (d, s)) == 0)
|
||||
Primitive_Error ("cannot open font: ~s", name);
|
||||
Enable_Interrupts;
|
||||
Alloca_End;
|
||||
return p;
|
||||
}
|
||||
|
||||
static Object P_Open_Font (d, name) Object d, name; {
|
||||
XFontStruct *p;
|
||||
|
||||
Check_Type (d, T_Display)
|
||||
p = Internal_Open_Font (DISPLAY(d)->dpy, name);
|
||||
return Make_Font (DISPLAY(d)->dpy, name, p->fid, p);
|
||||
}
|
||||
|
||||
void Open_Font_Maybe (f) Object f; {
|
||||
Object name;
|
||||
XFontStruct *p;
|
||||
|
||||
name = FONT(f)->name;
|
||||
if (!Truep (name))
|
||||
Primitive_Error ("invalid font");
|
||||
if (FONT(f)->id == 0) {
|
||||
p = Internal_Open_Font (FONT(f)->dpy, name);
|
||||
FONT(f)->id = p->fid;
|
||||
FONT(f)->info = p;
|
||||
Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0);
|
||||
}
|
||||
}
|
||||
|
||||
Object P_Close_Font (f) Object f; {
|
||||
Check_Type (f, T_Font);
|
||||
if (FONT(f)->id)
|
||||
XUnloadFont (FONT(f)->dpy, FONT(f)->id);
|
||||
FONT(f)->id = 0;
|
||||
Deregister_Object (f);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Font_Name (f) Object f; {
|
||||
Check_Type (f, T_Font);
|
||||
return FONT(f)->name;
|
||||
}
|
||||
|
||||
static Object P_Gcontext_Font (g) Object g; {
|
||||
register struct S_Gc *p;
|
||||
register XFontStruct *info;
|
||||
|
||||
Check_Type (g, T_Gc);
|
||||
p = GCONTEXT(g);
|
||||
Disable_Interrupts;
|
||||
info = XQueryFont (p->dpy, XGContextFromGC (p->gc));
|
||||
Enable_Interrupts;
|
||||
return Make_Font_Foreign (p->dpy, False, (Font)0, info);
|
||||
}
|
||||
|
||||
static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; {
|
||||
char **ret;
|
||||
int n;
|
||||
XFontStruct *iret;
|
||||
register i;
|
||||
Object f, v;
|
||||
Display *dpy;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
dpy = DISPLAY(d)->dpy;
|
||||
Disable_Interrupts;
|
||||
if (with_info)
|
||||
ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret);
|
||||
else
|
||||
ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n);
|
||||
Enable_Interrupts;
|
||||
v = Make_Vector (n, Null);
|
||||
f = Null;
|
||||
GC_Link2 (f, v);
|
||||
for (i = 0; i < n; i++) {
|
||||
f = Make_String (ret[i], strlen (ret[i]));
|
||||
if (with_info)
|
||||
f = Make_Font (dpy, f, (Font)0, &iret[i]);
|
||||
VECTOR(v)->data[i] = f;
|
||||
}
|
||||
GC_Unlink;
|
||||
if (with_info)
|
||||
XFreeFontInfo (ret, (XFontStruct *)0, 0);
|
||||
else
|
||||
XFreeFontNames (ret);
|
||||
return v;
|
||||
}
|
||||
|
||||
static Object P_List_Font_Names (d, pat) Object d, pat; {
|
||||
return Internal_List_Fonts (d, pat, 0);
|
||||
}
|
||||
|
||||
static Object P_List_Fonts (d, pat) Object d, pat; {
|
||||
return Internal_List_Fonts (d, pat, 1);
|
||||
}
|
||||
|
||||
static Object P_Font_Info (f) Object f; {
|
||||
Check_Type (f, T_Font);
|
||||
FI = *FONT(f)->info;
|
||||
return Record_To_Vector (Font_Info_Rec, Font_Info_Size,
|
||||
Sym_Font_Info, FONT(f)->dpy, ~0L);
|
||||
}
|
||||
|
||||
static Object P_Char_Info (f, index) Object f, index; {
|
||||
register t = TYPE(index);
|
||||
register unsigned i;
|
||||
register XCharStruct *cp;
|
||||
register XFontStruct *p;
|
||||
char *msg = "argument must be integer, character, 'min, or 'max";
|
||||
|
||||
Check_Type (f, T_Font);
|
||||
Open_Font_Maybe (f);
|
||||
p = FONT(f)->info;
|
||||
cp = &p->max_bounds;
|
||||
if (t == T_Symbol) {
|
||||
if (EQ(index, Sym_Min))
|
||||
cp = &p->min_bounds;
|
||||
else if (!EQ(index, Sym_Max))
|
||||
Primitive_Error (msg);
|
||||
} else {
|
||||
if (t == T_Character)
|
||||
i = CHAR(index);
|
||||
else if (t == T_Fixnum || t == T_Bignum)
|
||||
i = (unsigned)Get_Integer (index);
|
||||
else
|
||||
Primitive_Error (msg);
|
||||
if (!p->min_byte1 && !p->max_byte1) {
|
||||
if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2)
|
||||
Range_Error (index);
|
||||
i -= p->min_char_or_byte2;
|
||||
} else {
|
||||
register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff;
|
||||
if (b1 < p->min_byte1 || b1 > p->max_byte1 ||
|
||||
b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2)
|
||||
Range_Error (index);
|
||||
b1 -= p->min_byte1;
|
||||
b2 -= p->min_char_or_byte2;
|
||||
i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2;
|
||||
}
|
||||
if (p->per_char)
|
||||
cp = p->per_char + i;
|
||||
}
|
||||
CI = *cp;
|
||||
return Record_To_Vector (Char_Info_Rec, Char_Info_Size,
|
||||
Sym_Char_Info, FONT(f)->dpy, ~0L);
|
||||
}
|
||||
|
||||
static Object P_Font_Properties (f) Object f; {
|
||||
register i, n;
|
||||
Object v, a, val, x;
|
||||
GC_Node4;
|
||||
|
||||
Check_Type (f, T_Font);
|
||||
n = FONT(f)->info->n_properties;
|
||||
v = Make_Vector (n, Null);
|
||||
a = val = Null;
|
||||
GC_Link4 (v, a, val, f);
|
||||
for (i = 0; i < n; i++) {
|
||||
register XFontProp *p = FONT(f)->info->properties+i;
|
||||
a = Make_Atom (p->name);
|
||||
val = Make_Unsigned_Long ((unsigned long)p->card32);
|
||||
x = Cons (a, val);
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
return v;
|
||||
}
|
||||
|
||||
static Object P_Font_Path (d) Object d; {
|
||||
Object v;
|
||||
int i, n;
|
||||
char **ret;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Disable_Interrupts;
|
||||
ret = XGetFontPath (DISPLAY(d)->dpy, &n);
|
||||
Enable_Interrupts;
|
||||
v = Make_Vector (n, Null);
|
||||
GC_Link (v);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object x;
|
||||
|
||||
x = Make_String (ret[i], strlen (ret[i]));
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
XFreeFontPath (ret);
|
||||
return P_Vector_To_List (v);
|
||||
}
|
||||
|
||||
static Object P_Set_Font_Path (d, p) Object d, p; {
|
||||
register char **path;
|
||||
register i, n;
|
||||
Object c;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Check_List (p);
|
||||
n = Fast_Length (p);
|
||||
Alloca (path, char**, n * sizeof (char *));
|
||||
for (i = 0; i < n; i++, p = Cdr (p)) {
|
||||
c = Car (p);
|
||||
Get_Strsym_Stack (c, path[i]);
|
||||
}
|
||||
XSetFontPath (DISPLAY(d)->dpy, path, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_font () {
|
||||
Define_Symbol (&Sym_Font_Info, "font-info");
|
||||
Define_Symbol (&Sym_Char_Info, "char-info");
|
||||
Define_Symbol (&Sym_Min, "min");
|
||||
Define_Symbol (&Sym_Max, "max");
|
||||
T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font),
|
||||
Font_Equal, Font_Equal, Font_Print, Font_Visit);
|
||||
Define_Primitive (P_Fontp, "font?", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL);
|
||||
Define_Primitive (P_Close_Font, "close-font", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Name, "font-name", 1, 1, EVAL);
|
||||
Define_Primitive (P_Gcontext_Font, "gcontext-font", 1, 1, EVAL);
|
||||
Define_Primitive (P_List_Font_Names, "list-font-names", 2, 2, EVAL);
|
||||
Define_Primitive (P_List_Fonts, "list-fonts", 2, 2, EVAL);
|
||||
Define_Primitive (P_Font_Info, "xlib-font-info", 1, 1, EVAL);
|
||||
Define_Primitive (P_Char_Info, "xlib-char-info", 2, 2, EVAL);
|
||||
Define_Primitive (P_Font_Properties, "font-properties", 1, 1, EVAL);
|
||||
Define_Primitive (P_Font_Path, "font-path", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Font_Path, "set-font-path!", 2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,162 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Sym_Gc;
|
||||
|
||||
Generic_Predicate (Gc)
|
||||
|
||||
Generic_Equal_Dpy (Gc, GCONTEXT, gc)
|
||||
|
||||
Generic_Print (Gc, "#[gcontext %lu]", GCONTEXT(x)->gc)
|
||||
|
||||
Generic_Get_Display (Gc, GCONTEXT)
|
||||
|
||||
Object Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
|
||||
Object gc;
|
||||
|
||||
if (g == None)
|
||||
return Sym_None;
|
||||
gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
|
||||
if (Nullp (gc)) {
|
||||
gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0);
|
||||
GCONTEXT(gc)->tag = Null;
|
||||
GCONTEXT(gc)->gc = g;
|
||||
GCONTEXT(gc)->dpy = dpy;
|
||||
GCONTEXT(gc)->free = 0;
|
||||
Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc :
|
||||
(PFO)0, 0);
|
||||
}
|
||||
return gc;
|
||||
}
|
||||
|
||||
static Object P_Create_Gc (w, g) Object w, g; {
|
||||
unsigned long mask;
|
||||
Display *dpy;
|
||||
Drawable dr;
|
||||
|
||||
dr = Get_Drawable (w, &dpy);
|
||||
mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
|
||||
return Make_Gc (1, dpy, XCreateGC (dpy, dr, mask, &GCV));
|
||||
}
|
||||
|
||||
static Object P_Copy_Gc (gc, w) Object gc, w; {
|
||||
GC dst;
|
||||
Display *dpy;
|
||||
Drawable dr;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
dr = Get_Drawable (w, &dpy);
|
||||
dst = XCreateGC (dpy, dr, 0L, &GCV);
|
||||
XCopyGC (dpy, GCONTEXT(gc)->gc, ~0L, dst);
|
||||
return Make_Gc (1, dpy, dst);
|
||||
}
|
||||
|
||||
static Object P_Change_Gc (gc, g) Object gc, g; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
|
||||
XChangeGC (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV);
|
||||
return Void;
|
||||
}
|
||||
|
||||
Object P_Free_Gc (g) Object g; {
|
||||
Check_Type (g, T_Gc);
|
||||
if (!GCONTEXT(g)->free)
|
||||
XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc);
|
||||
Deregister_Object (g);
|
||||
GCONTEXT(g)->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Query_Best_Size (d, w, h, shape) Object d, w, h, shape; {
|
||||
unsigned int rw, rh;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0,
|
||||
Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy),
|
||||
Get_Integer (w), Get_Integer (h), &rw, &rh))
|
||||
Primitive_Error ("cannot query best shape");
|
||||
return Cons (Make_Integer (rw), Make_Integer (rh));
|
||||
}
|
||||
|
||||
static Object P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord)
|
||||
Object gc, x, y, v, ord; {
|
||||
register XRectangle *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XRectangle*, n * sizeof (XRectangle));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object rect;
|
||||
|
||||
rect = VECTOR(v)->data[i];
|
||||
Check_Type (rect, T_Pair);
|
||||
if (Fast_Length (rect) != 4)
|
||||
Primitive_Error ("invalid rectangle: ~s", rect);
|
||||
p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].height = Get_Integer (Car (rect));
|
||||
}
|
||||
XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (x),
|
||||
Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms));
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Gcontext_Dashlist (gc, off, v) Object gc, off, v; {
|
||||
register char *p;
|
||||
register i, n, d;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, char*, n);
|
||||
for (i = 0; i < n; i++) {
|
||||
d = Get_Integer (VECTOR(v)->data[i]);
|
||||
if (d < 0 || d > 255)
|
||||
Range_Error (VECTOR(v)->data[i]);
|
||||
p[i] = d;
|
||||
}
|
||||
XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (off), p, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
#define ValidGCValuesBits \
|
||||
(GCFunction | GCPlaneMask | GCForeground | GCBackground | GCLineWidth |\
|
||||
GCLineStyle | GCCapStyle | GCJoinStyle | GCFillStyle | GCFillRule |\
|
||||
GCTile | GCStipple | GCTileStipXOrigin | GCTileStipYOrigin | GCFont |\
|
||||
GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\
|
||||
GCDashOffset | GCArcMode)
|
||||
|
||||
static Object P_Get_Gc_Values (gc) Object gc; {
|
||||
unsigned long mask = ValidGCValuesBits;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
if (!XGetGCValues (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV))
|
||||
Primitive_Error ("cannot get gcontext values");
|
||||
return Record_To_Vector (GC_Rec, GC_Size, Sym_Gc, GCONTEXT(gc)->dpy,
|
||||
mask);
|
||||
}
|
||||
|
||||
elk_init_xlib_gcontext () {
|
||||
Define_Symbol (&Sym_Gc, "gcontext");
|
||||
Generic_Define (Gc, "gcontext", "gcontext?");
|
||||
Define_Primitive (P_Gc_Display, "gcontext-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Create_Gc, "xlib-create-gcontext",2, 2, EVAL);
|
||||
Define_Primitive (P_Copy_Gc, "copy-gcontext", 2, 2, EVAL);
|
||||
Define_Primitive (P_Change_Gc, "xlib-change-gcontext",2, 2, EVAL);
|
||||
Define_Primitive (P_Free_Gc, "free-gcontext", 1, 1, EVAL);
|
||||
Define_Primitive (P_Query_Best_Size, "query-best-size", 4, 4, EVAL);
|
||||
Define_Primitive (P_Set_Gcontext_Clip_Rectangles,
|
||||
"set-gcontext-clip-rectangles!", 5, 5, EVAL);
|
||||
Define_Primitive (P_Set_Gcontext_Dashlist,
|
||||
"set-gcontext-dashlist!", 3, 3, EVAL);
|
||||
Define_Primitive (P_Get_Gc_Values,
|
||||
"xlib-get-gcontext-values", 1, 1, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,138 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Sym_Any;
|
||||
|
||||
Time Get_Time (time) Object time; {
|
||||
if (EQ(time, Sym_Now))
|
||||
return CurrentTime;
|
||||
return (Time)Get_Long (time);
|
||||
}
|
||||
|
||||
static Get_Mode (m) Object m; {
|
||||
Check_Type (m, T_Boolean);
|
||||
return EQ(m, True) ? GrabModeSync : GrabModeAsync;
|
||||
}
|
||||
|
||||
static Object P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to,
|
||||
cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to,
|
||||
cursor, time; {
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (ownerp, T_Boolean);
|
||||
return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy,
|
||||
WINDOW(win)->win,
|
||||
EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
|
||||
Get_Mode (psyncp), Get_Mode (ksyncp),
|
||||
Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)),
|
||||
0, Grabstatus_Syms);
|
||||
}
|
||||
|
||||
static Object P_Ungrab_Pointer (d, time) Object d, time; {
|
||||
Check_Type (d, T_Display);
|
||||
XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp,
|
||||
confine_to, cursor) Object win, button, mods, ownerp, events,
|
||||
psyncp, ksyncp, confine_to, cursor; {
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (ownerp, T_Boolean);
|
||||
XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
|
||||
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win,
|
||||
EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
|
||||
Get_Mode (psyncp), Get_Mode (ksyncp),
|
||||
Get_Window (confine_to), Get_Cursor (cursor));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Ungrab_Button (win, button, mods) Object win, button, mods; {
|
||||
Check_Type (win, T_Window);
|
||||
XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
|
||||
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Change_Active_Pointer_Grab (d, events, cursor, time)
|
||||
Object d, events, cursor, time; {
|
||||
Check_Type (d, T_Display);
|
||||
XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1,
|
||||
Event_Syms), Get_Cursor (cursor), Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) Object win,
|
||||
ownerp, psyncp, ksyncp, time; {
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (ownerp, T_Boolean);
|
||||
return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy,
|
||||
WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
|
||||
Get_Mode (ksyncp), Get_Time (time)),
|
||||
0, Grabstatus_Syms);
|
||||
}
|
||||
|
||||
static Object P_Ungrab_Keyboard (d, time) Object d, time; {
|
||||
Check_Type (d, T_Display);
|
||||
XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) Object win,
|
||||
key, mods, ownerp, psyncp, ksyncp; {
|
||||
int keycode = AnyKey;
|
||||
|
||||
Check_Type (win, T_Window);
|
||||
if (!EQ(key, Sym_Any))
|
||||
keycode = Get_Integer (key);
|
||||
Check_Type (ownerp, T_Boolean);
|
||||
XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms),
|
||||
WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
|
||||
Get_Mode (ksyncp));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Ungrab_Key (win, key, mods) Object win, key, mods; {
|
||||
int keycode = AnyKey;
|
||||
|
||||
Check_Type (win, T_Window);
|
||||
if (!EQ(key, Sym_Any))
|
||||
keycode = Get_Integer (key);
|
||||
XUngrabKey (WINDOW(win)->dpy, keycode,
|
||||
Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Allow_Events (d, mode, time) Object d, mode, time; {
|
||||
Check_Type (d, T_Display);
|
||||
XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0,
|
||||
Allow_Events_Syms), Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Grab_Server (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
XGrabServer (DISPLAY(d)->dpy);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Ungrab_Server (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
XUngrabServer (DISPLAY(d)->dpy);
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_grab () {
|
||||
Define_Primitive (P_Grab_Pointer, "grab-pointer", 8, 8, EVAL);
|
||||
Define_Primitive (P_Ungrab_Pointer, "ungrab-pointer", 2, 2, EVAL);
|
||||
Define_Primitive (P_Grab_Button, "grab-button", 9, 9, EVAL);
|
||||
Define_Primitive (P_Ungrab_Button, "ungrab-button", 3, 3, EVAL);
|
||||
Define_Primitive (P_Change_Active_Pointer_Grab,
|
||||
"change-active-pointer-grab", 4, 4, EVAL);
|
||||
Define_Primitive (P_Grab_Keyboard, "grab-keyboard", 5, 5, EVAL);
|
||||
Define_Primitive (P_Ungrab_Keyboard, "ungrab-keyboard", 2, 2, EVAL);
|
||||
Define_Primitive (P_Grab_Key, "grab-key", 6, 6, EVAL);
|
||||
Define_Primitive (P_Ungrab_Key, "ungrab-key", 3, 3, EVAL);
|
||||
Define_Primitive (P_Allow_Events, "allow-events", 3, 3, EVAL);
|
||||
Define_Primitive (P_Grab_Server, "grab-server", 1, 1, EVAL);
|
||||
Define_Primitive (P_Ungrab_Server, "ungrab-server", 1, 1, EVAL);
|
||||
Define_Symbol (&Sym_Any, "any");
|
||||
}
|
||||
|
|
@ -0,0 +1,267 @@
|
|||
#include "xlib.h"
|
||||
|
||||
extern XDrawPoints(), XDrawLines(), XDrawRectangle(), XFillRectangle();
|
||||
extern XDrawRectangles(), XFillRectangles(), XDrawArc(), XFillArc();
|
||||
extern XDrawArcs(), XFillArcs(), XFillPolygon();
|
||||
|
||||
static Object P_Clear_Area (win, x, y, w, h, e) Object win, x, y, w, h, e; {
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (e, T_Boolean);
|
||||
XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, Get_Integer (x),
|
||||
Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) Object src, gc,
|
||||
sx, sy, w, h, dst, dx, dy; {
|
||||
Display *dpy;
|
||||
Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
|
||||
Get_Integer (sy), Get_Integer (w), Get_Integer (h),
|
||||
Get_Integer (dx), Get_Integer (dy));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy)
|
||||
Object src, gc, plane, sx, sy, w, h, dst, dx, dy; {
|
||||
Display *dpy;
|
||||
Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
|
||||
register unsigned long p;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
p = (unsigned long)Get_Long (plane);
|
||||
if (p & (p-1))
|
||||
Primitive_Error ("invalid plane: ~s", plane);
|
||||
XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx),
|
||||
Get_Integer (sy), Get_Integer (w), Get_Integer (h),
|
||||
Get_Integer (dx), Get_Integer (dy), p);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Point (d, gc, x, y) Object d, gc, x, y; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object Internal_Draw_Points (d, gc, v, relative, func, shape)
|
||||
Object d, gc, v, relative, shape; int (*func)(); {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
register XPoint *p;
|
||||
register i, n;
|
||||
int rel, sh;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
Check_Type (relative, T_Boolean);
|
||||
rel = EQ(relative, True) ? CoordModePrevious : CoordModeOrigin;
|
||||
if (func == XFillPolygon)
|
||||
sh = Symbols_To_Bits (shape, 0, Polyshape_Syms);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XPoint*, n * sizeof (XPoint));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object point;
|
||||
|
||||
point = VECTOR(v)->data[i];
|
||||
Check_Type (point, T_Pair);
|
||||
p[i].x = Get_Integer (Car (point));
|
||||
p[i].y = Get_Integer (Cdr (point));
|
||||
}
|
||||
if (func == XFillPolygon)
|
||||
XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel);
|
||||
else
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Points (d, gc, v, relative) Object d, gc, v, relative; {
|
||||
return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, Null);
|
||||
}
|
||||
|
||||
static Object P_Draw_Line (d, gc, x1, y1, x2, y2)
|
||||
Object d, gc, x1, y1, x2, y2; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
XDrawLine (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x1), Get_Integer (y1),
|
||||
Get_Integer (x2), Get_Integer (y2));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Lines (d, gc, v, relative) Object d, gc, v, relative; {
|
||||
return Internal_Draw_Points (d, gc, v, relative, XDrawLines, Null);
|
||||
}
|
||||
|
||||
static Object P_Draw_Segments (d, gc, v) Object d, gc, v; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
register XSegment *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XSegment*, n * sizeof (XSegment));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object seg;
|
||||
|
||||
seg = VECTOR(v)->data[i];
|
||||
Check_Type (seg, T_Pair);
|
||||
if (Fast_Length (seg) != 4)
|
||||
Primitive_Error ("invalid segment: ~s", seg);
|
||||
p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg);
|
||||
p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg);
|
||||
p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg);
|
||||
p[i].y2 = Get_Integer (Car (seg));
|
||||
}
|
||||
XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object Internal_Draw_Rectangle (d, gc, x, y, w, h, func)
|
||||
Object d, gc, x, y, w, h; int (*func)(); {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
|
||||
Get_Integer (y), Get_Integer (w), Get_Integer (h));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
|
||||
return Internal_Draw_Rectangle (d, gc, x, y, w, h, XDrawRectangle);
|
||||
}
|
||||
|
||||
static Object P_Fill_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; {
|
||||
return Internal_Draw_Rectangle (d, gc, x, y, w, h, XFillRectangle);
|
||||
}
|
||||
|
||||
static Object Internal_Draw_Rectangles (d, gc, v, func)
|
||||
Object d, gc, v; int (*func)(); {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
register XRectangle *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XRectangle*, n * sizeof (XRectangle));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object rect;
|
||||
|
||||
rect = VECTOR(v)->data[i];
|
||||
Check_Type (rect, T_Pair);
|
||||
if (Fast_Length (rect) != 4)
|
||||
Primitive_Error ("invalid rectangle: ~s", rect);
|
||||
p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
|
||||
p[i].height = Get_Integer (Car (rect));
|
||||
}
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Rectangles (d, gc, v) Object d, gc, v; {
|
||||
return Internal_Draw_Rectangles (d, gc, v, XDrawRectangles);
|
||||
}
|
||||
|
||||
static Object P_Fill_Rectangles (d, gc, v) Object d, gc, v; {
|
||||
return Internal_Draw_Rectangles (d, gc, v, XFillRectangles);
|
||||
}
|
||||
|
||||
static Object Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func)
|
||||
Object d, gc, x, y, w, h, a1, a2; int (*func)(); {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
|
||||
Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Arc (d, gc, x, y, w, h, a1, a2)
|
||||
Object d, gc, x, y, w, h, a1, a2; {
|
||||
return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc);
|
||||
}
|
||||
|
||||
static Object P_Fill_Arc (d, gc, x, y, w, h, a1, a2)
|
||||
Object d, gc, x, y, w, h, a1, a2; {
|
||||
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;
|
||||
int (*func)(); {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
register XArc *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, XArc*, n * sizeof (XArc));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object arc;
|
||||
|
||||
arc = VECTOR(v)->data[i];
|
||||
Check_Type (arc, T_Pair);
|
||||
if (Fast_Length (arc) != 6)
|
||||
Primitive_Error ("invalid arc: ~s", arc);
|
||||
p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc);
|
||||
p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc);
|
||||
p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc);
|
||||
p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc);
|
||||
p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc);
|
||||
p[i].angle2 = Get_Integer (Car (arc));
|
||||
}
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Arcs (d, gc, v) Object d, gc, v; {
|
||||
return Internal_Draw_Arcs (d, gc, v, XDrawArcs);
|
||||
}
|
||||
|
||||
static Object P_Fill_Arcs (d, gc, v) Object d, gc, v; {
|
||||
return Internal_Draw_Arcs (d, gc, v, XFillArcs);
|
||||
}
|
||||
|
||||
static Object P_Fill_Polygon (d, gc, v, relative, shape)
|
||||
Object d, gc, v, relative, shape; {
|
||||
return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape);
|
||||
}
|
||||
|
||||
elk_init_xlib_graphics () {
|
||||
Define_Primitive (P_Clear_Area, "clear-area", 6, 6, EVAL);
|
||||
Define_Primitive (P_Copy_Area, "copy-area", 9, 9, EVAL);
|
||||
Define_Primitive (P_Copy_Plane, "copy-plane", 10,10, EVAL);
|
||||
Define_Primitive (P_Draw_Point, "draw-point", 4, 4, EVAL);
|
||||
Define_Primitive (P_Draw_Points, "draw-points", 4, 4, EVAL);
|
||||
Define_Primitive (P_Draw_Line, "draw-line", 6, 6, EVAL);
|
||||
Define_Primitive (P_Draw_Lines, "draw-lines", 4, 4, EVAL);
|
||||
Define_Primitive (P_Draw_Segments, "draw-segments", 3, 3, EVAL);
|
||||
Define_Primitive (P_Draw_Rectangle, "draw-rectangle", 6, 6, EVAL);
|
||||
Define_Primitive (P_Fill_Rectangle, "fill-rectangle", 6, 6, EVAL);
|
||||
Define_Primitive (P_Draw_Rectangles, "draw-rectangles", 3, 3, EVAL);
|
||||
Define_Primitive (P_Fill_Rectangles, "fill-rectangles", 3, 3, EVAL);
|
||||
Define_Primitive (P_Draw_Arc, "draw-arc", 8, 8, EVAL);
|
||||
Define_Primitive (P_Fill_Arc, "fill-arc", 8, 8, EVAL);
|
||||
Define_Primitive (P_Draw_Arcs, "draw-arcs", 3, 3, EVAL);
|
||||
Define_Primitive (P_Fill_Arcs, "fill-arcs", 3, 3, EVAL);
|
||||
Define_Primitive (P_Fill_Polygon, "fill-polygon", 5, 5, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object P_Xlib_Release_4_Or_Laterp () {
|
||||
return True;
|
||||
}
|
||||
|
||||
static Object P_Xlib_Release_5_Or_Laterp () {
|
||||
#ifdef XLIB_RELEASE_5_OR_LATER
|
||||
return True;
|
||||
#else
|
||||
return False;
|
||||
#endif
|
||||
}
|
||||
|
||||
static Object P_Xlib_Release_6_Or_Laterp () {
|
||||
#ifdef XLIB_RELEASE_6_OR_LATER
|
||||
return True;
|
||||
#else
|
||||
return False;
|
||||
#endif
|
||||
}
|
||||
|
||||
elk_init_xlib_init () {
|
||||
Define_Primitive (P_Xlib_Release_4_Or_Laterp,
|
||||
"xlib-release-4-or-later?", 0, 0, EVAL);
|
||||
Define_Primitive (P_Xlib_Release_5_Or_Laterp,
|
||||
"xlib-release-5-or-later?", 0, 0, EVAL);
|
||||
Define_Primitive (P_Xlib_Release_6_Or_Laterp,
|
||||
"xlib-release-6-or-later?", 0, 0, EVAL);
|
||||
P_Provide (Intern ("xlib.o"));
|
||||
}
|
||||
|
||||
#if defined(XLIB_RELEASE_5_OR_LATER) && (defined(sun) || defined(__sun__)) &&\
|
||||
defined(__svr4__)
|
||||
/*
|
||||
* Stub interface to dynamic linker routines
|
||||
* that SunOS uses but didn't ship with 4.1.
|
||||
*
|
||||
* The C library routine wcstombs in SunOS 4.1 tries to dynamically
|
||||
* load some routines using the dlsym interface, described in dlsym(3x).
|
||||
* Unfortunately SunOS 4.1 does not include the necessary library, libdl.
|
||||
*/
|
||||
|
||||
void *dlopen() { return 0; }
|
||||
|
||||
void *dlsym() { return 0; }
|
||||
|
||||
int dlclose() { return -1; }
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,159 @@
|
|||
#include "xlib.h"
|
||||
|
||||
#ifdef XLIB_RELEASE_5_OR_LATER
|
||||
|
||||
/* I don't know if XDisplayKeycodes() was already there in X11R4.
|
||||
*/
|
||||
static Object P_Display_Min_Keycode (d) Object d; {
|
||||
int mink, maxk;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
|
||||
return Make_Integer (mink);
|
||||
}
|
||||
|
||||
static Object P_Display_Max_Keycode (d) Object d; {
|
||||
int mink, maxk;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
|
||||
return Make_Integer (maxk);
|
||||
}
|
||||
|
||||
#else
|
||||
static Object P_Display_Min_Keycode (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DISPLAY(d)->dpy->min_keycode);
|
||||
}
|
||||
|
||||
static Object P_Display_Max_Keycode (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (DISPLAY(d)->dpy->max_keycode);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef XLIB_RELEASE_5_OR_LATER
|
||||
|
||||
/* I'm not sure if this works correctly in X11R4:
|
||||
*/
|
||||
static Object P_Display_Keysyms_Per_Keycode (d) Object d; {
|
||||
KeySym *ksyms;
|
||||
int mink, maxk, ksyms_per_kode;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk);
|
||||
ksyms = XGetKeyboardMapping(DISPLAY(d)->dpy, (KeyCode)mink,
|
||||
maxk - mink + 1, &ksyms_per_kode);
|
||||
return Make_Integer (ksyms_per_kode);
|
||||
}
|
||||
|
||||
#else
|
||||
static Object P_Display_Keysyms_Per_Keycode (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
/* Force initialization: */
|
||||
Disable_Interrupts;
|
||||
(void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0);
|
||||
Enable_Interrupts;
|
||||
return Make_Integer (DISPLAY(d)->dpy->keysyms_per_keycode);
|
||||
}
|
||||
#endif
|
||||
|
||||
static Object P_String_To_Keysym (s) Object s; {
|
||||
KeySym k;
|
||||
|
||||
k = XStringToKeysym (Get_Strsym (s));
|
||||
return k == NoSymbol ? False : Make_Unsigned_Long ((unsigned long)k);
|
||||
}
|
||||
|
||||
static Object P_Keysym_To_String (k) Object k; {
|
||||
register char *s;
|
||||
|
||||
s = XKeysymToString ((KeySym)Get_Long (k));
|
||||
return s ? Make_String (s, strlen (s)) : False;
|
||||
}
|
||||
|
||||
static Object P_Keycode_To_Keysym (d, k, index) Object d, k, index; {
|
||||
Object ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Disable_Interrupts;
|
||||
ret = Make_Unsigned_Long ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy,
|
||||
Get_Integer (k), Get_Integer (index)));
|
||||
Enable_Interrupts;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Keysym_To_Keycode (d, k) Object d, k; {
|
||||
Object ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Disable_Interrupts;
|
||||
ret = Make_Unsigned (XKeysymToKeycode (DISPLAY(d)->dpy,
|
||||
(KeySym)Get_Long (k)));
|
||||
Enable_Interrupts;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Lookup_String (d, k, mask) Object d, k, mask; {
|
||||
XKeyEvent e;
|
||||
char buf[1024];
|
||||
register len;
|
||||
KeySym keysym_return;
|
||||
XComposeStatus status_return;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
e.display = DISPLAY(d)->dpy;
|
||||
e.keycode = Get_Integer (k);
|
||||
e.state = Symbols_To_Bits (mask, 1, State_Syms);
|
||||
Disable_Interrupts;
|
||||
len = XLookupString (&e, buf, 1024, &keysym_return, &status_return);
|
||||
Enable_Interrupts;
|
||||
return Make_String (buf, len);
|
||||
}
|
||||
|
||||
static Object P_Rebind_Keysym (d, k, mods, str) Object d, k, mods, str; {
|
||||
KeySym *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (str, T_String);
|
||||
Check_Type (mods, T_Vector);
|
||||
n = VECTOR(mods)->size;
|
||||
Alloca (p, KeySym*, n * sizeof (KeySym));
|
||||
for (i = 0; i < n; i++)
|
||||
p[i] = (KeySym)Get_Long (VECTOR(mods)->data[i]);
|
||||
XRebindKeysym (DISPLAY(d)->dpy, (KeySym)Get_Long (k), p, n,
|
||||
(unsigned char *)STRING(str)->data, STRING(str)->size);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Refresh_Keyboard_Mapping (w, event) Object w, event; {
|
||||
static XMappingEvent fake;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
fake.type = MappingNotify;
|
||||
fake.display = WINDOW(w)->dpy;
|
||||
fake.window = WINDOW(w)->win;
|
||||
fake.request = Symbols_To_Bits (event, 0, Mapping_Syms);
|
||||
XRefreshKeyboardMapping (&fake);
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_key () {
|
||||
Define_Primitive (P_Display_Min_Keycode, "display-min-keycode",
|
||||
1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Max_Keycode, "display-max-keycode",
|
||||
1, 1, EVAL);
|
||||
Define_Primitive (P_Display_Keysyms_Per_Keycode,
|
||||
"display-keysyms-per-keycode", 1, 1, EVAL);
|
||||
Define_Primitive (P_String_To_Keysym, "string->keysym", 1, 1, EVAL);
|
||||
Define_Primitive (P_Keysym_To_String, "keysym->string", 1, 1, EVAL);
|
||||
Define_Primitive (P_Keycode_To_Keysym, "keycode->keysym", 3, 3, EVAL);
|
||||
Define_Primitive (P_Keysym_To_Keycode, "keysym->keycode", 2, 2, EVAL);
|
||||
Define_Primitive (P_Lookup_String, "lookup-string", 3, 3, EVAL);
|
||||
Define_Primitive (P_Rebind_Keysym, "rebind-keysym", 4, 4, EVAL);
|
||||
Define_Primitive (P_Refresh_Keyboard_Mapping,
|
||||
"refresh-keyboard-mapping", 2, 2, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
#include <varargs.h>
|
||||
|
||||
#include "xlib.h"
|
||||
|
||||
Object Sym_None;
|
||||
|
||||
int Match_X_Obj (x, v) Object x; va_list v; {
|
||||
register type = TYPE(x);
|
||||
|
||||
if (type == T_Display) {
|
||||
return 1;
|
||||
} else if (type == T_Gc) {
|
||||
return va_arg (v, GC) == GCONTEXT(x)->gc;
|
||||
} else if (type == T_Pixel) {
|
||||
return va_arg (v, unsigned long) == PIXEL(x)->pix;
|
||||
} else if (type == T_Pixmap) {
|
||||
return va_arg (v, Pixmap) == PIXMAP(x)->pm;
|
||||
} else if (type == T_Window) {
|
||||
return va_arg (v, Window) == WINDOW(x)->win;
|
||||
} else if (type == T_Font) {
|
||||
return va_arg (v, Font) == FONT(x)->id;
|
||||
} else if (type == T_Colormap) {
|
||||
return va_arg (v, Colormap) == COLORMAP(x)->cm;
|
||||
} else if (type == T_Color) {
|
||||
return va_arg (v, unsigned int) == COLOR(x)->c.red
|
||||
&& va_arg (v, unsigned int) == COLOR(x)->c.green
|
||||
&& va_arg (v, unsigned int) == COLOR(x)->c.blue;
|
||||
} else if (type == T_Cursor) {
|
||||
return va_arg (v, Cursor) == CURSOR(x)->cursor;
|
||||
} else if (type == T_Atom) {
|
||||
return va_arg (v, Atom) == ATOM(x)->atom;
|
||||
} else Panic ("Match_X_Obj");
|
||||
return 0;
|
||||
}
|
||||
|
||||
elk_init_xlib_objects () {
|
||||
Define_Symbol (&Sym_None, "none");
|
||||
}
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Generic_Predicate (Pixel)
|
||||
|
||||
Generic_Simple_Equal (Pixel, PIXEL, pix)
|
||||
|
||||
Generic_Print (Pixel, "#[pixel 0x%lx]", PIXEL(x)->pix)
|
||||
|
||||
Object Make_Pixel (val) unsigned long val; {
|
||||
Object pix;
|
||||
|
||||
pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val);
|
||||
if (Nullp (pix)) {
|
||||
pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0);
|
||||
PIXEL(pix)->tag = Null;
|
||||
PIXEL(pix)->pix = val;
|
||||
Register_Object (pix, (GENERIC)0, (PFO)0, 0);
|
||||
}
|
||||
return pix;
|
||||
}
|
||||
|
||||
unsigned long Get_Pixel (p) Object p; {
|
||||
Check_Type (p, T_Pixel);
|
||||
return PIXEL(p)->pix;
|
||||
}
|
||||
|
||||
static Object P_Pixel_Value (p) Object p; {
|
||||
return Make_Unsigned_Long (Get_Pixel (p));
|
||||
}
|
||||
|
||||
static Object P_Black_Pixel (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Pixel (BlackPixel (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
static Object P_White_Pixel (d) Object d; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Pixel (WhitePixel (DISPLAY(d)->dpy,
|
||||
DefaultScreen (DISPLAY(d)->dpy)));
|
||||
}
|
||||
|
||||
elk_init_xlib_pixel () {
|
||||
Generic_Define (Pixel, "pixel", "pixel?");
|
||||
Define_Primitive (P_Pixel_Value, "pixel-value", 1, 1, EVAL);
|
||||
Define_Primitive (P_Black_Pixel, "black-pixel", 1, 1, EVAL);
|
||||
Define_Primitive (P_White_Pixel, "white-pixel", 1, 1, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,148 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Generic_Predicate (Pixmap)
|
||||
|
||||
Generic_Equal_Dpy (Pixmap, PIXMAP, pm)
|
||||
|
||||
Generic_Print (Pixmap, "#[pixmap %lu]", PIXMAP(x)->pm)
|
||||
|
||||
Generic_Get_Display (Pixmap, PIXMAP)
|
||||
|
||||
static Object Internal_Make_Pixmap (finalize, dpy, pix)
|
||||
Display *dpy; Pixmap pix; {
|
||||
Object pm;
|
||||
|
||||
if (pix == None)
|
||||
return Sym_None;
|
||||
pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix);
|
||||
if (Nullp (pm)) {
|
||||
pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0);
|
||||
PIXMAP(pm)->tag = Null;
|
||||
PIXMAP(pm)->pm = pix;
|
||||
PIXMAP(pm)->dpy = dpy;
|
||||
PIXMAP(pm)->free = 0;
|
||||
Register_Object (pm, (GENERIC)dpy,
|
||||
finalize ? P_Free_Pixmap : (PFO)0, 0);
|
||||
}
|
||||
return pm;
|
||||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
Object Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; {
|
||||
return Internal_Make_Pixmap (1, dpy, pix);
|
||||
}
|
||||
|
||||
Object Make_Pixmap_Foreign (dpy, pix) Display *dpy; Pixmap pix; {
|
||||
return Internal_Make_Pixmap (0, dpy, pix);
|
||||
}
|
||||
|
||||
Pixmap Get_Pixmap (p) Object p; {
|
||||
Check_Type (p, T_Pixmap);
|
||||
return PIXMAP(p)->pm;
|
||||
}
|
||||
|
||||
Object P_Free_Pixmap (p) Object p; {
|
||||
Check_Type (p, T_Pixmap);
|
||||
if (!PIXMAP(p)->free)
|
||||
XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm);
|
||||
Deregister_Object (p);
|
||||
PIXMAP(p)->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Create_Pixmap (d, w, h, depth) Object d, w, h, depth; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w),
|
||||
Get_Integer (h), Get_Integer (depth)));
|
||||
}
|
||||
|
||||
static Object P_Create_Bitmap_From_Data (win, data, pw, ph)
|
||||
Object win, data, pw, ph; {
|
||||
register w, h;
|
||||
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (data, T_String);
|
||||
w = Get_Integer (pw);
|
||||
h = Get_Integer (ph);
|
||||
if (w * h > 8 * STRING(data)->size)
|
||||
Primitive_Error ("bitmap too small");
|
||||
return Make_Pixmap (WINDOW(win)->dpy,
|
||||
XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win,
|
||||
STRING(data)->data, w, h));
|
||||
}
|
||||
|
||||
static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg,
|
||||
depth) Object win, data, pw, ph, fg, bg, depth; {
|
||||
register w, h;
|
||||
|
||||
Check_Type (win, T_Window);
|
||||
Check_Type (data, T_String);
|
||||
w = Get_Integer (pw);
|
||||
h = Get_Integer (ph);
|
||||
if (w * h > 8 * STRING(data)->size)
|
||||
Primitive_Error ("bitmap too small");
|
||||
return Make_Pixmap (WINDOW(win)->dpy,
|
||||
XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win,
|
||||
STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg),
|
||||
Get_Integer (depth)));
|
||||
}
|
||||
|
||||
static Object P_Read_Bitmap_File (d, fn) Object d, fn; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
unsigned width, height;
|
||||
int r, xhot, yhot;
|
||||
Pixmap bitmap;
|
||||
Object t, ret, x;
|
||||
GC_Node2;
|
||||
|
||||
Disable_Interrupts;
|
||||
r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap,
|
||||
&xhot, &yhot);
|
||||
Enable_Interrupts;
|
||||
if (r != BitmapSuccess)
|
||||
return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms);
|
||||
t = ret = P_Make_List (Make_Integer (5), Null);
|
||||
GC_Link2 (ret, t);
|
||||
x = Make_Pixmap (dpy, bitmap);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
Car (t) = Make_Integer (width); t = Cdr (t);
|
||||
Car (t) = Make_Integer (height); t = Cdr (t);
|
||||
Car (t) = Make_Integer (xhot); t = Cdr (t);
|
||||
Car (t) = Make_Integer (yhot);
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Write_Bitmap_File (argc, argv) Object *argv; {
|
||||
Pixmap pm;
|
||||
int ret, xhot = -1, yhot = -1;
|
||||
|
||||
pm = Get_Pixmap (argv[1]);
|
||||
if (argc == 5)
|
||||
Primitive_Error ("both x-hot and y-hot must be specified");
|
||||
if (argc == 6) {
|
||||
xhot = Get_Integer (argv[4]);
|
||||
yhot = Get_Integer (argv[5]);
|
||||
}
|
||||
Disable_Interrupts;
|
||||
ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm,
|
||||
Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot);
|
||||
Enable_Interrupts;
|
||||
return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms);
|
||||
}
|
||||
|
||||
elk_init_xlib_pixmap () {
|
||||
Generic_Define (Pixmap, "pixmap", "pixmap?");
|
||||
Define_Primitive (P_Pixmap_Display, "pixmap-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Free_Pixmap, "free-pixmap", 1, 1, EVAL);
|
||||
Define_Primitive (P_Create_Pixmap, "create-pixmap", 4, 4, EVAL);
|
||||
Define_Primitive (P_Create_Bitmap_From_Data,
|
||||
"create-bitmap-from-data", 4, 4, EVAL);
|
||||
Define_Primitive (P_Create_Pixmap_From_Bitmap_Data,
|
||||
"create-pixmap-from-bitmap-data", 7, 7, EVAL);
|
||||
Define_Primitive (P_Read_Bitmap_File, "read-bitmap-file", 2, 2, EVAL);
|
||||
Define_Primitive (P_Write_Bitmap_File, "write-bitmap-file", 4, 6, VARARGS);
|
||||
}
|
||||
|
|
@ -0,0 +1,250 @@
|
|||
#include "xlib.h"
|
||||
|
||||
Object Sym_Now;
|
||||
|
||||
Generic_Predicate (Atom)
|
||||
|
||||
Generic_Simple_Equal (Atom, ATOM, atom)
|
||||
|
||||
Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom)
|
||||
|
||||
Object Make_Atom (a) Atom a; {
|
||||
Object atom;
|
||||
|
||||
if (a == None)
|
||||
return Sym_None;
|
||||
atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a);
|
||||
if (Nullp (atom)) {
|
||||
atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0);
|
||||
ATOM(atom)->tag = Null;
|
||||
ATOM(atom)->atom = a;
|
||||
Register_Object (atom, (GENERIC)0, (PFO)0, 0);
|
||||
}
|
||||
return atom;
|
||||
}
|
||||
|
||||
/* Should be used with care */
|
||||
static Object P_Make_Atom (n) Object n; {
|
||||
return Make_Atom ((Atom)Get_Long (n));
|
||||
}
|
||||
|
||||
static Object P_Intern_Atom (d, name) Object d, name; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 0));
|
||||
}
|
||||
|
||||
static Object P_Find_Atom (d, name) Object d, name; {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 1));
|
||||
}
|
||||
|
||||
static Object P_Atom_Name (d, a) Object d, a; {
|
||||
register char *s;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (a, T_Atom);
|
||||
Disable_Interrupts;
|
||||
s = XGetAtomName (DISPLAY(d)->dpy, ATOM(a)->atom);
|
||||
Enable_Interrupts;
|
||||
return Make_String (s, strlen (s));
|
||||
}
|
||||
|
||||
static Object P_List_Properties (w) Object w; {
|
||||
register i;
|
||||
int n;
|
||||
register Atom *ap;
|
||||
Object v;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Disable_Interrupts;
|
||||
ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n);
|
||||
Enable_Interrupts;
|
||||
v = Make_Vector (n, Null);
|
||||
GC_Link (v);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object x;
|
||||
|
||||
x = Make_Atom (ap[i]);
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
XFree ((char *)ap);
|
||||
return v;
|
||||
}
|
||||
|
||||
static Object P_Get_Property (w, prop, type, start, len, deletep)
|
||||
Object w, prop, type, start, len, deletep; {
|
||||
Atom req_type = AnyPropertyType, actual_type;
|
||||
int format;
|
||||
unsigned long nitems, bytes_left;
|
||||
unsigned char *data;
|
||||
Object ret, t, x;
|
||||
register i;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (prop, T_Atom);
|
||||
if (!EQ(type, False)) {
|
||||
Check_Type (type, T_Atom);
|
||||
req_type = ATOM(type)->atom;
|
||||
}
|
||||
Check_Type (deletep, T_Boolean);
|
||||
Disable_Interrupts;
|
||||
if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
|
||||
Get_Long (start), Get_Long (len),
|
||||
EQ(deletep, True), req_type, &actual_type, &format,
|
||||
&nitems, &bytes_left, &data) != Success)
|
||||
Primitive_Error ("cannot get property");
|
||||
Enable_Interrupts;
|
||||
ret = t = P_Make_List (Make_Integer (4), Null);
|
||||
GC_Link2 (ret, t);
|
||||
x = Make_Atom (actual_type);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
x = Make_Integer (format);
|
||||
Car (t) = x; t = Cdr (t);
|
||||
if (nitems) {
|
||||
if (format == 8) {
|
||||
Object s;
|
||||
x = Make_String ((char *)0, (int)nitems);
|
||||
s = Car (t) = x;
|
||||
bcopy ((char *)data, STRING(s)->data, (int)nitems);
|
||||
} else {
|
||||
Object v;
|
||||
GC_Node;
|
||||
/* Assumes short is 16 bits and int is 32 bits.
|
||||
*/
|
||||
v = Make_Vector ((int)nitems, Null);
|
||||
GC_Link (v);
|
||||
for (i = 0; i < nitems; i++) {
|
||||
x = Make_Unsigned (format == 16 ?
|
||||
*((short *)data + i) : *((int *)data + i));
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
Car (t) = v;
|
||||
GC_Unlink;
|
||||
}
|
||||
}
|
||||
t = Cdr (t);
|
||||
x = Make_Unsigned_Long (bytes_left);
|
||||
Car (t) = x;
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Change_Property (w, prop, type, format, mode, data)
|
||||
Object w, prop, type, format, mode, data; {
|
||||
register i, m, x, nitems, f;
|
||||
char *buf;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (prop, T_Atom);
|
||||
Check_Type (type, T_Atom);
|
||||
m = Symbols_To_Bits (mode, 0, Propmode_Syms);
|
||||
switch (f = Get_Integer (format)) {
|
||||
case 8:
|
||||
Check_Type (data, T_String);
|
||||
buf = STRING(data)->data;
|
||||
nitems = STRING(data)->size;
|
||||
break;
|
||||
case 16: case 32:
|
||||
Check_Type (data, T_Vector);
|
||||
nitems = VECTOR(data)->size;
|
||||
Alloca (buf, char*, nitems * (f / sizeof (char)));
|
||||
for (i = 0; i < nitems; i++) {
|
||||
x = Get_Integer (VECTOR(data)->data[i]);
|
||||
if (f == 16) {
|
||||
if (x > 65535)
|
||||
Primitive_Error ("format mismatch");
|
||||
*((short *)buf + i) = x; /* Assumes short is 16 bits */
|
||||
} else *((int *)buf + i) = x; /* and int is 32 bits. */
|
||||
}
|
||||
break;
|
||||
default:
|
||||
Primitive_Error ("invalid format: ~s", format);
|
||||
}
|
||||
XChangeProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
|
||||
ATOM(type)->atom, f, m, (unsigned char *)buf, nitems);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Delete_Property (w, prop) Object w, prop; {
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (prop, T_Atom);
|
||||
XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Rotate_Properties (w, v, delta) Object w, v, delta; {
|
||||
Atom *p;
|
||||
register i, n;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (v, T_Vector);
|
||||
n = VECTOR(v)->size;
|
||||
Alloca (p, Atom*, n * sizeof (Atom));
|
||||
for (i = 0; i < n; i++) {
|
||||
Object a;
|
||||
|
||||
a = VECTOR(v)->data[i];
|
||||
Check_Type (a, T_Atom);
|
||||
p[i] = ATOM(a)->atom;
|
||||
}
|
||||
XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n,
|
||||
Get_Integer (delta));
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner,
|
||||
time; {
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (s, T_Atom);
|
||||
XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner),
|
||||
Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Selection_Owner (d, s) Object d, s; {
|
||||
Check_Type (d, T_Display);
|
||||
Check_Type (s, T_Atom);
|
||||
return Make_Window (0, DISPLAY(d)->dpy,
|
||||
XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom));
|
||||
}
|
||||
|
||||
static Object P_Convert_Selection (s, target, prop, w, time)
|
||||
Object s, target, prop, w, time; {
|
||||
Atom p = None;
|
||||
|
||||
Check_Type (s, T_Atom);
|
||||
Check_Type (target, T_Atom);
|
||||
if (!EQ(prop, Sym_None)) {
|
||||
Check_Type (prop, T_Atom);
|
||||
p = ATOM(prop)->atom;
|
||||
}
|
||||
Check_Type (w, T_Window);
|
||||
XConvertSelection (WINDOW(w)->dpy, ATOM(s)->atom, ATOM(target)->atom,
|
||||
p, WINDOW(w)->win, Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_property () {
|
||||
Define_Symbol (&Sym_Now, "now");
|
||||
Generic_Define (Atom, "atom", "atom?");
|
||||
Define_Primitive (P_Make_Atom, "make-atom", 1, 1, EVAL);
|
||||
Define_Primitive (P_Intern_Atom, "intern-atom", 2, 2, EVAL);
|
||||
Define_Primitive (P_Find_Atom, "find-atom", 2, 2, EVAL);
|
||||
Define_Primitive (P_Atom_Name, "atom-name", 2, 2, EVAL);
|
||||
Define_Primitive (P_List_Properties, "list-properties", 1, 1, EVAL);
|
||||
Define_Primitive (P_Get_Property, "get-property", 6, 6, EVAL);
|
||||
Define_Primitive (P_Change_Property, "change-property", 6, 6, EVAL);
|
||||
Define_Primitive (P_Delete_Property, "delete-property", 2, 2, EVAL);
|
||||
Define_Primitive (P_Rotate_Properties, "rotate-properties", 3, 3, EVAL);
|
||||
Define_Primitive (P_Set_Selection_Owner, "set-selection-owner!",
|
||||
4, 4, EVAL);
|
||||
Define_Primitive (P_Selection_Owner, "selection-owner", 2, 2, EVAL);
|
||||
Define_Primitive (P_Convert_Selection, "convert-selection", 5, 5, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,180 @@
|
|||
#include "xlib.h"
|
||||
|
||||
extern XDrawText(), XDrawText16();
|
||||
static Object Sym_1byte, Sym_2byte;
|
||||
|
||||
static Two_Byte (format) Object format; {
|
||||
Check_Type (format, T_Symbol);
|
||||
if (EQ(format, Sym_1byte))
|
||||
return 0;
|
||||
else if (EQ(format, Sym_2byte))
|
||||
return 1;
|
||||
Primitive_Error ("index format must be '1-byte or '2-byte");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
static Get_1_Byte_Char (x) Object x; {
|
||||
register c = Get_Integer (x);
|
||||
if (c < 0 || c > 255)
|
||||
Range_Error (x);
|
||||
return c;
|
||||
}
|
||||
|
||||
static Get_2_Byte_Char (x) Object x; {
|
||||
register c = Get_Integer (x);
|
||||
if (c < 0 || c > 65535)
|
||||
Range_Error (x);
|
||||
return c;
|
||||
}
|
||||
|
||||
/* Calculation of text widths and extents should not be done using
|
||||
* the Xlib functions. For instance, the values returned by
|
||||
* XTextExtents() are only shorts and can therefore overflow for
|
||||
* long strings.
|
||||
*/
|
||||
|
||||
static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; {
|
||||
char *s;
|
||||
XChar2b *s2;
|
||||
XFontStruct *info;
|
||||
Object *data;
|
||||
register i, n;
|
||||
int dir, fasc, fdesc;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (font, T_Font);
|
||||
info = FONT(font)->info;
|
||||
Check_Type (t, T_Vector);
|
||||
n = VECTOR(t)->size;
|
||||
data = VECTOR(t)->data;
|
||||
if (Two_Byte (f)) {
|
||||
Alloca (s2, XChar2b*, n * sizeof (XChar2b));
|
||||
for (i = 0; i < n; i++) {
|
||||
register c = Get_2_Byte_Char (data[i]);
|
||||
s2[i].byte1 = (c >> 8) & 0xff;
|
||||
s2[i].byte2 = c & 0xff;
|
||||
}
|
||||
if (width)
|
||||
i = XTextWidth16 (info, s2, n);
|
||||
else
|
||||
XTextExtents16 (info, s2, n, &dir, &fasc, &fdesc, &CI);
|
||||
} else {
|
||||
Alloca (s, char*, n);
|
||||
for (i = 0; i < n; i++)
|
||||
s[i] = Get_1_Byte_Char (data[i]);
|
||||
if (width)
|
||||
i = XTextWidth (info, s, n);
|
||||
else
|
||||
XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI);
|
||||
}
|
||||
Alloca_End;
|
||||
return width ? Make_Integer (i) : Record_To_Vector (Char_Info_Rec,
|
||||
Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L);
|
||||
}
|
||||
|
||||
static Object P_Text_Width (font, t, f) Object font, t, f; {
|
||||
return Internal_Text_Metrics (font, t, f, 1);
|
||||
}
|
||||
|
||||
static Object P_Text_Extents (font, t, f) Object font, t, f; {
|
||||
return Internal_Text_Metrics (font, t, f, 0);
|
||||
}
|
||||
|
||||
static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
Object *data;
|
||||
register i, n;
|
||||
char *s;
|
||||
XChar2b *s2;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
Check_Type (t, T_Vector);
|
||||
n = VECTOR(t)->size;
|
||||
data = VECTOR(t)->data;
|
||||
if (Two_Byte (f)) {
|
||||
Alloca (s2, XChar2b*, n * sizeof (XChar2b));
|
||||
for (i = 0; i < n; i++) {
|
||||
register c = Get_2_Byte_Char (data[i]);
|
||||
s2[i].byte1 = (c >> 8) & 0xff;
|
||||
s2[i].byte2 = c & 0xff;
|
||||
}
|
||||
XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
|
||||
Get_Integer (y), s2, n);
|
||||
} else {
|
||||
Alloca (s, char*, n);
|
||||
for (i = 0; i < n; i++)
|
||||
s[i] = Get_1_Byte_Char (data[i]);
|
||||
XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x),
|
||||
Get_Integer (y), s, n);
|
||||
}
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
Object *data;
|
||||
register i, n, j, k;
|
||||
int twobyte, nitems;
|
||||
XTextItem *items;
|
||||
int (*func)();
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (gc, T_Gc);
|
||||
twobyte = Two_Byte (f);
|
||||
func = twobyte ? (int(*)())XDrawText16 : (int(*)())XDrawText;
|
||||
Check_Type (t, T_Vector);
|
||||
if ((n = VECTOR(t)->size) == 0)
|
||||
return Void;
|
||||
for (data = VECTOR(t)->data, i = 0, nitems = 1; i < n; i++)
|
||||
if (TYPE(data[i]) == T_Font) nitems++;
|
||||
Alloca (items, XTextItem*, nitems * sizeof (XTextItem));
|
||||
items[0].delta = 0;
|
||||
items[0].font = None;
|
||||
for (j = k = i = 0; i <= n; i++) {
|
||||
if (i == n || TYPE(data[i]) == T_Font) {
|
||||
items[j].nchars = i-k;
|
||||
if (twobyte) {
|
||||
register XChar2b *p;
|
||||
|
||||
Alloca (p, XChar2b*, (i-k) * sizeof (XChar2b));
|
||||
((XTextItem16 *)items)[j].chars = p;
|
||||
for ( ; k < i; k++, p++) {
|
||||
register c = Get_2_Byte_Char (data[k]);
|
||||
p->byte1 = (c >> 8) & 0xff;
|
||||
p->byte2 = c & 0xff;
|
||||
}
|
||||
} else {
|
||||
register char *p;
|
||||
|
||||
Alloca (p, char*, i-k);
|
||||
items[j].chars = p;
|
||||
for ( ; k < i; k++)
|
||||
*p++ = Get_1_Byte_Char (data[k]);
|
||||
}
|
||||
k++;
|
||||
j++;
|
||||
if (i < n) {
|
||||
items[j].delta = 0;
|
||||
Open_Font_Maybe (data[i]);
|
||||
items[j].font = FONT(data[i])->id;
|
||||
}
|
||||
}
|
||||
}
|
||||
(*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y),
|
||||
items, nitems);
|
||||
Alloca_End;
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xlib_text () {
|
||||
Define_Primitive (P_Text_Width, "text-width", 3, 3, EVAL);
|
||||
Define_Primitive (P_Text_Extents, "xlib-text-extents", 3, 3, EVAL);
|
||||
Define_Primitive (P_Draw_Image_Text, "draw-image-text", 6, 6, EVAL);
|
||||
Define_Primitive (P_Draw_Poly_Text, "draw-poly-text", 6, 6, EVAL);
|
||||
Define_Symbol (&Sym_1byte, "1-byte");
|
||||
Define_Symbol (&Sym_2byte, "2-byte");
|
||||
}
|
||||
|
|
@ -0,0 +1,803 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Set_Attr_Slots;
|
||||
static Object Conf_Slots;
|
||||
static Object GC_Slots;
|
||||
static Object Geometry_Slots;
|
||||
static Object Win_Attr_Slots;
|
||||
static Object Font_Info_Slots;
|
||||
static Object Char_Info_Slots;
|
||||
static Object Wm_Hints_Slots;
|
||||
static Object Size_Hints_Slots;
|
||||
|
||||
static Object Sym_Parent_Relative, Sym_Copy_From_Parent;
|
||||
|
||||
XSetWindowAttributes SWA;
|
||||
RECORD Set_Attr_Rec[] = {
|
||||
{ (char *)&SWA.background_pixmap, "background-pixmap", T_BACKGROUND,
|
||||
0, CWBackPixmap },
|
||||
{ (char *)&SWA.background_pixel, "background-pixel", T_PIXEL,
|
||||
0, CWBackPixel },
|
||||
{ (char *)&SWA.border_pixmap, "border-pixmap", T_BORDER,
|
||||
0, CWBorderPixmap },
|
||||
{ (char *)&SWA.border_pixel, "border-pixel", T_PIXEL,
|
||||
0, CWBorderPixel },
|
||||
{ (char *)&SWA.bit_gravity, "bit-gravity", T_SYM,
|
||||
Bit_Grav_Syms, CWBitGravity },
|
||||
{ (char *)&SWA.win_gravity, "gravity", T_SYM,
|
||||
Grav_Syms, CWWinGravity },
|
||||
{ (char *)&SWA.backing_store, "backing-store", T_SYM,
|
||||
Backing_Store_Syms, CWBackingStore },
|
||||
{ (char *)&SWA.backing_planes, "backing-planes", T_PIXEL,
|
||||
0, CWBackingPlanes },
|
||||
{ (char *)&SWA.backing_pixel, "backing-pixel", T_PIXEL,
|
||||
0, CWBackingPixel },
|
||||
{ (char *)&SWA.save_under, "save-under", T_BOOL,
|
||||
0, CWSaveUnder },
|
||||
{ (char *)&SWA.event_mask, "event-mask", T_MASK,
|
||||
Event_Syms, CWEventMask },
|
||||
{ (char *)&SWA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK,
|
||||
Event_Syms, CWDontPropagate },
|
||||
{ (char *)&SWA.override_redirect, "override-redirect", T_BOOL,
|
||||
0, CWOverrideRedirect },
|
||||
{ (char *)&SWA.colormap, "colormap", T_COLORMAP,
|
||||
0, CWColormap },
|
||||
{ (char *)&SWA.cursor, "cursor", T_CURSOR,
|
||||
0, CWCursor },
|
||||
{ 0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Set_Attr_Size = sizeof Set_Attr_Rec / sizeof (RECORD);
|
||||
|
||||
XWindowChanges WC;
|
||||
RECORD Conf_Rec[] = {
|
||||
{ (char *)&WC.x, "x", T_INT, 0, CWX },
|
||||
{ (char *)&WC.y, "y", T_INT, 0, CWY },
|
||||
{ (char *)&WC.width, "width", T_INT, 0, CWWidth },
|
||||
{ (char *)&WC.height, "height", T_INT, 0, CWHeight },
|
||||
{ (char *)&WC.border_width, "border-width", T_INT, 0, CWBorderWidth },
|
||||
{ (char *)&WC.sibling, "sibling", T_WINDOW, 0, CWSibling },
|
||||
{ (char *)&WC.stack_mode, "stack-mode", T_SYM, Stack_Mode_Syms,
|
||||
CWStackMode },
|
||||
{ 0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Conf_Size = sizeof Conf_Rec / sizeof (RECORD);
|
||||
|
||||
XGCValues GCV;
|
||||
RECORD GC_Rec[] = {
|
||||
{ (char *)&GCV.function, "function", T_SYM,
|
||||
Func_Syms, GCFunction },
|
||||
{ (char *)&GCV.plane_mask, "plane-mask", T_PIXEL,
|
||||
0, GCPlaneMask },
|
||||
{ (char *)&GCV.foreground, "foreground", T_PIXEL,
|
||||
0, GCForeground },
|
||||
{ (char *)&GCV.background, "background", T_PIXEL,
|
||||
0, GCBackground },
|
||||
{ (char *)&GCV.line_width, "line-width", T_INT,
|
||||
0, GCLineWidth },
|
||||
{ (char *)&GCV.line_style, "line-style", T_SYM,
|
||||
Line_Style_Syms, GCLineStyle },
|
||||
{ (char *)&GCV.cap_style, "cap-style", T_SYM,
|
||||
Cap_Style_Syms, GCCapStyle },
|
||||
{ (char *)&GCV.join_style, "join-style", T_SYM,
|
||||
Join_Style_Syms, GCJoinStyle },
|
||||
{ (char *)&GCV.fill_style, "fill-style", T_SYM,
|
||||
Fill_Style_Syms, GCFillStyle },
|
||||
{ (char *)&GCV.fill_rule, "fill-rule", T_SYM,
|
||||
Fill_Rule_Syms, GCFillRule },
|
||||
{ (char *)&GCV.arc_mode, "arc-mode", T_SYM,
|
||||
Arc_Mode_Syms, GCArcMode },
|
||||
{ (char *)&GCV.tile, "tile", T_PIXMAP,
|
||||
0, GCTile },
|
||||
{ (char *)&GCV.stipple, "stipple", T_PIXMAP,
|
||||
0, GCStipple },
|
||||
{ (char *)&GCV.ts_x_origin, "ts-x", T_INT,
|
||||
0, GCTileStipXOrigin },
|
||||
{ (char *)&GCV.ts_y_origin, "ts-y", T_INT,
|
||||
0, GCTileStipYOrigin },
|
||||
{ (char *)&GCV.font, "font", T_FONT,
|
||||
0, GCFont },
|
||||
{ (char *)&GCV.subwindow_mode, "subwindow-mode", T_SYM,
|
||||
Subwin_Mode_Syms, GCSubwindowMode },
|
||||
{ (char *)&GCV.graphics_exposures, "exposures", T_BOOL,
|
||||
0, GCGraphicsExposures },
|
||||
{ (char *)&GCV.clip_x_origin, "clip-x", T_INT,
|
||||
0, GCClipXOrigin },
|
||||
{ (char *)&GCV.clip_y_origin, "clip-y", T_INT,
|
||||
0, GCClipYOrigin },
|
||||
{ (char *)&GCV.clip_mask, "clip-mask", T_PIXMAP,
|
||||
0, GCClipMask },
|
||||
{ (char *)&GCV.dash_offset, "dash-offset", T_INT,
|
||||
0, GCDashOffset },
|
||||
{ (char *)&GCV.dashes, "dashes", T_CHAR,
|
||||
0, GCDashList },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int GC_Size = sizeof GC_Rec / sizeof (RECORD);
|
||||
|
||||
GEOMETRY GEO;
|
||||
RECORD Geometry_Rec[] = {
|
||||
{ (char *)&GEO.root, "root", T_WINDOW, 0, 0 },
|
||||
{ (char *)&GEO.x, "x", T_INT, 0, 0 },
|
||||
{ (char *)&GEO.y, "y", T_INT, 0, 0 },
|
||||
{ (char *)&GEO.width, "width", T_INT, 0, 0 },
|
||||
{ (char *)&GEO.height, "height", T_INT, 0, 0 },
|
||||
{ (char *)&GEO.border_width, "border-width", T_INT, 0, 0 },
|
||||
{ (char *)&GEO.depth, "depth", T_INT, 0, 0 },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Geometry_Size = sizeof Geometry_Rec / sizeof (RECORD);
|
||||
|
||||
XWindowAttributes WA;
|
||||
RECORD Win_Attr_Rec[] = {
|
||||
{ (char *)&WA.x, "x", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.y, "y", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.width, "width", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.height, "height", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.border_width, "border-width", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.depth, "depth", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&WA.visual, "visual", T_NONE,
|
||||
0, 0 },
|
||||
{ (char *)&WA.root, "root", T_WINDOW,
|
||||
0, 0 },
|
||||
#if defined(__cplusplus) || defined(c_plusplus)
|
||||
{ (char *)&WA.c_class, "class", T_SYM,
|
||||
#else
|
||||
{ (char *)&WA.class, "class", T_SYM,
|
||||
#endif
|
||||
Class_Syms, 0 },
|
||||
{ (char *)&WA.bit_gravity, "bit-gravity", T_SYM,
|
||||
Bit_Grav_Syms, 0 },
|
||||
{ (char *)&WA.win_gravity, "gravity", T_SYM,
|
||||
Grav_Syms, 0 },
|
||||
{ (char *)&WA.backing_store, "backing-store", T_SYM,
|
||||
Backing_Store_Syms, 0 },
|
||||
{ (char *)&WA.backing_planes, "backing-planes", T_PIXEL,
|
||||
0, 0 },
|
||||
{ (char *)&WA.backing_pixel, "backing-pixel", T_PIXEL,
|
||||
0, 0 },
|
||||
{ (char *)&WA.save_under, "save-under", T_BOOL,
|
||||
0, 0 },
|
||||
{ (char *)&WA.colormap , "colormap", T_COLORMAP,
|
||||
0, 0 },
|
||||
{ (char *)&WA.map_installed, "map-installed", T_BOOL,
|
||||
0, 0 },
|
||||
{ (char *)&WA.map_state, "map-state", T_SYM,
|
||||
Map_State_Syms, 0 },
|
||||
{ (char *)&WA.all_event_masks, "all-event-masks", T_MASK,
|
||||
Event_Syms, 0 },
|
||||
{ (char *)&WA.your_event_mask, "your-event-mask", T_MASK,
|
||||
Event_Syms, 0 },
|
||||
{ (char *)&WA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK,
|
||||
Event_Syms, 0 },
|
||||
{ (char *)&WA.override_redirect, "override-redirect", T_BOOL,
|
||||
0, 0 },
|
||||
{ (char *)&WA.screen, "screen", T_NONE,
|
||||
0, 0 },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Win_Attr_Size = sizeof Win_Attr_Rec / sizeof (RECORD);
|
||||
|
||||
XFontStruct FI;
|
||||
RECORD Font_Info_Rec[] = {
|
||||
{ (char *)&FI.direction, "direction", T_SYM,
|
||||
Direction_Syms, 0 },
|
||||
{ (char *)&FI.min_char_or_byte2, "min-byte2", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.max_char_or_byte2, "max-byte2", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.min_byte1, "min-byte1", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.max_byte1, "max-byte1", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.all_chars_exist, "all-chars-exist?", T_BOOL,
|
||||
0, 0 },
|
||||
{ (char *)&FI.default_char, "default-char", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.ascent, "ascent", T_INT,
|
||||
0, 0 },
|
||||
{ (char *)&FI.descent, "descent", T_INT,
|
||||
0, 0 },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Font_Info_Size = sizeof Font_Info_Rec / sizeof (RECORD);
|
||||
|
||||
XCharStruct CI;
|
||||
RECORD Char_Info_Rec[] = {
|
||||
{ (char *)&CI.lbearing, "lbearing", T_SHORT, 0, 0 },
|
||||
{ (char *)&CI.rbearing, "rbearing", T_SHORT, 0, 0 },
|
||||
{ (char *)&CI.width, "width", T_SHORT, 0, 0 },
|
||||
{ (char *)&CI.ascent, "ascent", T_SHORT, 0, 0 },
|
||||
{ (char *)&CI.descent, "descent", T_SHORT, 0, 0 },
|
||||
{ (char *)&CI.attributes, "attributes", T_SHORT, 0, 0 },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Char_Info_Size = sizeof Char_Info_Rec / sizeof (RECORD);
|
||||
|
||||
XWMHints WMH;
|
||||
RECORD Wm_Hints_Rec[] = {
|
||||
{ (char *)&WMH.input, "input?", T_BOOL,
|
||||
0, InputHint },
|
||||
{ (char *)&WMH.initial_state, "initial-state", T_SYM,
|
||||
Initial_State_Syms, StateHint },
|
||||
{ (char *)&WMH.icon_pixmap, "icon-pixmap", T_PIXMAP,
|
||||
0, IconPixmapHint },
|
||||
{ (char *)&WMH.icon_window, "icon-window", T_WINDOW,
|
||||
0, IconWindowHint },
|
||||
{ (char *)&WMH.icon_x, "icon-x", T_INT,
|
||||
0, IconPositionHint },
|
||||
{ (char *)&WMH.icon_y, "icon-y", T_INT,
|
||||
0, IconPositionHint },
|
||||
{ (char *)&WMH.icon_mask, "icon-mask", T_PIXMAP,
|
||||
0, IconMaskHint },
|
||||
{ (char *)&WMH.window_group, "window-group", T_WINDOW,
|
||||
0, WindowGroupHint },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Wm_Hints_Size = sizeof Wm_Hints_Rec / sizeof (RECORD);
|
||||
|
||||
XSizeHints SZH;
|
||||
RECORD Size_Hints_Rec[] = {
|
||||
{ (char *)&SZH.x, "x", T_INT, 0, PPosition },
|
||||
{ (char *)&SZH.y, "y", T_INT, 0, PPosition },
|
||||
{ (char *)&SZH.width, "width", T_INT, 0, PSize },
|
||||
{ (char *)&SZH.height, "height", T_INT, 0, PSize },
|
||||
{ (char *)&SZH.x, "x", T_INT, 0, USPosition },
|
||||
{ (char *)&SZH.y, "y", T_INT, 0, USPosition },
|
||||
{ (char *)&SZH.width, "width", T_INT, 0, USSize },
|
||||
{ (char *)&SZH.height, "height", T_INT, 0, USSize },
|
||||
{ (char *)&SZH.min_width, "min-width", T_INT, 0, PMinSize },
|
||||
{ (char *)&SZH.min_height, "min-height", T_INT, 0, PMinSize },
|
||||
{ (char *)&SZH.max_width, "max-width", T_INT, 0, PMaxSize },
|
||||
{ (char *)&SZH.max_height, "max-height", T_INT, 0, PMaxSize },
|
||||
{ (char *)&SZH.width_inc, "width-inc", T_INT, 0, PResizeInc },
|
||||
{ (char *)&SZH.height_inc, "height-inc", T_INT, 0, PResizeInc },
|
||||
{ (char *)&SZH.min_aspect.x, "min-aspect-x", T_INT, 0, PAspect },
|
||||
{ (char *)&SZH.min_aspect.y, "min-aspect-y", T_INT, 0, PAspect },
|
||||
{ (char *)&SZH.max_aspect.x, "max-aspect-x", T_INT, 0, PAspect },
|
||||
{ (char *)&SZH.max_aspect.y, "max-aspect-y", T_INT, 0, PAspect },
|
||||
{ (char *)&SZH.base_width, "base-width", T_INT, 0, PBaseSize },
|
||||
{ (char *)&SZH.base_height, "base-height", T_INT, 0, PBaseSize },
|
||||
{ (char *)&SZH.win_gravity, "gravity", T_SYM, Grav_Syms,
|
||||
PWinGravity },
|
||||
{0, 0, T_NONE, 0, 0 }
|
||||
};
|
||||
int Size_Hints_Size = sizeof Size_Hints_Rec / sizeof (RECORD);
|
||||
|
||||
unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym;
|
||||
register RECORD *rp; {
|
||||
register Object *p;
|
||||
unsigned long mask = 0;
|
||||
|
||||
Check_Type (v, T_Vector);
|
||||
p = VECTOR(v)->data;
|
||||
if (VECTOR(v)->size != len && !EQ(p[0], sym))
|
||||
Primitive_Error ("invalid argument");
|
||||
for ( ; rp->slot; rp++) {
|
||||
++p;
|
||||
if (rp->type == T_NONE || Nullp (*p))
|
||||
continue;
|
||||
switch (rp->type) {
|
||||
case T_INT:
|
||||
*(int *)rp->slot = Get_Integer (*p); break;
|
||||
case T_SHORT:
|
||||
*(short *)rp->slot = Get_Integer (*p); break;
|
||||
case T_CHAR:
|
||||
*(char *)rp->slot = Get_Integer (*p); break;
|
||||
case T_PIXEL:
|
||||
*(unsigned long *)rp->slot = Get_Pixel (*p); break;
|
||||
case T_BACKGROUND:
|
||||
if (EQ(*p, Sym_None))
|
||||
*(Pixmap *)rp->slot = None;
|
||||
else if (EQ(*p, Sym_Parent_Relative))
|
||||
*(Pixmap *)rp->slot = ParentRelative;
|
||||
else
|
||||
*(Pixmap *)rp->slot = Get_Pixmap (*p);
|
||||
break;
|
||||
case T_BORDER:
|
||||
if (EQ(*p, Sym_Copy_From_Parent)) {
|
||||
*(Pixmap *)rp->slot = CopyFromParent;
|
||||
break;
|
||||
}
|
||||
/* fall through */
|
||||
case T_PIXMAP:
|
||||
*(Pixmap *)rp->slot = Get_Pixmap (*p); break;
|
||||
case T_BOOL:
|
||||
Check_Type (*p, T_Boolean);
|
||||
*(Bool *)rp->slot = (Bool)(FIXNUM(*p));
|
||||
break;
|
||||
case T_FONT:
|
||||
*(Font *)rp->slot = Get_Font (*p);
|
||||
break;
|
||||
case T_COLORMAP:
|
||||
*(Colormap *)rp->slot = Get_Colormap (*p); break;
|
||||
case T_CURSOR:
|
||||
*(Cursor *)rp->slot = Get_Cursor (*p);
|
||||
break;
|
||||
case T_WINDOW:
|
||||
break;
|
||||
case T_MASK:
|
||||
*(long *)rp->slot = Symbols_To_Bits (*p, 1, rp->syms);
|
||||
break;
|
||||
case T_SYM:
|
||||
*(int *)rp->slot = (int)Symbols_To_Bits (*p, 0, rp->syms);
|
||||
break;
|
||||
default:
|
||||
Panic ("vector->record");
|
||||
}
|
||||
mask |= rp->mask;
|
||||
}
|
||||
return mask;
|
||||
}
|
||||
|
||||
Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym;
|
||||
register RECORD *rp; Display *dpy; unsigned long flags; {
|
||||
register i;
|
||||
Object v, x;
|
||||
GC_Node2;
|
||||
|
||||
v = Null;
|
||||
GC_Link2 (sym, v);
|
||||
v = Make_Vector (len, Null);
|
||||
VECTOR(v)->data[0] = sym;
|
||||
for (i = 1; rp->slot; i++, rp++) {
|
||||
if (rp->type == T_NONE)
|
||||
continue;
|
||||
if (rp->mask && !(flags & rp->mask))
|
||||
continue;
|
||||
x = Null;
|
||||
switch (rp->type) {
|
||||
case T_INT:
|
||||
x = Make_Integer (*(int *)rp->slot); break;
|
||||
case T_SHORT:
|
||||
x = Make_Integer (*(short *)rp->slot); break;
|
||||
case T_CHAR:
|
||||
x = Make_Integer (*(char *)rp->slot); break;
|
||||
case T_PIXEL:
|
||||
x = Make_Pixel (*(unsigned long *)rp->slot); break;
|
||||
case T_PIXMAP:
|
||||
if (*(unsigned long *)rp->slot == ~0L)
|
||||
x = Sym_None;
|
||||
else
|
||||
x = Make_Pixmap_Foreign (dpy, *(Pixmap *)rp->slot);
|
||||
break;
|
||||
case T_FONT:
|
||||
if (*(unsigned long *)rp->slot == ~0L)
|
||||
x = Sym_None;
|
||||
else {
|
||||
register XFontStruct *info;
|
||||
Disable_Interrupts;
|
||||
info = XQueryFont (dpy, *(Font *)rp->slot);
|
||||
Enable_Interrupts;
|
||||
x = Make_Font_Foreign (dpy, False, *(Font *)rp->slot, info);
|
||||
}
|
||||
break;
|
||||
case T_BOOL:
|
||||
x = *(Bool *)rp->slot ? True : False; break;
|
||||
case T_COLORMAP:
|
||||
x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break;
|
||||
case T_WINDOW:
|
||||
x = Make_Window (0, dpy, *(Window *)rp->slot); break;
|
||||
case T_MASK:
|
||||
x = Bits_To_Symbols (*(long *)rp->slot, 1, rp->syms);
|
||||
break;
|
||||
case T_SYM:
|
||||
x = Bits_To_Symbols ((unsigned long)*(int *)rp->slot, 0, rp->syms);
|
||||
break;
|
||||
default:
|
||||
Panic ("record->vector");
|
||||
}
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
GC_Unlink;
|
||||
return v;
|
||||
}
|
||||
|
||||
SYMDESCR Func_Syms[] = {
|
||||
{ "clear", GXclear },
|
||||
{ "and", GXand },
|
||||
{ "and-reverse", GXandReverse },
|
||||
{ "copy", GXcopy },
|
||||
{ "and-inverted", GXandInverted },
|
||||
{ "no-op", GXnoop },
|
||||
{ "xor", GXxor },
|
||||
{ "or", GXor },
|
||||
{ "nor", GXnor },
|
||||
{ "equiv", GXequiv },
|
||||
{ "invert", GXinvert },
|
||||
{ "or-reverse", GXorReverse },
|
||||
{ "copy-inverted", GXcopyInverted },
|
||||
{ "or-inverted", GXorInverted },
|
||||
{ "nand", GXnand },
|
||||
{ "set", GXset },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Bit_Grav_Syms[] = {
|
||||
{ "forget", ForgetGravity },
|
||||
{ "north-west", NorthWestGravity },
|
||||
{ "north", NorthGravity },
|
||||
{ "north-east", NorthEastGravity },
|
||||
{ "west", WestGravity },
|
||||
{ "center", CenterGravity },
|
||||
{ "east", EastGravity },
|
||||
{ "south-west", SouthWestGravity },
|
||||
{ "south", SouthGravity },
|
||||
{ "south-east", SouthEastGravity },
|
||||
{ "static", StaticGravity },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Grav_Syms[] = {
|
||||
{ "unmap", UnmapGravity },
|
||||
{ "north-west", NorthWestGravity },
|
||||
{ "north", NorthGravity },
|
||||
{ "north-east", NorthEastGravity },
|
||||
{ "west", WestGravity },
|
||||
{ "center", CenterGravity },
|
||||
{ "east", EastGravity },
|
||||
{ "south-west", SouthWestGravity },
|
||||
{ "south", SouthGravity },
|
||||
{ "south-east", SouthEastGravity },
|
||||
{ "static", StaticGravity },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Backing_Store_Syms[] = {
|
||||
{ "not-useful", NotUseful },
|
||||
{ "when-mapped", WhenMapped },
|
||||
{ "always", Always },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Stack_Mode_Syms[] = {
|
||||
{ "above", Above },
|
||||
{ "below", Below },
|
||||
{ "top-if", TopIf },
|
||||
{ "bottom-if", BottomIf },
|
||||
{ "opposite", Opposite },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Line_Style_Syms[] = {
|
||||
{ "solid", LineSolid },
|
||||
{ "dash", LineOnOffDash },
|
||||
{ "double-dash", LineDoubleDash },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Cap_Style_Syms[] = {
|
||||
{ "not-last", CapNotLast },
|
||||
{ "butt", CapButt },
|
||||
{ "round", CapRound },
|
||||
{ "projecting", CapProjecting },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Join_Style_Syms[] = {
|
||||
{ "miter", JoinMiter },
|
||||
{ "round", JoinRound },
|
||||
{ "bevel", JoinBevel },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Fill_Style_Syms[] = {
|
||||
{ "solid", FillSolid },
|
||||
{ "tiled", FillTiled },
|
||||
{ "stippled", FillStippled },
|
||||
{ "opaque-stippled", FillOpaqueStippled },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Fill_Rule_Syms[] = {
|
||||
{ "even-odd", EvenOddRule },
|
||||
{ "winding", WindingRule },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Arc_Mode_Syms[] = {
|
||||
{ "chord", ArcChord },
|
||||
{ "pie-slice", ArcPieSlice },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Subwin_Mode_Syms[] = {
|
||||
{ "clip-by-children", ClipByChildren },
|
||||
{ "include-inferiors", IncludeInferiors },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Class_Syms[] = {
|
||||
{ "input-output", InputOutput },
|
||||
{ "input-only", InputOnly },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Map_State_Syms[] = {
|
||||
{ "unmapped", IsUnmapped },
|
||||
{ "unviewable", IsUnviewable },
|
||||
{ "viewable", IsViewable },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR State_Syms[] = {
|
||||
{ "shift", ShiftMask },
|
||||
{ "lock", LockMask },
|
||||
{ "control", ControlMask },
|
||||
{ "mod1", Mod1Mask },
|
||||
{ "mod2", Mod2Mask },
|
||||
{ "mod3", Mod3Mask },
|
||||
{ "mod4", Mod4Mask },
|
||||
{ "mod5", Mod5Mask },
|
||||
{ "button1", Button1Mask },
|
||||
{ "button2", Button2Mask },
|
||||
{ "button3", Button3Mask },
|
||||
{ "button4", Button4Mask },
|
||||
{ "button5", Button5Mask },
|
||||
{ "any-modifier", AnyModifier },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Button_Syms[] = {
|
||||
{ "any-button", AnyButton },
|
||||
{ "button1", Button1 },
|
||||
{ "button2", Button2 },
|
||||
{ "button3", Button3 },
|
||||
{ "button4", Button4 },
|
||||
{ "button5", Button5 },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Cross_Mode_Syms[] = {
|
||||
{ "normal", NotifyNormal },
|
||||
{ "grab", NotifyGrab },
|
||||
{ "ungrab", NotifyUngrab },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Cross_Detail_Syms[] = {
|
||||
{ "ancestor", NotifyAncestor },
|
||||
{ "virtual", NotifyVirtual },
|
||||
{ "inferior", NotifyInferior },
|
||||
{ "nonlinear", NotifyNonlinear },
|
||||
{ "nonlinear-virtual", NotifyNonlinearVirtual },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Focus_Detail_Syms[] = {
|
||||
{ "ancestor", NotifyAncestor },
|
||||
{ "virtual", NotifyVirtual },
|
||||
{ "inferior", NotifyInferior },
|
||||
{ "nonlinear", NotifyNonlinear },
|
||||
{ "nonlinear-virtual", NotifyNonlinearVirtual },
|
||||
{ "pointer", NotifyPointer },
|
||||
{ "pointer-root", NotifyPointerRoot },
|
||||
{ "none", NotifyDetailNone },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Visibility_Syms[] = {
|
||||
{ "unobscured", VisibilityUnobscured },
|
||||
{ "partially-obscured", VisibilityPartiallyObscured },
|
||||
{ "fully-obscured", VisibilityFullyObscured },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Place_Syms[] = {
|
||||
{ "top", PlaceOnTop },
|
||||
{ "bottom", PlaceOnBottom },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Prop_Syms[] = {
|
||||
{ "new-value", PropertyNewValue },
|
||||
{ "deleted", PropertyDelete },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Mapping_Syms[] = {
|
||||
{ "modifier", MappingModifier },
|
||||
{ "keyboard", MappingKeyboard },
|
||||
{ "pointer", MappingPointer },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Direction_Syms[] = {
|
||||
{ "left-to-right", FontLeftToRight },
|
||||
{ "right-to-left", FontRightToLeft },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Polyshape_Syms[] = {
|
||||
{ "complex", Complex },
|
||||
{ "non-convex", Nonconvex },
|
||||
{ "convex", Convex },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Propmode_Syms[] = {
|
||||
{ "replace", PropModeReplace },
|
||||
{ "prepend", PropModePrepend },
|
||||
{ "append", PropModeAppend },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Grabstatus_Syms[] = {
|
||||
{ "success", Success },
|
||||
{ "not-viewable", GrabNotViewable },
|
||||
{ "already-grabbed", AlreadyGrabbed },
|
||||
{ "frozen", GrabFrozen },
|
||||
{ "invalid-time", GrabInvalidTime },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Bitmapstatus_Syms[] = {
|
||||
{ "success", BitmapSuccess },
|
||||
{ "open-failed", BitmapOpenFailed },
|
||||
{ "file-invalid", BitmapFileInvalid },
|
||||
{ "no-memory", BitmapNoMemory },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Circulate_Syms[] = {
|
||||
{ "raise-lowest", RaiseLowest },
|
||||
{ "lower-highest", LowerHighest },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Allow_Events_Syms[] = {
|
||||
{ "async-pointer", AsyncPointer },
|
||||
{ "sync-pointer", SyncPointer },
|
||||
{ "replay-pointer", ReplayPointer },
|
||||
{ "async-keyboard", AsyncKeyboard },
|
||||
{ "sync-keyboard", SyncKeyboard },
|
||||
{ "replay-keyboard", ReplayKeyboard },
|
||||
{ "async-both", AsyncBoth },
|
||||
{ "sync-both", SyncBoth },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Revert_Syms[] = {
|
||||
{ "none", RevertToNone },
|
||||
{ "pointer-root", RevertToPointerRoot },
|
||||
{ "parent", RevertToParent },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Shape_Syms[] = {
|
||||
{ "cursor", CursorShape },
|
||||
{ "tile", TileShape },
|
||||
{ "stipple", StippleShape },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Initial_State_Syms[] = {
|
||||
{ "dont-care", DontCareState },
|
||||
{ "normal", NormalState },
|
||||
{ "zoom", ZoomState },
|
||||
{ "iconic", IconicState },
|
||||
{ "inactive", InactiveState },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Ordering_Syms[] = {
|
||||
{ "unsorted", Unsorted },
|
||||
{ "y-sorted", YSorted },
|
||||
{ "yx-sorted", YXSorted },
|
||||
{ "yx-banded", YXBanded },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Byte_Order_Syms[] = {
|
||||
{ "lsb-first", LSBFirst },
|
||||
{ "msb-first", MSBFirst },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Saveset_Syms[] = {
|
||||
{ "insert", SetModeInsert },
|
||||
{ "delete", SetModeDelete },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Closemode_Syms[] = {
|
||||
{ "destroy-all", DestroyAll },
|
||||
{ "retain-permanent", RetainPermanent },
|
||||
{ "retain-temporary", RetainTemporary },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Event_Syms[] = {
|
||||
{ "key-press", KeyPressMask },
|
||||
{ "key-release", KeyReleaseMask },
|
||||
{ "button-press", ButtonPressMask },
|
||||
{ "button-release", ButtonReleaseMask },
|
||||
{ "enter-window", EnterWindowMask },
|
||||
{ "leave-window", LeaveWindowMask },
|
||||
{ "pointer-motion", PointerMotionMask },
|
||||
{ "pointer-motion-hint", PointerMotionHintMask },
|
||||
{ "button-1-motion", Button1MotionMask },
|
||||
{ "button-2-motion", Button2MotionMask },
|
||||
{ "button-3-motion", Button3MotionMask },
|
||||
{ "button-4-motion", Button4MotionMask },
|
||||
{ "button-5-motion", Button5MotionMask },
|
||||
{ "button-motion", ButtonMotionMask },
|
||||
{ "keymap-state", KeymapStateMask },
|
||||
{ "exposure", ExposureMask },
|
||||
{ "visibility-change", VisibilityChangeMask },
|
||||
{ "structure-notify", StructureNotifyMask },
|
||||
{ "resize-redirect", ResizeRedirectMask },
|
||||
{ "substructure-notify", SubstructureNotifyMask },
|
||||
{ "substructure-redirect", SubstructureRedirectMask },
|
||||
{ "focus-change", FocusChangeMask },
|
||||
{ "property-change", PropertyChangeMask },
|
||||
{ "colormap-change", ColormapChangeMask },
|
||||
{ "owner-grab-button", OwnerGrabButtonMask },
|
||||
{ "all-events", ~(unsigned long)0 },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
SYMDESCR Error_Syms[] = {
|
||||
{ "bad-request", BadRequest },
|
||||
{ "bad-value", BadValue },
|
||||
{ "bad-window", BadWindow },
|
||||
{ "bad-pixmap", BadPixmap },
|
||||
{ "bad-atom", BadAtom },
|
||||
{ "bad-cursor", BadCursor },
|
||||
{ "bad-font", BadFont },
|
||||
{ "bad-match", BadMatch },
|
||||
{ "bad-drawable", BadDrawable },
|
||||
{ "bad-access", BadAccess },
|
||||
{ "bad-alloc", BadAlloc },
|
||||
{ "bad-color", BadColor },
|
||||
{ "bad-gcontext", BadGC },
|
||||
{ "bad-id-choice", BadIDChoice },
|
||||
{ "bad-name", BadName },
|
||||
{ "bad-length", BadLength },
|
||||
{ "bad-implementation", BadImplementation },
|
||||
{ 0, 0 }
|
||||
};
|
||||
|
||||
static Init_Record (rec, size, name, var) RECORD *rec; char *name;
|
||||
Object *var; {
|
||||
Object list, tail, cell;
|
||||
register i;
|
||||
char buf[128];
|
||||
GC_Node2;
|
||||
|
||||
GC_Link2 (list, tail);
|
||||
for (list = tail = Null, i = 1; i < size; tail = cell, i++, rec++) {
|
||||
cell = Intern (rec->name);
|
||||
cell = Cons (cell, Make_Integer (i));
|
||||
cell = Cons (cell, Null);
|
||||
if (Nullp (list))
|
||||
list = cell;
|
||||
else
|
||||
P_Set_Cdr (tail, cell);
|
||||
}
|
||||
sprintf (buf, "%s-slots", name);
|
||||
Define_Variable (var, buf, list);
|
||||
GC_Unlink;
|
||||
}
|
||||
|
||||
elk_init_xlib_type () {
|
||||
Init_Record (Set_Attr_Rec, Set_Attr_Size, "set-window-attributes",
|
||||
&Set_Attr_Slots);
|
||||
Init_Record (Conf_Rec, Conf_Size, "window-configuration", &Conf_Slots);
|
||||
Init_Record (GC_Rec, GC_Size, "gcontext", &GC_Slots);
|
||||
Init_Record (Geometry_Rec, Geometry_Size, "geometry", &Geometry_Slots);
|
||||
Init_Record (Win_Attr_Rec, Win_Attr_Size, "get-window-attributes",
|
||||
&Win_Attr_Slots);
|
||||
Init_Record (Font_Info_Rec, Font_Info_Size, "font-info", &Font_Info_Slots);
|
||||
Init_Record (Char_Info_Rec, Char_Info_Size, "char-info", &Char_Info_Slots);
|
||||
Init_Record (Wm_Hints_Rec, Wm_Hints_Size, "wm-hints", &Wm_Hints_Slots);
|
||||
Init_Record (Size_Hints_Rec, Size_Hints_Size, "size-hints",
|
||||
&Size_Hints_Slots);
|
||||
Define_Symbol (&Sym_Parent_Relative, "parent-relative");
|
||||
Define_Symbol (&Sym_Copy_From_Parent, "copy-from-parent");
|
||||
}
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object P_Get_Default (d, program, option) Object d, program, option; {
|
||||
register char *ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (ret = XGetDefault (DISPLAY(d)->dpy, Get_Strsym (program),
|
||||
Get_Strsym (option)))
|
||||
return Make_String (ret, strlen (ret));
|
||||
return False;
|
||||
}
|
||||
|
||||
static Object P_Resource_Manager_String (d) Object d; {
|
||||
register char *ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
ret = XResourceManagerString (DISPLAY(d)->dpy);
|
||||
return ret ? Make_String (ret, strlen (ret)) : False;
|
||||
}
|
||||
|
||||
static Object P_Parse_Geometry (string) Object string; {
|
||||
Object ret, t;
|
||||
register mask;
|
||||
int x, y;
|
||||
unsigned w, h;
|
||||
|
||||
mask = XParseGeometry (Get_Strsym (string), &x, &y, &w, &h);
|
||||
t = ret = P_Make_List (Make_Integer (6), False);
|
||||
if (mask & XNegative) Car (t) = True; t = Cdr (t);
|
||||
if (mask & YNegative) Car (t) = True; t = Cdr (t);
|
||||
if (mask & XValue) Car (t) = Make_Integer (x); t = Cdr (t);
|
||||
if (mask & YValue) Car (t) = Make_Integer (y); t = Cdr (t);
|
||||
if (mask & WidthValue) Car (t) = Make_Unsigned (w); t = Cdr (t);
|
||||
if (mask & HeightValue) Car (t) = Make_Unsigned (h);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Parse_Color (d, cmap, spec) Object d, cmap, spec; {
|
||||
XColor ret;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (XParseColor (DISPLAY(d)->dpy, Get_Colormap (cmap), Get_Strsym (spec),
|
||||
&ret))
|
||||
return Make_Color (ret.red, ret.green, ret.blue);
|
||||
return False;
|
||||
}
|
||||
|
||||
elk_init_xlib_util () {
|
||||
Define_Primitive (P_Get_Default, "get-default", 3, 3, EVAL);
|
||||
Define_Primitive (P_Resource_Manager_String,
|
||||
"resource-manager-string", 1, 1, EVAL);
|
||||
Define_Primitive (P_Parse_Geometry, "parse-geometry", 1, 1, EVAL);
|
||||
Define_Primitive (P_Parse_Color, "parse-color", 3, 3, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,262 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
|
||||
Object Sym_Conf;
|
||||
|
||||
Generic_Predicate (Window)
|
||||
|
||||
Generic_Equal_Dpy (Window, WINDOW, win)
|
||||
|
||||
Generic_Print (Window, "#[window %lu]", WINDOW(x)->win)
|
||||
|
||||
Generic_Get_Display (Window, WINDOW)
|
||||
|
||||
Object Make_Window (finalize, dpy, win) Display *dpy; Window win; {
|
||||
Object w;
|
||||
|
||||
if (win == None)
|
||||
return Sym_None;
|
||||
if (win == PointerRoot)
|
||||
return Intern ("pointer-root");
|
||||
w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
|
||||
if (Nullp (w)) {
|
||||
w = Alloc_Object (sizeof (struct S_Window), T_Window, 0);
|
||||
WINDOW(w)->tag = Null;
|
||||
WINDOW(w)->win = win;
|
||||
WINDOW(w)->dpy = dpy;
|
||||
WINDOW(w)->free = 0;
|
||||
WINDOW(w)->finalize = finalize;
|
||||
Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window :
|
||||
(PFO)0, 0);
|
||||
}
|
||||
return w;
|
||||
}
|
||||
|
||||
Window Get_Window (w) Object w; {
|
||||
if (EQ(w, Sym_None))
|
||||
return None;
|
||||
Check_Type (w, T_Window);
|
||||
return WINDOW(w)->win;
|
||||
}
|
||||
|
||||
Drawable Get_Drawable (d, dpyp) Object d; Display **dpyp; {
|
||||
if (TYPE(d) == T_Window) {
|
||||
*dpyp = WINDOW(d)->dpy;
|
||||
return (Drawable)WINDOW(d)->win;
|
||||
} else if (TYPE(d) == T_Pixmap) {
|
||||
*dpyp = PIXMAP(d)->dpy;
|
||||
return (Drawable)PIXMAP(d)->pm;
|
||||
}
|
||||
Wrong_Type_Combination (d, "drawable");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
static Object P_Create_Window (parent, x, y, width, height, border_width, attr)
|
||||
Object parent, x, y, width, height, border_width, attr; {
|
||||
unsigned long mask;
|
||||
Window win;
|
||||
|
||||
Check_Type (parent, T_Window);
|
||||
mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
|
||||
if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
|
||||
Get_Integer (x), Get_Integer (y), Get_Integer (width),
|
||||
Get_Integer (height), Get_Integer (border_width),
|
||||
CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
|
||||
Primitive_Error ("cannot create window");
|
||||
return Make_Window (1, WINDOW(parent)->dpy, win);
|
||||
}
|
||||
|
||||
static Object P_Configure_Window (w, conf) Object w, conf; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
|
||||
XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Change_Window_Attributes (w, attr) Object w, attr; {
|
||||
unsigned long mask;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
|
||||
XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Get_Window_Attributes (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
|
||||
return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
|
||||
WINDOW(w)->dpy, ~0L);
|
||||
}
|
||||
|
||||
static Object P_Get_Geometry (d) Object d; {
|
||||
Display *dpy;
|
||||
Drawable dr = Get_Drawable (d, &dpy);
|
||||
|
||||
/* GEO.width, GEO.height, etc. should really be unsigned, not int.
|
||||
*/
|
||||
XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width,
|
||||
(unsigned *)&GEO.height, (unsigned *)&GEO.border_width,
|
||||
(unsigned *)&GEO.depth);
|
||||
return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
|
||||
}
|
||||
|
||||
static Object P_Map_Window (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Unmap_Window (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
Object P_Destroy_Window (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
if (!WINDOW(w)->free)
|
||||
XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
Deregister_Object (w);
|
||||
WINDOW(w)->free = 1;
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Destroy_Subwindows (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Map_Subwindows (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Unmap_Subwindows (w) Object w; {
|
||||
Check_Type (w, T_Window);
|
||||
XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Circulate_Subwindows (w, dir) Object w, dir; {
|
||||
Check_Type (w, T_Window);
|
||||
XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win,
|
||||
Symbols_To_Bits (dir, 0, Circulate_Syms));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Query_Tree (w) Object w; {
|
||||
Window root, parent, *children;
|
||||
Display *dpy;
|
||||
int i;
|
||||
unsigned n;
|
||||
Object v, ret;
|
||||
GC_Node2;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
dpy = WINDOW(w)->dpy;
|
||||
Disable_Interrupts;
|
||||
XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
|
||||
Enable_Interrupts;
|
||||
v = ret = Null;
|
||||
GC_Link2 (v, ret);
|
||||
v = Make_Window (0, dpy, root);
|
||||
ret = Cons (v, Null);
|
||||
v = Make_Window (0, dpy, parent);
|
||||
ret = Cons (v, ret);
|
||||
v = Make_Vector (n, Null);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object x;
|
||||
|
||||
x = Make_Window (0, dpy, children[i]);
|
||||
VECTOR(v)->data[i] = x;
|
||||
}
|
||||
ret = Cons (v, ret);
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Translate_Coordinates (src, x, y, dst) Object src, x, y, dst; {
|
||||
int rx, ry;
|
||||
Window child;
|
||||
Object l, t, z;
|
||||
GC_Node3;
|
||||
|
||||
Check_Type (src, T_Window);
|
||||
Check_Type (dst, T_Window);
|
||||
if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win,
|
||||
WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry,
|
||||
&child))
|
||||
return False;
|
||||
l = t = P_Make_List (Make_Integer (3), Null);
|
||||
GC_Link3 (l, t, dst);
|
||||
Car (t) = Make_Integer (rx); t = Cdr (t);
|
||||
Car (t) = Make_Integer (ry), t = Cdr (t);
|
||||
z = Make_Window (0, WINDOW(dst)->dpy, child);
|
||||
Car (t) = z;
|
||||
GC_Unlink;
|
||||
return l;
|
||||
}
|
||||
|
||||
static Object P_Query_Pointer (win) Object win; {
|
||||
Object l, t, z;
|
||||
Bool ret;
|
||||
Window root, child;
|
||||
int r_x, r_y, x, y;
|
||||
unsigned int mask;
|
||||
GC_Node3;
|
||||
|
||||
Check_Type (win, T_Window);
|
||||
ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child,
|
||||
&r_x, &r_y, &x, &y, &mask);
|
||||
t = l = P_Make_List (Make_Integer (8), Null);
|
||||
GC_Link3 (l, t, win);
|
||||
Car (t) = Make_Integer (x); t = Cdr (t);
|
||||
Car (t) = Make_Integer (y); t = Cdr (t);
|
||||
Car (t) = ret ? True : False; t = Cdr (t);
|
||||
z = Make_Window (0, WINDOW(win)->dpy, root);
|
||||
Car (t) = z; t = Cdr (t);
|
||||
Car (t) = Make_Integer (r_x); t = Cdr (t);
|
||||
Car (t) = Make_Integer (r_y); t = Cdr (t);
|
||||
z = Make_Window (0, WINDOW(win)->dpy, child);
|
||||
Car (t) = z; t = Cdr (t);
|
||||
z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
|
||||
Car (t) = z;
|
||||
GC_Unlink;
|
||||
return l;
|
||||
}
|
||||
|
||||
elk_init_xlib_window () {
|
||||
Define_Symbol (&Sym_Set_Attr, "set-window-attributes");
|
||||
Define_Symbol (&Sym_Get_Attr, "get-window-attributes");
|
||||
Define_Symbol (&Sym_Conf, "window-configuration");
|
||||
Define_Symbol (&Sym_Geo, "geometry");
|
||||
Generic_Define (Window, "window", "window?");
|
||||
Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL);
|
||||
Define_Primitive (P_Create_Window,
|
||||
"xlib-create-window", 7, 7, EVAL);
|
||||
Define_Primitive (P_Configure_Window,
|
||||
"xlib-configure-window", 2, 2, EVAL);
|
||||
Define_Primitive (P_Change_Window_Attributes,
|
||||
"xlib-change-window-attributes", 2, 2, EVAL);
|
||||
Define_Primitive (P_Get_Window_Attributes,
|
||||
"xlib-get-window-attributes", 1, 1, EVAL);
|
||||
Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL);
|
||||
Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL);
|
||||
Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL);
|
||||
Define_Primitive (P_Circulate_Subwindows,
|
||||
"circulate-subwindows", 2, 2, EVAL);
|
||||
Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL);
|
||||
Define_Primitive (P_Destroy_Subwindows,
|
||||
"destroy-subwindows", 1, 1, EVAL);
|
||||
Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL);
|
||||
Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL);
|
||||
Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL);
|
||||
Define_Primitive (P_Translate_Coordinates,
|
||||
"translate-coordinates", 4, 4, EVAL);
|
||||
Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL);
|
||||
}
|
||||
|
|
@ -0,0 +1,172 @@
|
|||
#include "xlib.h"
|
||||
|
||||
static Object Sym_Pointer_Root;
|
||||
|
||||
static Object P_Reparent_Window (w, parent, x, y) Object w, parent, x, y; {
|
||||
Check_Type (w, T_Window);
|
||||
Check_Type (parent, T_Window);
|
||||
XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win,
|
||||
Get_Integer (x), Get_Integer (y));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Install_Colormap (c) Object c; {
|
||||
Check_Type (c, T_Colormap);
|
||||
XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Uninstall_Colormap (c) Object c; {
|
||||
Check_Type (c, T_Colormap);
|
||||
XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_List_Installed_Colormaps (w) Object w; {
|
||||
int i, n;
|
||||
Colormap *ret;
|
||||
Object v;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (w, T_Window);
|
||||
ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n);
|
||||
v = Make_Vector (n, Null);
|
||||
GC_Link (v);
|
||||
for (i = 0; i < n; i++) {
|
||||
Object c;
|
||||
|
||||
c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]);
|
||||
VECTOR(v)->data[i] = c;
|
||||
}
|
||||
XFree ((char *)ret);
|
||||
GC_Unlink;
|
||||
return v;
|
||||
}
|
||||
|
||||
static Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win,
|
||||
revert_to, time; {
|
||||
Window focus = PointerRoot;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
if (!EQ(win, Sym_Pointer_Root))
|
||||
focus = Get_Window (win);
|
||||
XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0,
|
||||
Revert_Syms), Get_Time (time));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Input_Focus (d) Object d; {
|
||||
Window win;
|
||||
int revert_to;
|
||||
Object ret, x;
|
||||
GC_Node;
|
||||
|
||||
Check_Type (d, T_Display);
|
||||
XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to);
|
||||
ret = Cons (Null, Null);
|
||||
GC_Link (ret);
|
||||
x = Make_Window (0, DISPLAY(d)->dpy, win);
|
||||
Car (ret) = x;
|
||||
x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms);
|
||||
Cdr (ret) = x;
|
||||
GC_Unlink;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
|
||||
srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
|
||||
Check_Type (dpy, T_Display);
|
||||
XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
|
||||
Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw),
|
||||
Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Bell (argc, argv) Object *argv; {
|
||||
register percent = 0;
|
||||
|
||||
Check_Type (argv[0], T_Display);
|
||||
if (argc == 2) {
|
||||
percent = Get_Integer (argv[1]);
|
||||
if (percent < -100 || percent > 100)
|
||||
Range_Error (argv[1]);
|
||||
}
|
||||
XBell (DISPLAY(argv[0])->dpy, percent);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Access_Control (dpy, on) Object dpy, on; {
|
||||
Check_Type (dpy, T_Display);
|
||||
Check_Type (on, T_Boolean);
|
||||
XSetAccessControl (DISPLAY(dpy)->dpy, EQ(on, True));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Change_Save_Set (win, mode) Object win, mode; {
|
||||
Check_Type (win, T_Window);
|
||||
XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win,
|
||||
Symbols_To_Bits (mode, 0, Saveset_Syms));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Close_Down_Mode (dpy, mode) Object dpy, mode; {
|
||||
Check_Type (dpy, T_Display);
|
||||
XSetCloseDownMode (DISPLAY(dpy)->dpy,
|
||||
Symbols_To_Bits (mode, 0, Closemode_Syms));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Get_Pointer_Mapping (dpy) Object dpy; {
|
||||
unsigned char map[256];
|
||||
register i, n;
|
||||
Object ret;
|
||||
|
||||
Check_Type (dpy, T_Display);
|
||||
n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256);
|
||||
ret = Make_Vector (n, Null);
|
||||
for (i = 0; i < n; i++)
|
||||
VECTOR(ret)->data[i] = Make_Integer (map[i]);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Set_Pointer_Mapping (dpy, map) Object dpy, map; {
|
||||
register i, n;
|
||||
register unsigned char *p;
|
||||
Object ret;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Type (dpy, T_Display);
|
||||
Check_Type (map, T_Vector);
|
||||
n = VECTOR(map)->size;
|
||||
Alloca (p, unsigned char*, n);
|
||||
for (i = 0; i < n; i++)
|
||||
p[i] = Get_Integer (VECTOR(map)->data[i]);
|
||||
ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ?
|
||||
True : False;
|
||||
Alloca_End;
|
||||
return ret;
|
||||
}
|
||||
|
||||
elk_init_xlib_wm () {
|
||||
Define_Primitive (P_Reparent_Window, "reparent-window", 4, 4, EVAL);
|
||||
Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL);
|
||||
Define_Primitive (P_Uninstall_Colormap,
|
||||
"uninstall-colormap", 1, 1, EVAL);
|
||||
Define_Primitive (P_List_Installed_Colormaps,
|
||||
"list-installed-colormaps", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Input_Focus, "set-input-focus", 4, 4, EVAL);
|
||||
Define_Primitive (P_Input_Focus, "input-focus", 1, 1, EVAL);
|
||||
Define_Primitive (P_General_Warp_Pointer,
|
||||
"general-warp-pointer", 9, 9, EVAL);
|
||||
Define_Primitive (P_Bell, "bell", 1, 2, VARARGS);
|
||||
Define_Primitive (P_Set_Access_Control,
|
||||
"set-access-control", 2, 2, EVAL);
|
||||
Define_Primitive (P_Change_Save_Set, "change-save-set", 2, 2, EVAL);
|
||||
Define_Primitive (P_Set_Close_Down_Mode,
|
||||
"set-close-down-mode", 2, 2, EVAL);
|
||||
Define_Primitive (P_Get_Pointer_Mapping,
|
||||
"get-pointer-mapping", 1, 1, EVAL);
|
||||
Define_Primitive (P_Set_Pointer_Mapping,
|
||||
"set-pointer-mapping", 2, 2, EVAL);
|
||||
Define_Symbol(&Sym_Pointer_Root, "pointer-root");
|
||||
}
|
||||
|
|
@ -0,0 +1,287 @@
|
|||
#include <X11/X.h>
|
||||
#include <X11/Xlib.h>
|
||||
#include <X11/Xutil.h>
|
||||
|
||||
#undef True
|
||||
#undef False
|
||||
|
||||
#ifndef NeedFunctionPrototypes /* Kludge */
|
||||
#error "X11 Release 3 (or earlier) no longer supported"
|
||||
#endif
|
||||
|
||||
#if XlibSpecificationRelease >= 5
|
||||
# define XLIB_RELEASE_5_OR_LATER
|
||||
#endif
|
||||
|
||||
#if XlibSpecificationRelease >= 6
|
||||
# define XLIB_RELEASE_6_OR_LATER
|
||||
#endif
|
||||
|
||||
#include "scheme.h"
|
||||
|
||||
extern int T_Display;
|
||||
extern int T_Gc;
|
||||
extern int T_Pixel;
|
||||
extern int T_Pixmap;
|
||||
extern int T_Window;
|
||||
extern int T_Font;
|
||||
extern int T_Colormap;
|
||||
extern int T_Color;
|
||||
extern int T_Cursor;
|
||||
extern int T_Atom;
|
||||
|
||||
#define DISPLAY(x) ((struct S_Display *)POINTER(x))
|
||||
#define GCONTEXT(x) ((struct S_Gc *)POINTER(x))
|
||||
#define PIXEL(x) ((struct S_Pixel *)POINTER(x))
|
||||
#define PIXMAP(x) ((struct S_Pixmap *)POINTER(x))
|
||||
#define WINDOW(x) ((struct S_Window *)POINTER(x))
|
||||
#define FONT(x) ((struct S_Font *)POINTER(x))
|
||||
#define COLORMAP(x) ((struct S_Colormap *)POINTER(x))
|
||||
#define COLOR(x) ((struct S_Color *)POINTER(x))
|
||||
#define CURSOR(x) ((struct S_Cursor *)POINTER(x))
|
||||
#define ATOM(x) ((struct S_Atom *)POINTER(x))
|
||||
|
||||
struct S_Display {
|
||||
Object after;
|
||||
Display *dpy;
|
||||
char free;
|
||||
};
|
||||
|
||||
struct S_Gc {
|
||||
Object tag;
|
||||
GC gc;
|
||||
Display *dpy;
|
||||
char free;
|
||||
};
|
||||
|
||||
struct S_Pixel {
|
||||
Object tag;
|
||||
unsigned long pix;
|
||||
};
|
||||
|
||||
struct S_Pixmap {
|
||||
Object tag;
|
||||
Pixmap pm;
|
||||
Display *dpy;
|
||||
char free;
|
||||
};
|
||||
|
||||
struct S_Window {
|
||||
Object tag;
|
||||
Window win;
|
||||
Display *dpy;
|
||||
char free;
|
||||
char finalize;
|
||||
};
|
||||
|
||||
struct S_Font {
|
||||
Object name;
|
||||
Font id;
|
||||
XFontStruct *info;
|
||||
Display *dpy;
|
||||
};
|
||||
|
||||
struct S_Colormap {
|
||||
Object tag;
|
||||
Colormap cm;
|
||||
Display *dpy;
|
||||
char free;
|
||||
};
|
||||
|
||||
struct S_Color {
|
||||
Object tag;
|
||||
XColor c;
|
||||
};
|
||||
|
||||
struct S_Cursor {
|
||||
Object tag;
|
||||
Cursor cursor;
|
||||
Display *dpy;
|
||||
char free;
|
||||
};
|
||||
|
||||
struct S_Atom {
|
||||
Object tag;
|
||||
Atom atom;
|
||||
};
|
||||
|
||||
enum Type {
|
||||
T_NONE,
|
||||
T_INT, T_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
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
char *slot;
|
||||
char *name;
|
||||
enum Type type;
|
||||
SYMDESCR *syms;
|
||||
int mask;
|
||||
} RECORD;
|
||||
|
||||
typedef struct {
|
||||
Window root;
|
||||
int x, y, width, height, border_width, depth;
|
||||
} GEOMETRY;
|
||||
|
||||
C_LINKAGE_BEGIN
|
||||
|
||||
extern Colormap Get_Colormap P_((Object));
|
||||
extern Cursor Get_Cursor P_((Object));
|
||||
extern Drawable Get_Drawable P_((Object, Display**));
|
||||
extern Font Get_Font P_((Object));
|
||||
extern int Get_Screen_Number P_((Display*, Object));
|
||||
extern Object Get_Event_Args P_((XEvent*));
|
||||
extern Pixmap Get_Pixmap P_((Object));
|
||||
extern Time Get_Time P_((Object));
|
||||
extern Window Get_Window P_((Object));
|
||||
extern XColor *Get_Color P_((Object));
|
||||
extern unsigned long Get_Pixel P_((Object));
|
||||
extern void Destroy_Event_Args P_((Object));
|
||||
extern int Encode_Event P_((Object));
|
||||
extern int Match_X_Obj P_((ELLIPSIS));
|
||||
extern void Open_Font_Maybe P_((Object));
|
||||
extern Object Make_Atom P_((Atom));
|
||||
extern Object Make_Color P_((unsigned int, unsigned int, unsigned int));
|
||||
extern Object Make_Colormap P_((int, Display*, Colormap));
|
||||
extern Object Make_Cursor P_((Display*, Cursor));
|
||||
extern Object Make_Cursor_Foreign P_((Display*, Cursor));
|
||||
extern Object Make_Display P_((int, Display*));
|
||||
extern Object Make_Font P_((Display*, Object, Font, XFontStruct*));
|
||||
extern Object Make_Font_Foreign P_((Display*, Object, Font, XFontStruct*));
|
||||
extern Object Make_Gc P_((int, Display*, GC));
|
||||
extern Object Make_Pixel P_((unsigned long));
|
||||
extern Object Make_Pixmap P_((Display*, Pixmap));
|
||||
extern Object Make_Pixmap_Foreign P_((Display*, Pixmap));
|
||||
extern Object Make_Window P_((int, Display*, Window));
|
||||
extern Object P_Close_Display P_((Object));
|
||||
extern Object P_Close_Font P_((Object));
|
||||
extern Object P_Destroy_Window P_((Object));
|
||||
extern Object P_Free_Colormap P_((Object));
|
||||
extern Object P_Free_Cursor P_((Object));
|
||||
extern Object P_Free_Gc P_((Object));
|
||||
extern Object P_Free_Pixmap P_((Object));
|
||||
extern Object P_Window_Unique_Id P_((Object));
|
||||
extern Object Record_To_Vector
|
||||
P_((RECORD*, int, Object, Display*, unsigned long));
|
||||
extern unsigned long Vector_To_Record P_((Object, int, Object, RECORD*));
|
||||
|
||||
C_LINKAGE_END
|
||||
|
||||
extern XSetWindowAttributes SWA;
|
||||
extern XWindowChanges WC;
|
||||
extern XGCValues GCV;
|
||||
extern GEOMETRY GEO;
|
||||
extern XWindowAttributes WA;
|
||||
extern XFontStruct FI;
|
||||
extern XCharStruct CI;
|
||||
extern XWMHints WMH;
|
||||
extern XSizeHints SZH;
|
||||
|
||||
extern Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size,
|
||||
Font_Info_Size, Char_Info_Size, Wm_Hints_Size, Size_Hints_Size;
|
||||
extern RECORD Set_Attr_Rec[], Conf_Rec[], GC_Rec[], Geometry_Rec[],
|
||||
Win_Attr_Rec[], Font_Info_Rec[], Char_Info_Rec[], Wm_Hints_Rec[],
|
||||
Size_Hints_Rec[];
|
||||
|
||||
extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
|
||||
Grav_Syms[], Backing_Store_Syms[], Class_Syms[], Stack_Mode_Syms[],
|
||||
Line_Style_Syms[], State_Syms[], Cap_Style_Syms[], Join_Style_Syms[],
|
||||
Map_State_Syms[], Fill_Style_Syms[], Fill_Rule_Syms[], Arc_Mode_Syms[],
|
||||
Subwin_Mode_Syms[], Button_Syms[], Cross_Mode_Syms[], Cross_Detail_Syms[],
|
||||
Focus_Detail_Syms[], Place_Syms[], Visibility_Syms[], Prop_Syms[],
|
||||
Mapping_Syms[], Direction_Syms[], Shape_Syms[], Propmode_Syms[],
|
||||
Grabstatus_Syms[], Allow_Events_Syms[], Revert_Syms[], Polyshape_Syms[],
|
||||
Initial_State_Syms[], Bitmapstatus_Syms[], Circulate_Syms[],
|
||||
Ordering_Syms[], Byte_Order_Syms[], Saveset_Syms[], Closemode_Syms[];
|
||||
|
||||
extern Object Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf;
|
||||
|
||||
|
||||
#if __STDC__ || defined(ANSI_CPP)
|
||||
# define conc(a,b) a##b
|
||||
# define conc3(a,b,c) a##b##c
|
||||
#else
|
||||
# define _identity(x) x
|
||||
# define conc(a,b) _identity(a)b
|
||||
# define conc3(a,b,c) conc(conc(a,b),c)
|
||||
#endif
|
||||
|
||||
|
||||
/* Generic_Predicate (Pixmap) generates:
|
||||
*
|
||||
* int T_Pixmap;
|
||||
*
|
||||
* static Object P_Pixmapp (x) Object x; {
|
||||
* return TYPE(x) == T_Pixmap ? True : False;
|
||||
* }
|
||||
*/
|
||||
#define Generic_Predicate(type) int conc(T_,type);\
|
||||
\
|
||||
static Object conc3(P_,type,p) (x) Object x; {\
|
||||
return TYPE(x) == conc(T_,type) ? True : False;\
|
||||
}
|
||||
|
||||
/* Generic_Equal (Pixmap, PIXMAP, pm) generates:
|
||||
*
|
||||
* static Pixmap_Equal (x, y) Object x, y; {
|
||||
* return PIXMAP(x)->pm == PIXMAP(y)->field
|
||||
* && !PIXMAP(x)->free && !PIXMAP(y)->free;
|
||||
* }
|
||||
*/
|
||||
#define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
|
||||
Object x, y; {\
|
||||
return cast(x)->field == cast(y)->field\
|
||||
&& !cast(x)->free && !cast(y)->free;\
|
||||
}
|
||||
|
||||
/* Same as above, but doesn't check for ->free:
|
||||
*/
|
||||
#define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
|
||||
Object x, y; {\
|
||||
return cast(x)->field == cast(y)->field;\
|
||||
}
|
||||
|
||||
/* Same as above, but also checks ->dpy
|
||||
*/
|
||||
#define Generic_Equal_Dpy(type,cast,field) static conc(type,_Equal)\
|
||||
(x, y)\
|
||||
Object x, y; {\
|
||||
return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\
|
||||
&& !cast(x)->free && !cast(y)->free;\
|
||||
}
|
||||
|
||||
/* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates:
|
||||
*
|
||||
* static Pixmap_Print (x, port, raw, depth, len) Object x, port; {
|
||||
* Printf (port, "#[pixmap %u]", PIXMAP(x)->pm);
|
||||
* }
|
||||
*/
|
||||
#define Generic_Print(type,fmt,how) static conc(type,_Print)\
|
||||
(x, port, raw, depth, len) Object x, port; {\
|
||||
Printf (port, fmt, (unsigned)how);\
|
||||
}
|
||||
|
||||
/* Generic_Define (Pixmap, "pixmap", "pixmap?") generates:
|
||||
*
|
||||
* T_Pixmap = Define_Type (0, "pixmap", NOFUNC, sizeof (struct S_Pixmap),
|
||||
* Pixmap_Equal, Pixmap_Equal, Pixmap_Print, NOFUNC);
|
||||
* Define_Primitive (P_Pixmapp, "pixmap?", 1, 1, EVAL);
|
||||
*/
|
||||
#define Generic_Define(type,name,pred) conc(T_,type) =\
|
||||
Define_Type (0, name, NOFUNC, sizeof (struct conc(S_,type)),\
|
||||
conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\
|
||||
Define_Primitive (conc3(P_,type,p), pred, 1, 1, EVAL);
|
||||
|
||||
/* Generic_Get_Display (Pixmap, PIXMAP) generates:
|
||||
*
|
||||
* static Object P_Pixmap_Display (x) Object x; {
|
||||
* Check_Type (x, T_Pixmap);
|
||||
* return Make_Display (PIXMAP(x)->dpy);
|
||||
* }
|
||||
*/
|
||||
#define Generic_Get_Display(type,cast) static Object conc3(P_,type,_Display)\
|
||||
(x) Object x; {\
|
||||
Check_Type (x, conc(T_,type));\
|
||||
return Make_Display (0, cast(x)->dpy);\
|
||||
}
|
||||
Loading…
Reference in New Issue