fixed replace-window
fixed focusing added delete-window on managers
This commit is contained in:
frese
parent
83234bc82d
commit
248b97a1fc
134
src/manager.scm
134
src/manager.scm
|
|
@ -66,7 +66,8 @@
|
|||
(make-wm-hint-alist (input? #t)))
|
||||
;; class-hint ??
|
||||
(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
|
||||
(make-wm-hint-alist
|
||||
(input? #t)))
|
||||
|
|
@ -74,7 +75,7 @@
|
|||
;; TODO: Colormaps
|
||||
|
||||
;; spawn handlers ************************************************
|
||||
(spawn* (list 'manager type)
|
||||
(spawn* (list 'manager wm)
|
||||
(lambda (release)
|
||||
(call-with-event-channel
|
||||
(wm:dpy wm) (wm:window wm)
|
||||
|
|
@ -117,24 +118,31 @@
|
|||
(send internal-out-channel '(fit-windows)))
|
||||
|
||||
((focus-change-event? xevent)
|
||||
;; really send it always ??
|
||||
(send internal-out-channel '(update-manager-state)))
|
||||
|
||||
;; the manager got the focus (as a client)
|
||||
((client-message-event? xevent)
|
||||
(let* ((p (client-message-event-property xevent))
|
||||
(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)))
|
||||
(time (cadr (property:data p)))
|
||||
(client (wm:current-client wm)))
|
||||
(if (and client
|
||||
(equal? name (intern-atom dpy "WM_TAKE_FOCUS" #t)))
|
||||
(handle-external-message wm exit
|
||||
(list 'select-client client time))
|
||||
(set-input-focus dpy main-window (revert-to parent)
|
||||
time))
|
||||
(if (equal? name (intern-atom dpy "WM_TAKE_FOCUS" #f))
|
||||
(begin
|
||||
(set-input-focus dpy main-window (revert-to parent) time)
|
||||
(if client
|
||||
(handle-external-message wm exit
|
||||
(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)
|
||||
|
|
@ -201,7 +209,7 @@
|
|||
)))
|
||||
|
||||
(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)))
|
||||
|
||||
;; *** external messages *********************************************
|
||||
|
|
@ -237,6 +245,10 @@
|
|||
(in-channel client:in-channel)
|
||||
(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)
|
||||
(mdisplay "creating client for " window "\n")
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
|
|
@ -255,7 +267,7 @@
|
|||
|
||||
(define (create-client-handler wm client)
|
||||
(spawn*
|
||||
(list "client-handler " (wm:type wm))
|
||||
(list 'client-handler wm client)
|
||||
(lambda (release)
|
||||
(call-with-event-channel
|
||||
(wm:dpy wm) (client:client-window client)
|
||||
|
|
@ -268,6 +280,7 @@
|
|||
(call-with-event-channel
|
||||
(wm:dpy wm) (client:window client)
|
||||
(event-mask property-change
|
||||
focus-change
|
||||
structure-notify)
|
||||
(lambda (client-channel)
|
||||
(call-with-current-continuation
|
||||
|
|
@ -279,8 +292,9 @@
|
|||
(lambda (msg)
|
||||
(case (car msg)
|
||||
((restart-handler)
|
||||
(mdisplay "restart-handler " wm " " client "\n")
|
||||
(create-client-handler wm client)
|
||||
(exit)))))
|
||||
(exit 'restart)))))
|
||||
(wrap (receive-rv client-window-channel)
|
||||
(lambda (xevent)
|
||||
(handle-client-window-xevent wm exit client xevent)))
|
||||
|
|
@ -296,15 +310,22 @@
|
|||
(and (pair? l) (car l))))
|
||||
|
||||
(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))
|
||||
(internal-out-channel (wm:internal-out-channel wm)))
|
||||
(internal-out-channel (wm:internal-out-channel wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(if client
|
||||
(begin
|
||||
(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))
|
||||
;; update everything... TODO
|
||||
;;(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 ??
|
||||
(map-window (wm:dpy wm) new-window)
|
||||
(send internal-out-channel (list 'update-client-state client))
|
||||
|
|
@ -340,42 +361,65 @@
|
|||
(wm-select-client wm client (button-event-time xevent))))
|
||||
|
||||
((destroy-window-event? xevent)
|
||||
(mdisplay "client-window destroyed\n")
|
||||
(exit)))))
|
||||
(mdisplay "client-window destroyed" wm client "\n")
|
||||
(exit 'destroy)))))
|
||||
|
||||
(define (handle-client-xevent wm exit client xevent)
|
||||
(let ((type (any-event-type xevent))
|
||||
(internal-out-channel (wm:internal-out-channel wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(cond
|
||||
((property-event? xevent)
|
||||
(let ((name (get-atom-name (property-event-display xevent)
|
||||
(property-event-atom xevent))))
|
||||
(if (or (destroy-window-event? xevent)
|
||||
(window-exists? dpy (client:window client)))
|
||||
(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))))
|
||||
;; TODO: withdrawn-state etc. unmap-event ...
|
||||
((destroy-window-event? xevent)
|
||||
(mdisplay "destroy-window client\n")
|
||||
(wm-deinit-client wm client)
|
||||
(exit))
|
||||
)))
|
||||
((eq? (event-type focus-out) type)
|
||||
(let ((mode (focus-change-event-mode xevent))
|
||||
(detail (focus-change-event-detail xevent)))
|
||||
(if (and (eq? mode (notify-mode normal))
|
||||
(memq detail (list (notify-detail nonlinear)
|
||||
(notify-detail nonlinear-virtual)
|
||||
(notify-detail ancestor))))
|
||||
;; focus lost -- if window-exists?
|
||||
(uninstall-colormaps dpy (client:window client)))))
|
||||
((eq? (event-type focus-in) type)
|
||||
(let ((mode (focus-change-event-mode xevent))
|
||||
(detail (focus-change-event-detail xevent)))
|
||||
(if (and (eq? mode (notify-mode normal))
|
||||
(memq detail (list (notify-detail nonlinear)
|
||||
(notify-detail nonlinear-virtual)
|
||||
(notify-detail ancestor))))
|
||||
;; focus taken -- if window-exists?
|
||||
(install-colormaps dpy (client:window client)))))
|
||||
|
||||
((property-event? xevent)
|
||||
(let ((name (get-atom-name (property-event-display xevent)
|
||||
(property-event-atom xevent))))
|
||||
(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)
|
||||
(filter (lambda (c)
|
||||
|
|
|
|||
Loading…
Reference in New Issue