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