Changeset 49 for trunk/Compiler/UCompiler.pas

Timestamp:

Mar 4, 2012, 5:26:20 PM (13 years ago)

Author:

chronos

Message:

• Added: Compiled target code now can be browsed using Target project navigation.

File:

• trunk/Compiler/UCompiler.pas (modified) (6 diffs)

trunk/Compiler/UCompiler.pas

@@ -21 +21 @@
   private
     FAnalyzer: TAnalyzer;
+    FTarget: TTarget;
     FOnErrorMessage: TErrorMessageEvent;
     function GetSource(Name: string; var SourceCode: string): Boolean;
+    function WriteTarget(Name: string; TargetCode: string): Boolean;
     procedure ErrorMessage(Text: string; Position: TPoint; FileName: string);
     procedure SetAnalyzer(const AValue: TAnalyzer);
     procedure AnalyzeAll;
     procedure ProduceAll;
+    procedure SetTarget(AValue: TTarget);
   public
     AbstractCode: TProgram;
     ErrorMessages: TListObject;
     CompiledFolder: string;
-    Target: TTarget;
+
     TargetFolder: string;
     Targets: TListTarget;
@@ -43 +46 @@
       write FOnErrorMessage;
     property Analyzer: TAnalyzer read FAnalyzer write SetAnalyzer;
+    property Target: TTarget read FTarget write SetTarget;
   end;
 
@@ -53 +57 @@
 resourcestring
   SNothingToAnalyze = 'Nothing to analyze';
+  SRewritingExistedTarget = 'Reqriting existing target file %s';
 
 { TCompiler }
@@ -113 +118 @@
 end;
 
+function TCompiler.WriteTarget(Name: string; TargetCode: string): Boolean;
+var
+  I: Integer;
+  F: TFileStream;
+begin
+  I := 0;
+  while (I < TargetFiles.Count) and (ExtractFileNameOnly(TargetFiles[I]) <> Name) do Inc(I);
+  if I >= TargetFiles.Count then begin
+    try
+      ForceDirectoriesUTF8(ExtractFileDir(Name));
+      if FileExistsUTF8(Name) then
+        F := TFileStream.Create(UTF8Decode(Name), fmOpenWrite)
+        else F := TFileStream.Create(UTF8Decode(Name), fmCreate);
+      F.Size := 0;
+      if Length(TargetCode) > 0 then
+        F.Write(TargetCode[1], Length(TargetCode));
+      Result := True;
+      TargetFiles.Add(Name);
+    finally
+      F.Free;
+    end;
+  end else begin
+    Result := False;
+    ErrorMessage(Format(SRewritingExistedTarget, [Name]), Point(0, 0), '');
+  end;
+end;
+
 procedure TCompiler.ErrorMessage(Text: string; Position: TPoint; FileName: string);
 var
@@ -160 +192 @@
       Target.Producer.Produce(TModule(Modules[I]));
       Target.Producer.AssignToStringList(ProducedCode);
-      TargetFileName := TargetFolder + DirectorySeparator +
-        CompiledFolder + DirectorySeparator + Target.Name +
-        DirectorySeparator + TModule(Modules[I]).TargetFile;
-      ForceDirectoriesUTF8(ExtractFileDir(TargetFileName));
-      ProducedCode.SaveToFile(TargetFileName);
+      TargetFileName := TargetFolder + DirectorySeparator + TModule(Modules[I]).TargetFile;
+      if Assigned(Target.Producer.OnWriteTarget) then
+        Target.Producer.OnWriteTarget(TargetFileName, ProducedCode.Text);
     end;
   finally
@@ -171 +201 @@
 end;
 
+procedure TCompiler.SetTarget(AValue: TTarget);
+begin
+  if FTarget = AValue then Exit;
+  FTarget := AValue;
+  FTarget.Producer.OnWriteTarget := WriteTarget;
+end;
+
 end.