Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;;;; clisp html.lisp > index.html
- ;; sexp-format (name ((atribute value) ...) tag-body)
- ;; sgml-format <name atribute="value" ...>tag-body</name>
- (defvar *HTML*
- '(html ((lang en)) (head () (meta ((charset utf-8)))
- (meta
- ((name viewport)
- (content width=device-width)))
- (title () dom))
- (body ((style "color: #BBB; background: #555;"))
- (p () "<Hello, world!>")
- (a ((href "https://pastebin.com/mSKvS8qR") (target "_blank")) src))))
- (defun fmt-atributes (atributes)
- (cond ((null atributes)
- (format nil ""))
- ((= (length atributes) 1)
- (apply #'format nil "~a=\"~a\"" (car atributes)))
- (t (format nil "~a ~a" (apply #'format nil "~a=\"~a\""
- (car atributes)) (fmt-atributes (cdr atributes))))))
- (defun fmt-contents (list)
- (let ((tmp ""))
- (loop for element in list do
- (if (null element)
- '()
- (if (listp element)
- (setq tmp (format nil "~a~a" tmp (sexpr-to-xml element)))
- (setq tmp (format nil "~a~a" tmp element)))))
- tmp))
- (defun sxp-xml (name atributes &rest contents)
- (let ((*print-case* :downcase))
- (if (null contents)
- (format nil "<~s ~a />"
- name (fmt-atributes atributes))
- (format nil "<~s ~a>~a</~s>"
- name (fmt-atributes atributes)
- (fmt-contents contents) name))))
- (defun sexpr-to-xml (a) (apply #'sxp-xml a))
- (format t "<!DOCTYPE html>~A<!-- clisp html.lisp -->" (sexpr-to-xml *HTML*))
- ;;; prints
- ; <!DOCTYPE html><html lang="en"><head ><meta charset="utf-8" /><meta name="viewport" content="width=device-width" /><title >dom</title></head><body style="color: #BBB; background: #555;"><p ><Hello, world!></p><a href="https://pastebin.com/mSKvS8qR" target="_blank">src</a></body></html><!-- clisp html.lisp -->
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
