X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base-class.lisp;h=24c24a386c07133b644bd1e4e84f6078f2d79b32;hb=da57e4f1ef6bef626996ce87fca1abf225274128;hp=1e3c5dff4ff1fc0bc3e1ce7c0897a78795a49e90;hpb=84f9a22269a37d2d58bdb0f6211f8757855c18ab;p=hyperobject.git diff --git a/base-class.lisp b/base-class.lisp index 1e3c5df..24c24a3 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.4 2002/12/13 08:25:45 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 (obj-data-fmtstr view) (multiple-value-list - (funcall (funcall (obj-data-value-func fmt) obj) obj)))))) + (funcall (obj-data-value-func view) obj))))))