[mcclim-cvs] CVS mcclim

thenriksen thenriksen at common-lisp.net
Sun Jan 14 19:59:07 UTC 2007


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

Modified Files:
	presentation-defs.lisp 
Log Message:
Fixed `presentation-history-previous' to work properly with an empty
history.


--- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp	2007/01/10 11:19:01	1.68
+++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp	2007/01/14 19:59:07	1.69
@@ -686,17 +686,19 @@
     (if (and (numberp pointer) (zerop pointer))
         (values nil nil)
         (progn
-          (if pointer
-              (decf pointer)
-              (setf pointer (1- (fill-pointer array))))
-          (destructuring-bind (object . object-ptype)
-              (when (array-in-bounds-p array pointer)
-                (aref array pointer))
-            (if object-ptype
-                (if (presentation-subtypep object-ptype ptype)
-                    (values object object-ptype)
-                    (progn (presentation-history-previous history ptype)))
-                (values nil nil)))))))
+          (cond ((and (numberp pointer) (plusp pointer))
+                 (decf pointer))
+                ((plusp (length array))
+                 (setf pointer (1- (fill-pointer array)))))
+          (if (and (numberp pointer) (array-in-bounds-p array pointer))
+              (destructuring-bind (object . object-ptype)
+                  (aref array pointer)
+                (if object-ptype
+                    (if (presentation-subtypep object-ptype ptype)
+                        (values object object-ptype)
+                        (progn (presentation-history-previous history ptype)))
+                    (values nil nil)))
+              (values nil nil))))))
 
 (defmacro with-object-on-history ((history object ptype) &body body)
   "Evaluate `body' with `object' as `ptype' as the head (most




More information about the Mcclim-cvs mailing list