parent
b909da1e5f
commit
fb2fd2ec65
|
@ -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))))
|
||||
|
|
Loading…
Reference in New Issue