#+(or cmu sbcl)
(eval-when (:compile-toplevel :execute)
(import #+cmu '(ext:unix-namestring unix:unix-link)
- #+sbcl '(sb-int:unix-namestring)))
+ #+sbcl '(sb-ext:native-namestring)))
+#+cmu
+(progn
+ (declaim (inline unix-namestring))
+ (defun native-namestring (pathname &key as-file)
+ (declare (ignore as-file))
+ (unix-namestring pathname nil)))
(defstruct (safely (:predicate safelyp))
"Stores information about how to commit or undo safe writes."
;; Use link(2) where available.
(generate-fresh-file-name file tag
(lambda (name)
- (let ((from (unix-namestring file t))
- (to (unix-namestring name nil)))
+ (let ((from (native-namestring file
+ :as-file t))
+ (to (native-namestring name
+ :as-file t)))
(and from to
(unix-link from to)))))
(loop
(unless trail
(return))
- (let ((job (pop trail)))
- (ecase (car job)
- (:shunt (destructuring-bind (tag new file) job
- (declare (ignore tag))
- (push `(:rmtmp ,new) revert)
- (if (probe-file file)
- (let ((old (safe-copy file "old")))
- (push `(:rmtmp ,old) cleanup)
- (push `(:revert ,old ,file) revert))
- (push `(:rmtmp ,file) revert))
- (rename new file)))
- (:delete (destructuring-bind (tag file) job
- (declare (ignore tag))
- (let ((old (safe-copy file "delete")))
- (push `(:revert ,old ,file) revert)
- (push `(:rmtmp ,old) cleanup)
- (delete-file file)))))))
+ (let ((job (pop trail)))
+ (ecase (car job)
+ (:shunt (destructuring-bind (tag new file) job
+ (declare (ignore tag))
+ (push `(:rmtmp ,new) revert)
+ (if (probe-file file)
+ (let ((old (safe-copy file "old")))
+ (push `(:rmtmp ,old) cleanup)
+ (push `(:revert ,old ,file) revert))
+ (push `(:rmtmp ,file) revert))
+ (rename new file)))
+ (:delete (destructuring-bind (tag file) job
+ (declare (ignore tag))
+ (let ((old (safe-copy file "delete")))
+ (push `(:revert ,old ,file) revert)
+ (push `(:rmtmp ,old) cleanup)
+ (delete-file file)))))))
(setf revert nil))
(safely-unwind trail)
(safely-unwind revert)