diff options
Diffstat (limited to '')
-rw-r--r-- | module/sxml/namespaced.scm | 12 | ||||
-rw-r--r-- | module/sxml/namespaced/util.scm | 45 |
2 files changed, 55 insertions, 2 deletions
diff --git a/module/sxml/namespaced.scm b/module/sxml/namespaced.scm index 846f8f25..e5a334da 100644 --- a/module/sxml/namespaced.scm +++ b/module/sxml/namespaced.scm @@ -15,10 +15,13 @@ namespaced-sxml->sxml/namespaces sxml->namespaced-sxml xml + attribute make-xml-element xml-element? - xml-element-tagname xml-element-namespace xml-element-attributes + xml-element-tagname + xml-element-namespace + xml-element-attributes make-pi-element pi-element? @@ -52,6 +55,9 @@ ((ns tag) (make-xml-element tag ns '())) ((ns tag attrs) (make-xml-element tag ns attrs)))) +(define (attribute xml attr) + (assoc-ref (xml-element-attributes xml) attr)) + (define* (parser key: trim-whitespace?) (ssax:make-parser @@ -226,7 +232,8 @@ (define* (namespaced-sxml->xml tree key: (namespaces '()) (port (current-output-port))) - ((@ (sxml simple) sxml->xml) (namespaced-sxml->sxml tree namespaces) port)) + ((@ (sxml simple) sxml->xml) + (namespaced-sxml->sxml tree namespaces) port)) ;; Takes a tree of namespaced-sxml, and optionally an assoc list from namespace symbols, to prefered prefix. ;; Returns two values: a sxml tree without declared namespaces @@ -256,3 +263,4 @@ ;;; TODO Figure out how to still use (sxml match) and (sxml xpath) with these ;;; new trees (probably rewriting to a "regular" sxml tree, and keeping ;;; a strict mapping of namespaces) + diff --git a/module/sxml/namespaced/util.scm b/module/sxml/namespaced/util.scm new file mode 100644 index 00000000..6f93e362 --- /dev/null +++ b/module/sxml/namespaced/util.scm @@ -0,0 +1,45 @@ +(define-module (sxml namespaced util) + :use-module (sxml namespaced) + :use-module (srfi srfi-1) + :use-module ((ice-9 control) :select (call/ec)) + :export (xml-element-hash-key + find-element + element-matches? + on-root-element + root-element + )) + +(define (xml-element-hash-key tag) + "Returns a value suitable as a key to hash-ref (and family)" + (cons (xml-element-namespace tag) + (xml-element-tagname tag))) + +(define (find-element target list) + (define target* (xml-element-hash-key target)) + (find (lambda (x) (and (list? x) + (not (null? x)) + (xml-element? (car x)) + (equal? target* (xml-element-hash-key (car x))))) + list)) + + +(define (element-matches? target-el tree) + (and (not (null? tree)) + (equal? + (xml-element-hash-key target-el) + (xml-element-hash-key (car tree))))) + + +(define (on-root-element proc tree) + (cond ((and (eq? '*TOP* (car tree)) + (pi-element? (cadr tree))) + (cons* (car tree) (cadr tree) + (proc (caddr tree)))) + ((eq? '*TOP* (car tree)) + (cons (car tree) + (proc (cadr tree)))) + (else (proc (car tree))))) + +(define (root-element tree) + (call/ec (lambda (return) + (on-root-element return tree)))) |