source: project/release/4/sxml-transforms/chicken/sxml-transforms.scm @ 11784

Last change on this file since 11784 was 11784, checked in by sjamaan, 13 years ago

Port sxml-transforms to Chicken 4

File size: 2.3 KB
Line 
1;; $Revision: 1.2 $ $Date: 2005/07/11 23:36:16 $
2
3(module sxml-transforms
4 (
5  ;; SXML-tree-trans.scm -- This does not depend on anything else
6  SRV:send-reply pre-post-order post-order foldts replace-range
7 
8  ;; SXML-to-HTML.scm -- needs make-char-quotator
9  SXML->HTML entag enattr string->goodHTML
10 
11  ;; SXML-to-HTML-ext.scm
12  universal-conversion-rules
13  universal-protected-rules
14  alist-conv-rules
15
16  ;; util.scm
17  make-char-quotator
18
19  ;; chicken/xhtml.scm
20  entag-xhtml
21  entag-html
22  )
23
24(import chicken scheme)
25(require-extension posix srfi-13)
26 
27(define inc add1)
28(define dec sub1)
29(define nl (string #\newline))  ;; for SXML->HTML
30
31; like cout << arguments << args
32; where argument can be any Scheme object. If it's a procedure
33; (without args) it's executed rather than printed (like newline)
34(define (cout . args)
35  (for-each (lambda (x)
36              (if (procedure? x) (x) (display x)))
37            args))
38
39(define (cerr . args)
40  (for-each (lambda (x)
41              (if (procedure? x) (x (current-error-port)) (display x (current-error-port))))
42            args))
43
44;;; Includes
45
46(include "SSAX/lib/util.scm") ;; for make-char-quotator only
47(include "SSAX/lib/SXML-tree-trans.scm")
48(include "SSAX/lib/lookup-def.scm")
49(include "SSAX/lib/SXML-to-HTML.scm")      ;; Warning: this needs nl at runtime (unless macro)
50
51;; Override the entag in SXML-to-HTML-ext's universal-conversion-rules
52;; to use entag-xhtml, as well as the user's view of entag.
53(define entag-html entag)
54(include "chicken/xhtml.scm")              ;; for entag-xhtml
55(define entag entag-xhtml)
56
57(define OS:file-length file-size)
58(include "SSAX/lib/SXML-to-HTML-ext.scm")  ;; Not trimmed, but non-exported code
59                                           ;; will not be compiled in.
60
61;;; Tack rules on to the universal conversion rules.
62(let ((extra-rules
63       ;; (& STR1 ...) : Quotes character references given by strings STR1 ...
64       ;; Conforms to HTMLprag's syntax.  Example:
65       ;; (& "ndash" "quot" ...) => ("&ndash;" "&quot;" ...)
66       `((& . ,(lambda (tag . elts)
67                 (map (lambda (elt)
68                        (string-append "&" elt ";"))
69                      elts))))))
70
71  (set! universal-conversion-rules
72        (append universal-conversion-rules extra-rules))
73  (set! universal-protected-rules
74        (append universal-protected-rules extra-rules)))
75)
Note: See TracBrowser for help on using the repository browser.