[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv8450

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Make fasl-pathname fully customizable not only the direcrory part.

* swank.lisp (*fasl-pathname-function*): New variable.
(*fasl-directory*): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/03/07 21:12:33	1.1713
+++ /project/slime/cvsroot/slime/ChangeLog	2009/03/09 11:06:24	1.1714
@@ -1,3 +1,10 @@
+2009-03-09  Helmut Eller  <heller at common-lisp.net>
+
+	Make fasl-pathname fully customizable not only the direcrory part.
+
+	* swank.lisp (*fasl-pathname-function*): New variable.
+	(*fasl-directory*): Deleted.
+
 2009-03-08  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-choose-overlay-for-read-error): Extraced and
--- /project/slime/cvsroot/slime/swank.lisp	2009/02/26 21:19:45	1.638
+++ /project/slime/cvsroot/slime/swank.lisp	2009/03/09 11:06:24	1.639
@@ -29,7 +29,7 @@
            ;; These are user-configurable variables:
            #:*communication-style*
            #:*dont-close*
-           #:*fasl-directory*
+           #:*fasl-pathname-function*
            #:*log-events*
            #:*log-output*
            #:*use-dedicated-output-stream*
@@ -2758,17 +2758,17 @@
            (declare (ignore output-pathname warnings?))
            (not failure?)))))))
 
-(defvar *fasl-directory* nil
-  "Directory where swank should place fasl files.")
+(defvar *fasl-pathname-function* nil
+  "In non-nil, use this function to compute the name for fasl-files.")
 
 (defun fasl-pathname (input-file options)
-  (cond ((getf options :fasl-directory)
+  (cond (*fasl-pathname-function*
+         (funcall *fasl-pathname-function* input-file options))
+        ((getf options :fasl-directory)
          (let* ((str (getf options :fasl-directory))
                 (dir (filename-to-pathname str)))
            (assert (char= (aref str (1- (length str))) #\/))
            (compile-file-pathname input-file :output-file dir)))
-        (*fasl-directory*
-         (compile-file-pathname input-file :output-file *fasl-directory*))
         (t
          (compile-file-pathname input-file))))