X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=dfd6aaa6332190f72d336c683c7330bb50a2a92d;hb=4e78f4f0086c35ac3fd4459e3fff1186d13bc07f;hp=d5536ce698344e96f249bdcc8f05eaa58319e35e;hpb=ed38cba0d2ed61535a9911969bfd000d5ae1ffb9;p=hyperobject.git
diff --git a/views.lisp b/views.lisp
index d5536ce..dfd6aaa 100644
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: views.lisp,v 1.44 2003/05/14 21:18:12 kevin Exp $
+;;;; $Id: views.lisp,v 1.49 2003/05/30 18:46:35 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
;;;; *************************************************************************
@@ -40,29 +40,29 @@
:accessor file-start-str)
(file-end-str :type (or string null) :initform nil :initarg :file-end-str
:accessor file-end-str)
- (list-start-str-or-func :type (or string function null) :initform nil
- :initarg :list-start-str-or-func
- :accessor list-start-str-or-func)
+ (list-start-printer :type (or string function null) :initform nil
+ :initarg :list-start-printer
+ :accessor list-start-printer)
(list-start-indent :initform nil :initarg :list-start-indent
:accessor list-start-indent)
- (list-end-str-or-func :type (or string function null) :initform nil
- :initarg :list-end-str-or-func
- :accessor list-end-str-or-func)
+ (list-end-printer :type (or string function null) :initform nil
+ :initarg :list-end-printer
+ :accessor list-end-printer)
(list-end-indent :initform nil :initarg :list-end-indent
:accessor list-end-indent)
- (obj-start-str-or-func :type (or string function null) :initform nil :initarg :obj-start-str-or-func
- :accessor obj-start-str-or-func)
+ (obj-start-printer :type (or string function null) :initform nil :initarg :obj-start-printer
+ :accessor obj-start-printer)
(obj-start-indent :initform nil :initarg :obj-start-indent
:accessor obj-start-indent)
- (obj-end-str-or-func :type (or string function null) :initform nil :initarg :obj-end-str-or-func
- :accessor obj-end-str-or-func)
+ (obj-end-printer :type (or string function null) :initform nil :initarg :obj-end-printer
+ :accessor obj-end-printer)
(obj-end-indent :initform nil :initarg :obj-end-indent
:accessor obj-end-indent)
(obj-data-indent :initform nil :initarg :obj-data-indent
:accessor obj-data-indent)
- (obj-data-func :type (or function null) :initform nil
- :initarg :obj-data-func
- :accessor obj-data-func)
+ (obj-data-printer :type (or function null) :initform nil
+ :initarg :obj-data-printer
+ :accessor obj-data-printer)
(obj-data-print-code :type (or function null) :initform nil
:initarg :obj-data-print-code
:accessor obj-data-print-code)
@@ -134,7 +134,7 @@
:category :compact-text)))
view))
((consp view-def)
- (eval `(make-instance ,view-def)))
+ (apply #'make-instance 'object-view view-def))
(t
(error "Invalid parameter to make-object-view: ~S" view-def))))
@@ -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 "" value-fmt "")))
- (:xml
- (string-append fmtstr (concatenate 'string "<" namestr-lower ">" value-fmt "")))
- (:html-labels
- (string-append fmtstr (concatenate 'string "" namestr-lower " " value-fmt "")))
- (:xhtml-labels
- (string-append fmtstr (concatenate 'string "" xml-namestr " " value-fmt "")))
- (:xml-labels
- (string-append fmtstr (concatenate 'string " <" xml-tag ">" value-fmt "")))
- ((or :html-link :xhtml-link)
- (push name links)
- (if (esd-hyperlink slot)
- (string-append fmtstr "<~~a>" value-fmt "")
- (string-append fmtstr (concatenate 'string "" value-fmt ""))))
- ((or :xml-link :ie-xml-link)
- (push name links)
- (if (esd-hyperlink slot)
- (string-append fmtstr "<~~a>" value-fmt "")
- (string-append fmtstr (concatenate 'string "<" xml-tag ">" value-fmt ""))))
- (:html-link-labels
- (push name links)
- (if (esd-hyperlink slot)
- (string-append fmtstr "" namestr-lower " <~~a>" value-fmt "")
- (string-append fmtstr (concatenate 'string "" namestr-lower " " value-fmt ""))))
- (:xhtml-link-labels
- (push name links)
- (if (esd-hyperlink slot)
- (string-append fmtstr "" xml-namestr " <~~a>" value-fmt "")
- (string-append fmtstr (concatenate 'string "" xml-namestr " " value-fmt ""))))
- ((or :xml-link-labels :ie-xml-link-labels)
- (push name links)
- (if (esd-hyperlink slot)
- (string-append fmtstr " <~~a>" value-fmt "")
- (string-append fmtstr (concatenate 'string " <" xml-tag ">" value-fmt "")))))
- ) ;; let value-fmt
-
- (let ((func (if print-formatter
- `(,print-formatter (slot-value x (quote ,name)))
- `(slot-value x (quote ,name)))))
- (when (and (in category :xml :xhtml :xml-link :xhtml-link
- :xml-labels :ie-xml-labels
- :xhtml-link-labels :xml-link-labels :ie-xml-link
- :ie-xml-link-labels)
- (or print-formatter
- (lisp-type-is-a-string type)))
- (setq func `(kmrcl:xml-cdata ,func)))
- (push func value-func))
- )))
-
- (when value-func
- (setq value-func
- (compile nil (eval `(lambda (x) (values ,@(nreverse value-func)))))))
-
- (setf (obj-data-fmtstr view) fmtstr)
- (setf (obj-data-value-func view) value-func)
- (setf (link-slots view) (nreverse links))
-
- (case category
- ((or :compact-text :compact-text-labels)
- (initialize-text-view view))
- ((or :html :xhtml :html-labels :xhtml-labels)
- (initialize-html-view view))
- ((or :xml :xml-labels)
- (initialize-xml-view view))
- ((or :html-link :html-link-labels)
- (initialize-html-view view)
- (setf (link-href-start view) "a href=")
- (setf (link-href-end view) "a")
- (setf (link-ampersand view) "&"))
- ((or :xhtml-link :xhtml-link-labels)
- (initialize-html-view view)
- (setf (link-href-start view) "a href=")
- (setf (link-href-end view) "a")
- (setf (link-ampersand view) "&"))
- ((or :xml-link :xml-link-labels)
- (initialize-xml-view view)
- (setf (link-href-start view)
- "xmllink xlink:type=\"simple\" xlink:href=")
- (setf (link-href-end view) "xmllink")
- (setf (link-ampersand view) "&"))
- ((or :ie-xml-link :ie-xml-link-labels)
- (initialize-xml-view view)
- (setf (link-href-start view) "html:a href=")
- (setf (link-href-end view) "html:a")
- (setf (link-ampersand view) "&"))))
- view)
-
;;;; *************************************************************************
;;;; View Data Format Section
@@ -528,7 +389,7 @@
strm))
(defun initialize-text-view (view)
- (setf (list-start-str-or-func view)
+ (setf (list-start-printer view)
(compile nil
(eval '(lambda (obj nitems strm)
(write-user-name-maybe-plural obj nitems strm)
@@ -551,13 +412,13 @@
(setf (file-start-str view) (format nil "~%"))
(setf (file-end-str view) (format nil "~%"))
(setf (list-start-indent view) t)
- (setf (list-start-str-or-func view) #'html-list-start-func)
- (setf (list-end-str-or-func view) (format nil "~%"))
+ (setf (list-start-printer view) #'html-list-start-func)
+ (setf (list-end-printer view) (format nil "~%"))
(setf (list-end-indent view) t)
(setf (obj-start-indent view) t)
- (setf (obj-start-str-or-func view) "")
+ (setf (obj-start-printer view) "")
(setf (obj-end-indent view) t)
- (setf (obj-end-str-or-func view) (format nil "~%"))
+ (setf (obj-end-printer view) (format nil "~%"))
(setf (obj-data-indent view) nil))
(defun initialize-xhtml-view (view)
@@ -565,13 +426,13 @@
(setf (file-start-str view) (format nil "~%"))
(setf (file-end-str view) (format nil "~%"))
(setf (list-start-indent view) t)
- (setf (list-start-str-or-func view) #'html-list-start-func)
- (setf (list-end-str-or-func view) (format nil "~%"))
+ (setf (list-start-printer view) #'html-list-start-func)
+ (setf (list-end-printer view) (format nil "~%"))
(setf (list-end-indent view) t)
(setf (obj-start-indent view) t)
- (setf (obj-start-str-or-func view) "")
+ (setf (obj-start-printer view) "")
(setf (obj-end-indent view) t)
- (setf (obj-end-str-or-func view) (format nil "~%"))
+ (setf (obj-end-printer view) (format nil "~%"))
(setf (obj-data-indent view) nil))
(defun xmlformat-list-end-func (x strm)
@@ -593,12 +454,12 @@
(initialize-text-view view)
(setf (file-start-str view) "") ; (std-xml-header)
(setf (list-start-indent view) t)
- (setf (list-start-str-or-func view) #'xmlformat-list-start-func)
+ (setf (list-start-printer view) #'xmlformat-list-start-func)
(setf (list-end-indent view) t)
- (setf (list-end-str-or-func view) #'xmlformat-list-end-func)
- (setf (obj-start-str-or-func view) (format nil "<~(~a~)>" (object-class-name view)))
+ (setf (list-end-printer view) #'xmlformat-list-end-func)
+ (setf (obj-start-printer view) (format nil "<~(~a~)>" (object-class-name view)))
(setf (obj-start-indent view) t)
- (setf (obj-end-str-or-func view) (format nil "~%" (object-class-name view)))
+ (setf (obj-end-printer view) (format nil "~%" (object-class-name view)))
(setf (obj-end-indent view) nil)
(setf (obj-data-indent view) nil))
@@ -618,7 +479,7 @@
(defun fmt-list-start (obj view strm indent num-items)
(when (list-start-indent view)
(indent-spaces indent strm))
- (awhen (list-start-str-or-func view)
+ (awhen (list-start-printer view)
(if (stringp it)
(write-string it strm)
(funcall it obj num-items strm))))
@@ -627,7 +488,7 @@
(declare (ignore num-items))
(when (list-end-indent view)
(indent-spaces indent strm))
- (awhen (list-end-str-or-func view)
+ (awhen (list-end-printer view)
(if (stringp it)
(write-string it strm)
(funcall it obj strm))))
@@ -637,7 +498,7 @@
(defun fmt-obj-start (obj view strm indent)
(when (obj-start-indent view)
(indent-spaces indent strm))
- (awhen (obj-start-str-or-func view)
+ (awhen (obj-start-printer view)
(if (stringp it)
(write-string it strm)
(funcall it obj strm))))
@@ -645,7 +506,7 @@
(defun fmt-obj-end (obj view strm indent)
(when (obj-end-indent view)
(indent-spaces indent strm))
- (awhen (obj-end-str-or-func view)
+ (awhen (obj-end-printer view)
(if (stringp it)
(write-string it strm)
(funcall it obj strm))))
@@ -684,7 +545,7 @@
(write-string it strm)))
(defun fmt-obj-data-plain (obj view strm)
- (awhen (obj-data-func view)
+ (awhen (obj-data-printer view)
(funcall it obj strm nil)))
(defun fmt-obj-data-with-link (obj view strm refvars)
@@ -696,7 +557,7 @@
(append (link-parameters it) refvars))
refvalues)
(push (make-link-end obj view name) refvalues)))
- (funcall (obj-data-func view) obj strm (nreverse refvalues))))
+ (funcall (obj-data-printer view) obj strm (nreverse refvalues))))
(defun obj-data (obj view)
"Returns the objects data as a string. Used by common-graphics outline function"