Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv26909
Modified Files:
window.scm
Log Message:
changed get-window-attributes to use vectors instead of lists
internally. fixed some typos. added comments.
Index: window.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/window.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** window.scm 2001/07/09 13:49:38 1.3
--- window.scm 2001/07/16 13:36:53 1.4
***************
*** 1,5 ****
;; Author: David Frese
! ; ...
(define (create-window . args)
--- 1,9 ----
;; Author: David Frese
! ;; create-window takes an alist of names and values - see
! ;; change-window-attributes and configure-window. Mandatory arguments for
! ;; create-window are 'parent, 'width and 'height. Example:
! ;; (create-window 'parent root 'width 500 'height 300 '((border-width . 4)))
! ;; Returns the new window or raises an exception if something went wrong.
(define (create-window . args)
***************
*** 21,26 ****
"Create_Window")
-
-
;; change-window-attributes takes an alist of names and values...
;; names can be: background-pixmap, background-pixel, border-pixmap,
--- 25,28 ----
***************
*** 40,44 ****
((pixel? value) (pixel-Xpixel value))
((colormap? value) (colormap-Xcolormap value))
! ((cursor? value) (cursor-Xcursor value))
(else value)))
(map cdr alist)))))
--- 42,46 ----
((pixel? value) (pixel-Xpixel value))
((colormap? value) (colormap-Xcolormap value))
! ;... ((cursor? value) (cursor-Xcursor value))
(else value)))
(map cdr alist)))))
***************
*** 50,58 ****
"Change_Window_Attributes")
! ;; single functions that use change-window-attributes:
(define (make-win-attr-setter name)
(lambda (window value)
! (change-window-attributes window (cons name value))))
(define set-window-background-pixmap! (make-win-attr-setter
'background-pixmap))
--- 52,61 ----
"Change_Window_Attributes")
! ;; simple functions that use change-window-attributes
! ;; TODO: a caching system for multiple calls to these functions
(define (make-win-attr-setter name)
(lambda (window value)
! (change-window-attributes window (list (cons name value)))))
(define set-window-background-pixmap! (make-win-attr-setter
'background-pixmap))
***************
*** 83,88 ****
(error "cannot get window attributes." window)
(let*
! (;; ... modify as a vector not as a list... ??
!
(alist (map cons
'(x y width height border-width depth visual root
--- 86,97 ----
(error "cannot get window attributes." window)
(let*
! ((comp (lambda (i f) (vector-set! v i (f (vector-ref v i)))))
! (mod-v (begin
! (comp 13 make-pixel) ;; backing-pixel
! (comp 7 (lambda (Xwin) ;; root
! ;; really this Display ??
! (make-window Xwin (window-display window))))
! ;; font, visual ??
! v))
(alist (map cons
'(x y width height border-width depth visual root
***************
*** 94,112 ****
; screen not supported
)
! (vector->list v)))
! (mod-alist (map (lambda (name-val)
! (case (car name-val)
! ;((...-mask))
! ;((font) ...)
! ((backing-pixel)
! (cons 'backing-pixel
! (make-pixel (cdr name-val))))
! ;((root)
! ; (cons 'root
! ; (make-window (cdr name-val) dpy??)))
! ;((visual) ??)
! (else name-val)))
! alist)))
! mod-alist)))))
(import-lambda-definition %get-window-attributes (Xdisplay Xwindow)
--- 103,108 ----
; screen not supported
)
! (vector->list mod-v))))
! alist)))))
(import-lambda-definition %get-window-attributes (Xdisplay Xwindow)
***************
*** 140,144 ****
(define window-override-redirect (make-win-attr-getter 'override-redirect))
! ;; ...
(define (configure-window window . args)
--- 136,140 ----
(define window-override-redirect (make-win-attr-getter 'override-redirect))
! ;; This sets the window-attributes listed below - call like create-window.
(define (configure-window window . args)
***************
*** 152,156 ****
(map cdr args)))))
(%configure-window (window-Xwindow window)
! (display-Xdisplay (window-display))
prep-alist)))
--- 148,152 ----
(map cdr args)))))
(%configure-window (window-Xwindow window)
! (display-Xdisplay (window-display window))
prep-alist)))
***************
*** 162,166 ****
(define (make-win-configurer name)
(lambda (window value)
! (configure-window window name value)))
(define set-window-x! (make-win-configurer 'x))
--- 158,162 ----
(define (make-win-configurer name)
(lambda (window value)
! (configure-window window (list (cons name value)))))
(define set-window-x! (make-win-configurer 'x))
***************
*** 172,176 ****
(define set-window-stack-mode! (make-win-configurer 'stack-mode))
! ;; ...
(define (map-window window)
--- 168,173 ----
(define set-window-stack-mode! (make-win-configurer 'stack-mode))
! ;; The map-window function maps the window and all of its subwindows that
have
! ;; had map requests. See XMapWindow.
(define (map-window window)
***************
*** 181,185 ****
"Map_Window")
! ;; ...
(define (unmap-window window)
--- 178,183 ----
"Map_Window")
! ;; The unmap-window function unmaps the specified window and causes the
! ;; X server to generate an unmap-notify event. See XUnmapWindow.
(define (unmap-window window)
***************
*** 190,194 ****
"Unmap_Window")
! ;; ...
(define (destroy-subwindows window)
--- 188,193 ----
"Unmap_Window")
! ;; The destroy-subwindows function destroys all inferior windows of the
! ;; specified window, in bottom-to-top stacking order. See XDestroySubWindows.
(define (destroy-subwindows window)
***************
*** 199,203 ****
"Destroy_Subwindows")
! ;; ...
(define (map-subwindows window)
--- 198,203 ----
"Destroy_Subwindows")
! ;; The map-subwindows function maps all subwindows for a specified window in
! ;; top-to-bottom stacking order. See XMapSubwindows
(define (map-subwindows window)
***************
*** 208,212 ****
"Map_Subwindows")
! ;; ...
(define (unmap-subwindows window)
--- 208,213 ----
"Map_Subwindows")
! ;; The unmap-subwindows function unmaps all subwindows for each subwindow
! ;; and expose events on formerly obscured windows. See XUnmapSubwindow.
(define (unmap-subwindows window)
***************
*** 217,221 ****
"Unmap_Subwindows")
! ;; ...
(define (circulate-subwindows window direction)
--- 218,222 ----
"Unmap_Subwindows")
! ;; See XCirculateSubwindows.
(define (circulate-subwindows window direction)
***************
*** 228,237 ****
"Circulate_Subwindows")
! ;; ...
(define (clear-window window)
(clear-area window 0 0 0 0 #f))
! ;; ...
(define (raise-window window)
--- 229,241 ----
"Circulate_Subwindows")
! ;; The clear-window function clears the entire area in the specified window.
! ;; See XClearWindow.
(define (clear-window window)
(clear-area window 0 0 0 0 #f))
! ;; The raise-window (lower-window) function raises (lowers) the specified
window
! ;; to the top (button) of the stack so that no sibling window obscures it (it
! ;; does not obscure any sibling windows). See XRaiseWindow.
(define (raise-window window)
***************
*** 241,245 ****
(set-window-stack-mode! window 'below))
! ;; ...
(define (restack-windows window-list)
--- 245,252 ----
(set-window-stack-mode! window 'below))
! ;; The restack-windows function restacks the windows in the order specified,
! ;; from top to bottom. The stacking order of the first window in the windows
! ;; list is unaffected, but the other windows in the array are stacked
underneath
! ;; the first window, in the order of the list. See XRestackWindows.
(define (restack-windows window-list)
***************
*** 252,256 ****
(loop n (cdr t))))))
! ;; ...
(define (query-tree window)
--- 259,264 ----
(loop n (cdr t))))))
! ;; query-tree returns a list of three elements: root window, parent window
and
! ;; child windows of the given window. See XQueryTree.
(define (query-tree window)
***************
*** 267,273 ****
"Query_Tree")
! ;; ...
! (define (translate-coordinates scr-window x y dst-window)
(let* ((display (window-display src-window))
(res (%translate-coordinates
--- 275,285 ----
"Query_Tree")
! ;; translate-coordinates takes the x and y coordinates relative to the source
! ;; window's origin and returns a list of three elements: the x and y
coordinates
! ;; relative to the destination window's origin. If the source window and the
! ;; destination window are on different screens the result is #f. See
! ;; XTranslateCoordinates.
! (define (translate-coordinates src-window x y dst-window)
(let* ((display (window-display src-window))
(res (%translate-coordinates
***************
*** 276,282 ****
x y
(window-Xwindow dst-window))))
! (list (first res)
! (second res)
! (make-window (third res) display))))
(import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y
--- 288,296 ----
x y
(window-Xwindow dst-window))))
! (if res
! (list (first res)
! (second res)
! (make-window (third res) display))
! #f)))
(import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y
***************
*** 285,289 ****
! ;;
(define (query-pointer window)
--- 299,306 ----
! ;; query-pointer returns a list of eight elements: x and y coordinates, a
! ;; boolean indicating whether the pointer is on the same screen as the
specified
! ;; window, the root window, the root window's x and y coordinates, the child
! ;; window and a list of modifier names (see grab-button). See XQueryPointer.
(define (query-pointer window)
***************
*** 301,307 ****
(import-lambda-definition %query-pointer (Xdisplay Xwindow)
! "Query_Pointer")
!
!
!
!
--- 318,320 ----
(import-lambda-definition %query-pointer (Xdisplay Xwindow)
! "Query_Pointer")
\ No newline at end of file
|