251 lines
7.3 KiB
C
251 lines
7.3 KiB
C
#include "xlib.h"
|
|
|
|
s48_value Sym_Now;
|
|
|
|
Generic_Predicate (Atom)
|
|
|
|
Generic_Simple_Equal (Atom, ATOM, atom)
|
|
|
|
Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom)
|
|
|
|
s48_value Make_Atom (a) Atom a; {
|
|
s48_value atom;
|
|
|
|
if (a == None)
|
|
return Sym_None;
|
|
atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a);
|
|
if (S48_NULL_P (atom)) {
|
|
atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0);
|
|
ATOM(atom)->tag = S48_NULL;
|
|
ATOM(atom)->atom = a;
|
|
Register_Object (atom, (GENERIC)0, (PFO)0, 0);
|
|
}
|
|
return atom;
|
|
}
|
|
|
|
/* Should be used with care */
|
|
static s48_value P_Make_Atom (n) s48_value n; {
|
|
return Make_Atom ((Atom)s48_extract_integer (n));
|
|
}
|
|
|
|
static s48_value P_Intern_Atom (d, name) s48_value d, name; {
|
|
Check_Type (d, T_Display);
|
|
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 0));
|
|
}
|
|
|
|
static s48_value P_Find_Atom (d, name) s48_value d, name; {
|
|
Check_Type (d, T_Display);
|
|
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 1));
|
|
}
|
|
|
|
static s48_value P_Atom_Name (d, a) s48_value 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 s48_value P_List_Properties (w) s48_value w; {
|
|
register i;
|
|
int n;
|
|
register Atom *ap;
|
|
s48_value v;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
Check_Type (w, T_Window);
|
|
Disable_Interrupts;
|
|
ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n);
|
|
Enable_Interrupts;
|
|
v = s48_make_vector (n, S48_NULL);
|
|
S48_GC_PROTECT_1 (v);
|
|
for (i = 0; i < n; i++) {
|
|
s48_value x;
|
|
|
|
x = Make_Atom (ap[i]);
|
|
S48_VECTOR_SET(v, i, x;)
|
|
}
|
|
S48_GC_UNPROTECT;
|
|
XFree ((char *)ap);
|
|
return v;
|
|
}
|
|
|
|
static s48_value P_Get_Property (w, prop, type, start, len, deletep)
|
|
s48_value w, prop, type, start, len, deletep; {
|
|
Atom req_type = AnyPropertyType, actual_type;
|
|
int format;
|
|
unsigned long nitems, bytes_left;
|
|
unsigned char *data;
|
|
s48_value ret, t, x;
|
|
register i;
|
|
S48_DECLARE_GC_PROTECT(2);
|
|
|
|
Check_Type (w, T_Window);
|
|
Check_Type (prop, T_Atom);
|
|
if (!S48_EQ_P(type, S48_FALSE)) {
|
|
Check_Type (type, T_Atom);
|
|
req_type = ATOM(type)->atom;
|
|
}
|
|
Check_Type (deletep, T_Boolean);
|
|
Disable_Interrupts;
|
|
if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
|
|
s48_extract_integer (start), s48_extract_integer (len),
|
|
S48_EQ_P(deletep, S48_TRUE), req_type, &actual_type, &format,
|
|
&nitems, &bytes_left, &data) != Success)
|
|
Primitive_Error ("cannot get property");
|
|
Enable_Interrupts;
|
|
ret = t = P_Make_List (s48_enter_integer (4), S48_NULL);
|
|
S48_GC_PROTECT_2 (ret, t);
|
|
x = Make_Atom (actual_type);
|
|
S48_CAR (t) = x; t = S48_CDR (t);
|
|
x = s48_enter_integer (format);
|
|
S48_CAR (t) = x; t = S48_CDR (t);
|
|
if (nitems) {
|
|
if (format == 8) {
|
|
s48_value s;
|
|
x = Make_String ((char *)0, (int)nitems);
|
|
s = S48_CAR (t) = x;
|
|
bcopy ((char *)data, STRING(s)->data, (int)nitems);
|
|
} else {
|
|
s48_value v;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
/* Assumes short is 16 bits and int is 32 bits.
|
|
*/
|
|
v = s48_make_vector ((int)nitems, S48_NULL);
|
|
S48_GC_PROTECT_1 (v);
|
|
for (i = 0; i < nitems; i++) {
|
|
x = s48_enter_integer (format == 16 ?
|
|
*((short *)data + i) : *((int *)data + i));
|
|
S48_VECTOR_SET(v, i, x;)
|
|
}
|
|
S48_CAR (t) = v;
|
|
S48_GC_UNPROTECT;
|
|
}
|
|
}
|
|
t = S48_CDR (t);
|
|
x = s48_enter_integer (bytes_left);
|
|
S48_CAR (t) = x;
|
|
S48_GC_UNPROTECT;
|
|
return ret;
|
|
}
|
|
|
|
static s48_value P_Change_Property (w, prop, type, format, mode, data)
|
|
s48_value w, prop, type, format, mode, data; {
|
|
register i, m, x, nitems, f;
|
|
char *buf;
|
|
Alloca_Begin;
|
|
|
|
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 = (int)s48_extract_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 = S48_VECTOR_LENGTH(data);
|
|
Alloca (buf, char*, nitems * (f / sizeof (char)));
|
|
for (i = 0; i < nitems; i++) {
|
|
x = (int)s48_extract_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 s48_value P_Delete_Property (w, prop) s48_value w, prop; {
|
|
Check_Type (w, T_Window);
|
|
Check_Type (prop, T_Atom);
|
|
XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom);
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Rotate_Properties (w, v, delta) s48_value w, v, delta; {
|
|
Atom *p;
|
|
register i, n;
|
|
Alloca_Begin;
|
|
|
|
Check_Type (w, T_Window);
|
|
Check_Type (v, T_Vector);
|
|
n = S48_VECTOR_LENGTH(v);
|
|
Alloca (p, Atom*, n * sizeof (Atom));
|
|
for (i = 0; i < n; i++) {
|
|
s48_value a;
|
|
|
|
a = S48_VECTOR_REF(v, i);
|
|
Check_Type (a, T_Atom);
|
|
p[i] = ATOM(a)->atom;
|
|
}
|
|
XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n,
|
|
(int)s48_extract_integer (delta));
|
|
Alloca_End;
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Set_Selection_Owner (d, s, owner, time) s48_value d, s, owner,
|
|
time; {
|
|
Check_Type (d, T_Display);
|
|
Check_Type (s, T_Atom);
|
|
XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner),
|
|
Get_Time (time));
|
|
return Void;
|
|
}
|
|
|
|
static s48_value P_Selection_Owner (d, s) s48_value d, s; {
|
|
Check_Type (d, T_Display);
|
|
Check_Type (s, T_Atom);
|
|
return Make_Window (0, DISPLAY(d)->dpy,
|
|
XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom));
|
|
}
|
|
|
|
static s48_value P_Convert_Selection (s, target, prop, w, time)
|
|
s48_value s, target, prop, w, time; {
|
|
Atom p = None;
|
|
|
|
Check_Type (s, T_Atom);
|
|
Check_Type (target, T_Atom);
|
|
if (!S48_EQ_P(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);
|
|
}
|