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

modified client creation/destruction 

changed attach window-list
This commit is contained in:
frese 2003-04-25 12:54:29 +00:00
parent ffa4d4f937
commit dfd4bcfb28
1 changed files with 31 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/root-manager.scm
View File

@ -71,7 +71,8 @@
(spawn* '(root-wm)
(lambda (release)
(call-with-event-channel
dpy window (event-mask substructure-redirect)
dpy window (event-mask substructure-redirect
substructure-notify)
(lambda (event-channel)
(release)
(call-with-current-continuation
@ -137,8 +138,10 @@
(root-wm-manage-window root-wm (map-request-event-window xevent)))
((and (unmap-event? xevent) (not (unmap-event-from-configure? xevent)))
;; syntetic unmap event for a transition to withdrawn state
(set-wm-state! dpy (unmap-event-window xevent)
(wm-state withdrawn) none))
(let* ((window (unmap-event-window xevent))
(wm (manager-of-window root-wm window)))
(set-wm-state! dpy window (wm-state withdrawn) none)
(wm-unmanage-window wm window)))
)))
(define (do-split root-wm orientation new-wm)
@ -271,7 +274,6 @@
(if replacement?
(client-replace-window parent (wm:window wm) replacement?))
;; sync??
(mdisplay "TEST\n")
(destroy-wm wm)))
((execute)
(let* ((cm (root-wm:current-manager root-wm))
@ -283,13 +285,19 @@
(run (sh -c ,(string-append exec " &"))))))
((attach)
(let* ((cm (root-wm:current-manager root-wm))
(windows-above (window-path (wm:dpy cm) (wm:window cm)))
(all-names
(map cdr (filter (lambda (win.name)
;; remove all that are below the current-wm
(not (member (wm:window cm)
(window-path (wm:dpy cm)
(car win.name)))))
(get-all-window-names))))
(map cdr (filter
(lambda (win.name)
;; remove all that are above the current-wm,
;; all workspaces and all windows that are
;; already managed by the current-wm
(let ((win (car win.name)))
(and (not (member win windows-above))
(not (is-workspace-window? root-wm win))
(not (eq? cm
(manager-of-window root-wm win))))))
(get-all-window-names))))
(attach (prompt (root-wm:dpy root-wm) (wm:window cm)
(get-option-value (root-wm:options root-wm)
'attach-question)
@ -409,12 +417,13 @@
(let ((child (child-at window x y)))
(if child
(window-at child x y)
window))))
(manager-of-window (lambda (window)
(or (get-manager-by-window root-wm window)
(let ((w (window-parent dpy window)))
(and w (manager-of-window w)))))))
(manager-of-window (window-at root-window x y))))
window)))))
(manager-of-window root-wm (window-at root-window x y))))
(define (manager-of-window root-wm window)
(or (get-manager-by-window root-wm window)
(let ((w (window-parent (root-wm:dpy root-wm) window)))
(and w (manager-of-window root-wm w)))))
(define (get-manager-by-window root-wm window)
(let ((l (filter (lambda (wm)
@ -423,6 +432,12 @@
(and (not (null? l))
(car l))))
(define (is-workspace-window? root-wm window)
(let ((p (window-parent (root-wm:dpy root-wm) window)))
(and p
(let ((wm (manager-of-window root-wm p)))
(and wm (eq? wm (root-wm:initial-manager root-wm)))))))
(define (create-new-manager root-wm type options parent)
(let* ((creator (cond
((eq? type (manager-type split)) create-split-wm)