diff --git a/collects/framework/main.ss b/collects/framework/main.ss index 20fbdd3c..f61cf6b7 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 c816d210..7ce14545 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 c46f7a74..e4e608ec 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)