-;;;; -*- 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.10 2002/10/18 07:28:57 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 "</~a>" ,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 "</~a>" ,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 &key (format :html)) &rest body)
-; (format *html-stream* "Return to <cui2 xml:href=\"qstr\">Home</cui2>")
-; (format *html-stream* "Return to <go xml:link=\"simple\" show=\"replace\" href=\"qstr/\">Home</go>")
- `(case ,format
- (:xml
- (princ-http "<xmllink xlink:type=\"simple\" xlink:href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</xmllink>"))
- (:ie-xml
- (princ-http "<html:a href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</html:a>"))
- (:html
- (princ-http "<a href=\"")
- (princ-http ,href)
- (princ-http "\">")
- ,@body
- (princ-http "</a>"))))
-
-(defun home-link (&key (format :html) (vars nil))
- (case format
- (:html
- (princ-http "<div class=\"homelink\">Return to ")
- (with-link ((make-url "index.html" :vars vars))
- (princ-http "Home"))
- (princ-http "</div>"))
- ((:xml :ie-xml)
- (princ-http "<homelink>Return to ")
- (with-link ((make-url "index.html" :vars vars :format format) :format format)
- (princ-http "Home"))
- (princ-http "</homelink>"))))
-
-(defun head (title-str &key css)
- (unless css
- (setq css "http://b9.com/main.css"))
- (net.html.generator:html
- (:head
- (princ-http (format nil "<link rel=\"stylesheet\" href=\"~A\" type=\"text/css\"></link>" 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 "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
- (head ,title :css ,css)
- (print-http "<body>")
- (prog1
- ,@body
- (print-http "</body></html>"))))))
- (:html
- `(prog1
- (progn
- (net.html.generator:html
- (print-http *standard-html-header*)
- (head ,title :css ,css)
- (print-http "<body>")
- (prog1
- ,@body
- (print-http "</body></html>"))))))
- (:xml
- `(prog1
- (progn
- (net.html.generator:html
- (princ-http *standard-xml-header*)
- (princ-http "<pagedata xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:html=\"http://www.w3.org/TR/REC-html40\">"))
- (with-tag "pagetitle" (princ-http ,title))
- ,@body)
- (princ-http "</pagedata>")))))
-
-
-;;; URL Encoding
-
-(defun encode-query (query)
- "Escape [] from net.aserve's query-to-form-urlencoded"
- (substitute-string-for-char
- (substitute-string-for-char
- (substitute-string-for-char
- (substitute #\+ #\space query)
- #\[ "%5B")
- #\] "%5D")
- #\" "%22"))
-
-