scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

303
c/xlib/property.c
View File

@ -1,4 +1,5 @@
#include "xlib.h" #include "xlib.h"
#include "scheme48.h"
s48_value Sym_Now; s48_value Sym_Now;
@ -8,6 +9,7 @@ Generic_Simple_Equal (Atom, ATOM, atom)
Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom) Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom)
/*
s48_value Make_Atom (a) Atom a; { s48_value Make_Atom (a) Atom a; {
s48_value atom; s48_value atom;
@ -22,199 +24,179 @@ s48_value Make_Atom (a) Atom a; {
} }
return atom; return atom;
} }
*/
/* Should be used with care */ /* 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; { s48_value Find_Atom (s48_value Xdisplay, s48_value name){
Check_Type (d, T_Display); Atom a = XInternAtom (EXTRACT_DISPLAY(Xdisplay), s48_extract_string(name), 1);
return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 0)); 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; { s48_value Atom_Name (s48_value Xdisplay, s48_value a) {
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; register char *s;
// not used: Disalbe_Interrupts
Check_Type (d, T_Display); s = XGetAtomName (EXTRACT_DISPLAY Xdisplay, a);
Check_Type (a, T_Atom); // not used: Enable_Interrupts
Disable_Interrupts; return s48_enter_string (s);
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; { s48_value List_Properties (s48_value Xwindow, x48_value Xdisplay){
register i; int n, i;
int n; Atom *ap;
register Atom *ap;
s48_value v; s48_value v;
S48_DECLARE_GC_PROTECT(1); S48_DECLARE_GC_PROTECT(1);
//not used: Disable_Interrupts
Check_Type (w, T_Window); ap = XListProperties (EXTRACT_DISPLAY(Xdisplay),
Disable_Interrupts; EXTRACT_WINDOW(Xwindow), &n);
ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n); //not used: Enable_Interrupts
Enable_Interrupts;
v = s48_make_vector (n, S48_NULL); v = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (v); S48_GC_PROTECT_1 (v);
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
s48_value x; S48_VECTOR_SET(v, i, s48_enter_integer((long) ap[i]))
x = Make_Atom (ap[i]);
S48_VECTOR_SET(v, i, x;)
} }
S48_GC_UNPROTECT; S48_GC_UNPROTECT;
XFree ((char *)ap); XFree ((char *)ap);
return v; 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); s48_value Get_Property(s48_value Xwindow, s48_value Xdisplay, s48_value Xatom_prop,
Check_Type (prop, T_Atom); s48_value Xatom_type, s48_value start, s48_value len,
if (!S48_EQ_P(type, S48_FALSE)) { s48_value deletep) {
Check_Type (type, T_Atom); Atom req_type = AnyPropertyType, actual_type_ret;
req_type = ATOM(type)->atom; 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); }else{
Disable_Interrupts; ret = (S48_NULL, ret);
if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, }
s48_extract_integer (start), s48_extract_integer (len), ret = s48_cons(s48_enter_integer((long)format_ret), ret);
S48_EQ_P(deletep, S48_TRUE), req_type, &actual_type, &format, ret = s48_cons(s48_enter_integer((long)actual_type_ret), ret);
&nitems, &bytes_left, &data) != Success) S48_GC_UNPROTECT;
Primitive_Error ("cannot get property"); return ret;
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); s48_value Change_Property(s48_value Xdisplay, s48_value Xwindow,
Check_Type (prop, T_Atom); s48_value Xatom_prop, s48_value Xatom_type,
Check_Type (type, T_Atom); s48_value format, s48_value mode,
m = Symbols_To_Bits (mode, 0, Propmode_Syms); s48_value data){
switch (f = (int)s48_extract_integer (format)) { int i, x, f, m, nitems;
case 8: char* buf;
Check_Type (data, T_String); m = Symbol_To_Bit (mode, Propmode_Syms);
buf = STRING(data)->data; f = (int)s48_extract_integer(format);
nitems = STRING(data)->size; switch (f) {
break; case 8:
case 16: case 32: buf = s48_extract_string(data);
Check_Type (data, T_Vector); nitems = strlen(buf);
nitems = S48_VECTOR_LENGTH(data); break;
Alloca (buf, char*, nitems * (f / sizeof (char))); case 16: case 32:
for (i = 0; i < nitems; i++) { nitems = S48_VECTOR_LENGTH(data);
x = (int)s48_extract_integer (VECTOR(data)->data[i]); // Alloca (buf, char*, nitems * (f / sizeof (char)));
if (f == 16) { for (i = 0; i < nitems; i++) {
if (x > 65535) x = (int)s48_extract_integer(s48_VECTOR_REF(data, nitems));
Primitive_Error ("format mismatch"); if (f == 16) {
*((short *)buf + i) = x; /* Assumes short is 16 bits */ *((short *)buf + i) = x; /* Assumes short is 16 bits */
} else *((int *)buf + i) = x; /* and int is 32 bits. */ }else *((int *)buf + i) = x;
} } /* and int is 32 bits. */
break; break;
default: }
Primitive_Error ("invalid format: ~s", format); XChangeProperty (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
} s48_extract_integer(Xatom_prop),
XChangeProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, s48_extract_integer(Xatom_type),
ATOM(type)->atom, f, m, (unsigned char *)buf, nitems); f, m, (unsigned char *)buf, nitems);
Alloca_End; return S48_UNSPECIFIC;
return Void;
} }
static s48_value P_Delete_Property (w, prop) s48_value w, prop; {
Check_Type (w, T_Window); s48_value P_Delete_Property (s48_value Xdisplay, s48_value Xwindow,
Check_Type (prop, T_Atom); s48_value Xatom_prop){
XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom); XDeleteProperty (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
return Void; 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); s48_value Rotate_Properties (s48_value Xdisplay, s48_value Xwindow,
Check_Type (v, T_Vector); s48_value Xatom_vec, s48_value delta){
n = S48_VECTOR_LENGTH(v); int n = S48_VECTOR_LENGTH(Xatom_vec), i;
Alloca (p, Atom*, n * sizeof (Atom)); Atom p[n];
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
s48_value a; p[i] = s48_extract_integer(S48_VECTOR_REF(Xatom_vec, i));
}
a = S48_VECTOR_REF(v, i); XRotateWindowProperties(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindwo),
Check_Type (a, T_Atom); p, n, (int)s48_extract_integer(delta));
p[i] = ATOM(a)->atom; return S48_UNSPECIFIC;
}
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, s48_value Set_Selection_Owner (s48_value Xdisplay, s48_value Xatom_s,
time; { s48_value Xwindow_owner, s58_value time){
Check_Type (d, T_Display);
Check_Type (s, T_Atom); XSetSelectionOwner (EXTRACT_DISPLAY(Xdisplay), s48_extract_integer(Xatom_s),
XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner), EXTRACT_WINDOW(Xwindow_owner), EXTRACT_TIME(time));
Get_Time (time)); return S48_UNSPECIFIC;
return Void;
} }
/*
static s48_value P_Selection_Owner (d, s) s48_value d, s; { static s48_value P_Selection_Owner (d, s) s48_value d, s; {
Check_Type (d, T_Display); Check_Type (d, T_Display);
Check_Type (s, T_Atom); Check_Type (s, T_Atom);
return Make_Window (0, DISPLAY(d)->dpy, return Make_Window (0, DISPLAY(d)->dpy,
XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom)); 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) static s48_value P_Convert_Selection (s, target, prop, w, time)
s48_value s, target, prop, w, time; { s48_value s, target, prop, w, time; {
Atom p = None; 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)); p, WINDOW(w)->win, Get_Time (time));
return Void; 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 () { elk_init_xlib_property () {
Define_Symbol (&Sym_Now, "now"); 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))