commit cc90f74b22539e5ffbe6667202d54b9cab9add02 Author: opfez Date: Tue Jul 13 19:33:20 2021 +0200 initial diff --git a/README.md b/README.md new file mode 100644 index 0000000..8e4b23b --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# cl-xml +### _Your Name _ + +This is a project to do ... something. + +## License + +Specify license here + diff --git a/cl-xml.asd b/cl-xml.asd new file mode 100644 index 0000000..6d60eb4 --- /dev/null +++ b/cl-xml.asd @@ -0,0 +1,10 @@ +;;;; cl-xml.asd + +(asdf:defsystem #:cl-xml + :description "Describe cl-xml here" + :author "Your Name " + :license "Specify license here" + :version "0.0.1" + :serial t + :components ((:file "package") + (:file "cl-xml"))) diff --git a/cl-xml.lisp b/cl-xml.lisp new file mode 100644 index 0000000..d01662c --- /dev/null +++ b/cl-xml.lisp @@ -0,0 +1,66 @@ +;;;; cl-xml.lisp + +;(in-package #:cl-xml) + +(declaim (optimize (debug 3))) + +(defun tagp (exp) + (symbolp (car exp))) + +(defun print-contents (contents indentation stream) + (mapc (lambda (s) (format stream "~a~a~%" indentation s)) contents)) + +(defun next-tags (list) + (cond ((null list) nil) + ((eq 'cons (type-of (car list))) list) + (t (next-tags (cdr list))))) + +(defun handle-keywords (keywords) + (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) + (labels ((create-indentation-string (count) + (if (= count 0) + '() + (cons " " (create-indentation-string (1- count)))))) + (let ((spaces (create-indentation-string level))) + (if (null spaces) + "" + (reduce (lambda (s1 s2) (concatenate 'string s1 s2)) + spaces))))) + +(defun sexp-to-xml (sexp indentation-level &optional (stream t)) + (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~%" spaces tag-name))))) + +(defmacro xml (form) + (sexp-to-xml form 0)) + +(defun sexp-to-xml-string (form) + (with-open-stream (stream (make-string-output-stream)) + (sexp-to-xml form 0 stream) + (get-output-stream-string stream))) + +(defmacro xml-string (form) + (sexp-to-xml-string form)) diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..84faad8 --- /dev/null +++ b/package.lisp @@ -0,0 +1,5 @@ +;;;; package.lisp + +(defpackage #:cl-xml + (:use #:cl) + (:export :xml))