From 2cab5071f3d6c378f8f16ec94e73c1cd0209d8fc Mon Sep 17 00:00:00 2001 From: frese Date: Mon, 16 Jul 2001 13:36:53 +0000 Subject: [PATCH] changed get-window-attributes to use vectors instead of lists internally. fixed some typos. added comments. --- scheme/xlib/window.scm | 107 +++++++++++++++++++++++------------------ 1 file changed, 60 insertions(+), 47 deletions(-) diff --git a/scheme/xlib/window.scm b/scheme/xlib/window.scm index 7f3c208..a6ad643 100644 --- a/scheme/xlib/window.scm +++ b/scheme/xlib/window.scm @@ -1,6 +1,10 @@ ;; 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) (let ((alist (named-args->alist args))) @@ -20,8 +24,6 @@ border-width attrAlist) "Create_Window") - - ;; change-window-attributes takes an alist of names and values... ;; names can be: background-pixmap, background-pixel, border-pixmap, ;; border-pixel, bit-gravity, gravity, backing-store, backing-planes, @@ -39,7 +41,7 @@ ((pixmap? value) (pixmap-Xpixmap value)) ((pixel? value) (pixel-Xpixel value)) ((colormap? value) (colormap-Xcolormap value)) - ((cursor? value) (cursor-Xcursor value)) +;... ((cursor? value) (cursor-Xcursor value)) (else value))) (map cdr alist))))) (%change-window-attributes (window-Xwindow window) @@ -49,11 +51,12 @@ (import-lambda-definition %change-window-attributes (Xwindow Xdisplay alist) "Change_Window_Attributes") -;; single functions that use 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 (cons name value)))) + (change-window-attributes window (list (cons name value))))) (define set-window-background-pixmap! (make-win-attr-setter 'background-pixmap)) (define set-window-background-pixel! (make-win-attr-setter 'background-pixel)) @@ -82,8 +85,14 @@ (if (not v) (error "cannot get window attributes." window) (let* - (;; ... modify as a vector not as a list... ?? - + ((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 class bit-gravity win-gravity backing-store @@ -93,21 +102,8 @@ override-redirect ; 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))))) + (vector->list mod-v)))) + alist))))) (import-lambda-definition %get-window-attributes (Xdisplay Xwindow) "Get_Window_Attributes") @@ -139,7 +135,7 @@ (make-win-attr-getter 'do-not-propagate-mask)) (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) (let* ((args (named-args->alist args)) @@ -151,7 +147,7 @@ val)) (map cdr args))))) (%configure-window (window-Xwindow window) - (display-Xdisplay (window-display)) + (display-Xdisplay (window-display window)) prep-alist))) (import-lambda-definition %configure-window (Xwindow Xdisplay alist) @@ -161,7 +157,7 @@ (define (make-win-configurer name) (lambda (window value) - (configure-window window name value))) + (configure-window window (list (cons name value))))) (define set-window-x! (make-win-configurer 'x)) (define set-window-y! (make-win-configurer 'y)) @@ -171,7 +167,8 @@ (define set-window-sibling! (make-win-configurer 'sibling)) (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) (%map-window (window-Xwindow window) @@ -180,7 +177,8 @@ (import-lambda-definition %map-window (Xwindow Xdisplay) "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) (%unmap-window (window-Xwindow window) @@ -189,7 +187,8 @@ (import-lambda-definition %unmap-window (Xwindow Xdisplay) "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) (%destroy-subwindows (window-Xwindow window) @@ -198,7 +197,8 @@ (import-lambda-definition %destroy-subwindows (Xwindow Xdisplay) "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) (%map-subwindows (window-Xwindow window) @@ -207,7 +207,8 @@ (import-lambda-definition %map-subwindows (Xwindow Xdisplay) "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) (%unmap-subwindows (window-Xwindow window) @@ -216,7 +217,7 @@ (import-lambda-definition %unmap-subwindows (Xwindow Xdisplay) "Unmap_Subwindows") -;; ... +;; See XCirculateSubwindows. (define (circulate-subwindows window direction) (%destroy-subwindows (window-Xwindow window) @@ -227,12 +228,15 @@ (import-lambda-definition %circulate-subwindows (Xwindow Xdisplay dir) "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) (set-window-stack-mode! window 'above)) @@ -240,7 +244,10 @@ (define (lower-window window) (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) (let loop ((w (car window-list)) @@ -251,7 +258,8 @@ (set-window-stack-mode! n 'below) (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) (let* ((display (window-display window)) @@ -266,25 +274,34 @@ (import-lambda-definition %query-tree (Xwindow Xdisplay) "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 scr-window x y dst-window) +(define (translate-coordinates src-window x y dst-window) (let* ((display (window-display src-window)) (res (%translate-coordinates (display-Xdisplay display) (window-Xwindow src-window) x y (window-Xwindow dst-window)))) - (list (first res) - (second res) - (make-window (third res) display)))) + (if res + (list (first res) + (second res) + (make-window (third res) display)) + #f))) (import-lambda-definition %translate-coordinates (Xdisplay srcXwindow x y srcXwindow) "Translate_Coordinates") -;; +;; 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) (let* ((display (window-display window)) @@ -300,8 +317,4 @@ (eighth res)))) (import-lambda-definition %query-pointer (Xdisplay Xwindow) - "Query_Pointer") - - - - + "Query_Pointer") \ No newline at end of file