I agree with all that you've written. As for the last point, transformation of the external format may happen in #'(setf component-external-format); and here is a slightly updated patch, this time as a proper attachment.
>From 9f431927d50269565d3fae2dc01fb662fa8c7156 Mon Sep 17 00:00:00 2001 From: Orivej Desh <[email protected]> Date: Wed, 21 Mar 2012 03:10:59 +0400 Subject: [PATCH] Add support for external format in compile-op and load-source-op. External format is specified via keyword :external-format per system or per its component, the latter taking precedence. The value is passed then as :external-format to #'load and #'compile-file. When unspecified, external-format defaults to UTF-8. --- asdf.lisp | 42 ++++++++++++++++++++++++++++++++++++------ 1 files changed, 36 insertions(+), 6 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index a69fe3c..3be86a7 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -263,6 +263,8 @@ #:component-parent #:component-property #:component-system + #:*utf-8-external-format* + #:component-external-format #:component-depends-on @@ -948,6 +950,10 @@ (defgeneric* component-property (component property)) (defgeneric* (setf component-property) (new-value component property)) +(defgeneric* component-external-format (component)) + +(defgeneric* (setf component-external-format) (new-value component)) + (eval-when (#-gcl :compile-toplevel :load-toplevel :execute) (defgeneric* (setf module-components-by-name) (new-value module))) @@ -1278,6 +1284,20 @@ (defmethod (setf component-property) (new-value (c component) property) (acons property new-value (slot-value c 'properties))))) new-value) +(defparameter *utf-8-external-format* + #+sbcl :utf-8 + #-sbcl :default + "External-format argument to pass for CL:OPEN to accept UTF-8 +encoded source code.") + +(defmethod component-external-format ((c component)) + (or (component-property c 'external-format) + (component-property (component-system c) 'external-format) + *utf-8-external-format*)) + +(defmethod (setf component-external-format) (new-value (c component)) + (setf (component-property c 'external-format) new-value)) + (defclass proto-system () ; slots to keep when resetting a system ;; To preserve identity for all objects, we'd need keep the components slots ;; but also to modify parse-component-form to reset the recycled objects. @@ -2344,6 +2364,7 @@ (defvar *compile-op-compile-file-function* 'compile-file* (defmethod perform ((operation compile-op) (c cl-source-file)) #-:broken-fasl-loader (let ((source-file (component-pathname c)) + (external-format (component-external-format c)) ;; on some implementations, there are more than one output-file, ;; but the first one should always be the primary fasl that gets loaded. (output-file (first (output-files operation c))) @@ -2353,7 +2374,9 @@ (defmethod perform ((operation compile-op) (c cl-source-file)) (call-with-around-compile-hook c #'(lambda () (apply *compile-op-compile-file-function* source-file - :output-file output-file (compile-op-flags operation)))) + :output-file output-file + :external-format external-format + (compile-op-flags operation)))) (unless output (error 'compile-error :component c :operation operation)) (when failure-p @@ -2457,9 +2480,11 @@ (defclass load-source-op (basic-load-op) ()) (defmethod perform ((o load-source-op) (c cl-source-file)) (declare (ignorable o)) - (let ((source (component-pathname c))) + (let ((source (component-pathname c)) + (external-format (component-external-format c))) (setf (component-property c 'last-loaded-as-source) - (and (call-with-around-compile-hook c #'(lambda () (load source))) + (and (call-with-around-compile-hook + c #'(lambda () (load source :external-format external-format))) (get-universal-time))))) (defmethod perform ((operation load-source-op) (c static-file)) @@ -2763,8 +2788,9 @@ (defun* parse-component-form (parent options) ;; remove-keys form. important to keep them in sync components pathname default-component-class perform explain output-files operation-done-p - weakly-depends-on - depends-on serial in-order-to do-first + weakly-depends-on depends-on serial in-order-to + external-format + do-first (version nil versionp) ;; list ends &allow-other-keys) options @@ -2790,7 +2816,8 @@ (defun* parse-component-form (parent options) (remove-keys '(components pathname default-component-class perform explain output-files operation-done-p - weakly-depends-on depends-on serial in-order-to) + weakly-depends-on depends-on serial in-order-to + external-format) rest))) (ret (find-component parent name))) (when weakly-depends-on @@ -2828,6 +2855,9 @@ (defun* parse-component-form (parent options) do-first `((compile-op (load-op ,@depends-on))))) + (when external-format + (setf (component-external-format ret) external-format)) + (%refresh-component-inline-methods ret rest) ret))) -- 1.7.9.1
_______________________________________________ asdf-devel mailing list [email protected] http://lists.common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
