- cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-06-1-gb0e85da
by Raymond Toy 15 Jun '12

15 Jun '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via b0e85da9332a8822dd9496a0e4a72571b6d3546b (commit) from 94321e988a142e938548e3be07c8cbaf3077211d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b0e85da9332a8822dd9496a0e4a72571b6d3546b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Jun 15 12:19:47 2012 -0700 Update to asdf 2.22. Testsuite for asdf, using 2012-06, passes fine. diff --git a/src/contrib/asdf/asdf.lisp b/src/contrib/asdf/asdf.lisp index b7ad1dd..5981f67 100644 --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.21: Another System Definition Facility. +;;; This is ASDF 2.22: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -116,7 +116,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.21") + (asdf-version "2.22") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -1343,7 +1343,7 @@ processed in order by OPERATE.")) :initarg :if-component-dep-fails :accessor module-if-component-dep-fails) (default-component-class - :initform *default-component-class* + :initform nil :initarg :default-component-class :accessor module-default-component-class))) @@ -2788,6 +2788,11 @@ details." directory-pathname (default-directory)))) +(defun* find-class* (x &optional (errorp t) environment) + (etypecase x + ((or standard-class built-in-class) x) + (symbol (find-class x errorp environment)))) + (defun* class-for-type (parent type) (or (loop :for symbol :in (list type @@ -2799,8 +2804,10 @@ details." class (find-class 'component))) :return class) (and (eq type :file) - (or (and parent (module-default-component-class parent)) - (find-class *default-component-class*))) + (find-class* + (or (loop :for module = parent :then (component-parent module) :while module + :thereis (module-default-component-class module)) + *default-component-class*) nil)) (sysdef-error "don't recognize component type ~A" type))) (defun* maybe-add-tree (tree op1 op2 c) @@ -2886,7 +2893,7 @@ Returns the new tree (which probably shares structure with the old one)" (type name &rest rest &key ;; the following list of keywords is reproduced below in the ;; remove-keys form. important to keep them in sync - components pathname default-component-class + components pathname perform explain output-files operation-done-p weakly-depends-on depends-on serial in-order-to do-first @@ -2913,7 +2920,7 @@ Returns the new tree (which probably shares structure with the old one)" :pathname pathname :parent parent (remove-keys - '(components pathname default-component-class + '(components pathname perform explain output-files operation-done-p weakly-depends-on depends-on serial in-order-to) rest))) @@ -2927,10 +2934,6 @@ Returns the new tree (which probably shares structure with the old one)" (setf ret (apply 'make-instance (class-for-type parent type) args))) (component-pathname ret) ; eagerly compute the absolute pathname (when (typep ret 'module) - (setf (module-default-component-class ret) - (or default-component-class - (and (typep parent 'module) - (module-default-component-class parent)))) (let ((*serial-depends-on* nil)) (setf (module-components ret) (loop @@ -3687,7 +3690,7 @@ Please remove it from your ASDF configuration")) #+sbcl ,(let ((h (getenv "SBCL_HOME"))) (when (plusp (length h)) `((,(truenamize h) ,*wild-inferiors*) ()))) ;; The below two are not needed: no precompiled ASDF system there - ;; #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) + #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ;; #+clozure ,(ignore-errors (list (wilden (let ((*default-pathname-defaults* #p"")) (truename #p"ccl:"))) ())) ;; All-import, here is where we want user stuff to be: :inherit-configuration @@ -4011,21 +4014,24 @@ with a different configuration, so the configuration would be re-read then." entries)) (defun* directory-files (directory &optional (pattern *wild-file*)) - (setf directory (pathname directory)) - (when (wild-pathname-p directory) - (error "Invalid wild in ~S" directory)) - (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) - (error "Invalid file pattern ~S" pattern)) - (when (typep directory 'logical-pathname) - (setf pattern (make-pathname-logical pattern (pathname-host directory)))) - (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) - (filter-logical-directory-results - directory entries - #'(lambda (f) - (make-pathname :defaults directory - :name (pathname-name f) - :type (make-pathname-component-logical (pathname-type f)) - :version (make-pathname-component-logical (pathname-version f))))))) + (let ((dir (pathname directory))) + (when (typep dir 'logical-pathname) + ;; Because of the filtering we do below, + ;; logical pathnames have restrictions on wild patterns. + ;; Not that the results are very portable when you use these patterns on physical pathnames. + (when (wild-pathname-p dir) + (error "Invalid wild pattern in logical directory ~S" directory)) + (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) + (error "Invalid file pattern ~S for logical directory ~S" pattern directory)) + (setf pattern (make-pathname-logical pattern (pathname-host dir)))) + (let ((entries (ignore-errors (directory* (merge-pathnames* pattern dir))))) + (filter-logical-directory-results + directory entries + #'(lambda (f) + (make-pathname :defaults dir + :name (make-pathname-component-logical (pathname-name f)) + :type (make-pathname-component-logical (pathname-type f)) + :version (make-pathname-component-logical (pathname-version f)))))))) (defun* directory-asd-files (directory) (directory-files directory *wild-asd*)) @@ -4399,7 +4405,7 @@ with a different configuration, so the configuration would be re-read then." (let ((*verbose-out* (make-broadcast-stream)) (system (find-system (string-downcase name) nil))) (when system - (operate *require-asdf-operator* system :verbose nil) + (operate *require-asdf-operator* system :verbose nil :force-not (loaded-systems)) t)))) #+(or abcl clisp clozure cmu ecl sbcl) diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index e2b20e8..631fcca 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -30,7 +30,7 @@ New in this release: * Added external format for EUC-KR. * Changes - * ASDF2 updated to version 2.21. + * ASDF2 updated to version 2.22. * Behavior of STRING-TO-OCTETS has changed. This is an incompatible change from the previous version but should be more useful when a buffer is given which is not large enough to hold ----------------------------------------------------------------------- Summary of changes: src/contrib/asdf/asdf.lisp | 62 +++++++++++++++++++++----------------- src/general-info/release-20d.txt | 2 +- 2 files changed, 35 insertions(+), 29 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp annotated tag snapshot-2012-06 created. snapshot-2012-06
by Raymond Toy 12 Jun '12

