(define (iconify-window window screen-number)
  (check-screen-number (window-display window) screen-number)
  (if (not (%iconify-window (display-Xdisplay (window-display window))
			    (window-Xwindow window)
			    screen-number))
      (error "cannot iconify window"
	     window)))

(import-lambda-definition %iconify-window (Xdisplay Xwindow scr-num)
  "scx_Iconify_Window")

(define (withdraw-window window screen-number)
  (check-screen-number screen-number)
  (if (not (%withdraw-window (display-Xdisplay (window-display window))
			     (window-Xwindow window)
			     screen-number))
      (error "cannot withdraw window"
	     window)))

(import-lambda-definition %withdraw-window (Xdisplay Xwindow scr-num)
  "scx_Withdraw_Window")

(define (reconfigure-wm-window window screen-number . args)
  (check-screen-number screen-number)
  (if (not (%reconfigure-wm-window (display-Xdisplay (window-display window))
				   (window-Xwindow window)
				   screen-number
				   (named-args->alist args)))
      (error "cannot reconfigure window"
	     window)))

(import-lambda-definition %reconfigure-wm-window (Xdisplay Xwindow scrnum alist)
  "scx_Reconfigure_Wm_Window")

(define (wm-command window)
  (vector->list (%wm-command (display-Xdisplay (window-display window))
			     (window-Xwindow window))))

(import-lambda-definition %wm-command (Xdisplay Xwindow)
  "scx_Wm_Command")

