X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=c2c71d734edd76677aecc848b114f616126427bc;hb=927d5f069190f0911510fac96298dde23e265840;hp=6776e39e1bc57a8455aa4a7711f09e7a4de281e4;hpb=3537a8422aeb2817b41ee835c5ff45ba1d973c98;p=hyperobject.git diff --git a/views.lisp b/views.lisp index 6776e39..c2c71d7 100644 --- a/views.lisp +++ b/views.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: views.lisp,v 1.56 2003/06/17 17:50:45 kevin Exp $ +;;;; $Id: views.lisp,v 1.58 2003/06/23 20:08:06 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -168,7 +168,7 @@ (defun initialize-view-by-source-code (obj-cl view) "Initialize a view based upon a source code" (let ((source-code (source-code view))) - (error "not implemented") + (warn "source code compilation is not implemented") ) ) @@ -176,9 +176,8 @@ `(typecase ,v (string (write-string ,v ,s)) - #+allegro (fixnum - (excl::print-fixnum ,s 10 ,v)) + (write-fixnum ,v ,s)) (symbol (write-string (symbol-name ,v) ,s)) (t @@ -318,7 +317,8 @@ :xhtml :xhtml-labels :xhtml-link-labels :xhtml-link :html-link :xml :xml-labels :xml-link :ie-xml-link - :xml-link-labels :ie-xml-link-labels) + :xml-link-labels :ie-xml-link-labels + :display-table :edit-table) (error "Unknown view category ~A" (category view))) (unless (slots view) (setf (slots view) (default-print-slots obj-cl))) @@ -386,6 +386,12 @@ (setf (link-ampersand view) "&")))) +(defun make-std-object-slots-view (class-name slots) + #'(lambda (obj strm) + ) + + ) + ;;;; ************************************************************************* ;;;; View Data Format Section ;;;; ************************************************************************* @@ -406,6 +412,7 @@ (setf (list-start-printer view) (compile nil (eval '(lambda (obj nitems indent strm) + (declare (ignore indent)) (write-user-name-maybe-plural obj nitems strm) (write-char #\: strm) (write-char #\Newline strm))))) @@ -415,7 +422,9 @@ (setf (indenter view) #'indent-spaces)) (defun html-list-start-func (obj nitems indent strm) - (write-string "
" strm) + (write-string "
" strm) (write-user-name-maybe-plural obj nitems strm) (write-string "
" strm) (write-char #\newline strm) @@ -424,7 +433,7 @@ (defun initialize-html-view (view) (initialize-text-view view) - (setf (indenter view) #'indent-html-spaces) + (setf (indenter view) #'indent-spaces) (setf (file-start-str view) (format nil "~%")) (setf (file-end-str view) (format nil "~%")) (setf (list-start-indent view) t) @@ -439,28 +448,33 @@ (setf (obj-data-indent view) nil)) (defun xhtml-list-start-func (obj nitems indent strm) - (write-string "
" strm) - (indent-html-spaces indent strm) + (write-string "
" strm) (write-user-name-maybe-plural obj nitems strm) (write-string "
" strm) + (write-string "
" strm) (write-char #\newline strm)) +(defun html-obj-start (obj indent strm) + (declare (ignore obj indent)) + (write-string "
" strm)) + (defun initialize-xhtml-view (view) (initialize-text-view view) - (setf (indenter view) #'indent-html-spaces) + (setf (indenter view) #'indent-spaces) (setf (file-start-str view) (format nil "~%")) (setf (file-end-str view) (format nil "~%")) (setf (list-start-indent view) nil) (setf (list-start-printer view) #'xhtml-list-start-func) - (setf (list-end-printer view) (format nil "~%")) + (setf (list-end-printer view) (format nil "
~%")) (setf (list-end-indent view) nil) (setf (obj-start-indent view) nil) - (setf (obj-start-printer view) nil) + (setf (obj-start-printer view) #'html-obj-start) (setf (obj-end-printer view) (format nil "
~%")) - (setf (obj-data-start-printer view) "
") - (setf (obj-data-end-printer view) nil) - (setf (obj-end-indent view) nil) - (setf (obj-data-indent view) t)) + (setf (obj-data-indent view) nil)) (defun xmlformat-list-end-func (x strm) (write-string "" strm) @@ -486,7 +501,7 @@ (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 (subobj-end-printer view) (format nil "</~(~a~)>~%" (object-class-name view))) + (setf (subobj-end-printer view) (format nil "</~(~a~)>" (object-class-name view))) (setf (subobj-end-indent view) nil) (setf (obj-data-indent view) nil)) @@ -532,7 +547,7 @@ (awhen (obj-start-printer view) (if (stringp it) (write-string it strm) - (funcall it obj strm)))) + (funcall it obj indent strm)))) (defun fmt-obj-end (obj view strm indent) (when (obj-end-indent view) @@ -550,7 +565,7 @@ (awhen (subobj-start-printer view) (if (stringp it) (write-string it strm) - (funcall it obj strm)))) + (funcall it obj indent strm)))) (defun fmt-subobj-end (obj view strm indent) (when (subobj-end-indent view)