12 Jun '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The annotated tag, snapshot-2012-06 has been created at 036e8b607ab2ddcf1717fb0918a68aee8278ee2f (tag) tagging 94321e988a142e938548e3be07c8cbaf3077211d (commit) replaces snapshot-2012-05 tagged by Raymond Toy on Mon Jun 11 20:57:00 2012 -0700 - Log ----------------------------------------------------------------- Snapshot 2012-06 Raymond Toy (20): Link to www.cmucl.org. Add popcnt instruction and use it in logcount vop if :sse3 is a Clear matching current exceptions when enabling new exceptions. This First cut at :file-attribute external-format that determines the * {{{COMPILE-FILE}}} should not signal an error when given a list for Add all the emacs format encodings. From Douglas. Debugger needs to open file with the appropriate external format. Use concatenate instead of format because format isn't available when Fix so this can build on 8-bit cmucl. Fix ticket:60 Update with changes. Merge branch 'master' into ext-format-file-attribute Remove extra closing parenthesis. Update with new :FILE-ATTRIBUTE external format, contributed by Revert :file-attribute changes. Update. Update translation template. Don't set dimension of array to 1 for the rest slots of a primitive Add comments about using clang instead of gcc on x86. Oops. Didn't mean for the gencgc.o rule to get included. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-20-g94321e9
by Raymond Toy 12 Jun '12

12 Jun '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 94321e988a142e938548e3be07c8cbaf3077211d (commit) from 86f6dccd0b106765670265e0cf0c7ce2e6a84b55 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 94321e988a142e938548e3be07c8cbaf3077211d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Jun 11 20:54:47 2012 -0700 Oops. Didn't mean for the gencgc.o rule to get included. diff --git a/src/lisp/Config.x86_common b/src/lisp/Config.x86_common index 0fa9bb3..edf4476 100644 --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -88,6 +88,3 @@ DEPEND_FLAGS = e_rem_pio2.o : e_rem_pio2.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $< -# -gencgc.o : gencgc.c - $(CC) -c -mno-sse $(CFLAGS) $(CPPFLAGS) $< \ No newline at end of file ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.x86_common | 3 --- 1 files changed, 0 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-19-g86f6dcc
by Raymond Toy 02 Jun '12

02 Jun '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 86f6dccd0b106765670265e0cf0c7ce2e6a84b55 (commit) from 0d6f20340333a05b1f990056b38ffb77083de2f1 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 86f6dccd0b106765670265e0cf0c7ce2e6a84b55 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Jun 2 15:02:00 2012 -0700 Add comments about using clang instead of gcc on x86. diff --git a/src/lisp/Config.x86_common b/src/lisp/Config.x86_common index 5ed23de..0fa9bb3 100644 --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -45,7 +45,24 @@ ifdef FEATURE_UNICODE CPP_DEFINE_OPTIONS += -DUNICODE endif +# Default to using gcc CC = gcc + +# But we can use clang. +# +# However, clang seems to want to use SSE instructions in various +# places, but we DON'T want that because we need a lisp that will run +# on chips without sse. +# +# But on Mac, every machine has SSE2 so we can use SSE2. However, +# there's some code path through GC or allocation where we aren't +# saving the FPU state so after GC or allocation, some XMM FP +# registers are corrupted. +# +# Got that? + +#CC = clang -mno-sse + LD = ld ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),) @@ -70,3 +87,7 @@ DEPEND_FLAGS = # -ffloat-store and -fno-strict-aliasing anymore. e_rem_pio2.o : e_rem_pio2.c $(CC) -c $(CFLAGS) $(CPPFLAGS) $< + +# +gencgc.o : gencgc.c + $(CC) -c -mno-sse $(CFLAGS) $(CPPFLAGS) $< \ No newline at end of file ----------------------------------------------------------------------- Summary of changes: src/lisp/Config.x86_common | 21 +++++++++++++++++++++ 1 files changed, 21 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-18-g0d6f203
by Raymond Toy 01 Jun '12

