From 4791d80dd2e4ca431173cbb7960c44a2fbdcd9e7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 19 Jun 2000 02:01:54 +0000 Subject: [PATCH] Simplify implementation of broken-pipe handler so that parts can be reused. --- v7/src/imail/imail-util.scm | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm index 5d8eaace9..40dd3ed4d 100644 --- 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)) -- 2.25.1