From 16ea422cd20e7c7a1ef372a2acf16014466f64b2 Mon Sep 17 00:00:00 2001 From: frese Date: Fri, 25 Apr 2003 12:21:52 +0000 Subject: [PATCH] modified client creation added some window-exists? checks --- src/manager.scm | 134 ++++++++++++++++++++++++---------------------- src/move-wm.scm | 40 +++++++------- src/switch-wm.scm | 18 ++++--- 3 files changed, 101 insertions(+), 91 deletions(-) diff --git a/src/manager.scm b/src/manager.scm index 0451094..1d308cd 100644 --- a/src/manager.scm +++ b/src/manager.scm @@ -152,10 +152,11 @@ (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)) + ;; sync?? + ;;(if (window-exists? dpy window) + ;; (map-window dpy window)) ;;(send internal-out-channel (list 'fit-client client)) ;;(send internal-out-channel (list 'update-client-state client)) ))) @@ -172,22 +173,21 @@ (eq? window (client:window c))) (wm:clients wm)))) (if client - (begin - (reparent-to-root dpy window) - (handle-external-message wm exit - (list 'deinit-client client)))))) + (reparent-to-root dpy window)))) ((destroy-manager) ;; (send internal-out-channel '(deinit-manager)) ;; sync ?? - (destroy-window dpy (wm:window wm))) + (if (window-exists? dpy (wm:window wm)) + (destroy-window dpy (wm:window wm)))) ((deinit-client) (let ((client (second msg))) (set-wm:clients! wm (filter (lambda (c) (not (eq? c client))) (wm:clients wm))) (if (eq? (wm:current-client wm) client) - (set-wm:current-client! wm #f)) ;; select another ?? + (set-wm:current-client! wm (and (not (null? (wm:clients wm))) + (car (wm:clients wm))))) (send (wm:internal-out-channel wm) (list 'deinit-client client)) ;; sync ?? (destroy-window dpy (client:client-window client)))) @@ -198,7 +198,8 @@ (for-each (lambda (client) (set-wm:current-client! wm client) (raise-window dpy (client:client-window client)) - (take-focus dpy (client:window client) time)) + (if (window-exists? dpy (client:window client)) + (take-focus dpy (client:window client) time))) (cons client (transients-for-client wm client))) ; (for-each (lambda (c) ; (if (not (eq? c client)) @@ -272,6 +273,7 @@ (client (make-client window client-window in-channel #f))) (reparent-window dpy window client-window 0 0) (create-client-handler wm client) + ;;(map-window dpy window) client)) (define (create-client-handler wm client) @@ -284,7 +286,7 @@ enter-window button-press structure-notify - focus-change) + substructure-redirect) (lambda (client-window-channel) (call-with-event-channel (wm:dpy wm) (client:window client) @@ -331,6 +333,7 @@ (reparent-window dpy new-window (client:client-window client) 0 0)) (send (client:in-channel client) '(restart-handler)) + ;; wait ?! ;; update everything... TODO ;;(send internal-out-channel (list 'init-client client #f)) (send internal-out-channel (list 'fit-client client)) @@ -353,14 +356,22 @@ ((configure-event? xevent) (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 - ;; anyway. - (if (window-exists? dpy (client:window client)) ;; TODO: not perfect - (send internal-out-channel - (list 'update-client-state client)))) - + ((configure-request-event? xevent) + (let ((changes (configure-request-event-window-change-alist xevent))) + (if (or (assq (window-change width) changes) + (assq (window-change height) changes) + (assq (window-change border-width) changes)) + (begin + (configure-window dpy (client:window client) + (filter (lambda (a.v) + (memq (car a.v) + (list (window-change width) + (window-change height)))) + changes)) + (send internal-out-channel (list 'fit-client-window client))) + (send-configuration dpy (client:window client))))) + ((circulate-event? xevent) + (send internal-out-channel (list 'update-client-state client))) ((eq? (event-type enter-notify) type) (if (memq 'enter (get-option-value (wm:options wm) 'focus-policy)) (wm-select-client wm client (crossing-event-time xevent)))) @@ -379,55 +390,48 @@ (dpy (wm:dpy wm))) (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))))) + (if (window-exists? dpy (client:window client)) + (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)))) + (uninstall-colormaps dpy (client:window client))))) + (send internal-out-channel + (list 'update-client-state 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))))) + (if (window-exists? dpy (client:window client)) + (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)))) + (install-colormaps dpy (client:window client))))) + (send internal-out-channel + (list 'update-client-state 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)) - ) + (if (window-exists? dpy (client:window client)) + (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 + )))) ((reparent-event? xevent) - (if (or (not (window-exists? dpy (client:window client))) - (not (eq? (client:client-window client) - (window-parent dpy (client:window client))))) + (if (and (window-exists? dpy (client:window client)) + (not (eq? (client:client-window client) + (window-parent dpy (client:window client))))) (begin + ;; window has been reparented away (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)) @@ -450,11 +454,13 @@ (define (client-name dpy client) (let* ((w (client:window client)) - (cname (let* ((p (get-wm-name dpy w)) - (l (if p (property->string-list p) '()))) - (if (null? l) - "" - (car l))))) + (cname (if (window-exists? dpy w) + (let* ((p (get-wm-name dpy w)) + (l (if p (property->string-list p) '()))) + (if (null? l) + "" + (car l))) + ""))) (with-lock *client-names-lock* (lambda () (let ((name? (let ((p (assq w *client-names*))) diff --git a/src/move-wm.scm b/src/move-wm.scm index dd2628e..ace33c0 100644 --- a/src/move-wm.scm +++ b/src/move-wm.scm @@ -73,8 +73,7 @@ 'normal)) (titlebar (car (client:data client))) (name (client-name (wm:dpy wm) client))) - (set-titlebar-state! titlebar state) - (set-titlebar-title! titlebar name))) + (set-titlebar-title+state! titlebar name state))) )) (loop)) (free-gc (wm:dpy wm) gc))) @@ -87,6 +86,7 @@ (resizer (create-resizer wm client)) (options (wm:options wm))) (set-client:data! client (list titlebar resizer)) + (set-titlebar-title! titlebar (client-name dpy client)) (let ((bw (get-option-value options 'border-width)) (th (get-option-value options 'titlebar-height))) (move-resize-window dpy (client:client-window client) @@ -130,9 +130,9 @@ (loop)))) (map-titlebar titlebar) - (map-window dpy (client:client-window client)) - ;;(select-client wm client))) ?? - ))) + (if (window-exists? dpy (client:window client)) + (map-window dpy (client:window client))) + (map-window dpy (client:client-window client))))) (define (create-client-titlebar channel wm client) (let ((options (wm:options wm))) @@ -161,13 +161,14 @@ (titlebar-height (get-option-value options 'titlebar-height)) (wa (get-window-attributes dpy (client:client-window client)))) ;; TODO: is called much too often - (move-resize-window dpy (client:window client) - border-width - (+ border-width titlebar-height) - (- (window-attribute:width wa) (* 2 border-width)) - (- (window-attribute:height wa) - (+ (* 2 border-width) titlebar-height))) - + (if (window-exists? dpy (client:window client)) + (move-resize-window dpy (client:window client) + border-width + (+ border-width titlebar-height) + (- (window-attribute:width wa) + (* 2 border-width)) + (- (window-attribute:height wa) + (+ (* 2 border-width) titlebar-height)))) (move-resize-titlebar (car (client:data client)) (make-rectangle border-width border-width @@ -178,13 +179,14 @@ (let* ((dpy (wm:dpy wm)) (options (wm:options wm)) (border-width (get-option-value options 'border-width)) - (titlebar-height (get-option-value options 'titlebar-height)) - (wa (get-window-attributes dpy (client:window client)))) - (resize-window dpy (client:client-window client) - (+ (window-attribute:width wa) (* 2 border-width)) - (+ (window-attribute:height wa) - (* 2 border-width) - titlebar-height)))) + (titlebar-height (get-option-value options 'titlebar-height))) + (if (window-exists? dpy (client:window client)) + (let ((wa (get-window-attributes dpy (client:window client)))) + (resize-window dpy (client:client-window client) + (+ (window-attribute:width wa) (* 2 border-width)) + (+ (window-attribute:height wa) + (* 2 border-width) + titlebar-height)))))) (define (assert-client-visible wm client) (let* ((dpy (wm:dpy wm)) diff --git a/src/switch-wm.scm b/src/switch-wm.scm index 3abcf6a..e6c42d6 100644 --- a/src/switch-wm.scm +++ b/src/switch-wm.scm @@ -95,7 +95,7 @@ (let* ((client (second msg)) (dpy (wm:dpy wm)) (window (client:window client))) - (if (window-exists? dpy (client:window client)) + (if (window-exists? dpy window) (let ((state (if (window-contains-focus? dpy window) 'focused (if (window-viewable? dpy window) @@ -103,8 +103,7 @@ 'normal))) (titlebar (assq/false client (data:titlebars data))) (name (client-name dpy client))) - (set-titlebar-state! titlebar state) - (set-titlebar-title! titlebar name))))) + (set-titlebar-title+state! titlebar name state))))) ((select-next) (select-next-client wm (second msg))) ((select-previous) (select-previous-client wm (second msg))) @@ -155,7 +154,7 @@ (fit-titlebars wm data) (update-titlebars wm data) (fit-client-window wm client) - ;;(fit-client wm client) + (fit-client wm client) (install-dragging-control channel dpy (titlebar:window titlebar) @@ -186,9 +185,9 @@ (loop)))) (map-titlebar titlebar) - (map-window dpy (client:client-window client)) - ;;(select-client wm client))) ?? - ))) + (if (window-exists? dpy (client:window client)) + (map-window dpy (client:window client))) + (map-window dpy (client:client-window client))))) (define (create-client-titlebar channel wm client) (let ((options (wm:options wm))) @@ -234,7 +233,10 @@ ;; *** (define (fit-client wm client) - (maximize-window (wm:dpy wm) (client:window client))) + (let ((window (client:window client)) + (dpy (wm:dpy wm))) + (if (window-exists? dpy window) + (maximize-window dpy window)))) (define (fit-client-window wm client) (let* ((dpy (wm:dpy wm))