01 Jun '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 0d6f20340333a05b1f990056b38ffb77083de2f1 (commit) via 7095ad43fd8997c759041e046ffc251fb9685011 (commit) via 27f601d7cef020a11b2ae18e0337319385d1fb2e (commit) from f8b368ffa9fbcf75cac9a7ed1d5551e1d57ae76b (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 0d6f20340333a05b1f990056b38ffb77083de2f1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu May 31 21:25:33 2012 -0700 Don't set dimension of array to 1 for the rest slots of a primitive object. diff --git a/src/compiler/generic/new-genesis.lisp b/src/compiler/generic/new-genesis.lisp index 9523d41..953d9ba 100644 --- a/src/compiler/generic/new-genesis.lisp +++ b/src/compiler/generic/new-genesis.lisp @@ -2570,7 +2570,7 @@ (when (vm:primitive-object-header obj) (format t " lispobj header;~%")) (dolist (slot (vm:primitive-object-slots obj)) - (format t " ~A ~A~@[[1]~];~%" + (format t " ~A ~A~@[[]~];~%" (getf (vm:slot-options slot) :c-type "lispobj") (nsubstitute #\_ #\- (string-downcase (string (vm:slot-name slot)))) commit 7095ad43fd8997c759041e046ffc251fb9685011 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu May 31 19:55:27 2012 -0700 Update translation template. diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index bb807f4..6a45d45 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -9187,16 +9187,6 @@ msgid "Error reading ~S: ~A" msgstr "" #: src/code/fd-stream.lisp -msgid "" -"List of coding translations used by 'stream-encoding-file-attribute to map\n" -" the read file coding into a native external-format. Each element is a " -"list of\n" -" a native external-format followed byte a list of coding strings that are " -"to be\n" -" mapped to this native format." -msgstr "" - -#: src/code/fd-stream.lisp msgid "Could not find any input routine for ~S" msgstr "" @@ -9273,10 +9263,6 @@ msgid "** Closed ~A~%" msgstr "" #: src/code/fd-stream.lisp -msgid "The ~A external-format requires a file stream." -msgstr "" - -#: src/code/fd-stream.lisp msgid "" "This is a string that OPEN tacks on the end of a file namestring to produce\n" " a name for the :if-exists :rename-and-delete and :rename options. Also,\n" @@ -10078,14 +10064,6 @@ msgid "" msgstr "" #: src/code/load.lisp -msgid "" -"The external-format that 'load and 'compile-file use when given an\n" -" external-format of :default. The default value is :default which will " -"open\n" -" the file using the 'ext:*default-external-format*" -msgstr "" - -#: src/code/load.lisp msgid "List of free fop tables for the fasloader." msgstr "" @@ -10157,7 +10135,7 @@ msgid "" "\n" " :EXTERNAL-FORMAT\n" " The external-format to use when opening the FILENAME. The default is\n" -" :default which uses the EXT:*DEFAULT-SOURCE-EXTERNAL-FORMAT*.\n" +" :default which uses the EXT:*DEFAULT-EXTERNAL-FORMAT*.\n" "\n" " The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER" "*\n" commit 27f601d7cef020a11b2ae18e0337319385d1fb2e Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue May 29 20:17:47 2012 -0700 Update. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index f176b8b..e2b20e8 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -28,10 +28,6 @@ New in this release: double-float) numbers. Utility functions are provided to set and access these packed numbers. * Added external format for EUC-KR. - * Added new external format, :FILE-ATTRIBUTE, which looks for an - emacs mode-line to determine the encoding to use for reading a - file. The end-of-line sequence is also determined from reading - the file. * Changes * ASDF2 updated to version 2.21. @@ -54,11 +50,6 @@ New in this release: enabling a trap when the current exception also listed that trap caused the exception to be immediately signaled. This no longer happens and now matches how ppc and sparc behave. - * The default external-format for COMPILE-FILE and LOAD is now - given by *DEFAULT-SOURCE-EXTERNAL-FORMAT*, instead of - *DEFAULT-EXTERNAL-FORMAT*. However, the default value of - *DEFAULT-SOURCE-EXTERNAL-FORMAT* is :DEFAULT, which means the - value of *DEFAULT-EXTERNAL-FORMAT* will be used. * ANSI compliance fixes: * CMUCL was not printing pathnames like (make-pathname :directory ----------------------------------------------------------------------- Summary of changes: src/compiler/generic/new-genesis.lisp | 2 +- src/general-info/release-20d.txt | 9 --------- src/i18n/locale/cmucl.pot | 24 +----------------------- 3 files changed, 2 insertions(+), 33 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-15-gf8b368f
by Raymond Toy 30 May '12

30 May '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via f8b368ffa9fbcf75cac9a7ed1d5551e1d57ae76b (commit) from 0653c4136d09939153698e149b55f493a42b349a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit f8b368ffa9fbcf75cac9a7ed1d5551e1d57ae76b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue May 29 19:57:28 2012 -0700 Revert :file-attribute changes. diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 014382e..0941ffe 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 62bf986..113ddf0 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 d0cfe58..a46d5bb 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 062a0d3..e41b331 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 89f7705..b5f591d 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 4d80735..cba62e9 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 ----------------------------------------------------------------------- Summary of changes: src/code/debug-int.lisp | 6 +- src/code/debug.lisp | 3 +- src/code/exports.lisp | 1 - src/code/fd-stream.lisp | 364 ++--------------------------------------------- src/code/load.lisp | 9 +- src/compiler/main.lisp | 2 - 6 files changed, 15 insertions(+), 370 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-14-g0653c41
by Raymond Toy 28 May '12

28 May '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 0653c4136d09939153698e149b55f493a42b349a (commit) via 4ffd5ed1ea819525878370bc988cd46386b8c1b2 (commit) via 7514638ff9ecc8d1f61c425feea45edf125d9e62 (commit) via fbced7f5db441d632c6ceb8eb53f598e0588551b (commit) via 38b90775ff86c404a507fda46eda01dc9bb2adab (commit) via 4bbfd80236161221c3271734cea742f11b25e334 (commit) via 9a2c833786572d84ca98de5e938e5ac4c42b4618 (commit) via 164dd1e02ab53a665e561b5e0a2369f19f73c3b0 (commit) from afd3451aeb9bb26e076e235c502c5b1a106081cf (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 0653c4136d09939153698e149b55f493a42b349a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon May 28 15:49:32 2012 -0700 Update with new :FILE-ATTRIBUTE external format, contributed by Douglas Crosher. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index af8619d..f176b8b 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -28,6 +28,10 @@ New in this release: double-float) numbers. Utility functions are provided to set and access these packed numbers. * Added external format for EUC-KR. + * Added new external format, :FILE-ATTRIBUTE, which looks for an + emacs mode-line to determine the encoding to use for reading a + file. The end-of-line sequence is also determined from reading + the file. * Changes * ASDF2 updated to version 2.21. @@ -50,6 +54,11 @@ New in this release: enabling a trap when the current exception also listed that trap caused the exception to be immediately signaled. This no longer happens and now matches how ppc and sparc behave. + * The default external-format for COMPILE-FILE and LOAD is now + given by *DEFAULT-SOURCE-EXTERNAL-FORMAT*, instead of + *DEFAULT-EXTERNAL-FORMAT*. However, the default value of + *DEFAULT-SOURCE-EXTERNAL-FORMAT* is :DEFAULT, which means the + value of *DEFAULT-EXTERNAL-FORMAT* will be used. * ANSI compliance fixes: * CMUCL was not printing pathnames like (make-pathname :directory @@ -82,6 +91,10 @@ New in this release: * EXPORT and friends should not EVAL the form when compiling. This was probably a leftover from the time when CMUCL did not have DEFPACKAGE. (See ticket:60.) + * The debugger was not always opening the file in the correct + external format. It defaulted to using + *DEFAULT-EXTERNAL-FORMAT* instead of the format used when + compiling the file. * Trac Tickets: * #50: Print/read error with make-pathname. commit 4ffd5ed1ea819525878370bc988cd46386b8c1b2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon May 28 09:47:36 2012 -0700 Remove extra closing parenthesis. diff --git a/src/tools/hemcom.lisp b/src/tools/hemcom.lisp index 949f3e0..c841aae 100644 --- a/src/tools/hemcom.lisp +++ b/src/tools/hemcom.lisp @@ -118,7 +118,7 @@ "WINDOW-DISPLAY-END" "WINDOW-DISPLAY-RECENTERING" "WINDOW-DISPLAY-START" "WINDOW-FONT" "WINDOW-HEIGHT" "WINDOW-POINT" "WINDOW-WIDTH" "WINDOWP" "WITH-INPUT-FROM-REGION" "WITH-MARK" "WITH-OUTPUT-TO-MARK" - "WITH-POP-UP-DISPLAY" "WITH-WRITABLE-BUFFER" "WRITE-FILE"))) + "WITH-POP-UP-DISPLAY" "WITH-WRITABLE-BUFFER" "WRITE-FILE")) (unless (find-package "HEMLOCK") (make-package "HEMLOCK" commit 7514638ff9ecc8d1f61c425feea45edf125d9e62 Merge: fbced7f afd3451 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon May 28 09:19:17 2012 -0700 Merge branch 'master' into ext-format-file-attribute commit fbced7f5db441d632c6ceb8eb53f598e0588551b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 26 11:13:01 2012 -0700 Fix so this can build on 8-bit cmucl. o Clean up reader conditionals in MAKE-FD-STREAM. o Add dummy %SET-FD-STREAM-EXTERNAL-FORMAT for non-unicode. diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 5f194a0..062a0d3 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -2136,6 +2136,12 @@ ;;;; Creation routines (MAKE-FD-STREAM and OPEN) +;; The unicode version of this is in fd-stream-extfmt.lisp +#-(and unicode (not unicode-boootstrap)) +(defun %set-fd-stream-external-format (stream extfmt &optional (updatep t)) + (declare (ignore stream extfmt updatep)) + (values)) + ;;; MAKE-FD-STREAM -- Public. ;;; ;;; Returns a FD-STREAM on the given file. @@ -2246,15 +2252,12 @@ ;; external format. ;; ;;#-unicode-bootstrap ; fails in stream-reinit otherwise - #+(and unicode (not unicode-bootstrap)) (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. - #+(and unicode (not unicode-bootstrap)) (%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) - #+(and unicode (not unicode-bootstrap)) (%set-fd-stream-external-format stream :iso8859-1 nil) (multiple-value-bind (encoding eol-mode) (stream-encoding-file-attribute stream) @@ -2271,18 +2274,14 @@ ((eq external-format :file-attribute) ;; Non-input stream, so can not read the file attributes, so use the ;; :default. - #+(and unicode (not unicode-bootstrap)) (%set-fd-stream-external-format stream :default nil) (set-routines stream element-type input output input-buffer-p :binary-stream-p binary-stream-p) - #+(and unicode (not unicode-bootstrap)) (%set-fd-stream-external-format stream :default nil)) (t - #+(and unicode (not unicode-bootstrap)) (%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) - #+(and unicode (not unicode-bootstrap)) (%set-fd-stream-external-format stream external-format nil))) stream)) commit 38b90775ff86c404a507fda46eda01dc9bb2adab Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 26 09:13:34 2012 -0700 Use concatenate instead of format because format isn't available when compiling. diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 85aa0b8..5f194a0 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1367,7 +1367,8 @@ (flet ((add-suffix (list suffix) (let ((list* nil)) (dolist (coding list) - (push (format nil "~A-~A" coding suffix) list*)) + (push (concatenate 'simple-string coding "-" suffix) + list*)) (nreverse list*)))) `((,target ,@list) ((,target :unix) ,@(add-suffix list "unix")) commit 4bbfd80236161221c3271734cea742f11b25e334 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 26 08:24:55 2012 -0700 Debugger needs to open file with the appropriate external format. Patch from Douglas. diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index a3a3dfb..014382e 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -4943,8 +4943,10 @@ 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))) - (with-open-file (f name) + 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) (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 825ed0b..62bf986 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -1486,7 +1486,8 @@ 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) :default))) + :external-format (or (c::debug-source-info d-source) + ext:*default-source-external-format*))) (unless *cached-source-stream* (error (intl:gettext "Source file no longer exists:~% ~A.") (namestring name))) (format t (intl:gettext "~%; File: ~A~%") (namestring name))) commit 9a2c833786572d84ca98de5e938e5ac4c42b4618 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat May 26 08:24:22 2012 -0700 Add all the emacs format encodings. From Douglas. diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 820c22d..85aa0b8 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1363,20 +1363,101 @@ ;;;; Utility functions (misc routines, etc) (defparameter *stream-encoding-file-attribute-translations* - '(;; Emacs specific codings. - ((:iso-8859-1 :unix) - "latin-1" "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix") - ((:iso-8859-1 :dos) - "latin-1" "latin-1-dos" "iso-latin-1-dos" "iso-8859-1-dos") - ((:iso-8859-1 :max) - "latin-1" "latin-1-mac" "iso-latin-1-mac" "iso-8859-1-mac") - ((:utf-8 :unix) "utf-8-unix") - ((:utf-8 :dos) "utf-8-dos") - ((:utf-8 :mac) "utf-8-mac") - ((:euc-jp :unix) "euc-jp-unix") - ((:euc-jp :dos) "euc-jp-dos") - ((:euc-jp :mac) "euc-jp-mac") - ) + (flet ((emacs-coding (target &rest list) + (flet ((add-suffix (list suffix) + (let ((list* nil)) + (dolist (coding list) + (push (format nil "~A-~A" 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 commit 164dd1e02ab53a665e561b5e0a2369f19f73c3b0 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri May 25 22:49:18 2012 -0700 First cut at :file-attribute external-format that determines the format from the file contents ala emacs. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index a46d5bb..d0cfe58 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1511,6 +1511,7 @@ "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 45b5847..820c22d 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1362,6 +1362,238 @@ ;;;; Utility functions (misc routines, etc) +(defparameter *stream-encoding-file-attribute-translations* + '(;; Emacs specific codings. + ((:iso-8859-1 :unix) + "latin-1" "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix") + ((:iso-8859-1 :dos) + "latin-1" "latin-1-dos" "iso-latin-1-dos" "iso-8859-1-dos") + ((:iso-8859-1 :max) + "latin-1" "latin-1-mac" "iso-latin-1-mac" "iso-8859-1-mac") + ((:utf-8 :unix) "utf-8-unix") + ((:utf-8 :dos) "utf-8-dos") + ((:utf-8 :mac) "utf-8-mac") + ((:euc-jp :unix) "euc-jp-unix") + ((:euc-jp :dos) "euc-jp-dos") + ((:euc-jp :mac) "euc-jp-mac") + ) + "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 @@ -1916,20 +2148,7 @@ (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 - #+(and unicode (not unicode-bootstrap)) - (%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) - #+(and unicode (not unicode-bootstrap)) - (%set-fd-stream-external-format stream external-format nil) (when (and auto-close (fboundp 'finalize)) (finalize stream #'(lambda () @@ -1937,6 +2156,52 @@ (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 + #+(and unicode (not unicode-bootstrap)) + (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. + #+(and unicode (not unicode-bootstrap)) + (%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) + #+(and unicode (not unicode-bootstrap)) + (%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. + #+(and unicode (not unicode-bootstrap)) + (%set-fd-stream-external-format stream :default nil) + (set-routines stream element-type input output input-buffer-p + :binary-stream-p binary-stream-p) + #+(and unicode (not unicode-bootstrap)) + (%set-fd-stream-external-format stream :default nil)) + (t + #+(and unicode (not unicode-bootstrap)) + (%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) + #+(and unicode (not unicode-bootstrap)) + (%set-fd-stream-external-format stream external-format nil))) stream)) diff --git a/src/code/load.lisp b/src/code/load.lisp index 832853b..89f7705 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -19,7 +19,7 @@ (in-package "EXTENSIONS") (export '(*load-if-source-newer* *load-source-types* *load-object-types* - invalid-fasl)) + invalid-fasl *default-source-external-format*)) (in-package "SYSTEM") (export '(foreign-symbol-address alternate-get-global-address)) @@ -94,6 +94,12 @@ (invalid-fasl-pathname condition) (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. ;;; @@ -523,6 +529,10 @@ defaulting. Probably only necessary if you have source files with a \"fasl\" type. + :EXTERNAL-FORMAT + The external-format to use when opening the FILENAME. The default is + :default which uses the EXT:*DEFAULT-SOURCE-EXTERNAL-FORMAT*. + The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER* determine the defaults for the corresponding keyword arguments. These variables are also bound to the specified argument values, so specifying a @@ -604,6 +614,8 @@ (*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 544ccb0..066ff2d 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -738,12 +738,12 @@ :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 - #+unicode (stream::ef-name - (stream::find-external-format external-format)) + #+unicode external-format #+unicode :decoding-error #+unicode decoding-error))) diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 5b38108..bb807f4 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -9187,6 +9187,16 @@ msgid "Error reading ~S: ~A" msgstr "" #: src/code/fd-stream.lisp +msgid "" +"List of coding translations used by 'stream-encoding-file-attribute to map\n" +" the read file coding into a native external-format. Each element is a " +"list of\n" +" a native external-format followed byte a list of coding strings that are " +"to be\n" +" mapped to this native format." +msgstr "" + +#: src/code/fd-stream.lisp msgid "Could not find any input routine for ~S" msgstr "" @@ -9263,6 +9273,10 @@ msgid "** Closed ~A~%" msgstr "" #: src/code/fd-stream.lisp +msgid "The ~A external-format requires a file stream." +msgstr "" + +#: src/code/fd-stream.lisp msgid "" "This is a string that OPEN tacks on the end of a file namestring to produce\n" " a name for the :if-exists :rename-and-delete and :rename options. Also,\n" @@ -10064,6 +10078,14 @@ msgid "" msgstr "" #: src/code/load.lisp +msgid "" +"The external-format that 'load and 'compile-file use when given an\n" +" external-format of :default. The default value is :default which will " +"open\n" +" the file using the 'ext:*default-external-format*" +msgstr "" + +#: src/code/load.lisp msgid "List of free fop tables for the fasloader." msgstr "" @@ -10133,6 +10155,10 @@ msgid "" " defaulting. Probably only necessary if you have source files with a\n" " \"fasl\" type. \n" "\n" +" :EXTERNAL-FORMAT\n" +" The external-format to use when opening the FILENAME. The default is\n" +" :default which uses the EXT:*DEFAULT-SOURCE-EXTERNAL-FORMAT*.\n" +"\n" " The variables *LOAD-VERBOSE*, *LOAD-PRINT* and EXT:*LOAD-IF-SOURCE-NEWER" "*\n" " determine the defaults for the corresponding keyword arguments. These\n" ----------------------------------------------------------------------- Summary of changes: src/code/debug-int.lisp | 6 +- src/code/debug.lisp | 3 +- src/code/exports.lisp | 1 + src/code/fd-stream.lisp | 372 ++++++++++++++++++++++++++++++++++++-- src/code/load.lisp | 14 ++- src/compiler/main.lisp | 6 +- src/general-info/release-20d.txt | 13 ++ src/i18n/locale/cmucl.pot | 26 +++ src/tools/hemcom.lisp | 2 +- 9 files changed, 422 insertions(+), 21 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-6-gafd3451
by Raymond Toy 28 May '12

28 May '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via afd3451aeb9bb26e076e235c502c5b1a106081cf (commit) from 2970ca060d1c2677b00cec111d6e64d8c92ef42c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit afd3451aeb9bb26e076e235c502c5b1a106081cf Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon May 28 09:18:47 2012 -0700 Update with changes. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 8c71e7f..af8619d 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -79,6 +79,9 @@ New in this release: * COMPILE-FILE should not signal an error when given a list for :EXTERNAL-FORMAT. Lists are needed to specify a composing external format like :DOS or :MAC. + * EXPORT and friends should not EVAL the form when compiling. + This was probably a leftover from the time when CMUCL did not + have DEFPACKAGE. (See ticket:60.) * Trac Tickets: * #50: Print/read error with make-pathname. @@ -86,6 +89,7 @@ New in this release: * #52: UNICODE-COMPLETE-NAME misses a completion. * #55: blocked signals. * #58: UTF-16 buffering problem. + * #60: compile-file and export problem * Other changes: * The layout of the cmucl directories has been changed. ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20d.txt | 4 ++++ 1 files changed, 4 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-5-g2970ca0
by Raymond Toy 28 May '12

28 May '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 2970ca060d1c2677b00cec111d6e64d8c92ef42c (commit) from 583fcce354c115bdba3ea1c01e2cd76da4251cc8 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 2970ca060d1c2677b00cec111d6e64d8c92ef42c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon May 28 09:11:46 2012 -0700 Fix ticket:60 src/compiler/main.lisp: o Remove special treatment of EXPORT (and others) in the compiler. I think we only need to treat IN-PACKAGE and DEFPACKAGE specially. src/contrib/defsyste/defsystem.lisp: o Add FIND-SYSTEM to the defpackage export list for MAKE. src/tools/hemcom.lisp: o Add defpackage for hemlock-internals since export no longer has the compile-time effect. diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 544ccb0..be5f291 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1210,11 +1210,10 @@ (if (atom form) (convert-and-maybe-compile form path) (case (car form) - ((make-package shadow shadowing-import export - unexport use-package unuse-package import - old-in-package %in-package %defpackage) + ((%in-package %defpackage) (process-cold-load-form form path t)) - ((error cerror break signal) + ((error cerror break signal make-package use-package unuse-package shadow + shadowing-import export unexport import) (process-cold-load-form form path nil)) (kernel:%compiler-defstruct (convert-and-maybe-compile form path) diff --git a/src/contrib/defsystem/defsystem.lisp b/src/contrib/defsystem/defsystem.lisp index 2d7f0ea..ae23dbc 100644 --- a/src/contrib/defsystem/defsystem.lisp +++ b/src/contrib/defsystem/defsystem.lisp @@ -1035,7 +1035,10 @@ ;;; Here I add the proper defpackage for CMU #+:CMU (defpackage "MAKE" (:use "COMMON-LISP" "CONDITIONS") - (:nicknames "MK")) + (:nicknames "MK") + (:export "DEFSYSTEM" "COMPILE-SYSTEM" "LOAD-SYSTEM" + "DEFINE-LANGUAGE" "*MULTIPLE-LISP-SUPPORT*" + "FIND-SYSTEM")) #+:sbcl (defpackage "MAKE" (:use "COMMON-LISP") diff --git a/src/tools/hemcom.lisp b/src/tools/hemcom.lisp index ee56f5c..949f3e0 100644 --- a/src/tools/hemcom.lisp +++ b/src/tools/hemcom.lisp @@ -32,6 +32,94 @@ :nicknames '("HI") :use '("LISP" "EXTENSIONS" "SYSTEM"))) +(defpackage "HEMLOCK-INTERNALS" + (:nicknames "HI") + (:export + "*BUFFER-LIST*" "*BUFFER-NAMES*" "*CHARACTER-ATTRIBUTE-NAMES*" + "*COMMAND-NAMES*" "*CREATE-INITIAL-WINDOWS-HOOK*" "*CREATE-WINDOW-HOOK*" + "*DELETE-WINDOW-HOOK*" "*ECHO-AREA-BUFFER*" "*ECHO-AREA-STREAM*" + "*ECHO-AREA-WINDOW*" "*EDITOR-INPUT*" "*GLOBAL-VARIABLE-NAMES*" + "*INPUT-TRANSCRIPT*" "*INVOKE-HOOK*" "*KEY-EVENT-HISTORY*" + "*LAST-KEY-EVENT-TYPED*" "*LOGICAL-KEY-EVENT-NAMES*" "*MODE-NAMES*" + "*PARSE-DEFAULT*" "*PARSE-DEFAULT-STRING*" "*PARSE-HELP*" + "*PARSE-INPUT-REGION*" "*PARSE-PROMPT*" "*PARSE-STARTING-MARK*" + "*PARSE-STRING-TABLES*" "*PARSE-TYPE*" "*PARSE-VALUE-MUST-EXIST*" + "*PARSE-VERIFICATION-FUNCTION*" "*PRINT-REGION*" + "*RANDOM-TYPEOUT-BUFFERS*" "*RANDOM-TYPEOUT-HOOK*" "*REAL-EDITOR-INPUT*" + "*WINDOW-LIST*" "ABORT-RECURSIVE-EDIT" "ADD-HOOK" + "AFTER-EDITOR-INITIALIZATIONS" "BIND-KEY" "BLANK-AFTER-P" + "BLANK-BEFORE-P" "BLANK-LINE-P" "BUFFER" "BUFFER-DELETE-HOOK" + "BUFFER-END" "BUFFER-END-MARK" "BUFFER-MAJOR-MODE" "BUFFER-MINOR-MODE" + "BUFFER-MODELINE-FIELD-P" "BUFFER-MODELINE-FIELDS" "BUFFER-MODES" + "BUFFER-MODIFIED" "BUFFER-NAME" "BUFFER-PATHNAME" "BUFFER-POINT" + "BUFFER-REGION" "BUFFER-SIGNATURE" "BUFFER-START" "BUFFER-START-MARK" + "BUFFER-VARIABLES" "BUFFER-WINDOWS" "BUFFER-WRITABLE" "BUFFER-WRITE-DATE" + "BUFFERP" "CENTER-WINDOW" "CHARACTER-ATTRIBUTE" + "CHARACTER-ATTRIBUTE-DOCUMENTATION" "CHARACTER-ATTRIBUTE-HOOKS" + "CHARACTER-ATTRIBUTE-NAME" "CHARACTER-ATTRIBUTE-P" "CHARACTER-OFFSET" + "CLEAR-ECHO-AREA" "CLEAR-EDITOR-INPUT" "CLRSTRING" "COMMAND" + "COMMAND-BINDINGS" "COMMAND-CASE" "COMMAND-DOCUMENTATION" + "COMMAND-FUNCTION" "COMMAND-NAME" "COMMANDP" "COMPLETE-STRING" + "COPY-MARK" "COPY-REGION" "COUNT-CHARACTERS" "COUNT-LINES" + "CURRENT-BUFFER" "CURRENT-POINT" "CURRENT-VARIABLE-TABLES" + "CURRENT-WINDOW" "CURSORPOS-TO-MARK" "DEFATTRIBUTE" "DEFAULT-FONT" + "DEFCOMMAND" "DEFHVAR" "DEFINE-LOGICAL-KEY-EVENT" "DEFINE-TTY-FONT" + "DEFMODE" "DELETE-AND-SAVE-REGION" "DELETE-BUFFER" "DELETE-CHARACTERS" + "DELETE-FONT-MARK" "DELETE-KEY-BINDING" "DELETE-LINE-FONT-MARKS" + "DELETE-MARK" "DELETE-REGION" "DELETE-STRING" "DELETE-VARIABLE" + "DELETE-WINDOW" "DIRECTORYP" "DISPLAYED-P" "DO-ALPHA-CHARS" "DO-STRINGS" + "EDITOR-DESCRIBE-FUNCTION" "EDITOR-ERROR" "EDITOR-ERROR-FORMAT-ARGUMENTS" + "EDITOR-ERROR-FORMAT-STRING" "EDITOR-FINISH-OUTPUT" "EDITOR-SLEEP" + "EMPTY-LINE-P" "END-LINE-P" "ENTER-WINDOW-AUTORAISE" "EXIT-HEMLOCK" + "EXIT-RECURSIVE-EDIT" "FETCH-CUT-STRING" "FILTER-REGION" "FIND-AMBIGUOUS" + "FIND-ATTRIBUTE" "FIND-CONTAINING" "FIND-PATTERN" "FIRST-LINE-P" + "FONT-MARK" "FUN-DEFINED-FROM-PATHNAME" "GET-COMMAND" "GET-KEY-EVENT" + "GETSTRING" "HANDLE-LISP-ERRORS" "HEMLOCK-BOUND-P" + "HEMLOCK-OUTPUT-STREAM" "HEMLOCK-OUTPUT-STREAM-P" "HEMLOCK-REGION-STREAM" + "HEMLOCK-REGION-STREAM-P" "HLET" "IN-RECURSIVE-EDIT" "INPUT-WAITING" + "INSERT-CHARACTER" "INSERT-REGION" "INSERT-STRING" "INVOKE-HOOK" + "KEY-TRANSLATION" "LAST-COMMAND-TYPE" "LAST-KEY-EVENT-CURSORPOS" + "LAST-LINE-P" "LINE" "LINE-BUFFER" "LINE-CHARACTER" "LINE-END" + "LINE-LENGTH" "LINE-NEXT" "LINE-OFFSET" "LINE-PLIST" "LINE-PREVIOUS" + "LINE-SIGNATURE" "LINE-START" "LINE-STRING" "LINE-TO-REGION" "LINE<" + "LINE<=" "LINE>" "LINE>=" "LINEP" "LINES-RELATED" "LISTEN-EDITOR-INPUT" + "LOGICAL-KEY-EVENT-DOCUMENTATION" "LOGICAL-KEY-EVENT-KEY-EVENTS" + "LOGICAL-KEY-EVENT-NAME" "LOGICAL-KEY-EVENT-P" "LOUD-MESSAGE" + "MAKE-BUFFER" "MAKE-COMMAND" "MAKE-EMPTY-REGION" + "MAKE-HEMLOCK-OUTPUT-STREAM" "MAKE-HEMLOCK-REGION-STREAM" + "MAKE-KBDMAC-STREAM" "MAKE-MODELINE-FIELD" "MAKE-RING" + "MAKE-STRING-TABLE" "MAKE-WINDOW" "MAKE-XWINDOW-LIKE-HWINDOW" + "MAP-BINDINGS" "MARK" "MARK-AFTER" "MARK-BEFORE" "MARK-CHARPOS" + "MARK-COLUMN" "MARK-KIND" "MARK-LINE" "MARK-TO-CURSORPOS" "MARK/=" + "MARK<" "MARK<=" "MARK=" "MARK>" "MARK>=" "MARKP" + "MERGE-RELATIVE-PATHNAMES" "MESSAGE" "MODE-DOCUMENTATION" "MODE-MAJOR-P" + "MODE-VARIABLES" "MODELINE-FIELD" "MODELINE-FIELD-FUNCTION" + "MODELINE-FIELD-NAME" "MODELINE-FIELD-P" "MODELINE-FIELD-WIDTH" + "MODIFY-KBDMAC-STREAM" "MOVE-FONT-MARK" "MOVE-MARK" "MOVE-TO-COLUMN" + "MOVE-TO-POSITION" "NEW-SEARCH-PATTERN" "NEXT-CHARACTER" "NEXT-WINDOW" + "NINSERT-REGION" "PAUSE-HEMLOCK" "PREFIX-ARGUMENT" "PREVIOUS-CHARACTER" + "PREVIOUS-WINDOW" "PROMPT-FOR-BUFFER" "PROMPT-FOR-EXPRESSION" + "PROMPT-FOR-FILE" "PROMPT-FOR-INTEGER" "PROMPT-FOR-KEY" + "PROMPT-FOR-KEY-EVENT" "PROMPT-FOR-KEYWORD" "PROMPT-FOR-STRING" + "PROMPT-FOR-VARIABLE" "PROMPT-FOR-Y-OR-N" "PROMPT-FOR-YES-OR-NO" + "READ-FILE" "RECURSIVE-EDIT" "REDISPLAY" "REDISPLAY-ALL" "REGION" + "REGION-BOUNDS" "REGION-END" "REGION-START" "REGION-TO-STRING" "REGIONP" + "REMOVE-HOOK" "REMOVE-SCHEDULED-EVENT" "REPLACE-PATTERN" "REPROMPT" + "REVERSE-FIND-ATTRIBUTE" "RING" "RING-LENGTH" "RING-POP" "RING-PUSH" + "RING-REF" "RINGP" "ROTATE-RING" "SAME-LINE-P" "SCHEDULE-EVENT" + "SCROLL-WINDOW" "SEARCH-CHAR-CODE-LIMIT" "SEARCH-PATTERN" + "SEARCH-PATTERN-P" "SET-REGION-BOUNDS" "SETV" "SHADOW-ATTRIBUTE" + "SHOW-MARK" "START-LINE-P" "STORE-CUT-STRING" "STRING-TABLE" + "STRING-TABLE-P" "STRING-TABLE-SEPARATOR" "STRING-TO-REGION" + "STRING-TO-VARIABLE" "SYNTAX-CHAR-CODE-LIMIT" "UNGET-KEY-EVENT" + "UNSHADOW-ATTRIBUTE" "UPDATE-MODELINE-FIELD" "UPDATE-MODELINE-FIELDS" + "USE-BUFFER" "VALUE" "VARIABLE-DOCUMENTATION" "VARIABLE-HOOKS" + "VARIABLE-NAME" "VARIABLE-VALUE" "WINDOW" "WINDOW-BUFFER" + "WINDOW-DISPLAY-END" "WINDOW-DISPLAY-RECENTERING" "WINDOW-DISPLAY-START" + "WINDOW-FONT" "WINDOW-HEIGHT" "WINDOW-POINT" "WINDOW-WIDTH" "WINDOWP" + "WITH-INPUT-FROM-REGION" "WITH-MARK" "WITH-OUTPUT-TO-MARK" + "WITH-POP-UP-DISPLAY" "WITH-WRITABLE-BUFFER" "WRITE-FILE"))) + (unless (find-package "HEMLOCK") (make-package "HEMLOCK" :nicknames '("ED") ----------------------------------------------------------------------- Summary of changes: src/compiler/main.lisp | 7 +-- src/contrib/defsystem/defsystem.lisp | 5 ++- src/tools/hemcom.lisp | 88 ++++++++++++++++++++++++++++++++++ 3 files changed, 95 insertions(+), 5 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-05-4-g583fcce
by Raymond Toy 26 May '12

26 May '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 583fcce354c115bdba3ea1c01e2cd76da4251cc8 (commit) from c4ee759adf765707fba62c154315f0ed3e9036db (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 583fcce354c115bdba3ea1c01e2cd76da4251cc8 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri May 25 22:50:38 2012 -0700 * {{{COMPILE-FILE}}} should not signal an error when given a list for {{{:EXTERNAL-FORMAT}}}. Lists are needed to specify a composing external format like {{{:DOS}}} or {{{:MAC}}}. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 6dcd544..5229915 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1153,7 +1153,7 @@ (:block-compile (member t nil :specified)) (:entry-points list) (:byte-compile (member t nil :maybe)) - (:external-format symbol) + (:external-format (or symbol list)) (:decoding-error (or null symbol function)) (:xref t)) (values (or pathname null) boolean boolean)) diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 9dbf560..8c71e7f 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -76,6 +76,9 @@ New in this release: * Fix typo in ISO8859-2 external format that caused it not to work correctly. This type potentially also caused failures for all other external formats that were based on ISO8859-2. + * COMPILE-FILE should not signal an error when given a list for + :EXTERNAL-FORMAT. Lists are needed to specify a composing + external format like :DOS or :MAC. * Trac Tickets: * #50: Print/read error with make-pathname. ----------------------------------------------------------------------- Summary of changes: src/compiler/fndb.lisp | 2 +- src/general-info/release-20d.txt | 3 +++ 2 files changed, 4 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0