*** empty log message ***
This commit is contained in:
parent
a380c30f74
commit
7609b10f0e
|
@ -1,4 +1,5 @@
|
|||
#include "xlib.h"
|
||||
#include "scheme48.h"
|
||||
|
||||
s48_value Sym_Now;
|
||||
|
||||
|
@ -8,6 +9,7 @@ Generic_Simple_Equal (Atom, ATOM, atom)
|
|||
|
||||
Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom)
|
||||
|
||||
/*
|
||||
s48_value Make_Atom (a) Atom a; {
|
||||
s48_value atom;
|
||||
|
||||
|
@ -22,199 +24,179 @@ s48_value Make_Atom (a) Atom a; {
|
|||
}
|
||||
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));
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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));
|
||||
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;
|
||||
}
|
||||
}
|
||||
|
||||
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; {
|
||||
s48_value Atom_Name (s48_value Xdisplay, s48_value 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));
|
||||
// not used: Disalbe_Interrupts
|
||||
s = XGetAtomName (EXTRACT_DISPLAY Xdisplay, a);
|
||||
// not used: Enable_Interrupts
|
||||
return s48_enter_string (s);
|
||||
}
|
||||
|
||||
static s48_value P_List_Properties (w) s48_value w; {
|
||||
register i;
|
||||
int n;
|
||||
register Atom *ap;
|
||||
s48_value List_Properties (s48_value Xwindow, x48_value Xdisplay){
|
||||
int n, i;
|
||||
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;
|
||||
//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_value x;
|
||||
|
||||
x = Make_Atom (ap[i]);
|
||||
S48_VECTOR_SET(v, i, x;)
|
||||
S48_VECTOR_SET(v, i, s48_enter_integer((long) ap[i]))
|
||||
}
|
||||
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;
|
||||
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);
|
||||
}
|
||||
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;
|
||||
}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;
|
||||
}
|
||||
|
||||
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;
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
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;
|
||||
|
@ -230,6 +212,23 @@ static s48_value P_Convert_Selection (s, target, prop, w, time)
|
|||
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");
|
||||
|
|
|
@ -0,0 +1,63 @@
|
|||
;; the atom-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-record-type atom :atom
|
||||
(really-make-atom tag Xatom)
|
||||
atom?
|
||||
(tag atom-tag atom-set-tag!)
|
||||
(Xatom real-atom-Xatom atom-set-Xatom!))
|
||||
|
||||
(define (atom-Xatom atom)
|
||||
(if (none-resource? atom)
|
||||
0
|
||||
(real-atom-Xatom atom)))
|
||||
|
||||
(define (make-atom Xatom)
|
||||
(if (= 0 Xatom)
|
||||
none-resource
|
||||
(let ((maybe-atom (atom-list-find Xatom)))
|
||||
(if maybe-atom
|
||||
maybe-atom
|
||||
(let ((atom (really-make-atom #f Xatom)))
|
||||
(add-finalizer! atom finalize-atom)
|
||||
(atom-list-set! Xatom atom)
|
||||
atom)))))
|
||||
|
||||
|
||||
(define (intern-atom display name)
|
||||
(let ((Xatom (%intern-atom (display-Xdisplay display)
|
||||
(if (symbol? name)
|
||||
(symbol->string name)
|
||||
name))))
|
||||
(make-atom Xatom)))
|
||||
|
||||
(import-lambda-definition %intern-atom (Xdisplay name)
|
||||
"Intern_Atom")
|
||||
|
||||
;; finalize-atom is called, when the garbage collector removes the last
|
||||
;; reference to the atom from the heap. Then we can savely close the
|
||||
;; atom and remove the weak-pointer from our list.
|
||||
|
||||
(define (finalize-atom atom)
|
||||
(let ((Xatom (atom-Xatom atom)))
|
||||
;(atom-set-Xatom! atom 'already-freed)
|
||||
(atom-list-delete! Xatom)))
|
||||
|
||||
|
||||
;; All atom records need to be saved in a weak-list, to have only one record
|
||||
;; for the same XLib atom
|
||||
|
||||
(define *weak-atom-list* (make-integer-table))
|
||||
|
||||
(define (atom-list-find Xatom)
|
||||
(let ((r (table-ref *weak-atom-list* Xatom)))
|
||||
(if r
|
||||
(weak-pointer-ref r)
|
||||
r)))
|
||||
|
||||
(define (atom-list-set! Xatom atom)
|
||||
(let ((p (make-weak-pointer atom)))
|
||||
(table-set! *weak-atom-list* Xatom p)))
|
||||
|
||||
(define (atom-list-delete! Xatom)
|
||||
(table-set! *weak-atom-list* Xatom #f))
|
||||
|
Loading…
Reference in New Issue