59 lines
2.0 KiB
Racket
59 lines
2.0 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
"intf.rkt"
|
|
"local-member-names.rkt")
|
|
(provide color color-range
|
|
find-source-editor
|
|
find-source-editor/defs
|
|
add-mouse-over
|
|
add-mouse-over/loc)
|
|
|
|
;; color : syntax[original] str -> void
|
|
;; colors the syntax with style-name's style
|
|
(define (color stx style-name)
|
|
(let ([source (find-source-editor stx)])
|
|
(when (and (syntax-position stx)
|
|
(syntax-span stx))
|
|
(let ([pos (- (syntax-position stx) 1)]
|
|
[span (syntax-span stx)])
|
|
(color-range source pos (+ pos span) style-name)))))
|
|
|
|
;; 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)
|
|
(define defs (current-annotations))
|
|
(when defs
|
|
(send defs syncheck:color-range source start finish style-name)))
|
|
|
|
;; add-mouse-over : syntax[original] 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 source (find-source-editor stx))
|
|
(define defs-text (current-annotations))
|
|
(when (and defs-text
|
|
source
|
|
(syntax-position stx)
|
|
(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)))
|
|
|
|
(define (add-mouse-over/loc source pos-left pos-right str)
|
|
(define defs-text (current-annotations))
|
|
(when defs-text
|
|
(send defs-text syncheck:add-mouse-over-status
|
|
source pos-left pos-right str)))
|
|
|
|
;; find-source-editor : stx -> editor or false
|
|
(define (find-source-editor stx)
|
|
(let ([defs-text (current-annotations)])
|
|
(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)
|
|
(send defs-text syncheck:find-source-object stx))
|
|
|