diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss index e39eb46a39..19e6b031ae 100644 --- a/collects/drscheme/private/debug.ss +++ b/collects/drscheme/private/debug.ss @@ -16,7 +16,7 @@ profile todo: scheme/gui/base string-constants framework/private/bday - "find-syntax-source-editor.ss" + "embedded-snip-utils.ss" "drsig.ss" "bindings-browser.ss" (for-syntax scheme/base)) @@ -787,20 +787,7 @@ profile todo: - ;; get-enclosing-editor-frame: editor<%> -> (or/c frame% #f) - ;; Returns the enclosing frame of an-editor, or #f if we can't find it. - (define (get-enclosing-editor-frame an-editor) - (let ([admin (send an-editor get-admin)]) - (cond - [(and admin (is-a? admin editor-snip-editor-admin<%>)) - (let* ([enclosing-editor-snip (send admin get-snip)] - [editor-snip-admin (send enclosing-editor-snip get-admin)] - [enclosing-editor (send editor-snip-admin get-editor)]) - (get-enclosing-editor-frame enclosing-editor))] - [else - (let ([canvas (send an-editor get-canvas)]) - (and canvas - (send canvas get-top-level-window)))]))) + diff --git a/collects/drscheme/private/embedded-snip-utils.ss b/collects/drscheme/private/embedded-snip-utils.ss new file mode 100644 index 0000000000..22ad98e957 --- /dev/null +++ b/collects/drscheme/private/embedded-snip-utils.ss @@ -0,0 +1,66 @@ +#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. +;; +;; 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]) + (cond + [(and (is-a? text text:basic<%>) + (send text port-name-matches? a-stx-source)) + text] + [else + (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. +(define (get-enclosing-editor-frame an-editor) + (let ([admin (send an-editor get-admin)]) + (cond + [(and admin (is-a? admin editor-snip-editor-admin<%>)) + (let* ([enclosing-editor-snip (send admin get-snip)]) + (cond + [(get-snip-outer-editor enclosing-editor-snip) + (get-enclosing-editor-frame (get-snip-outer-editor enclosing-editor-snip))] + [else + (let ([canvas (send an-editor get-canvas)]) + (and canvas + (send canvas get-top-level-window)))]))] + [else + (let ([canvas (send an-editor get-canvas)]) + (and canvas + (send canvas get-top-level-window)))]))) + + + +;; get-snip-outer-editor: snip% -> (or/c editor<%> #f) +;; Returns the immediate outer editor enclosing the snip, or false if we +;; can't find it. +(define (get-snip-outer-editor a-snip) + (cond + [(send a-snip get-admin) + (let* ([snip-admin (send a-snip get-admin)] + [enclosing-editor (send snip-admin get-editor)]) + enclosing-editor)] + [else + #f])) \ No newline at end of file diff --git a/collects/drscheme/private/find-syntax-source-editor.ss b/collects/drscheme/private/find-syntax-source-editor.ss deleted file mode 100644 index a2fc378c3c..0000000000 --- a/collects/drscheme/private/find-syntax-source-editor.ss +++ /dev/null @@ -1,30 +0,0 @@ -#lang scheme/base -(require scheme/class - framework - scheme/gui/base) - -(provide find-syntax-source-editor) - -;; find-syntax-source-editor: syntax-source text% -> (or/c editor #f) -;; Looks for an embedded snip editor whose source is the a-stx-source. -;; -;; 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]) - (cond - [(and (is-a? text text:basic<%>) - (send text port-name-matches? a-stx-source)) - text] - [else - (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))]))]))) \ No newline at end of file diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 1f95c4be4f..ecf61adbb7 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -26,7 +26,7 @@ TODO scheme/unit scheme/list "drsig.ss" - "find-syntax-source-editor.ss" + "embedded-snip-utils.ss" string-constants setup/xref scheme/gui/base