added windowmanager functions.

scheme/xlib/wm.scm

@@ -0,0 +1,119 @@
+(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")