clearified client creation process
fixed some more problems with immediately closed clients fixed dead-lock problem with wm-select-client
This commit is contained in:
frese
parent
68e7a41372
commit
d158788001
147
src/manager.scm
147
src/manager.scm
|
|
@ -152,16 +152,23 @@
|
|||
(dpy (wm:dpy wm)))
|
||||
(case (car msg)
|
||||
((manage-window)
|
||||
(let* ((window (second msg))
|
||||
(client (create-client wm window))
|
||||
(maybe-rect (third msg)))
|
||||
(set-wm:clients! wm (append (wm:clients wm) (list client)))
|
||||
(let ((window (second msg))
|
||||
(maybe-rect (third msg)))
|
||||
(let ((client (create-client wm window)))
|
||||
(set-wm:clients! wm (append (wm:clients wm) (list client)))
|
||||
(if (window-exists? dpy window)
|
||||
(map-window dpy window))
|
||||
(send internal-out-channel
|
||||
(list 'init-client client maybe-rect))
|
||||
;;(send internal-out-channel (list 'fit-client client))
|
||||
;;(send internal-out-channel (list 'update-client-state client))
|
||||
)))
|
||||
|
||||
((configure-window)
|
||||
(let ((window (second msg))
|
||||
(changes (third msg)))
|
||||
(send internal-out-channel
|
||||
(list 'init-client client maybe-rect))
|
||||
(send internal-out-channel (list 'fit-client client))
|
||||
;; sync ??
|
||||
(map-window dpy window)
|
||||
(send internal-out-channel (list 'update-client-state client))))
|
||||
(list 'configure-window window changes))))
|
||||
|
||||
((unmanage-window)
|
||||
(let* ((window (second msg))
|
||||
|
|
@ -225,11 +232,15 @@
|
|||
;; sync ??
|
||||
)
|
||||
|
||||
(define (wm-configure-window wm window changes)
|
||||
(send (wm:in-channel wm) (list 'configure-window window changes)))
|
||||
|
||||
(define (wm-unmanage-window wm window)
|
||||
(send (wm:in-channel wm) (list 'unmanage-window window)))
|
||||
|
||||
(define (wm-select-client wm client time)
|
||||
(send (wm:in-channel wm) (list 'select-client client time)))
|
||||
(spawn (lambda ()
|
||||
(send (wm:in-channel wm) (list 'select-client client time)))))
|
||||
|
||||
(define (destroy-wm wm)
|
||||
(send (wm:in-channel wm) '(destroy-manager)))
|
||||
|
|
@ -344,8 +355,8 @@
|
|||
(send internal-out-channel
|
||||
(list 'draw-client-window client))))
|
||||
((configure-event? xevent)
|
||||
(send internal-out-channel
|
||||
(list 'fit-client client)))
|
||||
(if (window-exists? dpy (client:window client))
|
||||
(send internal-out-channel (list 'fit-client client))))
|
||||
((or (focus-change-event? xevent) (circulate-event? xevent))
|
||||
;; TODO: look at mode? or maybe only look at focus-in of the
|
||||
;; client, because the client-window never gets the focus
|
||||
|
|
@ -370,62 +381,64 @@
|
|||
(let ((type (any-event-type xevent))
|
||||
(internal-out-channel (wm:internal-out-channel wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(if (or (destroy-window-event? xevent)
|
||||
(window-exists? dpy (client:window client)))
|
||||
(cond
|
||||
((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
|
||||
((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))))
|
||||
((unmap-event? xevent)
|
||||
;; might be the transition to withdrawn-state, wm-state
|
||||
;; change by root-manager
|
||||
(wm-deinit-client wm client)
|
||||
(exit 'unmap))
|
||||
((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))))
|
||||
))))
|
||||
((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))))
|
||||
((unmap-event? xevent)
|
||||
;; might be the transition to withdrawn-state, wm-state
|
||||
;; change by root-manager --> reparent to root ??
|
||||
(if (or (not (window-exists? dpy (client:window client)))
|
||||
(not (eq? (client:client-window client)
|
||||
(window-parent dpy (client:window client)))))
|
||||
(begin
|
||||
(wm-deinit-client wm client)
|
||||
(exit 'unmap))))
|
||||
((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