From: Chris Hanson Date: Wed, 26 Apr 2017 05:49:26 +0000 (-0700) Subject: Eliminate more low-hanging deprecations. X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~135 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a9292586e50ebe0e80760f6bbe8e63906508f79f;p=mit-scheme.git Eliminate more low-hanging deprecations. --- diff --git a/src/edwin/docstr.scm b/src/edwin/docstr.scm index 3731297cb..b812855b1 100644 --- a/src/edwin/docstr.scm +++ b/src/edwin/docstr.scm @@ -141,12 +141,11 @@ USA. (if (or (default-object? permanent) (not permanent)) output - permanent)) + permanent)) (set-string-length! *doc-strings* *doc-string-posn*) - (call-with-legacy-binary-output-file - output - (lambda (port) - (output-port/write-string port *doc-strings*))) + (call-with-binary-output-file output + (lambda (port) + (write-bytevector (string->bytevector *doc-strings*) port))) (set! *external-doc-strings?* #f) (set! *doc-string-posn* 0) (set! *doc-strings* #f) diff --git a/src/edwin/editor.scm b/src/edwin/editor.scm index e74655e9c..2f9deb0d5 100644 --- a/src/edwin/editor.scm +++ b/src/edwin/editor.scm @@ -70,7 +70,8 @@ USA. (lambda (root-continuation) (set! editor-thread-root-continuation root-continuation) - (with-notification-output-port null-output-port + (parameterize* (list (cons notification-output-port + null-output-port)) (lambda () (do ((thunks (let ((thunks editor-initial-threads)) (set! editor-initial-threads '()) diff --git a/src/imail/imail-rmail.scm b/src/imail/imail-rmail.scm index 9b62e424a..dc1859648 100644 --- a/src/imail/imail-rmail.scm +++ b/src/imail/imail-rmail.scm @@ -38,8 +38,10 @@ USA. (define-method create-file-folder-file (url (type )) type - (call-with-legacy-binary-output-file (pathname-url-pathname url) + (call-with-output-file (pathname-url-pathname url) (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (write-rmail-file-header (make-rmail-folder-header-fields '()) port)))) ;;;; Folder @@ -233,8 +235,10 @@ USA. ;;;; Write RMAIL file (define-method write-file-folder ((folder ) pathname) - (call-with-legacy-binary-output-file pathname + (call-with-output-file pathname (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (write-rmail-file-header (rmail-folder-header-fields folder) port) (for-each-vector-element (file-folder-messages folder) (lambda (message) @@ -243,8 +247,10 @@ USA. (define-method append-message-to-file (message url (type )) type - (call-with-legacy-binary-append-file (pathname-url-pathname url) + (call-with-append-file (pathname-url-pathname url) (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (write-rmail-message message port)))) (define (write-rmail-file-header header-fields port) diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm index 1093eb865..739cc1632 100644 --- a/src/imail/imail-top.scm +++ b/src/imail/imail-top.scm @@ -1097,21 +1097,24 @@ 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-legacy-binary-output-file) - filename - (lambda (port) - (call-with-mime-decoding-output-port - (let ((encoding (mime-body-one-part-encoding body))) - (if (and (mime-type? body 'APPLICATION 'MAC-BINHEX40) - (eq? encoding '7BIT)) - 'BINHEX40 - encoding)) - port - text? - (lambda (port) - (with-mime-best-effort - (lambda () - (write-mime-body body port))))))))))) + (call-with-output-file filename + (lambda (port) + (if (not text?) + (begin + (port/set-coding port 'binary) + (port/set-line-ending port 'binary))) + (call-with-mime-decoding-output-port + (let ((encoding (mime-body-one-part-encoding body))) + (if (and (mime-type? body 'APPLICATION 'MAC-BINHEX40) + (eq? encoding '7BIT)) + 'BINHEX40 + encoding)) + port + text? + (lambda (port) + (with-mime-best-effort + (lambda () + (write-mime-body body port))))))))))) (define (filter-mime-attachment-filename filename) (let ((filename diff --git a/src/imail/imail-umail.scm b/src/imail/imail-umail.scm index 3f4280476..0b0e69679 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-legacy-binary-output-file (pathname-url-pathname url) + (call-with-output-file (pathname-url-pathname url) (lambda (port) port unspecific))) @@ -144,8 +144,10 @@ USA. ;;;; Write unix mail file (define-method write-file-folder ((folder ) pathname) - (call-with-legacy-binary-output-file pathname + (call-with-output-file pathname (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (for-each-vector-element (file-folder-messages folder) (lambda (message) (write-umail-message message #t port))) @@ -153,8 +155,10 @@ USA. (define-method append-message-to-file (message url (type )) type - (call-with-legacy-binary-append-file (pathname-url-pathname url) + (call-with-append-file (pathname-url-pathname url) (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (write-umail-message message #t port)))) (define (write-umail-message message output-flags? port) diff --git a/src/imail/imail-util.scm b/src/imail/imail-util.scm index 8dce7d435..f013ed1bb 100644 --- a/src/imail/imail-util.scm +++ b/src/imail/imail-util.scm @@ -423,8 +423,10 @@ USA. ;;;; Extended-string input port (define (read-file-into-string pathname) - (call-with-legacy-binary-input-file pathname + (call-with-input-file pathname (lambda (port) + (port/set-coding port 'iso-8859-1) + (port/set-line-ending port 'newline) (let ((n-bytes ((textual-port-operation port 'LENGTH) port))) (let ((string (make-string n-bytes))) (let loop ((start 0))