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

updated functions to pass/receive vectors not lists from the c-routines.

This commit is contained in:
frese 2001-07-30 14:39:14 +00:00
parent 40f33cd2f3
commit cf6bc39491
1 changed files with 24 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
scheme/xlib/window.scm
View File

@ -11,7 +11,18 @@
(receive (x y width height border-width parent change-win-attr-list) (receive (x y width height border-width parent change-win-attr-list)
(alist-split alist '((x . 0) (y . 0) (width . #f) (height . #f) (alist-split alist '((x . 0) (y . 0) (width . #f) (height . #f)
(border-width . 2) (parent . #f))) (border-width . 2) (parent . #f)))
(let* ((display (window-display parent)) (let* ((change-win-attr-list
(map cons
(map car change-win-attr-list)
(map (lambda (obj)
(cond
((pixel? obj) (pixel-Xpixel obj))
((pixmap? obj) (pixmap-Xpixmap obj))
((colormap? obj) (colormap-Xcolormap obj))
;; cursor...??
(else obj)))
(map cdr change-win-attr-list))))
(display (window-display parent))
(Xwindow (%create-window (display-Xdisplay display) (Xwindow (%create-window (display-Xdisplay display)
(window-Xwindow parent) (window-Xwindow parent)
x y width height border-width x y width height border-width
@ -269,11 +280,12 @@
(let* ((display (window-display window)) (let* ((display (window-display window))
(res (%query-tree (window-Xwindow window) (res (%query-tree (window-Xwindow window)
(display-Xdisplay display)))) (display-Xdisplay display))))
(list (make-window (first res) display #f) (list
(make-window (second res) display #f) (make-window (vector-ref res 0) display #f)
(make-window (vector-ref res 1) display #f)
(vector-map! (lambda (Xwindow) (vector-map! (lambda (Xwindow)
(make-window Xwindow display #f)) (make-window Xwindow display #f))
(third res))))) (vector-ref res 2)))))
(import-lambda-definition %query-tree (Xwindow Xdisplay) (import-lambda-definition %query-tree (Xwindow Xdisplay)
"Query_Tree") "Query_Tree")
@ -292,9 +304,9 @@
x y x y
(window-Xwindow dst-window)))) (window-Xwindow dst-window))))
(if res (if res
(list (first res) (begin
(second res) (vector-set! res 2 (make-window (vector-ref res 2) display #f))
(make-window (third res) display #f)) (vector->list res))
#f))) #f)))
(import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y (import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y
@ -311,14 +323,9 @@
(let* ((display (window-display window)) (let* ((display (window-display window))
(res (%query-pointer (display-Xdisplay display) (res (%query-pointer (display-Xdisplay display)
(window-Xwindow window)))) (window-Xwindow window))))
(list (first res) (vector-set! res 3 (make-window (vector-ref res 3) display #f))
(second res) (vector-set! res 6 (make-window (vector-ref res 6) display #f))
(third res) (vector->list res)))
(make-window (fourth res) display #f)
(fifth res)
(sixth res)
(make-window (seventh res) display #f)
(eighth res))))
(import-lambda-definition %query-pointer (Xdisplay Xwindow) (import-lambda-definition %query-pointer (Xdisplay Xwindow)
"Query_Pointer") "Query_Pointer")