[asdf-addons-cvs] r2 - trunk/asdf-addons

[mkocic at common-lisp.net]

Author: mkocic
Date: Wed May 24 08:43:08 2006
New Revision: 2

Modified:
   trunk/asdf-addons/asdf-cache.lisp
Log:
Added support for exclusions. Exclueded folders (and it's subfolders) will not be cached.


Modified: trunk/asdf-addons/asdf-cache.lisp
==============================================================================
--- trunk/asdf-addons/asdf-cache.lisp	(original)
+++ trunk/asdf-addons/asdf-cache.lisp	Wed May 24 08:43:08 2006
@@ -1,11 +1,13 @@
 (defpackage #:asdf-cache
     (:use #:cl)
-  (:export #:*asdf-cache*))
+  (:export #:*asdf-cache*
+	   #:*exclusions*))
 
 (in-package #:asdf-cache)
 
 ;;; clc like functionality
 (defparameter *asdf-cache* nil)
+(defparameter *exclusions* nil)
 
 (defparameter *implementation-features*
   '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp
@@ -45,19 +47,28 @@
             (first-of *architecture-features*)
             (lisp-version-string))))
 
-
+(defun excluded (path)
+  (let ((target (directory-namestring path)))
+    (dolist (exc *exclusions*)
+      ;;(format t "exc = ~A~&"  exc)
+      ;;(format t "target = ~A~&"  target)
+      (when (search exc target)
+	(return t)))))
+
+(defun calculate-path (path)
+  (if (excluded path)
+      path
+      (merge-pathnames
+       (make-pathname :directory
+		      (append
+		       (pathname-directory *asdf-cache*)
+		       (list ".fasls" (unique-directory-name))
+		       (rest (pathname-directory path))))
+       path)))
 
 (defmethod asdf:output-files :around ((op asdf:compile-op) (src asdf:source-file))
   (unless *asdf-cache*
     (error "*asdf-cache* must be set to not nil value"))
   (let ((paths (call-next-method)))
-    (mapcar (lambda (path)
-              (merge-pathnames
-               (make-pathname :directory
-                              (append
-                               (pathname-directory *asdf-cache*)
-                               (list ".fasls" (unique-directory-name))
-                               (rest (pathname-directory path))))
-               path))
-            paths)))
-
+    (mapcar #'calculate-path 
+            paths)))
\ No newline at end of file