diff --git a/src/root-manager.scm b/src/root-manager.scm index ec550fd..37adb7c 100644 --- a/src/root-manager.scm +++ b/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))) - ((root-drop) ...) + ;; a split-wm should never be the current manager + (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))))