250 lines
7.6 KiB
C
250 lines
7.6 KiB
C
#include "xlib.h"
|
|
#include "scheme48.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 */
|
|
|
|
s48_value Intern_Atom (s48_value Xdisplay, s48_value name){
|
|
Atom a = XInternAtom(EXTRACT_DISPLAY(Xdisplay), s48_extract_string(name), 0);
|
|
return s48_enter_integer((long)a);
|
|
}
|
|
|
|
s48_value Find_Atom (s48_value Xdisplay, s48_value name){
|
|
Atom a = XInternAtom (EXTRACT_DISPLAY(Xdisplay), s48_extract_string(name), 1);
|
|
if (a == None){
|
|
return s48_value s48_enter_symbol(none);
|
|
}else{
|
|
return a;
|
|
}
|
|
}
|
|
|
|
s48_value Atom_Name (s48_value Xdisplay, s48_value a) {
|
|
register char *s;
|
|
// not used: Disalbe_Interrupts
|
|
s = XGetAtomName (EXTRACT_DISPLAY Xdisplay, a);
|
|
// not used: Enable_Interrupts
|
|
return s48_enter_string (s);
|
|
}
|
|
|
|
s48_value List_Properties (s48_value Xwindow, x48_value Xdisplay){
|
|
int n, i;
|
|
Atom *ap;
|
|
s48_value v;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
//not used: Disable_Interrupts
|
|
ap = XListProperties (EXTRACT_DISPLAY(Xdisplay),
|
|
EXTRACT_WINDOW(Xwindow), &n);
|
|
//not used: Enable_Interrupts
|
|
v = s48_make_vector (n, S48_NULL);
|
|
S48_GC_PROTECT_1 (v);
|
|
for (i = 0; i < n; i++) {
|
|
S48_VECTOR_SET(v, i, s48_enter_integer((long) ap[i]))
|
|
}
|
|
S48_GC_UNPROTECT;
|
|
XFree ((char *)ap);
|
|
return v;
|
|
}
|
|
|
|
|
|
s48_value Get_Property(s48_value Xwindow, s48_value Xdisplay, s48_value Xatom_prop,
|
|
s48_value Xatom_type, s48_value start, s48_value len,
|
|
s48_value deletep) {
|
|
Atom req_type = AnyPropertyType, actual_type_ret;
|
|
int format_ret, i;
|
|
unsigned long nitems_ret, bytes_left_ret;
|
|
unsigned char* prop_ret;
|
|
s48_value ret, x;
|
|
|
|
S48_DECLARE_GC_PROTECT(2);
|
|
|
|
if (!S48_EQ_P(Xatom_type, S48_FALSE)){
|
|
req_type = s48_extract_integer(Xatom_type);
|
|
}
|
|
//not used: Disable_Interrupts
|
|
XGetWindowProperty (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
s48_extract_integer(Xatom_prop), s48_extract_integer (start),
|
|
s48_extract_integer (len), S48_EXTRACT_BOOLEAN(deletep),
|
|
req_type, &actual_type_ret, &format_ret, &nitems_ret,
|
|
&bytes_left_ret, &prop_ret);
|
|
|
|
S48_GC_PROTECT_2 (ret, v);
|
|
ret = s48_cons(s48_enter_integer(bytes_left_ret), S48_NULL);
|
|
if (nitems_ret){
|
|
if (format_ret == 8){
|
|
char d[nitems_ret+1];
|
|
bcopy((char *)data, d, (int)nitems_ret);
|
|
d[nitems_ret+1] = (char)0;
|
|
ret = s48_cons (s48_enter_string(d), ret);
|
|
}else{
|
|
s48_value v;
|
|
// Assumes short is 16 bits and int is 32 bits.
|
|
v = s48_make_vector (nitems_ret, S48_NULL);
|
|
for (i = 0; i < nitems_ret; i++){
|
|
x = s48_enter_integer (format_ret == 16 ?
|
|
*((short *)prop_ret + i) : *((int *)prop_ret + i));
|
|
S48_VECTOR_SET(v, i, x;)
|
|
}
|
|
ret = s48_cons(v, ret);
|
|
}
|
|
}else{
|
|
ret = (S48_NULL, ret);
|
|
}
|
|
ret = s48_cons(s48_enter_integer((long)format_ret), ret);
|
|
ret = s48_cons(s48_enter_integer((long)actual_type_ret), ret);
|
|
S48_GC_UNPROTECT;
|
|
return ret;
|
|
}
|
|
|
|
|
|
s48_value Change_Property(s48_value Xdisplay, s48_value Xwindow,
|
|
s48_value Xatom_prop, s48_value Xatom_type,
|
|
s48_value format, s48_value mode,
|
|
s48_value data){
|
|
int i, x, f, m, nitems;
|
|
char* buf;
|
|
m = Symbol_To_Bit (mode, Propmode_Syms);
|
|
f = (int)s48_extract_integer(format);
|
|
switch (f) {
|
|
case 8:
|
|
buf = s48_extract_string(data);
|
|
nitems = strlen(buf);
|
|
break;
|
|
case 16: case 32:
|
|
nitems = S48_VECTOR_LENGTH(data);
|
|
// Alloca (buf, char*, nitems * (f / sizeof (char)));
|
|
for (i = 0; i < nitems; i++) {
|
|
x = (int)s48_extract_integer(s48_VECTOR_REF(data, nitems));
|
|
if (f == 16) {
|
|
*((short *)buf + i) = x; /* Assumes short is 16 bits */
|
|
}else *((int *)buf + i) = x;
|
|
} /* and int is 32 bits. */
|
|
break;
|
|
}
|
|
XChangeProperty (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
s48_extract_integer(Xatom_prop),
|
|
s48_extract_integer(Xatom_type),
|
|
f, m, (unsigned char *)buf, nitems);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value P_Delete_Property (s48_value Xdisplay, s48_value Xwindow,
|
|
s48_value Xatom_prop){
|
|
XDeleteProperty (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
|
|
s48_extract_integer(Xatom_prop));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value Rotate_Properties (s48_value Xdisplay, s48_value Xwindow,
|
|
s48_value Xatom_vec, s48_value delta){
|
|
int n = S48_VECTOR_LENGTH(Xatom_vec), i;
|
|
Atom p[n];
|
|
for (i = 0; i < n; i++) {
|
|
p[i] = s48_extract_integer(S48_VECTOR_REF(Xatom_vec, i));
|
|
}
|
|
XRotateWindowProperties(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindwo),
|
|
p, n, (int)s48_extract_integer(delta));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Set_Selection_Owner (s48_value Xdisplay, s48_value Xatom_s,
|
|
s48_value Xwindow_owner, s58_value time){
|
|
|
|
XSetSelectionOwner (EXTRACT_DISPLAY(Xdisplay), s48_extract_integer(Xatom_s),
|
|
EXTRACT_WINDOW(Xwindow_owner), EXTRACT_TIME(time));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
/*
|
|
|
|
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));
|
|
}
|
|
*/
|
|
|
|
s48_value Selection_Owner (s48_value Xdisplay, s48_value Xatom_s){
|
|
return ENTER_WINDOW (XGetSelectionOwner (EXTRACT_DISPLAY(Xdisplay),
|
|
s48_extract_integer(Xatom_s)));
|
|
}
|
|
|
|
/*
|
|
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;
|
|
}
|
|
*/
|
|
|
|
|
|
s48_value Convert_Selection (s48_value Xdisplay, s48_value Xatom_s,
|
|
s48_value Xatom_t, s48_value Xatom_p,
|
|
s48_value Xwindow, s48_value time){
|
|
Atom p = None;
|
|
|
|
if (!S48_EQ_P(prop, Sym_None)) {
|
|
Check_Type (prop, T_Atom);
|
|
p = ATOM(prop)->atom;
|
|
}
|
|
XConvertSelection(EXTRACT_DISPLAY(Xdisplay), EXTRACT_ATOM(Xatom_s),
|
|
EXTRACT_ATOM(Xatom_t), EXTRACT_ATOM(Xatom_p),
|
|
EXTRACT_WINDOW(Xwindow), EXTRACT_TIME(time));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
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);
|
|
}
|