X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=4b0867e0ca5ec3b19cb40e2f9467a9f6854ef654;hb=fb79a796c6ff0b90aedc377a804b48a7b543f65b;hp=6c7b9faef997129baff6515a300461f4dd9601fa;hpb=e34bf03b10157e5594b3000be9aa6e3cedc44542;p=hyperobject.git
diff --git a/views.lisp b/views.lisp
index 6c7b9fa..4b0867e 100644
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: views.lisp,v 1.45 2003/05/16 07:35:09 kevin Exp $
+;;;; $Id: views.lisp,v 1.47 2003/05/22 21:03:52 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))))
@@ -331,12 +331,12 @@
(when (and (view-has-links-p view) (esd-hyperlink slot))
(push (slot-definition-name slot) links)))
- (when (plusp (length print-func))
- (setf (obj-data-print-code view) `(lambda (x s links)
- (declare (ignorable links))
- ,@(map 'list #'identity print-func)))
- (setf (obj-data-func view)
- (compile nil (eval (obj-data-print-code view)))))
+ (vector-push-extend 'x print-func) ;; return object
+ (setf (obj-data-print-code view) `(lambda (x s links)
+ (declare (ignorable links))
+ ,@(map 'list #'identity print-func)))
+ (setf (obj-data-printer view)
+ (compile nil (eval (obj-data-print-code view))))
(setf (link-slots view) (nreverse links)))
@@ -391,7 +391,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)
@@ -414,13 +414,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)
@@ -428,13 +428,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)
@@ -456,12 +456,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))
@@ -481,7 +481,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))))
@@ -490,7 +490,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))))
@@ -500,7 +500,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))))
@@ -508,7 +508,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))))
@@ -547,7 +547,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)
@@ -559,7 +559,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"