>From ae64a637a88882ca0418658ea1ab064a34437c4d Mon Sep 17 00:00:00 2001
From: Orivej Desh <orivej@gmx.fr>
Date: Wed, 21 Mar 2012 03:10:59 +0400
Subject: [PATCH] Add support for source encoding in compile-op and
 load-source-op.

Source encoding is specified via keyword :encoding per system or per
its component, the latter taking precedence.  The value is passed then
as :external-format to #'load and #'compile-file.
---
 asdf.lisp |   30 ++++++++++++++++++++++++------
 1 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index a69fe3c..5cf5ce6 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -263,6 +263,7 @@
             #:component-parent
             #:component-property
             #:component-system
+            #:component-encoding
 
             #:component-depends-on
 
@@ -948,6 +949,8 @@ (defgeneric* component-property (component property))
 
 (defgeneric* (setf component-property) (new-value component property))
 
+(defgeneric* component-encoding (component))
+
 (eval-when (#-gcl :compile-toplevel :load-toplevel :execute)
   (defgeneric* (setf module-components-by-name) (new-value module)))
 
@@ -1278,6 +1281,11 @@ (defmethod (setf component-property) (new-value (c component) property)
               (acons property new-value (slot-value c 'properties)))))
   new-value)
 
+(defmethod component-encoding ((component component))
+  (or (component-property component 'encoding)
+      (component-property (component-system component) 'encoding)
+      :default))
+
 (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 +2352,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))
+        (encoding (component-encoding 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 +2362,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 encoding
+                      (compile-op-flags operation))))
       (unless output
         (error 'compile-error :component c :operation operation))
       (when failure-p
@@ -2457,9 +2468,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))
+        (encoding (component-encoding 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 encoding)))
                (get-universal-time)))))
 
 (defmethod perform ((operation load-source-op) (c static-file))
@@ -2763,8 +2776,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
+              encoding
+              do-first
               (version nil versionp)
               ;; list ends
               &allow-other-keys) options
@@ -2790,7 +2804,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
+                           encoding)
                          rest)))
            (ret (find-component parent name)))
       (when weakly-depends-on
@@ -2828,6 +2843,9 @@ (defun* parse-component-form (parent options)
              do-first
              `((compile-op (load-op ,@depends-on)))))
 
+      (when encoding
+        (setf (component-property ret 'encoding) encoding))
+
       (%refresh-component-inline-methods ret rest)
       ret)))
 
-- 
1.7.9.1

