r3071: *** empty log message ***

diff --git a/ml-class.lisp b/ml-class.lisp
index 6be17c146cca41866ee0f314f1fb36b13270459b..2376f0abbee6876fa0864d7353cdff44f293954a 100644 (file)
--- a/ml-class.lisp
+++ b/ml-class.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: ml-class.lisp,v 1.15 2002/10/16 16:18:27 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.16 2002/10/16 17:37:18 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -197,7 +197,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          
          (setq html-str (concatenate 'string "<span class=\"" namestr-lower "\">" value-fmt "</span>"))
          (setq xml-str (concatenate 'string "<" namestr-lower ">" value-fmt "</" namestr-lower ">"))
-         (setq html-label-str (concatenate 'string "<span class=\"label\">" namestr-lower "</span> " value-fmt))
+         (setq html-label-str (concatenate 'string "<span class=\"label\">" namestr-lower "</span> <span class=\"" namestr-lower "\">" value-fmt "</span>"))
          (setq xml-label-str (concatenate 'string "<label>" namestr-lower "</label> <" namestr-lower ">" value-fmt "</" namestr-lower ">"))
          
          (string-append fmtstr-text value-fmt)
@@ -669,7 +669,9 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     (let ((nobjs (length objs)))
       (fmt-list-start (car objs) fmt strm indent nobjs)
       (dolist (obj objs)
-        (unless (and english-only-function (not (funcall english-only-function obj)))
+        (unless (and english-only-function
+                 (multiple-value-bind (eng term) (funcall english-only-function obj)
+                   (and term (not eng))))
           (fmt-obj-start obj fmt strm indent)
           (fmt-obj-data obj fmt strm (1+ indent) label refvars)
           (if subobjects

diff --git a/package.lisp b/package.lisp
index bf26b7f8388fcb0473681be7166787a896cf6e30..d4a772df0075b3b3e691ed11a7d970c047164dca 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.4 2002/10/10 16:23:48 kevin Exp $
+;;;; $Id: package.lisp,v 1.5 2002/10/16 17:37:18 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -142,7 +142,7 @@
          #:home-link
          #:head
          #:with-xml-page
-         #:with-trans-page
+         #:with-html-page
          #:wrap-with-xml
          #:parse-xml-no-ws
          #:positions-xml-tag-contents

diff --git a/web-utils-aserve.lisp b/web-utils-aserve.lisp
index f6b9c75be9bf85915fa1c26c8f85a936b8c3aa0d..74a518a308aee40c5f42f20f67575e68234a7c82 100644 (file)
--- a/web-utils-aserve.lisp
+++ b/web-utils-aserve.lisp
@@ -1,3 +1,4 @@
+
 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
@@ -7,7 +8,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: web-utils-aserve.lisp,v 1.4 2002/10/10 16:23:48 kevin Exp $
+;;;; $Id: web-utils-aserve.lisp,v 1.5 2002/10/16 17:37:18 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -84,10 +85,12 @@
     (princ-http "Browser Home"))
   (princ-http "</font><p></p>"))
 
-(defun head (title-str)
+(defun head (title-str &key css)
+  (unless css
+    (setq css "http://b9.com/main.css"))
   (net.html.generator:html 
-   (:head 
-    "<LINK rel=\"stylesheet\" href=\"http://www.med-info.com/main.css\" type=\"text/css\">"
+   (:head
+    (princ-http (format nil "<LINK rel=\"stylesheet\" href=\"~A\" type=\"text/css\">" css))
     (:title (:princ-safe title-str)))))
 
 
@@ -104,7 +107,7 @@
         ,@body)
      (princ-http "</pagedata>")))
 
-(defmacro with-trans-page (title &rest body)
+(defmacro with-html-page ((title &key css) &rest body)
   `(prog1
        (progn
          (print-http "<?xml version=\"1.0\" standalone=\"yes\"?>")
@@ -112,7 +115,7 @@
          (print-http " \"http://www.w3c.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
          (print-http "")
          (print-http "<html xmlns=\"http://www.w3.org/1999/xhtml\">")
-         (head ,title)
+         (head ,title :css ,css)
          (print-http "<body bgcolor=\"#FFFFFF\">")
          (prog1 
              ,@body

diff --git a/web-utils.lisp b/web-utils.lisp
index 5ed96e1ef50c84b3117167ce5554e9aa66e355e9..f8c073b43c3d1a0b7e7e682af701c540c2d48705 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.4 2002/10/10 16:23:48 kevin Exp $
+;;;; $Id: web-utils.lisp,v 1.5 2002/10/16 17:37:18 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -24,7 +24,7 @@
 
 (defvar *std-xml-header* 
   (format nil 
-  "<?xml version=\"1.0\" ?>~%<?xml-stylesheet type=\"text/css\" href=\"/umlsclass.css\" ?>~%~%"))
+  "<?xml version=\"1.0\" ?>~%<?xml-stylesheet type=\"text/css\" href=\"http://b9.com/umls.css\" ?>~%~%"))
 
 (defun std-xml-header ()
   *std-xml-header*)