diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 014382ee9ee0305f627a49bf50d37c4d5bf5dade..0941ffebdf885cd1cbd2a3865446e87af4d85cba 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -4943,10 +4943,8 @@ The result is a symbol or nil if the routine cannot be found." (aref (or (debug-source-start-positions d-source) (error (intl:gettext "Cannot set breakpoints for editor when ~ there is no start positions map."))) - local-tlf-offset)) - (external-format (or (c::debug-source-info d-source) - ext:*default-source-external-format*))) - (with-open-file (f name :external-format external-format) + local-tlf-offset))) + (with-open-file (f name :external-format (c::debug-source-info d-source)) (cond ((= (debug-source-created d-source) (file-write-date name)) (file-position f char-offset)) diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 62bf9866f358cb04c1322ff4dee7d4d08da17d10..113ddf0f93212bb211c128b300aa89fb827ca07f 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -1486,8 +1486,7 @@ See the CMU Common Lisp User's Manual for more information. (when *cached-source-stream* (close *cached-source-stream*)) (setq *cached-source-stream* (open name :if-does-not-exist nil - :external-format (or (c::debug-source-info d-source) - ext:*default-source-external-format*))) + :external-format (c::debug-source-info d-source))) (unless *cached-source-stream* (error (intl:gettext "Source file no longer exists:~% ~A.") (namestring name))) (format t (intl:gettext "~%; File: ~A~%") (namestring name))) diff --git a/src/code/exports.lisp b/src/code/exports.lisp index d0cfe58a17b97f64ada8b49be84740de5730c10b..a46d5bbde2fc5c8a3f0028da2110028e85e97f46 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1511,7 +1511,6 @@ "DESCRIBE-EXTERNAL-FORMAT") ;; Unicode (:export "STRING-TO-OCTETS" "OCTETS-TO-STRING" "*DEFAULT-EXTERNAL-FORMAT*" - "*DEFAULT-SOURCE-EXTERNAL-FORMAT*" "DESCRIBE-EXTERNAL-FORMAT" "LIST-ALL-EXTERNAL-FORMATS" "STRING-ENCODE" "STRING-DECODE" diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 062a0d33af3f364a11bb6beccf98e0f29385ae6e..e41b33193ba97be0acc78d13b3ad953b9ff55baf 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1362,320 +1362,6 @@ ;;;; Utility functions (misc routines, etc) -(defparameter *stream-encoding-file-attribute-translations* - (flet ((emacs-coding (target &rest list) - (flet ((add-suffix (list suffix) - (let ((list* nil)) - (dolist (coding list) - (push (concatenate 'simple-string coding "-" suffix) - list*)) - (nreverse list*)))) - `((,target ,@list) - ((,target :unix) ,@(add-suffix list "unix")) - ((,target :dos) ,@(add-suffix list "dos")) - ((,target :mac) ,@(add-suffix list "mac")))))) - `(;; Emacs specific codings. - ,@(emacs-coding :utf-8 "utf-8" "utf-8-with-signature" "mule-utf-8") - ,@(emacs-coding :utf-16le "utf-16le" "utf-16-le") - ,@(emacs-coding :utf-16be "utf-16be" "utf-16-be") - ,@(emacs-coding :utf-16 "utf-16" "utf-16le-with-signature" "utf-16be-with-signature") - ,@(emacs-coding :us-ascii "us-ascii" "iso-safe") - ,@(emacs-coding :iso-8859-1 "iso-8859-1" "latin-1" "iso-latin-1") - ,@(emacs-coding :iso-8859-1 "binary" "no-conversion" "raw-text") - ,@(emacs-coding :iso-8859-2 "iso-8859-2" "latin-2" "iso-latin-2") - ,@(emacs-coding :iso-8859-3 "iso-8859-3" "latin-3" "iso-latin-3") - ,@(emacs-coding :iso-8859-4 "iso-8859-4" "latin-4" "iso-latin-4") - ,@(emacs-coding :iso-8859-5 "iso-8859-5" "cyrillic-iso-8bit") - ,@(emacs-coding :iso-8859-6 "iso-8859-6") - ,@(emacs-coding :iso-8859-7 "iso-8859-7" "greek-iso-8bit") - ,@(emacs-coding :iso-8859-8 "iso-8859-8" "hebrew-iso-8bit") - ,@(emacs-coding :iso-8859-9 "iso-8859-9" "latin-5" "iso-latin-5") - ,@(emacs-coding :iso-8859-10 "iso-8859-10" "latin-6" "iso-latin-6") - ,@(emacs-coding :iso-8859-11 "iso-8859-11") - ,@(emacs-coding :iso-8859-13 "iso-8859-13" "latin-7" "iso-latin-7") - ,@(emacs-coding :iso-8859-14 "iso-8859-14" "latin-8" "iso-latin-8") - ,@(emacs-coding :iso-8859-15 "iso-8859-15" "latin-9" "iso-latin-9" "latin-0") - ,@(emacs-coding :iso-8859-16 "iso-8859-16" "latin-10" "iso-latin-10") - ,@(emacs-coding :cp437 "cp437" "ibm437") - ,@(emacs-coding :cp850 "cp850" "ibm850") - ,@(emacs-coding :cp852 "cp852" "ibm852") - ,@(emacs-coding :cp857 "cp857" "ibm857") - ,@(emacs-coding :cp858 "cp858") - ,@(emacs-coding :cp860 "cp860" "ibm860") - ,@(emacs-coding :cp861 "cp861" "ibm861") - ,@(emacs-coding :cp862 "cp862" "ibm862") - ,@(emacs-coding :cp863 "cp863" "ibm863") - ,@(emacs-coding :cp865 "cp865" "ibm865") - ,@(emacs-coding :roman8 "roman8" "hp-roman8") - ,@(emacs-coding :macintosh "mac-roman") - ,@(emacs-coding :utf-7 "utf-7") - ,@(emacs-coding :cp1250 "cp1250" "windows-1250") - ,@(emacs-coding :cp1251 "cp1251" "windows-1251") - ,@(emacs-coding :cp1252 "cp1252" "windows-1252") - ,@(emacs-coding :cp1253 "cp1253" "windows-1253") - ,@(emacs-coding :cp1254 "cp1254" "windows-1254") - ,@(emacs-coding :cp1255 "cp1255" "windows-1255") - ,@(emacs-coding :cp1256 "cp1256" "windows-1256") - ,@(emacs-coding :cp1257 "cp1257" "windows-1257") - ,@(emacs-coding :cp1258 "cp1258" "windows-1258") - ,@(emacs-coding :cp851 "cp851" "ibm851") - ,@(emacs-coding :cp737 "cp737") - ,@(emacs-coding :cp869 "cp869" "ibm869") - ,@(emacs-coding :cp866 "cp866") - ,@(emacs-coding :koi8 "koi8" "koi8-r" "cyrillic-koi8" "cp878") - ,@(emacs-coding :koi8-u "koi8-u") - ,@(emacs-coding :koi8-t "koi8-t") - ,@(emacs-coding :cp1125 "cp1125" "ruscii" "cp866u") - ,@(emacs-coding :cp855 "cp855" "ibm855") - ,@(emacs-coding :mik "mik") - ,@(emacs-coding :pt154 "pt154") - ,@(emacs-coding :ebcdic-us "ebcdic-us") - ,@(emacs-coding :ebcdic-uk "ebcdic-uk") - ,@(emacs-coding :cp1047 "cp1047" "ibm1047") - ,@(emacs-coding :iso-2022-cn "iso-2022-cn" "chinese-iso-7bit") - ,@(emacs-coding :iso-2022-cn-ext "iso-2022-cn-ext") - ,@(emacs-coding :gb2312 "gb2312" "cn-gb" "euc-cn" "euc-china" - "cn-gb-2312" "chinese-iso-8bit") - ,@(emacs-coding :big5 "big5" "cp950" "cn-big5" "chinese-big5") - ,@(emacs-coding :big5hkscs "big5-hkscs" "cn-big5-hkscs" "chinese-big5-hkscs") - ,@(emacs-coding :euc-tw "euc-tw" "euc-taiwan") - ,@(emacs-coding :cp936 "cp936" "windows-936" "gbk" "chinese-gbk") - ,@(emacs-coding :gb18030 "gb18030" "chinese-gb18003") - ,@(emacs-coding :cp874 "ibm874" "cp874") - ,@(emacs-coding :tis-620 "tis-620" "tis620" "th-tis620" "thai-tis620") - ,@(emacs-coding :viscii "viscii" "vietnamese-viscii") - ,@(emacs-coding :tcvn "tcvn-5712" "tcvn" "vietnamese-tcvn") - ,@(emacs-coding :georgian-ps "georgian-ps") - ,@(emacs-coding :georgian-academy "georgian-academy") - ,@(emacs-coding :iso-2022-jp "iso-2022-jp" "junet") - ,@(emacs-coding :iso-2022-jp-2 "iso-2022-jp-2") - ,@(emacs-coding :shift-jis "shift_jis" "sjis" "japanese-shift-jis") - ,@(emacs-coding :cp932 "cp932" "japanese-cp932") - ,@(emacs-coding :euc-jp "euc-jp" "euc-japan" "euc-japan-1990" "japanese-iso-8bit") - ,@(emacs-coding :euc-ms "eucjp-ms") - ,@(emacs-coding :iso-2022-jp-3 "iso-2022-jp-3" "iso-2022-jp-2004") - ,@(emacs-coding :euc-jisx0213 "euc-jisx0213" "euc-jis-2004") - ,@(emacs-coding :euc-korea "euc-korea" "euc-kr" "korean-iso-8bit") - ,@(emacs-coding :iso-2022-kr "iso-2022-kr" "korean-iso-7bit-lock") - ,@(emacs-coding :cp949 "cp949" "korean-cp949") - )) - "List of coding translations used by 'stream-encoding-file-attribute to map - the read file coding into a native external-format. Each element is a list of - a native external-format followed by a list of coding strings that are to be - mapped to this native format. The first element is the target encoding, - may be a list with the first element being the encoding and the second the - line termination style: :unix (linefeed), :dos (CR-LF), or :mac (CR).") - - -;;; stream-encoding-file-attribute -- Internal -;;; -;;; Read the encoding file option from the stream 's which is expected to be a -;;; character stream with an external-format of :iso8859-1. -;;; -(defun stream-encoding-file-attribute (s) - (let* ((initial-encoding nil) - (declared-encoding nil) - (eol-mode nil) - (buffer (make-array 1024 :element-type '(unsigned-byte 8))) - (available (do ((i 0 (1+ i))) - ((>= i 1024) i) - (declare (fixnum i)) - (let ((ch (read-char s nil nil))) - (unless ch (return i)) - (setf (aref buffer i) (char-code ch)))))) - (labels ((decode-ascii (start size offset) - (declare (type fixnum start) - (type (integer 1 4) size) - (type (integer 0 3) offset)) - (let ((ascii (make-array 64 :element-type 'character - :adjustable t :fill-pointer 0))) - (do () - ((< available (+ start size))) - (let* ((code (ecase size - (1 (aref buffer start)) - (2 (let ((b0 (aref buffer start)) - (b1 (aref buffer (1+ start)))) - (ecase offset - (0 (logior (ash b1 8) b0)) - (1 (logior (ash b0 8) b1))))) - (4 - (let ((b0 (aref buffer start)) - (b1 (aref buffer (+ start 1))) - (b2 (aref buffer (+ start 2))) - (b3 (aref buffer (+ start 3)))) - (ecase offset - (0 (logior (ash b3 24) (ash b2 16) (ash b1 8) b0)) - (1 (logior (ash b1 24) (ash b0 16) (ash b3 8) b2)) - (2 (logior (ash b2 24) (ash b3 16) (ash b0 8) b1)) - (3 (logior (ash b0 24) (ash b1 16) (ash b2 8) b3)))))))) - (incf start size) - (let ((ch (if (< 0 code #x80) (code-char code) #\?))) - (vector-push-extend ch ascii)))) - ascii)) - (parse-file-option (ascii) - ;; Parse the file options. - (let ((found (search "-*-" ascii)) - (options nil)) - (when found - (block do-file-options - (let* ((start (+ found 3)) - (end (search "-*-" ascii :start2 start))) - (unless end - (return-from do-file-options)) - (unless (find #\: ascii :start start :end end) - (return-from do-file-options)) - (do ((opt-start start (1+ semi)) colon semi) - (nil) - (setf colon (position #\: ascii :start opt-start :end end)) - (unless colon - (return-from do-file-options)) - (setf semi (or (position #\; ascii :start colon :end end) end)) - (let ((option (string-trim '(#\space #\tab) - (subseq ascii opt-start colon))) - (value (string-trim '(#\space #\tab) - (subseq ascii (1+ colon) semi)))) - (push (cons option value) options) - (when (= semi end) (return nil))))))) - (setf declared-encoding - (cond ((cdr (assoc "external-format" options :test 'equalp))) - ((cdr (assoc "encoding" options :test 'equalp))) - ((cdr (assoc "coding" options :test 'equalp))))))) - (detect-line-termination (ascii) - ;; Look for the first line termination and check the style. - (let ((p (position-if #'(lambda (c) (member c '(#\linefeed #\return))) - ascii))) - (when p - (let ((c1 (char ascii p))) - (cond ((char= c1 #\linefeed) - (setf eol-mode :unix)) - ((< (1+ p) (length ascii)) - (assert (char= c1 #\return)) - (let ((c2 (char ascii (1+ p)))) - (cond ((eql c2 #\linefeed) - (setf eol-mode :dos)) - (t - (setf eol-mode :mac))))))))))) - (cond ((>= available 4) - (let ((b1 (aref buffer 0)) - (b2 (aref buffer 1)) - (b3 (aref buffer 2)) - (b4 (aref buffer 3))) - (cond ((and (= b1 #x00) (= b2 #x00) (= b3 #xFE) (= b4 #xFF)) - (setf initial-encoding :ucs-4be) - (let ((ascii (decode-ascii 4 4 3))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 #xff) (= b2 #xfe)) - (cond ((and (= b3 #x00) (= b4 #x00)) - (setf initial-encoding :ucs-4le) - (let ((ascii (decode-ascii 4 4 0))) - (parse-file-option ascii) - (detect-line-termination ascii))) - (t - (setf initial-encoding :utf-16) - (let ((ascii (decode-ascii 2 2 0))) - (parse-file-option ascii) - (detect-line-termination ascii))))) - ((and (= b1 #x00) (= b2 #x00) (= b3 #xFF) (= b4 #xFE)) - (let ((ascii (decode-ascii 4 4 2))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 #xfe) (= b2 #xff)) - (cond ((and (= b3 #x00) (= b4 #x00)) - (let ((ascii (decode-ascii 4 4 1))) - (parse-file-option ascii) - (detect-line-termination ascii))) - (t - (setf initial-encoding :utf-16) - (let ((ascii (decode-ascii 2 2 1))) - (parse-file-option ascii) - (detect-line-termination ascii))))) - ;; - ((and (= b1 #xEF) (= b2 #xBB) (= b3 #xBF)) - (setf initial-encoding :utf-8) - (let ((ascii (decode-ascii 3 1 0))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ;; - ((and (> b1 0) (= b2 0) (= b3 0) (= b4 0)) - (setf initial-encoding :ucs-4le) - (let ((ascii (decode-ascii 0 4 0))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 0) (> b2 0) (= b3 0) (= b4 0)) - (let ((ascii (decode-ascii 0 4 1))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 0) (= b2 0) (> b3 0) (= b4 0)) - (let ((ascii (decode-ascii 0 4 2))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 0) (= b2 0) (= b3 0) (> b4 0)) - (setf initial-encoding :ucs-4be) - (let ((ascii (decode-ascii 0 4 3))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ;; - ((and (> b1 0) (= b2 0) (> b3 0) (= b4 0)) - (setf initial-encoding :utf-16le) - (let ((ascii (decode-ascii 0 2 0))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ((and (= b1 0) (> b2 0) (= b3 0) (> b4 0)) - (setf initial-encoding :utf-16be) - (let ((ascii (decode-ascii 0 2 1))) - (parse-file-option ascii) - (detect-line-termination ascii))) - ;; - ((and (= b1 #x2B) (= b2 #x41) - (or (= b3 #x43) (= b3 #x44))) - (setf initial-encoding :utf-7) - (let ((ascii (decode-ascii 0 1 0))) - (detect-line-termination ascii))) - ((and (= b1 #x2F) (= b2 #x2B) (= b3 #x41)) - (setf initial-encoding :utf-7) - (let ((ascii (decode-ascii 0 1 0))) - (detect-line-termination ascii))) - (t - (let ((ascii (decode-ascii 0 1 0))) - (when (parse-file-option ascii) - (detect-line-termination ascii))))))) - ((= available 3) - (when (and (= (aref buffer 0) #xEF) - (= (aref buffer 1) #xBB) - (= (aref buffer 2) #xBF)) - (setf initial-encoding :utf-8))) - ((= available 2) - (let ((b1 (aref buffer 0)) - (b2 (aref buffer 1))) - (cond ((or (and (= b1 #xff) (= b2 #xfe)) - (and (= b1 #xfe) (= b2 #xff))) - (setf initial-encoding :utf-16))))))) - ;; - ;; - (cond ((and (not initial-encoding) (not declared-encoding)) - (values :default eol-mode)) - (t - (let ((encoding (or declared-encoding initial-encoding))) - (when (stringp encoding) - (setf encoding (string-upcase encoding)) - (dolist (translations *stream-encoding-file-attribute-translations*) - (when (member encoding (rest translations) :test 'equalp) - (let ((target (first translations))) - (cond ((consp target) - (setf encoding (first target)) - (setf eol-mode (second target))) - (t - (setf encoding (first translations))))) - (return)))) - (let ((external-format - (cond ((eq encoding :default) :default) - ((stringp encoding) - (intern encoding :keyword)) - (t - encoding)))) - (values external-format eol-mode))))))) - ;;; SET-ROUTINES -- internal ;;; ;;; Fill in the various routine slots for the given type. Input-p and @@ -2236,7 +1922,18 @@ (setf (fd-stream-flags stream) #b001)) (t (setf (fd-stream-flags stream) #b010))) + + ;; FIXME: setting the external format here should be better + ;; integrated into set-routines. We do it before so that + ;; set-routines can create an in-buffer if appropriate. But we + ;; need to do it after to put the correct input routines for the + ;; external format. ;; + ;;#-unicode-bootstrap ; fails in stream-reinit otherwise + (%set-fd-stream-external-format stream external-format nil) + (set-routines stream element-type input output input-buffer-p + :binary-stream-p binary-stream-p) + (%set-fd-stream-external-format stream external-format nil) (when (and auto-close (fboundp 'finalize)) (finalize stream #'(lambda () @@ -2244,45 +1941,6 @@ (format *terminal-io* (intl:gettext "** Closed ~A~%") name) (when original (revert-file file original))))) - ;; - ;; FIXME: setting the external format here should be better - ;; integrated into set-routines. We do it before so that - ;; set-routines can create an in-buffer if appropriate. But we - ;; need to do it after to put the correct input routines for the - ;; external format. - ;; - ;;#-unicode-bootstrap ; fails in stream-reinit otherwise - (cond ((and (eq external-format :file-attribute) input) - ;; Read the encoding file option with the external-format set to - ;; :iso8859-1, and then change the external-format if necessary. - (%set-fd-stream-external-format stream :iso8859-1 nil) - (set-routines stream element-type input output input-buffer-p - :binary-stream-p binary-stream-p) - (%set-fd-stream-external-format stream :iso8859-1 nil) - (multiple-value-bind (encoding eol-mode) - (stream-encoding-file-attribute stream) - (unless (file-position stream :start) - (error (intl:gettext "The ~A external-format requires a file stream.") - external-format)) - (unless (and (member encoding '(:iso8859-1 :iso-8859-1)) - (member eol-mode '(nil :unix))) - (setf (stream-external-format stream) - (cond ((member eol-mode '(nil :unix)) - (or encoding :default)) - (t - (list (or encoding :default) eol-mode))))))) - ((eq external-format :file-attribute) - ;; Non-input stream, so can not read the file attributes, so use the - ;; :default. - (%set-fd-stream-external-format stream :default nil) - (set-routines stream element-type input output input-buffer-p - :binary-stream-p binary-stream-p) - (%set-fd-stream-external-format stream :default nil)) - (t - (%set-fd-stream-external-format stream external-format nil) - (set-routines stream element-type input output input-buffer-p - :binary-stream-p binary-stream-p) - (%set-fd-stream-external-format stream external-format nil))) stream)) diff --git a/src/code/load.lisp b/src/code/load.lisp index 89f7705e562640f8f0b4366e716c901a90995f96..b5f591d26275fc747472d30c5888321a451fb261 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -95,11 +95,6 @@ (invalid-fasl-version condition) (invalid-fasl-expected-version condition))))) -(defvar *default-source-external-format* :default - "The external-format that 'load and 'compile-file use when given an - external-format of :default. The default value is :default which will open - the file using the 'ext:*default-external-format*") - ;;; LOAD-FRESH-LINE -- internal. ;;; @@ -531,7 +526,7 @@ :EXTERNAL-FORMAT The external-format to use when opening the FILENAME. The default is - :default which uses the EXT:*DEFAULT-SOURCE-EXTERNAL-FORMAT*. + :default which uses the EXT:*DEFAULT-EXTERNAL-FORMAT*. The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER* determine the defaults for the corresponding keyword arguments. These @@ -614,8 +609,6 @@ (*load-pathname* pathname)) (case contents (:source - (when (eq external-format :default) - (setf external-format *default-source-external-format*)) (with-open-file (file truename :external-format external-format :direction :input :if-does-not-exist if-does-not-exist) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 4d807359451cd4fd2e457f1c48b91e33a972c13a..cba62e95b7289d2e5a2eef9578b05b5bfb376471 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -738,8 +738,6 @@ :write-date (file-write-date x) :language :lisp)) files))) - (when (eq external-format :default) - (setf external-format *default-source-external-format*)) (make-source-info :files file-info :current-file file-info #+unicode :external-format