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-*-*-*-*-*-*-*")
(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,7 +14,9 @@
(manager-type switch) switch-wm-options-spec
out-channel
(lambda (wm in-channel)
(spawn (lambda ()
(spawn* (list 'switch-wm wm)
(lambda (release)
(release)
(switch-wm-handler wm in-channel)))
wm)))
@ -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,6 +102,8 @@
(width (window-width dpy (wm:window wm)))
(height (window-height dpy (wm:window wm)))
(titlebar-height (get-option-value (wm:options wm) 'titlebar-height)))
(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)))
@ -110,16 +117,17 @@
titlebar
(make-rectangle (* i width) 0
width titlebar-height)))
(iota n) widths titlebars))))
(iota n) widths titlebars))))))
(define (update-titlebars wm 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)))))
(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))))