scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added thread names 

removed kill-client
added main-window drawing
fixed titlebars with height 0 (workspace manager)
This commit is contained in:
frese 2003-04-11 01:20:22 +00:00
parent 537c32ce6c
commit 0b23d8bf08
1 changed files with 40 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/switch-wm.scm
View File

@ -7,7 +7,6 @@
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*") (font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
(select-next keys "M-k n") (select-next keys "M-k n")
(select-previous keys "M-k p") (select-previous keys "M-k p")
(kill-client keys "M-c")
) )
(define (create-switch-wm out-channel dpy parent options . children) (define (create-switch-wm out-channel dpy parent options . children)
@ -15,7 +14,9 @@
(manager-type switch) switch-wm-options-spec (manager-type switch) switch-wm-options-spec
out-channel out-channel
(lambda (wm in-channel) (lambda (wm in-channel)
(spawn (lambda () (spawn* (list 'switch-wm wm)
(lambda (release)
(release)
(switch-wm-handler wm in-channel))) (switch-wm-handler wm in-channel)))
wm))) wm)))
@ -27,23 +28,27 @@
(define (switch-wm-handler wm channel) (define (switch-wm-handler wm channel)
(let* ((dpy (wm:dpy wm)) (let* ((dpy (wm:dpy wm))
(window (wm:window wm))
(options (wm:options wm)) (options (wm:options wm))
(gc (create-gc dpy (wm:window wm) '())) (gc (create-gc dpy window '()))
(empty-titlebar (create-empty-titlebar wm)) (empty-titlebar (create-empty-titlebar wm))
(data (make-switch-wm-data '() empty-titlebar))) (data (make-switch-wm-data '() empty-titlebar)))
(update-titlebars wm data) (update-titlebars wm data)
(grab-shortcut dpy (wm:window wm) (grab-shortcut dpy window
(get-option-value options 'select-next) (get-option-value options 'select-next)
'select-next channel #f) 'select-next channel #f)
(grab-shortcut dpy (wm:window wm) (grab-shortcut dpy window
(get-option-value options 'select-previous) (get-option-value options 'select-previous)
'select-previous channel #f) 'select-previous channel #f)
(let loop () (let loop ()
(let ((msg (receive channel))) (let ((msg (receive channel)))
(case (car msg) (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-windows)
(fit-titlebars wm data) (fit-titlebars wm data)
@ -97,6 +102,8 @@
(width (window-width dpy (wm:window wm))) (width (window-width dpy (wm:window wm)))
(height (window-height dpy (wm:window wm))) (height (window-height dpy (wm:window wm)))
(titlebar-height (get-option-value (wm:options wm) 'titlebar-height))) (titlebar-height (get-option-value (wm:options wm) 'titlebar-height)))
(if (> titlebar-height 0)
(begin
(move-resize-titlebar (data:empty-titlebar data) (move-resize-titlebar (data:empty-titlebar data)
(make-rectangle 0 0 width titlebar-height)) (make-rectangle 0 0 width titlebar-height))
(let* ((titlebars (map cdr (data:titlebars data))) (let* ((titlebars (map cdr (data:titlebars data)))
@ -110,16 +117,17 @@
titlebar titlebar
(make-rectangle (* i width) 0 (make-rectangle (* i width) 0
width titlebar-height))) width titlebar-height)))
(iota n) widths titlebars)))) (iota n) widths titlebars))))))
(define (update-titlebars wm data) (define (update-titlebars wm data)
(if (> (get-option-value (wm:options wm) 'titlebar-height) 0)
(if (null? (data:titlebars data)) (if (null? (data:titlebars data))
(map-titlebar (data:empty-titlebar data)) (map-titlebar (data:empty-titlebar data))
(begin (begin
(unmap-titlebar (data:empty-titlebar data)) (unmap-titlebar (data:empty-titlebar data))
(for-each (lambda (c.t) (for-each (lambda (c.t)
(map-titlebar (cdr c.t))) (map-titlebar (cdr c.t)))
(data:titlebars data))))) (data:titlebars data))))))
(define (init-client wm data client maybe-rect) (define (init-client wm data client maybe-rect)
;; TODO: transients! ;; TODO: transients!
@ -138,11 +146,10 @@
(install-dragging-control channel dpy (install-dragging-control channel dpy
(titlebar:window titlebar) (titlebar:window titlebar)
(titlebar:window titlebar)) (titlebar:window titlebar))
(grab-shortcut dpy (client:client-window client) (spawn*
(get-option-value options 'kill-client) (list 'switch-wm-client-handler wm client)
'kill-client channel #f) (lambda (release)
(spawn (release)
(lambda ()
(let loop () (let loop ()
(let ((msg (receive channel))) (let ((msg (receive channel)))
(case (car msg) (case (car msg)
@ -157,9 +164,6 @@
root-x root-y)))))) root-x root-y))))))
((click) ((click)
(wm-select-client wm client (fourth msg))) (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")))) (else (mdisplay "unhandled client message: " msg "\n"))))
;; TODO: internal channel ;; TODO: internal channel
(loop)))) (loop))))