X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/lisp/blobdiff_plain/2d9f4fc0d90318686f2d2f691c893174ef1bbc0c..39bf02db3dc4419a6451f2c68996c48187a20d1f:/safely.lisp

diff --git a/safely.lisp b/safely.lisp
index 4830a99..84a06c4 100644
--- a/safely.lisp
+++ b/safely.lisp
@@ -110,6 +110,11 @@ (defun safely-open-output-stream (safe file &rest open-args)
 	  (safely-trail safe))
     stream))
 
+(declaim (inline rename))
+(defun rename (old new)
+  #-clisp (rename-file old new)
+  #+clisp (posix:copy-file old new :method :rename))
+
 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."
   (handler-case (delete-file file)
@@ -118,7 +123,7 @@ (defun delete-file-without-moaning (file)
 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
    mangling."
-  (handler-case (rename-file old new)
+  (handler-case (rename old new)
     (file-error () nil)))
 
 (defun safely-unwind (trail)
@@ -166,6 +171,16 @@ (defun safe-copy (file tag)
 				(and from to
 				     (unix-link from to)))))
 
+  #+clisp
+  (generate-fresh-file-name file tag
+			    (lambda (name)
+			      (posix:copy-file (namestring file)
+					       (namestring name)
+					       :method :hardlink
+					       :if-exists nil)))
+
+
+
   #-(or cmu sbcl)
   ;; Otherwise just copy the file contents and hope for the best.
   (with-open-file (input file :element-type :default)
@@ -215,7 +230,7 @@ (defun safely-commit (safe)
 				  (push `(:rmtmp ,old) cleanup)
 				  (push `(:revert ,old ,file) revert))
 				(push `(:rmtmp ,file) revert))
-			    (rename-file new file)))
+			    (rename new file)))
 		  (:delete (destructuring-bind (tag file) job
 			     (declare (ignore tag))
 			     (let ((old (safe-copy file "delete")))