added a color:text method get-token-range and then used that to improve how f1 in drracket works

Please include this commit on the release branch
This commit is contained in:
Robby Findler 2011-01-29 12:26:59 -06:00
parent f190e3efec
commit 4090eabacb
3 changed files with 57 additions and 15 deletions

View File

@ -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))

View File

@ -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))

View File

@ -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).