[mcclim-cvs] CVS mcclim

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv31502

Modified Files:
	dialog.lisp 
Log Message:
Do some compile-time analysis to remove unreachable-code warnings at
compile-time for uses of `accepting-values'.


--- /project/mcclim/cvsroot/mcclim/dialog.lisp	2006/12/13 15:31:07	1.24
+++ /project/mcclim/cvsroot/mcclim/dialog.lisp	2006/12/21 23:14:20	1.25
@@ -164,18 +164,22 @@
             x-position y-position width height command-table frame-class))
   (setq stream (stream-designator-symbol stream '*standard-input*))
   (with-gensyms (accepting-values-continuation)
-    (let ((return-form
-           `(flet ((,accepting-values-continuation (,stream)
-                     , at body))
-              (invoke-accepting-values ,stream
-                                       #',accepting-values-continuation
-                                       , at args))
-            ))
-      `(if  ,own-window
-            (with-stream-in-own-window (,stream *standard-input* *standard-output*)
-                                       (,label)
-                                       ,return-form)
-           ,return-form))))
+    (let* ((return-form
+            `(flet ((,accepting-values-continuation (,stream)
+                      , at body))
+               (invoke-accepting-values ,stream
+                                        #',accepting-values-continuation
+                                        , at args)))
+           (true-form `(with-stream-in-own-window (,stream *standard-input* *standard-output*)
+                         (,label)
+                         ,return-form)))
+      ;; To avoid unreachable-code warnings, if `own-window' is a
+      ;; boolean constant, don't generate the `if' form.
+      (cond ((eq own-window t) true-form)
+            ((eq own-window nil) return-form)
+            (t `(if ,own-window
+                    ,true-form
+                    ,return-form))))))
 
 (defun invoke-accepting-values
     (stream body