From 0b3efb0966e20b99e719108cc5cacaf5b1f0b425 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 6 Jun 2019 23:10:07 -0700 Subject: [PATCH] Make sure that ports use ISO 8859-1 coding. --- src/edwin/adapters.scm | 60 ++++++++++++++++++++++++++++++++++++++++++ src/edwin/decls.scm | 1 + src/edwin/ed-ffi.scm | 2 ++ src/edwin/edwin.ldr | 1 + src/edwin/edwin.pkg | 8 ++++++ 5 files changed, 72 insertions(+) create mode 100644 src/edwin/adapters.scm diff --git a/src/edwin/adapters.scm b/src/edwin/adapters.scm new file mode 100644 index 000000000..aca5e3e61 --- /dev/null +++ b/src/edwin/adapters.scm @@ -0,0 +1,60 @@ +#| -*-Scheme-*- + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, + 2017, 2018, 2019 Massachusetts Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +|# + +;;;; Runtime-system adapters +;;; package: (edwin adapters) + +;;; This file contains adapters that bridge between Edwin and the runtime +;;; system. These are necessary because Edwin has assumptions about the +;;; behavior of the runtime system that are no longer valid. Since some of +;;; these assumptions are deeply rooted, it's easier to adapt around them rather +;;; than rewrite Edwin. + +;;; The most critical assumption is that Edwin relies on an older model of +;;; strings, in which each character is a byte, and the default coding is ISO +;;; 8859-1, while the runtime system now supports full Unicode and uses a +;;; default coding of UTF 8. Most of that is taken care of by the (edwin +;;; string) package, which contains a copy of the runtime's old string +;;; implementation. Other things, like file I/O, are handled here. + +(declare (usual-integrations)) + +(define (call-with-file-adapter procedure) + (lambda (pathname receiver) + (procedure pathname + (lambda (port) + (port/set-coding port 'iso-8859-1) + (receiver port))))) + + +(define edwin:call-with-append-file + (call-with-file-adapter call-with-append-file)) + +(define edwin:call-with-input-file + (call-with-file-adapter call-with-input-file)) + +(define edwin:call-with-output-file + (call-with-file-adapter call-with-output-file)) \ No newline at end of file diff --git a/src/edwin/decls.scm b/src/edwin/decls.scm index 5081cc508..1a962b6ec 100644 --- a/src/edwin/decls.scm +++ b/src/edwin/decls.scm @@ -111,6 +111,7 @@ USA. (for-each (lambda (filename) (apply sf-edwin filename includes)) '("abbrev" + "adapters" "argred" "artdebug" "autold" diff --git a/src/edwin/ed-ffi.scm b/src/edwin/ed-ffi.scm index 075fdfdb0..1e48abff1 100644 --- a/src/edwin/ed-ffi.scm +++ b/src/edwin/ed-ffi.scm @@ -30,6 +30,7 @@ USA. (standard-scheme-find-file-initialization '#(("abbrev" (edwin)) + ("adapters" (edwin adapters)) ("ansi" (edwin screen console-screen)) ("argred" (edwin command-argument)) ("artdebug" (edwin debugger)) @@ -150,6 +151,7 @@ USA. ("simple" (edwin)) ("snr" (edwin news-reader)) ("sort" (edwin)) + ("string" (edwin string)) ("strpad" (edwin)) ("strtab" (edwin)) ("struct" (edwin)) diff --git a/src/edwin/edwin.ldr b/src/edwin/edwin.ldr index cbfe05a7c..1c11dd444 100644 --- a/src/edwin/edwin.ldr +++ b/src/edwin/edwin.ldr @@ -81,6 +81,7 @@ USA. (let ((environment (->environment '(edwin)))) (load "utils" environment) + (load "adapters" (->environment '(edwin adapters))) (load "string" (->environment '(edwin string))) (load "nvector" environment) (load "ring" environment) diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg index 90ef42ceb..d39267677 100644 --- a/src/edwin/edwin.pkg +++ b/src/edwin/edwin.pkg @@ -151,6 +151,14 @@ USA. (export (edwin class-macros) class-instance-transforms)) +(define-package (edwin adapters) + (files "adapters") + (parent ()) + (export (edwin) + (call-with-append-file edwin:call-with-append-file) + (call-with-input-file edwin:call-with-input-file) + (call-with-output-file edwin:call-with-output-file))) + (define-package (edwin string) (files "string") (parent (edwin)) -- 2.25.1