changed get-window-attributes to use vectors instead of lists
internally. fixed some typos. added comments.
This commit is contained in:
frese
parent
144ecc85c6
commit
2cab5071f3
|
|
@ -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")
|
||||
Loading…
Reference in New Issue