r3565: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 5 Dec 2002 19:57:12 +0000 (19:57 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 5 Dec 2002 19:57:12 +0000 (19:57 +0000)
views.lisp

index d994e4d0363a413daa6d46690750cc65f4119fc4..b0811c44a0050f954297d7610ae674fcc40f046e 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: views.lisp,v 1.8 2002/12/05 19:15:02 kevin Exp $
+;;;; $Id: views.lisp,v 1.9 2002/12/05 19:57:12 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 
 (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 ((print-pos (position (name ref) (hyperobject-class-print-slots x))))
-       (when print-pos
-         (let ((link-start (make-link-start x (link-ref fmt) (name ref) (lookup ref)
-                                            (nth print-pos 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)