From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Wed, 16 Oct 2002 17:37:39 +0000 (+0000)
Subject: r3071: *** empty log message ***
X-Git-Tag: v1.96~314
X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=bb23129ae7ddabcbcb09c718545f69a52a8d1eaf

r3071: *** empty log message ***
---

diff --git a/ml-class.lisp b/ml-class.lisp
index 6be17c1..2376f0a 100644
--- 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 bf26b7f..d4a772d 100644
--- 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 f6b9c75..74a518a 100644
--- 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 5ed96e1..f8c073b 100644
--- 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*)