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

Simplifying scheme box location-finding code.

Browse Source 
svn: r10803
This commit is contained in:
Danny Yoo 2008-07-17 00:52:47 +00:00
parent 2260741a64
commit 4535aa4537
2 changed files with 11 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/stepper/private/xml-snip-helpers.ss
View File

@ -12,16 +12,15 @@
scheme-read-special scheme-read-special
scheme-snip<%>) 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)] (let ([text (send snip get-editor)]
[splice? (send snip get-splice?)]) [splice? (send snip get-splice?)])
(when (= 0 (send text last-position)) (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? (if splice?
"read: bad syntax: empty scheme splice box" "read: bad syntax: empty scheme splice box"
"read: bad syntax: empty scheme 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)] (let* ([source-name (get-source-name text)]
[stx (read-syntax source-name [stx (read-syntax source-name
(open-input-text-editor text 0 'end values source-name))]) (open-input-text-editor text 0 'end values source-name))])
@ -40,13 +39,12 @@
[else [else
(send text get-filename)])) (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)] (let ([editor (send snip get-editor)]
[old-locked #f]) [old-locked #f])
(when (= 0 (send editor last-position)) (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" (raise-read-error "read: bad syntax: empty xml box"
(get-source-name txt) line col pos 1))) source line col pos 1))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
(set! old-locked (send editor is-locked?)) (set! old-locked (send editor is-locked?))
@ -157,19 +155,4 @@
;; deteremines if a snip can be expanded here ;; deteremines if a snip can be expanded here
(define (transformable? snip) (define (transformable? snip)
(or (is-a? snip xml-snip<%>) (or (is-a? snip xml-snip<%>)
(is-a? snip scheme-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))))))))))

8
collects/stepper/xml-tool.ss
View File

@ -79,10 +79,10 @@
(when admin (when admin
(send admin resized this #t))))) (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? (xml-read-special eliminate-whitespace-in-empty-tags?
this this
file source
line line
col col
pos)) pos))
@ -169,8 +169,8 @@
(inherit get-editor) (inherit get-editor)
(define/public (read-special file line col pos) (define/public (read-special source line col pos)
(scheme-read-special this file line col pos)) (scheme-read-special this source line col pos))
(define/override (make-editor) (new (get-scheme-box-text%))) (define/override (make-editor) (new (get-scheme-box-text%)))