X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base-class.lisp;h=0da829b3d209a27fb0dffeac4ccd016b080efc52;hb=da95022a6396191e772e59cd7622c7c5919ce605;hp=1e3c5dff4ff1fc0bc3e1ce7c0897a78795a49e90;hpb=67749fdfa2aa1dd4f374e7d87621216d883bc520;p=hyperobject.git diff --git a/base-class.lisp b/base-class.lisp index 1e3c5df..0da829b 100644 --- a/base-class.lisp +++ b/base-class.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: base-class.lisp,v 1.2 2002/12/02 15:57:17 kevin Exp $ +;;;; $Id: base-class.lisp,v 1.3 2002/12/13 05:44:19 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -22,12 +22,10 @@ (:metaclass hyperobject-class) (:description "Basic hyperobject class")) - (defmethod print-object ((obj hyperobject) (s stream)) (print-unreadable-object (obj s :type t :identity t) - (let ((fmt (make-instance 'hyperobject::textformat))) - (apply #'format - s (funcall (obj-data-fmtstr fmt) obj) + (let ((view (get-category-view obj :compact-text))) + (apply #'format s (slot-value view 'obj-data-fmtstr) (multiple-value-list - (funcall (funcall (obj-data-value-func fmt) obj) obj)))))) + (funcall (slot-value view 'obj-data-value-func) obj))))))