scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added root-manager options 

added split-wm creation
This commit is contained in:
frese 2003-03-30 01:46:01 +00:00
parent ad3e6183c2
commit 17b4f5e624
1 changed files with 76 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
src/root-manager.scm
View File

@ -1,26 +1,31 @@
(define-record-type root-wm :root-wm
(make-root-wm dpy managers current-manager)
(make-root-wm dpy managers current-manager in-channel)
root-wm?
(dpy root-wm:dpy)
(managers root-wm:managers set-root-wm:managers!)
(current-manager root-wm:current-manager set-root-wm:current-manager!))
(current-manager root-wm:current-manager set-root-wm:current-manager!)
(in-channel root-wm:in-channel))
(define (create-root-wm dpy)
(let* ((window (default-root-window dpy))
(children (window-children dpy window))
(in-channel (make-channel))
(root-wm (make-root-wm dpy '() #f))
(root-wm (make-root-wm dpy '() #f in-channel))
(initial-manager (create-move-wm in-channel dpy window '())))
(mdisplay "creating root-wm\n")
(set-root-wm:managers! root-wm (list initial-manager))
(set-root-wm:current-manager! root-wm initial-manager)
(add-manager! root-wm initial-manager)
(map-window dpy (wm:window initial-manager))
(for-each (lambda (window)
(wm-manage-window initial-manager window))
children)
;;(create-move-wm in-channel dpy window '())
(grab-shortcut dpy window (string->keys dpy "M-k h") ;; -> options!
'split-horizontal in-channel #t)
(grab-shortcut dpy window (string->keys dpy "M-k v")
'split-vertical in-channel #t)
(call-with-event-channel
dpy window (event-mask substructure-redirect)
@ -52,9 +57,72 @@
)))
(define (handle-message root-wm exit msg)
'none)
(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
;; TODO other options
(list (cons 'orientation orientation))))
(first current)
(second (create-switch-wm in-channel dpy (wm:window splitter)
'())))
(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) ...)
(else (mdisplay "unknown root message: " msg "\n"))))
;; *** observing managers ********************************************
(define (add-manager! manager)
#t)
(define (add-manager! root-wm manager)
(set-root-wm:managers! root-wm (cons manager
(root-wm:managers root-wm)))
(spawn*
(lambda (release)
(call-with-event-channel
(root-wm:dpy root-wm) (wm:window manager)
(event-mask structure-notify
focus-change)
(lambda (event-channel)
(release)
(let loop ()
(let ((e (receive event-channel)))
(cond
((destroy-window-event? e) #t)
((focus-change-event? e)
;; look at mode/detail ??
(if (window-contains-focus? (root-wm:dpy root-wm)
(wm:window manager))
(send (root-wm:in-channel root-wm)
(list 'manager-focused manager)))
(loop))
(else (loop))))
(loop)))))))
(define (manager-parent root-wm manager)
(let loop ((parent-window (window-parent (root-wm:dpy root-wm)
(wm:window manager))))
(if (zero? parent-window)
#f
(let ((l (filter (lambda (m)
(equal? (wm:window m) parent-window))
(root-wm:managers root-wm))))
(if (null? l)
(loop (window-parent (root-wm:dpy root-wm)
parent-window))
(car l))))))