*** empty log message ***

This commit is contained in:
nofreude 2001-07-11 14:22:42 +00:00
parent a380c30f74
commit 7609b10f0e
2 changed files with 214 additions and 152 deletions

View File

@ -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");

63
scheme/xlib/atom-type.scm Normal file
View File

@ -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))