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