Changeset 29642 in project


Ignore:
Timestamp:
08/25/13 10:05:07 (7 years ago)
Author:
Jim Ursetto
Message:

sxml-serializer 0.4: allow *default* pseudo-namespace in source doc; bugfixes

Location:
release/4/sxml-serializer/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/sxml-serializer/trunk/sxml-serializer.scm

    r29639 r29642  
    8989  (let ((omit-xml-declaration #t)       ;; Force omission of xml-declaration
    9090        (standalone 'omit)
    91         (version "1.0"))
     91        (version "1.0")
     92        ;; Don't prefix "" URIs.  Could go in conventional-ns-prefixes instead,
     93        ;; but overriding ns-prefixes would kill that behavior.
     94        (ns-prefixes (append ns-prefixes '((*default* . ""))))
     95        )
    9296    (parameterize ((allow-prefix-redeclarations? allow-prefix-redeclarations)) ; redundant?
    9397      (if output
     
    261265        (n-parts (srl:split-name name)))
    262266    (cond
    263       ((not (car n-parts))  ; no namespace-id => no namespace
    264        (if attribute?
    265            (values #f #f (cdr n-parts)  ; name as a string
    266                    #f)
    267            (values "*default*" "" (cdr n-parts)  ; name as a string
    268                    ;; declaration of empty namespace required if default currently non-empty
    269                    (let ((def (assoc "*default*" declared-ns-prefixes)))
    270                      (and def (not (string=? "" (cdr def))))))))
    271       ((string-ci=? (car n-parts) "xml")  ; reserved XML namespace
     267      ((and attribute?
     268            (not (car n-parts)))         ; no namespace-id => no namespace
     269       (values #f #f (cdr n-parts)       ; name as a string
     270               #f))
     271      ((and (car n-parts)
     272            (string-ci=? (car n-parts) "xml")) ; reserved XML namespace
    272273       (values (car n-parts) "http://www.w3.org/XML/1998/namespace"
    273274               (cdr n-parts) #f))
     
    275276       (call-with-values
    276277        (lambda ()
    277           (cond
    278             ((assq (string->symbol (car n-parts))  ; suppose a namespace-id
    279                    namespace-assoc)
    280              => (lambda (lst)
    281                   (values (cadr lst) (car n-parts))))
    282             (else  ; first part of a name is a namespace URI
    283              (values (car n-parts) #f))))
     278          (let ((nid (or (car n-parts) "*default*")))
     279            (cond
     280             ((assq (string->symbol nid) ; suppose a namespace-id
     281                    namespace-assoc)
     282              => (lambda (lst)
     283                   (values (cadr lst) nid)))
     284             (else           ; first part of a name is a namespace URI
     285              (values (or (car n-parts) "") #f)))))
    284286        (lambda (namespace-uri ns-id)
    285287          (cond
     
    303305                            candidate))))
    304306                (else
    305                  (use-ns-id-or-generate-prefix ns-id)))
     307                 (if (and ns-id (allow-prefix-redeclarations?))
     308                     ns-id
     309                     (use-ns-id-or-generate-prefix ns-id))))
    306310              namespace-uri
    307311              (cdr n-parts)
     
    538542                  end-tag)))))))))))))
    539543
     544;; Changes: Declare the empty ("") namespace URI upfront so we do
     545;;          not get a spurious xmlns="" on the first unprefixed elt.
     546;; WARNING: *default* must be added to ns-prefixes, but this is done
     547;;          only in serialize-sxml and theoretically there are other
     548;;          entry points to this procedure (though not in practice,
     549;;          as the module hides them).
     550;;   Therefore, srl:top->nested-str-lst and srl:display-top-out
     551;;   should probably take a declared-ns-prefixes argument so that
     552;;   *default* is only automatically declared when it's
     553;;   already in ns-prefixes.
     554(define (srl:top->nested-str-lst doc
     555                                 cdata-section-elements indent
     556                                 method ns-prefix-assig
     557                                 omit-xml-declaration? standalone version)
     558  (let* ((namespace-assoc (srl:ns-assoc-for-top doc))
     559         (declared-ns-prefixes '(("*default*" . "")))        ;; [+]
     560         (ns-prefix-assig
     561          (append
     562           (srl:extract-original-prefix-binding namespace-assoc)
     563           ns-prefix-assig))
     564         (serialized-content
     565          (map
     566           (if
     567            indent  ; => output each member from the newline
     568            (let ((indentation (list indent)))  ; for nested elements
     569              (lambda (kid)
     570                (list
     571                 srl:newline
     572                 (srl:node->nested-str-lst-recursive
     573                  kid method
     574                  ns-prefix-assig namespace-assoc declared-ns-prefixes
     575                  indentation #f
     576                  cdata-section-elements srl:string->char-data))))
     577            (lambda (kid)
     578              (srl:node->nested-str-lst-recursive
     579               kid method
     580               ns-prefix-assig namespace-assoc declared-ns-prefixes
     581               indent #f
     582               cdata-section-elements srl:string->char-data)))
     583           ((srl:select-kids  ; document node content
     584             (lambda (node)  ; TODO: support SXML entities
     585               (not (and
     586                     (pair? node) (memq (car node) '(@ @@ *ENTITY*))))))
     587            doc))))
     588    (if (or (eq? method 'html) omit-xml-declaration?)
     589        (if (and indent (not (null? serialized-content)))
     590            ; Remove the starting newline
     591            ; ATTENTION: beware of `Gambit cadar bug':
     592            ; http://mailman.iro.umontreal.ca/pipermail/gambit-list/
     593            ;   2005-July/000315.html
     594            (cons (cadar serialized-content) (cdr serialized-content))
     595            serialized-content)
     596        (list (srl:make-xml-decl version standalone) serialized-content))))
     597
     598(define (srl:display-top-out doc port
     599                             cdata-section-elements indent
     600                             method ns-prefix-assig
     601                             omit-xml-declaration? standalone version) 
     602  (let ((no-xml-decl?  ; no XML declaration was displayed?
     603         (if (not (or (eq? method 'html) omit-xml-declaration?))
     604             (begin
     605               (for-each  ; display xml declaration
     606                (lambda (x) (display x port))
     607                (srl:make-xml-decl version standalone))
     608               #f)
     609             #t))
     610        (content  ; document node content
     611         ((srl:select-kids
     612           (lambda (node)  ; TODO: support SXML entities
     613             (not (and
     614                   (pair? node) (memq (car node) '(@ @@ *ENTITY*))))))
     615          doc))
     616        (namespace-assoc (srl:ns-assoc-for-top doc))
     617        (declared-ns-prefixes '(("*default*" . ""))))      ; [+]
     618    (let ((ns-prefix-assig
     619           (append
     620            (srl:extract-original-prefix-binding namespace-assoc)
     621            ns-prefix-assig)))
     622      (cond
     623        ((null? content)  ; generally a rare practical situation
     624         #t)  ; nothing more to do
     625        ((and indent no-xml-decl?)
     626         ; We'll not display newline before (car content)
     627         (let ((indentation (list indent)))  ; for nested elements
     628           (for-each
     629            (lambda (kid put-newline?)
     630              (begin
     631                (if put-newline?
     632                    (display srl:newline port))
     633                (srl:display-node-out-recursive
     634                 kid port method
     635                 ns-prefix-assig namespace-assoc declared-ns-prefixes
     636                 indentation #f
     637                 cdata-section-elements srl:string->char-data)))
     638            content
     639            ; After sequence normalization, content does not contain #f
     640            (cons #f (cdr content)))))
     641        (else
     642         (for-each
     643          (if
     644           indent  ; => output each member from the newline
     645           (let ((indentation (list indent)))  ; for nested elements
     646             (lambda (kid)
     647               (begin
     648                 (display srl:newline port)
     649                 (srl:display-node-out-recursive
     650                  kid port method
     651                  ns-prefix-assig namespace-assoc declared-ns-prefixes
     652                  indentation #f
     653                  cdata-section-elements srl:string->char-data))))
     654           (lambda (kid)
     655             (srl:display-node-out-recursive
     656              kid port method
     657              ns-prefix-assig namespace-assoc declared-ns-prefixes
     658              indent #f
     659              cdata-section-elements srl:string->char-data)))
     660          content))))))
     661
    540662;; Changes: accept nulls, chars, and symbols as SXML nodes.  For some
    541663;; reason numbers and bools were already accepted, which makes me think
  • release/4/sxml-serializer/trunk/sxml-serializer.setup

    r29639 r29642  
    44(install-extension 'sxml-serializer
    55  `("sxml-serializer.so" "sxml-serializer.import.so")
    6   `((version 0.3)   ;; CVS version 1.7 Fri Nov 7 08:36:28 2008 UTC
     6  `((version 0.4)   ;; CVS version 1.7 Fri Nov 7 08:36:28 2008 UTC
    77    ))
Note: See TracChangeset for help on using the changeset viewer.