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

fix the algorithm for determining if a > that is typed in an

Browse Source 
XML box ends an opening tag or not
  closes PR 11792
This commit is contained in:
Robby Findler 2011-03-31 17:26:03 -05:00
parent 56ab3eecb6
commit d4e6f99b74
3 changed files with 82 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/stepper/private/find-tag.rkt Normal file
View File

@ -0,0 +1,52 @@
#lang racket/base
(require racket/class
racket/gui/base
racket/contract)
(provide/contract
[find-tag
(-> (is-a?/c text%)
exact-nonnegative-integer?
(or/c #f string?))])
;; finds the name of the XML tag just before `start' in `text'.
;; returns the tag name, with no trailing space of > or anything like that.
(define (find-tag text start)
;; loop iterates backwards, searching for #\<
;; when it finds it, it gets the string starting
;; there, forwards to last-space (if there was a space)
;; or start-1.
;; If there is a #\/ or a #\> just after the #\<, return #f
;; (in that case, they are typing a close tag or closing an empty tag)
;; this technique gleaned from the spec at:
;; http://www.w3.org/TR/2000/REC-xml-20001006
;; If there are two hyphens after the #\<, then assume this is a
;; comment and just give up.
(let loop ([pos (- start 2)]
[last-space #f])
(cond
[(< pos 0) #f]
[else
(let ([char (send text get-character pos)])
(case char
[(#\>) #f]
[(#\/) (if last-space
(loop (- pos 1) last-space)
#f)]
[(#\<)
(cond
[(or (char=? (send text get-character (+ pos 1)) #\/)
(char=? (send text get-character (+ pos 1)) #\>))
;;technique gleaned, as above
#f]
[(and (< (+ pos 3) (send text last-position))
(char=? (send text get-character (+ pos 1)) #\!)
(char=? (send text get-character (+ pos 2)) #\-)
(char=? (send text get-character (+ pos 3)) #\-))
;; comment, just give up
#f]
[else
(send text get-text (+ pos 1) (or last-space (- start 1)))])]
[(#\space #\return #\newline #\tab)
(loop (- pos 1) pos)]
[else (loop (- pos 1) last-space)]))])))

39
collects/stepper/xml-tool.rkt
View File

@ -1,6 +1,7 @@
(module xml-tool mzscheme
(require "private/xml-snip-helpers.ss"
(require "private/xml-snip-helpers.rkt"
"private/find-tag.rkt"
"xml-sig.ss"
mzlib/unit
mzlib/contract
@ -333,40 +334,8 @@
(send text insert ">")
(send text set-position start)))
(send text end-edit-sequence))
;; find-tag : (is-a?/c text%) number? -> (union false? string?)
;; finds the name of the XML tag just before `start' in `text'.
;; returns the tag name, with no trailing space of > or anything like that.
(define (find-tag text start)
;; loop iterates backwards, searching for #\<
;; when it finds it, it gets the string starting
;; there, forwards to last-space (if there was a space)
;; or start-1.
;; If there is a #\/ or a #\> just after the #\<, return #f
;; (in that case, they are typing a close tag or closing an empty tag)
;; this technique gleaned from the spec at:
;; http://www.w3.org/TR/2000/REC-xml-20001006
(let loop ([pos (- start 2)]
[last-space #f])
(cond
[(< pos 0) #f]
[else
(let ([char (send text get-character pos)])
(case char
[(#\>) #f]
[(#\/) (if last-space
(loop (- pos 1) last-space)
#f)]
[(#\<)
(if (or (char=? (send text get-character (+ pos 1)) #\/)
(char=? (send text get-character (+ pos 1)) #\>))
#f
(send text get-text (+ pos 1) (or last-space (- start 1))))]
[(#\space #\return #\newline #\tab)
(loop (- pos 1) pos)]
[else (loop (- pos 1) last-space)]))])))
(define (xml-box-frame-extension super%)
(define (xml-box-frame-extension super%)
(class super%
(inherit get-editor register-capability-menu-item get-insert-menu get-edit-target-object)

26
collects/tests/stepper/find-tag-test.rkt Normal file
View File

@ -0,0 +1,26 @@
#lang racket/base
(require stepper/private/find-tag
racket/gui/base
rackunit
racket/class)
(define (mk-txt str)
(define t (new text%))
(send t insert str)
t)
(define (find-tag/end str)
(find-tag (mk-txt str) (string-length str)))
(check-equal? (find-tag/end "<a>") "a")
(check-equal? (find-tag/end "<abcdef>") "abcdef")
(check-equal? (find-tag/end "<abcdef x=\"3\">") "abcdef")
(check-equal? (find-tag/end "<a></a>") #f)
(check-equal? (find-tag/end "<!-- whatever -->") #f)
(check-equal? (find-tag/end "<!--whatever -->") #f)
(check-equal? (find-tag/end "<!--whatever-->") #f)
(check-equal? (find-tag/end "<!-->") #f)
(check-equal? (find-tag/end "<>") #f)