78 lines
2.7 KiB
Racket
78 lines
2.7 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/gui/base
|
|
framework
|
|
"intf.rkt")
|
|
(provide color color-range
|
|
find-source-editor
|
|
find-source-editor/defs
|
|
get-defs-text)
|
|
|
|
;; color : syntax[original] str -> void
|
|
;; colors the syntax with style-name's style
|
|
(define (color stx style-name mode)
|
|
(let ([source (find-source-editor stx)])
|
|
(when (and (is-a? source text%)
|
|
(syntax-position stx)
|
|
(syntax-span stx))
|
|
(let ([pos (- (syntax-position stx) 1)]
|
|
[span (syntax-span stx)])
|
|
(color-range source pos (+ pos span) style-name mode)))))
|
|
|
|
;; color-range : text start finish style-name
|
|
;; colors a range in the text based on `style-name'
|
|
(define (color-range source start finish style-name mode)
|
|
(let ([style (send (send source get-style-list)
|
|
find-named-style
|
|
style-name)])
|
|
(apply-style/remember source start finish style mode)))
|
|
|
|
;; find-source-editor : stx -> editor or false
|
|
(define (find-source-editor stx)
|
|
(let ([defs-text (get-defs-text)])
|
|
(and defs-text
|
|
(find-source-editor/defs stx defs-text))))
|
|
|
|
;; find-source-editor : stx text -> editor or false
|
|
(define (find-source-editor/defs stx defs-text)
|
|
(cond
|
|
[(not (syntax-source stx)) #f]
|
|
[(and (symbol? (syntax-source stx))
|
|
(text:lookup-port-name (syntax-source stx)))
|
|
=> values]
|
|
[else
|
|
(let txt-loop ([text defs-text])
|
|
(cond
|
|
[(and (is-a? text text:basic<%>)
|
|
(send text port-name-matches? (syntax-source stx)))
|
|
text]
|
|
[else
|
|
(let snip-loop ([snip (send text find-first-snip)])
|
|
(cond
|
|
[(not snip)
|
|
#f]
|
|
[(and (is-a? snip editor-snip%)
|
|
(send snip get-editor))
|
|
(or (txt-loop (send snip get-editor))
|
|
(snip-loop (send snip next)))]
|
|
[else
|
|
(snip-loop (send snip next))]))]))]))
|
|
;; get-defs-text : -> text or false
|
|
(define (get-defs-text)
|
|
(currently-processing-definitions-text))
|
|
|
|
;; apply-style/remember : (is-a?/c editor<%>) number number style% symbol -> void
|
|
(define (apply-style/remember ed start finish style mode)
|
|
(let ([outermost (find-outermost-editor ed)])
|
|
(and (is-a? outermost syncheck-text<%>)
|
|
(send outermost syncheck:apply-style/remember ed start finish style mode))))
|
|
|
|
(define (find-outermost-editor ed)
|
|
(let loop ([ed ed])
|
|
(let ([admin (send ed get-admin)])
|
|
(if (is-a? admin editor-snip-editor-admin<%>)
|
|
(let* ([enclosing-snip (send admin get-snip)]
|
|
[enclosing-snip-admin (send enclosing-snip get-admin)])
|
|
(loop (send enclosing-snip-admin get-editor)))
|
|
ed))))
|