From c4a768af007a62a42ed908b5bbe6a36bdaf0d444 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 21 Jul 2012 12:22:40 -0500 Subject: [PATCH] add a Copy menu to the error message from the online expansion stuff closes PR 12923 --- collects/drracket/private/module-language.rkt | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index 9ad601a3b1..fa9f054514 100644 --- a/collects/drracket/private/module-language.rkt +++ b/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))