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