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

fixed replace-window 

fixed focusing
added delete-window on managers
This commit is contained in:
frese 2003-04-11 01:11:46 +00:00
parent 83234bc82d
commit 248b97a1fc
1 changed files with 89 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
src/manager.scm
View File

@ -66,7 +66,8 @@
(make-wm-hint-alist (input? #t))) (make-wm-hint-alist (input? #t)))
;; class-hint ?? ;; class-hint ??
(set-wm-protocols! dpy main-window (set-wm-protocols! dpy main-window
(list (intern-atom dpy "WM_TAKE_FOCUS" #t))) (list (intern-atom dpy "WM_TAKE_FOCUS" #f)
(intern-atom dpy "WM_DELETE_WINDOW" #f)))
(set-wm-hints! dpy main-window (set-wm-hints! dpy main-window
(make-wm-hint-alist (make-wm-hint-alist
(input? #t))) (input? #t)))
@ -74,7 +75,7 @@
;; TODO: Colormaps ;; TODO: Colormaps
;; spawn handlers ************************************************ ;; spawn handlers ************************************************
(spawn* (list 'manager type) (spawn* (list 'manager wm)
(lambda (release) (lambda (release)
(call-with-event-channel (call-with-event-channel
(wm:dpy wm) (wm:window wm) (wm:dpy wm) (wm:window wm)
@ -117,24 +118,31 @@
(send internal-out-channel '(fit-windows))) (send internal-out-channel '(fit-windows)))
((focus-change-event? xevent) ((focus-change-event? xevent)
;; really send it always ??
(send internal-out-channel '(update-manager-state))) (send internal-out-channel '(update-manager-state)))
;; the manager got the focus (as a client) ;; the manager got the focus (as a client)
((client-message-event? xevent) ((client-message-event? xevent)
(let* ((p (client-message-event-property xevent)) (let* ((p (client-message-event-property xevent))
(type (property:type p))) (type (property:type p)))
(if (equal? type (intern-atom dpy "WM_PROTOCOLS" #t)) (if (equal? type (intern-atom dpy "WM_PROTOCOLS" #f))
(let ((name (car (property:data p))) (let ((name (car (property:data p)))
(time (cadr (property:data p))) (time (cadr (property:data p)))
(client (wm:current-client wm))) (client (wm:current-client wm)))
(if (and client (if (equal? name (intern-atom dpy "WM_TAKE_FOCUS" #f))
(equal? name (intern-atom dpy "WM_TAKE_FOCUS" #t))) (begin
(handle-external-message wm exit (set-input-focus dpy main-window (revert-to parent) time)
(list 'select-client client time)) (if client
(set-input-focus dpy main-window (revert-to parent) (handle-external-message wm exit
time)) (list 'select-client client
time)))))
(if (equal? name (intern-atom dpy "WM_DELETE_WINDOW" #f))
(if (null? (wm:clients wm))
;; (destroy-wm wm) would dead-lock
(handle-external-message wm exit '(destroy-manager))))
)))) ))))
((destroy-window-event? xevent)
(exit 'destroy))
))) )))
(define (handle-external-message wm exit msg) (define (handle-external-message wm exit msg)
@ -201,7 +209,7 @@
))) )))
(define (wm-deinit-client wm client) (define (wm-deinit-client wm client)
(mdisplay "manager deinit-client\n") (mdisplay "manager deinit-client " wm " " client "\n")
(send (wm:in-channel wm) (list 'deinit-client client))) (send (wm:in-channel wm) (list 'deinit-client client)))
;; *** external messages ********************************************* ;; *** external messages *********************************************
@ -237,6 +245,10 @@
(in-channel client:in-channel) (in-channel client:in-channel)
(data client:data set-client:data!)) (data client:data set-client:data!))
(define-record-discloser :client
(lambda (c)
`(Client ,(client:window c) in ,(client:client-window c))))
(define (create-client wm window) (define (create-client wm window)
(mdisplay "creating client for " window "\n") (mdisplay "creating client for " window "\n")
(let* ((dpy (wm:dpy wm)) (let* ((dpy (wm:dpy wm))
@ -255,7 +267,7 @@
(define (create-client-handler wm client) (define (create-client-handler wm client)
(spawn* (spawn*
(list "client-handler " (wm:type wm)) (list 'client-handler wm client)
(lambda (release) (lambda (release)
(call-with-event-channel (call-with-event-channel
(wm:dpy wm) (client:client-window client) (wm:dpy wm) (client:client-window client)
@ -268,6 +280,7 @@
(call-with-event-channel (call-with-event-channel
(wm:dpy wm) (client:window client) (wm:dpy wm) (client:window client)
(event-mask property-change (event-mask property-change
focus-change
structure-notify) structure-notify)
(lambda (client-channel) (lambda (client-channel)
(call-with-current-continuation (call-with-current-continuation
@ -279,8 +292,9 @@
(lambda (msg) (lambda (msg)
(case (car msg) (case (car msg)
((restart-handler) ((restart-handler)
(mdisplay "restart-handler " wm " " client "\n")
(create-client-handler wm client) (create-client-handler wm client)
(exit))))) (exit 'restart)))))
(wrap (receive-rv client-window-channel) (wrap (receive-rv client-window-channel)
(lambda (xevent) (lambda (xevent)
(handle-client-window-xevent wm exit client xevent))) (handle-client-window-xevent wm exit client xevent)))
@ -296,15 +310,22 @@
(and (pair? l) (car l)))) (and (pair? l) (car l))))
(define (client-replace-window wm old-window new-window) (define (client-replace-window wm old-window new-window)
(mdisplay "client-replace-window: " wm " " old-window " " new-window "\n")
(let ((client (client-of-window wm old-window)) (let ((client (client-of-window wm old-window))
(internal-out-channel (wm:internal-out-channel wm))) (internal-out-channel (wm:internal-out-channel wm))
(dpy (wm:dpy wm)))
(if client (if client
(begin (begin
(set-client:window! client new-window) (set-client:window! client new-window)
(if (not (equal? (window-parent dpy new-window)
(client:client-window client)))
(reparent-window dpy new-window (client:client-window client)
0 0))
(send (client:in-channel client) '(restart-handler)) (send (client:in-channel client) '(restart-handler))
;; update everything... TODO ;; update everything... TODO
;;(send internal-out-channel (list 'init-client client #f)) ;;(send internal-out-channel (list 'init-client client #f))
(send internal-out-channel (list 'fit-windows client)) (send internal-out-channel (list 'fit-client client))
;;(send internal-out-channel (list 'fit-windows client))
;; sync ?? ;; sync ??
(map-window (wm:dpy wm) new-window) (map-window (wm:dpy wm) new-window)
(send internal-out-channel (list 'update-client-state client)) (send internal-out-channel (list 'update-client-state client))
@ -340,42 +361,65 @@
(wm-select-client wm client (button-event-time xevent)))) (wm-select-client wm client (button-event-time xevent))))
((destroy-window-event? xevent) ((destroy-window-event? xevent)
(mdisplay "client-window destroyed\n") (mdisplay "client-window destroyed" wm client "\n")
(exit))))) (exit 'destroy)))))
(define (handle-client-xevent wm exit client xevent) (define (handle-client-xevent wm exit client xevent)
(let ((type (any-event-type xevent)) (let ((type (any-event-type xevent))
(internal-out-channel (wm:internal-out-channel wm)) (internal-out-channel (wm:internal-out-channel wm))
(dpy (wm:dpy wm))) (dpy (wm:dpy wm)))
(cond (if (or (destroy-window-event? xevent)
((property-event? xevent) (window-exists? dpy (client:window client)))
(let ((name (get-atom-name (property-event-display xevent)
(property-event-atom xevent))))
(cond (cond
((equal? "WM_NAME" name) ((eq? (event-type focus-out) type)
(send internal-out-channel (let ((mode (focus-change-event-mode xevent))
(list 'update-client-state client))) (detail (focus-change-event-detail xevent)))
;; TODO: respect NORMAL_HINTS change (if (and (eq? mode (notify-mode normal))
))) (memq detail (list (notify-detail nonlinear)
((configure-event? xevent) (notify-detail nonlinear-virtual)
;; TODO: we have to prevent this event if changed the size on our own. (notify-detail ancestor))))
;; --> XReconfigureWMWindow ?? ;; focus lost -- if window-exists?
(send internal-out-channel (list 'fit-client-window client)) (uninstall-colormaps dpy (client:window client)))))
) ((eq? (event-type focus-in) type)
((reparent-event? xevent) (let ((mode (focus-change-event-mode xevent))
(if (or (not (window-exists? dpy (client:window client))) (detail (focus-change-event-detail xevent)))
(not (eq? (client:client-window client) (if (and (eq? mode (notify-mode normal))
(window-parent dpy (client:window client))))) (memq detail (list (notify-detail nonlinear)
(begin (notify-detail nonlinear-virtual)
(mdisplay "manager " (wm:type wm) " reparented client\n") (notify-detail ancestor))))
(wm-deinit-client wm client) ;; focus taken -- if window-exists?
(exit)))) (install-colormaps dpy (client:window client)))))
;; TODO: withdrawn-state etc. unmap-event ...
((destroy-window-event? xevent) ((property-event? xevent)
(mdisplay "destroy-window client\n") (let ((name (get-atom-name (property-event-display xevent)
(wm-deinit-client wm client) (property-event-atom xevent))))
(exit)) (cond
))) ((equal? "WM_NAME" name)
(send internal-out-channel
(list 'update-client-state client)))
;; TODO: respect NORMAL_HINTS change
)))
((configure-event? xevent)
;; TODO: we have to prevent this event if changed the size on our own.
;; --> XReconfigureWMWindow ??
(send internal-out-channel (list 'fit-client-window client))
)
((reparent-event? xevent)
(if (or (not (window-exists? dpy (client:window client)))
(not (eq? (client:client-window client)
(window-parent dpy (client:window client)))))
(begin
(mdisplay "manager " (wm:type wm) " reparented client\n")
(wm-deinit-client wm client)
(exit 'reparent))))
;; TODO: withdrawn-state etc. unmap-event ...
((destroy-window-event? xevent)
(mdisplay "destroy-window-event client " wm " " client "\n")
(if (eq? (client:window client) (destroy-window-event-event xevent))
(begin
(wm-deinit-client wm client)
(exit 'destroy))))
))))
(define (transients-for-client wm client) (define (transients-for-client wm client)
(filter (lambda (c) (filter (lambda (c)