1 | ;; |
---|
2 | ;; SXML.scm |
---|
3 | ;; |
---|
4 | ;; Auxilliary functions for SXML manipulation. |
---|
5 | ;; |
---|
6 | ;; Copyright Ivan Raikov and the Okinawa Institute of Science and Technology |
---|
7 | ;; |
---|
8 | ;; This program is free software: you can redistribute it and/or |
---|
9 | ;; modify it under the terms of the GNU General Public License as |
---|
10 | ;; published by the Free Software Foundation, either version 3 of the |
---|
11 | ;; License, or (at your option) any later version. |
---|
12 | ;; |
---|
13 | ;; This program is distributed in the hope that it will be useful, but |
---|
14 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
16 | ;; General Public License for more details. |
---|
17 | ;; |
---|
18 | ;; A full copy of the GPL license can be found at |
---|
19 | ;; <http://www.gnu.org/licenses/>. |
---|
20 | ;; |
---|
21 | |
---|
22 | (require-extension srfi-1) |
---|
23 | (require-extension sxml-tools) |
---|
24 | (include "stx-macros.scm") |
---|
25 | |
---|
26 | |
---|
27 | ;; obtain the first non-attribute child |
---|
28 | (define (sxml:kid node) |
---|
29 | (let ((v ((select-first-kid (lambda (x) (not (eq? (car x) '@)))) node))) |
---|
30 | (if (not v) (error 'sxml:kid "node does not have children" node) v))) |
---|
31 | |
---|
32 | ;; obtain all non-attribute children of a node |
---|
33 | (define (sxml:kids node) |
---|
34 | ((select-kids (lambda (x) (not (eq? (car x) '@)))) node)) |
---|
35 | |
---|
36 | ;; obtain all children of a node named n |
---|
37 | (define (sxml:kidsn name node) |
---|
38 | ((select-kids (lambda (x) (eq? (car x) name))) node)) |
---|
39 | |
---|
40 | ;; obtain child named n of a node |
---|
41 | (define (sxml:kidn name node) |
---|
42 | ((select-first-kid (lambda (x) (eq? (car x) name))) node)) |
---|
43 | |
---|
44 | ;; obtain non-empty child named n of a node |
---|
45 | (define (sxml:kidn* name node) |
---|
46 | ((select-first-kid (lambda (x) (and (eq? (car x) name) (not (null? (cdr x)))))) node)) |
---|
47 | |
---|
48 | ;; obtain the cdr of child named n |
---|
49 | (define (sxml:kidn-cdr name node) |
---|
50 | (let ((v ((select-first-kid (lambda (x) (eq? (car x) name))) node))) |
---|
51 | (if (not v) (error 'sxml-kidn-cdr "node does not have children" node) (cdr v)))) |
---|
52 | |
---|
53 | |
---|
54 | ;; obtain the cadr of child named n |
---|
55 | (define (sxml:kidn-cadr name node) |
---|
56 | (let ((v ((select-first-kid (lambda (x) (eq? (car x) name))) node))) |
---|
57 | (if (not v) (error 'sxml:kidn-cadr "node does not have children" node) (cadr v)))) |
---|
58 | |
---|
59 | (define (sxml:if-number x) |
---|
60 | (and x (sxml:number x))) |
---|
61 | |
---|
62 | (define (sxml:attrv name node . lst) |
---|
63 | (if (null? lst) (sxml:attr node name) |
---|
64 | (map (lambda (node) (sxml:attr node name)) (cons node lst)))) |
---|
65 | |
---|
66 | |
---|
67 | |
---|
68 | |
---|