source: project/release/4/sxpath/chicken/sxpath-lolevel.scm @ 13360

Last change on this file since 13360 was 13360, checked in by sjamaan, 11 years ago

Add txpath and sxpath libraries, that are built on top of sxpath-lolevel

File size: 4.2 KB
Line 
1(provide 'sxpath-lolevel)
2
3(module sxpath-lolevel
4  (
5   ;; sxpathlib
6   nodeset?
7   as-nodeset
8   sxml:element?
9   ntype-names??
10   ntype??
11   ntype-namespace-id??
12   sxml:complement
13   node-eq?
14   node-equal?
15   node-pos
16   sxml:filter
17   take-until take-after
18   map-union
19   node-reverse
20   node-trace
21   select-kids
22   node-self
23   node-join
24   node-reduce
25   node-or
26   node-closure
27   sxml:node?
28   sxml:attr-list
29   sxml:attribute
30   sxml:child
31   sxml:parent
32   node-parent
33   sxml:child-nodes
34   sxml:child-elements
35
36   ;; sxml-tools
37   sxml:empty-element?
38   sxml:shallow-normalized?
39   sxml:normalized?
40   sxml:shallow-minimized?
41   sxml:minimized?
42   sxml:name
43   sxml:element-name
44   sxml:node-name
45   sxml:ncname
46   sxml:name->ns-id
47   sxml:content
48   sxml:text
49   sxml:content-raw
50   sxml:attr-list-u
51   sxml:aux-list
52   sxml:aux-list-u
53   sxml:aux-node
54   sxml:aux-nodes
55   sxml:attr
56   sxml:attr-from-list
57   sxml:num-attr
58   sxml:attr-u
59   sxml:ns-list
60   sxml:ns-id->nodes
61   sxml:ns-id->uri
62   sxml:ns-uri->nodes
63   sxml:ns-uri->id
64   sxml:ns-id sxml:ns-uri
65   sxml:ns-prefix
66   sxml:change-content!
67   sxml:change-content
68   sxml:change-attrlist
69   sxml:change-attrlist!
70   sxml:change-name!
71   sxml:change-name
72   sxml:add-attr
73   sxml:add-attr!
74   sxml:change-attr
75   sxml:change-attr!
76   sxml:set-attr
77   sxml:set-attr!
78   sxml:add-aux
79   sxml:add-aux!
80   sxml:squeeze!
81   sxml:squeeze
82   sxml:clean
83   select-first-kid
84   sxml:node-parent
85   sxml:add-parents
86   sxml:lookup
87   sxml:attr->xml
88   sxml:string->xml
89   sxml:sxml->xml
90   sxml:attr->html
91   sxml:string->html
92   sxml:non-terminated-html-tag?
93   sxml:sxml->html
94 
95   ;; sxml-errors (actually, defined here)
96   sxml:error
97
98   ;; sxpath-ext
99   sxml:string
100   sxml:boolean
101   sxml:number
102   sxml:string-value
103   sxml:id
104   sxml:list-head
105   sxml:merge-sort
106   sxml:equality-cmp
107   sxml:equal?
108   sxml:not-equal?
109   sxml:relational-cmp
110   sxml:ancestor
111   sxml:ancestor-or-self
112   sxml:descendant
113   sxml:descendant-or-self
114   sxml:following sxml:following-sibling
115   sxml:namespace
116   sxml:preceding sxml:preceding-sibling
117   )
118
119(import (except chicken define-macro) scheme
120        (only extras pp)
121        (only ports call-with-input-string))
122
123(require-library srfi-13 srfi-1)
124
125(import (only srfi-1 filter))
126
127;; There's no real danger of hygiene breakage because the macros here
128;; are only used locally
129(define-syntax define-macro
130  (syntax-rules ()
131    ((define-macro (macro-name . args)
132       body ...)
133     (define-syntax (macro-name exp rename compare)
134       (apply (lambda args body ...) (cdr exp))))))
135
136
137;; A bit big to include this here, but we don't want a dependency on
138;; sxml-transforms just for this one.
139(define (make-char-quotator char-encoding)
140  (let ((bad-chars (map car char-encoding)))
141
142    ; Check to see if str contains one of the characters in charset,
143    ; from the position i onward. If so, return that character's index.
144    ; otherwise, return #f
145    (define (index-cset str i charset)
146      (let loop ((i i))
147        (and (< i (string-length str))
148             (if (memv (string-ref str i) charset) i
149                 (loop (inc i))))))
150
151    ; The body of the function
152    (lambda (str)
153      (let ((bad-pos (index-cset str 0 bad-chars)))
154        (if (not bad-pos) str   ; str had all good chars
155            (let loop ((from 0) (to bad-pos))
156              (cond
157               ((>= from (string-length str)) '())
158               ((not to)
159                (cons (substring str from (string-length str)) '()))
160               (else
161                (let ((quoted-char
162                       (cdr (assv (string-ref str to) char-encoding)))
163                      (new-to 
164                       (index-cset str (inc to) bad-chars)))
165                  (if (< from to)
166                      (cons
167                       (substring str from to)
168                       (cons quoted-char (loop (inc to) new-to)))
169                      (cons quoted-char (loop (inc to) new-to))))))))))))
170
171(include "chicken/common.scm")
172
173(include "sxml-tools/sxml-tools.scm")
174;; We need the sxpathlib because sxml-tools makes use of a few of its
175;; procedures, like sxml:filter and select-kids, but sxpathlib itself
176;; also uses sxml-tools, so they are tied together.
177(include "sxml-tools/sxpathlib.scm")
178;; Because we include sxpathlib, we should also include sxpath-ext
179;; because together they form the "low-level" interface to sxpath.
180(include "sxml-tools/sxpath-ext.scm")
181
182;; Overwrite the meaning of sxml:error so it does something sane
183(set! sxml:error error)
184
185)
Note: See TracBrowser for help on using the repository browser.