modified client creation
added some window-exists? checks
This commit is contained in:
parent
f5a2a3dca8
commit
16ea422cd2
|
@ -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,25 +390,31 @@
|
||||||
(dpy (wm:dpy wm)))
|
(dpy (wm:dpy wm)))
|
||||||
(cond
|
(cond
|
||||||
((eq? (event-type focus-out) type)
|
((eq? (event-type focus-out) type)
|
||||||
|
(if (window-exists? dpy (client:window client))
|
||||||
(let ((mode (focus-change-event-mode xevent))
|
(let ((mode (focus-change-event-mode xevent))
|
||||||
(detail (focus-change-event-detail xevent)))
|
(detail (focus-change-event-detail xevent)))
|
||||||
(if (and (eq? mode (notify-mode normal))
|
(if (and (eq? mode (notify-mode normal))
|
||||||
(memq detail (list (notify-detail nonlinear)
|
(memq detail (list (notify-detail nonlinear)
|
||||||
(notify-detail nonlinear-virtual)
|
(notify-detail nonlinear-virtual)
|
||||||
(notify-detail ancestor))))
|
(notify-detail ancestor))))
|
||||||
;; focus lost -- if window-exists?
|
|
||||||
(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)
|
||||||
|
(if (window-exists? dpy (client:window client))
|
||||||
(let ((mode (focus-change-event-mode xevent))
|
(let ((mode (focus-change-event-mode xevent))
|
||||||
(detail (focus-change-event-detail xevent)))
|
(detail (focus-change-event-detail xevent)))
|
||||||
(if (and (eq? mode (notify-mode normal))
|
(if (and (eq? mode (notify-mode normal))
|
||||||
(memq detail (list (notify-detail nonlinear)
|
(memq detail (list (notify-detail nonlinear)
|
||||||
(notify-detail nonlinear-virtual)
|
(notify-detail nonlinear-virtual)
|
||||||
(notify-detail ancestor))))
|
(notify-detail ancestor))))
|
||||||
;; focus taken -- if window-exists?
|
|
||||||
(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)
|
||||||
|
(if (window-exists? dpy (client:window client))
|
||||||
(let ((name (get-atom-name (property-event-display xevent)
|
(let ((name (get-atom-name (property-event-display xevent)
|
||||||
(property-event-atom xevent))))
|
(property-event-atom xevent))))
|
||||||
(cond
|
(cond
|
||||||
|
@ -405,29 +422,16 @@
|
||||||
(send internal-out-channel
|
(send internal-out-channel
|
||||||
(list 'update-client-state client)))
|
(list 'update-client-state client)))
|
||||||
;; TODO: respect NORMAL_HINTS change
|
;; 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)
|
||||||
|
(let* ((p (get-wm-name dpy w))
|
||||||
(l (if p (property->string-list p) '())))
|
(l (if p (property->string-list p) '())))
|
||||||
(if (null? l)
|
(if (null? l)
|
||||||
"<untitled>"
|
"<untitled>"
|
||||||
(car l)))))
|
(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*)))
|
||||||
|
|
|
@ -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
|
||||||
|
(if (window-exists? dpy (client:window client))
|
||||||
(move-resize-window dpy (client:window client)
|
(move-resize-window dpy (client:window client)
|
||||||
border-width
|
border-width
|
||||||
(+ border-width titlebar-height)
|
(+ border-width titlebar-height)
|
||||||
(- (window-attribute:width wa) (* 2 border-width))
|
(- (window-attribute:width wa)
|
||||||
|
(* 2 border-width))
|
||||||
(- (window-attribute:height wa)
|
(- (window-attribute:height wa)
|
||||||
(+ (* 2 border-width) titlebar-height)))
|
(+ (* 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))
|
||||||
|
(let ((wa (get-window-attributes dpy (client:window client))))
|
||||||
(resize-window dpy (client:client-window client)
|
(resize-window dpy (client:client-window client)
|
||||||
(+ (window-attribute:width wa) (* 2 border-width))
|
(+ (window-attribute:width wa) (* 2 border-width))
|
||||||
(+ (window-attribute:height wa)
|
(+ (window-attribute:height wa)
|
||||||
(* 2 border-width)
|
(* 2 border-width)
|
||||||
titlebar-height))))
|
titlebar-height))))))
|
||||||
|
|
||||||
(define (assert-client-visible wm client)
|
(define (assert-client-visible wm client)
|
||||||
(let* ((dpy (wm:dpy wm))
|
(let* ((dpy (wm:dpy wm))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue