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

modified client creation 

added some window-exists? checks
This commit is contained in:
frese 2003-04-25 12:21:52 +00:00
parent f5a2a3dca8
commit 16ea422cd2
3 changed files with 101 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
src/manager.scm
View File

@ -152,10 +152,11 @@
(maybe-rect (third msg))) (maybe-rect (third msg)))
(let ((client (create-client wm window))) (let ((client (create-client wm window)))
(set-wm:clients! wm (append (wm:clients wm) (list client))) (set-wm:clients! wm (append (wm:clients wm) (list client)))
(if (window-exists? dpy window)
(map-window dpy window))
(send internal-out-channel (send internal-out-channel
(list 'init-client client maybe-rect)) (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 'fit-client client))
;;(send internal-out-channel (list 'update-client-state client)) ;;(send internal-out-channel (list 'update-client-state client))
))) )))
@ -172,22 +173,21 @@
(eq? window (client:window c))) (eq? window (client:window c)))
(wm:clients wm)))) (wm:clients wm))))
(if client (if client
(begin (reparent-to-root dpy window))))
(reparent-to-root dpy window)
(handle-external-message wm exit
(list 'deinit-client client))))))
((destroy-manager) ((destroy-manager)
;; (send internal-out-channel '(deinit-manager)) ;; (send internal-out-channel '(deinit-manager))
;; sync ?? ;; sync ??
(destroy-window dpy (wm:window wm))) (if (window-exists? dpy (wm:window wm))
(destroy-window dpy (wm:window wm))))
((deinit-client) ((deinit-client)
(let ((client (second msg))) (let ((client (second msg)))
(set-wm:clients! wm (filter (lambda (c) (not (eq? c client))) (set-wm:clients! wm (filter (lambda (c) (not (eq? c client)))
(wm:clients wm))) (wm:clients wm)))
(if (eq? (wm:current-client wm) client) (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)) (send (wm:internal-out-channel wm) (list 'deinit-client client))
;; sync ?? ;; sync ??
(destroy-window dpy (client:client-window client)))) (destroy-window dpy (client:client-window client))))
@ -198,7 +198,8 @@
(for-each (lambda (client) (for-each (lambda (client)
(set-wm:current-client! wm client) (set-wm:current-client! wm client)
(raise-window dpy (client:client-window 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))) (cons client (transients-for-client wm client)))
; (for-each (lambda (c) ; (for-each (lambda (c)
; (if (not (eq? c client)) ; (if (not (eq? c client))
@ -272,6 +273,7 @@
(client (make-client window client-window in-channel #f))) (client (make-client window client-window in-channel #f)))
(reparent-window dpy window client-window 0 0) (reparent-window dpy window client-window 0 0)
(create-client-handler wm client) (create-client-handler wm client)
;;(map-window dpy window)
client)) client))
(define (create-client-handler wm client) (define (create-client-handler wm client)
@ -284,7 +286,7 @@
enter-window enter-window
button-press button-press
structure-notify structure-notify
focus-change) substructure-redirect)
(lambda (client-window-channel) (lambda (client-window-channel)
(call-with-event-channel (call-with-event-channel
(wm:dpy wm) (client:window client) (wm:dpy wm) (client:window client)
@ -331,6 +333,7 @@
(reparent-window dpy new-window (client:client-window client) (reparent-window dpy new-window (client:client-window client)
0 0)) 0 0))
(send (client:in-channel client) '(restart-handler)) (send (client:in-channel client) '(restart-handler))
;; wait ?!
;; 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-client client)) (send internal-out-channel (list 'fit-client client))
@ -353,14 +356,22 @@
((configure-event? xevent) ((configure-event? xevent)
(if (window-exists? dpy (client:window client)) (if (window-exists? dpy (client:window client))
(send internal-out-channel (list 'fit-client client)))) (send internal-out-channel (list 'fit-client client))))
((or (focus-change-event? xevent) (circulate-event? xevent)) ((configure-request-event? xevent)
;; TODO: look at mode? or maybe only look at focus-in of the (let ((changes (configure-request-event-window-change-alist xevent)))
;; client, because the client-window never gets the focus (if (or (assq (window-change width) changes)
;; anyway. (assq (window-change height) changes)
(if (window-exists? dpy (client:window client)) ;; TODO: not perfect (assq (window-change border-width) changes))
(send internal-out-channel (begin
(list 'update-client-state client)))) (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) ((eq? (event-type enter-notify) type)
(if (memq 'enter (get-option-value (wm:options wm) 'focus-policy)) (if (memq 'enter (get-option-value (wm:options wm) 'focus-policy))
(wm-select-client wm client (crossing-event-time xevent)))) (wm-select-client wm client (crossing-event-time xevent))))
@ -379,55 +390,48 @@
(dpy (wm:dpy wm))) (dpy (wm:dpy wm)))
(cond (cond
((eq? (event-type focus-out) type) ((eq? (event-type focus-out) type)
(let ((mode (focus-change-event-mode xevent)) (if (window-exists? dpy (client:window client))
(detail (focus-change-event-detail xevent))) (let ((mode (focus-change-event-mode xevent))
(if (and (eq? mode (notify-mode normal)) (detail (focus-change-event-detail xevent)))
(memq detail (list (notify-detail nonlinear) (if (and (eq? mode (notify-mode normal))
(notify-detail nonlinear-virtual) (memq detail (list (notify-detail nonlinear)
(notify-detail ancestor)))) (notify-detail nonlinear-virtual)
;; focus lost -- if window-exists? (notify-detail ancestor))))
(uninstall-colormaps dpy (client:window client))))) (uninstall-colormaps dpy (client:window client)))))
(send internal-out-channel
(list 'update-client-state client)))
((eq? (event-type focus-in) type) ((eq? (event-type focus-in) type)
(let ((mode (focus-change-event-mode xevent)) (if (window-exists? dpy (client:window client))
(detail (focus-change-event-detail xevent))) (let ((mode (focus-change-event-mode xevent))
(if (and (eq? mode (notify-mode normal)) (detail (focus-change-event-detail xevent)))
(memq detail (list (notify-detail nonlinear) (if (and (eq? mode (notify-mode normal))
(notify-detail nonlinear-virtual) (memq detail (list (notify-detail nonlinear)
(notify-detail ancestor)))) (notify-detail nonlinear-virtual)
;; focus taken -- if window-exists? (notify-detail ancestor))))
(install-colormaps dpy (client:window client))))) (install-colormaps dpy (client:window client)))))
(send internal-out-channel
(list 'update-client-state client)))
((property-event? xevent) ((property-event? xevent)
(let ((name (get-atom-name (property-event-display xevent) (if (window-exists? dpy (client:window client))
(property-event-atom xevent)))) (let ((name (get-atom-name (property-event-display xevent)
(cond (property-event-atom xevent))))
((equal? "WM_NAME" name) (cond
(send internal-out-channel ((equal? "WM_NAME" name)
(list 'update-client-state client))) (send internal-out-channel
;; TODO: respect NORMAL_HINTS change (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) ((reparent-event? xevent)
(if (or (not (window-exists? dpy (client:window client))) (if (and (window-exists? dpy (client:window client))
(not (eq? (client:client-window client) (not (eq? (client:client-window client)
(window-parent dpy (client:window client))))) (window-parent dpy (client:window client)))))
(begin (begin
;; window has been reparented away
(mdisplay "manager " (wm:type wm) " reparented client\n") (mdisplay "manager " (wm:type wm) " reparented client\n")
(wm-deinit-client wm client) (wm-deinit-client wm client)
(exit 'reparent)))) (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) ((destroy-window-event? xevent)
(mdisplay "destroy-window-event client " wm " " client "\n") (mdisplay "destroy-window-event client " wm " " client "\n")
(if (eq? (client:window client) (destroy-window-event-event xevent)) (if (eq? (client:window client) (destroy-window-event-event xevent))
@ -450,11 +454,13 @@
(define (client-name dpy client) (define (client-name dpy client)
(let* ((w (client:window client)) (let* ((w (client:window client))
(cname (let* ((p (get-wm-name dpy w)) (cname (if (window-exists? dpy w)
(l (if p (property->string-list p) '()))) (let* ((p (get-wm-name dpy w))
(if (null? l) (l (if p (property->string-list p) '())))
"<untitled>" (if (null? l)
(car l))))) "<untitled>"
(car l)))
"<untitled>")))
(with-lock *client-names-lock* (with-lock *client-names-lock*
(lambda () (lambda ()
(let ((name? (let ((p (assq w *client-names*))) (let ((name? (let ((p (assq w *client-names*)))

40
src/move-wm.scm
View File

@ -73,8 +73,7 @@
'normal)) 'normal))
(titlebar (car (client:data client))) (titlebar (car (client:data client)))
(name (client-name (wm:dpy wm) client))) (name (client-name (wm:dpy wm) client)))
(set-titlebar-state! titlebar state) (set-titlebar-title+state! titlebar name state)))
(set-titlebar-title! titlebar name)))
)) ))
(loop)) (loop))
(free-gc (wm:dpy wm) gc))) (free-gc (wm:dpy wm) gc)))
@ -87,6 +86,7 @@
(resizer (create-resizer wm client)) (resizer (create-resizer wm client))
(options (wm:options wm))) (options (wm:options wm)))
(set-client:data! client (list titlebar resizer)) (set-client:data! client (list titlebar resizer))
(set-titlebar-title! titlebar (client-name dpy client))
(let ((bw (get-option-value options 'border-width)) (let ((bw (get-option-value options 'border-width))
(th (get-option-value options 'titlebar-height))) (th (get-option-value options 'titlebar-height)))
(move-resize-window dpy (client:client-window client) (move-resize-window dpy (client:client-window client)
@ -130,9 +130,9 @@
(loop)))) (loop))))
(map-titlebar titlebar) (map-titlebar titlebar)
(map-window dpy (client:client-window client)) (if (window-exists? dpy (client:window client))
;;(select-client wm client))) ?? (map-window dpy (client:window client)))
))) (map-window dpy (client:client-window client)))))
(define (create-client-titlebar channel wm client) (define (create-client-titlebar channel wm client)
(let ((options (wm:options wm))) (let ((options (wm:options wm)))
@ -161,13 +161,14 @@
(titlebar-height (get-option-value options 'titlebar-height)) (titlebar-height (get-option-value options 'titlebar-height))
(wa (get-window-attributes dpy (client:client-window client)))) (wa (get-window-attributes dpy (client:client-window client))))
;; TODO: is called much too often ;; TODO: is called much too often
(move-resize-window dpy (client:window client) (if (window-exists? dpy (client:window client))
border-width (move-resize-window dpy (client:window client)
(+ border-width titlebar-height) border-width
(- (window-attribute:width wa) (* 2 border-width)) (+ border-width titlebar-height)
(- (window-attribute:height wa) (- (window-attribute:width wa)
(+ (* 2 border-width) titlebar-height))) (* 2 border-width))
(- (window-attribute:height wa)
(+ (* 2 border-width) titlebar-height))))
(move-resize-titlebar (move-resize-titlebar
(car (client:data client)) (car (client:data client))
(make-rectangle border-width border-width (make-rectangle border-width border-width
@ -178,13 +179,14 @@
(let* ((dpy (wm:dpy wm)) (let* ((dpy (wm:dpy wm))
(options (wm:options wm)) (options (wm:options wm))
(border-width (get-option-value options 'border-width)) (border-width (get-option-value options 'border-width))
(titlebar-height (get-option-value options 'titlebar-height)) (titlebar-height (get-option-value options 'titlebar-height)))
(wa (get-window-attributes dpy (client:window client)))) (if (window-exists? dpy (client:window client))
(resize-window dpy (client:client-window client) (let ((wa (get-window-attributes dpy (client:window client))))
(+ (window-attribute:width wa) (* 2 border-width)) (resize-window dpy (client:client-window client)
(+ (window-attribute:height wa) (+ (window-attribute:width wa) (* 2 border-width))
(* 2 border-width) (+ (window-attribute:height wa)
titlebar-height)))) (* 2 border-width)
titlebar-height))))))
(define (assert-client-visible wm client) (define (assert-client-visible wm client)
(let* ((dpy (wm:dpy wm)) (let* ((dpy (wm:dpy wm))

18
src/switch-wm.scm
View File

@ -95,7 +95,7 @@
(let* ((client (second msg)) (let* ((client (second msg))
(dpy (wm:dpy wm)) (dpy (wm:dpy wm))
(window (client:window client))) (window (client:window client)))
(if (window-exists? dpy (client:window client)) (if (window-exists? dpy window)
(let ((state (if (window-contains-focus? dpy window) (let ((state (if (window-contains-focus? dpy window)
'focused 'focused
(if (window-viewable? dpy window) (if (window-viewable? dpy window)
@ -103,8 +103,7 @@
'normal))) 'normal)))
(titlebar (assq/false client (data:titlebars data))) (titlebar (assq/false client (data:titlebars data)))
(name (client-name dpy client))) (name (client-name dpy client)))
(set-titlebar-state! titlebar state) (set-titlebar-title+state! titlebar name state)))))
(set-titlebar-title! titlebar name)))))
((select-next) (select-next-client wm (second msg))) ((select-next) (select-next-client wm (second msg)))
((select-previous) (select-previous-client wm (second msg))) ((select-previous) (select-previous-client wm (second msg)))
@ -155,7 +154,7 @@
(fit-titlebars wm data) (fit-titlebars wm data)
(update-titlebars wm data) (update-titlebars wm data)
(fit-client-window wm client) (fit-client-window wm client)
;;(fit-client wm client) (fit-client wm client)
(install-dragging-control channel dpy (install-dragging-control channel dpy
(titlebar:window titlebar) (titlebar:window titlebar)
@ -186,9 +185,9 @@
(loop)))) (loop))))
(map-titlebar titlebar) (map-titlebar titlebar)
(map-window dpy (client:client-window client)) (if (window-exists? dpy (client:window client))
;;(select-client wm client))) ?? (map-window dpy (client:window client)))
))) (map-window dpy (client:client-window client)))))
(define (create-client-titlebar channel wm client) (define (create-client-titlebar channel wm client)
(let ((options (wm:options wm))) (let ((options (wm:options wm)))
@ -234,7 +233,10 @@
;; *** ;; ***
(define (fit-client wm client) (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) (define (fit-client-window wm client)
(let* ((dpy (wm:dpy wm)) (let* ((dpy (wm:dpy wm))