From 6d397148565e581f9546b3b8dfb882a78890b60f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 18 Apr 2023 19:26:42 +0200 Subject: Utilities for namespaced sxml. --- module/sxml/namespaced/util.scm | 45 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 module/sxml/namespaced/util.scm (limited to 'module/sxml/namespaced/util.scm') 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)))) -- cgit v1.2.3