120 lines
3.5 KiB
Scheme
120 lines
3.5 KiB
Scheme
|
(define (reparent-window window parent-window x y)
|
||
|
|
(%reparent-window (display-Xdisplay (window-display window))
|
||
|
|
(window-Xwindow window)
|
||
|
|
(window-Xwindow parent-window)
|
||
|
|
x y))
|
||
|
|
|
||
|
|
(import-lambda-definition %reparent-window (Xdisplay Xwindow Xwindow_parent x y)
|
||
|
|
"scx_Reparent_Window")
|
||
|
|
|
||
|
|
(define (install-colormap colormap)
|
||
|
|
(%install-colormap (display-Xdisplay (colormap-display colormap))
|
||
|
|
(colormap-Xcolormap colormap)))
|
||
|
|
|
||
|
|
(import-lambda-definition %install-colormap (Xdisplay Xcolormap)
|
||
|
|
"scx_Install_Colormap")
|
||
|
|
|
||
|
|
(define (uninstall-colormap colormap)
|
||
|
|
(%uninstall-colormap (display-Xdisplay (colormap-display colormap))
|
||
|
|
(colormap-Xcolormap colormap)))
|
||
|
|
|
||
|
|
(import-lambda-definition %uninstall-colormap (Xdisplay Xcolormap)
|
||
|
|
"scx_Uninstall_Colormap")
|
||
|
|
|
||
|
|
(define (list-installed-colormaps window)
|
||
|
|
(let* ((dpy (window-display window))
|
||
|
|
(ret (%list-installed-colormaps
|
||
|
|
(display-Xdisplay dpy)
|
||
|
|
(window-Xwindow window))))
|
||
|
|
(vector-map! (lambda (Xcolormap)
|
||
|
|
(make-colormap Xcolormap display #f))
|
||
|
|
ret)))
|
||
|
|
|
||
|
|
(import-lambda-definition %list-installed-colormaps (Xdisplay Xwindow)
|
||
|
|
"scx_List_Installed_Colormaps")
|
||
|
|
|
||
|
|
(define (set-input-focus display window revert-to time)
|
||
|
|
(%set-input-focus (display-Xdisplay display)
|
||
|
|
(begin
|
||
|
|
(if (not (or (window? window)
|
||
|
|
(eq? window 'pointer-root)))
|
||
|
|
(error "expected argument of type window; given"
|
||
|
|
window))
|
||
|
|
window)
|
||
|
|
time))
|
||
|
|
|
||
|
|
(import-lambda-definition %set-input-focus (Xdisplay Xwindow)
|
||
|
|
"scx_Set_Input_Focus")
|
||
|
|
|
||
|
|
(define (input-focus display)
|
||
|
|
(let ((ret (%input-focus (display-Xdisplay display))))
|
||
|
|
(cons (make-window (car ret) display #f)
|
||
|
|
(cdr ret))))
|
||
|
|
|
||
|
|
(define (general-warp-pointer display
|
||
|
|
dst-win dst-x dst-y
|
||
|
|
src-win src-x src-y src-width src-height)
|
||
|
|
(%general-warp-pointer (display-Xdisplay display)
|
||
|
|
(window-Xwindow dst-win) dst-x dst-y
|
||
|
|
(window-Xwindow src-win)
|
||
|
|
src-x src-y src-width src-height))
|
||
|
|
|
||
|
|
(import-lambda-definition %general-warp-pointer
|
||
|
|
(Xdisplay Xdst-win dst-x dst-y
|
||
|
|
Xsrc-win src-x src-y src-width src-height)
|
||
|
|
"scx_General_Warp_Pointer")
|
||
|
|
|
||
|
|
(define (warp-pointer dst-window dst-x dst-y)
|
||
|
|
(general-warp-pointer (window-display dst-window)
|
||
|
|
dst-window dst-x dst-y
|
||
|
|
'none 0 0 0 0))
|
||
|
|
|
||
|
|
(define (warp-pointer-relative display x-offset y-offset)
|
||
|
|
(general-warp-pointer display
|
||
|
|
'none x-offset y-offset
|
||
|
|
'none 0 0 0 0))
|
||
|
|
|
||
|
|
(define (bell display . percent)
|
||
|
|
(%bell (display-Xdisplay display)
|
||
|
|
(if (null? percent)
|
||
|
|
0
|
||
|
|
(car percent))))
|
||
|
|
|
||
|
|
(import-lambda-definition %bell (Xdisplay percent)
|
||
|
|
"scx_Bell")
|
||
|
|
|
||
|
|
(define (set-access-control display enable?)
|
||
|
|
(%set-access-control (display-Xdisplay display)
|
||
|
|
enable?))
|
||
|
|
|
||
|
|
(import-lambda-definition %set-access-control (Xdisplay on)
|
||
|
|
"scx_Set_Access_Control")
|
||
|
|
|
||
|
|
(define (change-save-set window mode)
|
||
|
|
(%change-save-set (display-Xdisplay (window-display window))
|
||
|
|
(window-Xwindow window)
|
||
|
|
mode))
|
||
|
|
|
||
|
|
(import-lambda-definition %change-save-set (Xdisplay Xwindow mode)
|
||
|
|
"scx_Change_Save_Set")
|
||
|
|
|
||
|
|
(define (set-close-down-mode display mode)
|
||
|
|
(%set-close-down-mode (display-Xdisplay display)
|
||
|
|
mode))
|
||
|
|
|
||
|
|
(import-lambda-definition %set-close-down-mode (Xdisplay mode)
|
||
|
|
"scx_Set_Close_Down_Mode")
|
||
|
|
|
||
|
|
(define (get-pointer-mapping display)
|
||
|
|
(%get-pointer-mapping (display-Xdisplay display)))
|
||
|
|
|
||
|
|
(import-lambda-definition %get-pointer-mapping (Xdisplay)
|
||
|
|
"scx_Get_Pointer_Mapping")
|
||
|
|
|
||
|
|
(define (set-pointer-mapping display mapping)
|
||
|
|
(%set-pointer-mapping (display-Xdisplay display)
|
||
|
|
mapping))
|
||
|
|
|
||
|
|
(import-lambda-definition %set-pointer-mapping (Xdisplay map)
|
||
|
|
"scx_Set_Pointer_Mapping")
|