stdsite.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          stdsite.cl
   6 ;;;; Purpose:       Functions to create my standard style sites
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Aug 2002
   9 ;;;;
  10 ;;;; $Id: stdsite.lisp,v 1.1 2002/09/30 10:26:43 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; LML users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the GNU General Public License v2
  16 ;;;; (http://www.gnu.org/licenses/gpl.html)
  17 ;;;; *************************************************************************
  18
  19 ;;; A "standard site" is a format for a certain style of web page.
  20 ;;; It is based on the LML package.
  21 ;;; A stdsite page expects to include the following files:
  22 ;;;  head.lml_
  23 ;;;  banner.lml_
  24 ;;;  content.lml_
  25 ;;;  footer.lml_
  26
  27 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  28 (in-package :lml)
  29
  30 (defmacro std-head (title &body body)
  31   `(head
  32     (title ,title)
  33     (lml-load #p"head.lml_")
  34     ,@body))
  35
  36
  37 (defun std-footer (file)
  38   (div-c "disclaimsec"
  39     (let ((src-file (make-pathname
  40                      :defaults *sources-dir*
  41                      :type "lml"
  42                      :name (pathname-name file))))
  43       (when (probe-file src-file)
  44         (div-c "lastmod"
  45           (lml-print "Last modified: ~A" (date-string (file-write-date src-file))))))
  46     (lml-load #p"footer.lml_"))
  47   (values))
  48
  49
  50 (defmacro std-body (file &body body)
  51   `(body
  52     (lml-load #p"banner.lml_")
  53     (table-c "stdbodytable" :border "0" :cellpadding "3"
  54              (tbody
  55               (tr :valign "top"
  56                   (td-c "stdcontentcell"
  57                         (lml-load #p"contents.lml_"))
  58                   (td :valign "top"
  59                       ,@body
  60                       (std-footer ,file)))))))
  61
  62
  63 (defmacro print-std-page (file title &body body)
  64   `(progn
  65      (xhtml-prologue)
  66      (html :xmlns "http://www.w3.org/1999/xhtml"
  67            (std-head ,title)
  68            (std-body ,file ,@body))))
  69
  70 (defmacro std-page (out-file title &body body)
  71   `(let ((*indent* 0))
  72      (with-open-file (*html-output* (lml-file-name ,out-file :output)
  73                       :direction :output
  74                       :if-exists :supersede)
  75        (print-std-page (lml-file-name ,out-file :source) ,title ,@body))))
  76
  77 (defmacro titled-pre-section (title &body body)
  78   `(progn
  79      (h1 ,title)
  80      (pre :style "padding-left:30pt;"
  81           ,@body)))
  82
  83
  84