From d6af219e32386c64ef95b8ff0dd8900ea92371fc Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Mon, 26 May 2003 21:43:05 +0000
Subject: [PATCH] r5036: *** empty log message ***

---
 mop.lisp   |  8 ++++++--
 views.lisp | 42 ++++++++++++++++++++----------------------
 2 files changed, 26 insertions(+), 24 deletions(-)

diff --git a/mop.lisp b/mop.lisp
index 21c77bc..695b4e9 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: mop.lisp,v 1.74 2003/05/17 22:24:38 kevin Exp $
+;;;; $Id: mop.lisp,v 1.75 2003/05/26 21:43:05 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -255,8 +255,12 @@
       (setf (slot-value esd 'length) length)
       (setf (slot-value esd 'type) (value-type-to-lisp-type value-type))
       (setf (slot-value esd 'value-type) value-type)
+      (setf (slot-value esd 'user-name)
+	    (aif (slot-value dsd 'user-name)
+		 it
+		 (string-downcase (symbol-name (slot-definition-name dsd)))))
       (dolist (name '(print-formatter subobject hyperlink hyperlink-parameters
-		      description value-constraint index null-allowed user-name))
+		      description value-constraint index null-allowed))
 	(setf (slot-value esd name) (slot-value dsd name)))
       esd)))
 
diff --git a/views.lisp b/views.lisp
index 4b0867e..0aeafe1 100644
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: views.lisp,v 1.47 2003/05/22 21:03:52 kevin Exp $
+;;;; $Id: views.lisp,v 1.48 2003/05/26 21:43:05 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -177,12 +177,10 @@
   (let* ((slot-data (slot-value obj name))
 	 (fmt-data (if formatter
 		       (funcall formatter slot-data)
-		   slot-data))
-	 (data (if cdata
-		   (kmrcl:xml-cdata fmt-data)
-		   fmt-data)))
-    (write-simple data strm)))
-
+		       slot-data)))
+    (if cdata
+	(write-xml-cdata fmt-data strm)
+	(write-simple fmt-data strm))))
 
 (defun ppfc-html (title name type formatter cdata print-func)
   (vector-push-extend '(write-string "<span class=\"" s) print-func)
@@ -237,9 +235,9 @@
 (defun push-print-fun-code (category slot nlink print-func)
   (let* ((formatter (esd-print-formatter slot))
 	 (name (slot-definition-name slot))
-	 (namestr-lower (string-downcase (symbol-name name)))
-	 (xml-namestr (escape-xml-string namestr-lower))
-	 (xml-tag (escape-xml-string namestr-lower))
+	 (user-name (esd-user-name slot))
+	 (xml-user-name (escape-xml-string user-name))
+	 (xml-tag (escape-xml-string user-name))
 	 (type (slot-value slot 'type))
 	 (cdata (not (null
 		      (and (in category :xml :xhtml :xml-link :xhtml-link
@@ -255,44 +253,44 @@
        (vector-push-extend
 	`(write-ho-value x ',name ',type ',formatter ,cdata s) print-func))
       (:compact-text-labels
-       (vector-push-extend `(write-string ,namestr-lower s) print-func)
+       (vector-push-extend `(write-string ,user-name s) print-func)
        (vector-push-extend '(write-char #\space s) print-func)
        (vector-push-extend
 	`(write-ho-value x ',name ',type ',formatter ,cdata s) print-func))
       ((or :html :xhtml)
-       (ppfc-html namestr-lower name type formatter cdata print-func))
+       (ppfc-html user-name name type formatter cdata print-func))
       (:xml
        (ppfc-xml xml-tag name type formatter cdata print-func))
       (:html-labels
-       (ppfc-html-labels namestr-lower name type formatter cdata print-func))
+       (ppfc-html-labels user-name name type formatter cdata print-func))
       (:xhtml-labels
-       (ppfc-xhtml-labels xml-namestr namestr-lower name type formatter cdata print-func))
+       (ppfc-xhtml-labels xml-user-name user-name name type formatter cdata print-func))
       (:xml-labels
-       (ppfc-xml-labels xml-namestr xml-tag name type formatter cdata print-func))
+       (ppfc-xml-labels xml-user-name xml-tag name type formatter cdata print-func))
       ((or :html-link :xhtml-link)
        (if hyperlink
 	   (ppfc-html-link name type formatter cdata nlink print-func)
-	   (ppfc-html namestr-lower name type formatter cdata print-func)))
+	   (ppfc-html user-name name type formatter cdata print-func)))
       ((or :xml-link :ie-xml-link)
        (if hyperlink
 	   (ppfc-html-link name type formatter cdata nlink print-func)
 	   (ppfc-xml xml-tag name type formatter cdata print-func)))
       (:html-link-labels
        (if hyperlink
-	   (ppfc-html-link-labels namestr-lower name type formatter cdata nlink
+	   (ppfc-html-link-labels user-name name type formatter cdata nlink
 				  print-func)
-	   (ppfc-html-labels namestr-lower name type formatter cdata print-func)))
+	   (ppfc-html-labels user-name name type formatter cdata print-func)))
       (:xhtml-link-labels
        (if hyperlink
-	   (ppfc-html-link-labels xml-namestr name type formatter cdata nlink
+	   (ppfc-html-link-labels xml-user-name name type formatter cdata nlink
 				  print-func)
-	   (ppfc-xhtml-labels xml-tag namestr-lower name type formatter cdata
+	   (ppfc-xhtml-labels xml-tag user-name name type formatter cdata
 			      print-func)))
       ((or :xml-link-labels :ie-xml-link-labels)
        (if hyperlink
-	   (ppfc-html-link-labels xml-namestr name type formatter cdata nlink
+	   (ppfc-html-link-labels xml-user-name name type formatter cdata nlink
 				  print-func)
-	   (ppfc-xml-labels xml-tag namestr-lower name type formatter cdata
+	   (ppfc-xml-labels xml-tag user-name name type formatter cdata
 			    print-func))))))
 
 
-- 
2.34.1