326 lines
10 KiB
Scheme
326 lines
10 KiB
Scheme
(define-options-spec split-special-options-spec
|
|
(orientation symbol 'horizontal) ;; horizontal | vertical
|
|
(aspect number 1/1))
|
|
|
|
;; ---------- ----------
|
|
;; | | | | |
|
|
;; ---------- vertical | | | horizontal
|
|
;; | | | | |
|
|
;; ---------- ----------
|
|
|
|
(define (create-split-wm external-in-channel dpy parent options
|
|
special-options . children)
|
|
(let ((special-options (create-options dpy #f
|
|
split-special-options-spec
|
|
special-options)))
|
|
(create-wm dpy parent options special-options children
|
|
(manager-type split)
|
|
external-in-channel
|
|
(lambda (wm in-channel)
|
|
(init-split-wm wm in-channel)
|
|
wm))))
|
|
|
|
(define-record-type split-data :split-data
|
|
(make-split-data resizer first-client second-client)
|
|
split-data?
|
|
(resizer data:resizer set-data:resizer!)
|
|
(first-client data:first-client set-data:first-client!)
|
|
(second-client data:second-client set-data:second-client!))
|
|
|
|
(define (init-split-wm wm channel)
|
|
(let* ((data (make-split-data #f #f #f))
|
|
(resizer (create-resizer wm data)))
|
|
(set-data:resizer! data resizer)
|
|
(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)))))
|
|
(free-options (wm:special-options wm) #t)))))
|
|
|
|
(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 data))
|
|
|
|
((init-client)
|
|
(let ((client (second msg))
|
|
(first? (not (data:first-client data))))
|
|
(if first?
|
|
(set-data:first-client! data client)
|
|
(set-data:second-client! data client))
|
|
|
|
(set-window-border-width! dpy (client:window client) 0)
|
|
(fit-windows wm data)
|
|
|
|
(map-window dpy (client:window client))
|
|
(map-window dpy (client:client-window client))
|
|
|
|
(let ((opt (if (eq? (get-option-value (wm:special-options wm)
|
|
'orientation)
|
|
'horizontal)
|
|
(if first? 'select-right 'select-left)
|
|
(if first? 'select-down 'select-up))))
|
|
(grab-shortcut dpy (client:client-window client)
|
|
(get-option-value (wm:options wm) opt)
|
|
(if first? 'select-second 'select-first)
|
|
channel #f))
|
|
))
|
|
|
|
((deinit-client)
|
|
(let ((client (second msg)))
|
|
(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 ((r (client:window (or first-client second-client))))
|
|
(send (wm:out-channel wm) (list 'destroy-wm wm r)))))))
|
|
|
|
((iconfiy-client maximize-client) #t)
|
|
|
|
((draw-client-window) #t)
|
|
|
|
((fit-client)
|
|
;; client-window changed it's size
|
|
(fit-client-windows wm (second msg)))
|
|
|
|
((fit-client-window)
|
|
;; client changed it's size ??
|
|
#t)
|
|
|
|
((manager-focused)
|
|
(let ((time (second msg))
|
|
(cc (wm-current-client wm)))
|
|
(if cc (wm-select-client wm cc time))))
|
|
|
|
((update-client-state) #t)
|
|
((update-client-name) #t)
|
|
|
|
;; Shortcuts
|
|
((select-first)
|
|
(let ((time (second msg)))
|
|
(if (data:first-client data)
|
|
(wm-select-client wm (data:first-client data) time))))
|
|
((select-second)
|
|
(let ((time (second msg)))
|
|
(if (data:second-client data)
|
|
(wm-select-client wm (data:second-client data) time))))
|
|
|
|
((show-clients) #t)
|
|
|
|
(else (warn "unhandled split-wm message" wm msg)))))
|
|
|
|
(define (calc-rectangles wm data)
|
|
(let* ((options (wm:options wm))
|
|
(special-options (wm:special-options wm))
|
|
(bar-width (get-option-value options 'bar-width))
|
|
(orientation (get-option-value special-options 'orientation))
|
|
(aspect (get-option-value special-options 'aspect))
|
|
(r (clip-rectangle (wm:dpy wm) (wm:window wm))))
|
|
(if (eq? orientation 'horizontal)
|
|
(let* ((r1 (make-rectangle 0 0
|
|
(floor (/ (- (rectangle:width r) bar-width)
|
|
(+ 1 (/ 1 aspect))))
|
|
(rectangle:height r)))
|
|
(r2 (make-rectangle (rectangle:width r1) 0
|
|
bar-width (rectangle:height r)))
|
|
(r3 (make-rectangle (+ (rectangle:width r1) bar-width) 0
|
|
(- (rectangle:width r)
|
|
(+ (rectangle:width r1) bar-width))
|
|
(rectangle:height r))))
|
|
(list r1 r2 r3))
|
|
(let* ((r1 (make-rectangle 0 0 (rectangle:width r)
|
|
(floor (/ (- (rectangle:height r) bar-width)
|
|
(+ 1 (/ 1 aspect))))))
|
|
(r2 (make-rectangle 0 (rectangle:height r1)
|
|
(rectangle:width r) bar-width))
|
|
(r3 (make-rectangle 0 (+ (rectangle:height r1) bar-width)
|
|
(rectangle:width r)
|
|
(- (rectangle:height r)
|
|
(+ (rectangle:height r1) bar-width)))))
|
|
(list r1 r2 r3)))))
|
|
|
|
(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 data))
|
|
(dpy (wm:dpy wm)))
|
|
(move-resize-window* dpy resizer-window (second rects))
|
|
(if first-client
|
|
(move-resize-window* dpy
|
|
(client:client-window first-client)
|
|
(first rects)))
|
|
(if second-client
|
|
(move-resize-window* dpy
|
|
(client:client-window second-client)
|
|
(third rects))))))
|
|
|
|
(define (fit-client-windows wm client)
|
|
(let ((dpy (wm:dpy wm)))
|
|
(maximize-window dpy (client:window client))))
|
|
|
|
;; *******************************************************************
|
|
;; Resizer
|
|
;; *******************************************************************
|
|
|
|
(define (create-resizer wm data)
|
|
(let* ((dpy (wm:dpy wm))
|
|
(main-window (wm:window wm))
|
|
(options (wm:options wm))
|
|
(soptions (wm:special-options wm))
|
|
(window (create-simple-window dpy main-window 0 0 1 1 0
|
|
(white-pixel dpy) (black-pixel dpy)))
|
|
(root (window-root dpy window))
|
|
(gc (create-gc dpy window '()))
|
|
(root-gc (create-gc dpy window
|
|
(make-gc-value-alist
|
|
(function (gc-function xor))
|
|
(subwindow-mode (subwindow-mode
|
|
include-inferiors)))))
|
|
(cursor (create-font-cursor
|
|
dpy (if (eq? (get-option-value soptions 'orientation)
|
|
'horizontal)
|
|
xc-sb-h-double-arrow
|
|
xc-sb-v-double-arrow))))
|
|
(set-window-cursor! dpy window cursor)
|
|
(spawn*
|
|
(list 'split-resizer wm)
|
|
(lambda (release)
|
|
(call-with-event-channel
|
|
dpy window (event-mask structure-notify
|
|
exposure
|
|
button-press button-release
|
|
button-1-motion)
|
|
(lambda (event-channel)
|
|
(release)
|
|
(letrec
|
|
((idle (lambda ()
|
|
(let* ((e (receive event-channel))
|
|
(type (any-event-type e)))
|
|
(cond
|
|
((eq? (event-type button-press) type)
|
|
(let ((r (root-rectangle dpy window)))
|
|
(grab-server dpy)
|
|
(draw-resizer r)
|
|
(drag r r (button-event-x e) (button-event-y e))))
|
|
((expose-event? e)
|
|
(if (= 0 (expose-event-count e))
|
|
(draw-resizer-window))
|
|
(idle))
|
|
((destroy-window-event? e) #t)
|
|
(else (idle))))))
|
|
(drag (lambda (start-rect last-rect start-x start-y)
|
|
(let* ((e (receive event-channel))
|
|
(type (any-event-type e)))
|
|
(cond
|
|
((motion-event? e)
|
|
(draw-resizer last-rect)
|
|
(let ((new-rect (calc-new-rect
|
|
start-rect
|
|
(- (motion-event-x e) start-x)
|
|
(- (motion-event-y e) start-y))))
|
|
(draw-resizer new-rect)
|
|
(drag start-rect new-rect start-x start-y)))
|
|
((eq? (event-type button-release) type)
|
|
(draw-resizer last-rect)
|
|
(ungrab-server dpy)
|
|
(commit-resize (- (button-event-x e) start-x)
|
|
(- (button-event-y e) start-y))
|
|
(idle))
|
|
((expose-event? e)
|
|
(if (= 0 (expose-event-count e))
|
|
(draw-resizer-window))
|
|
(drag start-rect last-rect start-x start-y))
|
|
((destroy-window-event? e) #t)
|
|
(else
|
|
(drag start-rect last-rect start-x start-y))))))
|
|
|
|
(draw-resizer
|
|
(lambda (rect)
|
|
(draw dpy root root-gc rect)))
|
|
(draw-resizer-window
|
|
(lambda ()
|
|
(draw dpy window gc (clip-rectangle dpy window))))
|
|
(commit-resize
|
|
(lambda (dx dy)
|
|
;; check if outside... TODO
|
|
(let* ((rects (calc-rectangles wm data))
|
|
(r1 (first rects)) (r2 (third rects))
|
|
(aspect
|
|
(if (eq? 'horizontal
|
|
(get-option-value (wm:special-options wm)
|
|
'orientation))
|
|
(if (= 0 (- (rectangle:width r2) dx))
|
|
0
|
|
(/ (+ (rectangle:width r1) dx)
|
|
(- (rectangle:width r2) dx)))
|
|
(if (= 0 (- (rectangle:height r2) dy))
|
|
0
|
|
(/ (+ (rectangle:height r1) dy)
|
|
(- (rectangle:height r2) dy))))))
|
|
(if (> aspect 0)
|
|
(begin
|
|
(set-option! (wm:special-options wm) 'aspect aspect)
|
|
(send (wm:internal-out-channel wm)
|
|
'(fit-windows))
|
|
)))))
|
|
(calc-new-rect
|
|
(lambda (start-rect dx dy)
|
|
(let ((width (rectangle:width start-rect))
|
|
(height (rectangle:height start-rect)))
|
|
(if (eq? (get-option-value (wm:special-options wm)
|
|
'orientation)
|
|
'horizontal)
|
|
(make-rectangle (+ (rectangle:x start-rect) dx)
|
|
(rectangle:y start-rect)
|
|
width height)
|
|
(make-rectangle (rectangle:x start-rect)
|
|
(+ (rectangle:y start-rect) dy)
|
|
width height)))))
|
|
(draw
|
|
(lambda (dpy window gc r)
|
|
(let ((colors (get-option-value options 'bar-colors)))
|
|
(set-gc-foreground! dpy gc (second colors))
|
|
(fill-rectangle dpy window gc
|
|
(rectangle:x r) (rectangle:y r)
|
|
(rectangle:width r) (rectangle:height r))
|
|
;; Rest ??
|
|
)))
|
|
)
|
|
(idle)
|
|
(free-cursor dpy cursor)
|
|
(free-gc dpy gc)
|
|
(free-gc dpy root-gc))))))
|
|
window))
|