Added text:get-port-name to framework, and used text:lookup-port-name to get at the editor in DrScheme error highlighting.

svn: r10494

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<%>)
+                        [(and (symbol? debug-source)
-                         (get-enclosing-editor-frame 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))])

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
+(provide get-enclosing-editor-frame)
-         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))])))))
 
 ;; 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)])
+        (let ([enclosing-editor-snip (send admin get-snip)])
-        (if (get-snip-outer-editor enclosing-editor-snip)
+          (if (get-snip-outer-editor enclosing-editor-snip)
           (get-enclosing-editor-frame (get-snip-outer-editor
                                        enclosing-editor-snip))
           (topwin)))

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)]

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%))

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<%>

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)