[mcclim-cvs] CVS mcclim/ESA

[thenriksen]

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

Modified Files:
	utils.lisp packages.lisp 
Log Message:
Added `maptree' utility function.


--- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp	2006/11/08 01:10:15	1.1
+++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp	2006/12/09 21:28:05	1.2
@@ -192,4 +192,16 @@
   "binds NEW-VAR (defaults to VAR) to VAR with the keyword arguments specified
 in KEYWORDS removed."
   `(let ((,new-var (remove-keywords ,var ',keywords)))
-     , at body))
\ No newline at end of file
+     , at body))
+
+(defun maptree (fn x)
+  "This auxiliary function is like MAPCAR but has two extra
+purposes: (1) it handles dotted lists; (2) it tries to make the
+result share with the argument x as much as possible."
+  (if (atom x) 
+      (funcall fn x) 
+      (let ((a (funcall fn (car x))) 
+            (d (maptree fn (cdr x)))) 
+        (if (and (eql a (car x)) (eql d (cdr x))) 
+            x 
+            (cons a d)))))
--- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp	2006/11/08 01:10:15	1.1
+++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp	2006/12/09 21:28:05	1.2
@@ -39,7 +39,8 @@
            #:case-relevant-test
            #:with-keywords-removed
            #:invoke-with-dynamic-bindings-1
-           #:invoke-with-dynamic-bindings))
+           #:invoke-with-dynamic-bindings
+           #:maptree))
 
 (defpackage :esa
   (:use :clim-lisp :clim :esa-utils)