diff --git a/src/titlebar.scm b/src/titlebar.scm index 3c7349f..483aea4 100644 --- a/src/titlebar.scm +++ b/src/titlebar.scm @@ -3,7 +3,7 @@ (normal-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black")) (active-colors colors '("#9999aa" "#eeeeff" "#777788" "black")) (focused-colors colors '("#666699" "#aaaacc" "#333366" "#eeeeee")) - (border-style symbol 'raised) ; none | sunken + (border-style symbol 'raised) ; flat | sunken (font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*") (button-border-style symbol 'flat) ; none | raised ) @@ -55,25 +55,41 @@ (wrap (receive-rv event-channel) (lambda (xevent) (cond + ((or (destroy-window-event? xevent) + (not (window-exists? dpy window))) + (exit)) ((expose-event? xevent) (if (and (= 0 (expose-event-count xevent)) (window-exists? dpy window)) - (draw-titlebar tb options gc))) - ((destroy-window-event? xevent) - (exit))))) + (draw-titlebar tb options gc)))))) (wrap (receive-rv in-channel) (lambda (msg) (case (car msg) ((title) - (set-titlebar:title! tb (cdr msg)) - (draw-titlebar tb options gc)) + (let ((title (cdr msg))) + (if (not (equal? (titlebar:title tb) title)) + (begin + (set-titlebar:title! tb title) + (draw-titlebar tb options gc))))) ((state) - (set-titlebar:state! tb (cdr msg)) - (draw-titlebar tb options gc))))) + (let ((state (cdr msg))) + (if (not (equal? (titlebar:state tb) state)) + (begin + (set-titlebar:state! tb (cdr msg)) + (draw-titlebar tb options gc))))) + ((title+state) + (let ((title (second msg)) + (state (third msg))) + (if (or (not (equal? (titlebar:title tb) title)) + (not (equal? (titlebar:state tb) state))) + (begin + (set-titlebar:title! tb title) + (set-titlebar:state! tb state) + (draw-titlebar tb options gc)))))))) ) (loop)))))) (free-gc dpy gc) - ;; colormap might to exists anymore... + ;; colormap might not exists anymore... (free-options options #t))) tb)) @@ -96,6 +112,9 @@ (define (set-titlebar-state! tb state) (send (titlebar:channel tb) (cons 'state state))) +(define (set-titlebar-title+state! tb title state) + (send (titlebar:channel tb) (list 'title+state title state))) + (define (draw-titlebar tb options gc) (let ((dpy (titlebar:dpy tb)) (window (titlebar:window tb)) @@ -121,8 +140,10 @@ dark-color light-color))) ;; else flat... ;; draw the title - (set-gc-foreground! dpy gc font-color) - (set-gc-background! dpy gc main-color) + (change-gc dpy gc + (make-gc-value-alist + (foreground font-color) + (background main-color))) (let ((x.y (text-center-pos r font title))) (draw-image-string dpy window gc (car x.y) (cdr x.y) title))