suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make the tooltip appear on the left side of the icon if the window is sufficiently large

Browse Source 
svn: r9718
This commit is contained in:
Robby Findler 2008-05-07 02:52:43 +00:00
parent 94d8c852da
commit c09743e2d2
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mrlib/switchable-button.ss
View File

@ -40,8 +40,6 @@
min-width min-height
get-client-size get-dc)
(super-new)
;(stretchable-width #f)
;(stretchable-height #f)
(let-values ([(tw th _1 _2) (send (get-dc) get-text-extent label small-control-font)])
(min-width (floor (inexact->exact (+ tw 4))))
(min-height (floor (inexact->exact (+ th 4)))))))
@ -136,12 +134,21 @@
(send float-window reflow-container)
;; position the floating window
(let-values ([(x y) (client->screen (floor (get-width))
(let-values ([(dw dh) (get-display-size)]
[(x y) (client->screen (floor (get-width))
(floor
(- (/ (get-height) 2)
(/ (send float-window get-height) 2))))]
[(dx dy) (get-display-left-top-inset)])
(send float-window move (- x dx) (- y dy)))
(let ([rhs-x (- x dx)]
[rhs-y (- y dy)])
(cond
[(< (+ rhs-x (send float-window get-width)) dw)
(send float-window move rhs-x rhs-y)]
[else
(send float-window move
(- rhs-x (send float-window get-width) (get-width))
rhs-y)])))
(unless timer-running?
(set! timer-running? #t)
(send timer start 500 #t))]