65 lines
2.3 KiB
Common Lisp
65 lines
2.3 KiB
Common Lisp
;;;; cl-xml.lisp
|
|
|
|
(in-package #:cl-xml)
|
|
|
|
(defun tagp (exp)
|
|
(symbolp (car exp)))
|
|
|
|
(defun print-contents (contents indentation stream)
|
|
"Print the contents of a tag with correct indentation. Every element in CONTENTS is on a separate line."
|
|
(mapc (lambda (s) (format stream "~a~a~%" indentation s)) contents))
|
|
|
|
(defun next-tags (list)
|
|
"Get the next tags in the tree."
|
|
(cond ((null list) nil)
|
|
((eq 'cons (type-of (car list))) list)
|
|
(t (next-tags (cdr list)))))
|
|
|
|
(defun handle-keywords (keywords)
|
|
"Turn keyword-value pairs on the form :key \"value\" into key=\"value\"."
|
|
(cond ((or (null keywords)
|
|
(consp (car keywords)))
|
|
"")
|
|
((keywordp (car keywords))
|
|
(format nil " ~a=\"~a\"~a"
|
|
(string-downcase (symbol-name (car keywords)))
|
|
(cadr keywords)
|
|
(handle-keywords (cddr keywords))))))
|
|
|
|
(defun indentation (level)
|
|
"Create a string of LEVEL length consisting of spaces."
|
|
(make-string level :initial-element #\Space))
|
|
|
|
(defun sexp-to-xml (sexp indentation-level &optional (stream t))
|
|
"Turn an s-expression into an xml form."
|
|
(cond ((null sexp) nil)
|
|
((stringp (car sexp)) (print-contents sexp (indentation indentation-level) stream))
|
|
((consp (car sexp))
|
|
(sexp-to-xml (car sexp) (1+ indentation-level) stream)
|
|
(sexp-to-xml (cdr sexp) indentation-level stream))
|
|
((tagp sexp)
|
|
(let ((tag-name (string-downcase (symbol-name (car sexp))))
|
|
(spaces (indentation indentation-level)))
|
|
(format stream "~a<~a~a>~%"
|
|
spaces
|
|
tag-name
|
|
(handle-keywords (cdr sexp)))
|
|
(let ((next-tags (next-tags (cdr sexp))))
|
|
(unless (null next-tags)
|
|
(sexp-to-xml next-tags (1+ indentation-level) stream)))
|
|
(format stream "~a</~a>~%" spaces tag-name)))))
|
|
|
|
(defmacro xml (form)
|
|
"Macro interface to SEXP-TO-XML."
|
|
(sexp-to-xml form 0))
|
|
|
|
(defun sexp-to-xml-string (form)
|
|
"Captures the output of SEXP-TO-XML into a string."
|
|
(with-open-stream (stream (make-string-output-stream))
|
|
(sexp-to-xml form 0 stream)
|
|
(get-output-stream-string stream)))
|
|
|
|
(defmacro xml-string (form)
|
|
"Macro interface to SEXP-TO-XML-STRING."
|
|
(sexp-to-xml-string form))
|