From 99ad8a7980f5d23c1dedf02c98b78f3cd41481a2 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 13 Jan 1992 19:14:33 +0000
Subject: [PATCH] Add new procedures CALL-WITH-TEMPORARY-BUFFER and
 NEW-BUFFER-NAME.

---
 v7/src/edwin/bufcom.scm | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index d63d3e540..5d0a558a7 100644
--- a/v7/src/edwin/bufcom.scm
+++ b/v7/src/edwin/bufcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.89 1991/05/14 02:26:52 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.90 1992/01/13 19:14:33 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -202,14 +202,16 @@ Uses the visited file name, the -*- line, and the local variables spec."
       (write-buffer-interactive buffer false)))
 
 (define (new-buffer name)
-  (create-buffer
-   (if (find-buffer name)
-       (let search-loop ((n 2))
-	 (let ((new-name (string-append name "<" (write-to-string n) ">")))
-	   (if (find-buffer new-name)
-	       (search-loop (1+ n))
-	       new-name)))
-       name)))
+  (create-buffer (new-buffer-name name)))
+
+(define (new-buffer-name name)
+  (if (find-buffer name)
+      (let search-loop ((n 2))
+	(let ((new-name (string-append name "<" (write-to-string n) ">")))
+	  (if (find-buffer new-name)
+	      (search-loop (1+ n))
+	      new-name)))
+      name))
 
 (define (string->temporary-buffer string name)
   (let ((buffer (temporary-buffer name)))
@@ -225,6 +227,18 @@ Uses the visited file name, the -*- line, and the local variables spec."
     (buffer-not-modified! buffer)
     (pop-up-buffer buffer false)))
 
+(define (call-with-temporary-buffer name procedure)
+  (let ((buffer))
+    (dynamic-wind (lambda ()
+		    unspecific)
+		  (lambda ()
+		    (set! buffer (temporary-buffer name))
+		    (procedure buffer))
+		  (lambda ()
+		    (kill-buffer buffer)
+		    (set! buffer)
+		    unspecific))))
+
 (define (temporary-buffer name)
   (let ((buffer (find-or-create-buffer name)))
     (buffer-reset! buffer)
-- 
2.25.1