From: Chris Hanson Date: Sat, 8 Jun 2019 05:02:39 +0000 (-0700) Subject: Teach reader to find and respect "coding" attribute. X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~4 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=21d158a5ec8de5839c7d73ca7eb95a0860f7d16a;p=mit-scheme.git Teach reader to find and respect "coding" attribute. This allows a file to override the default utf-8 coding. --- diff --git a/src/runtime/reader.scm b/src/runtime/reader.scm index c76b8b1dd..5e5c28bf9 100644 --- a/src/runtime/reader.scm +++ b/src/runtime/reader.scm @@ -898,6 +898,7 @@ USA. (set-db-property! db 'reader-enable-attributes? #f) ;; Save all the attributes; this helps with testing. (set-db-property! db 'reader-file-attributes file-attribute-alist) + (process-coding-attribute file-attribute-alist db) (process-keyword-attribute file-attribute-alist db) (process-mode-attribute file-attribute-alist db) (process-studly-case-attribute file-attribute-alist db)) @@ -907,6 +908,18 @@ USA. (lambda (left right) (string-ci=? (symbol->string left) (symbol->string right))))) +;;; Allow file to specify its character coding. +(define (process-coding-attribute file-attribute-alist db) + (let ((entry (lookup-file-attribute file-attribute-alist 'coding))) + (if (pair? entry) + (let ((coding (cdr entry)) + (port (db-port db))) + (if (and (symbol? coding) (known-input-port-coding? coding)) + (if (and (port/supports-coding? port) + (port/known-coding? port coding)) + (port/set-coding port coding)) + (warn "Unrecognized value for coding:" coding)))))) + ;;; Look for keyword-style: prefix or keyword-style: suffix (define (process-keyword-attribute file-attribute-alist db) (let ((keyword-entry @@ -925,7 +938,7 @@ USA. (set-db-property! db 'reader-keyword-style 'suffix)) (else (warn "Unrecognized value for keyword-style" value))))))) - + ;;; Don't do anything with the mode, but warn if it isn't scheme. (define (process-mode-attribute file-attribute-alist db) (declare (ignore db))