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

Fixed check syntax so it deals with the .rkt and .ss conflation properly

Browse Source
This commit is contained in:
Robby Findler 2010-04-23 14:55:13 -05:00
parent 256e3fedd2
commit 8dc93d9877
1 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/drscheme/syncheck.ss
View File

@ -2276,16 +2276,28 @@ If the namespace does not, they are colored the unbound color.
(parameterize ([current-namespace user-namespace] (parameterize ([current-namespace user-namespace]
[current-directory user-directory] [current-directory user-directory]
[current-load-relative-directory user-directory]) [current-load-relative-directory user-directory])
(let ([ans (with-handlers ([exn:fail? (λ (x) #f)]) (let* ([rkt-path/mod-path
(with-handlers ([exn:fail? (λ (x) #f)])
(cond (cond
[(module-path-index? datum) [(module-path-index? datum)
(resolved-module-path-name (resolved-module-path-name
(module-path-index-resolve datum))] (module-path-index-resolve datum))]
[else [else
(resolved-module-path-name (resolved-module-path-name
((current-module-name-resolver) datum #f #f))]))]) ((current-module-name-resolver) datum #f #f))]))]
(and (path? ans) [rkt-path/f (and (path? rkt-path/mod-path) rkt-path/mod-path)])
ans)))) (let/ec k
(unless (path? rkt-path/f) (k rkt-path/f))
(when (file-exists? rkt-path/f) (k rkt-path/f))
(let* ([bts (path->bytes rkt-path/f)]
[len (bytes-length bts)])
(unless (and (len . >= . 4)
(bytes=? #".rkt" (subbytes bts (- len 4))))
(k rkt-path/f))
(let ([ss-path (bytes->path (bytes-append (subbytes bts 0 (- len 4)) #".ss"))])
(unless (file-exists? ss-path)
(k rkt-path/f))
ss-path))))))
;; make-require-open-menu : path -> menu -> void ;; make-require-open-menu : path -> menu -> void
(define (make-require-open-menu file) (define (make-require-open-menu file)