2f9f780727
this also gets rid of the module-level imports as annotations in the bar along the buttom of a drracket window, which eliminates the use of the 'drracket:check-syntax:mouse-over status line and thus: closes PR 12186
64 lines
2.2 KiB
Racket
64 lines
2.2 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)
|
|
(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))
|