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

fixed PR 9113

Browse Source 
svn: r8040
This commit is contained in:
Robby Findler 2007-12-17 23:16:23 +00:00
parent dd19a2d1ab
commit 02bd5d4a66
1 changed files with 20 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/drscheme/syncheck.ss
View File

@ -31,6 +31,7 @@ If the namespace does not, they are colored the unbound color.
mred/mred
setup/xref
scribble/xref
scribble/manual-struct
net/url
net/uri-codec
browser/external
@ -2385,23 +2386,25 @@ If the namespace does not, they are colored the unbound color.
(when definition-tag
(let-values ([(path tag) (xref-tag->path+anchor (get-xref) definition-tag)])
(when path
(send defs-text syncheck:add-background-color defs-text "navajowhite" start fin (syntax-e stx))
(send defs-text syncheck:add-menu
defs-text
start
fin
(syntax-e stx)
(λ (menu)
(instantiate menu-item% ()
(parent menu)
(label (format (string-constant cs-view-docs) (syntax-e stx)))
(callback
(λ (x y)
(send-url (format "file://~a~a"
(path->string path)
(if tag
(string-append "#" (uri-encode tag))
""))))))))))))))))))
(let ([index-entry (xref-tag->index-entry (get-xref) definition-tag)])
(when index-entry
(send defs-text syncheck:add-background-color defs-text "navajowhite" start fin (syntax-e stx))
(send defs-text syncheck:add-menu
defs-text
start
fin
(syntax-e stx)
(λ (menu)
(instantiate menu-item% ()
(parent menu)
(label (format (string-constant cs-view-docs) (exported-index-desc-name (entry-desc index-entry))))
(callback
(λ (x y)
(send-url (format "file://~a~a"
(path->string path)
(if tag
(string-append "#" (uri-encode tag))
""))))))))))))))))))))