diff options
author | Andy Wingo <wingo@pobox.com> | 2013-01-30 15:29:18 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-01-30 15:29:18 +0100 |
commit | e10c250928bc6c4116d6344616d39f3c52edc36b (patch) | |
tree | dffa1373ad37416ead9549da2f971185608eec73 /module/sxml | |
parent | 1260fd0b2c4ce1d0d7e7b17df924c245f67f9058 (diff) | |
download | guile-e10c250928bc6c4116d6344616d39f3c52edc36b.tar.gz |
add #:doctype-handler to xml->sxml
* module/sxml/simple.scm (read-internal-doctype-as-string): New helper.
(xml->sxml): Add #:doctype-handler argument.
* doc/ref/sxml.texi (Reading and Writing XML): Document
#:doctype-handler. Fix some other examples, and fix the default value
of #:declare-namespaces?.
* test-suite/tests/sxml.simple.test: Add all tests from the manual
here.
Diffstat (limited to 'module/sxml')
-rw-r--r-- | module/sxml/simple.scm | 56 |
1 files changed, 43 insertions, 13 deletions
diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm index 606975df9..703ad9137 100644 --- a/module/sxml/simple.scm +++ b/module/sxml/simple.scm @@ -26,6 +26,7 @@ ;;; Code: (define-module (sxml simple) + #:use-module (sxml ssax input-parse) #:use-module (sxml ssax) #:use-module (sxml transform) #:use-module (ice-9 match) @@ -35,10 +36,6 @@ ;; Helpers from upstream/SSAX.scm. ;; -(define (ssax:warn port msg . args) - (format (current-ssax-error-port) - ";;; SSAX warning: ~a ~a\n" msg args)) - ; ssax:reverse-collect-str LIST-OF-FRAGS -> LIST-OF-FRAGS ; given the list of fragments (some of which are text strings) ; reverse the list and concatenate adjacent text strings. @@ -65,6 +62,17 @@ (cons (string-concatenate/shared strs) result))) '()))))))) +(define (read-internal-doctype-as-string port) + (string-concatenate/shared + (let loop () + (let ((fragment + (next-token '() '(#\]) "reading internal DOCTYPE" port))) + (if (eqv? #\> (peek-next-char port)) + (begin + (read-char port) + (cons fragment '())) + (cons* fragment "]" (loop))))))) + ;; Ideas for the future for this interface: ;; ;; * Allow doctypes to provide parsed entities @@ -81,7 +89,8 @@ (declare-namespaces? #t) (trim-whitespace? #f) (entities '()) - (default-entity-handler #f)) + (default-entity-handler #f) + (doctype-handler #f)) "Use SSAX to parse an XML document into SXML. Takes one optional argument, @var{string-or-port}, which defaults to the current input port." @@ -96,7 +105,7 @@ port." ;; NAMESPACES: list of (DOC-PREFIX . (USER-PREFIX . URI)). ;; A DOC-PREFIX of #f indicates that it comes from the user. ;; Otherwise, prefixes are symbols. - (define (user-namespaces) + (define (munge-namespaces namespaces) (map (lambda (el) (match el ((prefix . uri-string) @@ -105,6 +114,9 @@ port." (ssax:uri-string->symbol uri-string))))) namespaces)) + (define (user-namespaces) + (munge-namespaces namespaces)) + (define (user-entities) (if (and default-entity-handler (not (assq '*DEFAULT* entities))) @@ -117,6 +129,13 @@ port." (symbol-append prefix (string->symbol ":") local-part)) (_ name))) + (define (doctype-continuation seed) + (lambda* (#:key (entities '()) (namespaces '())) + (values #f + (append entities (user-entities)) + (append (munge-namespaces namespaces) (user-namespaces)) + seed))) + ;; The SEED in this parser is the SXML: initialized to '() at each new ;; level by the fdown handlers; built in reverse by the fhere parsers; ;; and reverse-collected by the fup handlers. @@ -159,18 +178,29 @@ port." ;; ;; SEED builds up the content. (lambda (port docname systemid internal-subset? seed) - (when internal-subset? - (ssax:warn port "Internal DTD subset is not currently handled ") - (ssax:skip-internal-dtd port)) - (ssax:warn port "DOCTYPE DECL " docname " " - systemid " found and skipped") - (values #f (user-entities) (user-namespaces) seed)) + (call-with-values + (lambda () + (cond + (doctype-handler + (doctype-handler docname systemid + (and internal-subset? + (read-internal-doctype-as-string port)))) + (else + (when internal-subset? + (ssax:skip-internal-dtd port)) + (values)))) + (doctype-continuation seed))) UNDECL-ROOT ;; This is like the DOCTYPE handler, but for documents that do not ;; have a <!DOCTYPE!> entry. (lambda (elem-gi seed) - (values #f (user-entities) (user-namespaces) seed)) + (call-with-values + (lambda () + (if doctype-handler + (doctype-handler #f #f #f) + (values))) + (doctype-continuation seed))) PI ((*DEFAULT* |