;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: web-utils.lisp ;;;; Purpose: Basic web utility functions ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; ;;;; $Id: web-utils.lisp,v 1.9 2002/10/18 05:14:49 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))) ;;; HTML/XML constants (defvar *standard-xml-header* #.(format nil "~%~%~%")) (defvar *standard-html-header* "") (defvar *standard-xhtml-header* #.(format nil "~%")) ;;; User agent functions (defun user-agent-ie-p (agent) "Takes a user-agent string and returns T for Internet Explorer." (when (or (string-equal "Microsoft" (subseq agent 0 (length "Microsoft"))) (string-equal "Internet Explore" (subseq agent 0 (length "Internet Explore"))) (search "MSIE" agent)) t)) ;;; URL Functions (defvar *base-url* "") (defun base-url! (url) (setq *base-url* url)) (defun make-url (page-name &key (base-dir *base-url*) (format :html) (vars nil)) (let ((amp (case format (:html "&") ((:xml :ie-xml) "&")))) (concatenate 'string base-dir page-name (if vars (let ((first-var (first vars))) (concatenate 'string "?" (car first-var) "=" (cadr first-var) (mapcar-append-string #'(lambda (var) (when (and (car var) (cadr var)) (concatenate 'string amp (car var) "=" (cadr var)))) (rest vars)))) ""))))