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

[Andy Hefner]

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

Modified Files:
	presentation-defs.lisp 
Log Message:
Fix presentation system bug which produced incorrect results for 
presentation-type-of.

Date: Sun Jan  2 06:28:38 2005
Author: ahefner

Index: mcclim/presentation-defs.lisp
diff -u mcclim/presentation-defs.lisp:1.37 mcclim/presentation-defs.lisp:1.38
--- mcclim/presentation-defs.lisp:1.37	Sun Dec  5 20:37:52 2004
+++ mcclim/presentation-defs.lisp	Sun Jan  2 06:28:38 2005
@@ -76,19 +76,20 @@
   (let* ((name (class-name (class-of object)))
 	 (ptype-entry (gethash name *presentation-type-table*)))
     (unless ptype-entry
-      (return-from get-ptype-from-class-of name))
+      (return-from get-ptype-from-class-of nil))
     ;; Does the type have required parameters?  If so, we can't use it...
     (let ((parameter-ll (parameters-lambda-list ptype-entry)))
       (values name 
               (if (eq (car parameter-ll) '&whole)
                   (cddr parameter-ll)
-                  parameter-ll)))))      
+                  parameter-ll)))))
 
 (defmethod presentation-type-of ((object standard-object))
   (multiple-value-bind (name lambda-list)
       (get-ptype-from-class-of object)
-    (if (or (null lambda-list)
-            (member lambda-list lambda-list-keywords))
+    (if (and name
+             (or (null lambda-list)
+                 (member (first lambda-list) lambda-list-keywords)))
         name
         (call-next-method))))