r3094: *** empty log message ***

diff --git a/kmrcl.asd b/kmrcl.asd
index a0aa8e3f9eab1073473af6c44f9e26c7addd6c6b..c0048096bdfd0ff2acd146ee8f0039f9ecb127b4 100644 (file)
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: kmrcl.asd,v 1.13 2002/10/17 00:25:05 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.14 2002/10/18 05:14:49 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -17,7 +17,8 @@
 ;;;; *************************************************************************
 
 #+allegro (require :pxml)
-#+allegro (require :aserve)
+#+(and allegro (not common-lisp-controller)) (require :aserve)
+#+(and allegro common-lisp-controller) (c-l-c::clc-require :aserve)
 #+(or lispworks cmu) (ignore-errors (require :aserve))
 
 (in-package :asdf)

diff --git a/web-utils-aserve.lisp b/web-utils-aserve.lisp
index 9261cddc4198d149d8e67c26b4c47b33e90b765e..654866254e07c06fe39b0638a7918b294a166477 100644 (file)
--- a/web-utils-aserve.lisp
+++ b/web-utils-aserve.lisp
@@ -1,4 +1,3 @@
-
 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
@@ -8,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: web-utils-aserve.lisp,v 1.8 2002/10/16 23:34:33 kevin Exp $
+;;;; $Id: web-utils-aserve.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
 ;;;;
@@ -61,29 +60,41 @@
   (with-tag-attribute "font" (format nil "size=\"~a\"" size)
                      (princ-http text)))
 
-(defmacro with-link ((href xml linktype) &rest body)
-  (declare (ignore linktype))
+(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>")
-  `(if ,xml
-       (progn
-        (princ-http "<elem xlink:type=\"simple\" xlink:href=\"")
-        (princ-http ,href)
-        (princ-http "\">")
-        ,@body
-        (princ-http "</elem>"))
-     (progn 
-       (princ-http "<a href=\"")
-       (princ-http ,href)
-       (princ-http "\">")
-       ,@body
-       (princ-http "</a>"))))
-
-(defun home-link (&key (xml nil) (vars nil))
-  (princ-http "<font size=\"-1\">Return to ")
-  (with-link ((make-url "index.html" :vars vars) xml "homelink")
-    (princ-http "Browser Home"))
-  (princ-http "</font><p></p>"))
+  `(case ,format
+     (:xml
+      (princ-http "<elem xlink:type=\"simple\" xlink:href=\"")
+      (princ-http ,href)
+      (princ-http "\">")
+      ,@body
+      (princ-http "</elem>"))
+     (: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

diff --git a/web-utils.lisp b/web-utils.lisp
index f777f218b0dbf998cecd2f1db9153c4b35e9a065..0f41c1275fec17e8b58ffcf9fc1ceff9afeaffd5 100644 (file)
--- a/web-utils.lisp
+++ b/web-utils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: web-utils.lisp,v 1.8 2002/10/17 22:25:38 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
 ;;;;
@@ -36,7 +36,8 @@
 (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"))))
+           (string-equal "Internet Explore" (subseq agent 0 (length "Internet Explore")))
+           (search "MSIE" agent))
     t))
 
 ;;; URL Functions
@@ -45,15 +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))))
+       ""))))