- Timestamp:
- Jul 17, 2012, 6:44:54 AM (12 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Compiler/UCompiler.pas
r51 r59 16 16 end; 17 17 18 { TSourceFileManager } 19 20 TSourceFileManager = class 21 Files: TListString; 22 function LoadStringFromFile(FileName: string): string; 23 procedure SaveStringToFile(FileName: string; Content: string); 24 public 25 function GetFileContent(Name: string; var Content: string): Boolean; 26 function SetFileContent(Name: string; const Content: string): Boolean; 27 constructor Create; 28 destructor Destroy; override; 29 end; 30 18 31 { TCompilerList } 19 32 … … 21 34 private 22 35 FAnalyzer: TAnalyzer; 36 FOnLoadSource: TGetSourceEvent; 37 FOnSaveTarget: TWriteTargetEvent; 23 38 FTarget: TTarget; 24 39 FOnErrorMessage: TErrorMessageEvent; 25 function GetSource(Name: string; var SourceCode: string): Boolean;26 function WriteTarget(Name: string; TargetCode: string): Boolean;27 40 procedure ErrorMessage(Text: string; Position: TPoint; FileName: string); 28 41 procedure SetAnalyzer(const AValue: TAnalyzer); … … 38 51 Targets: TListTarget; 39 52 MainSource: string; 40 SourceFiles: TListString; 41 TargetFiles: TListString; 42 constructor Create; 53 constructor Create; virtual; 43 54 destructor Destroy; override; 44 55 procedure Init; … … 48 59 property Analyzer: TAnalyzer read FAnalyzer write SetAnalyzer; 49 60 property Target: TTarget read FTarget write SetTarget; 61 property OnLoadSource: TGetSourceEvent read FOnLoadSource write FOnLoadSource; 62 property OnSaveTarget: TWriteTargetEvent read FOnSaveTarget write FOnSaveTarget; 50 63 end; 51 64 … … 60 73 SRewritingExistedTarget = 'Reqriting existing target file %s'; 61 74 75 { TSourceFileManager } 76 77 function TSourceFileManager.LoadStringFromFile(FileName: string): string; 78 var 79 F: TFileStream; 80 begin 81 try 82 F := TFileStream.Create(UTF8Decode(FileName), fmOpenRead); 83 SetLength(Result, F.Size); 84 if F.Size > 0 then 85 F.Read(Result[1], F.Size); 86 finally 87 F.Free; 88 end; 89 end; 90 91 procedure TSourceFileManager.SaveStringToFile(FileName: string; Content: string); 92 var 93 F: TFileStream; 94 begin 95 try 96 ForceDirectoriesUTF8(ExtractFileDir(FileName)); 97 if FileExistsUTF8(FileName) then 98 F := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite) 99 else F := TFileStream.Create(UTF8Decode(FileName), fmCreate); 100 F.Size := 0; 101 if Length(Content) > 0 then 102 F.Write(Content[1], Length(Content)); 103 finally 104 F.Free; 105 end; 106 end; 107 108 function TSourceFileManager.GetFileContent(Name: string; var Content: string): Boolean; 109 var 110 I: Integer; 111 begin 112 I := 0; 113 while (I < Files.Count) and (ExtractFileNameOnly(Files[I]) <> Name) do Inc(I); 114 if I < Files.Count then begin 115 if FileExistsUTF8(Files[I]) then begin 116 Content := LoadStringFromFile(Files[I]); 117 Result := True; 118 end else Result := False; 119 end else Result := False; 120 end; 121 122 function TSourceFileManager.SetFileContent(Name: string; const Content: string 123 ): Boolean; 124 var 125 I: Integer; 126 F: TFileStream; 127 begin 128 I := 0; 129 while (I < Files.Count) and (ExtractFileNameOnly(Files[I]) <> Name) do Inc(I); 130 if I >= Files.Count then begin 131 SaveStringToFile(Name, Content); 132 Result := True; 133 Files.Add(Name); 134 end else begin 135 Result := False; 136 //ErrorMessage(Format(SRewritingExistedTarget, [Name]), Point(0, 0), ''); 137 end; 138 end; 139 140 constructor TSourceFileManager.Create; 141 begin 142 Files := TListString.Create; 143 end; 144 145 destructor TSourceFileManager.Destroy; 146 begin 147 Files.Free; 148 inherited Destroy; 149 end; 150 62 151 { TCompiler } 63 152 64 153 procedure TCompiler.Compile; 65 154 begin 155 Analyzer.OnGetSource := OnLoadSource; 66 156 AnalyzeAll; 157 if Assigned(Target.Producer) then 158 Target.Producer.OnWriteTarget := OnSaveTarget; 67 159 ProduceAll; 68 160 end; … … 72 164 Analyzer := TAnalyzerPascal.Create; 73 165 Targets := TListTarget.Create; 74 SourceFiles := TListString.Create;75 TargetFiles := TListString.Create;76 166 77 167 RegisterTargets(Self); … … 94 184 Targets.Free; 95 185 ErrorMessages.Free; 96 SourceFiles.Free;97 TargetFiles.Free;98 end;99 100 function TCompiler.GetSource(Name: string; var SourceCode: string): Boolean;101 var102 I: Integer;103 F: TFileStream;104 begin105 I := 0;106 while (I < SourceFiles.Count) and (ExtractFileNameOnly(SourceFiles[I]) <> Name) do Inc(I);107 if I < SourceFiles.Count then begin108 if FileExistsUTF8(SourceFiles[I]) then109 try110 F := TFileStream.Create(UTF8Decode(SourceFiles[I]), fmOpenRead);111 SetLength(SourceCode, F.Size);112 if F.Size > 0 then113 F.Read(SourceCode[1], F.Size);114 Result := True;115 finally116 F.Free;117 end else Result := False;118 end else Result := False;119 end;120 121 function TCompiler.WriteTarget(Name: string; TargetCode: string): Boolean;122 var123 I: Integer;124 F: TFileStream;125 begin126 I := 0;127 while (I < TargetFiles.Count) and (ExtractFileNameOnly(TargetFiles[I]) <> Name) do Inc(I);128 if I >= TargetFiles.Count then begin129 try130 ForceDirectoriesUTF8(ExtractFileDir(Name));131 if FileExistsUTF8(Name) then132 F := TFileStream.Create(UTF8Decode(Name), fmOpenWrite)133 else F := TFileStream.Create(UTF8Decode(Name), fmCreate);134 F.Size := 0;135 if Length(TargetCode) > 0 then136 F.Write(TargetCode[1], Length(TargetCode));137 Result := True;138 TargetFiles.Add(Name);139 finally140 F.Free;141 end;142 end else begin143 Result := False;144 ErrorMessage(Format(SRewritingExistedTarget, [Name]), Point(0, 0), '');145 end;146 186 end; 147 187 … … 164 204 if Assigned(Analyzer) then begin 165 205 Analyzer.OnErrorMessage := ErrorMessage; 166 Analyzer.OnGetSource := GetSource;206 Analyzer.OnGetSource := OnLoadSource; 167 207 end; 168 208 end; … … 170 210 procedure TCompiler.AnalyzeAll; 171 211 begin 172 if (SourceFiles.Count > 0)then begin212 if MainSource <> '' then begin 173 213 Analyzer.FileName := MainSource; 174 214 Analyzer.OnGetSource(ExtractFileNameOnly(Analyzer.FileName), Analyzer.SourceCode); … … 208 248 FTarget.Compiler := Self; 209 249 if Assigned(FTarget.Producer) then 210 FTarget.Producer.OnWriteTarget := WriteTarget;250 FTarget.Producer.OnWriteTarget := OnSaveTarget; 211 251 end; 212 252 -
trunk/Compiler/UProducer.pas
r49 r59 10 10 type 11 11 12 TWriteTargetEvent = function (Name: string; Code: string): Boolean of object;12 TWriteTargetEvent = function (Name: string; const Code: string): Boolean of object; 13 13 14 14 { TProducer } -
trunk/IDE/Forms/UFormMain.pas
r55 r59 168 168 begin 169 169 FormSourceCode.Save; 170 AProjectSave.Execute; 170 171 with Core do begin 171 172 // Compile project file … … 178 179 if Project.Files.Count > 0 then 179 180 with TProjectFile(Project.Files[0]) do begin 180 Compiler.SourceFiles. Clear;181 Project.Files.DumpFileList(Compiler.SourceFiles );181 Compiler.SourceFiles.Files.Clear; 182 Project.Files.DumpFileList(Compiler.SourceFiles.Files); 182 183 Compiler.MainSource := Project.MainSource.AbsoluteFileName; 183 184 TargetProject.FileName := ExtractFileDir(Project.FileName) + DirectorySeparator + … … 186 187 Compiler.TargetFolder := ExtractFileDir(TargetProject.FileName); 187 188 Compiler.Compile; 188 TargetProject.Files.LoadFromList(Compiler.TargetFiles );189 TargetProject.Files.LoadFromList(Compiler.TargetFiles.Files); 189 190 FormTargetProject.UpdateInterface; 190 191 end; -
trunk/IDE/UCore.pas
r57 r59 13 13 14 14 TCustomCompiler = class(TCompiler) 15 SourceFiles: TSourceFileManager; 16 TargetFiles: TSourceFileManager; 15 17 procedure LoadFromRegistry(Root: HKEY; Key: string); 16 18 procedure SaveToRegistry(Root: HKEY; Key: string); 19 constructor Create; override; 20 destructor Destroy; override; 17 21 end; 18 22 … … 29 33 private 30 34 procedure ProjectChange(Sender: TObject); 35 function LoadSourceFile(FileName: string; var Content: string): Boolean; 36 function SaveSourceFile(FileName: string; const Content: string): Boolean; 31 37 public 32 38 ReopenLastOpenedFile: Boolean; … … 81 87 DeleteFile(DebugLog1.FileName); 82 88 Compiler := TCustomCompiler.Create; 89 //Compiler.OnLoadSource := LoadSourceFile; 90 //Compiler.OnSaveTarget := SaveSourceFile; 83 91 Project := TProject.Create; 84 92 ProjectTemplates := TProjectTemplateList.Create; … … 116 124 begin 117 125 FormMain.UpdateInterface; 126 end; 127 128 function TCore.LoadSourceFile(FileName: string; var Content: string): Boolean; 129 begin 130 131 end; 132 133 function TCore.SaveSourceFile(FileName: string; const Content: string): Boolean; 134 begin 135 118 136 end; 119 137 … … 205 223 end; 206 224 225 constructor TCustomCompiler.Create; 226 begin 227 inherited Create; 228 SourceFiles := TSourceFileManager.Create; 229 TargetFiles := TSourceFileManager.Create; 230 OnLoadSource := SourceFiles.GetFileContent; 231 OnSaveTarget := TargetFiles.SetFileContent; 232 end; 233 234 destructor TCustomCompiler.Destroy; 235 begin 236 TargetFiles.Free; 237 SourceFiles.Free; 238 inherited Destroy; 239 end; 240 207 241 208 242 end.
Note:
See TracChangeset
for help on using the changeset viewer.