r3587: *** empty log message ***

[hyperobject.git] / views.lisp

diff --git a/views.lisp b/views.lisp
index f6f052f9c23e2e821c3ac6ff8e0ffa892e458e3c..a80c1e9a58051331c17fae8530096be424fd0241 100644 (file)
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: views.lisp,v 1.7 2002/12/05 18:31:36 kevin Exp $
+;;;; $Id: views.lisp,v 1.11 2002/12/09 10:39:38 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -218,11 +218,15 @@
    (obj-data-end-fmtstr :initarg :obj-data-end-fmtstr :reader obj-data-end-fmtstr)
    (obj-data-value-func :initarg :obj-data-value-func :reader obj-data-value-func)
    (link-ref :initarg :link-ref :reader link-ref))
-  (:default-initargs :file-start-str nil :file-end-str nil :list-start-fmtstr nil :list-start-value-func nil
-                    :list-start-indent nil :list-end-fmtstr nil :list-end-value-func nil :list-end-indent nil
-                    :obj-start-fmtstr nil :obj-start-value-func nil :obj-start-indent nil
-                    :obj-end-fmtstr nil :obj-end-value-func nil :obj-end-indent nil
-                    :obj-data-indent nil :obj-data-fmtstr nil :obj-data-fmtstr-labels nil :obj-data-end-fmtstr nil
+  (:default-initargs :file-start-str nil :file-end-str nil
+                    :list-start-fmtstr nil :list-start-value-func nil
+                    :list-start-indent nil :list-end-fmtstr nil
+                    :list-end-value-func nil :list-end-indent nil
+                    :obj-start-fmtstr nil :obj-start-value-func nil
+                    :obj-start-indent nil :obj-end-fmtstr nil
+                    :obj-end-value-func nil :obj-end-indent nil
+                    :obj-data-indent nil :obj-data-fmtstr nil
+                    :obj-data-fmtstr-labels nil :obj-data-end-fmtstr nil
                     :obj-data-value-func nil :link-ref nil)
   (:documentation "Parent for all dataformat objects"))
 
@@ -233,7 +237,7 @@
   ())
 
 (defun text-list-start-value-func (obj nitems)
-  (values (hyperobject-class-title obj) nitems))
+  (values (hyperobject-class-user-name obj) nitems))
 
 (defclass textformat (dataformat) 
   ()   
@@ -251,7 +255,7 @@
   (string-downcase (class-name (class-of obj))))
 
 (defun htmlformat-list-start-value-func (x nitems) 
-  (values (hyperobject-class-title x) nitems (class-name-of x)))
+  (values (hyperobject-class-user-name x) nitems (class-name-of x)))
 
 (defclass htmlformat (textformat) 
   ()
@@ -300,7 +304,7 @@
   (format nil "~alist" (class-name-of x)))
 
 (defun xmlformat-list-start-value-func (x nitems) 
-  (values (format nil "~alist" (class-name-of x)) (hyperobject-class-title x) nitems))
+  (values (format nil "~alist" (class-name-of x)) (hyperobject-class-user-name x) nitems))
 
 (defclass xmlformat (textformat) 
   ()
@@ -485,26 +489,17 @@
 
 (defgeneric fmt-obj-data-with-ref (obj fmt s label refvars))
 (defmethod fmt-obj-data-with-ref (x (fmt textformat) s label refvars)
-  (let ((refstr (make-ref-data-str x fmt label))
-       (refvalues nil)
-       (field-values 
-        (multiple-value-list
-         (funcall (funcall (obj-data-value-func fmt) x) x))))
-    
+  (let ((refvalues '()))
     ;; make list of hyperlink link fields for printing to refstr template
-    (dolist (ref (hyperobject-class-hyperlinks x))
-      (let ((link-start 
-            (make-link-start x (link-ref fmt) (name ref) (lookup ref)
-                             (nth (position (name ref)
-                                            (slot-value x 'print-slots))
-                                  field-values)  
-                             (append (link-parameters ref) refvars)))
-           (link-end (make-link-end x (link-ref fmt) (name ref))))
-       (push link-start refvalues)
-       (push link-end refvalues)))
+    (dolist (name (hyperobject-class-print-slots x))
+      (let-when (hyperlink (find name (hyperobject-class-hyperlinks x) :key #'name))
+       (push  (make-link-start x (link-ref fmt) name (lookup hyperlink)
+                               (slot-value x name)
+                               (append (link-parameters hyperlink) refvars))
+              refvalues)
+       (push (make-link-end x (link-ref fmt) name) refvalues)))
     (setq refvalues (nreverse refvalues))
-    
-    (apply #'format s refstr refvalues)))
+    (apply #'format s (make-ref-data-str x fmt label) refvalues)))
 
 (defgeneric obj-data (obj))
 (defmethod obj-data (x)
@@ -539,7 +534,7 @@
       (dolist (obj objlist)
         (awhen (hyperobject-class-subobjects obj)  ;; access list of functions
           (dolist (child-obj it)   ;; for each child function
-            (awhen (funcall (reader child-obj) obj)
+            (awhen (slot-value obj (name-slot child-obj))
               (load-all-subobjects it))))))
     objs))
 
@@ -565,10 +560,10 @@
           (if subobjects
               (awhen (hyperobject-class-subobjects obj)  ;; access list of functions
                         (dolist (child-obj it)   ;; for each child function
-                          (awhen (funcall (reader child-obj) obj) ;; access set of child objects
-                                    (view-hyperobject it fmt strm label 
-                                                     (1+ indent) english-only-function
-                                                    subobjects refvars)))))
+                          (awhen (slot-value obj (name-slot child-obj)) ;; access set of child objects
+                                (view-hyperobject it fmt strm label 
+                                                  (1+ indent) english-only-function
+                                                  subobjects refvars)))))
           (fmt-obj-end obj fmt strm indent)))
       (fmt-list-end (car objs) fmt strm indent nobjs))
     t))