diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 4b4b681fe1..8d75db3ddd 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -238,16 +238,38 @@ module browser threading seems wrong. [before+ (and before (send text get-forward-sexp before))] [after (send text get-forward-sexp pos)] [after- (and after (send text get-backward-sexp after))]) - (cond - [(and before before+ - (<= before pos before+) - (eq? 'symbol (send text classify-position before))) - (send text get-text before before+)] - [(and after after- - (<= after- pos after) - (eq? 'symbol (send text classify-position after-))) - (send text get-text after- after)] - [else ""]))] + + (define (get-tokens start end) + (let loop ([i start]) + (cond + [(and (< i end) + (< i (send text last-position))) + (define-values (tstart tend) (send text get-token-range i)) + (cons (list (send text classify-position i) tstart tend) + (loop tend))] + [else '()]))) + + ;; find-searchable-tokens : number number -> (or/c #f (list symbol number number)) + (define (find-searchable-tokens start end) + (define tokens (get-tokens start end)) + (define raw-tokens (map (λ (x) (list-ref x 0)) tokens)) + (cond + [(equal? raw-tokens '(symbol)) + (car tokens)] + [(equal? raw-tokens '(constant symbol)) + (cadr tokens)] + [else #f])) + + (define searchable-token + (or (and before before+ + (<= before pos before+) + (find-searchable-tokens before before+)) + (and after after- + (<= after- pos after) + (find-searchable-tokens after- after)))) + (if searchable-token + (send text get-text (list-ref searchable-token 1) (list-ref searchable-token 2)) + ""))] [else (send text split-snip pos) (send text split-snip (+ pos 1)) diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index f7be4ce51e..08ef4f5ecc 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -817,16 +817,26 @@ added get-regions ;; Determines whether a position is a 'comment, 'string, etc. (define/public (classify-position position) + (define tokens (get-tokens-at-position 'classify-position position)) + (and tokens + (let ([root-data (send tokens get-root-data)]) + (and root-data + (data-type root-data))))) + + (define/public (get-token-range position) + (define tokens (get-tokens-at-position 'get-token-range position)) + (values (and tokens (send tokens get-root-start-position)) + (and tokens (send tokens get-root-end-position)))) + + (define/private (get-tokens-at-position who position) (when stopped? - (error 'classify-position "called on a color:text<%> whose colorer is stopped.")) + (error who "called on a color:text<%> whose colorer is stopped.")) (let ([ls (find-ls position)]) (and ls (let ([tokens (lexer-state-tokens ls)]) (tokenize-to-pos ls position) (send tokens search! (- position (lexer-state-start-pos ls))) - (let ([root-data (send tokens get-root-data)]) - (and root-data - (data-type root-data))))))) + tokens)))) (define/private (tokenize-to-pos ls position) (when (and (not (lexer-state-up-to-date? ls)) diff --git a/collects/scribblings/framework/color.scrbl b/collects/scribblings/framework/color.scrbl index 979155fa5c..2dd561e6a1 100644 --- a/collects/scribblings/framework/color.scrbl +++ b/collects/scribblings/framework/color.scrbl @@ -212,7 +212,7 @@ right kind. If @scheme[flash?] is true, the matching open parenthesis will be flashed. } - @defmethod*[(((classify-position (position natural-number?)) symbol?))]{ + @defmethod*[(((classify-position (position exact-nonnegative-integer?)) symbol?))]{ Return a symbol for the lexer-determined token type for the token that @@ -221,6 +221,16 @@ Must only be called while the tokenizer is started. } + @defmethod[(get-token-range [position exact-nonnegative-integer?]) + (values (or/c #f exact-nonnegative-integer?) + (or/c #f exact-nonnegative-integer?))]{ + + Returns the range of the token surrounding @racket[position], if there is a token there. + + This method must be called only when the tokenizer is started. + + } + @defmethod[#:mode augment (on-lexer-valid [valid? boolean?]) any]{ This method is an observer for when the lexer is working. It is called when the lexer's state changes from valid to invalid (and back).