From: Chris Hanson Date: Fri, 13 Jan 2017 20:11:00 +0000 (-0800) Subject: Rename all binary I/O procedures to "legacy". X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~128 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=37a08e9d4007900144efe54e0f94c877984c355c;p=mit-scheme.git Rename all binary I/O procedures to "legacy". --- diff --git a/src/blowfish/blowfish-check.scm b/src/blowfish/blowfish-check.scm index 0da3acd65..e5e4e30b3 100644 --- a/src/blowfish/blowfish-check.scm +++ b/src/blowfish/blowfish-check.scm @@ -27,7 +27,7 @@ USA. ;;;; Test the BLOWFISH option. (let ((sample "Some text to encrypt and decrypt.")) - (call-with-binary-output-file "test" + (call-with-legacy-binary-output-file "test" (lambda (output) (call-with-input-string sample (lambda (input) @@ -35,7 +35,7 @@ USA. (write-blowfish-file-header output) #t))))) (let ((read-back - (call-with-binary-input-file "test" + (call-with-legacy-binary-input-file "test" (lambda (input) (call-with-output-string (lambda (output) diff --git a/src/blowfish/blowfish.scm b/src/blowfish/blowfish.scm index d10fd834c..fbd881fcb 100644 --- a/src/blowfish/blowfish.scm +++ b/src/blowfish/blowfish.scm @@ -227,7 +227,7 @@ USA. (error:bad-range-argument port 'READ-BLOWFISH-FILE-HEADER))))) (define (blowfish-file? pathname) - (let ((line (call-with-binary-input-file pathname read-line))) + (let ((line (call-with-legacy-binary-input-file pathname read-line))) (and (not (eof-object? line)) (or (string=? line blowfish-file-header-v1) (string=? line blowfish-file-header-v2))))) diff --git a/src/edwin/docstr.scm b/src/edwin/docstr.scm index 755684568..3731297cb 100644 --- a/src/edwin/docstr.scm +++ b/src/edwin/docstr.scm @@ -143,7 +143,7 @@ USA. output permanent)) (set-string-length! *doc-strings* *doc-string-posn*) - (call-with-binary-output-file + (call-with-legacy-binary-output-file output (lambda (port) (output-port/write-string port *doc-strings*))) diff --git a/src/edwin/filcom.scm b/src/edwin/filcom.scm index fea998b69..2ee4ee37c 100644 --- a/src/edwin/filcom.scm +++ b/src/edwin/filcom.scm @@ -667,7 +667,7 @@ Prefix arg means treat the plaintext file as binary data." " already exists; overwrite"))) (begin ((if binary-plaintext? - call-with-binary-input-file + call-with-legacy-binary-input-file call-with-input-file) from (lambda (input) @@ -687,7 +687,7 @@ Prefix arg means treat the plaintext file as binary data." " already exists; overwrite"))) (begin ((if binary-plaintext? - call-with-binary-output-file + call-with-legacy-binary-output-file call-with-output-file) to (lambda (output) @@ -699,7 +699,7 @@ Prefix arg means treat the plaintext file as binary data." #t))) (define (%blowfish-encrypt-file pathname input) - (call-with-binary-output-file pathname + (call-with-legacy-binary-output-file pathname (lambda (output) (call-with-sensitive-string (call-with-confirmed-pass-phrase md5-string) (lambda (key-string) @@ -708,7 +708,7 @@ Prefix arg means treat the plaintext file as binary data." #t)))))) (define (%blowfish-decrypt-file pathname output) - (call-with-binary-input-file pathname + (call-with-legacy-binary-input-file pathname (lambda (input) (call-with-sensitive-string (call-with-pass-phrase "Pass phrase" md5-string) diff --git a/src/edwin/sendmail.scm b/src/edwin/sendmail.scm index 2d2fe4a5f..e632cb6bd 100644 --- a/src/edwin/sendmail.scm +++ b/src/edwin/sendmail.scm @@ -1457,7 +1457,7 @@ the user from the mailer." (let ((context (initialize port text?))) ((if (eq? type 'TEXT) call-with-input-file - call-with-binary-input-file) + call-with-legacy-binary-input-file) (mime-attachment-pathname attachment) (lambda (input-port) (let ((buffer (make-string 4096))) diff --git a/src/imail/imail-rmail.scm b/src/imail/imail-rmail.scm index ee1eb2047..81ebbaa8c 100644 --- a/src/imail/imail-rmail.scm +++ b/src/imail/imail-rmail.scm @@ -38,7 +38,7 @@ USA. (define-method create-file-folder-file (url (type )) type - (call-with-binary-output-file (pathname-url-pathname url) + (call-with-legacy-binary-output-file (pathname-url-pathname url) (lambda (port) (write-rmail-file-header (make-rmail-folder-header-fields '()) port)))) @@ -233,7 +233,7 @@ USA. ;;;; Write RMAIL file (define-method write-file-folder ((folder ) pathname) - (call-with-binary-output-file pathname + (call-with-legacy-binary-output-file pathname (lambda (port) (write-rmail-file-header (rmail-folder-header-fields folder) port) (for-each-vector-element (file-folder-messages folder) @@ -243,7 +243,7 @@ USA. (define-method append-message-to-file (message url (type )) type - (call-with-binary-append-file (pathname-url-pathname url) + (call-with-legacy-binary-append-file (pathname-url-pathname url) (lambda (port) (write-rmail-message message port)))) diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm index 8b9d901a8..9f41b7633 100644 --- a/src/imail/imail-top.scm +++ b/src/imail/imail-top.scm @@ -1097,7 +1097,7 @@ With prefix argument, prompt even when point is on an attachment." (eq? type 'MESSAGE))))) (if (or (not (file-exists? filename)) (prompt-for-yes-or-no? "File already exists; overwrite")) - ((if text? call-with-output-file call-with-binary-output-file) + ((if text? call-with-output-file call-with-legacy-binary-output-file) filename (lambda (port) (call-with-mime-decoding-output-port diff --git a/src/imail/imail-umail.scm b/src/imail/imail-umail.scm index 9643afb2e..f5906cb99 100644 --- a/src/imail/imail-umail.scm +++ b/src/imail/imail-umail.scm @@ -38,7 +38,7 @@ USA. (define-method create-file-folder-file (url (type )) type - (call-with-binary-output-file (pathname-url-pathname url) + (call-with-legacy-binary-output-file (pathname-url-pathname url) (lambda (port) port unspecific))) @@ -144,7 +144,7 @@ USA. ;;;; Write unix mail file (define-method write-file-folder ((folder ) pathname) - (call-with-binary-output-file pathname + (call-with-legacy-binary-output-file pathname (lambda (port) (for-each-vector-element (file-folder-messages folder) (lambda (message) @@ -153,7 +153,7 @@ USA. (define-method append-message-to-file (message url (type )) type - (call-with-binary-append-file (pathname-url-pathname url) + (call-with-legacy-binary-append-file (pathname-url-pathname url) (lambda (port) (write-umail-message message #t port)))) diff --git a/src/imail/imail-util.scm b/src/imail/imail-util.scm index ef546ff16..b14762007 100644 --- a/src/imail/imail-util.scm +++ b/src/imail/imail-util.scm @@ -423,7 +423,7 @@ USA. ;;;; Extended-string input port (define (read-file-into-xstring pathname) - (call-with-binary-input-file pathname + (call-with-legacy-binary-input-file pathname (lambda (port) (let ((n-bytes ((port/operation port 'LENGTH) port))) (let ((xstring (make-string n-bytes))) diff --git a/src/md5/md5.scm b/src/md5/md5.scm index 0649f0555..6fd1a5681 100644 --- a/src/md5/md5.scm +++ b/src/md5/md5.scm @@ -68,7 +68,7 @@ USA. result)) (define (md5-file filename) - (call-with-binary-input-file filename + (call-with-legacy-binary-input-file filename (lambda (port) (let ((buffer (make-string 4096)) (context (%md5-init))) diff --git a/src/mhash/mhash.scm b/src/mhash/mhash.scm index 4ed16fe72..2b23a8bcb 100644 --- a/src/mhash/mhash.scm +++ b/src/mhash/mhash.scm @@ -393,7 +393,7 @@ USA. unspecific) (define (mhash-file hash-type filename) - (call-with-binary-input-file filename + (call-with-legacy-binary-input-file filename (lambda (port) (let ((buffer (make-string 4096)) (context (mhash-init hash-type))) diff --git a/src/runtime/blowfish.scm b/src/runtime/blowfish.scm index e2996c7ae..9534d69af 100644 --- a/src/runtime/blowfish.scm +++ b/src/runtime/blowfish.scm @@ -95,7 +95,7 @@ USA. (error:bad-range-argument port 'READ-BLOWFISH-FILE-HEADER))))) (define (blowfish-file? pathname) - (let ((line (call-with-binary-input-file pathname read-line))) + (let ((line (call-with-legacy-binary-input-file pathname read-line))) (and (not (eof-object? line)) (or (string=? line blowfish-file-header-v1) (string=? line blowfish-file-header-v2))))) diff --git a/src/runtime/cpress.scm b/src/runtime/cpress.scm index 3c63f5474..ed7c4a529 100644 --- a/src/runtime/cpress.scm +++ b/src/runtime/cpress.scm @@ -86,9 +86,9 @@ USA. ;;; determines the algorithm. (define (compress ifile ofile) - (call-with-binary-input-file (merge-pathnames ifile) + (call-with-legacy-binary-input-file (merge-pathnames ifile) (lambda (input) - (call-with-binary-output-file (merge-pathnames ofile) + (call-with-legacy-binary-output-file (merge-pathnames ofile) (lambda (output) (write-string "Compressed-B1-1.00" output) (compress-ports input output)))))) diff --git a/src/runtime/crypto.scm b/src/runtime/crypto.scm index 10d8eeaa0..5e22c64e1 100644 --- a/src/runtime/crypto.scm +++ b/src/runtime/crypto.scm @@ -240,7 +240,7 @@ USA. unspecific) (define (mhash-file hash-type filename) - (call-with-binary-input-file filename + (call-with-legacy-binary-input-file filename (lambda (port) (let ((buffer (make-string 4096)) (context (mhash-init hash-type))) @@ -304,7 +304,7 @@ USA. (error "This Scheme system was built without MD5 support.")))) (define (%md5-file filename) - (call-with-binary-input-file filename + (call-with-legacy-binary-input-file filename (lambda (port) (let ((buffer (make-string 4096)) (context ((ucode-primitive md5-init 0)))) diff --git a/src/runtime/fileio.scm b/src/runtime/fileio.scm index f4047bbe5..e279a2dfc 100644 --- a/src/runtime/fileio.scm +++ b/src/runtime/fileio.scm @@ -133,7 +133,7 @@ USA. (port/set-line-ending port (file-line-ending pathname)) port)) -(define (open-binary-input-file filename) +(define (open-legacy-binary-input-file filename) (let* ((pathname (merge-pathnames filename)) (channel (file-open-input-channel (->namestring pathname))) (port (make-generic-i/o-port channel #f input-file-type pathname))) @@ -142,7 +142,7 @@ USA. (port/set-line-ending port 'BINARY) port)) -(define (open-binary-output-file filename #!optional append?) +(define (open-legacy-binary-output-file filename #!optional append?) (let* ((pathname (merge-pathnames filename)) (channel (let ((filename (->namestring pathname))) @@ -155,7 +155,7 @@ USA. (port/set-line-ending port 'BINARY) port)) -(define (open-exclusive-binary-output-file filename) +(define (open-exclusive-legacy-binary-output-file filename) (let* ((pathname (merge-pathnames filename)) (channel (file-open-exclusive-output-channel (->namestring pathname))) (port (make-generic-i/o-port #f channel output-file-type pathname))) @@ -164,7 +164,7 @@ USA. (port/set-line-ending port 'BINARY) port)) -(define (open-binary-i/o-file filename) +(define (open-legacy-binary-i/o-file filename) (let* ((pathname (merge-pathnames filename)) (channel (file-open-io-channel (->namestring pathname))) (port (make-generic-i/o-port channel channel i/o-file-type pathname))) @@ -182,8 +182,8 @@ USA. (define call-with-input-file (make-call-with-file open-input-file)) -(define call-with-binary-input-file - (make-call-with-file open-binary-input-file)) +(define call-with-legacy-binary-input-file + (make-call-with-file open-legacy-binary-input-file)) (define call-with-output-file (make-call-with-file open-output-file)) @@ -191,18 +191,18 @@ USA. (define call-with-exclusive-output-file (make-call-with-file open-exclusive-output-file)) -(define call-with-binary-output-file - (make-call-with-file open-binary-output-file)) +(define call-with-legacy-binary-output-file + (make-call-with-file open-legacy-binary-output-file)) -(define call-with-exclusive-binary-output-file - (make-call-with-file open-exclusive-binary-output-file)) +(define call-with-exclusive-legacy-binary-output-file + (make-call-with-file open-exclusive-legacy-binary-output-file)) (define call-with-append-file (make-call-with-file (lambda (filename) (open-output-file filename #t)))) -(define call-with-binary-append-file +(define call-with-legacy-binary-append-file (make-call-with-file - (lambda (filename) (open-binary-output-file filename #t)))) + (lambda (filename) (open-legacy-binary-output-file filename #t)))) (define ((make-with-input-from-file call) input-specifier thunk) (call input-specifier @@ -213,7 +213,7 @@ USA. (make-with-input-from-file call-with-input-file)) (define with-input-from-binary-file - (make-with-input-from-file call-with-binary-input-file)) + (make-with-input-from-file call-with-legacy-binary-input-file)) (define ((make-with-output-to-file call) output-specifier thunk) (call output-specifier @@ -227,7 +227,7 @@ USA. (make-with-output-to-file call-with-exclusive-output-file)) (define with-output-to-binary-file - (make-with-output-to-file call-with-binary-output-file)) + (make-with-output-to-file call-with-legacy-binary-output-file)) -(define with-output-to-exclusive-binary-file - (make-with-output-to-file call-with-exclusive-binary-output-file)) \ No newline at end of file +(define with-output-to-exclusive-legacy-binary-file + (make-with-output-to-file call-with-exclusive-legacy-binary-output-file)) \ No newline at end of file diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm index b370fd53c..a6ccf0482 100644 --- a/src/runtime/infutl.scm +++ b/src/runtime/infutl.scm @@ -604,7 +604,7 @@ USA. (fasload-loader temporary-file)))))) (define (uncompress-internal ifile ofile if-fail) - (call-with-binary-input-file (merge-pathnames ifile) + (call-with-legacy-binary-input-file (merge-pathnames ifile) (lambda (input) (let* ((file-marker "Compressed-B1-1.00") (marker-size (string-length file-marker)) @@ -614,7 +614,7 @@ USA. actual-marker 0 marker-size) marker-size) (string=? file-marker actual-marker)) - (call-with-binary-output-file (merge-pathnames ofile) - (lambda (output) + (call-with-legacy-binary-output-file (merge-pathnames ofile) + (lambda (output) (uncompress-ports input output (fix:* (file-length ifile) 2)))) (if-fail "Not a recognized compressed file:" ifile)))))) \ No newline at end of file diff --git a/src/runtime/load.scm b/src/runtime/load.scm index 1b24a39f2..3d60793a6 100644 --- a/src/runtime/load.scm +++ b/src/runtime/load.scm @@ -203,7 +203,7 @@ USA. (define (fasl-file? pathname) (and (file-regular? pathname) - (call-with-binary-input-file pathname + (call-with-legacy-binary-input-file pathname (lambda (port) (let ((n (vector-ref (gc-space-status) 0))) (let ((marker (make-string n))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 392c9923f..d4fa46171 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -973,6 +973,7 @@ USA. guarantee-string guarantee-string-index guarantee-xstring + legacy-string? ;; END deprecated bindings (set-vector-8b-length! set-string-length!) (vector-8b-length string-length) @@ -987,7 +988,6 @@ USA. guarantee-substring-end-index guarantee-substring-start-index hexadecimal->vector-8b - legacy-string? lisp-string->camel-case list->string make-string @@ -1135,6 +1135,9 @@ USA. (files "bytevector") (parent (runtime)) (export () + ;; BEGIN deprecated bindings + legacy-string->bytevector + ;; END deprecated bindings byte? bytevector bytevector-append @@ -1146,7 +1149,6 @@ USA. bytevector-u8-set! bytevector=? bytevector? - legacy-string->bytevector make-bytevector string->utf8 utf8->string)) @@ -2100,27 +2102,27 @@ USA. (parent (runtime)) (export () ;; BEGIN deprecated bindings + call-with-exclusive-legacy-binary-output-file + call-with-legacy-binary-append-file + call-with-legacy-binary-input-file + call-with-legacy-binary-output-file + open-exclusive-legacy-binary-output-file + open-legacy-binary-i/o-file + open-legacy-binary-input-file + open-legacy-binary-output-file with-input-from-binary-file with-output-to-binary-file + with-output-to-exclusive-legacy-binary-file ;; END deprecated bindings call-with-append-file - call-with-binary-append-file - call-with-binary-input-file - call-with-binary-output-file - call-with-exclusive-binary-output-file call-with-exclusive-output-file call-with-input-file call-with-output-file - open-binary-i/o-file - open-binary-input-file - open-binary-output-file - open-exclusive-binary-output-file open-exclusive-output-file open-i/o-file open-input-file open-output-file with-input-from-file - with-output-to-exclusive-binary-file with-output-to-exclusive-file with-output-to-file) (initialization (initialize-package!)))