Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv20834
Modified Files: dev-commands.lisp Log Message: Made com-show-class-slots check to make sure that inheritance was finalized on the class object that the user is inquiring about. ACL is not aggressive about finalizing class inheritance, and if you invoke class-slots on a class that's not finalized, you get an error. The CLIM-Listener will check for this condition and finalize the object class, if necessary.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2007/06/02 20:30:53 1.42 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2007/09/04 20:45:54 1.43 @@ -672,25 +672,29 @@ class))))
(define-command (com-show-class-slots :name "Show Class Slots" - :command-table show-commands + :command-table show-commands :menu "Class Slots" - :provide-output-destination-keyword t) + :provide-output-destination-keyword t) ((class-name 'clim:symbol :prompt "class name")) - (let ((class (find-class class-name nil))) - (if (null class) - (format t "~&~A is not a defined class.~%" class-name) - (let ((slots (clim-mop:class-slots class))) - (if (null slots) - (note "~%This class has no slots.~%~%") - (progn - ; oddly, looks much better in courier, because of all the capital letters. -; (with-text-family (t :sans-serif) - (invoke-as-heading - (lambda () - (format t "~&Slots for ") - (with-output-as-presentation (t (clim-mop:class-name class) 'class-name :single-box t) - (princ (clim-mop:class-name class))))) - (present-the-slots class) )))))) + (let* ((class (find-class class-name nil)) + (finalized-p (and class + (progn + (clim-mop:finalize-inheritance class) + (clim-mop:class-finalized-p class)))) + (slots (and finalized-p (clim-mop:class-slots class)))) + (cond + ((null class) + (note "~A is not a defined class.~%" class-name)) + ((not finalized-p) + (note "Class ~A is not finalized." class-name)) + ((null slots) + (note "~%This class has no slots.~%~%")) + (t (invoke-as-heading + (lambda () + (format t "~&Slots for ") + (with-output-as-presentation (t (clim-mop:class-name class) 'class-name :single-box t) + (princ (clim-mop:class-name class))))) + (present-the-slots class)))))
(defparameter *ignorable-internal-class-names* '(standard-object))