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)
@@ -470,6 +484,7 @@
(write-char #\newline strm))
(defun xmlformat-list-start-func (x nitems indent strm)
+ (declare (ignore indent))
(write-char #\< strm)
(write-string (class-name-of x) strm)
(write-string "list>
" 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)