X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/00b2180928c51dd6ca8e767d5b752718c4ca4ab9..5f61c96135dd8b0e795f6e1e5d96708347fc8f5e:/safely.lisp diff --git a/safely.lisp b/safely.lisp index 44a707e..b5d7ff8 100644 --- a/safely.lisp +++ b/safely.lisp @@ -13,12 +13,12 @@ ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. -;;; +;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. -;;; +;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software Foundation, ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. @@ -30,6 +30,11 @@ #: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) @@ -136,19 +141,24 @@ (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." - #+cmu + #+(or cmu sbcl) ;; 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 - (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 @@ -171,7 +181,7 @@ (when (< read (length buffer)) (return copy)))))) (close output))))) - + (defun safely-commit (safe) "Commit SAFE. The files deleted by safely-delete-file are deleted; the files created by safely-open-output-stream are renamed over the old