From 01b0c1124987003bec34691c3ee507cc84916978 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 28 Oct 2014 08:24:33 -0500 Subject: [PATCH] generalize the support for mouseover tooltips so that the computation of the string doesn't have to happen during macro expansion, but can happen only when check syntax is in the picture --- .../drracket/private/syncheck/annotate.rkt | 17 ++++++++++++----- .../drracket/private/syncheck/traversals.rkt | 5 ++++- .../drracket/scribblings/tools/tools.scrbl | 14 ++++++++++---- 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/annotate.rkt b/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/annotate.rkt index 987285218c..f085735a87 100644 --- a/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/annotate.rkt +++ b/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/annotate.rkt @@ -25,10 +25,10 @@ (when defs (send defs syncheck:color-range source start finish style-name))) -;; add-mouse-over : syntax[original] string -> void +;; add-mouse-over : syntax[original] (or/c string (-> string?)) -> void ;; registers the range in the editor so that a mouse over ;; this area shows up in the status line. -(define (add-mouse-over stx str) +(define (add-mouse-over stx str/proc) (define source (find-source-editor stx)) (define defs-text (current-annotations)) (when (and defs-text @@ -37,12 +37,19 @@ (syntax-span stx)) (define pos-left (- (syntax-position stx) 1)) (define pos-right (+ pos-left (syntax-span stx))) - (send defs-text syncheck:add-mouse-over-status - source pos-left pos-right str))) + (add-mouse-over/loc/proc defs-text source pos-left pos-right str/proc))) -(define (add-mouse-over/loc source pos-left pos-right str) +(define (add-mouse-over/loc source pos-left pos-right str/proc) (define defs-text (current-annotations)) (when defs-text + (add-mouse-over/loc/proc defs-text source pos-left pos-right str/proc))) + +(define (add-mouse-over/loc/proc defs-text source pos-left pos-right str/proc) + (define str + (cond + [(procedure? str/proc) (str/proc)] + [else str/proc])) + (when (string? str) (send defs-text syncheck:add-mouse-over-status source pos-left pos-right str))) diff --git a/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/traversals.rkt b/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/traversals.rkt index fce049e9e9..d87aec2429 100644 --- a/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/traversals.rkt +++ b/pkgs/drracket-pkgs/drracket-tool-lib/drracket/private/syncheck/traversals.rkt @@ -545,7 +545,10 @@ prop)]))) (define mouse-over-tooltip-prop? - (vector/c #:flat? #t syntax? exact-nonnegative-integer? exact-nonnegative-integer? string?)) + (vector/c #:flat? #t syntax? exact-nonnegative-integer? exact-nonnegative-integer? + (or/c string? + ;; don't check the range here, since we want a predicate, not really a contract + (-> any)))) (define (add-mouse-over-tooltips stx) (let loop ([prop (syntax-property stx 'mouse-over-tooltips)]) (cond diff --git a/pkgs/drracket-pkgs/drracket/scribblings/tools/tools.scrbl b/pkgs/drracket-pkgs/drracket/scribblings/tools/tools.scrbl index a2b67b08c5..de7ba76925 100644 --- a/pkgs/drracket-pkgs/drracket/scribblings/tools/tools.scrbl +++ b/pkgs/drracket-pkgs/drracket/scribblings/tools/tools.scrbl @@ -753,12 +753,18 @@ After putting this code in the DrRacket window, mouse over the words ``big'' and The value of the @racket['mouse-over-tooltips] property is expected to be to be a tree of @racket[cons] pairs (in any configuration) whose leaves are either ignored or are vectors of the shape -@racketblock[(vector/c syntax? exact-nonnegative-integer? exact-nonnegative-integer? string?)] +@racketblock[(vector/c syntax? + exact-nonnegative-integer? + exact-nonnegative-integer? + (or/c string? (-> string?)))] Each vector's content indicates where to show a tooltip. The first three components are a syntax object whose @racket[syntax-source] field indicates which file the tooltip goes in, the start and end position in the editor where mouseovers will show the tooltip, -and the content of the tooltip. For example, here's a macro that shows the span of itself -in a tooltip on mouseover: +and the content of the tooltip. If the tooltip content is a procedure, this procedure +is called by Check Syntax to compute the string used for the tooltip, as Check Syntax +traverses the syntax objects looking for properties. + +For example, here's a macro that shows the span of itself in a tooltip on mouseover: @codeblock{ #lang racket (define-syntax (char-span stx) @@ -777,7 +783,7 @@ in a tooltip on mouseover: (char-span (+ 1 2))} -Finally, Check Syntax only draws arrows between identifiers that are @racket[syntax-original?] +Finally, Check Syntax draws arrows only between identifiers that are @racket[syntax-original?] or that have the @racket[syntax-property] @racket['original-for-check-syntax] set to @racket[#t].