Add ASDF utilities from 2.26.7 (merge with asdf-bundle).

diff --git a/package.lisp b/package.lisp
index a28487b..1b3e22b 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -35,7 +35,11 @@
       *wild* *wild-file* *wild-directory* *wild-inferiors*
       *wild-path* wilden directorize-pathname-host-device
       find-class*
-      get-folder-path)))
+      get-folder-path
+      add-pathname-suffix
+      tmpize-pathname
+      call-with-staging-pathname
+      )))
 
 (defpackage :asdf-utils
   (:use :common-lisp)

diff --git a/utils.lisp b/utils.lisp
index ea74626..9876c3d 100644 (file)
--- a/utils.lisp
+++ b/utils.lisp
@@ -690,3 +690,28 @@ with given pathname and if it exists return its truename."
     (:appdata (getenv-absolute-directory "APPDATA"))
     (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA")
                         (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
+
+(defun* add-pathname-suffix (pathname suffix)
+  (make-pathname :name (strcat (pathname-name pathname) suffix)
+                 :defaults pathname))
+
+(defun* tmpize-pathname (x)
+  (add-pathname-suffix x "-ASDF-TMP"))
+
+(defun call-with-staging-pathname (pathname fun)
+  "Calls fun with a staging pathname, and atomically
+renames the staging pathname to the pathname in the end.
+Note: this protects only against failure of the program,
+not against concurrent attempts.
+For the latter case, we ought pick random suffix and atomically open it."
+  (let* ((pathname (pathname pathname))
+         (staging (tmpize-pathname pathname)))
+    (unwind-protect
+         (multiple-value-prog1
+             (funcall fun staging)
+           (rename-file staging pathname #+clozure :if-exists #+clozure :rename-and-delete))
+      (when (probe-file* staging)
+        (delete-file staging)))))
+
+(defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body)
+  `(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body)))