;;;; 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
;;;;
(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) "<html><body>~%")
- (setf (slot-value view 'file-end-str) "</body><html>~%")
+ (setf (slot-value view 'file-start-str) (format nil "<html><body>~%"))
+ (setf (slot-value view 'file-end-str) (format nil "</body><html>~%"))
(setf (slot-value view 'list-start-indent) t)
(setf (slot-value view 'list-start-fmtstr)
"<p><b>~a~p:</b></p><div class=\"~A\"><ul>~%")
(setf (slot-value view 'list-start-value-func)
#'htmlformat-list-start-value-func)
- (setf (slot-value view 'list-end-fmtstr) "</ul></div>~%")
+ (setf (slot-value view 'list-end-fmtstr) (format nil "</ul></div>~%"))
(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) "<li>")
(setf (slot-value view 'obj-start-value-func) nil)
(setf (slot-value view 'obj-end-indent) t)
- (setf (slot-value view 'obj-end-fmtstr) "</li>~%")
+ (setf (slot-value view 'obj-end-fmtstr) (format nil "</li>~%"))
(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) "<html><body>~%")
- (setf (slot-value view 'file-end-str) "</body><html>~%")
+ (setf (slot-value view 'file-start-str) (format nil "<html><body>~%"))
+ (setf (slot-value view 'file-end-str) (format nil "</body><html>~%"))
(setf (slot-value view 'list-start-indent) t)
(setf (slot-value view 'list-start-fmtstr)
"<p><b>~a~p:</b></p><div class=\"~A\"><ul>~%")
(setf (slot-value view 'list-start-value-func)
#'htmlformat-list-start-value-func)
- (setf (slot-value view 'list-end-fmtstr) "</ul></div>~%")
+ (setf (slot-value view 'list-end-fmtstr) (format nil "</ul></div>~%"))
(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) "<li>")
(setf (slot-value view 'obj-start-value-func) nil)
(setf (slot-value view 'obj-end-indent) t)
- (setf (slot-value view 'obj-end-fmtstr) "</li>~%")
+ (setf (slot-value view 'obj-end-fmtstr) (format nil "</li>~%"))
(setf (slot-value view 'obj-end-value-func) nil)
(setf (slot-value view 'obj-data-indent) t))
(setf (slot-value view 'list-end-indent) t)
(setf (slot-value view 'list-end-fmtstr) "</~a>~%")
(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) "</~a>~%")
- (setf (slot-value view 'obj-end-value-func) #'class-name-of)
+ (setf (slot-value view 'obj-end-fmtstr) (format nil "</~(~a~)>~%" (slot-value view 'object-class)))
(setf (slot-value view 'obj-end-indent) nil)
(setf (slot-value view 'obj-data-indent) nil))
(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
(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))
(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
(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)
(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
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)))
projects / hyperobject.git / blobdiff