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

added button resizing 

cleaned up a bit
This commit is contained in:
frese 2003-04-27 19:14:24 +00:00
parent de00f837dc
commit 1fdd6a1366
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/titlebar.scm
View File

@ -28,16 +28,13 @@
(tb (make-titlebar in-channel dpy window "test" 'normal))
(button-channel out-channel)
(button-size 13) ;; TODO has to be calculated from window-height
(buttons (map (lambda (id i)
(buttons (map (lambda (id)
(create-button dpy window colormap
(make-rectangle
(+ 2 (* i (+ 2 button-size)))
2 button-size button-size)
(make-rectangle 0 0 1 1)
button-channel id
;; TODO: border-style -> colors
`((content . ,id))))
(get-option-value options 'buttons)
(iota (length (get-option-value options 'buttons)))))
(get-option-value options 'buttons)))
;; icon-window...
)
(for-each map-button buttons)
@ -61,7 +58,11 @@
((expose-event? xevent)
(if (and (= 0 (expose-event-count xevent))
(window-exists? dpy window))
(draw-titlebar tb options gc))))))
(draw-titlebar tb options gc)))
((configure-event? xevent)
(refit-buttons options buttons
(configure-event-width xevent)
(configure-event-height xevent))))))
(wrap (receive-rv in-channel)
(lambda (msg)
(case (car msg)
@ -98,7 +99,6 @@
(define (map-titlebar tb)
(map-window (titlebar:dpy tb) (titlebar:window tb)))
; (send (titlebar:channel tb) '(map #f)))
(define (unmap-titlebar tb)
(unmap-window (titlebar:dpy tb) (titlebar:window tb)))
@ -155,3 +155,14 @@
((active) 'active-colors)
((focused) 'focused-colors)
(else 'normal-colors))))
(define (refit-buttons options buttons width height)
(let* ((margin 2)
(bs (- height (* 2 margin)))
(spacing 2))
(for-each (lambda (i button)
(let ((r (make-rectangle (+ margin (* i (+ bs spacing)))
margin bs bs)))
(move-resize-button button r)))
(iota (length buttons))
buttons)))