chiark
/
gitweb
/
~mdw
/
lisp
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
optparse-test: Fix to use cl-launch with /bin/sh hack.
[lisp]
/
safely.lisp
diff --git
a/safely.lisp
b/safely.lisp
index 0a05f8b174cc6371a15b4cdb5f19a2342532f37b..b5d7ff8f895982c27a589b968f35f58cd8cd4816 100644
(file)
--- a/
safely.lisp
+++ b/
safely.lisp
@@
-30,6
+30,11
@@
(defpackage #:safely
#:safely-writing))
(in-package #:safely)
#:safely-writing))
(in-package #:safely)
+#+(or cmu sbcl)
+(eval-when (:compile-toplevel :execute)
+ (import #+cmu '(ext:unix-namestring unix:unix-link)
+ #+sbcl '(sb-int:unix-namestring)))
+
(defstruct (safely (:predicate safelyp))
"Stores information about how to commit or undo safe writes."
(streams nil)
(defstruct (safely (:predicate safelyp))
"Stores information about how to commit or undo safe writes."
(streams nil)
@@
-136,19
+141,24
@@
(defun safely-bail (safe)
(safely-unwind (safely-trail safe))
(safely-reset safe))
(safely-unwind (safely-trail safe))
(safely-reset safe))
+#+sbcl
+(defun unix-link (from to)
+ (sb-unix::int-syscall ("link" sb-alien:c-string sb-alien:c-string)
+ from to))
+
(defun safe-copy (file tag)
"Make a copy of the FILE. Return the new name."
(defun safe-copy (file tag)
"Make a copy of the FILE. Return the new name."
- #+
cmu
+ #+
(or cmu sbcl)
;; Use link(2) where available.
(generate-fresh-file-name file tag
(lambda (name)
;; Use link(2) where available.
(generate-fresh-file-name file tag
(lambda (name)
- (let ((from (
ext:
unix-namestring file t))
- (to (
ext:
unix-namestring name nil)))
+ (let ((from (unix-namestring file t))
+ (to (unix-namestring name nil)))
(and from to
(and from to
- (unix
:unix
-link from to)))))
+ (unix-link from to)))))
- #-
cmu
+ #-
(or cmu sbcl)
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
(multiple-value-bind
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
(multiple-value-bind