chiark
/
gitweb
/
~mdw
/
lisp
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
safely.lisp: Hacking for CLisp support.
[lisp]
/
safely.lisp
diff --git
a/safely.lisp
b/safely.lisp
index 2477f9a721b7350fb997e31d97937a30b43d39af..8cd0f9a635dd6e137414f46448bba475a23e473a 100644
(file)
--- a/
safely.lisp
+++ b/
safely.lisp
@@
-104,6
+104,11
@@
(defun safely-open-output-stream (safe file &rest open-args)
(safely-trail safe))
stream))
(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)
(defun delete-file-without-moaning (file)
"Delete the FILE, ignoring errors."
(handler-case (delete-file file)
@@
-112,7
+117,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."
(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)
(file-error () nil)))
(defun safely-unwind (trail)
@@
-158,6
+163,14
@@
(defun safe-copy (file tag)
(and from to
(unix-link from to)))))
(and from to
(unix-link from to)))))
+ #+clisp
+ (generate-fresh-file-name file tag
+ (lambda (name)
+ (>= (unix:link (namestring file)
+ (namestring name))
+ 0)))
+
+
#-(or cmu sbcl)
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
#-(or cmu sbcl)
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
@@
-207,7
+220,7
@@
(defun safely-commit (safe)
(push `(:rmtmp ,old) cleanup)
(push `(:revert ,old ,file) revert))
(push `(:rmtmp ,file) revert))
(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")))
(:delete (destructuring-bind (tag file) job
(declare (ignore tag))
(let ((old (safe-copy file "delete")))