diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-07-12 23:08:10 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-07-12 23:08:10 +0200 |
commit | bd401036e892b07e7f4c1a4ee41d0a30364385e0 (patch) | |
tree | 616eb872e6708a65a8477faa74a76c2d9696a134 /module | |
parent | Minor formatting changes. (diff) | |
download | calp-bd401036e892b07e7f4c1a4ee41d0a30364385e0.tar.gz calp-bd401036e892b07e7f4c1a4ee41d0a30364385e0.tar.xz |
Add initial (sxml namespace).
Diffstat (limited to 'module')
-rw-r--r-- | module/sxml/namespace.scm | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/module/sxml/namespace.scm b/module/sxml/namespace.scm new file mode 100644 index 00000000..4e364cad --- /dev/null +++ b/module/sxml/namespace.scm @@ -0,0 +1,39 @@ +(define-module (sxml namespace) + :use-module (util) + :use-module (sxml transform)) + +(define* (symbol-split symbol key: (sep #\:)) + (->> (-> symbol + symbol->string + (string-split sep)) + (map string->symbol) + (apply values))) + +(define (string-last string) + (string-ref string (1- (string-length string)))) + +;; sxml, (U symbol string #f) → sxml +;; NOTE possibly allow namespace to be a map between namespaces +(define-public (move-to-namespace sxml namespace) + + (define nssymb + (cond + [(not namespace) '#{}#] + [(symbol? namespace) + (if (char=? #\: (string-last (symbol->string namespace))) + namespace (symbol-append namespace ':))] + [(string? namespace) + (if (char=? #\: (string-last namespace)) + (string->symbol namespace) + (string->symbol (string-append namespace ":")))])) + + (define (ns tag) + (call-with-values (lambda () (symbol-split tag)) + (case-lambda + [(ns tag) (symbol-append nssymb tag)] + [(tag) (symbol-append nssymb tag)]))) + + (pre-post-order + sxml + `((*TOP* . ,list) (*PI* . ,list) (*text* . ,(lambda (tag text) text)) + (*default* . ,(lambda (tag . body) `(,(ns tag) . ,body)))))) |