;;;; -*- 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.1 2002/10/06 13:21:47 kevin Exp $
;;;;
;;;; This file, part of Webutils, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Webutils users are granted the rights to distribute and use this software
;;;; as governed by the terms of the GNU General Public License.
;;;; *************************************************************************
(in-package :webutils)
(declaim (optimize (speed 3) (safety 1)))
;;; 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)
(net.html.generator:html
(:head
""
(:title (:princ-safe title-str)))))
;;; Page wrappers
(defmacro with-xml-page (title &rest body)
`(prog1
(progn
(net.html.generator:html
(princ-http (std-xml-header))
(princ-http ""))
(with-tag "pagetitle" (princ-http ,title))
,@body)
(princ-http "")))
(defmacro with-trans-page (title &rest body)
`(prog1
(progn
(print-http "")
(print-http "")
(print-http "")
(print-http "")
(head ,title)
(print-http "")
(prog1
,@body
(print-http "")))
(print-http "")))
;;; 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"))