separated default options (config) and saved options (layout)
added some synchronization optimized focus-control cleaned up a bit
This commit is contained in:
frese
parent
315a71013a
commit
de00f837dc
168
src/manager.scm
168
src/manager.scm
|
|
@ -37,7 +37,7 @@
|
|||
((eq? type (manager-type switch)) "switch-wm")
|
||||
((eq? type (manager-type move)) "move-wm")))
|
||||
|
||||
(define (create-wm dpy parent options children
|
||||
(define (create-wm dpy parent options default-options children
|
||||
type options-spec out-channel fun)
|
||||
(let* ((wa (get-window-attributes dpy parent))
|
||||
(main-window
|
||||
|
|
@ -52,8 +52,10 @@
|
|||
(wm (make-wm type in-channel out-channel internal-out-channel
|
||||
dpy main-window colormap
|
||||
(create-options dpy colormap
|
||||
(options-spec-union options-spec
|
||||
manager-options-spec)
|
||||
(spec-defaults default-options
|
||||
(options-spec-union
|
||||
options-spec
|
||||
manager-options-spec))
|
||||
options)
|
||||
'() #f)))
|
||||
|
||||
|
|
@ -118,8 +120,18 @@
|
|||
(send internal-out-channel '(fit-windows)))
|
||||
|
||||
((focus-change-event? xevent)
|
||||
;; really send it always ??
|
||||
(send internal-out-channel '(update-manager-state)))
|
||||
(if (window-exists? dpy (wm:window wm))
|
||||
(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 virtual)
|
||||
(notify-detail ancestor))))
|
||||
(let ((focused? (eq? (event-type focus-in)
|
||||
(focus-change-event-type xevent))))
|
||||
(send internal-out-channel
|
||||
(list 'update-manager-state focused?)))))))
|
||||
|
||||
;; the manager got the focus (as a client)
|
||||
((client-message-event? xevent)
|
||||
|
|
@ -147,24 +159,24 @@
|
|||
(let ((internal-out-channel (wm:internal-out-channel wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(case (car msg)
|
||||
((wait)
|
||||
(let ((sp (second msg))
|
||||
(message (third msg)))
|
||||
(handle-external-message wm exit message)
|
||||
(sync-point-release sp)))
|
||||
|
||||
((manage-window)
|
||||
(let ((window (second msg))
|
||||
(maybe-rect (third msg)))
|
||||
(let ((client (create-client wm window)))
|
||||
(set-wm:clients! wm (append (wm:clients wm) (list client)))
|
||||
(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))
|
||||
)))
|
||||
(send-message+wait internal-out-channel
|
||||
(list 'init-client client maybe-rect)))))
|
||||
|
||||
((configure-window)
|
||||
(let ((window (second msg))
|
||||
(changes (third msg)))
|
||||
(send internal-out-channel
|
||||
(send-message+wait internal-out-channel
|
||||
(list 'configure-window window changes))))
|
||||
|
||||
((unmanage-window)
|
||||
|
|
@ -176,8 +188,7 @@
|
|||
(reparent-to-root dpy window))))
|
||||
|
||||
((destroy-manager)
|
||||
;; (send internal-out-channel '(deinit-manager))
|
||||
;; sync ??
|
||||
(send-message+wait internal-out-channel '(deinit-manager))
|
||||
(if (window-exists? dpy (wm:window wm))
|
||||
(destroy-window dpy (wm:window wm))))
|
||||
|
||||
|
|
@ -186,10 +197,11 @@
|
|||
(set-wm:clients! wm (filter (lambda (c) (not (eq? c client)))
|
||||
(wm:clients wm)))
|
||||
(if (eq? (wm:current-client wm) client)
|
||||
;; select-client ??
|
||||
(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 ??
|
||||
(send-message+wait (wm:internal-out-channel wm)
|
||||
(list 'deinit-client client))
|
||||
(destroy-window dpy (client:client-window client))))
|
||||
|
||||
((select-client)
|
||||
|
|
@ -200,37 +212,25 @@
|
|||
(raise-window dpy (client:client-window client))
|
||||
(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))
|
||||
; (grab-button dpy
|
||||
; (button button1) (state-set)
|
||||
; (client:client-window c) #f
|
||||
; (event-mask button-press)
|
||||
; (grab-mode async) (grab-mode async)
|
||||
; none none)))
|
||||
; (wm:clients wm))
|
||||
))
|
||||
(cons client (transients-for-client wm client)))))
|
||||
|
||||
)))
|
||||
(else (warn "unhandled manager message" wm msg)))))
|
||||
|
||||
(define (wm-deinit-client wm client)
|
||||
(mdisplay "manager deinit-client " wm " " client "\n")
|
||||
(send (wm:in-channel wm) (list 'deinit-client client)))
|
||||
|
||||
;; *** external messages *********************************************
|
||||
|
||||
(define (wm-manage-window wm window . rect)
|
||||
(send (wm:in-channel wm)
|
||||
(list 'manage-window window
|
||||
(if (null? rect)
|
||||
(let ((maybe-rect (if (null? rect)
|
||||
#f
|
||||
(car rect))))
|
||||
;; sync ??
|
||||
)
|
||||
(send-message+wait (wm:in-channel wm)
|
||||
(list 'manage-window window maybe-rect))))
|
||||
|
||||
(define (wm-configure-window wm window changes)
|
||||
(send (wm:in-channel wm) (list 'configure-window window changes)))
|
||||
(send-message+wait (wm:in-channel wm)
|
||||
(list 'configure-window window changes)))
|
||||
|
||||
(define (wm-unmanage-window wm window)
|
||||
(send (wm:in-channel wm) (list 'unmanage-window window)))
|
||||
|
|
@ -240,7 +240,7 @@
|
|||
(send (wm:in-channel wm) (list 'select-client client time)))))
|
||||
|
||||
(define (destroy-wm wm)
|
||||
(send (wm:in-channel wm) '(destroy-manager)))
|
||||
(send-message+wait (wm:in-channel wm) '(destroy-manager)))
|
||||
|
||||
(define (send-root-drop wm window x y)
|
||||
(send (wm:out-channel wm) (list 'root-drop window x y)))
|
||||
|
|
@ -248,19 +248,27 @@
|
|||
;; *** client ********************************************************
|
||||
|
||||
(define-record-type client :client
|
||||
(make-client window client-window in-channel data)
|
||||
(make-client window client-window in-channel data focused?)
|
||||
client?
|
||||
(window client:window set-client:window!)
|
||||
(client-window client:client-window)
|
||||
(in-channel client:in-channel)
|
||||
(data client:data set-client:data!))
|
||||
(data client:data set-client:data!)
|
||||
(focused? client:focused? set-client:focused?!))
|
||||
|
||||
(define (set-client-focused?! wm client focused?)
|
||||
(let ((prev (client:focused? client)))
|
||||
(if (not (eq? prev focused?))
|
||||
(begin
|
||||
(set-client:focused?! client focused?)
|
||||
(send (wm:internal-out-channel wm)
|
||||
(list 'update-client-state client focused?))))))
|
||||
|
||||
(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))
|
||||
(client-window (create-simple-window dpy (wm:window wm)
|
||||
0 0
|
||||
|
|
@ -270,10 +278,9 @@
|
|||
(white-pixel dpy)
|
||||
(black-pixel dpy)))
|
||||
(in-channel (make-channel))
|
||||
(client (make-client window client-window in-channel #f)))
|
||||
(client (make-client window client-window in-channel #f #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)
|
||||
|
|
@ -303,9 +310,11 @@
|
|||
(lambda (msg)
|
||||
(case (car msg)
|
||||
((restart-handler)
|
||||
(mdisplay "restart-handler " wm " " client "\n")
|
||||
(create-client-handler wm client)
|
||||
(exit 'restart)))))
|
||||
(sync-point-release (second msg))
|
||||
(exit 'restart))
|
||||
(else (warn "unhandled client message" wm
|
||||
client msg)))))
|
||||
(wrap (receive-rv client-window-channel)
|
||||
(lambda (xevent)
|
||||
(handle-client-window-xevent wm exit client xevent)))
|
||||
|
|
@ -315,13 +324,11 @@
|
|||
(loop)))))))))))
|
||||
|
||||
(define (client-of-window wm window)
|
||||
(let ((l (filter (lambda (client)
|
||||
(find (lambda (client)
|
||||
(equal? window (client:window client)))
|
||||
(wm-clients wm))))
|
||||
(and (pair? l) (car l))))
|
||||
(wm-clients wm)))
|
||||
|
||||
(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))
|
||||
(dpy (wm:dpy wm)))
|
||||
|
|
@ -332,16 +339,14 @@
|
|||
(client:client-window client)))
|
||||
(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))
|
||||
;;(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))
|
||||
)
|
||||
(let ((sp (make-sync-point)))
|
||||
(send (client:in-channel client)
|
||||
(list 'restart-handler sp))
|
||||
(sync-point-wait sp))
|
||||
(send-message+wait internal-out-channel (list 'fit-client client))
|
||||
(send internal-out-channel
|
||||
(list 'update-client-name client (client-name dpy client)))
|
||||
(map-window (wm:dpy wm) new-window))
|
||||
#f)))
|
||||
|
||||
(define (handle-client-window-xevent wm exit client xevent)
|
||||
|
|
@ -370,18 +375,17 @@
|
|||
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)))
|
||||
;; ((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))))
|
||||
|
||||
((eq? (event-type button-press) type)
|
||||
(if (memq 'click (get-option-value (wm:options wm) 'focus-policy))
|
||||
(wm-select-client wm client (button-event-time xevent))))
|
||||
;; ((eq? (event-type button-press) type)
|
||||
;; (if (memq 'click (get-option-value (wm:options wm) 'focus-policy))
|
||||
;; (wm-select-client wm client (button-event-time xevent))))
|
||||
|
||||
((destroy-window-event? xevent)
|
||||
(mdisplay "client-window destroyed" wm client "\n")
|
||||
(exit 'destroy)))))
|
||||
|
||||
(define (handle-client-xevent wm exit client xevent)
|
||||
|
|
@ -389,29 +393,23 @@
|
|||
(internal-out-channel (wm:internal-out-channel wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(cond
|
||||
((eq? (event-type focus-out) type)
|
||||
((focus-change-event? xevent)
|
||||
(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 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)
|
||||
(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)))
|
||||
(if (eq? (event-type focus-in)
|
||||
(focus-change-event-type xevent))
|
||||
(begin
|
||||
(install-colormaps dpy (client:window client))
|
||||
(set-client-focused?! wm client #t))
|
||||
(begin
|
||||
(uninstall-colormaps dpy (client:window client))
|
||||
(set-client-focused?! wm client #f)))))))
|
||||
|
||||
((property-event? xevent)
|
||||
(if (window-exists? dpy (client:window client))
|
||||
|
|
@ -420,20 +418,18 @@
|
|||
(cond
|
||||
((equal? "WM_NAME" name)
|
||||
(send internal-out-channel
|
||||
(list 'update-client-state client)))
|
||||
;; TODO: respect NORMAL_HINTS change
|
||||
))))
|
||||
(list 'update-client-name client
|
||||
(client-name dpy client))))))))
|
||||
|
||||
((reparent-event? xevent)
|
||||
(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))))
|
||||
((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)
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
xc-bottom-side xc-bottom-left-corner default-cursor))))
|
||||
|
||||
(spawn*
|
||||
(list 'move-wm-resizer wm client)
|
||||
(lambda (release)
|
||||
(call-with-event-channel
|
||||
dpy window
|
||||
|
|
@ -34,13 +35,14 @@
|
|||
(lambda ()
|
||||
(let ((xevent (receive event-channel)))
|
||||
(cond
|
||||
((motion-event? xevent)
|
||||
((and (motion-event? xevent) (window-exists? dpy window))
|
||||
(set-resize-cursor wm client cursors
|
||||
(motion-event-x xevent)
|
||||
(motion-event-y xevent))
|
||||
(idle))
|
||||
((eq? (event-type button-press)
|
||||
((and (eq? (event-type button-press)
|
||||
(any-event-type xevent))
|
||||
(window-exists? dpy window))
|
||||
(let* ((x (button-event-x xevent))
|
||||
(y (button-event-y xevent))
|
||||
(dir (resizer-direction wm client x y)))
|
||||
|
|
@ -80,7 +82,11 @@
|
|||
prev-rect dir)))))))
|
||||
(idle))))
|
||||
(free-gc dpy gc)
|
||||
(for-each (lambda (c) (free-cursor dpy (cdr c))) cursors)))))
|
||||
(for-each (lambda (c) (free-cursor dpy (cdr c))) cursors)))
|
||||
window))
|
||||
|
||||
(define (destroy-resizer dpy resizer)
|
||||
(destroy-window dpy resizer))
|
||||
|
||||
(define (rubber-draw dpy gc rect)
|
||||
(draw-rectangle dpy (default-root-window dpy) gc
|
||||
|
|
|
|||
|
|
@ -10,29 +10,54 @@
|
|||
(border-colors colors '("#333333" "#dddddd"))
|
||||
)
|
||||
|
||||
(define (create-move-wm out-channel dpy parent options . children)
|
||||
(create-wm dpy parent options children
|
||||
(define (create-move-wm out-channel dpy parent options default-options
|
||||
. children)
|
||||
(create-wm dpy parent options default-options children
|
||||
(manager-type move) move-wm-options-spec
|
||||
out-channel
|
||||
(lambda (wm in-channel)
|
||||
(spawn* (list 'move-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(move-wm-handler wm in-channel)))
|
||||
(init-move-wm wm in-channel)
|
||||
wm)))
|
||||
|
||||
(define (move-wm-handler wm channel)
|
||||
(define (init-move-wm wm channel)
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
(window (wm:window wm))
|
||||
(gc (create-gc dpy window '())))
|
||||
(spawn* (list 'move-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(call-with-current-continuation
|
||||
(lambda (exit)
|
||||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(handle-message wm gc exit msg)
|
||||
(loop)))))
|
||||
(free-gc dpy gc)))))
|
||||
|
||||
(define (handle-message wm gc exit msg)
|
||||
(let ((dpy (wm:dpy wm))
|
||||
(window (wm:window wm)))
|
||||
(case (car msg)
|
||||
((wait)
|
||||
(let ((sp (second msg))
|
||||
(message (third msg)))
|
||||
(handle-message wm gc
|
||||
(lambda args
|
||||
(sync-point-release sp)
|
||||
(apply exit args))
|
||||
message)
|
||||
(sync-point-release sp)))
|
||||
|
||||
((deinit-manager)
|
||||
(exit 'deinit-manager))
|
||||
|
||||
((draw-main-window)
|
||||
(set-gc-foreground! dpy gc (black-pixel dpy))
|
||||
(fill-rectangle* dpy window gc
|
||||
(clip-rectangle dpy window)))
|
||||
|
||||
((update-manager-state) #t)
|
||||
|
||||
((fit-windows)
|
||||
(map (lambda (client)
|
||||
(assert-client-visible wm client))
|
||||
|
|
@ -40,6 +65,7 @@
|
|||
|
||||
((init-client)
|
||||
(init-client wm (second msg) (third msg)))
|
||||
|
||||
((deinit-client)
|
||||
(deinit-client wm (second msg)))
|
||||
|
||||
|
|
@ -54,6 +80,7 @@
|
|||
|
||||
((draw-client-window)
|
||||
(draw-client-window wm (second msg) gc))
|
||||
|
||||
((fit-client)
|
||||
;; client-window changed it's size
|
||||
(fit-client-windows wm (second msg)))
|
||||
|
|
@ -66,17 +93,20 @@
|
|||
|
||||
((update-client-state)
|
||||
(let* ((client (second msg))
|
||||
(dpy (wm:dpy wm))
|
||||
(window (client:window client))
|
||||
(state (if (window-contains-focus? dpy window)
|
||||
(focused? (third msg))
|
||||
(state (if focused?
|
||||
'focused
|
||||
'normal))
|
||||
(titlebar (car (client:data client)))
|
||||
(name (client-name (wm:dpy wm) client)))
|
||||
(set-titlebar-title+state! titlebar name state)))
|
||||
))
|
||||
(loop))
|
||||
(free-gc (wm:dpy wm) gc)))
|
||||
(titlebar (car (client:data client))))
|
||||
(set-titlebar-state! titlebar state)))
|
||||
|
||||
((update-client-name)
|
||||
(let ((client (second msg))
|
||||
(name (third msg)))
|
||||
(let ((titlebar (car (client:data client))))
|
||||
(set-titlebar-title! titlebar name))))
|
||||
|
||||
(else (warn "unhandled move-wm message" wm msg)))))
|
||||
|
||||
(define (init-client wm client maybe-rect)
|
||||
(let ((dpy (wm:dpy wm)))
|
||||
|
|
@ -127,7 +157,8 @@
|
|||
(delete-window dpy (client:window client) (second msg)))
|
||||
))))
|
||||
;; TODO: internal channel
|
||||
(loop))))
|
||||
(loop))
|
||||
(destroy-resizer dpy resizer)))
|
||||
|
||||
(map-titlebar titlebar)
|
||||
(if (window-exists? dpy (client:window client))
|
||||
|
|
@ -138,8 +169,8 @@
|
|||
(let ((options (wm:options wm)))
|
||||
(create-titlebar channel (wm:dpy wm) (client:client-window client)
|
||||
(wm:colormap wm)
|
||||
;; TODO: buttons
|
||||
(list (cons 'normal-colors
|
||||
(list (cons 'buttons '(kill maximize))
|
||||
(cons 'normal-colors
|
||||
(get-option options 'titlebar-colors))
|
||||
(cons 'active-colors
|
||||
(get-option options'titlebar-colors-focused))
|
||||
|
|
@ -222,8 +253,20 @@
|
|||
(if maybe-rect
|
||||
maybe-rect
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
(w.h (desired-size/hints dpy win
|
||||
(maximal-size/hints dpy win 400 200)))
|
||||
(default-width 400)
|
||||
(default-height 200)
|
||||
(w.h-1
|
||||
(let ((w.h (minimal-size/hints dpy win default-width
|
||||
default-height)))
|
||||
(cons (if (< default-width (car w.h))
|
||||
(car w.h)
|
||||
default-width)
|
||||
(if (< default-height (cdr w.h))
|
||||
(cdr w.h)
|
||||
default-height))))
|
||||
(w.h-2 (maximal-size/hints dpy win (car w.h-1) (cdr w.h-1)))
|
||||
(w.h (desired-size/hints dpy win w.h-2))
|
||||
;; TODO: look for a free position ?! Transients centered?
|
||||
(x.y (desired-position/hints dpy win (cons 0 0))))
|
||||
(make-rectangle (car x.y) (cdr x.y)
|
||||
(car w.h) (cdr w.h)))))
|
||||
|
|
|
|||
103
src/split-wm.scm
103
src/split-wm.scm
|
|
@ -17,43 +17,69 @@
|
|||
;; | | | | |
|
||||
;; ---------- ----------
|
||||
|
||||
(define (create-split-wm external-in-channel dpy parent options . children)
|
||||
(create-wm dpy parent options children
|
||||
(define (create-split-wm external-in-channel dpy parent options
|
||||
default-options . children)
|
||||
(create-wm dpy parent options default-options children
|
||||
(manager-type split) split-wm-options-spec
|
||||
external-in-channel
|
||||
(lambda (wm in-channel)
|
||||
(spawn* (list 'split-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(split-wm-handler wm in-channel)))
|
||||
(init-split-wm wm in-channel)
|
||||
wm)))
|
||||
|
||||
(define (split-wm? wm)
|
||||
(and (wm? wm) (eq? (wm:type wm) (manager-type split))))
|
||||
(define-record-type split-data :split-data
|
||||
(make-split-data resizer first-client second-client)
|
||||
split-data?
|
||||
(resizer data:resizer)
|
||||
(first-client data:first-client set-data:first-client!)
|
||||
(second-client data:second-client set-data:second-client!))
|
||||
|
||||
(define (split-wm-handler wm channel)
|
||||
(let ((resizer-window (create-resizer wm))
|
||||
(dpy (wm:dpy wm))
|
||||
(first-client #f)
|
||||
(second-client #f))
|
||||
(map-window (wm:dpy wm) resizer-window)
|
||||
(define (init-split-wm wm channel)
|
||||
(let* ((resizer (create-resizer wm))
|
||||
(data (make-split-data resizer #f #f)))
|
||||
(spawn* (list 'split-wm wm)
|
||||
(lambda (release)
|
||||
(map-window (wm:dpy wm) resizer)
|
||||
(release)
|
||||
(call-with-current-continuation
|
||||
(lambda (exit)
|
||||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(handle-message wm channel data exit msg)
|
||||
(loop)))))))))
|
||||
|
||||
(define (handle-message wm channel data exit msg)
|
||||
(let ((dpy (wm:dpy wm)))
|
||||
(case (car msg)
|
||||
((wait)
|
||||
(let ((sp (second msg))
|
||||
(message (third msg)))
|
||||
(handle-message wm channel data
|
||||
(lambda args
|
||||
(sync-point-release sp)
|
||||
(apply exit args))
|
||||
message)
|
||||
(sync-point-release sp)))
|
||||
|
||||
((deinit-manager)
|
||||
(destroy-window dpy (data:resizer data))
|
||||
(exit 'deinit-manager))
|
||||
|
||||
((draw-main-window) #t)
|
||||
|
||||
((update-manager-state) #t)
|
||||
|
||||
((fit-windows)
|
||||
(fit-windows wm resizer-window first-client second-client))
|
||||
(fit-windows wm data))
|
||||
|
||||
((init-client)
|
||||
(let ((client (second msg))
|
||||
(first? (not first-client)))
|
||||
(first? (not (data:first-client data))))
|
||||
(if first?
|
||||
(set! first-client client)
|
||||
(set! second-client client))
|
||||
(set-data:first-client! data client)
|
||||
(set-data:second-client! data client))
|
||||
|
||||
(set-window-border-width! dpy (client:window client) 0)
|
||||
(fit-windows wm resizer-window first-client second-client)
|
||||
(fit-windows wm data)
|
||||
|
||||
(map-window dpy (client:window client))
|
||||
(map-window dpy (client:client-window client))
|
||||
|
|
@ -71,17 +97,18 @@
|
|||
|
||||
((deinit-client)
|
||||
(let ((client (second msg)))
|
||||
(if (eq? client first-client)
|
||||
(set! first-client #f))
|
||||
(if (eq? client second-client)
|
||||
(set! second-client #f))
|
||||
;; destroy split if only one client left
|
||||
(if (eq? client (data:first-client data))
|
||||
(set-data:first-client! data #f))
|
||||
(if (eq? client (data:second-client data))
|
||||
(set-data:second-client! data #f))
|
||||
;; destroy split if only one client left. replace the
|
||||
;; wm by the remaining client.
|
||||
(let ((first-client (data:first-client data))
|
||||
(second-client (data:second-client data)))
|
||||
(if (and (not (and first-client second-client))
|
||||
(or first-client second-client))
|
||||
(let ((repl (client:window (or first-client second-client))))
|
||||
(mdisplay "destroying " wm ". with replacement " repl "\n")
|
||||
(send (wm:out-channel wm)
|
||||
(list 'destroy-wm wm repl))))))
|
||||
(let ((r (client:window (or first-client second-client))))
|
||||
(send (wm:out-channel wm) (list 'destroy-wm wm r)))))))
|
||||
|
||||
((draw-client-window) #t)
|
||||
|
||||
|
|
@ -99,18 +126,19 @@
|
|||
(if cc (wm-select-client wm cc time))))
|
||||
|
||||
((update-client-state) #t)
|
||||
((update-client-name) #t)
|
||||
|
||||
;; Shortcuts
|
||||
((select-first)
|
||||
(let ((time (second msg)))
|
||||
(if first-client
|
||||
(wm-select-client wm first-client time))))
|
||||
(if (data:first-client data)
|
||||
(wm-select-client wm (data:first-client data) time))))
|
||||
((select-second)
|
||||
(let ((time (second msg)))
|
||||
(if second-client
|
||||
(wm-select-client wm second-client time))))
|
||||
))
|
||||
(loop))))
|
||||
(if (data:second-client data)
|
||||
(wm-select-client wm (data:second-client data) time))))
|
||||
|
||||
(else (warn "unhandled split-wm message" wm msg)))))
|
||||
|
||||
(define (calc-rectangles wm)
|
||||
(let* ((options (wm:options wm))
|
||||
|
|
@ -141,7 +169,10 @@
|
|||
(+ (rectangle:height r1) bar-width)))))
|
||||
(list r1 r2 r3)))))
|
||||
|
||||
(define (fit-windows wm resizer-window first-client second-client)
|
||||
(define (fit-windows wm data)
|
||||
(let ((resizer-window (data:resizer data))
|
||||
(first-client (data:first-client data))
|
||||
(second-client (data:second-client data)))
|
||||
(let* ((rects (calc-rectangles wm))
|
||||
(dpy (wm:dpy wm)))
|
||||
(move-resize-window* dpy resizer-window (second rects))
|
||||
|
|
@ -152,7 +183,7 @@
|
|||
(if second-client
|
||||
(move-resize-window* dpy
|
||||
(client:client-window second-client)
|
||||
(third rects)))))
|
||||
(third rects))))))
|
||||
|
||||
(define (fit-client-windows wm client)
|
||||
(let ((dpy (wm:dpy wm)))
|
||||
|
|
|
|||
|
|
@ -9,15 +9,13 @@
|
|||
(select-previous keys "M-k p")
|
||||
)
|
||||
|
||||
(define (create-switch-wm out-channel dpy parent options . children)
|
||||
(create-wm dpy parent options children
|
||||
(define (create-switch-wm out-channel dpy parent options default-options
|
||||
. children)
|
||||
(create-wm dpy parent options default-options children
|
||||
(manager-type switch) switch-wm-options-spec
|
||||
out-channel
|
||||
(lambda (wm in-channel)
|
||||
(spawn* (list 'switch-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(switch-wm-handler wm in-channel)))
|
||||
(init-switch-wm wm in-channel)
|
||||
wm)))
|
||||
|
||||
(define-record-type switch-wm-data :switch-wm-data
|
||||
|
|
@ -26,7 +24,7 @@
|
|||
(titlebars data:titlebars set-data:titlebars!)
|
||||
(empty-titlebar data:empty-titlebar))
|
||||
|
||||
(define (switch-wm-handler wm channel)
|
||||
(define (init-switch-wm wm channel)
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
(window (wm:window wm))
|
||||
(options (wm:options wm))
|
||||
|
|
@ -42,9 +40,38 @@
|
|||
(get-option-value options 'select-previous)
|
||||
'select-previous channel #f)
|
||||
|
||||
(spawn* (list 'switch-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(call-with-current-continuation
|
||||
(lambda (exit)
|
||||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(handle-message wm data gc exit msg)
|
||||
(loop)))))
|
||||
(free-gc dpy gc)))))
|
||||
|
||||
(define (handle-message wm data gc exit msg)
|
||||
(let ((dpy (wm:dpy wm))
|
||||
(window (wm:window wm)))
|
||||
(case (car msg)
|
||||
((wait)
|
||||
(let ((sp (second msg))
|
||||
(message (third msg)))
|
||||
(handle-message wm data gc
|
||||
(lambda args
|
||||
(sync-point-release sp)
|
||||
(apply exit args))
|
||||
message)
|
||||
(sync-point-release sp)))
|
||||
|
||||
((deinit-manager)
|
||||
(destroy-titlebar (data:empty-titlebar data))
|
||||
(for-each (lambda (client.tb)
|
||||
(destroy-titlebar (cdr client.tb)))
|
||||
(data:titlebars data))
|
||||
(exit 'deinit-manager))
|
||||
|
||||
((draw-main-window)
|
||||
(set-gc-foreground! dpy gc (black-pixel dpy))
|
||||
(fill-rectangle* dpy window gc
|
||||
|
|
@ -58,6 +85,7 @@
|
|||
|
||||
((init-client)
|
||||
(init-client wm data (second msg) (third msg)))
|
||||
|
||||
((deinit-client)
|
||||
(deinit-client wm data (second msg)))
|
||||
|
||||
|
|
@ -81,10 +109,11 @@
|
|||
(fit-client-window wm (second msg)))
|
||||
|
||||
((update-manager-state)
|
||||
(let ((state (if (window-contains-focus? dpy (wm:window wm))
|
||||
(let* ((focused? (second msg))
|
||||
(state (if focused?
|
||||
'focused
|
||||
'active)))
|
||||
(set-titlebar-state! empty-titlebar state)))
|
||||
(set-titlebar-state! (data:empty-titlebar data) state)))
|
||||
|
||||
((manager-focused)
|
||||
(let ((time (second msg))
|
||||
|
|
@ -93,23 +122,29 @@
|
|||
|
||||
((update-client-state)
|
||||
(let* ((client (second msg))
|
||||
(focused? (third msg))
|
||||
(dpy (wm:dpy wm))
|
||||
(window (client:window client)))
|
||||
(if (window-exists? dpy window)
|
||||
(let ((state (if (window-contains-focus? dpy window)
|
||||
(window (client:window client))
|
||||
(titlebar (assq/false client (data:titlebars data))))
|
||||
(if (and titlebar (window-exists? dpy window))
|
||||
(let ((state (if focused?
|
||||
'focused
|
||||
(if (window-viewable? dpy window)
|
||||
'active
|
||||
'normal)))
|
||||
(titlebar (assq/false client (data:titlebars data)))
|
||||
(name (client-name dpy client)))
|
||||
(set-titlebar-title+state! titlebar name state)))))
|
||||
'normal))))
|
||||
(set-titlebar-state! titlebar state)))))
|
||||
|
||||
((update-client-name)
|
||||
(let ((client (second msg))
|
||||
(name (third msg)))
|
||||
(let ((titlebar (assq/false client (data:titlebars data))))
|
||||
(if titlebar
|
||||
(set-titlebar-title! titlebar name)))))
|
||||
|
||||
((select-next) (select-next-client wm (second msg)))
|
||||
((select-previous) (select-previous-client wm (second msg)))
|
||||
))
|
||||
(loop))
|
||||
(free-gc (wm:dpy wm) gc)))
|
||||
|
||||
(else (warn "unhandled switch-wm message" wm msg)))))
|
||||
|
||||
(define (fit-titlebars wm data)
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
|
|
@ -144,15 +179,16 @@
|
|||
(data:titlebars data))))))
|
||||
|
||||
(define (init-client wm data client maybe-rect)
|
||||
;; TODO: transients!
|
||||
(let ((dpy (wm:dpy wm))
|
||||
(options (wm:options wm)))
|
||||
(let* ((channel (make-channel))
|
||||
(titlebar (create-client-titlebar channel wm client)))
|
||||
(set-data:titlebars! data (append (data:titlebars data)
|
||||
(list (cons client titlebar))))
|
||||
(set-titlebar-title! titlebar (client-name dpy client))
|
||||
(fit-titlebars wm data)
|
||||
(update-titlebars wm data)
|
||||
|
||||
(fit-client-window wm client)
|
||||
(fit-client wm client)
|
||||
|
||||
|
|
@ -180,8 +216,7 @@
|
|||
;; from titlebar-buttons
|
||||
((kill)
|
||||
(delete-window dpy (client:window client) (second msg)))
|
||||
(else (mdisplay "unhandled client message: " msg "\n"))))
|
||||
;; TODO: internal channel
|
||||
(else (warn "unhandled client message " wm client msg))))
|
||||
(loop))))
|
||||
|
||||
(map-titlebar titlebar)
|
||||
|
|
@ -193,8 +228,8 @@
|
|||
(let ((options (wm:options wm)))
|
||||
(create-titlebar channel (wm:dpy wm) (wm:window wm)
|
||||
(wm:colormap wm)
|
||||
;; TODO: buttons
|
||||
(list (cons 'normal-colors
|
||||
(list (cons 'buttons '(kill))
|
||||
(cons 'normal-colors
|
||||
(get-option options 'titlebar-colors))
|
||||
(cons 'active-colors
|
||||
(get-option options 'titlebar-colors-active))
|
||||
|
|
@ -207,7 +242,7 @@
|
|||
(let* ((options (wm:options wm))
|
||||
(tb
|
||||
(create-titlebar #f (wm:dpy wm) (wm:window wm) (wm:colormap wm)
|
||||
(list ;; TODO: (cons 'draggable #f)
|
||||
(list
|
||||
(cons 'normal-colors
|
||||
(get-option options 'titlebar-colors))
|
||||
(cons 'active-colors
|
||||
|
|
|
|||
Loading…
Reference in New Issue