From 4535aa45373d3edadc9449982ae81ce0cbc8c67a Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 17 Jul 2008 00:52:47 +0000 Subject: [PATCH] Simplifying scheme box location-finding code. svn: r10803 --- collects/stepper/private/xml-snip-helpers.ss | 31 +++++--------------- collects/stepper/xml-tool.ss | 8 ++--- 2 files changed, 11 insertions(+), 28 deletions(-) diff --git a/collects/stepper/private/xml-snip-helpers.ss b/collects/stepper/private/xml-snip-helpers.ss index e48a284b21..dbf2c0a18e 100644 --- a/collects/stepper/private/xml-snip-helpers.ss +++ b/collects/stepper/private/xml-snip-helpers.ss @@ -12,16 +12,15 @@ scheme-read-special scheme-snip<%>) - (define (scheme-read-special snip file line col pos) + (define (scheme-read-special snip source line col pos) (let ([text (send snip get-editor)] [splice? (send snip get-splice?)]) (when (= 0 (send text last-position)) - (let-values ([(txt line col pos) (find-position-in-outer snip)]) - (raise-read-error + (raise-read-error (if splice? "read: bad syntax: empty scheme splice box" "read: bad syntax: empty scheme box") - (get-source-name txt) line col pos 1))) + source line col pos 1)) (let* ([source-name (get-source-name text)] [stx (read-syntax source-name (open-input-text-editor text 0 'end values source-name))]) @@ -40,13 +39,12 @@ [else (send text get-filename)])) - (define (xml-read-special eliminate-whitespace-in-empty-tags? snip file line col pos) + (define (xml-read-special eliminate-whitespace-in-empty-tags? snip source line col pos) (let ([editor (send snip get-editor)] [old-locked #f]) (when (= 0 (send editor last-position)) - (let-values ([(txt line col pos) (find-position-in-outer snip)]) - (raise-read-error "read: bad syntax: empty xml box" - (get-source-name txt) line col pos 1))) + (raise-read-error "read: bad syntax: empty xml box" + source line col pos 1)) (dynamic-wind (lambda () (set! old-locked (send editor is-locked?)) @@ -157,19 +155,4 @@ ;; deteremines if a snip can be expanded here (define (transformable? snip) (or (is-a? snip xml-snip<%>) - (is-a? snip scheme-snip<%>))) - - ;; find-in-position-in-outer : - ;; editor-snip -> (values (union #f text%) (union #f number) (union #f number) (union #f number)) - (define (find-position-in-outer editor-snip) - (let/ec k - (let ([fail (lambda () (k #f #f #f #f))]) - (let ([admin (send editor-snip get-admin)]) - (unless admin (fail)) - (let ([outer-editor (send admin get-editor)]) - (unless (is-a? outer-editor text%) (fail)) - (let ([pos (send outer-editor get-snip-position editor-snip)]) - (unless pos (fail)) - (let* ([line (send outer-editor position-paragraph pos)] - [line-start (send outer-editor paragraph-start-position line)]) - (values outer-editor (+ line 1) (+ (- pos line-start) 1) (+ pos 1)))))))))) + (is-a? snip scheme-snip<%>)))) diff --git a/collects/stepper/xml-tool.ss b/collects/stepper/xml-tool.ss index f3fc2e80bc..f67db50bc8 100644 --- a/collects/stepper/xml-tool.ss +++ b/collects/stepper/xml-tool.ss @@ -79,10 +79,10 @@ (when admin (send admin resized this #t))))) - (define/public (read-special file line col pos) + (define/public (read-special source line col pos) (xml-read-special eliminate-whitespace-in-empty-tags? this - file + source line col pos)) @@ -169,8 +169,8 @@ (inherit get-editor) - (define/public (read-special file line col pos) - (scheme-read-special this file line col pos)) + (define/public (read-special source line col pos) + (scheme-read-special this source line col pos)) (define/override (make-editor) (new (get-scheme-box-text%)))