SXPath-old.scm 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217
  1. ; XML processing in Scheme
  2. ; SXPath -- SXML Query Language
  3. ;
  4. ; SXPath is a query language for SXML, an instance of XML Information
  5. ; set (Infoset) in the form of s-expressions. See SSAX.scm for the
  6. ; definition of SXML and more details. SXPath is also a translation into
  7. ; Scheme of an XML Path Language, XPath:
  8. ; http://www.w3.org/TR/xpath
  9. ; XPath and SXPath describe means of selecting a set of Infoset's items
  10. ; or their properties.
  11. ;
  12. ; To facilitate queries, XPath maps the XML Infoset into an explicit
  13. ; tree, and introduces important notions of a location path and a
  14. ; current, context node. A location path denotes a selection of a set of
  15. ; nodes relative to a context node. Any XPath tree has a distinguished,
  16. ; root node -- which serves as the context node for absolute location
  17. ; paths. Location path is recursively defined as a location step joined
  18. ; with a location path. A location step is a simple query of the
  19. ; database relative to a context node. A step may include expressions
  20. ; that further filter the selected set. Each node in the resulting set
  21. ; is used as a context node for the adjoining location path. The result
  22. ; of the step is a union of the sets returned by the latter location
  23. ; paths.
  24. ;
  25. ; The SXML representation of the XML Infoset (see SSAX.scm) is rather
  26. ; suitable for querying as it is. Bowing to the XPath specification,
  27. ; we will refer to SXML information items as 'Nodes':
  28. ; <Node> ::= <Element> | <attributes-coll> | <attrib>
  29. ; | "text string" | <PI>
  30. ; This production can also be described as
  31. ; <Node> ::= (name . <Nodeset>) | "text string"
  32. ; An (ordered) set of nodes is just a list of the constituent nodes:
  33. ; <Nodeset> ::= (<Node> ...)
  34. ; Nodesets, and Nodes other than text strings are both lists. A
  35. ; <Nodeset> however is either an empty list, or a list whose head is not
  36. ; a symbol. A symbol at the head of a node is either an XML name (in
  37. ; which case it's a tag of an XML element), or an administrative name
  38. ; such as '@'. This uniform list representation makes processing rather
  39. ; simple and elegant, while avoiding confusion. The multi-branch tree
  40. ; structure formed by the mutually-recursive datatypes <Node> and
  41. ; <Nodeset> lends itself well to processing by functional languages.
  42. ;
  43. ; A location path is in fact a composite query over an XPath tree or
  44. ; its branch. A singe step is a combination of a projection, selection
  45. ; or a transitive closure. Multiple steps are combined via join and
  46. ; union operations. This insight allows us to _elegantly_ implement
  47. ; XPath as a sequence of projection and filtering primitives --
  48. ; converters -- joined by _combinators_. Each converter takes a node
  49. ; and returns a nodeset which is the result of the corresponding query
  50. ; relative to that node. A converter can also be called on a set of
  51. ; nodes. In that case it returns a union of the corresponding queries over
  52. ; each node in the set. The union is easily implemented as a list
  53. ; append operation as all nodes in a SXML tree are considered
  54. ; distinct, by XPath conventions. We also preserve the order of the
  55. ; members in the union. Query combinators are high-order functions:
  56. ; they take converter(s) (which is a Node|Nodeset -> Nodeset function)
  57. ; and compose or otherwise combine them. We will be concerned with
  58. ; only relative location paths [XPath]: an absolute location path is a
  59. ; relative path applied to the root node.
  60. ;
  61. ; Similarly to XPath, SXPath defines full and abbreviated notations
  62. ; for location paths. In both cases, the abbreviated notation can be
  63. ; mechanically expanded into the full form by simple rewriting
  64. ; rules. In case of SXPath the corresponding rules are given as
  65. ; comments to a sxpath function, below. The regression test suite at
  66. ; the end of this file shows a representative sample of SXPaths in
  67. ; both notations, juxtaposed with the corresponding XPath
  68. ; expressions. Most of the samples are borrowed literally from the
  69. ; XPath specification, while the others are adjusted for our running
  70. ; example, tree1.
  71. ;
  72. ; To do:
  73. ; Rename filter to node-filter or ns-filter
  74. ; Use ;=== for chapters, ;--- for sections, and ;^^^ for end sections
  75. ;
  76. ; $Id: SXPath-old.scm,v 1.4 2004/07/07 16:02:31 sperber Exp $
  77. ; See http://pobox.com/~oleg/ftp/Scheme/myenv.scm
  78. ; See http://pobox.com/~oleg/ftp/Scheme/myenv-scm.scm
  79. ; See http://pobox.com/~oleg/ftp/Scheme/myenv-bigloo.scm
  80. ;(module SXPath
  81. ; (include "myenv-bigloo.scm")) ; For use with Bigloo 2.2b
  82. ;(load "myenv-scm.scm") ; For use with SCM v5d2
  83. ;(include "myenv.scm") ; For use with Gambit-C 3.0
  84. (define (nodeset? x)
  85. (or (and (pair? x) (not (symbol? (car x)))) (null? x)))
  86. ;-------------------------
  87. ; Basic converters and applicators
  88. ; A converter is a function
  89. ; type Converter = Node|Nodeset -> Nodeset
  90. ; A converter can also play a role of a predicate: in that case, if a
  91. ; converter, applied to a node or a nodeset, yields a non-empty
  92. ; nodeset, the converter-predicate is deemed satisfied. Throughout
  93. ; this file a nil nodeset is equivalent to #f in denoting a failure.
  94. ; The following function implements a 'Node test' as defined in
  95. ; Sec. 2.3 of XPath document. A node test is one of the components of a
  96. ; location step. It is also a converter-predicate in SXPath.
  97. ;
  98. ; The function node-typeof? takes a type criterion and returns a function,
  99. ; which, when applied to a node, will tell if the node satisfies
  100. ; the test.
  101. ; node-typeof? :: Crit -> Node -> Boolean
  102. ;
  103. ; The criterion 'crit' is a symbol, one of the following:
  104. ; id - tests if the Node has the right name (id)
  105. ; @ - tests if the Node is an <attributes-coll>
  106. ; * - tests if the Node is an <Element>
  107. ; *text* - tests if the Node is a text node
  108. ; *PI* - tests if the Node is a PI node
  109. ; *any* - #t for any type of Node
  110. (define (node-typeof? crit)
  111. (lambda (node)
  112. (case crit
  113. ((*) (and (pair? node) (not (memq (car node) '(@ *PI*)))))
  114. ((*any*) #t)
  115. ((*text*) (string? node))
  116. (else
  117. (and (pair? node) (eq? crit (car node))))
  118. )))
  119. ; Curried equivalence converter-predicates
  120. (define (node-eq? other)
  121. (lambda (node)
  122. (eq? other node)))
  123. (define (node-equal? other)
  124. (lambda (node)
  125. (equal? other node)))
  126. ; node-pos:: N -> Nodeset -> Nodeset, or
  127. ; node-pos:: N -> Converter
  128. ; Select the N'th element of a Nodeset and return as a singular Nodeset;
  129. ; Return an empty nodeset if the Nth element does not exist.
  130. ; ((node-pos 1) Nodeset) selects the node at the head of the Nodeset,
  131. ; if exists; ((node-pos 2) Nodeset) selects the Node after that, if
  132. ; exists.
  133. ; N can also be a negative number: in that case the node is picked from
  134. ; the tail of the list.
  135. ; ((node-pos -1) Nodeset) selects the last node of a non-empty nodeset;
  136. ; ((node-pos -2) Nodeset) selects the last but one node, if exists.
  137. (define (node-pos n)
  138. (lambda (nodeset)
  139. (cond
  140. ((not (nodeset? nodeset)) '())
  141. ((null? nodeset) nodeset)
  142. ((eqv? n 1) (list (car nodeset)))
  143. ((negative? n) ((node-pos (+ n 1 (length nodeset))) nodeset))
  144. (else
  145. (assert (positive? n))
  146. ((node-pos (dec n)) (cdr nodeset))))))
  147. ; filter:: Converter -> Converter
  148. ; A filter applicator, which introduces a filtering context. The argument
  149. ; converter is considered a predicate, with either #f or nil result meaning
  150. ; failure.
  151. (define (filter pred?)
  152. (lambda (lst) ; a nodeset or a node (will be converted to a singleton nset)
  153. (let loop ((lst (if (nodeset? lst) lst (list lst))) (res '()))
  154. (if (null? lst)
  155. (reverse res)
  156. (let ((pred-result (pred? (car lst))))
  157. (loop (cdr lst)
  158. (if (and pred-result (not (null? pred-result)))
  159. (cons (car lst) res)
  160. res)))))))
  161. ; take-until:: Converter -> Converter, or
  162. ; take-until:: Pred -> Node|Nodeset -> Nodeset
  163. ; Given a converter-predicate and a nodeset, apply the predicate to
  164. ; each element of the nodeset, until the predicate yields anything but #f or
  165. ; nil. Return the elements of the input nodeset that have been processed
  166. ; till that moment (that is, which fail the predicate).
  167. ; take-until is a variation of the filter above: take-until passes
  168. ; elements of an ordered input set till (but not including) the first
  169. ; element that satisfies the predicate.
  170. ; The nodeset returned by ((take-until (not pred)) nset) is a subset --
  171. ; to be more precise, a prefix -- of the nodeset returned by
  172. ; ((filter pred) nset)
  173. (define (take-until pred?)
  174. (lambda (lst) ; a nodeset or a node (will be converted to a singleton nset)
  175. (let loop ((lst (if (nodeset? lst) lst (list lst))))
  176. (if (null? lst) lst
  177. (let ((pred-result (pred? (car lst))))
  178. (if (and pred-result (not (null? pred-result)))
  179. '()
  180. (cons (car lst) (loop (cdr lst)))))
  181. ))))
  182. ; take-after:: Converter -> Converter, or
  183. ; take-after:: Pred -> Node|Nodeset -> Nodeset
  184. ; Given a converter-predicate and a nodeset, apply the predicate to
  185. ; each element of the nodeset, until the predicate yields anything but #f or
  186. ; nil. Return the elements of the input nodeset that have not been processed:
  187. ; that is, return the elements of the input nodeset that follow the first
  188. ; element that satisfied the predicate.
  189. ; take-after along with take-until partition an input nodeset into three
  190. ; parts: the first element that satisfies a predicate, all preceding
  191. ; elements and all following elements.
  192. (define (take-after pred?)
  193. (lambda (lst) ; a nodeset or a node (will be converted to a singleton nset)
  194. (let loop ((lst (if (nodeset? lst) lst (list lst))))
  195. (if (null? lst) lst
  196. (let ((pred-result (pred? (car lst))))
  197. (if (and pred-result (not (null? pred-result)))
  198. (cdr lst)
  199. (loop (cdr lst))))
  200. ))))
  201. ; Apply proc to each element of lst and return the list of results.
  202. ; if proc returns a nodeset, splice it into the result
  203. ;
  204. ; From another point of view, map-union is a function Converter->Converter,
  205. ; which places an argument-converter in a joining context.
  206. (define (map-union proc lst)
  207. (if (null? lst) lst
  208. (let ((proc-res (proc (car lst))))
  209. ((if (nodeset? proc-res) append cons)
  210. proc-res (map-union proc (cdr lst))))))
  211. ; node-reverse :: Converter, or
  212. ; node-reverse:: Node|Nodeset -> Nodeset
  213. ; Reverses the order of nodes in the nodeset
  214. ; This basic converter is needed to implement a reverse document order
  215. ; (see the XPath Recommendation).
  216. (define node-reverse
  217. (lambda (node-or-nodeset)
  218. (if (not (nodeset? node-or-nodeset)) (list node-or-nodeset)
  219. (reverse node-or-nodeset))))
  220. ; node-trace:: String -> Converter
  221. ; (node-trace title) is an identity converter. In addition it prints out
  222. ; a node or nodeset it is applied to, prefixed with the 'title'.
  223. ; This converter is very useful for debugging.
  224. (define (node-trace title)
  225. (lambda (node-or-nodeset)
  226. (cout nl "-->")
  227. (display title)
  228. (display " :")
  229. (pretty-print node-or-nodeset)
  230. node-or-nodeset))
  231. ;-------------------------
  232. ; Converter combinators
  233. ;
  234. ; Combinators are higher-order functions that transmogrify a converter
  235. ; or glue a sequence of converters into a single, non-trivial
  236. ; converter. The goal is to arrive at converters that correspond to
  237. ; XPath location paths.
  238. ;
  239. ; From a different point of view, a combinator is a fixed, named
  240. ; _pattern_ of applying converters. Given below is a complete set of
  241. ; such patterns that together implement XPath location path
  242. ; specification. As it turns out, all these combinators can be built
  243. ; from a small number of basic blocks: regular functional composition,
  244. ; map-union and filter applicators, and the nodeset union.
  245. ; select-kids:: Pred -> Node -> Nodeset
  246. ; Given a Node, return an (ordered) subset its children that satisfy
  247. ; the Pred (a converter, actually)
  248. ; select-kids:: Pred -> Nodeset -> Nodeset
  249. ; The same as above, but select among children of all the nodes in
  250. ; the Nodeset
  251. ;
  252. ; More succinctly, the signature of this function is
  253. ; select-kids:: Converter -> Converter
  254. (define (select-kids test-pred?)
  255. (lambda (node) ; node or node-set
  256. (cond
  257. ((null? node) node)
  258. ((not (pair? node)) '()) ; No children
  259. ((symbol? (car node))
  260. ((filter test-pred?) (cdr node))) ; it's a single node
  261. (else (map-union (select-kids test-pred?) node)))))
  262. ; node-self:: Pred -> Node -> Nodeset, or
  263. ; node-self:: Converter -> Converter
  264. ; Similar to select-kids but apply to the Node itself rather
  265. ; than to its children. The resulting Nodeset will contain either one
  266. ; component, or will be empty (if the Node failed the Pred).
  267. (define node-self filter)
  268. ; node-join:: [LocPath] -> Node|Nodeset -> Nodeset, or
  269. ; node-join:: [Converter] -> Converter
  270. ; join the sequence of location steps or paths as described
  271. ; in the title comments above.
  272. (define (node-join . selectors)
  273. (lambda (nodeset) ; Nodeset or node
  274. (let loop ((nodeset nodeset) (selectors selectors))
  275. (if (null? selectors) nodeset
  276. (loop
  277. (if (nodeset? nodeset)
  278. (map-union (car selectors) nodeset)
  279. ((car selectors) nodeset))
  280. (cdr selectors))))))
  281. ; node-reduce:: [LocPath] -> Node|Nodeset -> Nodeset, or
  282. ; node-reduce:: [Converter] -> Converter
  283. ; A regular functional composition of converters.
  284. ; From a different point of view,
  285. ; ((apply node-reduce converters) nodeset)
  286. ; is equivalent to
  287. ; (foldl apply nodeset converters)
  288. ; i.e., folding, or reducing, a list of converters with the nodeset
  289. ; as a seed.
  290. (define (node-reduce . converters)
  291. (lambda (nodeset) ; Nodeset or node
  292. (let loop ((nodeset nodeset) (converters converters))
  293. (if (null? converters) nodeset
  294. (loop ((car converters) nodeset) (cdr converters))))))
  295. ; node-or:: [Converter] -> Converter
  296. ; This combinator applies all converters to a given node and
  297. ; produces the union of their results.
  298. ; This combinator corresponds to a union, '|' operation for XPath
  299. ; location paths.
  300. ; (define (node-or . converters)
  301. ; (lambda (node-or-nodeset)
  302. ; (if (null? converters) node-or-nodeset
  303. ; (append
  304. ; ((car converters) node-or-nodeset)
  305. ; ((apply node-or (cdr converters)) node-or-nodeset)))))
  306. ; More optimal implementation follows
  307. (define (node-or . converters)
  308. (lambda (node-or-nodeset)
  309. (let loop ((result '()) (converters converters))
  310. (if (null? converters) result
  311. (loop (append result (or ((car converters) node-or-nodeset) '()))
  312. (cdr converters))))))
  313. ; node-closure:: Converter -> Converter
  314. ; Select all _descendants_ of a node that satisfy a converter-predicate.
  315. ; This combinator is similar to select-kids but applies to
  316. ; grand... children as well.
  317. ; This combinator implements the "descendant::" XPath axis
  318. ; Conceptually, this combinator can be expressed as
  319. ; (define (node-closure f)
  320. ; (node-or
  321. ; (select-kids f)
  322. ; (node-reduce (select-kids (node-typeof? '*)) (node-closure f))))
  323. ; This definition, as written, looks somewhat like a fixpoint, and it
  324. ; will run forever. It is obvious however that sooner or later
  325. ; (select-kids (node-typeof? '*)) will return an empty nodeset. At
  326. ; this point further iterations will no longer affect the result and
  327. ; can be stopped.
  328. (define (node-closure test-pred?)
  329. (lambda (node) ; Nodeset or node
  330. (let loop ((parent node) (result '()))
  331. (if (null? parent) result
  332. (loop ((select-kids (node-typeof? '*)) parent)
  333. (append result
  334. ((select-kids test-pred?) parent)))
  335. ))))
  336. ; node-parent:: RootNode -> Converter
  337. ; (node-parent rootnode) yields a converter that returns a parent of a
  338. ; node it is applied to. If applied to a nodeset, it returns the list
  339. ; of parents of nodes in the nodeset. The rootnode does not have
  340. ; to be the root node of the whole SXML tree -- it may be a root node
  341. ; of a branch of interest.
  342. ; Given the notation of Philip Wadler's paper on semantics of XSLT,
  343. ; parent(x) = { y | y=subnode*(root), x=subnode(y) }
  344. ; Therefore, node-parent is not the fundamental converter: it can be
  345. ; expressed through the existing ones. Yet node-parent is a rather
  346. ; convenient converter. It corresponds to a parent:: axis of SXPath.
  347. ; Note that the parent:: axis can be used with an attribute node as well!
  348. (define (node-parent rootnode)
  349. (lambda (node) ; Nodeset or node
  350. (if (nodeset? node) (map-union (node-parent rootnode) node)
  351. (let ((pred
  352. (node-or
  353. (node-reduce
  354. (node-self (node-typeof? '*))
  355. (select-kids (node-eq? node)))
  356. (node-join
  357. (select-kids (node-typeof? '@))
  358. (select-kids (node-eq? node))))))
  359. ((node-or
  360. (node-self pred)
  361. (node-closure pred))
  362. rootnode)))))
  363. ;-------------------------
  364. ; Evaluate an abbreviated SXPath
  365. ; sxpath:: AbbrPath -> Converter, or
  366. ; sxpath:: AbbrPath -> Node|Nodeset -> Nodeset
  367. ; AbbrPath is a list. It is translated to the full SXPath according
  368. ; to the following rewriting rules
  369. ; (sxpath '()) -> (node-join)
  370. ; (sxpath '(path-component ...)) ->
  371. ; (node-join (sxpath1 path-component) (sxpath '(...)))
  372. ; (sxpath1 '//) -> (node-or
  373. ; (node-self (node-typeof? '*any*))
  374. ; (node-closure (node-typeof? '*any*)))
  375. ; (sxpath1 '(equal? x)) -> (select-kids (node-equal? x))
  376. ; (sxpath1 '(eq? x)) -> (select-kids (node-eq? x))
  377. ; (sxpath1 ?symbol) -> (select-kids (node-typeof? ?symbol)
  378. ; (sxpath1 procedure) -> procedure
  379. ; (sxpath1 '(?symbol ...)) -> (sxpath1 '((?symbol) ...))
  380. ; (sxpath1 '(path reducer ...)) ->
  381. ; (node-reduce (sxpath path) (sxpathr reducer) ...)
  382. ; (sxpathr number) -> (node-pos number)
  383. ; (sxpathr path-filter) -> (filter (sxpath path-filter))
  384. (define (sxpath path)
  385. (lambda (nodeset)
  386. (let loop ((nodeset nodeset) (path path))
  387. (cond
  388. ((null? path) nodeset)
  389. ((nodeset? nodeset)
  390. (map-union (sxpath path) nodeset))
  391. ((procedure? (car path))
  392. (loop ((car path) nodeset) (cdr path)))
  393. ((eq? '// (car path))
  394. (loop
  395. ((if (nodeset? nodeset) append cons) nodeset
  396. ((node-closure (node-typeof? '*any*)) nodeset))
  397. (cdr path)))
  398. ((symbol? (car path))
  399. (loop ((select-kids (node-typeof? (car path))) nodeset)
  400. (cdr path)))
  401. ((and (pair? (car path)) (eq? 'equal? (caar path)))
  402. (loop ((select-kids (apply node-equal? (cdar path))) nodeset)
  403. (cdr path)))
  404. ((and (pair? (car path)) (eq? 'eq? (caar path)))
  405. (loop ((select-kids (apply node-eq? (cdar path))) nodeset)
  406. (cdr path)))
  407. ((pair? (car path))
  408. (let reducer ((nodeset
  409. (if (symbol? (caar path))
  410. ((select-kids (node-typeof? (caar path))) nodeset)
  411. (loop nodeset (caar path))))
  412. (reducing-path (cdar path)))
  413. (cond
  414. ((null? reducing-path) (loop nodeset (cdr path)))
  415. ((number? (car reducing-path))
  416. (reducer ((node-pos (car reducing-path)) nodeset)
  417. (cdr reducing-path)))
  418. (else
  419. (reducer ((filter (sxpath (car reducing-path))) nodeset)
  420. (cdr reducing-path))))))
  421. (else
  422. (error "Invalid path step: " (car path)))
  423. ))))
  424. ;------------------------------------------------------------------------
  425. ; Sample XPath/SXPath expressions: regression test suite for the
  426. ; implementation above.
  427. ; A running example
  428. (define tree1
  429. '(html
  430. (head (title "Slides"))
  431. (body
  432. (p (@ (align "center"))
  433. (table (@ (style "font-size: x-large"))
  434. (tr
  435. (td (@ (align "right")) "Talks ")
  436. (td (@ (align "center")) " = ")
  437. (td " slides + transition"))
  438. (tr (td)
  439. (td (@ (align "center")) " = ")
  440. (td " data + control"))
  441. (tr (td)
  442. (td (@ (align "center")) " = ")
  443. (td " programs"))))
  444. (ul
  445. (li (a (@ (href "slides/slide0001.gif")) "Introduction"))
  446. (li (a (@ (href "slides/slide0010.gif")) "Summary")))
  447. )))
  448. ; Example from a posting "Re: DrScheme and XML",
  449. ; Shriram Krishnamurthi, comp.lang.scheme, Nov. 26. 1999.
  450. ; http://www.deja.com/getdoc.xp?AN=553507805
  451. (define tree3
  452. '(poem (@ (title "The Lovesong of J. Alfred Prufrock")
  453. (poet "T. S. Eliot"))
  454. (stanza
  455. (line "Let us go then, you and I,")
  456. (line "When the evening is spread out against the sky")
  457. (line "Like a patient etherized upon a table:"))
  458. (stanza
  459. (line "In the room the women come and go")
  460. (line "Talking of Michaelangelo."))))
  461. ; Validation Test harness
  462. (define-syntax run-test
  463. (syntax-rules (define)
  464. ((run-test "scan-exp" (define vars body))
  465. (define vars (run-test "scan-exp" body)))
  466. ((run-test "scan-exp" ?body)
  467. (letrec-syntax
  468. ((scan-exp ; (scan-exp body k)
  469. (syntax-rules (quote quasiquote !)
  470. ((scan-exp '() (k-head ! . args))
  471. (k-head '() . args))
  472. ((scan-exp (quote (hd . tl)) k)
  473. (scan-lit-lst (hd . tl) (do-wrap ! quasiquote k)))
  474. ((scan-exp (quasiquote (hd . tl)) k)
  475. (scan-lit-lst (hd . tl) (do-wrap ! quasiquote k)))
  476. ((scan-exp (quote x) (k-head ! . args))
  477. (k-head
  478. (if (string? (quote x)) (string->symbol (quote x)) (quote x))
  479. . args))
  480. ((scan-exp (hd . tl) k)
  481. (scan-exp hd (do-tl ! scan-exp tl k)))
  482. ((scan-exp x (k-head ! . args))
  483. (k-head x . args))))
  484. (do-tl
  485. (syntax-rules (!)
  486. ((do-tl processed-hd fn () (k-head ! . args))
  487. (k-head (processed-hd) . args))
  488. ((do-tl processed-hd fn old-tl k)
  489. (fn old-tl (do-cons ! processed-hd k)))))
  490. (do-cons
  491. (syntax-rules (!)
  492. ((do-cons processed-tl processed-hd (k-head ! . args))
  493. (k-head (processed-hd . processed-tl) . args))))
  494. (do-wrap
  495. (syntax-rules (!)
  496. ((do-wrap val fn (k-head ! . args))
  497. (k-head (fn val) . args))))
  498. (do-finish
  499. (syntax-rules ()
  500. ((do-finish new-body) new-body)))
  501. (scan-lit-lst ; scan literal list
  502. (syntax-rules (quote unquote unquote-splicing !)
  503. ((scan-lit-lst '() (k-head ! . args))
  504. (k-head '() . args))
  505. ((scan-lit-lst (quote (hd . tl)) k)
  506. (do-tl quote scan-lit-lst ((hd . tl)) k))
  507. ((scan-lit-lst (unquote x) k)
  508. (scan-exp x (do-wrap ! unquote k)))
  509. ((scan-lit-lst (unquote-splicing x) k)
  510. (scan-exp x (do-wrap ! unquote-splicing k)))
  511. ((scan-lit-lst (quote x) (k-head ! . args))
  512. (k-head
  513. ,(if (string? (quote x)) (string->symbol (quote x)) (quote x))
  514. . args))
  515. ((scan-lit-lst (hd . tl) k)
  516. (scan-lit-lst hd (do-tl ! scan-lit-lst tl k)))
  517. ((scan-lit-lst x (k-head ! . args))
  518. (k-head x . args))))
  519. )
  520. (scan-exp ?body (do-finish !))))
  521. ((run-test body ...)
  522. (begin
  523. (run-test "scan-exp" body) ...))
  524. ))
  525. ; Overwrite the above macro to switch the tests off
  526. ; (define-macro (run-test selector node expected-result) #f)
  527. ; Location path, full form: child::para
  528. ; Location path, abbreviated form: para
  529. ; selects the para element children of the context node
  530. (let ((tree
  531. '(elem (@) (para (@) "para") (br (@)) "cdata" (para (@) "second par"))
  532. )
  533. (expected '((para (@) "para") (para (@) "second par")))
  534. )
  535. (run-test (select-kids (node-typeof? 'para)) tree expected)
  536. (run-test (sxpath '(para)) tree expected)
  537. )
  538. ; Location path, full form: child::*
  539. ; Location path, abbreviated form: *
  540. ; selects all element children of the context node
  541. (let ((tree
  542. '(elem (@) (para (@) "para") (br (@)) "cdata" (para "second par"))
  543. )
  544. (expected
  545. '((para (@) "para") (br (@)) (para "second par")))
  546. )
  547. (run-test (select-kids (node-typeof? '*)) tree expected)
  548. (run-test (sxpath '(*)) tree expected)
  549. )
  550. ; Location path, full form: child::text()
  551. ; Location path, abbreviated form: text()
  552. ; selects all text node children of the context node
  553. (let ((tree
  554. '(elem (@) (para (@) "para") (br (@)) "cdata" (para "second par"))
  555. )
  556. (expected
  557. '("cdata"))
  558. )
  559. (run-test (select-kids (node-typeof? '*text*)) tree expected)
  560. (run-test (sxpath '(*text*)) tree expected)
  561. )
  562. ; Location path, full form: child::node()
  563. ; Location path, abbreviated form: node()
  564. ; selects all the children of the context node, whatever their node type
  565. (let* ((tree
  566. '(elem (@) (para (@) "para") (br (@)) "cdata" (para "second par"))
  567. )
  568. (expected (cdr tree))
  569. )
  570. (run-test (select-kids (node-typeof? '*any*)) tree expected)
  571. (run-test (sxpath '(*any*)) tree expected)
  572. )
  573. ; Location path, full form: child::*/child::para
  574. ; Location path, abbreviated form: */para
  575. ; selects all para grandchildren of the context node
  576. (let ((tree
  577. '(elem (@) (para (@) "para") (br (@)) "cdata" (para "second par")
  578. (div (@ (name "aa")) (para "third para")))
  579. )
  580. (expected
  581. '((para "third para")))
  582. )
  583. (run-test
  584. (node-join (select-kids (node-typeof? '*))
  585. (select-kids (node-typeof? 'para)))
  586. tree expected)
  587. (run-test (sxpath '(* para)) tree expected)
  588. )
  589. ; Location path, full form: attribute::name
  590. ; Location path, abbreviated form: @name
  591. ; selects the 'name' attribute of the context node
  592. (let ((tree
  593. '(elem (@ (name "elem") (id "idz"))
  594. (para (@) "para") (br (@)) "cdata" (para (@) "second par")
  595. (div (@ (name "aa")) (para (@) "third para")))
  596. )
  597. (expected
  598. '((name "elem")))
  599. )
  600. (run-test
  601. (node-join (select-kids (node-typeof? '@))
  602. (select-kids (node-typeof? 'name)))
  603. tree expected)
  604. (run-test (sxpath '(@ name)) tree expected)
  605. )
  606. ; Location path, full form: attribute::*
  607. ; Location path, abbreviated form: @*
  608. ; selects all the attributes of the context node
  609. (let ((tree
  610. '(elem (@ (name "elem") (id "idz"))
  611. (para (@) "para") (br (@)) "cdata" (para "second par")
  612. (div (@ (name "aa")) (para (@) "third para")))
  613. )
  614. (expected
  615. '((name "elem") (id "idz")))
  616. )
  617. (run-test
  618. (node-join (select-kids (node-typeof? '@))
  619. (select-kids (node-typeof? '*)))
  620. tree expected)
  621. (run-test (sxpath '(@ *)) tree expected)
  622. )
  623. ; Location path, full form: descendant::para
  624. ; Location path, abbreviated form: .//para
  625. ; selects the para element descendants of the context node
  626. (let ((tree
  627. '(elem (@ (name "elem") (id "idz"))
  628. (para (@) "para") (br (@)) "cdata" (para "second par")
  629. (div (@ (name "aa")) (para (@) "third para")))
  630. )
  631. (expected
  632. '((para (@) "para") (para "second par") (para (@) "third para")))
  633. )
  634. (run-test
  635. (node-closure (node-typeof? 'para))
  636. tree expected)
  637. (run-test (sxpath '(// para)) tree expected)
  638. )
  639. ; Location path, full form: self::para
  640. ; Location path, abbreviated form: _none_
  641. ; selects the context node if it is a para element; otherwise selects nothing
  642. (let ((tree
  643. '(elem (@ (name "elem") (id "idz"))
  644. (para (@) "para") (br (@)) "cdata" (para "second par")
  645. (div (@ (name "aa")) (para (@) "third para")))
  646. )
  647. )
  648. (run-test (node-self (node-typeof? 'para)) tree '())
  649. (run-test (node-self (node-typeof? 'elem)) tree (list tree))
  650. )
  651. ; Location path, full form: descendant-or-self::node()
  652. ; Location path, abbreviated form: //
  653. ; selects the context node, all the children (including attribute nodes)
  654. ; of the context node, and all the children of all the (element)
  655. ; descendants of the context node.
  656. ; This is _almost_ a powerset of the context node.
  657. (let* ((tree
  658. '(para (@ (name "elem") (id "idz"))
  659. (para (@) "para") (br (@)) "cdata" (para "second par")
  660. (div (@ (name "aa")) (para (@) "third para")))
  661. )
  662. (expected
  663. (cons tree
  664. (append (cdr tree)
  665. '((@) "para" (@) "second par"
  666. (@ (name "aa")) (para (@) "third para")
  667. (@) "third para"))))
  668. )
  669. (run-test
  670. (node-or
  671. (node-self (node-typeof? '*any*))
  672. (node-closure (node-typeof? '*any*)))
  673. tree expected)
  674. (run-test (sxpath '(//)) tree expected)
  675. )
  676. ; Location path, full form: ancestor::div
  677. ; Location path, abbreviated form: _none_
  678. ; selects all div ancestors of the context node
  679. ; This Location expression is equivalent to the following:
  680. ; /descendant-or-self::div[descendant::node() = curr_node]
  681. ; This shows that the ancestor:: axis is actually redundant. Still,
  682. ; it can be emulated as the following SXPath expression demonstrates.
  683. ; The insight behind "ancestor::div" -- selecting all "div" ancestors
  684. ; of the current node -- is
  685. ; S[ancestor::div] context_node =
  686. ; { y | y=subnode*(root), context_node=subnode(subnode*(y)),
  687. ; isElement(y), name(y) = "div" }
  688. ; We observe that
  689. ; { y | y=subnode*(root), pred(y) }
  690. ; can be expressed in SXPath as
  691. ; ((node-or (node-self pred) (node-closure pred)) root-node)
  692. ; The composite predicate 'isElement(y) & name(y) = "div"' corresponds to
  693. ; (node-self (node-typeof? 'div)) in SXPath. Finally, filter
  694. ; context_node=subnode(subnode*(y)) is tantamount to
  695. ; (node-closure (node-eq? context-node)), whereas node-reduce denotes the
  696. ; the composition of converters-predicates in the filtering context.
  697. (let*
  698. ((root
  699. '(div (@ (name "elem") (id "idz"))
  700. (para (@) "para") (br (@)) "cdata" (para (@) "second par")
  701. (div (@ (name "aa")) (para (@) "third para"))))
  702. (context-node ; /descendant::any()[child::text() == "third para"]
  703. (car
  704. ((node-closure
  705. (select-kids
  706. (node-equal? "third para")))
  707. root)))
  708. (pred
  709. (node-reduce (node-self (node-typeof? 'div))
  710. (node-closure (node-eq? context-node))
  711. ))
  712. )
  713. (run-test
  714. (node-or
  715. (node-self pred)
  716. (node-closure pred))
  717. root
  718. (cons root
  719. '((div (@ (name "aa")) (para (@) "third para")))))
  720. )
  721. ; Location path, full form: child::div/descendant::para
  722. ; Location path, abbreviated form: div//para
  723. ; selects the para element descendants of the div element
  724. ; children of the context node
  725. (let ((tree
  726. '(elem (@ (name "elem") (id "idz"))
  727. (para (@) "para") (br (@)) "cdata" (para "second par")
  728. (div (@ (name "aa")) (para (@) "third para")
  729. (div (para "fourth para"))))
  730. )
  731. (expected
  732. '((para (@) "third para") (para "fourth para")))
  733. )
  734. (run-test
  735. (node-join
  736. (select-kids (node-typeof? 'div))
  737. (node-closure (node-typeof? 'para)))
  738. tree expected)
  739. (run-test (sxpath '(div // para)) tree expected)
  740. )
  741. ; Location path, full form: /descendant::olist/child::item
  742. ; Location path, abbreviated form: //olist/item
  743. ; selects all the item elements that have an olist parent (which is not root)
  744. ; and that are in the same document as the context node
  745. ; See the following test.
  746. ; Location path, full form: /descendant::td/attribute::align
  747. ; Location path, abbreviated form: //td/@align
  748. ; Selects 'align' attributes of all 'td' elements in tree1
  749. (let ((tree tree1)
  750. (expected
  751. '((align "right") (align "center") (align "center") (align "center"))
  752. ))
  753. (run-test
  754. (node-join
  755. (node-closure (node-typeof? 'td))
  756. (select-kids (node-typeof? '@))
  757. (select-kids (node-typeof? 'align)))
  758. tree expected)
  759. (run-test (sxpath '(// td @ align)) tree expected)
  760. )
  761. ; Location path, full form: /descendant::td[attribute::align]
  762. ; Location path, abbreviated form: //td[@align]
  763. ; Selects all td elements that have an attribute 'align' in tree1
  764. (let ((tree tree1)
  765. (expected
  766. '((td (@ (align "right")) "Talks ") (td (@ (align "center")) " = ")
  767. (td (@ (align "center")) " = ") (td (@ (align "center")) " = "))
  768. ))
  769. (run-test
  770. (node-reduce
  771. (node-closure (node-typeof? 'td))
  772. (filter
  773. (node-join
  774. (select-kids (node-typeof? '@))
  775. (select-kids (node-typeof? 'align)))))
  776. tree expected)
  777. (run-test (sxpath `(// td ,(node-self (sxpath '(@ align))))) tree expected)
  778. (run-test (sxpath '(// (td (@ align)))) tree expected)
  779. (run-test (sxpath '(// ((td) (@ align)))) tree expected)
  780. ; note! (sxpath ...) is a converter. Therefore, it can be used
  781. ; as any other converter, for example, in the full-form SXPath.
  782. ; Thus we can mix the full and abbreviated form SXPath's freely.
  783. (run-test
  784. (node-reduce
  785. (node-closure (node-typeof? 'td))
  786. (filter
  787. (sxpath '(@ align))))
  788. tree expected)
  789. )
  790. ; Location path, full form: /descendant::td[attribute::align = "right"]
  791. ; Location path, abbreviated form: //td[@align = "right"]
  792. ; Selects all td elements that have an attribute align = "right" in tree1
  793. (let ((tree tree1)
  794. (expected
  795. '((td (@ (align "right")) "Talks "))
  796. ))
  797. (run-test
  798. (node-reduce
  799. (node-closure (node-typeof? 'td))
  800. (filter
  801. (node-join
  802. (select-kids (node-typeof? '@))
  803. (select-kids (node-equal? '(align "right"))))))
  804. tree expected)
  805. (run-test (sxpath '(// (td (@ (equal? (align "right")))))) tree expected)
  806. )
  807. ; Location path, full form: child::para[position()=1]
  808. ; Location path, abbreviated form: para[1]
  809. ; selects the first para child of the context node
  810. (let ((tree
  811. '(elem (@ (name "elem") (id "idz"))
  812. (para (@) "para") (br (@)) "cdata" (para "second par")
  813. (div (@ (name "aa")) (para (@) "third para")))
  814. )
  815. (expected
  816. '((para (@) "para"))
  817. ))
  818. (run-test
  819. (node-reduce
  820. (select-kids (node-typeof? 'para))
  821. (node-pos 1))
  822. tree expected)
  823. (run-test (sxpath '((para 1))) tree expected)
  824. )
  825. ; Location path, full form: child::para[position()=last()]
  826. ; Location path, abbreviated form: para[last()]
  827. ; selects the last para child of the context node
  828. (let ((tree
  829. '(elem (@ (name "elem") (id "idz"))
  830. (para (@) "para") (br (@)) "cdata" (para "second par")
  831. (div (@ (name "aa")) (para (@) "third para")))
  832. )
  833. (expected
  834. '((para "second par"))
  835. ))
  836. (run-test
  837. (node-reduce
  838. (select-kids (node-typeof? 'para))
  839. (node-pos -1))
  840. tree expected)
  841. (run-test (sxpath '((para -1))) tree expected)
  842. )
  843. ; Illustrating the following Note of Sec 2.5 of XPath:
  844. ; "NOTE: The location path //para[1] does not mean the same as the
  845. ; location path /descendant::para[1]. The latter selects the first
  846. ; descendant para element; the former selects all descendant para
  847. ; elements that are the first para children of their parents."
  848. (let ((tree
  849. '(elem (@ (name "elem") (id "idz"))
  850. (para (@) "para") (br (@)) "cdata" (para "second par")
  851. (div (@ (name "aa")) (para (@) "third para")))
  852. )
  853. )
  854. (run-test
  855. (node-reduce ; /descendant::para[1] in SXPath
  856. (node-closure (node-typeof? 'para))
  857. (node-pos 1))
  858. tree '((para (@) "para")))
  859. (run-test (sxpath '(// (para 1))) tree
  860. '((para (@) "para") (para (@) "third para")))
  861. )
  862. ; Location path, full form: parent::node()
  863. ; Location path, abbreviated form: ..
  864. ; selects the parent of the context node. The context node may be
  865. ; an attribute node!
  866. ; For the last test:
  867. ; Location path, full form: parent::*/attribute::name
  868. ; Location path, abbreviated form: ../@name
  869. ; Selects the name attribute of the parent of the context node
  870. (let* ((tree
  871. '(elem (@ (name "elem") (id "idz"))
  872. (para (@) "para") (br (@)) "cdata" (para "second par")
  873. (div (@ (name "aa")) (para (@) "third para")))
  874. )
  875. (para1 ; the first para node
  876. (car ((sxpath '(para)) tree)))
  877. (para3 ; the third para node
  878. (car ((sxpath '(div para)) tree)))
  879. (div ; div node
  880. (car ((sxpath '(// div)) tree)))
  881. )
  882. (run-test
  883. (node-parent tree)
  884. para1 (list tree))
  885. (run-test
  886. (node-parent tree)
  887. para3 (list div))
  888. (run-test ; checking the parent of an attribute node
  889. (node-parent tree)
  890. ((sxpath '(@ name)) div) (list div))
  891. (run-test
  892. (node-join
  893. (node-parent tree)
  894. (select-kids (node-typeof? '@))
  895. (select-kids (node-typeof? 'name)))
  896. para3 '((name "aa")))
  897. (run-test
  898. (sxpath `(,(node-parent tree) @ name))
  899. para3 '((name "aa")))
  900. )
  901. ; Location path, full form: following-sibling::chapter[position()=1]
  902. ; Location path, abbreviated form: none
  903. ; selects the next chapter sibling of the context node
  904. ; The path is equivalent to
  905. ; let cnode = context-node
  906. ; in
  907. ; parent::* / child::chapter [take-after node_eq(self::*,cnode)]
  908. ; [position()=1]
  909. (let* ((tree
  910. '(document
  911. (preface "preface")
  912. (chapter (@ (id "one")) "Chap 1 text")
  913. (chapter (@ (id "two")) "Chap 2 text")
  914. (chapter (@ (id "three")) "Chap 3 text")
  915. (chapter (@ (id "four")) "Chap 4 text")
  916. (epilogue "Epilogue text")
  917. (appendix (@ (id "A")) "App A text")
  918. (References "References"))
  919. )
  920. (a-node ; to be used as a context node
  921. (car ((sxpath '(// (chapter (@ (equal? (id "two")))))) tree)))
  922. (expected
  923. '((chapter (@ (id "three")) "Chap 3 text")))
  924. )
  925. (run-test
  926. (node-reduce
  927. (node-join
  928. (node-parent tree)
  929. (select-kids (node-typeof? 'chapter)))
  930. (take-after (node-eq? a-node))
  931. (node-pos 1)
  932. )
  933. a-node expected)
  934. )
  935. ; preceding-sibling::chapter[position()=1]
  936. ; selects the previous chapter sibling of the context node
  937. ; The path is equivalent to
  938. ; let cnode = context-node
  939. ; in
  940. ; parent::* / child::chapter [take-until node_eq(self::*,cnode)]
  941. ; [position()=-1]
  942. (let* ((tree
  943. '(document
  944. (preface "preface")
  945. (chapter (@ (id "one")) "Chap 1 text")
  946. (chapter (@ (id "two")) "Chap 2 text")
  947. (chapter (@ (id "three")) "Chap 3 text")
  948. (chapter (@ (id "four")) "Chap 4 text")
  949. (epilogue "Epilogue text")
  950. (appendix (@ (id "A")) "App A text")
  951. (References "References"))
  952. )
  953. (a-node ; to be used as a context node
  954. (car ((sxpath '(// (chapter (@ (equal? (id "three")))))) tree)))
  955. (expected
  956. '((chapter (@ (id "two")) "Chap 2 text")))
  957. )
  958. (run-test
  959. (node-reduce
  960. (node-join
  961. (node-parent tree)
  962. (select-kids (node-typeof? 'chapter)))
  963. (take-until (node-eq? a-node))
  964. (node-pos -1)
  965. )
  966. a-node expected)
  967. )
  968. ; /descendant::figure[position()=42]
  969. ; selects the forty-second figure element in the document
  970. ; See the next example, which is more general.
  971. ; Location path, full form:
  972. ; child::table/child::tr[position()=2]/child::td[position()=3]
  973. ; Location path, abbreviated form: table/tr[2]/td[3]
  974. ; selects the third td of the second tr of the table
  975. (let ((tree ((node-closure (node-typeof? 'p)) tree1))
  976. (expected
  977. '((td " data + control"))
  978. ))
  979. (run-test
  980. (node-join
  981. (select-kids (node-typeof? 'table))
  982. (node-reduce (select-kids (node-typeof? 'tr))
  983. (node-pos 2))
  984. (node-reduce (select-kids (node-typeof? 'td))
  985. (node-pos 3)))
  986. tree expected)
  987. (run-test (sxpath '(table (tr 2) (td 3))) tree expected)
  988. )
  989. ; Location path, full form:
  990. ; child::para[attribute::type='warning'][position()=5]
  991. ; Location path, abbreviated form: para[@type='warning'][5]
  992. ; selects the fifth para child of the context node that has a type
  993. ; attribute with value warning
  994. (let ((tree
  995. '(chapter
  996. (para "para1")
  997. (para (@ (type "warning")) "para 2")
  998. (para (@ (type "warning")) "para 3")
  999. (para (@ (type "warning")) "para 4")
  1000. (para (@ (type "warning")) "para 5")
  1001. (para (@ (type "warning")) "para 6"))
  1002. )
  1003. (expected
  1004. '((para (@ (type "warning")) "para 6"))
  1005. ))
  1006. (run-test
  1007. (node-reduce
  1008. (select-kids (node-typeof? 'para))
  1009. (filter
  1010. (node-join
  1011. (select-kids (node-typeof? '@))
  1012. (select-kids (node-equal? '(type "warning")))))
  1013. (node-pos 5))
  1014. tree expected)
  1015. (run-test (sxpath '( (((para (@ (equal? (type "warning"))))) 5 ) ))
  1016. tree expected)
  1017. (run-test (sxpath '( (para (@ (equal? (type "warning"))) 5 ) ))
  1018. tree expected)
  1019. )
  1020. ; Location path, full form:
  1021. ; child::para[position()=5][attribute::type='warning']
  1022. ; Location path, abbreviated form: para[5][@type='warning']
  1023. ; selects the fifth para child of the context node if that child has a 'type'
  1024. ; attribute with value warning
  1025. (let ((tree
  1026. '(chapter
  1027. (para "para1")
  1028. (para (@ (type "warning")) "para 2")
  1029. (para (@ (type "warning")) "para 3")
  1030. (para (@ (type "warning")) "para 4")
  1031. (para (@ (type "warning")) "para 5")
  1032. (para (@ (type "warning")) "para 6"))
  1033. )
  1034. (expected
  1035. '((para (@ (type "warning")) "para 5"))
  1036. ))
  1037. (run-test
  1038. (node-reduce
  1039. (select-kids (node-typeof? 'para))
  1040. (node-pos 5)
  1041. (filter
  1042. (node-join
  1043. (select-kids (node-typeof? '@))
  1044. (select-kids (node-equal? '(type "warning"))))))
  1045. tree expected)
  1046. (run-test (sxpath '( (( (para 5)) (@ (equal? (type "warning"))))))
  1047. tree expected)
  1048. (run-test (sxpath '( (para 5 (@ (equal? (type "warning")))) ))
  1049. tree expected)
  1050. )
  1051. ; Location path, full form:
  1052. ; child::*[self::chapter or self::appendix]
  1053. ; Location path, semi-abbreviated form: *[self::chapter or self::appendix]
  1054. ; selects the chapter and appendix children of the context node
  1055. (let ((tree
  1056. '(document
  1057. (preface "preface")
  1058. (chapter (@ (id "one")) "Chap 1 text")
  1059. (chapter (@ (id "two")) "Chap 2 text")
  1060. (chapter (@ (id "three")) "Chap 3 text")
  1061. (epilogue "Epilogue text")
  1062. (appendix (@ (id "A")) "App A text")
  1063. (References "References"))
  1064. )
  1065. (expected
  1066. '((chapter (@ (id "one")) "Chap 1 text")
  1067. (chapter (@ (id "two")) "Chap 2 text")
  1068. (chapter (@ (id "three")) "Chap 3 text")
  1069. (appendix (@ (id "A")) "App A text"))
  1070. ))
  1071. (run-test
  1072. (node-join
  1073. (select-kids (node-typeof? '*))
  1074. (filter
  1075. (node-or
  1076. (node-self (node-typeof? 'chapter))
  1077. (node-self (node-typeof? 'appendix)))))
  1078. tree expected)
  1079. (run-test (sxpath `(* ,(node-or (node-self (node-typeof? 'chapter))
  1080. (node-self (node-typeof? 'appendix)))))
  1081. tree expected)
  1082. )
  1083. ; Location path, full form: child::chapter[child::title='Introduction']
  1084. ; Location path, abbreviated form: chapter[title = 'Introduction']
  1085. ; selects the chapter children of the context node that have one or more
  1086. ; title children with string-value equal to Introduction
  1087. ; See a similar example: //td[@align = "right"] above.
  1088. ; Location path, full form: child::chapter[child::title]
  1089. ; Location path, abbreviated form: chapter[title]
  1090. ; selects the chapter children of the context node that have one or
  1091. ; more title children
  1092. ; See a similar example //td[@align] above.
  1093. (cerr nl "Example with tree3: extracting the first lines of every stanza" nl)
  1094. (let ((tree tree3)
  1095. (expected
  1096. '("Let us go then, you and I," "In the room the women come and go")
  1097. ))
  1098. (run-test
  1099. (node-join
  1100. (node-closure (node-typeof? 'stanza))
  1101. (node-reduce
  1102. (select-kids (node-typeof? 'line)) (node-pos 1))
  1103. (select-kids (node-typeof? '*text*)))
  1104. tree expected)
  1105. (run-test (sxpath '(// stanza (line 1) *text*)) tree expected)
  1106. )