X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=c30c0a8cfd1b24c9753bb16f6b31a70fefebab8d;hb=9ccad91c1ec86cd90e8b591c29ec85aff9c89268;hp=e30b0eb072b83d0611d0537eae930412850fc922;hpb=da95022a6396191e772e59cd7622c7c5919ce605;p=hyperobject.git diff --git a/views.lisp b/views.lisp index e30b0eb..c30c0a8 100644 --- a/views.lisp +++ b/views.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: views.lisp,v 1.12 2002/12/13 05:44:19 kevin Exp $ +;;;; $Id: views.lisp,v 1.13 2002/12/13 07:33:54 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -264,45 +264,46 @@ (setf (slot-value view 'list-start-value-func) #'text-list-start-value-func) (setf (slot-value view 'list-start-indent) t) (setf (slot-value view 'obj-data-indent) t) - (setf (slot-value view 'obj-data-end-fmtstr) "~%")) + (setf (slot-value view 'obj-data-end-fmtstr) (format nil "~%")) + ) (defun initialize-html-view (view) (initialize-text-view view) - (setf (slot-value view 'file-start-str) "~%") - (setf (slot-value view 'file-end-str) "~%") + (setf (slot-value view 'file-start-str) (format nil "~%")) + (setf (slot-value view 'file-end-str) (format nil "~%")) (setf (slot-value view 'list-start-indent) t) (setf (slot-value view 'list-start-fmtstr) "

~a~p:

~%") + (setf (slot-value view 'list-end-fmtstr) (format nil "~%")) (setf (slot-value view 'list-end-indent) t) (setf (slot-value view 'list-end-value-func) nil) (setf (slot-value view 'obj-start-indent) t) (setf (slot-value view 'obj-start-fmtstr) "
  • ") (setf (slot-value view 'obj-start-value-func) nil) (setf (slot-value view 'obj-end-indent) t) - (setf (slot-value view 'obj-end-fmtstr) "
    • ~%") + (setf (slot-value view 'obj-end-fmtstr) (format nil "~%")) (setf (slot-value view 'obj-end-value-func) nil) (setf (slot-value view 'obj-data-indent) t)) (defun initialize-xhtml-view (view) (initialize-text-view view) - (setf (slot-value view 'file-start-str) "~%") - (setf (slot-value view 'file-end-str) "~%") + (setf (slot-value view 'file-start-str) (format nil "~%")) + (setf (slot-value view 'file-end-str) (format nil "~%")) (setf (slot-value view 'list-start-indent) t) (setf (slot-value view 'list-start-fmtstr) "

    ~a~p:

    ~%") + (setf (slot-value view 'list-end-fmtstr) (format nil "~%")) (setf (slot-value view 'list-end-indent) t) (setf (slot-value view 'list-end-value-func) nil) (setf (slot-value view 'obj-start-indent) t) (setf (slot-value view 'obj-start-fmtstr) "
  • ") (setf (slot-value view 'obj-start-value-func) nil) (setf (slot-value view 'obj-end-indent) t) - (setf (slot-value view 'obj-end-fmtstr) "
    • ~%") + (setf (slot-value view 'obj-end-fmtstr) (format nil "~%")) (setf (slot-value view 'obj-end-value-func) nil) (setf (slot-value view 'obj-data-indent) t)) @@ -322,11 +323,9 @@ (setf (slot-value view 'list-end-indent) t) (setf (slot-value view 'list-end-fmtstr) "~%") (setf (slot-value view 'list-end-value-func) #'xmlformat-list-end-value-func) - (setf (slot-value view 'obj-start-fmtstr) "<~a>") - (setf (slot-value view 'obj-start-value-func) #'class-name-of) + (setf (slot-value view 'obj-start-fmtstr) (format nil "<~(~a~)>" (slot-value view 'object-class))) (setf (slot-value view 'obj-start-indent) t) - (setf (slot-value view 'obj-end-fmtstr) "~%") - (setf (slot-value view 'obj-end-value-func) #'class-name-of) + (setf (slot-value view 'obj-end-fmtstr) (format nil "~%" (slot-value view 'object-class))) (setf (slot-value view 'obj-end-indent) nil) (setf (slot-value view 'obj-data-indent) nil)) @@ -335,11 +334,11 @@ (defun fmt-file-start (view strm) (awhen (slot-value view 'file-start-str) - (format strm it))) + (write-string it strm))) (defun fmt-file-end (view strm) (awhen (slot-value view 'file-end-str) - (format strm it))) + (write-string it strm))) ;;; List Start and Ends @@ -351,7 +350,7 @@ (apply #'format strm fmtstr (multiple-value-list (funcall value-func obj num-items))) - (format strm fmtstr)))) + (write-string fmtstr strm)))) (defun fmt-list-end (obj view strm indent num-items) (declare (ignore num-items)) @@ -361,7 +360,7 @@ (let-if (value-func (slot-value view 'list-end-value-func)) (apply #'format strm fmtstr (multiple-value-list (funcall value-func obj))) - (format strm fmtstr)))) + (write-string fmtstr strm)))) ;;; Object Start and Ends @@ -372,7 +371,7 @@ (let-if (value-func (slot-value view 'obj-start-value-func)) (apply #'format strm fmtstr (multiple-value-list (funcall value-func obj))) - (format strm fmtstr)))) + (write-string fmtstr strm)))) (defun fmt-obj-end (obj view strm indent) (when (slot-value view 'obj-end-indent) @@ -381,7 +380,7 @@ (let-if (value-func (slot-value view 'obj-end-value-func)) (apply #'format strm fmtstr (multiple-value-list (funcall value-func obj))) - (format strm fmtstr)))) + (write-string fmtstr strm)))) ;;; Object Data @@ -460,7 +459,13 @@ subobjects refvars) "Display a single or list of hyperobject-class instances and their subobjects" (let-when (objlist (mklist objs)) - (let ((nobjs (length objlist))) + (let ((nobjs (length objlist)) + (*print-pretty* nil) + (*print-circle* nil) + (*print-escape* nil) + (*print-readably* nil) + (*print-length* nil) + (*print-level* nil)) (fmt-list-start (car objlist) view strm indent nobjs) (dolist (obj objlist) (unless (and filter (not (funcall filter obj)))