From 596c62d2991f41ae60dccd11faf54158de354a95 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 13 Jul 2005 14:41:26 +0000 Subject: [PATCH] Adding support for cdata and exporting correct-xexpr? svn: r374 --- collects/xml/doc.txt | 14 ++++++++++++++ collects/xml/private/reader.ss | 4 ++-- collects/xml/private/sig.ss | 2 ++ collects/xml/private/structures.ss | 4 ++++ collects/xml/private/syntax.ss | 8 ++++++++ collects/xml/private/writer.ss | 6 ++++++ collects/xml/private/xexpr.ss | 6 ++++-- 7 files changed, 40 insertions(+), 4 deletions(-) diff --git a/collects/xml/doc.txt b/collects/xml/doc.txt index ff15bdb6a8..d3140653e3 100644 --- a/collects/xml/doc.txt +++ b/collects/xml/doc.txt @@ -106,6 +106,13 @@ Functions "something-else" set to what it was really given; and the code set to the part of the non-Xexpr that caused the exception. +> correct-xexpr? : any (-> a) (exn -> a) -> a + If the given thing is an Xexpr, produce an a. Otherwise call the + second function with an exn:invalid-xexpr. This second function + may inspect this structure and decide to return a "correct" value. + This is a method of extending the definition of an Xexpr and is used + by the web-server's Xexpr/callbacks. (See for an example.) + Parameters ========== @@ -182,6 +189,7 @@ Note: Xexpr is the only important one to understand. Even then, | (cons Symbol (listof Xexpr)) ;; an element with no attributes | Symbol ;; symbolic entities such as   | Number ;; numeric entities like  + | Cdata | Misc > Document = (make-document Prolog Element (listof Processing-instruction)) @@ -222,6 +230,12 @@ Note: Xexpr is the only important one to understand. Even then, > Pcdata = (make-pcdata Location Location String) (define-struct (pcdata struct:source) (string)) +> Cdata = (make-cdata Location Location String) + (define-struct (cdata struct:source) (string)) + Note: The string of a cdata structure is assumed to be of the form + "" with proper quoting. If this is an incorrect + assumption, this library will generate invalid XML. + > Entity = (make-entity (U Nat Symbol)) (define-struct entity (text)) diff --git a/collects/xml/private/reader.ss b/collects/xml/private/reader.ss index b5fa170abc..5f76de102d 100644 --- a/collects/xml/private/reader.ss +++ b/collects/xml/private/reader.ss @@ -189,7 +189,7 @@ (lex-error in pos "expected ; at the end of an entity")))])]) (make-entity start (pos) data)))) - ; lex-tag-cdata-pi-comment : Input-port (-> Location) -> Start-tag | Element | End-tag | Pcdata | Pi | Comment + ; lex-tag-cdata-pi-comment : Input-port (-> Location) -> Start-tag | Element | End-tag | Cdata | Pi | Comment ; pre: the first char is a #\< (define (lex-tag-cdata-pi-comment in pos) (let ([start (pos)]) @@ -210,7 +210,7 @@ (unless (string=? (read-string 6 in) "CDATA[") (lex-error in pos "expected CDATA following <[")) (let ([data (lex-cdata-contents in pos)]) - (make-pcdata start (pos) data))] + (make-cdata start (pos) (format "" data)))] [else (skip-dtd in pos) (skip-space in) (unless (eq? (peek-char-or-special in) #\<) diff --git a/collects/xml/private/sig.ss b/collects/xml/private/sig.ss index 2d3a6ae938..88decd4533 100644 --- a/collects/xml/private/sig.ss +++ b/collects/xml/private/sig.ss @@ -16,6 +16,7 @@ (struct pi (target-name instruction)) (struct source (start stop)) (struct pcdata (string)) + (struct cdata (string)) (struct entity (text)) content?)) @@ -40,6 +41,7 @@ xexpr->string xexpr-drop-empty-attributes xexpr? + correct-xexpr? validate-xexpr (struct exn:invalid-xexpr (code)) xexpr-attribute? diff --git a/collects/xml/private/structures.ss b/collects/xml/private/structures.ss index a4cee54a58..6b7704dcf4 100644 --- a/collects/xml/private/structures.ss +++ b/collects/xml/private/structures.ss @@ -59,10 +59,14 @@ ; Pcdata = (make-pcdata Location Location String) (define-struct (pcdata source) (string)) + ; Cdata = (make-cdata Location Location String) + (define-struct (cdata source) (string)) + ; Content = Pcdata ; | Element ; | Entity ; | Misc + ; | Cdata ; Misc = Comment ; | Processing-instruction diff --git a/collects/xml/private/syntax.ss b/collects/xml/private/syntax.ss index 0e950827ab..e34c167bcf 100644 --- a/collects/xml/private/syntax.ss +++ b/collects/xml/private/syntax.ss @@ -55,6 +55,10 @@ (define (make-pcdata from to x) (wrap x from to)) + ; make-cdata : src src str -> cdata + (define (make-cdata from to x) + (wrap x from to)) + ; make-entity : src src (U sym num) -> entity (define (make-entity from to entity) (wrap entity from to)) @@ -98,6 +102,7 @@ (define (entity-text e) (syntax-e e)) (define (pcdata-string x) (syntax-e x)) + (define (cdata-string x) (syntax-e x)) (define (comment-text c) (error 'comment-text "expected a syntax representation of an XML comment, received ~a" c)) @@ -182,6 +187,8 @@ ; : tst -> bool (define (pcdata? x) (and (syntax? x) (string (syntax-e x)))) + (define (cdata? x) + (and (syntax? x) (string (syntax-e x)))) ; : tst -> bool (define (entity? x) @@ -200,6 +207,7 @@ (struct! pi (target-name instruction)) ;(struct! source (start stop)) (struct! pcdata (string)) + (struct! cdata (string)) (struct! entity (text)) ))) diff --git a/collects/xml/private/writer.ss b/collects/xml/private/writer.ss index a5b9c31546..ce8eb2c84f 100644 --- a/collects/xml/private/writer.ss +++ b/collects/xml/private/writer.ss @@ -87,6 +87,7 @@ ((cond [(element? el) write-xml-element] [(pcdata? el) write-xml-pcdata] + [(cdata? el) write-xml-cdata] [(entity? el) write-xml-entity] [(comment? el) write-xml-comment] [(pi? el) write-xml-pi] @@ -130,6 +131,11 @@ ;; write-xml-pcdata : Pcdata Nat (Nat Output-Stream -> Void) Output-Stream -> Void (define (write-xml-pcdata str over dent out) (write-xml-base (escape (pcdata-string str) escape-table) over dent out)) + + ;; write-xml-cdata : Cdata Nat (Nat Output-Stream -> Void) Output-Stream -> Void + (define (write-xml-cdata cdata over dent out) + ;; XXX: Different kind of quote is needed, for assume the user includes the with proper quoting + (write-xml-base (format "~a" (cdata-string cdata)) over dent out)) ;; write-xml-pi : Processing-instruction Nat (Nat Output-Stream -> Void) Output-Stream -> Void (define (write-xml-pi pi over dent out) diff --git a/collects/xml/private/xexpr.ss b/collects/xml/private/xexpr.ss index 0d7eb2e158..8a681da780 100644 --- a/collects/xml/private/xexpr.ss +++ b/collects/xml/private/xexpr.ss @@ -18,6 +18,7 @@ ;; | Nat ;; | Comment ;; | Processing-instruction + ;; | Cdata ;; Attribute-srep ::= (list Symbol String) ;; sorting is no longer necessary, since xt3d uses xml->zxexpr, which sorts. @@ -58,6 +59,7 @@ ((number? x) (true)) ((comment? x) (true)) ((pi? x) (true)) + ((cdata? x) (true)) ((list? x) (or (null? x) (if (symbol? (car x)) @@ -172,7 +174,7 @@ (cons (element-name x) (combine atts body)))] [(pcdata? x) (pcdata-string x)] [(entity? x) (entity-text x)] - [(or (comment? x) (pi? x)) x] + [(or (comment? x) (pi? x) (cdata? x)) x] [(document? x) (error 'xml->xexpr "Expected content, given ~e~nUse document-element to extract the content." x)] [else ;(error 'xml->xexpr "Expected content, given ~e" x) x])))) @@ -208,7 +210,7 @@ [(string? x) (make-pcdata 'scheme 'scheme x)] [(or (symbol? x) (and (integer? x) (>= x 0))) (make-entity 'scheme 'scheme x)] - [(or (comment? x) (pi? x)) x] + [(or (comment? x) (pi? x) (cdata? x)) x] [else ;(error 'xexpr->xml "malformed xexpr ~s" x) x]))