Simplify implementation of broken-pipe handler so that parts can be

reused.

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index 5d8eaace90dd951c30ef27c3afe0fc9b17daef95..40dd3ed4d1052ca93b8a4a0556151b3657f5ecad 100644 (file)
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.27 2000/05/30 20:53:19 cph Exp $
+;;; $Id: imail-util.scm,v 1.28 2000/06/19 02:01:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -279,15 +279,17 @@
   (bind-condition-handler (list condition-type:system-call-error
                                condition-type:derived-port-error)
       (lambda (condition)
-       (if (or (broken-pipe? condition)
-               (derived-broken-pipe? condition))
+       (if (broken-pipe? condition)
            (handler condition)))
     thunk))
 
 (define (broken-pipe? condition)
-  (and (eq? (condition/type condition) condition-type:system-call-error)
-       (eq? (system-call-name condition) 'WRITE)
-       (eq? (system-call-error condition) 'BROKEN-PIPE)))
+  (cond ((eq? (condition/type condition) condition-type:system-call-error)
+        (and (eq? (system-call-name condition) 'WRITE)
+             (eq? (system-call-error condition) 'BROKEN-PIPE)))
+       ((eq? (condition/type condition) condition-type:derived-port-error)
+        (broken-pipe? (derived-port-condition condition)))
+       (else #f)))
 
 (define system-call-name
   (condition-accessor condition-type:system-call-error 'SYSTEM-CALL))
@@ -295,10 +297,6 @@
 (define system-call-error
   (condition-accessor condition-type:system-call-error 'ERROR-TYPE))
 
-(define (derived-broken-pipe? condition)
-  (and (eq? (condition/type condition) condition-type:derived-port-error)
-       (broken-pipe? (derived-port-condition condition))))
-
 (define derived-port-condition
   (condition-accessor condition-type:derived-port-error 'CONDITION))
 \f