(define-options-spec switch-wm-options-spec
  (titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black"))
  (titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee"))
  (titlebar-colors-active colors '("#9999aa" "#eeeeff" "#777788" "black"))
  (titlebar-height int 18)
  (titlebar-style symbol 'raised)
  (font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
  (select-next keys "M-k n")
  (select-previous keys "M-k p")
  )

(define (create-switch-wm out-channel dpy parent options . children)
  (create-wm dpy parent options children
	     (manager-type switch) switch-wm-options-spec
	     out-channel
	     (lambda (wm in-channel)
	       (spawn* (list 'switch-wm wm)
		       (lambda (release)
			 (release)
			 (switch-wm-handler wm in-channel)))
	       wm)))

(define-record-type switch-wm-data :switch-wm-data
  (make-switch-wm-data titlebars empty-titlebar)
  switch-wm-data?
  (titlebars data:titlebars set-data:titlebars!)
  (empty-titlebar data:empty-titlebar))

(define (switch-wm-handler wm channel)
  (let* ((dpy (wm:dpy wm))
	 (window (wm:window wm))
	 (options (wm:options wm))
	 (gc (create-gc dpy window '()))
	 (empty-titlebar (create-empty-titlebar wm))
	 (data (make-switch-wm-data '() empty-titlebar)))
    (update-titlebars wm data)

    (grab-shortcut dpy window
		   (get-option-value options 'select-next)
		   'select-next channel #f)
    (grab-shortcut dpy window
		   (get-option-value options 'select-previous)
		   'select-previous channel #f)

    (let loop ()
      (let ((msg (receive channel)))
	(case (car msg)
	  ((draw-main-window)
	   (set-gc-foreground! dpy gc (black-pixel dpy))
	   (fill-rectangle* dpy window gc
			    (clip-rectangle dpy window)))

	  ((fit-windows)
	   (fit-titlebars wm data)
	   (for-each (lambda (c)
		       (fit-client-window wm c))
		     (wm-clients wm)))
	  
	  ((init-client)
	   (init-client wm data (second msg) (third msg)))
	  ((deinit-client)
	   (deinit-client wm data (second msg)))

	  ((configure-window)
	   (let ((window (second msg))
		 (changes (third msg)))
	     ;; TODO: exact sizes ?!
	     (configure-window dpy window
			       (append (make-window-change-alist
					(border-width 0))
				       changes))))
	  
	  ((draw-client-window) #f)

	  ((fit-client)
	   ;; client-window changed it's size
	   (fit-client wm (second msg)))
	  
	  ((fit-client-window)
	   ;; client changed it's size ??
	   (fit-client-window wm (second msg)))

	  ((update-manager-state)
	   (let ((state (if (window-contains-focus? dpy (wm:window wm))
			    'focused
			    'active)))
	     (set-titlebar-state! empty-titlebar state)))

	  ((manager-focused)
	   (let ((time (second msg))
		 (cc (wm-current-client wm)))
	     (if cc (wm-select-client wm cc time))))
	  
	  ((update-client-state)
	   (let* ((client (second msg))
		  (dpy (wm:dpy wm))
		  (window (client:window client)))
	     (if (window-exists? dpy (client:window client))
		 (let ((state (if (window-contains-focus? dpy window)
				  'focused
				  (if (window-viewable? dpy window)
				      'active
				      'normal)))
		       (titlebar (assq/false client (data:titlebars data)))
		       (name (client-name dpy client)))
		   (set-titlebar-state! titlebar state)
		   (set-titlebar-title! titlebar name)))))

	  ((select-next) (select-next-client wm (second msg)))
	  ((select-previous) (select-previous-client wm (second msg)))
	  ))
      (loop))
    (free-gc (wm:dpy wm) gc)))

(define (fit-titlebars wm data)
  (let* ((dpy (wm:dpy wm))
	 (width (window-width dpy (wm:window wm)))
	 (height (window-height dpy (wm:window wm)))
	 (titlebar-height (get-option-value (wm:options wm) 'titlebar-height)))
    (if (> titlebar-height 0)
	(begin
	  (move-resize-titlebar (data:empty-titlebar data)
				(make-rectangle 0 0 width titlebar-height))
	  (let* ((titlebars (map cdr (data:titlebars data)))
		 (n (length titlebars))
		 (widths (if (zero? n) '()
			     (let ((dw (quotient width n)))
			       (append (map (lambda (_) dw) (iota (- n 1)))
				       (list (- width (* dw (- n 1)))))))))
	    (for-each (lambda (i width titlebar)
			(move-resize-titlebar
			 titlebar
			 (make-rectangle (* i width) 0
					 width titlebar-height)))
		      (iota n) widths titlebars))))))

(define (update-titlebars wm data)
  (if (> (get-option-value (wm:options wm) 'titlebar-height) 0)
      (if (null? (data:titlebars data))
	  (map-titlebar (data:empty-titlebar data))
	  (begin
	    (unmap-titlebar (data:empty-titlebar data))
	    (for-each (lambda (c.t)
			(map-titlebar (cdr c.t)))
		      (data:titlebars data))))))

(define (init-client wm data client maybe-rect)
  ;; TODO: transients!
  (let ((dpy (wm:dpy wm))
	(options (wm:options wm)))
    (let* ((channel (make-channel))
	   (titlebar (create-client-titlebar channel wm client)))
      (set-data:titlebars! data (append (data:titlebars data)
					(list (cons client titlebar))))
      (fit-titlebars wm data)
      (update-titlebars wm data)
      (fit-client-window wm client)
      ;;(fit-client wm client)

      (install-dragging-control channel dpy
				(titlebar:window titlebar)
				(titlebar:window titlebar))
      (spawn*
       (list 'switch-wm-client-handler wm client)
       (lambda (release)
	 (release)
	 (let loop ()
	   (let ((msg (receive channel)))
	     (case (car msg)
	       ((drop)
		;; check if outside...
		(let ((root-x (fourth msg))
		      (root-y (fifth msg)))
		  (let ((r (root-rectangle dpy (wm:window wm))))
		    (if (not (point-in-rectangle? r root-x root-y))
			(send (wm:out-channel wm)
			      (list 'root-drop (client:window client)
				    root-x root-y))))))
	       ((click)
		(wm-select-client wm client (fourth msg)))
	       ;; from titlebar-buttons
	       ((kill)
		(delete-window dpy (client:window client) (second msg)))
	       (else (mdisplay "unhandled client message: " msg "\n"))))
	   ;; TODO: internal channel
	   (loop))))
      
      (map-titlebar titlebar)
      (map-window dpy (client:client-window client))
      ;;(select-client wm client))) ??
      )))

(define (create-client-titlebar channel wm client)
  (let ((options (wm:options wm)))
    (create-titlebar channel (wm:dpy wm) (wm:window wm)
		     (wm:colormap wm)
		     ;; TODO: buttons
		     (list (cons 'normal-colors
				 (get-option options 'titlebar-colors))
			   (cons 'active-colors
				 (get-option options 'titlebar-colors-active))
			   (cons 'focused-colors
				 (get-option options 'titlebar-colors-focused))
			   (cons 'border-style
				 (get-option options 'titlebar-style))))))

(define (create-empty-titlebar wm)
  (let* ((options (wm:options wm))
	 (tb
	  (create-titlebar #f (wm:dpy wm) (wm:window wm) (wm:colormap wm)
		   (list ;; TODO: (cons 'draggable #f)
		    (cons 'normal-colors
			  (get-option options 'titlebar-colors))
		    (cons 'active-colors
			  (get-option options 'titlebar-colors-active))
		    (cons 'focused-colors
			  (get-option options 'titlebar-colors-focused))
		    (cons 'border-style
			  (get-option options 'titlebar-style))
		    (cons 'buttons '())))))
    (set-titlebar-title! tb "<empty frame>")
    tb))

(define (deinit-client wm data client)
  (let ((dpy (wm:dpy wm))
	(tb (assq/false client (data:titlebars data))))
    (set-data:titlebars! data (filter (lambda (c.t)
					(not (eq? (car c.t) client)))
				      (data:titlebars data)))
    (if tb (destroy-titlebar tb))
    (fit-titlebars wm data)
    (update-titlebars wm data)))

;; ***

(define (fit-client wm client)
  (maximize-window (wm:dpy wm) (client:window client)))

(define (fit-client-window wm client)
  (let* ((dpy (wm:dpy wm))
	 (w (wm:window wm))
	 (options (wm:options wm))
	 (titlebar-height (get-option-value options 'titlebar-height)))
    (move-resize-window dpy (client:client-window client)
			0 titlebar-height
			(window-width dpy w) (- (window-height dpy w)
						titlebar-height))))

;; ***

(define (select-next-client* wm clients time)
  (let ((cc (wm-current-client wm)))
    (let loop ((l (append clients clients)))
      (and (not (null? l))
	   (if (eq? (car l) cc)
	       (and (not (null? (cdr l)))
		    (wm-select-client wm (cadr l) time))
	       (loop (cdr l)))))))

(define (select-next-client wm time)
  (select-next-client* wm (wm-clients wm) time))

(define (select-previous-client wm time)
  (select-next-client* wm (reverse (wm-clients wm)) time))