;; iconfiy-window send a WM_CHANGE_STATE message (in an appropiate
;; format), to the root window of the specified screen. See
;; XIconifyWindow.

(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")

;; withdraw-window unmaps the specified window and sends a synthetic
;; UnmapNotify event to the root window of the specified screen. See
;; XWithdrawWindow.

(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")

;; reconfigure-wm-window change attributes of the specified window
;; similar to configure-window, or sends a ConfigureRequestEvent to
;; the root window if that fails. See XReconfigureWMWindow. See
;; configure-window.

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

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

;; get-wm-command reads the WM_COMMAND property from the specified
;; window and returns is as a list of strings. See XGetCommand.

(define (get-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")

;; set-wm-command! sets the WM_COMMAND property (the command and
;; arguments used to invoke the application). The command has to be
;; specified as a list of string or symbols. See XSetCommand.

(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")

;; get-text-property returns the property specified by atom of the
;; specified window as a list of strings. See XGetTextProperty.

(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")

;; set-text-property! sets the property specified by atom of the
;; specified window to value - a list of strings or symbols.

(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")

;; get-wm-protocols function returns the list of atoms stored in the
;; WM_PROTOCOLS property on the specified window. These atoms describe
;; window manager protocols in which the owner of this window is
;; willing to participate. See XGetWMProtocols.

(define (get-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")

;; set-wm-protocols! sets the WM_PROTOCOLS property of the specified
;; window. protocols has to be a list of atoms. See XSetWMProtocols.

(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")

;; get-wm-class returns the class hint for the specified window. See
;; XGetClassHint.

(define (get-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")

;; set-wm-class! sets the class hint for the specified window. See
;; XSetClassHint.

(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")

;; enumerated type for the XWMHints type. used by set-wm-hints! and
;; get-wm-hints.

(define-enumerated-type wm-hint :wm-hint
  wm-hint?
  wm-hints
  wm-hint-name
  wm-hint-index
  (input? initial-state icon-pixmap icon-window icon-position icon-mask
   window-group urgency))

(define wm-hint-alist->vector
  (make-enum-alist->vector
   wm-hints wm-hint-index
   (lambda (i)
     (case i
       ((0 7) (lambda (x) (if x 1 0)))
       ((2 5) pixmap-Xpixmap)
       ((3 6) window-Xwindow)
       (else (lambda (x) x))))))

(define vector->wm-hint-alist
  (make-vector->enum-alist
   wm-hints
   (lambda (i display)
     (case i
       ((2 5) (lambda (Xpixmap)
		(if (null? Xpixmap)
		    '()
		    (make-pixmap Xpixmap display #f))))
       ((3 6) (lambda (Xwindow)
		(if (null? Xwindow)
		    '()
		    (make-window Xwindow display #f))))
       (else (lambda (x) x))))))

;; get-wm-hints reads the window manager hints and returns them as an
;; alist mapping wm-hint types to specific values. If a hints is not
;; defined, it is not included in the alist. See wm-hint.  See
;; XGetWMHints for a description.

(define (get-wm-hints window)
  (let ((res (%wm-hints (display-Xdisplay (window-display window))
			(window-Xwindow window))))
    (filter (lambda (x) (not (null? (cdr x))))
	    (vector->wm-hint-alist res (window-display window)))))

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

;; set-wm-hints! sets the specified window manager hints. The hints
;; must be specified as an alist of wm-hint values (see above) mapping
;; to the appropiate values. See XSetWMHints.

(define (set-wm-hints! window wm-hint-alist)
  (%set-wm-hints! (display-Xdisplay (window-display window))
		  (window-Xwindow window)
		  (wm-hint-alist->vector wm-hint-alist)))

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

;; get-transient-for returns the WM_TRANSIENT_FOR property for the
;; specified window. The value of that property is a window. See
;; XGetTransientForHint.

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

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

;; set-transient-for! sets the WM_TRANSIENT_FOR property of the
;; specified window to the specified property-window. See
;; XSetTransientForHint.

(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")

;; The following function a wrappers for the get/set-text-property
;; function.

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

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

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

(define (get-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))

;; an enumerated type for XSizeHints used by get-wm-normal-hints and
;; set-wm-normal-hints!

(define-enumerated-type size-hint :size-hint
  size-hint?
  size-hints
  size-hint-name
  size-hint-index
  ;; aspect should have the form ((min-x . min-y) . (max-x . max-y))
  ;; for win-gravity see gravity in create-window.
  ;; the other hints must be pairs of integers - (x . y) or (width . height)
  ;; us-position, us-size .....!!??
  (us-position us-size position size min-size max-size resize-inc aspect
   base-size win-gravity))

(define size-hint-alist->vector
  (make-enum-alist->vector
   size-hints size-hint-index
   (lambda (i)
     (lambda (x) x))))

(define vector->size-hint-alist
  (make-vector->enum-alist
   size-hints
   (lambda (i extra)
     (lambda (x) x))))

;; get-wm-normal-hints/set-wm-normal-hints! get or set the size hints
;; stored in the WM_NORMAL_HINTS property on the specified window. The
;; hints are '(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). See XGetWMNormalHints, XSetWMNormalHints.

(define (get-wm-normal-hints window)
  (let* ((v (%wm-normal-hints (display-Xdisplay (window-display window))
			      (window-Xwindow window))))
        (filter (lambda (x) (not (null? (cdr x))))
		(vector->size-hint-alist v #f))))

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

(define (set-wm-normal-hints! window size-hint-alist)
  (%set-wm-normal-hints! (display-Xdisplay (window-Xwindow window))
			 (window-Xwindow window)
			 (size-hint-alist->vector size-hint-alist)))

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

;; get-icon-sizes returns the icon sizes specified by a window manager as
;; a list. If no icon sizes are specified the list is empty. An icon
;; size itself is a list consisting of integers meaning '(min-width
;; min-height max-width max-height width-inc height-inc). See
;; XGetIconSizes.

(define (get-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")

;; set-icon-sizes! is used only by window managers to set the
;; supported icon sizes. See icon-sizes, XSetIconSizes.

(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")