[mcclim-cvs] CVS update: mcclim/Apps/Listener/dev-commands.lisp

[Robert Goldman]

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

Modified Files:
	dev-commands.lisp 
Log Message:
Made class-grapher update space requirements.
Date: Tue Dec  6 17:21:58 2005
Author: rgoldman

Index: mcclim/Apps/Listener/dev-commands.lisp
diff -u mcclim/Apps/Listener/dev-commands.lisp:1.31 mcclim/Apps/Listener/dev-commands.lisp:1.32
--- mcclim/Apps/Listener/dev-commands.lisp:1.31	Thu Oct 13 17:15:24 2005
+++ mcclim/Apps/Listener/dev-commands.lisp	Tue Dec  6 17:21:58 2005
@@ -440,24 +440,29 @@
         (arrow-ink  *graph-edge-ink*)
 	(text-style *graph-text-style*))
     (with-drawing-options (stream :text-style text-style)
-      (format-graph-from-roots (list class)
-                               #'(lambda (class stream)
-                                   (with-drawing-options (stream :ink normal-ink
-                                                                 :text-style text-style)
-                                     ;; Present class name rather than class here because the printing of the
-                                     ;; class object itself is rather long and freaks out the pointer doc pane.
-                                     (with-output-as-presentation (stream (clim-mop:class-name class) 'class-name)
-                                        ; (surrounding-output-with-border (stream :shape :drop-shadow)
-				       (princ (clim-mop:class-name class) stream)))) ;)
-                               inferior-fun
-                               :stream stream
-                               :merge-duplicates T
-                               :graph-type :tree
-                               :orientation orientation
-                               :arc-drawer
-                               #'(lambda (stream foo bar x1 y1 x2 y2)
-                                   (declare (ignore foo bar))
-                                   (draw-arrow* stream x1 y1 x2 y2 :ink arrow-ink))))))
+      (prog1
+	;; not sure whether anyone wants the return value...
+	(format-graph-from-roots (list class)
+				 #'(lambda (class stream)
+				     (with-drawing-options (stream :ink normal-ink
+								   :text-style text-style)
+				       ;; Present class name rather than class here because the printing of the
+				       ;; class object itself is rather long and freaks out the pointer doc pane.
+				       (with-output-as-presentation (stream (clim-mop:class-name class) 'class-name)
+					; (surrounding-output-with-border (stream :shape :drop-shadow)
+					 (princ (clim-mop:class-name class) stream)))) ;)
+				 inferior-fun
+				 :stream stream
+				 :merge-duplicates T
+				 :graph-type :tree
+				 :orientation orientation
+				 :arc-drawer
+				 #'(lambda (stream foo bar x1 y1 x2 y2)
+				     (declare (ignore foo bar))
+				     (draw-arrow* stream x1 y1 x2 y2 :ink arrow-ink)))
+	;; format-graph-from-roots doesn't do this by default...
+	(when (typep stream 'pane)
+	  (change-space-requirements stream))))))
 
 (defun frob-to-class (spec)
   (if (typep spec 'class)