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

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

Browse Source 
svn: r10494
This commit is contained in:
Danny Yoo 2008-06-28 23:33:39 +00:00
parent dcced09987
commit a506cefeac
6 changed files with 49 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/drscheme/private/debug.ss
View File

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

27
collects/drscheme/private/embedded-snip-utils.ss
View File

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

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

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

7
collects/framework/main.ss
View File

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

3
collects/framework/private/sig.ss
View File

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

27
collects/framework/private/text.ss
View File

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