X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=views.lisp;h=8f0f9b8c2ff377ff205c2011a4bb2e0095140c81;hb=0de08a4b7bd0ee44f96b1a543de6a86c89e7e6a9;hp=f4f075742d6156bb55f0af351f9cd5bd636b65e2;hpb=47a7911aaa793adcce5add7bc912ded4bff18d99;p=hyperobject.git diff --git a/views.lisp b/views.lisp index f4f0757..8f0f9b8 100644 --- a/views.lisp +++ b/views.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: views.lisp,v 1.18 2002/12/26 11:57:15 kevin Exp $ +;;;; $Id: views.lisp,v 1.25 2003/03/26 21:03:22 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -20,8 +20,12 @@ (defclass object-view () - ((object-class :initform nil :initarg :object-class :accessor object-class - :documentation "Name of class for object to be viewed.") + ((object-class-name :initform nil :initarg :object-class-name + :accessor object-class-name + :documentation "Name of class of object to be viewed.") + (object-class :initform nil :initarg :object-class + :accessor object-class + :documentation "Class of object to be viewed.") (slots :initform nil :initarg :slots :accessor slots :documentation "List of effective slots for object to be viewed.") (name :initform nil :initarg :name :accessor name @@ -97,7 +101,9 @@ (aif (find category (views obj-class) :key #'category) it (let ((view - (make-instance 'object-view :object-class (class-name obj-class) + (make-instance 'object-view + :object-class-name (class-name obj-class) + :object-class obj-class :category category :slots slots))) (push view (views obj-class)) @@ -132,7 +138,8 @@ ((eq view-def :default) (let* ((name (class-name cl)) (view (make-instance 'object-view :name "automatic" - :object-class name + :object-class-name name + :object-class cl :category :compact-text))) view)) ((consp view-def) @@ -142,7 +149,7 @@ (defmethod initialize-instance :after ((view object-view) &rest initargs &key &allow-other-keys) - (initialize-view (find-class (object-class view)) view)) + (initialize-view (object-class view) view)) (defun initialize-view (obj-cl view) "Calculate all view slots for a hyperobject class" @@ -186,7 +193,7 @@ (error "Slot ~A is not found in class ~S" slot-name obj-cl)) (let* ((name (slot-definition-name slot)) (namestr-lower (string-downcase (symbol-name name))) - (xml-namestring (escape-xml-string namestr-lower)) + (xml-namestr (escape-xml-string namestr-lower)) (xml-tag (escape-xml-string namestr-lower)) (type (slot-value slot 'type)) (print-formatter (esd-print-formatter slot))) @@ -244,7 +251,7 @@ ((or :xml-link-labels :ie-xml-link-labels) (push name links) (if (esd-hyperlink slot) - (string-append fmtstr " <~~a>" value-fmt "") + (string-append fmtstr " <~~a>" value-fmt "") (string-append fmtstr (concatenate 'string " <" xml-tag ">" value-fmt ""))))) ) ;; let value-fmt @@ -252,6 +259,7 @@ `(,print-formatter (slot-value x (quote ,name))) `(slot-value x (quote ,name))))) (when (and (in category :xml :xhtml :xml-link :xhtml-link + :xml-labels :ie-xml-labels :xhtml-link-labels :xml-link-labels :ie-xml-link :ie-xml-link-labels) (or print-formatter @@ -376,9 +384,9 @@ (setf (list-end-indent view) t) (setf (list-end-fmtstr view) "~%") (setf (list-end-value-func view) #'xmlformat-list-end-value-func) - (setf (obj-start-fmtstr view) (format nil "<~(~a~)>" (object-class view))) + (setf (obj-start-fmtstr view) (format nil "<~(~a~)>" (object-class-name view))) (setf (obj-start-indent view) t) - (setf (obj-end-fmtstr view) (format nil "~%" (object-class view))) + (setf (obj-end-fmtstr view) (format nil "~%" (object-class-name view))) (setf (obj-end-indent view) nil) (setf (obj-data-indent view) nil)) @@ -553,4 +561,3 @@ (defun fmt-comma-integer (i) (format nil "~:d" i)) -