b972a0940d
being edited in DrRacket (via places) Added an API to let tools have access to that information (and compute more stuff) Used that to make an online version of Check Syntax which led to a separately callable Check Syntax API.
64 lines
2.3 KiB
Racket
64 lines
2.3 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/place
|
|
"traversals.rkt"
|
|
"intf.rkt")
|
|
(provide go)
|
|
|
|
(define obj%
|
|
(class (annotations-mixin object%)
|
|
(init-field src)
|
|
(define trace '())
|
|
|
|
(define-values (remote local) (place-channel))
|
|
(define table (make-hash))
|
|
(thread
|
|
(λ ()
|
|
(with-handlers ((exn:fail? (λ (x) (eprintf "online-comp.rkt: thread failed ~a\n" (exn-message x)))))
|
|
(let loop ()
|
|
(define id/name (place-channel-get local))
|
|
(define id (list-ref id/name 0))
|
|
(define name (list-ref id/name 1))
|
|
(define res ((hash-ref table id) name))
|
|
(place-channel-put local res)))))
|
|
|
|
(define/override (syncheck:find-source-object stx)
|
|
(and (equal? src (syntax-source stx))
|
|
src))
|
|
(define-syntax-rule
|
|
(log name)
|
|
(define/override (name . args)
|
|
(set! trace (cons (cons 'name args) trace))))
|
|
|
|
; (log syncheck:color-range) ;; we don't want log these as they are too distracting to keep popping up
|
|
; (log syncheck:add-mouse-over-status) ;; we don't log these as they require space in the window
|
|
(log syncheck:add-arrow)
|
|
(log syncheck:add-tail-arrow)
|
|
(log syncheck:add-background-color)
|
|
(log syncheck:add-require-open-menu)
|
|
(log syncheck:add-docs-menu)
|
|
(log syncheck:add-jump-to-definition)
|
|
(define/override (syncheck:add-rename-menu id-as-sym to-be-renamed/poss dup-name?)
|
|
(define id (hash-count table))
|
|
(hash-set! table id dup-name?)
|
|
(set! trace (cons (list 'syncheck:add-rename-menu id-as-sym to-be-renamed/poss remote id)
|
|
trace)))
|
|
|
|
(define/public (get-trace) (reverse trace))
|
|
(super-new)))
|
|
|
|
(void (get-xref)) ;; do this now so that it doesn't get killed during a call to 'go'
|
|
|
|
(define (go expanded path the-source)
|
|
(define obj (new obj% [src the-source]))
|
|
(define-values (expanded-expression expansion-completed)
|
|
(make-traversal (current-namespace)
|
|
(if path
|
|
(let-values ([(base name dir) (split-path path)])
|
|
base)
|
|
(current-directory))))
|
|
(parameterize ([current-annotations obj])
|
|
(expanded-expression expanded)
|
|
(expansion-completed))
|
|
(send obj get-trace))
|