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

added some window-exists? checks 

made redrawing little more efficient
This commit is contained in:
frese 2003-04-25 12:50:45 +00:00
parent 573d7f43f6
commit ffa4d4f937
1 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/titlebar.scm
View File

@ -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))