[plt-scheme] Event bug under MS Windows

This was confusing, but I think it's not a bug in MrEd.

When you move the mouse down, you end up moving the mouse over the
tooltip window --- so the mouse effectively leaves the button window
and moves into the tooltip window.

When you move up, then you're not moving on top of the initial tooltip
window, so you don't get extra leave and enter events.

For a while, I thought it really was a bug, because I didn't see the
effect that you describe under Mac OS X. But that's just because the
window-placement rules are a little strange. Subtract the result of
`(get-display-left-top-inset)' from the result of `client->screen' to
get the location in the right kind of coordinates. (See the docs for
`client->screen' for more information.) With that change, the program
runs the same in Mac OS X and Windows: moving down generates extra
leave and enter events.

You might want to look at `mrlib/switchable-button' to see how it
implements tooltips. (It would be nice, of course, to have the tooltip
functionality implemented in its own library.)


At Sat, 13 Sep 2008 01:33:55 +0200 (CEST), Ivanyi Peter wrote:
> Hi,
> 
> The program below tries to simulate a tooltip window.
> If you try it under MS Windows and you move the mouse from top 
> to bottom over the button, you should notice, that it will
> print 
> repeatedly:
> 
> enter
> motion
> leave
> 
> It is very strange, as when you move the mouse from bottom
> to top
> over the button it prints one 'enter, a lot of motion and
> one 'leave
> message. I think this is a bug in MrEd.
> Can it be fixed?
> 
> Thanks.
> 
> Peter Ivanyi
> 
> ---------------------------------------------------------------------------
> 
> (module tooltip mzscheme
>   (require (lib "class.ss") (lib "mred.ss" "mred") (lib
> "framework.ss" "framework"))
> 
>   (define mred-button-tooltip%
>     (class button%
>       
>       (init-field
>         (tooltip-text " ")
>       )
>       
>       ; this is the timer
>       (define timer #f)
>       ; whether the tooltip window is shown
>       (define shown? #f)
>       ; the tooltip window
>       (define tooltip #f)
>       
>       (define (tooltip:clear)
>         (if timer
>           (begin
>             (send timer stop)
>             (set! timer #f)
>           )
>         )
>         (if (and tooltip shown?)
>           (begin
>             (send tooltip show #f)
>             (set! tooltip #f)
>             (set! shown? #f)
>           )
>         )
>       )
>       
>       (define (tooltip:timer)
>         (tooltip:clear)
>       )
>       
>       (define (tooltip:setup text x y)
>         (let-values
>           (((sx sy) (send this client->screen x y)))
>           (let*
>             ((frame (new frame%
>                          (parent #f)
>                          (label "")
>                          (stretchable-height #f)
>                          (stretchable-width #f)
>                          (x sx)
>                          (y sy)
>                          (width 46)
>                          (height 17)
>                          (border 2)
>                          (style '(no-system-menu no-caption
> no-resize-border float))
>                     )
>               )
>               (message (new message% (parent frame) (label
> text)))
>             )
>             (set! tooltip frame)
>             (set! timer (new timer% (notify-callback
> tooltip:timer)
>                                     (interval        3000)
>                                     (just-once?      #t)
>                         ))
>             (send tooltip show #t)
>             (set! shown? #t)
>           )
>         )
>       )
>       
>       
>       (define/override (on-subwindow-event w e)
>         (cond
>           ( (equal? (send e get-event-type) 'leave)
>             (tooltip:clear)
>           )
>           ( (member (send e get-event-type) '(enter))
>             (if (not shown?)
>               (tooltip:setup tooltip-text (send e get-x)
> (send e get-y))
>             )
>           )
>         )
>           
>         
>         (display (send e get-event-type))(newline)
>         #f
>       )
>       
>       (super-new)
>     )
>   )
>   
>   (define f (new frame% (label "Test")))
>   (define b (new mred-button-tooltip% (parent f) (label
> "Hello") (tooltip-text "Button") ))
>   (send f show #t)
>   
> 
> )
> 
> 
> _______________________________________
> LEGYÉL TE IS KLIKKBRÓKER! - Befektetési alapok online az [origo] klikkbankban! 
> Ne bízd másra a pénzügyeidet! Kattints!
> kérjen ajánlatot most!http://www.klikkbank.hu/klikkbroker/index.html
> 
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme