commit b9430d02d40ae3aa73e09bc0486e28dba23562ec
parent 82dbf5e56e44fde947578af90e38f231a5b5d2e5
Author: Tomas Hlavaty <tom@logand.com>
Date: Thu, 19 Sep 2013 00:10:25 +0200
refactor html writer to separate packages
Diffstat:
| M | cl-rw.asd | | | 2 | ++ |
| A | css.lisp | | | 38 | ++++++++++++++++++++++++++++++++++++++ |
| A | html.lisp | | | 71 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | ui.lisp | | | 100 | +------------------------------------------------------------------------------ |
4 files changed, 112 insertions(+), 99 deletions(-)
diff --git a/cl-rw.asd b/cl-rw.asd
@@ -43,5 +43,7 @@
(:file "os")
(:file "net")
(:file "concurrency")
+ (:file "css")
+ (:file "html")
(:file "calendar")
(:file "ui")))
diff --git a/css.lisp b/css.lisp
@@ -0,0 +1,38 @@
+(defpackage :rw.css
+ (:use :cl)
+ (:export :css
+ :style))
+
+(in-package :rw.css)
+
+(defun style (form)
+ (loop
+ for (k v) on form by #'cddr
+ for i from 0
+ when v
+ do (flet ((out (x)
+ (typecase x
+ (symbol (format t "~(~a~)" x))
+ (t (format t "~a" x)))))
+ (when (plusp i)
+ (write-char #\;))
+ (out k)
+ (write-char #\:)
+ (out v))))
+
+;;(style '(:one 1 :two 2 :three nil :four :hello))
+
+(defun css (form)
+ (dolist (x form)
+ (let ((style (with-output-to-string (*standard-output*) (style (cdr x)))))
+ (when style
+ (flet ((out (x)
+ (typecase x
+ (symbol (format t "~(~a~)" x))
+ (t (format t "~a" x)))))
+ (out (car x))
+ (write-char #\{)
+ (write-string style)
+ (write-char #\}))))))
+
+;;(css '((:pre :one 1 :two 2 :three nil :four :hello)))
diff --git a/html.lisp b/html.lisp
@@ -0,0 +1,71 @@
+(defpackage :rw.html
+ (:use :cl)
+ (:export :html))
+
+(in-package :rw.html)
+
+(defun html (form)
+ (labels ((esc (x)
+ (loop
+ for c across x
+ do (case c
+ (#\& (write-string "&"))
+ (#\< (write-string "<"))
+ (#\> (write-string ">"))
+ (t (write-char c)))))
+ (name (x)
+ (esc (etypecase x
+ (number (format nil "~a" x))
+ (string x)
+ (symbol (format nil "~(~a~)" x)))))
+ (attribute (k v)
+ (unless (or (not v)
+ (and (consp v)
+ (eq :style (car v))
+ (not (cdr v))))
+ (write-char #\space)
+ (name k)
+ (write-char #\=)
+ (write-char #\")
+ (loop
+ for c across (etypecase v
+ (string v)
+ (number (format nil "~a" v))
+ (symbol (format nil "~(~a~)" v))
+ (cons
+ (ecase (car v)
+ (:style
+ (with-output-to-string (*standard-output*)
+ (rw.css:style (cdr v)))))))
+ do (case c
+ (#\& (write-string "&"))
+ (#\" (write-string """))
+ (t (write-char c))))
+ (write-char #\")))
+ (element (e a b)
+ (case e
+ (:<style
+ (element :style a
+ (list
+ (with-output-to-string (*standard-output*)
+ (rw.css:css b)))))
+ (t
+ (write-char #\<)
+ (name e)
+ (loop for (k v) on a by #'cddr do (attribute k v))
+ (when b (write-char #\>))
+ (mapc #'rec b)
+ (when b (write-char #\<))
+ (write-char #\/)
+ (when b (name e))
+ (write-char #\>))))
+ (rec (x)
+ (if (atom x)
+ (when x (name x))
+ (destructuring-bind (y &rest z) x
+ (if (atom y)
+ (element y nil z)
+ (element (car y) (cdr y) z))))))
+ (princ "<!DOCTYPE html>")
+ (terpri)
+ (rec form)))
diff --git a/ui.lisp b/ui.lisp
@@ -25,104 +25,6 @@
(in-package :rw.ui)
-(defun style (form)
- (loop
- for (k v) on form by #'cddr
- for i from 0
- when v
- do (flet ((out (x)
- (typecase x
- (symbol (format t "~(~a~)" x))
- (t (format t "~a" x)))))
- (when (plusp i)
- (write-char #\;))
- (out k)
- (write-char #\:)
- (out v))))
-
-;;(style '(:one 1 :two 2 :three nil :four :hello))
-
-(defun css (form)
- (dolist (x form)
- (let ((style (with-output-to-string (*standard-output*) (style (cdr x)))))
- (when style
- (flet ((out (x)
- (typecase x
- (symbol (format t "~(~a~)" x))
- (t (format t "~a" x)))))
- (out (car x))
- (write-char #\{)
- (write-string style)
- (write-char #\}))))))
-
-;;(css '((:pre :one 1 :two 2 :three nil :four :hello)))
-
-(defun html (form)
- (labels ((esc (x)
- (loop
- for c across x
- do (case c
- (#\& (write-string "&"))
- (#\< (write-string "<"))
- (#\> (write-string ">"))
- (t (write-char c)))))
- (name (x)
- (esc (etypecase x
- (number (format nil "~a" x))
- (string x)
- (symbol (format nil "~(~a~)" x)))))
- (attribute (k v)
- (unless (or (not v)
- (and (consp v)
- (eq :style (car v))
- (not (cdr v))))
- (write-char #\space)
- (name k)
- (write-char #\=)
- (write-char #\")
- (loop
- for c across (etypecase v
- (string v)
- (number (format nil "~a" v))
- (symbol (format nil "~(~a~)" v))
- (cons
- (ecase (car v)
- (:style
- (with-output-to-string (*standard-output*)
- (style (cdr v)))))))
- do (case c
- (#\& (write-string "&"))
- (#\" (write-string """))
- (t (write-char c))))
- (write-char #\")))
- (element (e a b)
- (case e
- (:<style
- (element :style a
- (list
- (with-output-to-string (*standard-output*)
- (css b)))))
- (t
- (write-char #\<)
- (name e)
- (loop for (k v) on a by #'cddr do (attribute k v))
- (when b (write-char #\>))
- (mapc #'rec b)
- (when b (write-char #\<))
- (write-char #\/)
- (when b (name e))
- (write-char #\>))))
- (rec (x)
- (if (atom x)
- (when x (name x))
- (destructuring-bind (y &rest z) x
- (if (atom y)
- (element y nil z)
- (element (car y) (cdr y) z))))))
- (princ "<!DOCTYPE html>")
- (terpri)
- (rec form)))
-
(defvar *click-link*)
(defvar *click-form*)
@@ -143,7 +45,7 @@
(hunchentoot:header-out "pragma") "no-cache"
(hunchentoot:header-out "expires") "-1")
(with-output-to-string (*standard-output*)
- (html form)))
+ (rw.html:html form)))
(defvar *register*)
