From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 Nov 1993 21:36:53 +0000 (+0000)
Subject: Add new procedure DELETE-FILE-NO-ERRORS.
X-Git-Tag: 20090517-FFI~7592
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=af0c8e1e9ed03c3fc8e4ff8e2a3c398401d20ae7;p=mit-scheme.git

Add new procedure DELETE-FILE-NO-ERRORS.
---

diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm
index 80d144849..0d677be70 100644
--- a/v7/src/runtime/sfile.scm
+++ b/v7/src/runtime/sfile.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/sfile.scm,v 14.8 1991/11/04 20:29:58 cph Exp $
+$Id: sfile.scm,v 14.9 1993/11/06 21:36:53 cph Exp $
 
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -47,6 +47,14 @@ MIT in each case. |#
 (define (delete-file filename)
   ((ucode-primitive file-remove) (->namestring (merge-pathnames filename))))
 
+(define (delete-file-no-errors filename)
+  (call-with-current-continuation
+   (lambda (k)
+     (bind-condition-handler (list condition-type:file-error
+				   condition-type:port-error)
+	 (lambda (condition) condition (k unspecific))
+       (lambda () (delete-file filename))))))
+
 (define (copy-file from to)
   (let ((input-filename (->namestring (merge-pathnames from)))
 	(output-filename (->namestring (merge-pathnames to))))