[racket-dev] [plt] Push #25044: master branch updated

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Sat Jul 21 13:31:22 EDT 2012

Thanks for the prompt service. 20 lines of code is nice. 


On Jul 21, 2012, at 1:23 PM, robby at racket-lang.org wrote:

> robby has updated `master' from df4508573a to c4a768af00.
>  http://git.racket-lang.org/plt/df4508573a..c4a768af00
> 
> =====[ One Commit ]=====================================================
> Directory summary:
> 100.0% collects/drracket/private/
> 
> ~~~~~~~~~~
> 
> c4a768a Robby Findler <robby at racket-lang.org> 2012-07-21 12:22
> :
> | add a Copy menu to the error message from the online expansion stuff
> |
> | closes PR 12923
> :
>  M collects/drracket/private/module-language.rkt | 19 ++++++++++++++++++-
> 
> =====[ Overall Diff ]===================================================
> 
> collects/drracket/private/module-language.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/module-language.rkt
> +++ NEW/collects/drracket/private/module-language.rkt
> @@ -1151,11 +1151,28 @@
>   (define error-message%
>     (class canvas%
>       (init-field msg err?)
> -      (inherit refresh get-dc get-client-size)
> +      (inherit refresh get-dc get-client-size popup-menu)
>       (define/public (set-msg _msg _err?) 
>         (set! msg _msg)
>         (set! err? _err?)
>         (refresh))
> +      (define/override (on-event evt)
> +        (cond
> +          [(and (send evt button-down?) err?)
> +           (define m (new popup-menu%))
> +           (define itm (new menu-item% 
> +                            [label (string-constant copy-menu-item)]
> +                            [parent m]
> +                            [callback
> +                             (λ (itm evt)
> +                               (send the-clipboard set-clipboard-string 
> +                                     msg
> +                                     (send evt get-time-stamp)))]))
> +           (popup-menu m 
> +                       (+ (send evt get-x) 1)
> +                       (+ (send evt get-y) 1))]
> +          [else
> +           (super on-event evt)]))
>       (define/override (on-paint)
>         (define dc (get-dc))
>         (define-values (cw ch) (get-client-size))



Posted on the dev mailing list.