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

fixed PR 9062

Browse Source 
svn: r7723
This commit is contained in:
Robby Findler 2007-11-14 13:31:37 +00:00
parent bfe7279853
commit c46aacc0a3
3 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/drscheme/private/eval.ss
View File

@ -19,15 +19,18 @@
(import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
[prefix drscheme:rep: drscheme:rep^] [prefix drscheme:rep: drscheme:rep^]
[prefix drscheme:init: drscheme:init^] [prefix drscheme:init: drscheme:init^]
[prefix drscheme:language: drscheme:language^]) [prefix drscheme:language: drscheme:language^]
[prefix drscheme:unit: drscheme:unit^])
(export drscheme:eval^) (export drscheme:eval^)
(define (editor->port-name txt) (define (editor->port-name txt)
(let* ([b (box #f)] (let* ([b (box #f)]
[n (send txt get-filename b)]) [n (send txt get-filename b)])
(cond (cond
[(or (unbox b) (not n)) [(or (unbox b) (not n))
'unknown] (if (is-a? txt drscheme:unit:definitions-text<%>)
(send txt get-port-name-identifier)
'unknown)]
[else n]))) [else n])))
(define (traverse-program/multiple language-settings (define (traverse-program/multiple language-settings

3
collects/drscheme/private/rep.ss
View File

@ -756,8 +756,7 @@ TODO
(number? (srcloc-position loc)) (number? (srcloc-position loc))
(number? (srcloc-span loc)))) (number? (srcloc-span loc))))
(map (λ (srcloc) (map (λ (srcloc)
(if (equal? (normal-case-path (normalize-path (send definitions-text get-filename))) (if (send definitions-text port-name-matches? (srcloc-source srcloc))
(normal-case-path (normalize-path (srcloc-source srcloc))))
(make-srcloc definitions-text (make-srcloc definitions-text
(srcloc-line srcloc) (srcloc-line srcloc)
(srcloc-column srcloc) (srcloc-column srcloc)

18
collects/drscheme/private/unit.ss
View File

@ -92,7 +92,9 @@ module browser threading seems wrong.
get-tab get-tab
get-next-settings get-next-settings
after-set-next-settings after-set-next-settings
set-needs-execution-message)) set-needs-execution-message
get-port-name-identifier
port-name-matches?))
(define-struct teachpack-callbacks (define-struct teachpack-callbacks
(get-names ;; settings -> (listof string) (get-names ;; settings -> (listof string)
@ -403,6 +405,20 @@ module browser threading seems wrong.
(define/public (get-tab) tab) (define/public (get-tab) tab)
(define/public (set-tab t) (set! tab t)) (define/public (set-tab t) (set! tab t))
(define port-name-identifier #f)
(define/public (get-port-name-identifier)
(unless port-name-identifier
(set! port-name-identifier (gensym 'unsaved-editor)))
port-name-identifier)
(define/public (port-name-matches? id)
(let ([filename (get-filename)])
(or (and (path? id)
(path? filename)
(equal? (normal-case-path (normalize-path (get-filename)))
(normal-case-path (normalize-path id))))
(and (symbol? port-name-identifier)
(equal? port-name-identifier id)))))
(inherit get-surrogate set-surrogate) (inherit get-surrogate set-surrogate)
(define/public (set-current-mode mode) (define/public (set-current-mode mode)
(let ([surrogate (drscheme:modes:mode-surrogate mode)]) (let ([surrogate (drscheme:modes:mode-surrogate mode)])