Plaster

(defun scan-line () (let ((input-value nil) (input-list nil)) (with-input-from-string (input-string (read-line)) (loop while (setf input-value (read input-string nil)) do (push input-value input-list)) (reverse input-list)))) (defun scanner () (let ((current (read))) (case current (title (title))))) (defun check (word-list element &optional (current (car word-list))) (case current (.c (format (text-content element) "<span class=\"~a\">" (cadr word-list)) (make-color-class (cadr word-list)) (setf word-list (cdr word-list))) (.ce (format (text-content element) "</span>"))) (unless (null (cdr word-list)) (check (cdr word-list) element))) (defclass dom-element () ((father :accessor father :initarg :father :initform nil) (children :accessor children :initarg :children :initform nil) (css-class :accessor css-class :initarg :css-class :initform nil) (text-content :accessor text-content :initarg :text-content :initform (make-array 0 :adjustable t :fill-pointer t :element-type 'character)) (nesting-value :accessor nesting-value :initarg :nesting-value :initform 0) (tag-name :accessor tag-name :initarg :tag-name :initform nil))) (defparameter *colors* nil) (defun father-child (father child) (setf (father child) father) (push child (children father))) (defmacro make-element (element-name tag-name &optional &rest body) `(defparameter ,element-name (make-instance 'dom-element :tag-name ,tag-name ,@body))) (defun append-children (father children-list) (dolist (child children-list) (father-child father child))) (defun know-nesting (element &optional (nesting 1)) (if (eq (father element) root) nesting (know-nesting (father element) (1+ nesting)))) (defun make-class (class-name content-list) (format (text-content style) ".~a~%{~%~{~3t~a: ~a;~^~%~}~%}~%" class-name content-list)) (defun make-color-class (color) (unless (member color *colors*) (push color *colors*) (make-class color (list "color" color)))) (defun title () (make-element h1 'h1) (make-element title 'title) (father-child body h1) (father-child head title) (check (scan-line) h1)) (setf *print-case* :downcase) (make-element root 'html) (make-element body 'body) (make-element head 'head) (make-element style 'style) (make-element script 'script) (append-children root (list head body script))