ttml11/spec/scm/adi.scm
changeset 240 d1300a76da8f
equal deleted inserted replaced
239:9bbcbd072f4f 240:d1300a76da8f
       
     1 ;;; -*-Scheme-*-
       
     2 ;;; Package: (dfxp rxi adi)
       
     3 
       
     4 ;
       
     5 ; DFXP Abstrarct Document Instance Load, Save, Transformer
       
     6 ;
       
     7 
       
     8 (declare (usual-integrations))
       
     9 
       
    10 (define *dfxp-preferred-reverse-bindings*
       
    11   '(("http://www.w3.org/ns/ttml" . "")
       
    12     ("http://www.w3.org/ns/ttml#parameter" . "ttp")
       
    13     ("http://www.w3.org/ns/ttml#style" . "tts")
       
    14     ("http://www.w3.org/ns/ttml#style-extension" . "ttsx")
       
    15     ("http://www.w3.org/ns/ttml#metadata" . "ttm")
       
    16     ("http://www.w3.org/ns/ttml#metadata-extension" . "ttmx")))
       
    17 
       
    18 (define *dfxp-namespaces-table*
       
    19   (let ((t (make-string-hash-table)))
       
    20     (for-each
       
    21       (lambda (b)
       
    22         (hash-table/put! t (car b) #t))
       
    23       *dfxp-preferred-reverse-bindings*)
       
    24     t))
       
    25 
       
    26 (define *dfxp-empty-element-types*
       
    27   '(("br" . "http://www.w3.org/ns/ttml")
       
    28     ("metadata" . "http://www.w3.org/ns/ttml")))
       
    29 
       
    30 (define (in-per-element-namespace? attr)
       
    31   (let* ((name (rxi-attribute/name attr))
       
    32          (namespace (rxi-name/namespace name)))
       
    33     (null? namespace)))
       
    34 
       
    35 (define (in-dfxp-namespace? name)
       
    36   (hash-table/get *dfxp-namespaces-table* (rxi-name/namespace name) #f))
       
    37 
       
    38 (define (in-xml-namespace? name)
       
    39   (string=? (rxi-name/namespace name) (car *xml-default-reverse-binding*)))
       
    40 
       
    41 (define (in-dfxp-or-xml-namespace? name)
       
    42   (or (in-dfxp-namespace? name)
       
    43       (in-xml-namespace? name)))
       
    44 
       
    45 (define (empty-dfxp-element-type? elt)
       
    46   (let* ((name (rxi-element/name elt))
       
    47          (local (rxi-name/local name))
       
    48          (namespace (rxi-name/namespace name)))
       
    49     (find-matching-item
       
    50       *dfxp-empty-element-types*
       
    51       (lambda (n)
       
    52         (and (string=? local (car n))
       
    53              (string=? namespace (cdr n)))))))
       
    54                         
       
    55 (define (only-whitespace-children? elt)
       
    56   (let ((children (rxi-element/children elt)))
       
    57     (not
       
    58       (find-matching-item
       
    59         children
       
    60         (lambda (c)
       
    61           (or (not (string? c))
       
    62               (string-find-next-char-in-set c char-set:not-whitespace)))))))
       
    63 
       
    64 (define (rxi-document/adi-transform-element elt)
       
    65   ;; prune and transform children
       
    66   (set-rxi-element/children!
       
    67     elt
       
    68     (delete-matching-items
       
    69       (map
       
    70         (lambda (c)
       
    71           (if (string? c)
       
    72               c
       
    73               (if (not (in-dfxp-namespace? (rxi-element/name c)))
       
    74                   '()
       
    75                   (rxi-document/adi-transform-element c))))
       
    76         (rxi-element/children elt))
       
    77       null?))
       
    78   ;; prune remaining children if empty element type and only whitespace remains
       
    79   (if (and (empty-dfxp-element-type? elt)
       
    80            (only-whitespace-children? elt))
       
    81       (set-rxi-element/children! elt '()))
       
    82   ;; prune foreign namespace attributes
       
    83   (set-rxi-element/attributes!
       
    84     elt
       
    85     (delete-matching-items
       
    86       (rxi-element/attributes elt)
       
    87       (lambda (a)
       
    88           (not (or (in-per-element-namespace? a)
       
    89                    (in-dfxp-or-xml-namespace? (rxi-attribute/name a)))))))
       
    90   elt)
       
    91 
       
    92 (define (rxi-document/adi-transform document)
       
    93   (if (not (null? (rxi-document/annotation document 'adi-transform)))
       
    94       (warn "Document already transformed, ignoring re-transform.")
       
    95       (let ((root (rxi-document/root document)))
       
    96         (set-rxi-document/root! document (rxi-document/adi-transform-element root))
       
    97         (set-rxi-document/annotation! document 'adi-transform #t)))
       
    98   document)
       
    99   
       
   100 ;
       
   101 ; Load TT AF document instance from PATHNAME using RXI loader,
       
   102 ; then transform resulting RXI-DOCUMENT instance to an ADI-DOCUMENT
       
   103 ; instance.
       
   104 ;
       
   105 (define (adi-document/load pathname)
       
   106   (rxi-document/adi-transform
       
   107     (rxi-document/load pathname)))
       
   108 
       
   109 ;
       
   110 ; Save ADI-DOCUMENT instance DOCUMENT, which was created by ADI-DOCUMENT/LOAD,
       
   111 ; to PATHNAME using underlying RXI-DOCUMENT's document serializer,
       
   112 ; where optional argument OTHER-REVERSE-BINDINGS, if specified, consists
       
   113 ; of an association list whose keys are namespace URIs and values are the
       
   114 ; namespace prefixes to use to designate those namespaces.
       
   115 ;
       
   116 ; By default the set of refeverse bindings defined by *DFXP-PREFERRED-REVERSE-BINDING*
       
   117 ; are used when serializaing. However, reverse bindings specified by using
       
   118 ; OTHER-REVERSE-BINDINGS take precedence, overriding default reverse bindings.
       
   119 ;
       
   120 (define (adi-document/save document pathname #!optional other-reverse-bindings)
       
   121   (rxi-document/save document pathname
       
   122     (if (default-object? other-reverse-bindings)
       
   123         *dfxp-preferred-reverse-bindings*
       
   124         (append other-reverse-bindings *dfxp-preferred-reverse-bindings*))))