;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: web-utils-aserve.lisp
;;;; Purpose: Web utilities based on aserve functions
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
;;;; $Id: web-utils-aserve.lisp,v 1.7 2002/10/16 22:56:07 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(in-package :kmrcl)
(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
;;; AllegroServe interaction functions
(defun cgi-var (var req)
"Look CGI variable in AllegroServe association list"
(cdr (assoc var (net.aserve:request-query req) :test #'equal)))
(defun princ-http (s)
(princ s *html-stream*))
(defun print-http (s)
(format *html-stream* "~a~%" s))
;;; Tag functions
(defmacro with-tag (tag &rest body)
"Outputs to http tag and executes body"
`(prog1
(progn
(princ-http (format nil "<~a>" ,tag))
,@body)
(princ-http (format nil "" ,tag))))
(defmacro with-tag-attribute (tag attribute &rest body)
"Outputs to http tag + attribute and executes body"
`(prog1
(progn
(princ-http (format nil "<~a ~a>" ,tag ,attribute))
,@body)
(princ-http (format nil "" ,tag))))
(defun princ-http-with-color (text color)
(with-tag-attribute "font" (format nil "color=\"~a\"" color)
(princ-http text)))
(defun princ-http-with-size (text size)
(with-tag-attribute "font" (format nil "size=\"~a\"" size)
(princ-http text)))
(defmacro with-link ((href xml linktype) &rest body)
(declare (ignore linktype))
; (format *html-stream* "Return to Home")
; (format *html-stream* "Return to Home")
`(if ,xml
(progn
(princ-http "")
,@body
(princ-http ""))
(progn
(princ-http "")
,@body
(princ-http ""))))
(defun home-link (&key (xml nil) (vars nil))
(princ-http "Return to ")
(with-link ((make-url "index.html" :vars vars) xml "homelink")
(princ-http "Browser Home"))
(princ-http ""))
(defun head (title-str &key css)
(unless css
(setq css "http://b9.com/main.css"))
(net.html.generator:html
(:head
(princ-http (format nil "" css))
(:title (:princ-safe title-str)))))
;;; Page wrappers
(defmacro with-page ((title &key css (format :xhtml)) &rest body)
(case format
(:xhtml
`(prog1
(progn
(net.html.generator:html
(print-http *standard-xhtml-header*)
(print-http "")
(head ,title :css ,css)
(print-http "")
(prog1
,@body
(print-http ""))))))
(:html
`(prog1
(progn
(net.html.generator:html
(print-http *standard-html-header*)
(head ,title :css ,css)
(print-http "")
(prog1
,@body
(print-http "