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

minor cleanup

Browse Source 
svn: r15885
This commit is contained in:
Robby Findler 2009-09-05 10:18:08 +00:00
parent 33680c1b9c
commit 8838409b44
1 changed files with 46 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
collects/drscheme/syncheck.ss
View File

@ -1898,7 +1898,8 @@ If the namespace does not, they are colored the unbound color.
(let ([handle-var-ref (let ([handle-var-ref
(λ (var index binders varsets) (λ (var index binders varsets)
(color-variable var index varsets) (color-variable var index varsets)
(document-variable var index) (when (syntax-original? var)
(document-variable var index))
(connect-identifier var (connect-identifier var
rename-ht rename-ht
binders binders
@ -2152,7 +2153,7 @@ If the namespace does not, they are colored the unbound color.
(and (not a) (and (not a)
(not b)))))))]) (not b)))))))])
(cond (cond
[(module-identifier-mapping-get varsets var (λ () #f)) [(get-ids varsets var (λ () #f))
(color var set!d-variable-style-name)] (color var set!d-variable-style-name)]
[lexical? (color var lexically-bound-variable-style-name)] [lexical? (color var lexically-bound-variable-style-name)]
[(pair? b) (color var imported-variable-style-name)]))) [(pair? b) (color var imported-variable-style-name)])))
@ -2607,51 +2608,50 @@ If the namespace does not, they are colored the unbound color.
; ;
;; document-variable : stx phase-level -> void ;; document-variable : stx[identifier,original] phase-level -> void
(define (document-variable stx phase-level) (define (document-variable stx phase-level)
(when (syntax-original? stx) (let ([defs-text (currently-processing-definitions-text)])
(let ([defs-text (currently-processing-definitions-text)]) (when defs-text
(when defs-text (let ([binding-info (identifier-binding stx phase-level)])
(let ([binding-info (identifier-binding stx phase-level)]) (when (and (pair? binding-info)
(when (and (pair? binding-info) (syntax-position stx)
(syntax-position stx) (syntax-span stx))
(syntax-span stx)) (let* ([start (- (syntax-position stx) 1)]
(let* ([start (- (syntax-position stx) 1)] [fin (+ start (syntax-span stx))]
[fin (+ start (syntax-span stx))] [source-editor (find-source-editor stx)]
[source-editor (find-source-editor stx)] [xref (get-xref)])
[xref (get-xref)]) (when (and xref source-editor)
(when (and xref source-editor) (let ([definition-tag (xref-binding->definition-tag xref binding-info #f)])
(let ([definition-tag (xref-binding->definition-tag xref binding-info #f)]) (when definition-tag
(when definition-tag (let-values ([(path tag) (xref-tag->path+anchor xref definition-tag)])
(let-values ([(path tag) (xref-tag->path+anchor xref definition-tag)]) (when path
(when path (let ([index-entry (xref-tag->index-entry xref definition-tag)])
(let ([index-entry (xref-tag->index-entry xref definition-tag)]) (when index-entry
(when index-entry (send defs-text syncheck:add-background-color
(send defs-text syncheck:add-background-color source-editor "navajowhite" start fin (syntax-e stx))
source-editor "navajowhite" start fin (syntax-e stx)) (send defs-text syncheck:add-menu
(send defs-text syncheck:add-menu source-editor
source-editor start
start fin
fin (syntax-e stx)
(syntax-e stx) (λ (menu)
(λ (menu) (instantiate menu-item% ()
(instantiate menu-item% () (parent menu)
(parent menu) (label (build-docs-label (entry-desc index-entry)))
(label (build-docs-label (entry-desc index-entry))) (callback
(callback (λ (x y)
(λ (x y) (let* ([url (path->url path)]
(let* ([url (path->url path)] [url2 (if tag
[url2 (if tag (make-url (url-scheme url)
(make-url (url-scheme url) (url-user url)
(url-user url) (url-host url)
(url-host url) (url-port url)
(url-port url) (url-path-absolute? url)
(url-path-absolute? url) (url-path url)
(url-path url) (url-query url)
(url-query url) tag)
tag) url)])
url)]) (send-url (url->string url2)))))))))))))))))))))
(send-url (url->string url2))))))))))))))))))))))
(define (build-docs-label desc) (define (build-docs-label desc)
(let ([libs (exported-index-desc-from-libs desc)]) (let ([libs (exported-index-desc-from-libs desc)])