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