Changeset 13784 in project


Ignore:
Timestamp:
03/16/09 21:46:49 (11 years ago)
Author:
sjamaan
Message:

Update to latest upstream version; remove own hacked version of pre-post-order-splice

Location:
release/4/sxml-transforms
Files:
1 added
1 deleted
9 edited

Legend:

Unmodified
Added
Removed
  • release/4/sxml-transforms/SSAX/examples/packages.scm

    r11784 r13784  
    5656        assertions
    5757        crementing
     58        sxml-tree-trans
    5859        srfi-23)
    5960  (begin
  • release/4/sxml-transforms/SSAX/examples/sxml-to-sxml.scm

    r11784 r13784  
    11;       Transforming SXML to SXML: Composing SXML transformations
    22;
    3 ; The present code introduces and tests a version of pre-post-order
     3; The present code tests a version of pre-post-order
    44; that transforms an SXML document into a _strictly conformant_ SXML
    55; document. That is, the result of a pre-post-order transformation can
     
    5050; on its source document being fully SXML compliant.
    5151;
    52 ; The problem can be rectified, by changing pre-post-order as shown in
    53 ; the code below. The only change is replacing the two occurrences of
    54 ; 'map' (there are only two such occurrences) with
    55 ; map-node-concat. Justification for the change: a pre-post-order
    56 ; handler can yield either a node, or a nodelist. Now, if the handler
    57 ; returns a nodelist, we _splice_ it in in the result tree. This
    58 ; operation seems to make sure that each node of a tree is a valid
    59 ; SXML node.
     52; The problem can be rectified in pre-post-order-splice.
    6053;
    6154; For a pure SXML-to-XML conversion, the splicing-in seems to be an
     
    8073;   )
    8174;
    82 ; $Id: sxml-to-sxml.scm,v 1.2 2004/07/07 16:02:30 sperber Exp $
    83 
    84 ; map-node-concat FN NODELIST -> NODELIST
    85 ; Map FN to each element of NODELIST where FN is a function
    86 ;       NODE -> NODE or NODELIST
    87 ; If an application of FN yields a NODELIST (including the empty list),
    88 ; we _splice_ it in into the result. Essentially,
    89 ;       (map-node-concat fn nodelist)
    90 ; is equivalent to
    91 ; (apply append
    92 ;   (map (lambda (node)
    93 ;        (let ((result (fn node)))
    94 ;          (if (nodelist? result) result (list result))))
    95 ;     nodelist))
    96 
    97 (define (map-node-concat fn lst)
    98   (if (null? lst) '()
    99     (let ((result (fn (car lst))))
    100       (cond
    101         ((null? result)                 ; It's a null node-list, splice it in
    102           (map-node-concat fn (cdr lst)))
    103         ((and (pair? result) (not (symbol? (car result))))
    104                 ;  it's a non-null node-list
    105           (append result (map-node-concat fn (cdr lst))))
    106         (else
    107           (cons   result (map-node-concat fn (cdr lst))))))))
    108 
    109 ; The following is almost identical to pre-post-order
    110 ; from ../lib/SXML-tree-trans.scm
    111 ; except that the two occurrences of 'map' in that pre-post-order
    112 ; (there are only two such occurrences) are replaced with map-node-concat
    113 ; in the code below.
    114 
    115 (define (pre-post-order tree bindings)
    116   (let* ((default-binding (assq '*default* bindings))
    117          (text-binding (or (assq '*text* bindings) default-binding))
    118          (text-handler                  ; Cache default and text bindings
    119            (and text-binding
    120              (if (procedure? (cdr text-binding))
    121                  (cdr text-binding) (cddr text-binding)))))
    122     (let loop ((tree tree))
    123       (cond
    124         ((null? tree) '())
    125         ((not (pair? tree))
    126           (let ((trigger '*text*))
    127             (if text-handler (text-handler trigger tree)
    128               (error "Unknown binding for " trigger " and no default"))))
    129                                         ; tree is a nodelist
    130         ((not (symbol? (car tree))) (map-node-concat loop tree))
    131         (else                           ; tree is an SXML node
    132           (let* ((trigger (car tree))
    133                  (binding (or (assq trigger bindings) default-binding)))
    134             (cond
    135               ((not binding)
    136                 (error "Unknown binding for " trigger " and no default"))
    137               ((not (pair? (cdr binding)))  ; must be a procedure: handler
    138                 (apply (cdr binding) trigger
    139                   (map-node-concat loop (cdr tree))))
    140               ((eq? '*preorder* (cadr binding))
    141                 (apply (cddr binding) tree))
    142               ((eq? '*macro* (cadr binding))
    143                 (loop (apply (cddr binding) tree)))
    144               (else                         ; (cadr binding) is a local binding
    145                 (apply (cddr binding) trigger
    146                   (pre-post-order (cdr tree) (append (cadr binding) bindings)))
    147                 ))))))))
     75; $Id: sxml-to-sxml.scm,v 1.3 2009/03/16 03:08:58 oleg Exp $
    14876
    14977
    150 ; Examples and tests
     78(define pre-post-order pre-post-order-splice)
     79
    15180
    15281; First example from Joerg-Cyril Hoehle, see above
  • release/4/sxml-transforms/SSAX/examples/target-dependencies

    r11784 r13784  
    55sxslt-advanced-depend=srfi-13-local.scm util.scm assert.scm SXML-tree-trans.scm output.scm SXML-to-HTML.scm lookup-def.scm SXML-to-HTML-ext.scm
    66
    7 sxml-to-sxml-depend=ppretty-prints.scm assert.scm
     7sxml-to-sxml-depend=ppretty-prints.scm assert.scm SXML-tree-trans.scm
    88
    99sxml-nesting-depth-label-depend=ppretty-prints.scm assert.scm SXML-tree-trans.scm
  • release/4/sxml-transforms/SSAX/lib/SXML-tree-trans.scm

    r11784 r13784  
    1313; serves as usage examples.
    1414;
    15 ; $Id: SXML-tree-trans.scm,v 1.7 2004/11/09 20:22:26 sperber Exp $
     15; $Id: SXML-tree-trans.scm,v 1.8 2009/03/16 03:08:59 oleg Exp $
    1616
    1717
     
    139139; backward compatibility.
    140140(define post-order pre-post-order)
     141
     142
     143; A version of pre-post-order that transforms an SXML document into a
     144; _strictly conformant_ SXML document. That is, the result of a
     145; pre-post-order transformation can be queried with SXPath or
     146; transformed again with SXSLT.
     147
     148; Joerg-Cyril Hoehle wrote on the SSAX-SXML mailing list about
     149; chaining of transformations on a SXML source:
     150;       SXML --transform--> SXML1 --transform--> SXML2 ... --> XML
     151; It's only the last transformation step that would produce XML.
     152; We can use a pre-post-order traversal combinator with an appropriate
     153; stylesheet to run each 'transform' step above. SRV:send-reply at the
     154; end will write out the resulting XML document.
     155; (see Joerg-Cyril Hoehle's messages on the SSAX-SXML list on Oct
     156; 21 and 22, 2003).
     157;
     158; Composing SXML transformations by feeding the result of one
     159; pre-post-order traversal into another works. Still, the result of
     160; pre-post-order is merely a tree of fragments, which is generally not
     161; a strictly valid SXML.  Joerg-Cyril Hoehle pointed out that, for
     162; example, given an SXML document
     163;       '(Data (repeat 3 (random-Header 3))))
     164; a sample transformation
     165; (pre-post-order sxml
     166;   `((repeat *macro*
     167;      . ,(lambda (tag count . elems)
     168;         (apply make-list count elems)))
     169;      (random-Header *preorder*
     170;        . ,(lambda (tag elems)
     171;           `(Header ,(gensym))))
     172;      (*text* . ,(lambda (trigger x) x))
     173;      (*default* . ,(lambda x x))))
     174;
     175; yields the following.
     176; (Data
     177;  ((Header VOTj)
     178;   (Header 0qel)
     179;   (Header bA97)))
     180;
     181; All (Header ...) elements are enclosed in an extra pair of
     182; parentheses. In general, pre-post-order may add extra nesting levels
     183; and insert empty lists. Both these features break the strict SXML
     184; specification compliance of the transformation result. Still,
     185; pre-post-order itself can process such a tree correctly. Therefore,
     186; if we use only pre-post-order for our multi-stage SXML
     187; transformations, no problems occur. However, if we wish to employ
     188; SXPath to select parts from a pre-post-order-transformed SXML
     189; document, we get a problem. SXPath, unlike pre-post-order, insists
     190; on its source document being fully SXML compliant.
     191;
     192; The problem can be rectified, by changing pre-post-order as shown in
     193; the code below. The only change is replacing the two occurrences of
     194; 'map' (there are only two such occurrences) with
     195; map-node-concat. Justification for the change: a pre-post-order
     196; handler can yield either a node, or a nodelist. Now, if the handler
     197; returns a nodelist, we _splice_ it in in the result tree. This
     198; operation seems to make sure that each node of a tree is a valid
     199; SXML node.
     200;
     201; For a pure SXML-to-XML conversion, the splicing-in seems to be an
     202; overkill. Therefore, it may make sense to keep both versions of
     203; pre-post-order. Personally I have no problem with proliferation of
     204; pre-post-order-like functions. I believe that it is the data
     205; structure/protocols that should be standardized and
     206; parsimonious. Each user may write processing code in his own way. Of
     207; course some of the processing code turns out more general than the
     208; other, and can be shared. Nevertheless, it's the common data
     209; structure, the common format that guarantees interoperability --
     210; rather than the common library. Code should be tailored (or even
     211; automatically generated) to suit circumstances.
     212;
     213
     214; map-node-concat FN NODELIST -> NODELIST
     215; Map FN to each element of NODELIST where FN is a function
     216;       NODE -> NODE or NODELIST
     217; If an application of FN yields a NODELIST (including the empty list),
     218; we _splice_ it in into the result. Essentially,
     219;       (map-node-concat fn nodelist)
     220; is equivalent to
     221; (apply append
     222;   (map (lambda (node)
     223;        (let ((result (fn node)))
     224;          (if (nodelist? result) result (list result))))
     225;     nodelist))
     226
     227(define (map-node-concat fn lst)
     228  (if (null? lst) '()
     229    (let ((result (fn (car lst))))
     230      (cond
     231        ((null? result)                 ; It's a null node-list, splice it in
     232          (map-node-concat fn (cdr lst)))
     233        ((and (pair? result) (not (symbol? (car result))))
     234                ;  it's a non-null node-list
     235          (append result (map-node-concat fn (cdr lst))))
     236        (else
     237          (cons   result (map-node-concat fn (cdr lst))))))))
     238
     239; The following is almost identical to pre-post-order
     240; except that the two occurrences of 'map' in that pre-post-order
     241; (there are only two such occurrences) are replaced with map-node-concat
     242; in the code below.
     243
     244(define (pre-post-order-splice tree bindings)
     245  (let* ((default-binding (assq '*default* bindings))
     246         (text-binding (or (assq '*text* bindings) default-binding))
     247         (text-handler                  ; Cache default and text bindings
     248           (and text-binding
     249             (if (procedure? (cdr text-binding))
     250                 (cdr text-binding) (cddr text-binding)))))
     251    (let loop ((tree tree))
     252      (cond
     253        ((null? tree) '())
     254        ((not (pair? tree))
     255          (let ((trigger '*text*))
     256            (if text-handler (text-handler trigger tree)
     257              (error "Unknown binding for " trigger " and no default"))))
     258                                        ; tree is a nodelist
     259        ((not (symbol? (car tree))) (map-node-concat loop tree))
     260        (else                           ; tree is an SXML node
     261          (let* ((trigger (car tree))
     262                 (binding (or (assq trigger bindings) default-binding)))
     263            (cond
     264              ((not binding)
     265                (error "Unknown binding for " trigger " and no default"))
     266              ((not (pair? (cdr binding)))  ; must be a procedure: handler
     267                (apply (cdr binding) trigger
     268                  (map-node-concat loop (cdr tree))))
     269              ((eq? '*preorder* (cadr binding))
     270                (apply (cddr binding) tree))
     271              ((eq? '*macro* (cadr binding))
     272                (loop (apply (cddr binding) tree)))
     273              (else                         ; (cadr binding) is a local binding
     274                (apply (cddr binding) trigger
     275                  (pre-post-order (cdr tree) (append (cadr binding) bindings)))
     276                ))))))))
    141277
    142278;------------------------------------------------------------------------
  • release/4/sxml-transforms/SSAX/lib/packages.scm

    r11784 r13784  
    6464(define-interface sxml-tree-trans-interface
    6565  (export SRV:send-reply
    66           post-order pre-post-order replace-range))
     66          post-order pre-post-order pre-post-order-splice replace-range))
    6767
    6868(define-interface sxml-to-html-interface
  • release/4/sxml-transforms/SSAX/lib/util.scm

    r13521 r13784  
    258258;           '((#\< . "&lt;") (#\> . "&gt;") (#\& . "&amp;") (#\" . "&quot;")))
    259259
    260 ; Check to see if str contains one of the characters in charset,
    261 ; from the position i onward. If so, return that character's index.
    262 ; otherwise, return #f
    263 (define (index-cset str i charset)
    264   (let loop ((i i))
    265     (and (< i (string-length str))
    266          (if (memv (string-ref str i) charset) i
    267              (loop (inc i))))))
    268 
    269260(define (make-char-quotator char-encoding)
    270261  (let ((bad-chars (map car char-encoding)))
     262
     263    ; Check to see if str contains one of the characters in charset,
     264    ; from the position i onward. If so, return that character's index.
     265    ; otherwise, return #f
     266    (define (index-cset str i charset)
     267      (let loop ((i i))
     268        (and (< i (string-length str))
     269             (if (memv (string-ref str i) charset) i
     270                 (loop (inc i))))))
    271271
    272272    ; The body of the function
  • release/4/sxml-transforms/SSAX/ssax-sourceforge.scm

    r11784 r13784  
    11; Evaluation of this file yields an HTML document
    2 ; $Id: ssax-sourceforge.scm,v 1.10 2008/07/22 11:16:01 oleg Exp $
     2; $Id: ssax-sourceforge.scm,v 1.12 2009/03/11 04:13:56 oleg Exp $
    33
    44(define Content
     
    88   (description "Representing, authoring, querying and transforming
    99markup data in Scheme; XML notation for a programming language")
    10    (Date-Revision-yyyymmdd "20080722")
     10   (Date-Revision-yyyymmdd "20090310")
    1111   (Date-Creation-yyyymmdd "20010706")
    1212   (keywords "XML, XML parsing, XML Infoset, XPath, XSLT, SAX, SXML, SXSLT, SXPath, Scheme, HTML composition, HTML authoring")
     
    2828   (page-title)
    2929
    30    (a (@ (href "http://sourceforge.net")) " "
    31       (img (@ (src "http://sourceforge.net/sflogo.php?group_id=30687")
    32               (width "88") (height "31") (border "0")
    33               (alt "SourceForge Logo"))))
     30   (a (@ (href "http://sourceforge.net/projects/ssax")) " "
     31      (img (@ (src
     32            "http://sflogo.sourceforge.net/sflogo.php?group_id=30687&type=9")
     33              (width "80") (height "15") (border "0")
     34              (alt "Get S-exp-based XML parsing/query/conversion at
     35   SourceForge.net. Fast, secure and Free Open Source software downloads"))))
    3436
    3537; Ref to Makoto Satoo
     
    108110        "http://www-6.ibm.com/jp/developerworks/library/j_x-matters31.html")
    109111      "[Japanese]")
     112   
     113   (p "Authoring dynamic websites with SXML by Peter Bex:"
     114     (URL "http://sjamaan.ath.cx/docs/scheme/sxslt.pdf"))
    110115
    111116   (p
  • release/4/sxml-transforms/chicken/sxml-transforms.scm

    r11784 r13784  
    44 (
    55  ;; SXML-tree-trans.scm -- This does not depend on anything else
    6   SRV:send-reply pre-post-order post-order foldts replace-range
     6  SRV:send-reply pre-post-order post-order pre-post-order-splice
     7  foldts replace-range
    78 
    89  ;; SXML-to-HTML.scm -- needs make-char-quotator
  • release/4/sxml-transforms/sxml-transforms.setup

    r11786 r13784  
    55  `("sxml-transforms.so"
    66    "sxml-transforms.import.so" )
    7   `((version 1.2)
     7  `((version 1.3)
    88    (documentation "sxml-transforms.html")))
    9 
    10 (compile -s -O2 -d0 -o "sxml-to-sxml.so" -j sxml-to-sxml chicken/sxml-to-sxml.scm)
    11 (compile -s -O2 -d0 sxml-to-sxml.import.scm)
    12 
    13 (install-extension 'sxml-to-sxml
    14   `("sxml-to-sxml.so"
    15     "sxml-to-sxml.import.so")
    16   `((version 1.2)
    17     (documentation "sxml-transforms.html")))
Note: See TracChangeset for help on using the changeset viewer.