;;;; 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
;;;; *************************************************************************
: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)
: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))))
(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)))
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)
(setf (file-start-str view) (format nil "<html><body>~%"))
(setf (file-end-str view) (format nil "</body><html>~%"))
(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 "</ul></div>~%"))
+ (setf (list-start-printer view) #'html-list-start-func)
+ (setf (list-end-printer view) (format nil "</ul></div>~%"))
(setf (list-end-indent view) t)
(setf (obj-start-indent view) t)
- (setf (obj-start-str-or-func view) "<li>")
+ (setf (obj-start-printer view) "<li>")
(setf (obj-end-indent view) t)
- (setf (obj-end-str-or-func view) (format nil "</li>~%"))
+ (setf (obj-end-printer view) (format nil "</li>~%"))
(setf (obj-data-indent view) nil))
(defun initialize-xhtml-view (view)
(setf (file-start-str view) (format nil "<html><body>~%"))
(setf (file-end-str view) (format nil "</body><html>~%"))
(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 "</ul></div>~%"))
+ (setf (list-start-printer view) #'html-list-start-func)
+ (setf (list-end-printer view) (format nil "</ul></div>~%"))
(setf (list-end-indent view) t)
(setf (obj-start-indent view) t)
- (setf (obj-start-str-or-func view) "<li>")
+ (setf (obj-start-printer view) "<li>")
(setf (obj-end-indent view) t)
- (setf (obj-end-str-or-func view) (format nil "</li>~%"))
+ (setf (obj-end-printer view) (format nil "</li>~%"))
(setf (obj-data-indent view) nil))
(defun xmlformat-list-end-func (x strm)
(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 "</~(~a~)>~%" (object-class-name view)))
+ (setf (obj-end-printer view) (format nil "</~(~a~)>~%" (object-class-name view)))
(setf (obj-end-indent view) nil)
(setf (obj-data-indent view) nil))
(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))))
(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))))
(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))))
(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))))
(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)
(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"