X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=web-utils.lisp;h=0f41c1275fec17e8b58ffcf9fc1ceff9afeaffd5;hp=2854064398afdf87367a32638eb8a6c3eae13367;hb=b30c91702a68ca81402b646bd7468bfc75c5a804;hpb=64ab2587ad0923623832012abd1b8b2cf5a11a84 diff --git a/web-utils.lisp b/web-utils.lisp index 2854064..0f41c12 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -7,12 +7,13 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: web-utils.lisp,v 1.3 2002/10/09 14:24:47 kevin Exp $ +;;;; $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 +;;;; 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 GNU General Public License. +;;;; 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) @@ -21,12 +22,23 @@ ;;; HTML/XML constants -(defvar *std-xml-header* - (format nil - "~%~%~%")) +(defvar *standard-xml-header* + #.(format nil "~%~%~%")) -(defun std-xml-header () - *std-xml-header*) +(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 @@ -34,16 +46,22 @@ (defun base-url! (url) (setq *base-url* url)) -(defun make-url (page-name &key (base-dir *base-url*) (vars nil)) - (concatenate 'string base-dir page-name - (if vars - (string-trim-last-character - (concatenate 'string "?" - (mapcar-append-string - #'(lambda (var) - (when (and (car var) (cadr var)) - (concatenate 'string - (car var) "=" (cadr var) "&"))) - vars))) - ""))) - +(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)))) + ""))))