suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix up a few bugs, improve the docs, and start a test suite for the

Browse Source 
new check syntax direct-to-traversal api
This commit is contained in:
Robby Findler 2011-08-14 14:31:04 -05:00
parent fdcb22ea32
commit 00d3f72f21
4 changed files with 81 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drracket/private/syncheck/intf.rkt
View File

@ -87,8 +87,8 @@
(mixin () (syncheck-annotations<%>)
(define/public (syncheck:find-source-object stx) #f)
(define/public (syncheck:add-background-color source start end color) (void))
(define/public (syncheck:add-require-open-menu source color start end key) (void))
(define/public (syncheck:add-rename-menu text start-pos end-pos key id-as-sym id-sets rename-ht get-ids) (void))
(define/public (syncheck:add-require-open-menu source start end key) (void))
(define/public (syncheck:add-rename-menu id all-ids new-name-intereferes?) (void))
(define/public (syncheck:add-docs-menu text start-pos end-pos key the-label path tag) (void))
(define/public (syncheck:add-arrow start-text start-pos-left start-pos-right
end-text end-pos-left end-pos-right

2
collects/drracket/private/syncheck/traversals.rkt
View File

@ -892,7 +892,7 @@
;; finds the filename corresponding to the require in stx
(define (get-require-filename datum user-namespace user-directory)
(parameterize ([current-namespace user-namespace]
[current-directory user-directory]
[current-directory (or user-directory (current-directory))]
[current-load-relative-directory user-directory])
(let* ([rkt-path/mod-path
(with-handlers ([exn:fail? (λ (x) #f)])

15
collects/scribblings/tools/tools.scrbl
View File

@ -619,9 +619,9 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
(-> void?))]{
This function creates some local state about a traversal of syntax objects
and returns two functions. The first one should be called with each of the
syntax objects that make up a program (there will be only one if the program
is a module) and then the second one should be called to indicate there are no
more.
(fully expanded) syntax objects that make up a program (there will be only
one if the program is a module) and then the second one should be called to
indicate there are no more.
The optional argument to the first function is called for each sequence
of binding identifiers encountered in @racket[define-values], @racket[define-syntaxes],
@ -630,7 +630,8 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
During the dynamic extent of the call to the two result functions, the value
of the @racket[current-annotations] parameter is consulted and various
methods are invoked in the corresponding object (if any), to indicate
what has been found in the syntax object.
what has been found in the syntax object. These methods will only be called
if the syntax objects have source locations.
}
@defparam[current-annotations ca (or/c #f (is-a?/c syncheck-annotations<%>))]{
@ -760,6 +761,10 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
Supplies all of the methods in @racket[syncheck-annotations<%>]
with default behavior. Be sure to use this mixin to future-proof
your code and then override the methods you're interested in.
The @racket[syncheck:find-source-object] method ignores its arguments
and returns @racket[#f];
all of the other methods ignore their arguments and return @racket[(void)].
}
@(define-syntax-rule
@ -767,7 +772,7 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
(begin @defidform[x]{Bound to an identifier created with @racket[define-local-member-name]
that is used in @racket[syncheck-annotations<%>].}
...))
@syncheck-method-id[syncheck:find-source-editor
@syncheck-method-id[syncheck:find-source-object
syncheck:add-background-color
syncheck:add-require-open-menu
syncheck:add-docs-menu

68
collects/tests/drracket/syncheck-direct.rkt Normal file
View File

@ -0,0 +1,68 @@
#lang racket/base
(require drracket/check-syntax
racket/class
rackunit)
(check-true
(let ()
(define add-arrow-called? #f)
(define annotations
(new (class (annotations-mixin object%)
(super-new)
(define/override (syncheck:find-source-object stx)
(if (eq? 'the-source (syntax-source stx))
'yep
#f))
(define/override (syncheck:add-arrow . args)
(set! add-arrow-called? #t)))))
(define-values (add-syntax done)
(make-traversal (make-base-namespace)
(current-directory)))
(parameterize ([current-annotations annotations]
[current-namespace (make-base-namespace)])
(add-syntax (expand
(read-syntax
'the-source
(open-input-string
(format "~s"
`(module m racket/base
(define x 4)
x
(let ([y 1]) y)))))))
(done))
add-arrow-called?))
(check-true
(let ()
(define add-arrow-called? #f)
(define annotations
(new (class (annotations-mixin object%)
(super-new)
(define/override (syncheck:find-source-object stx)
(if (eq? 'the-source (syntax-source stx))
'yep
#f))
(define/override (syncheck:add-arrow . args)
(set! add-arrow-called? #t)))))
(define-values (add-syntax done)
(make-traversal (make-base-namespace) #f))
(parameterize ([current-annotations annotations]
[current-namespace (make-base-namespace)])
(add-syntax (expand
(read-syntax
'the-source
(open-input-string
(format "~s"
`(module m racket/base
(define x 4)
x
(let ([y 1]) y)))))))
(done))
add-arrow-called?))