From 248b97a1fcc3f73a017f3ece4287145a2185d9cb Mon Sep 17 00:00:00 2001 From: frese Date: Fri, 11 Apr 2003 01:11:46 +0000 Subject: [PATCH] fixed replace-window fixed focusing added delete-window on managers --- src/manager.scm | 134 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 89 insertions(+), 45 deletions(-) diff --git a/src/manager.scm b/src/manager.scm index e7b723c..012bed6 100644 --- a/src/manager.scm +++ b/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)