[mcclim-cvs] CVS update: mcclim/presentation-defs.lisp

[Timothy Moore]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv20050

Modified Files:
	presentation-defs.lisp 
Log Message:
For CLOS objects, make presentation-type-of return the name of the class if possible
Date: Wed Jan 19 14:44:46 2005
Author: tmoore

Index: mcclim/presentation-defs.lisp
diff -u mcclim/presentation-defs.lisp:1.39 mcclim/presentation-defs.lisp:1.40
--- mcclim/presentation-defs.lisp:1.39	Tue Jan 11 05:02:19 2005
+++ mcclim/presentation-defs.lisp	Wed Jan 19 14:44:46 2005
@@ -87,11 +87,15 @@
 (defmethod presentation-type-of ((object standard-object))
   (multiple-value-bind (name lambda-list)
       (get-ptype-from-class-of object)
-    (if (and name
-             (or (null lambda-list)
-                 (member (first lambda-list) lambda-list-keywords)))
-        name
-        (call-next-method))))       
+    (cond ((and name
+		(or (null lambda-list)
+		    (member (first lambda-list) lambda-list-keywords)))
+	   name)
+	  (name
+	   'standard-object)
+	  (t (let* ((class (class-of object))
+		    (class-name (class-name class)))
+	       (or class-name class))))))
 
 (defmethod presentation-type-of ((object structure-object))
   (multiple-value-bind (name lambda-list)
@@ -100,7 +104,6 @@
             (member lambda-list lambda-list-keywords))
         name
         (call-next-method))))
-  
 
 (define-presentation-generic-function
     %map-over-presentation-type-supertypes