r3659: *** empty log message ***

[hyperobject.git] / views.lisp

diff --git a/views.lisp b/views.lisp
index 4d57aa423371dfeb8e649fc975af9060a0687040..f8b2649a76794daf026b73251610ca22ec8540c8 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.14 2002/12/13 08:25:45 kevin Exp $
+;;;; $Id: views.lisp,v 1.17 2002/12/24 06:30:29 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,38 @@
   
 (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 :ie-xml-link
+               :xml-link-labels :ie-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 +213,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 ">")))
@@ -197,7 +224,7 @@
               (if (esd-hyperlink slot)
                   (string-append fmtstr "<~~a>" value-fmt "</~~a>")
                   (string-append fmtstr (concatenate 'string "<span class=\"" namestr-lower "\">" value-fmt "</span>"))))
-             (:xml-link
+             ((or :xml-link :ie-xml-link)
               (push name links)
               (if (esd-hyperlink slot)
                   (string-append fmtstr "<~~a>" value-fmt "</~~a>")
@@ -212,16 +239,16 @@
               (if (esd-hyperlink slot)
                   (string-append fmtstr "<span class=\"label\"><[!CDATA[" namestr-lower "]]></span> <~~a>" value-fmt "</~~a>")
                   (string-append fmtstr (concatenate 'string "<span class=\"label\"><![CDATA[" namestr-lower "]]></span> <span class=\"" namestr-lower "\">" value-fmt "</span>"))))
-             (:xml-link-labels
+             ((or :xml-link-labels :ie-xml-link-labels)
               (push name links)
               (if (esd-hyperlink slot)
                   (string-append fmtstr "<label><[![CDATA[" namestr-lower "]]></label> <~~a>" value-fmt "</~~a>")
                   (string-append fmtstr (concatenate 'string "<label><![CDATA[" namestr-lower "]]></label> <" namestr-lower ">" value-fmt "</" namestr-lower ">")))))
            ) ;; let value-fmt
-         
+           
          (let ((func (if print-formatter
-                         `(,print-formatter (slot-value x (quote ,name)))
-                         `(slot-value x (quote ,name)))))
+                 `(,print-formatter (slot-value x (quote ,name)))
+                 `(slot-value x (quote ,name)))))
            (when (and (in category :xml :xhtml :xml-link :xhtml-link
                           :xhtml-link-labels :xml-link-labels :ie-xml-link
                           :ie-xml-link-labels)
@@ -425,9 +452,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 +461,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)