src/my-html.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Html generator helper
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2010 Philippe Brochard <hocwp@free.fr>
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;; --------------------------------------------------------------------------
  25
  26
  27
  28 (in-package :common-lisp-user)
  29
  30 (defpackage :my-html
  31   (:use :common-lisp :tools)
  32   (:export :insert-html-doctype
  33            :produce-html
  34            :with-html
  35            :produce-html-string))
  36
  37 (in-package :my-html)
  38
  39
  40 (defun insert-html-doctype ()
  41   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
  42      \"http://www.w3.org/TR/html4/transitional.dtd\">")
  43
  44
  45
  46 (defun produce-html (tree &optional (level 0) (stream *standard-output*))
  47   (cond ((listp tree)
  48          (print-space level stream)
  49          (format stream "~(<~A>~)~%" (first tree))
  50          (dolist (subtree (rest tree))
  51            (produce-html subtree (+ 2 level) stream))
  52          (print-space level stream)
  53          (format stream "~(</~A>~)~%"
  54                  (if (stringp (first tree))
  55                      (subseq (first tree) 0 (position #\Space (first tree)))
  56                      (first tree))))
  57         (t
  58          (print-space level stream)
  59          (format stream (if (stringp tree) "~A~%" "~(~A~)~%") tree))))
  60
  61
  62 (defmacro with-html ((&optional (stream t)) &rest rest)
  63   `(produce-html ',@rest 0 ,stream))
  64
  65
  66 (defun produce-html-string (tree &optional (level 0))
  67   (with-output-to-string (str)
  68     (produce-html tree level str)))
  69
  70
  71
  72
  73 (defun test1 ()
  74   (produce-html `(html
  75                   (head
  76                    (title "Plop"))
  77                   (body
  78                    (h1 "A title")
  79                    (h2 "plop")
  80                    Plop ,(+ 2 2)
  81                    ,(format nil "Plip=~A" (+ 3 5))
  82                    ("a href=\"index.html\"" index)
  83                    (ul
  84                     (li "toto")
  85                     (li "klm"))))))
  86
  87
  88 (defun test2 ()
  89   (with-html ()
  90     (html
  91      (head
  92       (title "Plop"))
  93      "<img src=\"toto.png\">"
  94      (body
  95       (h1 "Un titre")
  96       (h2 "plop")
  97       (ul
  98        (li "toto")
  99        (li "klm"))))))
 100
 101
 102 (defun test3 ()
 103   (produce-html-string `(html
 104                          (head
 105                           (title "Plop"))
 106                          (body
 107                           (h1 "A title")
 108                           (h2 plop)
 109                           Plop ,(+ 2 2)
 110                           ,(format nil "Plip=~A" (+ 3 5))
 111                           |Foo Bar Baz|
 112                           ("a href=\"index.html\"" Index)
 113                           (ul
 114                            (li "toto")
 115                            (li "klm"))))
 116                        10))
 117
 118
 119
 120
 121