;;;; 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
;;;;
: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.")
(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))
(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 ">")))
(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)
(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)