- added root-drop

- made splitting more general

src/root-manager.scm

@@ -59,32 +59,46 @@
 (define (handle-message root-wm exit msg)
   (case (car msg)
     ((split-vertical split-horizontal)
-     ;; TODO: ask for second manager
      (let* ((current (root-wm:current-manager root-wm))
 	    (parent (manager-parent root-wm current)) ;; #f if root
 	    (dpy (wm:dpy current))
-	    (parent-window (or (and parent (wm:window parent))
-			       (default-root-window dpy)))
 	    (in-channel (root-wm:in-channel root-wm))
 	    (orientation (if (eq? 'split-vertical (car msg))
 			     'vertical 'horizontal))
-	    (splitter (create-split-wm in-channel dpy parent-window
+	    (splitter (create-split-wm in-channel dpy
+				       (window-parent dpy (wm:window current))
 				       ;; TODO other options
 				       (list (cons 'orientation orientation))))
 	    (first current)
+	    ;; TODO: ask for second manager
 	    (second (create-switch-wm in-channel dpy (wm:window splitter)
+				      ;; TODO options
 				      '())))
+       ;; we just replace the client:window
+       (if parent
+	   (client-replace-window parent (wm:window current)
+				  (wm:window splitter))
+	   (map-window dpy (wm:window splitter))) ;; maybe resize ??
        (wm-manage-window splitter (wm:window first))
        (wm-manage-window splitter (wm:window second))
-       (if parent
+
-	   (wm-manage-window parent (wm:window splitter))
-	   (map-window dpy (wm:window splitter)))
        (add-manager! root-wm splitter)
        (add-manager! root-wm second)))
+
     ((manager-focused)
      (let ((manager (second msg)))
-       (set-root-wm:current-manager! root-wm manager)))
+       ;; a split-wm should never be the current manager
-    ((root-drop) ...)
+       (if (not (eq? (manager-type split) (wm:type manager)))
+	     (set-root-wm:current-manager! root-wm manager))))
+    ((root-drop)
+     (let ((window (second msg))
+	   (pointer-x (third msg))
+	   (pointer-y (fourth msg)))
+       (let ((manager (find-manager-at root-wm pointer-x pointer-y)))
+	 (if manager
+	     (wm-manage-window manager window)
+	     (mdisplay "did not find a manager at " pointer-x ":"
+		       pointer-y "\n")))))
     (else (mdisplay "unknown root message: " msg "\n"))))
 
 ;; *** observing managers ********************************************
@@ -126,3 +140,22 @@
 	      (loop (window-parent (root-wm:dpy root-wm)
 				   parent-window))
 	      (car l))))))
+
+(define (find-manager-at root-wm x y)
+  ;; returns the upper-most manager at root-window's coords x y
+  (let* ((dpy (root-wm:dpy root-wm))
+	 (candidates
+	  (filter (lambda (wm)
+		    (point-in-rectangle? (root-rectangle dpy (wm:window wm))
+					 x y))
+		  (root-wm:managers root-wm))))
+    (letrec ((loop (lambda (wm level rest)
+		     (if (null? rest)
+			 wm
+			 (let* ((next (car rest))
+				(next-level (window-level dpy
+							  (wm:window next))))
+			   (if (> next-level level)
+			       (loop next next-level (cdr rest))
+			       (loop wm level (cdr rest))))))))
+      (loop #f -1 candidates))))