278 lines
8.5 KiB
Scheme
278 lines
8.5 KiB
Scheme
(define-options-spec split-wm-options-spec
|
|
(orientation symbol 'horizontal) ;; horizontal | vertical
|
|
(aspect number 1/1)
|
|
(bar-width int 3)
|
|
(resize-step int 5)
|
|
(bar-style symbol 'raised) ;; raised | sunken | flat
|
|
(bar-colors colors '("#dddddd" "#888888" "#333333"))
|
|
(select-right keys "M-Right")
|
|
(select-left keys "M-Left")
|
|
(select-up keys "M-Up")
|
|
(select-down keys "M-Down")
|
|
)
|
|
|
|
;; ---------- ----------
|
|
;; | | | | |
|
|
;; ---------- vertical | | | horizontal
|
|
;; | | | | |
|
|
;; ---------- ----------
|
|
|
|
(define (create-split-wm external-in-channel dpy parent options . children)
|
|
(create-wm dpy parent options children
|
|
(manager-type split) split-wm-options-spec
|
|
external-in-channel
|
|
(lambda (wm in-channel)
|
|
(spawn (lambda ()
|
|
(split-wm-handler wm in-channel)))
|
|
wm)))
|
|
|
|
(define (split-wm? wm)
|
|
(and (wm? wm) (eq? (wm:type wm) (manager-type split))))
|
|
|
|
(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)
|
|
(let loop ()
|
|
(let ((msg (receive channel)))
|
|
(case (car msg)
|
|
((draw-main-window) #t)
|
|
|
|
((fit-windows)
|
|
(fit-windows wm resizer-window first-client second-client))
|
|
|
|
((init-client)
|
|
(let ((client (second msg))
|
|
(first? (not first-client)))
|
|
(if first?
|
|
(set! first-client client)
|
|
(set! second-client client))
|
|
|
|
(set-window-border-width! dpy (client:window client) 0)
|
|
(fit-windows wm resizer-window first-client second-client)
|
|
|
|
(map-window dpy (client:client-window client))
|
|
;;(select-client wm client))) ??
|
|
|
|
(let ((opt (if (eq? (get-option-value (wm: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 first-client)
|
|
(set! first-client #f))
|
|
(if (eq? client second-client)
|
|
(set! second-client #f))
|
|
;; TODO: destroy switch if only one client left
|
|
))
|
|
|
|
((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)
|
|
|
|
((update-client-state) #t)
|
|
|
|
;; Shortcuts
|
|
((select-first)
|
|
(let ((time (second msg)))
|
|
(if first-client
|
|
(wm-select-client wm first-client time))))
|
|
((select-second)
|
|
(let ((time (second msg)))
|
|
(if second-client
|
|
(wm-select-client wm second-client time))))
|
|
))
|
|
(loop))))
|
|
|
|
(define (calc-rectangles wm)
|
|
(let* ((options (wm:options wm))
|
|
(bar-width (get-option-value options 'bar-width))
|
|
(orientation (get-option-value options 'orientation))
|
|
(aspect (get-option-value 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 resizer-window first-client second-client)
|
|
(let* ((rects (calc-rectangles wm))
|
|
(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)
|
|
(let* ((dpy (wm:dpy wm))
|
|
(main-window (wm:window wm))
|
|
(options (wm: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 options 'orientation)
|
|
'horizontal)
|
|
xc-sb-h-double-arrow
|
|
xc-sb-v-double-arrow))))
|
|
(set-window-cursor! dpy window cursor)
|
|
(spawn*
|
|
(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))
|
|
(r1 (first rects)) (r2 (third rects))
|
|
(aspect
|
|
(if (eq? 'horizontal
|
|
(get-option-value options '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! options '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 options '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))
|