added thread names
removed kill-client added main-window drawing fixed titlebars with height 0 (workspace manager)
This commit is contained in:
parent
537c32ce6c
commit
0b23d8bf08
|
@ -7,7 +7,6 @@
|
|||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||
(select-next keys "M-k n")
|
||||
(select-previous keys "M-k p")
|
||||
(kill-client keys "M-c")
|
||||
)
|
||||
|
||||
(define (create-switch-wm out-channel dpy parent options . children)
|
||||
|
@ -15,8 +14,10 @@
|
|||
(manager-type switch) switch-wm-options-spec
|
||||
out-channel
|
||||
(lambda (wm in-channel)
|
||||
(spawn (lambda ()
|
||||
(switch-wm-handler wm in-channel)))
|
||||
(spawn* (list 'switch-wm wm)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(switch-wm-handler wm in-channel)))
|
||||
wm)))
|
||||
|
||||
(define-record-type switch-wm-data :switch-wm-data
|
||||
|
@ -27,23 +28,27 @@
|
|||
|
||||
(define (switch-wm-handler wm channel)
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
(window (wm:window wm))
|
||||
(options (wm:options wm))
|
||||
(gc (create-gc dpy (wm:window wm) '()))
|
||||
(gc (create-gc dpy window '()))
|
||||
(empty-titlebar (create-empty-titlebar wm))
|
||||
(data (make-switch-wm-data '() empty-titlebar)))
|
||||
(update-titlebars wm data)
|
||||
|
||||
(grab-shortcut dpy (wm:window wm)
|
||||
(grab-shortcut dpy window
|
||||
(get-option-value options 'select-next)
|
||||
'select-next channel #f)
|
||||
(grab-shortcut dpy (wm:window wm)
|
||||
(grab-shortcut dpy window
|
||||
(get-option-value options 'select-previous)
|
||||
'select-previous channel #f)
|
||||
|
||||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(case (car msg)
|
||||
((draw-main-window) #t)
|
||||
((draw-main-window)
|
||||
(set-gc-foreground! dpy gc (black-pixel dpy))
|
||||
(fill-rectangle* dpy window gc
|
||||
(clip-rectangle dpy window)))
|
||||
|
||||
((fit-windows)
|
||||
(fit-titlebars wm data)
|
||||
|
@ -97,29 +102,32 @@
|
|||
(width (window-width dpy (wm:window wm)))
|
||||
(height (window-height dpy (wm:window wm)))
|
||||
(titlebar-height (get-option-value (wm:options wm) 'titlebar-height)))
|
||||
(move-resize-titlebar (data:empty-titlebar data)
|
||||
(make-rectangle 0 0 width titlebar-height))
|
||||
(let* ((titlebars (map cdr (data:titlebars data)))
|
||||
(n (length titlebars))
|
||||
(widths (if (zero? n) '()
|
||||
(let ((dw (quotient width n)))
|
||||
(append (map (lambda (_) dw) (iota (- n 1)))
|
||||
(list (- width (* dw (- n 1)))))))))
|
||||
(for-each (lambda (i width titlebar)
|
||||
(move-resize-titlebar
|
||||
titlebar
|
||||
(make-rectangle (* i width) 0
|
||||
width titlebar-height)))
|
||||
(iota n) widths titlebars))))
|
||||
(if (> titlebar-height 0)
|
||||
(begin
|
||||
(move-resize-titlebar (data:empty-titlebar data)
|
||||
(make-rectangle 0 0 width titlebar-height))
|
||||
(let* ((titlebars (map cdr (data:titlebars data)))
|
||||
(n (length titlebars))
|
||||
(widths (if (zero? n) '()
|
||||
(let ((dw (quotient width n)))
|
||||
(append (map (lambda (_) dw) (iota (- n 1)))
|
||||
(list (- width (* dw (- n 1)))))))))
|
||||
(for-each (lambda (i width titlebar)
|
||||
(move-resize-titlebar
|
||||
titlebar
|
||||
(make-rectangle (* i width) 0
|
||||
width titlebar-height)))
|
||||
(iota n) widths titlebars))))))
|
||||
|
||||
(define (update-titlebars wm data)
|
||||
(if (null? (data:titlebars data))
|
||||
(map-titlebar (data:empty-titlebar data))
|
||||
(begin
|
||||
(unmap-titlebar (data:empty-titlebar data))
|
||||
(for-each (lambda (c.t)
|
||||
(map-titlebar (cdr c.t)))
|
||||
(data:titlebars data)))))
|
||||
(if (> (get-option-value (wm:options wm) 'titlebar-height) 0)
|
||||
(if (null? (data:titlebars data))
|
||||
(map-titlebar (data:empty-titlebar data))
|
||||
(begin
|
||||
(unmap-titlebar (data:empty-titlebar data))
|
||||
(for-each (lambda (c.t)
|
||||
(map-titlebar (cdr c.t)))
|
||||
(data:titlebars data))))))
|
||||
|
||||
(define (init-client wm data client maybe-rect)
|
||||
;; TODO: transients!
|
||||
|
@ -138,11 +146,10 @@
|
|||
(install-dragging-control channel dpy
|
||||
(titlebar:window titlebar)
|
||||
(titlebar:window titlebar))
|
||||
(grab-shortcut dpy (client:client-window client)
|
||||
(get-option-value options 'kill-client)
|
||||
'kill-client channel #f)
|
||||
(spawn
|
||||
(lambda ()
|
||||
(spawn*
|
||||
(list 'switch-wm-client-handler wm client)
|
||||
(lambda (release)
|
||||
(release)
|
||||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(case (car msg)
|
||||
|
@ -157,9 +164,6 @@
|
|||
root-x root-y))))))
|
||||
((click)
|
||||
(wm-select-client wm client (fourth msg)))
|
||||
((kill-client)
|
||||
(let ((time (second msg)))
|
||||
(delete-window dpy (client:window client) time)))
|
||||
(else (mdisplay "unhandled client message: " msg "\n"))))
|
||||
;; TODO: internal channel
|
||||
(loop))))
|
||||
|
|
Loading…
Reference in New Issue