(define (get-text-property window atom)
  (let ((res (%get-text-property (display-Xdisplay (window-display window))
				 (window-Xwindow window)
				 (atom-Xatom atom))))
    (cond
     ((eq? res #t) #f)
     ((eq? res #f) (error "cannot create string list from text property"))
     (else (vector->list res)))))

(import-lambda-definition %get-text-property (Xdisplay Xwindow Xatom)
  "scx_Get_Text_Property")

(define (set-text-property! window value atom)
  (let ((res (%set-text-property! (display-Xdisplay (window-display window))
				  (window-Xwindow window)
				  (list->vector value)
				  (atom-Xatom atom))))
    (if res
	res
	(error "cannot create text property from string list" value))))

(import-lambda-definition %set-text-property! (Xdisplay Xwindow value XAtom)
  "scx_Set_Text_Property")

(define (wm-protocols window)
  (let ((res (%wm-protocols (display-Xdisplay (window-display window))
			    (window-Xwindow window))))
    (if res
	(map make-atom
	     (vector->list res))
	(error "cannot get WM protocols"))))

(import-lambda-definition %wm-protocols (Xdisplay Xwindow)
  "scx_Wm_Protocols")

(define (set-wm-protocols! window protocols)
  (let ((res (%set-wm-protocols! (display-Xdisplay (window-display window))
				 (window-Xwindow window)
				 (list->vector (map atom-Xatom protocols)))))
    (if res
	res
	(error "cannot set WM protocols" protocols))))

(import-lambda-definition %set-wm-protocols! (Xdisplay Xwindow protocols)
  "scx_Set_Wm_Protocols")

(define (wm-class window)
  (let ((res (%wm-class (display-Xdisplay (window-display window))
			(window-Xwindow window))))
    (if res
	res
	(error "cannot get WM class hint"))))

(import-lambda-definition %wm-class (Xdisplay Xwindow)
  "scx_Wm_Class")

(define (set-wm-class! window name class)
  (%set-wm-class! (display-Xdisplay (window-display window))
		  (window-Xwindow window)
		  (if (symbol? name)
		      (symbol->string name)
		      name)
		  (if (symbol? class)
		      (symbol->string class)
		      class)))

(import-lambda-definition %set-wm-class! (Xdisplay Xwindow name class)
  "scx_Set_Wm_Class")

(define (set-wm-command! window command)
  (%set-wm-command! (display-Xdisplay (window-display window))
		    (window-Xwindow window)
		    (list->vector (map (lambda (x)
					 (if (symbol? x)
					     (symbol->string x)
					     x))
				       command))))

(import-lambda-definition %set-wm-command (Xdisplay Xwindow command)
  "scx_Set_Wm_Command")

(define (wm-hints window)
  (let ((res (%wm-hints (display-Xdisplay (window-display window))
			(window-Xwindow window)))
	(make-window* (lambda (Xwindow)
			(if (null? Xwindow)
			    Xwindow
			    (make-window Xwindow (window-display window)
					 #f))))
	(make-pixmap* (lambda (Xpixmap)
			(if (null? Xpixmap)
			    Xpixmap
			    (make-pixmap Xpixmap (window-display window)
					 #f)))))
    (vector-set! res 2 (make-pixmap* (vector-ref res 2)))
    (vector-set! res 3 (make-window* (vector-ref res 3)))
    (vector-set! res 6 (make-pixmap* (vector-ref res 6)))
    (vector-set! res 7 (make-window* (vector-ref res 7)))
    (map cons
	 '(input? initial-state icon-pixmap icon-window icon-x icon-y 
		  icon-mask window-group urgency)
	 (vector->list res))))

(import-lambda-definition %wm-hints (Xdisplay Xwindow)
  "scx_Wm_Hints")

(define (set-wm-hints! window . args)
  (%set-wm-hints! (display-Xdisplay (window-display window))
		  (window-Xwindow window)
		  (map (lambda (p)
			 (case (car p)
			   ((icon-pixmap icon-mask)
			    (cons (car p) (pixmap-Xpixmap (cdr p))))
			   ((icon-window window-group)
			    (cons (car p) (window-Xwindow (cdr p))))
			   (else p)))
		       (named-args->alist args))))

(import-lambda-definition %set-wm-hints! (Xdisplay Xwindow args)
  "scx_Set_Wm_Hints")

(define (transient-for window)
  (make-window (%transient-for (display-Xdisplay (display-window window))
			       (window-Xwindow window))
	       (window-display window)
	       #f))

(import-lambda-definition %transient-for (Xdisplay Xwindow)
  "scx_Transient_For")

(define (set-transient-for! window property-window)
  (%set-transient-for (display-Xdisplay (window-display window))
		      (window-Xwindow window)
		      (window-Xwindow property-window)))

(import-lambda-definition %set-transient-for! (Xdisplay Xwindow 
							Xpropertywindow)
  "scx_Set_Transient_For")

(define xa-wm-name (make-atom 39))
(define xa-wm-icon-name (make-atom 37))
(define xa-wm-client-machine (make-atom 36))

(define (wm-name w)
  (get-text-property w xa-wm-name))

(define (wm-icon-name w)
  (get-text-property w xa-wm-icon-name))

(define (wm-client-machine w)
  (get-text-property w xa-wm-client-machine))

(define (set-wm-name! w s)
  (set-text-property! w s xa-wm-name))

(define (set-wm-icon-name! w s)
  (set-text-property! w s xa-wm-icon-name))

(define (set-wm-client-machine! w s)
  (set-text-property! w s xa-wm-client-machine))

(define (wm-normal-hints window)
  (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
			      (window-Xwindow window)))
	 (alist (map cons
		     '(x y width height us-position us-size
			 min-width min-height max-width max-height
			 width-inc height-inc min-aspect-x min-aspect-y
			 max-aspect-x max-aspect-y base-width base-height
			 gravity)
		     (vector->list v))))
    alist))

(import-lambda-definition %wm-normal-hints (Xdisplay Xwindow)
  "scx_Wm_Normal_Hints")

(define (set-wm-normal-hints! window . args)
  (let ((alist (named-args->alist args)))
    (%set-wm-normal-hints! (display-Xdisplay (window-Xwindow window))
			   (window-Xwindow window)
			   alist)))

(import-lambda-definition %set-wm-normal-hints (Xdisplay Xwindow alist)
  "scx_Set_Wm_Normal_Hints")

(define (icon-sizes window)
  (let ((r (%icon-sizes (display-Xdisplay (window-display window))
			(window-Xwindow window))))
    (map vector->list
	 (vector->list r))))

(import-lambda-definition %icon-sizes (Xdisplay Xwindow)
  "scx_Icon_Sizes")

(define (set-icon-sizes! window icon-sizes)
  (%set-icon-sizes! (display-Xdisplay (window-display window))
		    (window-Xwindow window)
		    (list->vector (map list->vector icon-sizes))))

(import-lambda-definition %set-icon-sizes! (Xdisplay Xwindow sizes)
  "scx_Set_Icon_Sizes")