X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=fadc3ba1736479d035975a40eab26c2bdbfb3593;hb=d3dd5096c102155d3c5dba9642bbcf4d6f78928e;hp=c53a90069ccc5ab5894413e1ea8bcce623abc7be;hpb=936bbfecd171bf0ebcbb5144eed4568f3e3aee71;p=hyperobject.git
diff --git a/views.lisp b/views.lisp
index c53a900..fadc3ba 100644
--- 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 "" value-fmt "")))
(:xml
(string-append fmtstr (concatenate 'string "<" namestr-lower ">" value-fmt "" namestr-lower ">")))
- (:html-label
+ (:html-labels
(string-append fmtstr (concatenate 'string "" namestr-lower " " value-fmt "")))
- (:xhtml-label
+ (:xhtml-labels
(string-append fmtstr (concatenate 'string " " value-fmt "")))
(:xml-labels
(string-append fmtstr (concatenate 'string " <" 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)