From 8ffbc2df0fde83082610149d24e594c1cd879f4a Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:25 -0800 Subject: Import Upstream version 2a6 --- withfile.scm | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) create mode 100644 withfile.scm (limited to 'withfile.scm') diff --git a/withfile.scm b/withfile.scm new file mode 100644 index 0000000..fc13510 --- /dev/null +++ b/withfile.scm @@ -0,0 +1,82 @@ +; "withfile.scm", with-input-from-file and with-output-to-file for Scheme +; Copyright (c) 1992, 1993 Aubrey Jaffer +;; +;Permission to copy this software, to redistribute it, and to use it +;for any purpose is granted, subject to the following restrictions and +;understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warrantee or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +(require 'dynamic-wind) + +(define withfile:current-input (current-input-port)) +(define withfile:current-output (current-output-port)) + +(define (current-input-port) withfile:current-input) +(define (current-output-port) withfile:current-output) + +(define (with-input-from-file file thunk) + (define oport withfile:current-input) + (define port (open-input-file file)) + (dynamic-wind (lambda () (set! oport withfile:current-input) + (set! withfile:current-input port)) + (lambda() (let ((ans (thunk))) (close-input-port port) ans)) + (lambda() (set! withfile:current-input oport)))) + +(define (with-output-from-file file thunk) + (define oport withfile:current-output) + (define port (open-output-file file)) + (dynamic-wind (lambda() (set! oport withfile:current-output) + (set! withfile:current-output port)) + (lambda() (let ((ans (thunk))) (close-output-port port) ans)) + (lambda() (set! withfile:current-output oport)))) + +(define peek-char + (let ((peek-char peek-char)) + (lambda opt + (peek-char (if (null? opt) withfile:current-input (car opt)))))) + +(define read-char + (let ((read-char read-char)) + (lambda opt + (read-char (if (null? opt) withfile:current-input (car opt)))))) + +(define read + (let ((read read)) + (lambda opt + (read (if (null? opt) withfile:current-input (car opt)))))) + +(define write-char + (let ((write-char write-char)) + (lambda (obj . opt) + (write-char obj (if (null? opt) withfile:current-output (car opt)))))) + +(define write + (let ((write write)) + (lambda (obj . opt) + (write obj (if (null? opt) withfile:current-output (car opt)))))) + +(define display + (let ((display display)) + (lambda (obj . opt) + (display obj (if (null? opt) withfile:current-output (car opt)))))) + +(define newline + (let ((newline newline)) + (lambda opt + (newline (if (null? opt) withfile:current-output (car opt)))))) + +(define force-output + (let ((force-output force-output)) + (lambda opt + (force-output (if (null? opt) withfile:current-output (car opt)))))) -- cgit v1.2.3