/lib/sml.arc
Unknown | 82 lines | 73 code | 9 blank | 0 comment | 0 complexity | 982fb926f8aaed86249529488af3d8ee MD5 | raw file
1;; 2;; Routines for manipulating sml 3;; 4;; sml is an S-Expression Meta Language for XML that looks like: 5;; 6;; (tagname attr "value" attr2 "value2" 7;; (tagname2) 8;; (tagname3 "data")) 9;; 10 11;; Convert S-Expression Meta Language to XML 12(def sml-pr-xml (tag (o indent 0)) 13 (with (name (sml-tag-name tag) 14 elements (sml-elements tag)) 15 (repeat indent (pr " ")) 16 (pr "<" name) 17 (sml-pr-attrs (sml-attrs tag)) 18 (if (is (len elements) 0) 19 (prn "/>") 20 (do 21 (prn ">") 22 (map [sml-pr-element _ (+ 2 indent)] elements) 23 (repeat indent (pr " ")) 24 (prn "</" name ">"))) 25 nil)) 26 27(def sml-tag-name (tag) 28 (car tag)) 29 30(def sml-attrs (tag) 31 (let rest (cdr tag) 32 (if (no rest) nil 33 (caris (car rest) '@) (cdr:car rest) ;; old format 34 (no (isa (car rest) 'sym)) nil 35 (cons (car rest) (cons (cadr rest) (sml-attrs (cdr rest))))))) 36 37(def sml-elements (tag) 38 (let rest (cdr tag) 39 (if (no rest) nil 40 (caris (car rest) '@) (cdr rest) ;; old format 41 (no (isa (car rest) 'sym)) rest 42 (sml-elements (cdr rest))))) 43 44(def sml-pr-attrs (attrs) 45 (when attrs 46 (pr " " (car attrs) "=\"") 47 (each c (string (cadr attrs)) 48 (pr (case c #\\ "\" 49 #\" """ 50 #\& "&" 51 c))) 52 (pr "\"") 53 (sml-pr-attrs (cddr attrs)))) 54 55(def sml-pr-element (el indent) 56 (if (is (type el) 'cons) (sml-pr-xml el indent) 57 (pr-escaped el))) 58 59(def sml-get-attr (tag name) 60 (sml-get-attr-from-attrs (sml-attrs tag) name)) 61 62(def sml-get-attr-from-attrs (attrs name) 63 (when attrs 64 (if (is (car attrs) name) (cadr attrs) 65 (sml-get-attr-from-attrs (cddr attrs) name)))) 66 67;; Pretty-print the S-Expression ML 68(def sml-ppr (tag (o indent 0)) 69 (prn) 70 (repeat indent (pr " ")) 71 (if (is (type tag) 'cons) 72 (with (name (car tag) 73 attrs (sml-attrs tag) 74 elements (sml-elements tag)) 75 (pr "(" name) 76 (each attr attrs (pr " ") (write attr)) 77 (each el elements (sml-ppr el (+ indent 2))) 78 (pr ")")) 79 (is (type tag) 'string) (write tag) 80 (is tag nil) (pr nil) 81 (err "Unrecognized type in sml:" (type tag))) 82 (if (is indent 0) (prn)))