From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 11 May 1996 08:46:52 +0000 (+0000)
Subject: Pop up a buffer showing the "popclient" output so that it is visible
X-Git-Tag: 20090517-FFI~5533
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7021fc5ae9143dc2aca961d64d3cbbea736d08d8;p=mit-scheme.git

Pop up a buffer showing the "popclient" output so that it is visible
while "popclient" is running.  Use new popped-up buffer features to
keep it visible if an error occurs.
---

diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm
index 6042338a1..e74be91e2 100644
--- a/v7/src/edwin/os2.scm
+++ b/v7/src/edwin/os2.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: os2.scm,v 1.30 1996/05/04 17:38:12 cph Exp $
+;;;	$Id: os2.scm,v 1.31 1996/05/11 08:46:35 cph Exp $
 ;;;
 ;;;	Copyright (c) 1994-96 Massachusetts Institute of Technology
 ;;;
@@ -335,24 +335,27 @@ filename suffix \".gz\"."
 			       "popmail.tmp")
 			   directory))))
     (let ((buffer (temporary-buffer "*popclient*")))
-      (let ((status.reason
-	     (let ((args
-		    (list "-u" user-name
-			  "-p" (os2-pop-client-password password)
-			  "-o" target
-			  server)))
-	       (apply run-synchronous-process #f (buffer-end buffer) #f #f
-		      "popclient"
-		      "-3"
-		      (if (ref-variable rmail-pop-delete)
-			  args
-			  (cons "-k" args))))))
-	(if (and (eq? 'EXITED (car status.reason))
-		 (memv (cdr status.reason) '(0 1)))
-	    (kill-buffer buffer)
-	    (begin
-	      (pop-up-buffer buffer)
-	      (editor-error "Error getting mail from POP server.")))))
+      (cleanup-pop-up-buffers
+       (lambda ()
+	 (pop-up-buffer buffer)
+	 (let ((status.reason
+		(let ((args
+		       (list "-u" user-name
+			     "-p" (os2-pop-client-password password)
+			     "-o" target
+			     server)))
+		  (apply run-synchronous-process #f (buffer-end buffer) #f #f
+			 "popclient"
+			 "-3"
+			 (if (ref-variable rmail-pop-delete)
+			     args
+			     (cons "-k" args))))))
+	   (if (and (eq? 'EXITED (car status.reason))
+		    (memv (cdr status.reason) '(0 1)))
+	       (kill-pop-up-buffer buffer)
+	       (begin
+		 (keep-pop-up-buffer buffer)
+		 (editor-error "Error getting mail from POP server.")))))))
     target))
 
 (define (os2-pop-client-password password)
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index c3b9bb10c..aa24e3a17 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: unix.scm,v 1.69 1996/05/04 17:38:55 cph Exp $
+;;;	$Id: unix.scm,v 1.70 1996/05/11 08:46:52 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -713,25 +713,29 @@ option, instead taking -P <filename>."
 (define (unix/pop-client server user-name password directory)
   (let ((target (->namestring (merge-pathnames ".popmail" directory))))
     (let ((buffer (temporary-buffer "*popclient*")))
-      (let ((status.reason
-	     (unix/call-with-pop-client-password-options password
-	       (lambda (password-options)
-		 (let ((args
-			(append (list "-u" user-name)
-				password-options
-				(list "-o" target server))))
-		   (apply run-synchronous-process #f (buffer-end buffer) #f #f
-			  "popclient"
-			  "-3"
-			  (if (ref-variable rmail-pop-delete)
-			      args
-			      (cons "-k" args))))))))
-	(if (and (eq? 'EXITED (car status.reason))
-		 (memv (cdr status.reason) '(0 1)))
-	    (kill-buffer buffer)
-	    (begin
-	      (pop-up-buffer buffer)
-	      (editor-error "Error getting mail from POP server.")))))
+      (cleanup-pop-up-buffers
+       (lambda ()
+	 (pop-up-buffer buffer)
+	 (let ((status.reason
+		(unix/call-with-pop-client-password-options password
+		  (lambda (password-options)
+		    (let ((args
+			   (append (list "-u" user-name)
+				   password-options
+				   (list "-o" target server))))
+		      (apply run-synchronous-process
+			     #f (buffer-end buffer) #f #f
+			     "popclient"
+			     "-3"
+			     (if (ref-variable rmail-pop-delete)
+				 args
+				 (cons "-k" args))))))))
+	   (if (and (eq? 'EXITED (car status.reason))
+		    (memv (cdr status.reason) '(0 1)))
+	       (kill-pop-up-buffer buffer)
+	       (begin
+		 (keep-pop-up-buffer buffer)
+		 (editor-error "Error getting mail from POP server.")))))))
     target))
 
 (define (unix/call-with-pop-client-password-options password receiver)