r3620: *** empty log message ***

diff --git a/views.lisp b/views.lisp
index c53a90069ccc5ab5894413e1ea8bcce623abc7be..fadc3ba1736479d035975a40eab26c2bdbfb3593 100644 (file)
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: views.lisp,v 1.15 2002/12/13 08:41:25 kevin Exp $
+;;;; $Id: views.lisp,v 1.16 2002/12/13 12:23:17 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,9 +26,9 @@
          :documentation "List of effective slots for object to be viewed.")
    (name :initform nil :initarg :name :accessor name
         :documentation "Name for this view.")
-   (category :initform nil :initarg :category :reader category
+   (category :initform nil :initarg :category :accessor category
             :documentation "Category for view. Helpful when want to find a view corresponding to a particular category.")
-   (source-code :initform nil :initarg :source-code
+   (source-code :initform nil :initarg :source-code :accessor source-code 
                :documentation "Source code for generating view.")
    (country-language :initform :en :initarg :country-language
                     :documentation "Country's Language for this view.")
@@ -146,11 +146,36 @@
   
 (defun initialize-view (obj-cl view)
   "Calculate all view slots for a hyperobject class"
+  (cond
+    ((category view)
+     (initialize-view-by-category obj-cl view))
+    ((source-code view)
+     (initialize-view-by-source-code obj-cl view))
+    (t
+     (setf (category view) :compact-text)
+     (initialize-view-by-category obj-cl view))))
+
+(defun initialize-view-by-source-code (obj-cl view)
+  "Initialize a view based upon a source code"
+  (let ((source-code (source-code view)))
+    (error "not implemented")
+    )
+  )
+
+(defun initialize-view-by-category (obj-cl view)
+  "Initialize a view based upon a preset category"
   (let ((fmtstr nil)
        (first-field t)
        (value-func '())
        (links '())
        (category (category view)))
+
+    (unless (in category :compact-text :compact-text-labels
+               :html :html-labels :html-link-labels
+               :xhtml :xhtml-labels :xhtml-link-labels
+               :xml :xml-labels :xml-link-labels)
+      (error "Unknown view category ~A" category))
+    
     (unless (slots view)
       (setf (slots view) (default-print-slots obj-cl)))
     (dolist (slot-name (slots view))
@@ -186,9 +211,9 @@
               (string-append fmtstr (concatenate 'string "<span class=\"" namestr-lower "\">" value-fmt "</span>")))
              (:xml
               (string-append fmtstr (concatenate 'string "<" namestr-lower ">" value-fmt "</" namestr-lower ">")))
-             (:html-label
+             (:html-labels
               (string-append fmtstr (concatenate 'string "<span class=\"label\">" namestr-lower "</span> <span class=\"" namestr-lower "\">" value-fmt "</span>")))
-             (:xhtml-label
+             (:xhtml-labels
               (string-append fmtstr (concatenate 'string "<span class=\"label\"><![CDATA[" namestr-lower "]]></span> <span class=\"" namestr-lower "\">" value-fmt "</span>")))
              (:xml-labels
               (string-append fmtstr (concatenate 'string "<label><[!CDATA[" namestr-lower "]]></label> <" namestr-lower ">" value-fmt "</" namestr-lower ">")))
@@ -425,9 +450,7 @@
 
 (defun make-link-end (obj view fieldname)
   (declare (ignore obj fieldname))
-  ;;(format nil "~a" (href-end ref))
-  (link-href-end view)
-  )
+  (link-href-end view))
 
 (defun fmt-obj-data (obj view strm indent refvars)
   (when (obj-data-indent view)
@@ -436,7 +459,7 @@
       (fmt-obj-data-with-link obj view strm refvars)
       (fmt-obj-data-plain obj view strm))
   (awhen (obj-data-end-fmtstr view)
-        (format strm it)))
+        (write-string it strm)))
 
 (defun fmt-obj-data-plain (obj view strm)
   (awhen (obj-data-value-func view)