From: Chris Hanson Date: Sat, 8 Jun 2019 05:02:39 +0000 (-0700) Subject: Teach reader to find and respect "coding" attribute. X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=06f33a4fb7467a07f3f7df0b4fff08691c74e9de;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 020dc5db2..a464e19e1 100644 --- a/src/runtime/reader.scm +++ b/src/runtime/reader.scm @@ -900,6 +900,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)) @@ -909,6 +910,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 @@ -927,7 +940,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))