Simplify CATCH-FILE-ERRORS so that the error-handling procedure always
authorChris Hanson <org/chris-hanson/cph>
Thu, 10 May 2001 18:22:37 +0000 (18:22 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 10 May 2001 18:22:37 +0000 (18:22 +0000)
gets the condition as an argument.

v7/src/edwin/autosv.scm
v7/src/edwin/dired.scm
v7/src/edwin/fileio.scm
v7/src/edwin/utils.scm
v7/src/edwin/vc.scm

index bf529ebacd1e271e88901fb55b48b02104b8a016..0879d8da100ac57663bec872070c44b016abc539 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: autosv.scm,v 1.33 1999/01/02 06:11:34 cph Exp $
+;;; $Id: autosv.scm,v 1.34 2001/05/10 18:22:26 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,7 +16,8 @@
 ;;;
 ;;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Auto Save
 
@@ -162,7 +163,8 @@ This file is not the file you visited; that changes only when you save."
 
 (define (auto-save-buffer buffer)
   (catch-file-errors
-   (lambda ()
+   (lambda (condition)
+     condition
      (editor-beep)
      (let ((name (buffer-name buffer)))
        (message "Autosaving...error for " name)
index 5d33d34683df80bfaa96b3854e9aedbb370de363..f8dd5779ab7fcecba0ec0498dd700dd50be7c172 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: dired.scm,v 1.183 2001/05/09 21:03:05 cph Exp $
+;;; $Id: dired.scm,v 1.184 2001/05/10 18:22:29 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -573,15 +573,11 @@ When renaming multiple or marked files, you specify a directory."
 (define (dired-create-file-operation operation)
   (lambda (lstart from to)
     lstart
-    (call-with-current-continuation
-     (lambda (continuation)
-       (bind-condition-handler (list condition-type:file-error
-                                    condition-type:port-error)
-          continuation
-        (lambda ()
-          (dired-handle-overwrite to)
-          (operation from to)
-          #f))))))
+    (catch-file-errors (lambda (condition) condition)
+      (lambda ()
+       (dired-handle-overwrite to)
+       (operation from to)
+       #f))))
 
 (define (dired-handle-overwrite to)
   (if (and (file-exists? to)
index 6be0ed5deb8cfe7729f6ea10e7b2557c81d7b0f2..a4c6ad78bb6a7cc7189dd581846507dd5db00796 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: fileio.scm,v 1.153 2001/02/06 04:19:13 cph Exp $
+;;; $Id: fileio.scm,v 1.154 2001/05/10 18:22:31 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -16,7 +16,8 @@
 ;;;
 ;;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; File <-> Buffer I/O
 
@@ -526,11 +527,12 @@ Otherwise, a message is written both before and after long file writes."
                    ((ref-variable file-precious-flag buffer)
                     (let ((old (os/precious-backup-pathname pathname)))
                       (let ((rename-back?
-                             (catch-file-errors (lambda () #f)
-                               (lambda ()
-                                 (rename-file pathname old)
-                                 (set! modes (file-modes old))
-                                 #t))))
+                             (catch-file-errors
+                              (lambda (condition) condition #f)
+                              (lambda ()
+                                (rename-file pathname old)
+                                (set! modes (file-modes old))
+                                #t))))
                         (unwind-protect
                          #f
                          (lambda ()
@@ -564,7 +566,7 @@ Otherwise, a message is written both before and after long file writes."
                     (write-buffer buffer)))
              (if modes
                  (catch-file-errors
-                  (lambda () unspecific)
+                  (lambda (condition) condition unspecific)
                   (lambda ()
                     (os/restore-modes-to-updated-file! pathname modes))))
              (event-distributor/invoke! event:after-buffer-save buffer)))))))
@@ -714,14 +716,15 @@ Otherwise, a message is written both before and after long file writes."
        (os/backup-buffer? truename)
        (let ((truename (file-chase-links truename)))
         (catch-file-errors
-         (lambda () #f)
+         (lambda (condition) condition #f)
          (lambda ()
            (call-with-values
                (lambda () (os/buffer-backup-pathname truename buffer))
              (lambda (backup-pathname targets)
                (let ((modes
                       (catch-file-errors
-                       (lambda ()
+                       (lambda (condition)
+                         condition
                          (let ((filename (os/default-backup-filename)))
                            (temporary-message
                             "Cannot write backup file; backing up in "
index 7e716b00611e4858139bf0eaa055f68740278628..0b0642314a5e1ba6a2e6c729083c9010e5c2d61b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: utils.scm,v 1.47 2001/02/05 18:34:54 cph Exp $
+;;; $Id: utils.scm,v 1.48 2001/05/10 18:22:34 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -16,7 +16,8 @@
 ;;;
 ;;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Editor Utilities
 
   (loop))
 
 (define (delete-directory-no-errors filename)
-  (catch-file-errors (lambda () #f)
+  (catch-file-errors (lambda (condition) condition #f)
                     (lambda () (delete-directory filename) #t)))
 
 (define (string-or-false? object)
    (lambda (continuation)
      (bind-condition-handler (list condition-type:file-error
                                   condition-type:port-error)
-        (if (procedure-arity-valid? if-error 0)
-            (lambda (condition) condition (continuation (if-error)))
-            (lambda (condition) (continuation (if-error condition))))
+        (lambda (condition)
+          (continuation (if-error condition)))
        thunk))))
\ No newline at end of file
index 6cc4a69b623a7479f35b99469f719246ab9bb798..a75ce5015b9c3caffc9712a8c7bcd811c1a9d723 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: vc.scm,v 1.76 2000/12/03 23:31:17 cph Exp $
+;;; $Id: vc.scm,v 1.77 2001/05/10 18:22:37 cph Exp $
 ;;;
-;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1994-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,7 +16,8 @@
 ;;;
 ;;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Version Control
 
@@ -1436,7 +1437,7 @@ the value of vc-log-mode-hook."
                  (parse-buffer buffer)
                  (call-with-temporary-buffer " *VC-temp*"
                    (lambda (buffer)
-                     (catch-file-errors (lambda () #f)
+                     (catch-file-errors (lambda (condition) condition #f)
                        (lambda ()
                          (read-buffer buffer workfile #f)
                          (parse-buffer buffer)))))))))))))