(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))