guile/guile-scsh ChangeLog filesys.scm scsh-con...

[Gary Houston]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Gary Houston <address@hidden>   01/06/06 15:00:34

Modified files:
        guile-scsh     : ChangeLog filesys.scm scsh-condition.scm 

Log message:
        * scsh-condition.scm (with-errno-handler*): bug fix, errors were
        not reported correctly.  use (ice-9 stack-catch) to improve
        error messages.
        * filesys.scm (create-file-thing): use (ice-9 stack-catch) to improve
        error messages.
        (delete-filesys-object): handle errno/isdir, not errno/perm when
        deleting a file.  otherwise directories can't be deleted: seems like
        a bug in scsh.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/ChangeLog.diff?cvsroot=OldCVS&tr1=1.59&tr2=1.60&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/filesys.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/scsh-condition.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text

Patches:
Index: guile/guile-scsh/ChangeLog
diff -u guile/guile-scsh/ChangeLog:1.59 guile/guile-scsh/ChangeLog:1.60
--- guile/guile-scsh/ChangeLog:1.59     Mon Jun  4 15:06:13 2001
+++ guile/guile-scsh/ChangeLog  Wed Jun  6 15:00:34 2001
@@ -1,3 +1,14 @@
+2001-06-06  Gary Houston  <address@hidden>
+
+       * scsh-condition.scm (with-errno-handler*): bug fix, errors were
+       not reported correctly.  use (ice-9 stack-catch) to improve
+       error messages.
+       * filesys.scm (create-file-thing): use (ice-9 stack-catch) to improve
+       error messages.
+       (delete-filesys-object): handle errno/isdir, not errno/perm when
+       deleting a file.  otherwise directories can't be deleted: seems like
+       a bug in scsh.
+
 2001-06-04  Gary Houston  <address@hidden>
 
        * rw.scm (generic-write-string/partial, write-string/partial):
Index: guile/guile-scsh/filesys.scm
diff -u guile/guile-scsh/filesys.scm:1.4 guile/guile-scsh/filesys.scm:1.5
--- guile/guile-scsh/filesys.scm:1.4    Mon May 28 15:35:08 2001
+++ guile/guile-scsh/filesys.scm        Wed Jun  6 15:00:34 2001
@@ -3,6 +3,7 @@
 ;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
 
 (define-module (scsh filesys)
+  :use-module (ice-9 stack-catch)
   :use-module (scsh scsh-condition)
   :use-module (scsh syscalls)
   :use-module (scsh let-opt)
@@ -27,7 +28,8 @@
   (let loop ()
     (or (with-errno-handler ; Assume it's a file and try.
            ((err data)
-            ((errno/perm) #f) ; Return #f if directory
+            ((errno/isdir) #f) ; Return #f if directory
+            ((errno/perm) #f)
             ((errno/noent) #t))
            (delete-file fname)
            #t)
@@ -51,20 +53,20 @@
                 (y-or-n? (string-append op-name ": " fname
                                         " already exists. Delete")))))
     (let loop ((override? override?))
-      (catch 'system-error
-            (lambda () (makeit fname))
-            (lambda (tag proc msg msg-args rest)
-              (let ((errno (car rest)))
-                (if (= errno errno/exist)
-                    ;; FNAME exists. Nuke it and retry?
-                    (cond ((if (eq? override? 'query)
-                               (query)
-                               override?)
-                           (delete-filesys-object fname)
-                           (loop #t))
-                          (else
-                           (scm-error tag proc msg msg-args rest)))
-                    (scm-error tag proc msg msg-args rest))))))))
+      (stack-catch 'system-error
+                  (lambda () (makeit fname))
+                  (lambda (tag proc msg msg-args rest)
+                    (let ((errno (car rest)))
+                      (if (= errno errno/exist)
+                          ;; FNAME exists. Nuke it and retry?
+                          (cond ((if (eq? override? 'query)
+                                     (query)
+                                     override?)
+                                 (delete-filesys-object fname)
+                                 (loop #t))
+                                (else
+                                 (throw tag proc msg msg-args rest)))
+                          (throw tag proc msg msg-args rest))))))))
 
 ;;;;;;;
 
Index: guile/guile-scsh/scsh-condition.scm
diff -u guile/guile-scsh/scsh-condition.scm:1.4 
guile/guile-scsh/scsh-condition.scm:1.5
--- guile/guile-scsh/scsh-condition.scm:1.4     Mon Nov 27 13:27:04 2000
+++ guile/guile-scsh/scsh-condition.scm Wed Jun  6 15:00:34 2001
@@ -2,6 +2,7 @@
 ;;; Add scsh conditions to s48.
 
 (define-module (scsh scsh-condition)
+  :use-module (ice-9 stack-catch)
   :use-module (scsh alt-syntax)
 )
 (export errno-error with-errno-handler*)
@@ -18,17 +19,14 @@
     (scm-error 'system-error syscall "%s" msg (list errno))))
 
 (define (with-errno-handler* handler thunk)
-  (catch 'system-error
-        thunk
-        (lambda args
-          (let ((errno (car (list-ref args 4)))
-                (message (car (list-ref args 3)))
-                (subr (list-ref args 1)))
-          (handler errno (list message
-                               subr
-                               '()))   ; data
-          (throw 'system-error subr "%s" (list-ref args 3) #f)))))
-                     
+  (stack-catch 'system-error
+              thunk
+              (lambda (key subr msg msg-args rest)
+                (let ((errno (car rest)))
+                  (handler errno (list msg
+                                       subr
+                                       '()))   ; data
+                  (throw key subr msg msg-args rest)))))
 
 ;;; (with-errno-handler
 ;;;   ((errno data) ; These are vars bound in this scope.