diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-10 22:45:30 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-10 23:45:29 +0200 |
| commit | df9fa9743e5f56f932f919273b1811b63222f919 (patch) | |
| tree | b4b228b4248ad4b60fae3db62df5e744c39a7b32 | |
| parent | Add ->port. (diff) | |
| download | calp-df9fa9743e5f56f932f919273b1811b63222f919.tar.gz calp-df9fa9743e5f56f932f919273b1811b63222f919.tar.xz | |
Add (sxml util).
| -rw-r--r-- | module/sxml/util.scm | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/module/sxml/util.scm b/module/sxml/util.scm new file mode 100644 index 00000000..532141b2 --- /dev/null +++ b/module/sxml/util.scm @@ -0,0 +1,22 @@ +(define-module (sxml util) + :use-module (ice-9 match) + :export (get-root-element add-attributes)) + +(define (get-root-element tree) + (match tree + (('*TOP* ('*PI* 'xml body) (root . children)) + (lambda (modifier) `(*TOP* (*PI* xml ,body) + ,(modifier `(,root ,@children))))) + (('*TOP* (root . children)) + (lambda (modifier) `(*TOP* ,(modifier `(,root ,@children))))) + ((root . children) + (lambda (modifier) `(*TOP* ,(modifier `(,root ,@children))))))) + +(define (add-attributes element added-attributes) + (match element + ((el ('@ . attributes) . children) + `(,el (@ ,@attributes ,@added-attributes) + ,@children)) + ((el . children) + `(,el (@ ,@added-attributes) + ,@children)))) |