diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss index 19e6b031ae..35bdaec4b4 100644 --- a/collects/drscheme/private/debug.ss +++ b/collects/drscheme/private/debug.ss @@ -763,8 +763,11 @@ profile todo: srclocs)] [frame (cond [(path? debug-source) (handler:edit-file debug-source)] - [(is-a? debug-source editor<%>) - (get-enclosing-editor-frame debug-source)] + [(and (symbol? debug-source) + (text:lookup-port-name debug-source)) + => + (lambda (editor) + (get-enclosing-editor-frame editor))] [else #f])] [editor (cond [(path? debug-source) @@ -774,7 +777,10 @@ profile todo: [(and frame (is-a? frame frame:editor<%>)) (send frame get-editor)] [else #f])] - [(is-a? debug-source editor<%>) debug-source] + [(and (symbol? debug-source) + (text:lookup-port-name debug-source)) + => + values] [else #f])] [rep (and (is-a? frame drscheme:unit:frame%) (send frame get-interactions-text))]) diff --git a/collects/drscheme/private/embedded-snip-utils.ss b/collects/drscheme/private/embedded-snip-utils.ss index 657b7beeb7..9e96e233be 100644 --- a/collects/drscheme/private/embedded-snip-utils.ss +++ b/collects/drscheme/private/embedded-snip-utils.ss @@ -1,29 +1,8 @@ #lang scheme/base (require scheme/class - framework scheme/gui/base) -(provide find-syntax-source-editor - get-enclosing-editor-frame) - -;; find-syntax-source-editor: syntax-source text% -> (or/c editor #f) -;; Looks for an embedded snip editor whose source is the a-stx-source. -;; -;; [dyoo] Note: this is a copy-and-paste from syncheck. -;; I've ripping out the editor caches for now, -;; until I get comments from others about this. -(define (find-syntax-source-editor a-stx-source defs-text) - (let txt-loop ([text defs-text]) - (if (and (is-a? text text:basic<%>) - (or (send text port-name-matches? a-stx-source) - (eq? text a-stx-source))) - text - (let snip-loop ([snip (send text find-first-snip)]) - (cond [(not snip) #f] - [(and (is-a? snip editor-snip%) (send snip get-editor)) - (or (txt-loop (send snip get-editor)) - (snip-loop (send snip next)))] - [else (snip-loop (send snip next))]))))) +(provide get-enclosing-editor-frame) ;; get-enclosing-editor-frame: editor<%> -> (or/c frame% #f) ;; Returns the enclosing frame of an-editor, or #f if we can't find it. @@ -33,8 +12,8 @@ (and canvas (send canvas get-top-level-window)))) (let ([admin (send an-editor get-admin)]) (if (and admin (is-a? admin editor-snip-editor-admin<%>)) - (let ([enclosing-editor-snip (send admin get-snip)]) - (if (get-snip-outer-editor enclosing-editor-snip) + (let ([enclosing-editor-snip (send admin get-snip)]) + (if (get-snip-outer-editor enclosing-editor-snip) (get-enclosing-editor-frame (get-snip-outer-editor enclosing-editor-snip)) (topwin))) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index f15bdace0d..2006a33c4d 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -26,7 +26,6 @@ TODO scheme/unit scheme/list "drsig.ss" - "embedded-snip-utils.ss" string-constants setup/xref scheme/gui/base @@ -35,7 +34,6 @@ TODO (provide rep@ with-stacktrace-name) -(define-struct unsaved-editor (editor)) (define stacktrace-runtime-name (string->uninterned-symbol "this-is-the-funny-name")) @@ -708,7 +706,8 @@ TODO (srcloc-column srcloc) (srcloc-position srcloc) (srcloc-span srcloc))] - [(find-syntax-source-editor (srcloc-source srcloc) definitions-text) + [(and (symbol? (srcloc-source srcloc)) + (text:lookup-port-name (srcloc-source srcloc))) => (lambda (editor) (make-srcloc editor @@ -716,12 +715,6 @@ TODO (srcloc-column srcloc) (srcloc-position srcloc) (srcloc-span srcloc)))] - [(unsaved-editor? (srcloc-source srcloc)) - (make-srcloc (unsaved-editor-editor (srcloc-source srcloc)) - (srcloc-line srcloc) - (srcloc-column srcloc) - (srcloc-position srcloc) - (srcloc-span srcloc))] [else srcloc])) locs)))] [locs (cleanup-locs raw-locs)] diff --git a/collects/framework/main.ss b/collects/framework/main.ss index 20fbdd3cb7..f61cf6b7e9 100644 --- a/collects/framework/main.ss +++ b/collects/framework/main.ss @@ -85,6 +85,13 @@ symbols are meant to be module paths. If @scheme[manuals] is false, then all of the documented names are used.}) + (proc-doc/names + text:lookup-port-name + (-> symbol? (or/c (is-a?/c editor:basic<%>) false/c)) + (manuals) + @{Returns the editor instance whose port-name matches the given symbol. If no + editor can be found, then returns @scheme[false].}) + (proc-doc/names number-snip:make-repeating-decimal-snip (number? boolean? . -> . (is-a?/c snip%)) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index c816d2100f..7ce14545a4 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -207,7 +207,8 @@ (define-signature text^ extends text-class^ (autocomplete-append-after autocomplete-limit - get-completions/manuals)) + get-completions/manuals + lookup-port-name)) (define-signature canvas-class^ (basic<%> diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index c46f7a7449..e4e608ecf7 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -49,6 +49,30 @@ WARNING: printf is rebound in the body of the unit to always (define-struct range (start end b/w-bitmap color caret-space?)) (define-struct rectangle (left top right bottom b/w-bitmap color)) + +(define-values (register-port-name! lookup-port-name) + ;; port-name->editor-ht: (hashof symbol (weakboxof editor:basic<%>)) + ;; Maintains a mapping from port names back to their respective editors. + (let ([port-name->editor-ht (make-weak-hasheq)]) + + ;; register-port-name-to-editor!: symbol editor<%> -> void + ;; Registers the editor's port name. + (define (register-port-name! a-port-name an-editor) + (hash-set! port-name->editor-ht a-port-name (make-weak-box an-editor))) + + ;; lookup-port-name: symbol -> (or/c editor:basic<%> #f) + ;; Given a port name, tries to get the editor with that name. + (define (lookup-port-name a-port-name) + (let ([a-weak-box (hash-ref port-name->editor-ht a-port-name #f)]) + (cond + [(not a-weak-box) + #f] + [else + (weak-box-value a-weak-box)]))) + + (values register-port-name! lookup-port-name))) + + ;; wx: `default-wrapping?', add as the initial value for auto-wrap bitmap, ;; unless matthew makes it primitive @@ -82,7 +106,8 @@ WARNING: printf is rebound in the body of the unit to always (cond [(or (unbox b) (not n)) (unless port-name-identifier - (set! port-name-identifier (gensym 'unsaved-editor))) + (set! port-name-identifier (gensym 'unsaved-editor)) + (register-port-name! port-name-identifier this)) port-name-identifier] [else n]))) (define/public (port-name-matches? id)