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

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

Migrate sxpath away to be named sxpath-lolevel

File size: 4.8 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-13 string-prefix? string-index-right)
126        (only srfi-1 filter))
127
128(define string-rindex string-index-right)
129
130(define nl (string #\newline))
131(define -- sub1)
132(define inc add1)
133
134; like cout << arguments << args
135; where argument can be any Scheme object. If it's a procedure
136; (without args) it's executed rather than printed (like newline)
137(define (cout . args)
138  (for-each (lambda (x)
139              (if (procedure? x) (x) (display x)))
140            args))
141
142(define (cerr . args)
143  (for-each (lambda (x)
144              (if (procedure? x) (x (current-error-port)) (display x (current-error-port))))
145            args))
146
147;; There's no real danger of hygiene breakage because the macros here
148;; are only used locally
149(define-syntax define-macro
150  (syntax-rules ()
151    ((define-macro (macro-name . args)
152       body ...)
153     (define-syntax (macro-name exp rename compare)
154       (apply (lambda args body ...) (cdr exp))))))
155
156;; A bit big to include this here, but we don't want a dependency on
157;; sxml-transforms just for this one.
158(define (make-char-quotator char-encoding)
159  (let ((bad-chars (map car char-encoding)))
160
161    ; Check to see if str contains one of the characters in charset,
162    ; from the position i onward. If so, return that character's index.
163    ; otherwise, return #f
164    (define (index-cset str i charset)
165      (let loop ((i i))
166        (and (< i (string-length str))
167             (if (memv (string-ref str i) charset) i
168                 (loop (inc i))))))
169
170    ; The body of the function
171    (lambda (str)
172      (let ((bad-pos (index-cset str 0 bad-chars)))
173        (if (not bad-pos) str   ; str had all good chars
174            (let loop ((from 0) (to bad-pos))
175              (cond
176               ((>= from (string-length str)) '())
177               ((not to)
178                (cons (substring str from (string-length str)) '()))
179               (else
180                (let ((quoted-char
181                       (cdr (assv (string-ref str to) char-encoding)))
182                      (new-to 
183                       (index-cset str (inc to) bad-chars)))
184                  (if (< from to)
185                      (cons
186                       (substring str from to)
187                       (cons quoted-char (loop (inc to) new-to)))
188                      (cons quoted-char (loop (inc to) new-to))))))))))))
189
190(include "sxml-tools/sxml-tools.scm")
191;; We need the sxpathlib because sxml-tools makes use of a few of its
192;; procedures, like sxml:filter and select-kids, but sxpathlib itself
193;; also uses sxml-tools, so they are tied together.
194(include "sxml-tools/sxpathlib.scm")
195;; Because we include sxpathlib, we should also include sxpath-ext
196;; because together they form the "low-level" interface to sxpath.
197(include "sxml-tools/sxpath-ext.scm")
198
199;; Overwrite the meaning of sxml:error so it does something sane
200(set! sxml:error error)
201
202)
Note: See TracBrowser for help on using the repository browser.