/lib/sml.arc

http://github.com/alimoeeny/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. ;; Convert S-Expression Meta Language to XML
  11. (def sml-pr-xml (tag (o indent 0))
  12. (with (name (sml-tag-name tag)
  13. elements (sml-elements tag))
  14. (repeat indent (pr " "))
  15. (pr "<" name)
  16. (sml-pr-attrs (sml-attrs tag))
  17. (if (is (len elements) 0)
  18. (prn "/>")
  19. (do
  20. (prn ">")
  21. (map [sml-pr-element _ (+ 2 indent)] elements)
  22. (repeat indent (pr " "))
  23. (prn "</" name ">")))
  24. nil))
  25. (def sml-tag-name (tag)
  26. (car tag))
  27. (def sml-attrs (tag)
  28. (let rest (cdr tag)
  29. (if (no rest) nil
  30. (caris (car rest) '@) (cdr:car rest) ;; old format
  31. (no (isa (car rest) 'sym)) nil
  32. (cons (car rest) (cons (cadr rest) (sml-attrs (cdr rest)))))))
  33. (def sml-elements (tag)
  34. (let rest (cdr tag)
  35. (if (no rest) nil
  36. (caris (car rest) '@) (cdr rest) ;; old format
  37. (no (isa (car rest) 'sym)) rest
  38. (sml-elements (cdr rest)))))
  39. (def sml-pr-attrs (attrs)
  40. (when attrs
  41. (pr " " (car attrs) "=\"")
  42. (each c (string (cadr attrs))
  43. (pr (case c #\\ "&#x5c;"
  44. #\" "&#x22;"
  45. #\& "&amp;"
  46. c)))
  47. (pr "\"")
  48. (sml-pr-attrs (cddr attrs))))
  49. (def sml-pr-element (el indent)
  50. (if (is (type el) 'cons) (sml-pr-xml el indent)
  51. (pr-escaped el)))
  52. (def sml-get-attr (tag name)
  53. (sml-get-attr-from-attrs (sml-attrs tag) name))
  54. (def sml-get-attr-from-attrs (attrs name)
  55. (when attrs
  56. (if (is (car attrs) name) (cadr attrs)
  57. (sml-get-attr-from-attrs (cddr attrs) name))))
  58. ;; Pretty-print the S-Expression ML
  59. (def sml-ppr (tag (o indent 0))
  60. (prn)
  61. (repeat indent (pr " "))
  62. (if (is (type tag) 'cons)
  63. (with (name (car tag)
  64. attrs (sml-attrs tag)
  65. elements (sml-elements tag))
  66. (pr "(" name)
  67. (each attr attrs (pr " ") (write attr))
  68. (each el elements (sml-ppr el (+ indent 2)))
  69. (pr ")"))
  70. (is (type tag) 'string) (write tag)
  71. (is tag nil) (pr nil)
  72. (err "Unrecognized type in sml:" (type tag)))
  73. (if (is indent 0) (prn)))