added iconify, maximize

added show-clients

src/move-wm-icon.scm

@@ -0,0 +1,86 @@
+(define-record-type icon :icon
+  (make-icon wm client window)
+  icon?
+  (wm icon:wm)
+  (client icon:client)
+  (window icon:window))
+
+(define (create-icon wm client rect)
+  (let* ((dpy (wm:dpy wm))
+	 (window (create-simple-window dpy (wm:window wm)
+				       (rectangle:x rect) (rectangle:y rect)
+				       (rectangle:width rect)
+				       (rectangle:height rect)
+				       0
+				       (black-pixel dpy) (white-pixel dpy)))
+	 (gc (create-gc dpy window
+			(make-gc-value-alist
+			 (foreground (black-pixel dpy))
+			 (background (white-pixel dpy))))))
+    (spawn*
+     (list 'move-wm-icon wm client window)
+     (lambda (release)
+       (call-with-current-continuation
+	(lambda (exit)
+	  (call-with-event-channel
+	   dpy window (event-mask exposure
+				  structure-notify
+				  button-press)
+	   (lambda (event-channel)
+	     (release)
+	     (let loop ()
+	       (let ((xevent (receive event-channel)))
+		 (cond
+		  ((destroy-window-event? xevent) (exit 'destroyed))
+
+		  ((expose-event? xevent)
+		   (if (= 0 (expose-event-count xevent))
+		       (draw-icon dpy window gc client)))
+
+		  ((and (button-event? xevent)
+			(eq? (event-type button-press)
+			     (button-event-type xevent)))
+		   (send (wm:internal-out-channel wm)
+			 (list 'normalize-client client))
+		   (exit 'normalized)))
+		 (loop)))))))
+       (free-gc dpy gc)))
+    (make-icon wm client window)))
+
+(define (map-icon icon)
+  (map-window (wm:dpy (icon:wm icon)) (icon:window icon)))
+
+(define (destroy-icon icon)
+  (destroy-window (wm:dpy (icon:wm icon)) (icon:window icon)))
+
+(define (draw-icon dpy window gc client)
+  (let ((title (client-name dpy client)) ;; or WM_ICON_NAME ??
+	(r (clip-rectangle dpy window)))
+    (draw-image-string dpy window gc 2 14 title)))
+
+(define (find-icon-rect wm-rect icons)
+  (let* ((icon-w 200)
+	 (icon-h 18)
+	 (xs (iota (quotient (rectangle:width wm-rect) icon-w)))
+	 (ys (reverse (iota (quotient (rectangle:height wm-rect) icon-h))))
+	 (all (flatten (map (lambda (yi)
+			      (map (lambda (xi)
+				     (make-rectangle (* xi icon-w)
+						     (* yi icon-h)
+						     icon-w icon-h))
+				   xs))
+			    ys)))
+	 (icon-rects (map (lambda (i)
+			    (window-rectangle (wm:dpy (icon:wm i))
+					      (icon:window i)))
+			  icons))
+	 (free (filter (lambda (r)
+			 (not (any (lambda (ir)
+				     (rectangles-overlap? r ir))
+				   icon-rects)))
+		       all)))
+    (if (null? free)
+	(if (null? all)
+	    (make-rectangle 0 0 icon-w icon-h)
+	    (car all))
+	(car free))))

src/move-wm.scm

@@ -12,7 +12,9 @@
 
 (define (create-move-wm out-channel dpy parent options default-options
 			. children)
-  (create-wm dpy parent options default-options children
+  (create-wm dpy parent options (append default-options
+					'((focus-policy . (click))))
+	     children
 	     (manager-type move) move-wm-options-spec
 	     out-channel
 	     (lambda (wm in-channel)
@@ -77,6 +79,33 @@
 			   (append (make-window-change-alist
 				    (border-width 0))
 				   changes))))
+
+      ((iconify-client)
+       (let ((client (second msg)))
+	 (if (not (client-data:icon client))
+	     (begin
+	       (unmap-window dpy (client:client-window client))
+	       (unmap-window dpy (client:window client))
+	       (set-wm-state! dpy (client:window client) (wm-state iconic)
+			      none)
+	       (let ((icon (create-client-icon wm client)))
+		 (set-client-data:icon! client icon)
+		 (map-icon icon))))))
+
+      ((maximize-client)
+       (let ((client (second msg)))
+	 (maximize-window dpy (client:client-window client))))
+
+      ((normalize-client)
+       (let ((client (second msg)))
+	 (if (client-data:icon client)
+	     (begin
+	       (destroy-icon (client-data:icon client))
+	       (map-window dpy (client:window client))
+	       (map-window dpy (client:client-window client))
+	       (set-wm-state! dpy (client:window client) (wm-state normal)
+			      none)
+	       (set-client-data:icon! client #f)))))
       
       ((draw-client-window)
        (draw-client-window wm (second msg) gc))
@@ -97,17 +126,41 @@
 	      (state (if focused?
 			 'focused
 			 'normal))
-	      (titlebar (car (client:data client))))
+	      (titlebar (client-data:titlebar client)))
 	 (set-titlebar-state! titlebar state)))
       
       ((update-client-name)
        (let ((client (second msg))
 	     (name (third msg)))
-	 (let ((titlebar (car (client:data client))))
+	 (let ((titlebar (client-data:titlebar client)))
 	   (set-titlebar-title! titlebar name))))
+
+      ((show-clients)
+       (let ((clients (second msg)))
+	 (for-each (lambda (c)
+		     (if (client-data:icon c)
+			 (handle-message wm gc exit
+					 (list 'normalize-client c)))
+		     (raise-window dpy (client:client-window c)))
+		   clients)))
       
       (else (warn "unhandled move-wm message" wm msg)))))
 
+(define (make-client-data titlebar resizer icon)
+  (list titlebar resizer icon))
+
+(define (client-data:titlebar client)
+  (first (client:data client)))
+
+(define (client-data:resizer client)
+  (second (client:data client)))
+
+(define (client-data:icon client)
+  (third (client:data client)))
+
+(define (set-client-data:icon! client icon)
+  (set-car! (cddr (client:data client)) icon))
+
 (define (init-client wm client maybe-rect)
   (let ((dpy (wm:dpy wm)))
     (let* ((r (initial-client-rect wm (client:window client) maybe-rect))
@@ -115,7 +168,7 @@
 	   (titlebar (create-client-titlebar channel wm client))
 	   (resizer (create-resizer wm client))
 	   (options (wm:options wm)))
-      (set-client:data! client (list titlebar resizer))
+      (set-client:data! client (make-client-data titlebar resizer #f))
       (set-titlebar-title! titlebar (client-name dpy client))
       (let ((bw (get-option-value options 'border-width))
 	    (th (get-option-value options 'titlebar-height)))
@@ -155,6 +208,10 @@
 		     ;; from titlebar-buttons
 		     ((kill)
 		      (delete-window dpy (client:window client) (second msg)))
+		     ((iconify)
+		      (wm-iconify-window wm (client:window client)))
+		     ((maximize)
+		      (wm-maximize-window wm (client:window client)))
 		     ))))
 	   ;; TODO: internal channel
 	   (loop))
@@ -169,7 +226,7 @@
   (let ((options (wm:options wm)))
     (create-titlebar channel (wm:dpy wm) (client:client-window client)
 		     (wm:colormap wm)
-		     (list (cons 'buttons '(kill maximize))
+		     (list (cons 'buttons '(kill maximize iconify))
 			   (cons 'normal-colors
 				 (get-option options 'titlebar-colors))
 			   (cons 'active-colors
@@ -181,7 +238,14 @@
 
 (define (deinit-client wm client)
   (let ((dpy (wm:dpy wm)))
-    #t))
+    (set-input-focus dpy (wm:window wm) (revert-to parent) current-time)))
+
+(define (create-client-icon wm client)
+  (let* ((other-icons (filter (lambda (x) x)
+			      (map client-data:icon (wm-clients wm))))
+	 (r (find-icon-rect (clip-rectangle (wm:dpy wm) (wm:window wm))
+			    other-icons)))
+    (create-icon wm client r)))
 
 ;; ***
 
@@ -201,7 +265,7 @@
 			    (- (window-attribute:height wa)
 			       (+ (* 2 border-width) titlebar-height))))
     (move-resize-titlebar
-     (car (client:data client))
+     (client-data:titlebar client)
      (make-rectangle border-width border-width
 		     (- (window-attribute:width wa) (* 2 border-width))
 		     titlebar-height))))
@@ -223,8 +287,14 @@
   (let* ((dpy (wm:dpy wm))
 	 (win (client:client-window client))
 	 (x (window-x dpy win))
-	 (y (window-y dpy win)))
+	 (y (window-y dpy win))
-    #t)) ;; ... TODO
+	 (w (window-width (wm:window wm)))
+	 (h (window-height (wm:window wm))))
+    ;; TODO: assert-icon-visible ...
+    (if (>= x w)
+	(set-window-x! win (- w 10)))
+    (if (>= y h)
+	(set-window-y! win (- h 10)))))
 
 (define (draw-client-window wm client gc)
   (let* ((options (wm:options wm))
@@ -267,7 +337,15 @@
 	     (w.h-2 (maximal-size/hints dpy win (car w.h-1) (cdr w.h-1)))
 	     (w.h (desired-size/hints dpy win w.h-2))
 	     ;; TODO: look for a free position ?! Transients centered?
-	     (x.y (desired-position/hints dpy win (cons 0 0))))
+	     (maybe-x.y (find-free-position wm w.h (cons 0 0)))
+	     (x.y (desired-position/hints dpy win maybe-x.y)))
 	(make-rectangle (car x.y) (cdr x.y)
 			(car w.h) (cdr w.h)))))
 
+(define (find-free-position wm size default-pos)
+  (let* ((dpy (wm:dpy wm))
+	 (max-w (window-width dpy (wm:window wm)))
+	 (max-h (window-height dpy (wm:window wm)))
+	 (w (car size))
+	 (h (cdr size)))
+    default-pos)) ;; TODO

src/split-wm.scm

@@ -109,6 +109,8 @@
 		    (or first-client second-client))
 	       (let ((r (client:window (or first-client second-client))))
 		 (send (wm:out-channel wm) (list 'destroy-wm wm r)))))))
+
+      ((iconfiy-client maximize-client) #t)
       
       ((draw-client-window) #t)
       
@@ -138,6 +140,8 @@
 	 (if (data:second-client data)
 	     (wm-select-client wm (data:second-client data) time))))
 
+      ((show-clients) #t)
+
       (else (warn "unhandled split-wm message" wm msg)))))
 
 (define (calc-rectangles wm)

src/switch-wm.scm

@@ -89,6 +89,8 @@
       ((deinit-client)
        (deinit-client wm data (second msg)))
 
+      ((iconify-client maximize-client) #t)
+
       ((configure-window)
        (let ((window (second msg))
 	     (changes (third msg)))
@@ -144,6 +146,15 @@
       ((select-next) (select-next-client wm (second msg)))
       ((select-previous) (select-previous-client wm (second msg)))
 
+      ((show-clients)
+       (let ((clients (second msg)))
+	 ;; it's a list of a client and it's transients.
+	 (let ((cc (wm-current-client wm))
+	       (top (last clients)))
+	   (if (and cc (window-mapped? dpy (client:client-window cc)))
+	       (unmap-window dpy (client:client-window cc)))
+	   (map-window dpy (client:client-window top)))))
+
       (else (warn "unhandled switch-wm message" wm msg)))))
 
 (define (fit-titlebars wm data)
@@ -222,7 +233,7 @@
       (map-titlebar titlebar)
       (if (window-exists? dpy (client:window client))
 	  (map-window dpy (client:window client)))
-      (map-window dpy (client:client-window client)))))
+      (wm-select-client wm client current-time))))
 
 (define (create-client-titlebar channel wm client)
   (let ((options (wm:options wm)))
@@ -263,7 +274,12 @@
 				      (data:titlebars data)))
     (if tb (destroy-titlebar tb))
     (fit-titlebars wm data)
-    (update-titlebars wm data)))
+    (update-titlebars wm data)
+    (if (eq? client (wm-current-client wm))
+	(if (null? (wm-clients wm))
+	    (set-input-focus dpy (wm:window wm) (revert-to parent)
+			     current-time)
+	    (wm-select-client wm (car (wm-clients wm)) current-time)))))
 
 ;; ***