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

PR 10329

Browse Source 
svn: r15565
This commit is contained in:
Robby Findler 2009-07-25 15:26:07 +00:00
parent 03f91ccbeb
commit b62d5d42d6
1 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/drscheme/syncheck.ss
View File

@ -2044,10 +2044,12 @@ If the namespace does not, they are colored the unbound color.
id
(syntax->datum req-stx))
(when id
(let ([filename (get-require-filename source-req-path user-namespace user-directory)])
(when filename
(add-jump-to-definition
var
source-id
(get-require-filename source-req-path user-namespace user-directory)))
filename))))
(add-mouse-over var
(fw:gui-utils:format-literal-label
(string-constant cs-mouse-over-import)
@ -2185,6 +2187,7 @@ If the namespace does not, they are colored the unbound color.
defs-text
(syntax-position stx)
(syntax-span stx))
(printf "filename ~s\n" filename)
(let* ([pos-left (- (syntax-position stx) 1)]
[pos-right (+ pos-left (syntax-span stx))])
(send defs-text syncheck:add-jump-to-definition
@ -2250,13 +2253,13 @@ If the namespace does not, they are colored the unbound color.
#f
(make-require-open-menu file)))))))))))
;; get-require-filename : sexp-or-module-path-index namespace string[directory] -> filename
;; get-require-filename : sexp-or-module-path-index namespace string[directory] -> filename or #f
;; 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-load-relative-directory user-directory])
(with-handlers ([exn:fail? (λ (x)
(let ([ans (with-handlers ([exn:fail? (λ (x)
(printf "fail ~s\n" (exn-message x))
#f)])
(cond
@ -2264,7 +2267,10 @@ If the namespace does not, they are colored the unbound color.
(resolved-module-path-name
(module-path-index-resolve datum))]
[else
((current-module-name-resolver) datum #f #f)]))))
(resolved-module-path-name
((current-module-name-resolver) datum #f #f))]))])
(and (path? ans)
ans))))
;; make-require-open-menu : path -> menu -> void
(define (make-require-open-menu file)