From eaeb21e6aee2e337e8fc007f4e78f59bf1fd55cc Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 1 Aug 2020 07:39:34 +0000 Subject: [PATCH] * Add stub generator git-svn-id: trunk@45976 - --- .gitattributes | 5 + utils/pas2js/libstub.lpi | 67 ++++++ utils/pas2js/libstub.pp | 174 +++++++++++++++ utils/pas2js/makestub.lpi | 70 +++++++ utils/pas2js/makestub.pp | 121 +++++++++++ utils/pas2js/stubcreator.pp | 408 ++++++++++++++++++++++++++++++++++++ 6 files changed, 845 insertions(+) create mode 100644 utils/pas2js/libstub.lpi create mode 100644 utils/pas2js/libstub.pp create mode 100644 utils/pas2js/makestub.lpi create mode 100644 utils/pas2js/makestub.pp create mode 100644 utils/pas2js/stubcreator.pp diff --git a/.gitattributes b/.gitattributes index f27743249d..4f57d57946 100644 --- a/.gitattributes +++ b/.gitattributes @@ -19361,6 +19361,10 @@ utils/pas2js/docs/translation.html svneol=native#text/html utils/pas2js/fpmake.lpi svneol=native#text/plain utils/pas2js/fpmake.pp svneol=native#text/plain utils/pas2js/httpcompiler.pp svneol=native#text/plain +utils/pas2js/libstub.lpi svneol=native#text/plain +utils/pas2js/libstub.pp svneol=native#text/plain +utils/pas2js/makestub.lpi svneol=native#text/plain +utils/pas2js/makestub.pp svneol=native#text/plain utils/pas2js/nodepas2js.lpi svneol=native#text/plain utils/pas2js/nodepas2js.pp svneol=native#text/plain utils/pas2js/pas2js.cfg svneol=native#text/plain @@ -19376,6 +19380,7 @@ utils/pas2js/samples/hello.pas svneol=native#text/plain utils/pas2js/samples/ifdemo.pp svneol=native#text/plain utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain utils/pas2js/samples/whiledemo.pp svneol=native#text/plain +utils/pas2js/stubcreator.pp svneol=native#text/plain utils/pas2js/webfilecache.pp svneol=native#text/plain utils/pas2js/webidl2pas.lpi svneol=native#text/plain utils/pas2js/webidl2pas.pp svneol=native#text/plain diff --git a/utils/pas2js/libstub.lpi b/utils/pas2js/libstub.lpi new file mode 100644 index 0000000000..32135500ec --- /dev/null +++ b/utils/pas2js/libstub.lpi @@ -0,0 +1,67 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="libstub.pp"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="stubcreator.pp"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="libstub"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <RelocatableUnit Value="True"/> + </CodeGeneration> + <Linking> + <Options> + <ExecutableType Value="Library"/> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp new file mode 100644 index 0000000000..ae87c46c02 --- /dev/null +++ b/utils/pas2js/libstub.pp @@ -0,0 +1,174 @@ +{ + libstub - pas2js stub generator, library version + Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +library stub; + +{$mode objfpc}{$H+} + +uses + SysUtils, Classes, stubcreator; + +Type + PStubCreator = Pointer; + +Function GetStubCreator : PStubCreator; stdcall; + +begin + Result:=TStubCreator.Create(Nil); +end; + +Procedure FreeStubCreator(P : PStubCreator); stdcall; + +begin + TStubCreator(P).Free; +end; + +Function MaybeStr(P : PAnsiChar) : String; + +begin + If Assigned(P) then + Result:=P + else + Result:=''; +end; + +Procedure SetStubCreatorInputFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + InputFileName:=AFileName; +end; + + +Procedure SetStubCreatorConfigFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + ConfigFileName:=MaybeStr(AFileName); +end; + + +Procedure SetStubCreatorOutputFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + OutputFileName:=MaybeStr(AFileName); +end; + +Procedure SetStubCreatorHeaderFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + HeaderFileName:=MaybeStr(AFileName); +end; + +Procedure AddStubCreatorDefine(P : PStubCreator; ADefine : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + TStubCreator(P).Defines.Add(MaybeStr(ADefine)); +end; + +Procedure AddStubCreatorForwardClass(P : PStubCreator; AForwardClass : PAnsiChar); stdcall; + +Var + S : String; + +begin + if Assigned(P) then + With TStubCreator(P) do + begin + S:=MaybeStr(AForwardClass); + if (S<>'') then + begin + if TStubCreator(P).ForwardClasses<>'' then + S:=','+S; + TStubCreator(P).ForwardClasses:=TStubCreator(P).ForwardClasses+S; + end; + end; +end; + +Procedure SetStubCreatorHeaderContent(P : PStubCreator; AContent : PAnsiChar); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + HeaderStream:=TStringStream.Create(MaybeStr(AContent)); +end; + +Procedure SetStubCreatorOuputCallBack(P : PStubCreator; AData : Pointer; ACallBack : TWriteCallBack); stdcall; + +begin + if Assigned(P) then + With TStubCreator(P) do + begin + CallbackData:=AData; + OnWriteCallBack:=ACallBack; + end; +end; + +Function ExecuteStubCreator(P : PStubCreator) : Boolean; stdcall; + +begin + Result:=False; + try + TStubCreator(P).Execute; + Result:=True; + except + On E: Exception do + Writeln('Exception ',E.ClassName,' ',E.Message); + // Ignore + end; +end; + +Procedure GetStubCreatorLastError(P : PStubCreator; AError : PAnsiChar; + Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); stdcall; + +Var + L : Integer; + E,C : String; + +begin + TStubCreator(P).GetLastError(E,C); + L:=Length(E); + if (L>AErrorLength) then + L:=AErrorLength; + if (L>0) then + Move(E[1],AError^,L); + L:=Length(C); + if L>AErrorClassLength then + L:=AErrorClassLength; + if (L>0) then + Move(C[1],AErrorClass^,L); +end; + +exports + // Stub creator + GetStubCreator, + FreeStubCreator, + SetStubCreatorInputFileName, + SetStubCreatorOutputFileName, + SetStubCreatorHeaderFileName, + SetStubCreatorConfigFileName, + SetStubCreatorHeaderContent, + SetStubCreatorOuputCallBack, + GetStubCreatorLastError, + AddStubCreatorDefine, + AddStubCreatorForwardClass, + ExecuteStubCreator; + +end. + diff --git a/utils/pas2js/makestub.lpi b/utils/pas2js/makestub.lpi new file mode 100644 index 0000000000..6d5db4e64b --- /dev/null +++ b/utils/pas2js/makestub.lpi @@ -0,0 +1,70 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="12"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <CompatibilityMode Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <Title Value="Javascript Import file Stub Creator"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="1"> + <Mode0 Name="default"> + <local> + <CommandLineParams Value="--input="$HOME/source/pas2js/src/rtl/web.pas -S2h" --no-externalclass --no-implementation --no-externalvar --no-externalfunction -x jstypes -o web.pp"/> + </local> + </Mode0> + </Modes> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="makestub.pp"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="stubcreator.pp"/> + <IsPartOfProject Value="True"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="makestub"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../src"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/utils/pas2js/makestub.pp b/utils/pas2js/makestub.pp new file mode 100644 index 0000000000..d917c9ee24 --- /dev/null +++ b/utils/pas2js/makestub.pp @@ -0,0 +1,121 @@ +{ + makestub - pas2js stub generator + Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +program makestub; + +{$mode objfpc} +{$H+} + +uses SysUtils, Classes, custapp, stubcreator; + +Type + { TStubCreatorApplication } + + TStubCreatorApplication = Class(TCustomApplication) + Private + FCreator : TStubCreator; + procedure PrintUsage(S: String); + Protected + function ParseOptions : Boolean; + Procedure DoRun; override; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + end; + +{ TStubCreatorApplication } + +procedure TStubCreatorApplication.PrintUsage(S : String); + +begin + if S<>'' then + Writeln('Error : ',S); + writeln('usage: stubcreator options'); + writeln; + writeln('Where options is one or more of'); + Writeln('-h --help This text'); + writeln('-i --input=file Is the file to be read by the parser'); + writeln('-I --include=dir Add dir to include path'); + writeln('-o --output=file Output file name. If not specified, standard output is assumed '); + Writeln('-c --config=filename Read ini file with configuration'); + Writeln('-H --header=filename Add file header using contents of file "filename"'); + Writeln('-f --forwardclasses[=list]'); + Writeln(' Generate forward definitions for list of classes. If empty, for all classes.'); + ExitCode:=Ord(S<>''); +end; + +function TStubCreatorApplication.ParseOptions : Boolean; + +Var + S : String; + +begin + Result:=False; + S:=CheckOptions('d:i:o:c:h:f:H:I:',['help','input:','output:','forwardclasses::', + 'config:','linenumberwidth:','define:','header:', + 'include:']); + if (S<>'') or HasOption('h','help') then + begin + PrintUsage(S); + Exit; + end; + FCreator.InputFileName:=GetOptionValue('i','input'); + FCreator.OutputFileName:=GetOptionValue('o','output'); + FCreator.HeaderFileName:=GetOptionValue('H','header'); + If HasOption('d','define') then + for S in GetOptionValues('d','define') do + FCreator.Defines.Add(S); + If HasOption('I','include') then + for S in GetOptionValues('i','include') do + FCreator.IncludePaths.Add(S); + if Hasoption('f','forwardclasses') then + FCreator.ForwardClasses:=GetOptionValue('f','forwardclasses'); + if (FCreator.HeaderFileName<>'') and Not FileExists(FCreator.HeaderFileName) then + begin + PrintUsage(Format('Header file "%s"does not exist',[FCreator.HeaderFileName])); + Exit; + end; + Result:=True; +end; + +{ TStubCreatorApplication } + +procedure TStubCreatorApplication.DoRun; + +begin + Terminate; + If not ParseOptions then + exit; + FCreator.Execute; +end; + +constructor TStubCreatorApplication.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCreator:=TStubCreator.Create(Self); + StopOnException:=True; +end; + +destructor TStubCreatorApplication.Destroy; +begin + FreeAndNil(FCreator); + inherited Destroy; +end; + +Var + Application : TStubCreatorApplication; + +begin + Application:=TStubCreatorApplication.Create(Nil); + Application.Initialize; + Application.Run; + Application.Free; +end. diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp new file mode 100644 index 0000000000..68cfd22c83 --- /dev/null +++ b/utils/pas2js/stubcreator.pp @@ -0,0 +1,408 @@ +{ + Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org + + pas2js Delphi stub generator - component + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +unit stubcreator; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, strutils, inifiles, pscanner, pparser, pastree, iostream, paswrite; + +Const + DTypesUnit = 'jsdelphisystem'; + +type + { We have to override abstract TPasTreeContainer methods } + + TSimpleEngine = class(TPasTreeContainer) + public + function CreateElement(AClass: TPTreeElement; const AName: String; + AParent: TPasElement; AVisibility: TPasMemberVisibility; + const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; + override; + function FindElement(const AName: String): TPasElement; override; + end; + + TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall; + TWriteEvent = Procedure(AFileData : String) of object; + + { TStubCreator } + + TStubCreator = Class(TComponent) + private + FConfigFile: String; + FHeaderStream: TStream; + FIncludePaths: TStrings; + FInputFile: String; + FOnWrite: TWriteEvent; + FOnWriteCallBack: TWriteCallBack; + FOutputFile: String; + FDefines : TStrings; + FOptions: TPasWriterOptions; + FLineNumberWidth, + FIndentSize : Integer; + FExtraUnits : String; + FForwardClasses : String; + FHeaderFile : String; + FOutputStream: TStream; + FWriteStream : TStringStream; + FCallBackData : Pointer; + FLastErrorClass : String; + FLastError : String; + procedure SetDefines(AValue: TStrings); + procedure SetIncludePaths(AValue: TStrings); + procedure SetOnWrite(AValue: TWriteEvent); + procedure SetWriteCallback(AValue: TWriteCallBack); + Protected + procedure DoExecute;virtual; + Procedure DoWriteEvent; virtual; + procedure ReadConfig(const aFileName: String); virtual; + procedure ReadConfig(const aIni: TIniFile); virtual; + procedure WriteModule(M: TPasModule); virtual; + function GetModule: TPasModule; virtual; + Function MaybeGetFileStream(AStream : TStream; Const AFileName : String; aFileMode : Word) : TStream; virtual; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Procedure Execute; + Procedure GetLastError(Out AError,AErrorClass : String); + // Streams take precedence over filenames. They will be freed on destroy! + // OutputStream can be used combined with write callbacks. + Property OutputStream : TStream Read FOutputStream Write FOutputStream; + Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream; + Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback; + Property CallbackData : Pointer Read FCallBackData Write FCallBackData; + + Published + Property Defines : TStrings Read FDefines Write SetDefines; + Property ConfigFileName : String Read FConfigFile Write FConfigFile; + Property InputFileName : String Read FInputFile write FInputFile; + Property OutputFileName : String Read FOutputFile write FOutputFile; + Property HeaderFileName : String Read FHeaderFile write FHeaderFile; + Property ForwardClasses : String Read FForwardClasses write FForwardClasses; + Property IncludePaths : TStrings Read FIncludePaths Write SetIncludePaths; + Property OnWrite : TWriteEvent Read FOnWrite Write SetOnWrite; + end; + +Implementation + +ResourceString + SErrNoDestGiven = 'No destination file specified.'; + SErrNoSourceParsed = 'Parsing produced no file.'; + +procedure TStubCreator.SetDefines(AValue: TStrings); +begin + if FDefines=AValue then Exit; + FDefines.Assign(AValue); +end; + +procedure TStubCreator.SetIncludePaths(AValue: TStrings); +begin + if FIncludePaths=AValue then Exit; + FIncludePaths.Assign(AValue); +end; + +procedure TStubCreator.SetOnWrite(AValue: TWriteEvent); +begin + if FOnWrite=AValue then Exit; + FOnWrite:=AValue; + FreeAndNil(FWriteStream); + if Assigned(AValue) then + FWriteStream:=TStringStream.Create(''); +end; + +procedure TStubCreator.SetWriteCallback(AValue: TWriteCallBack); +begin + if FOnWriteCallBack=AValue then Exit; + FOnWriteCallBack:=AValue; + FreeAndNil(FWriteStream); + if Assigned(AValue) then + FWriteStream:=TStringStream.Create(''); +end; + +procedure TStubCreator.DoWriteEvent; + +Var + S : String; + +begin + If Assigned(FOnWrite) then + FOnWrite(FWriteStream.DataString); + if Assigned(FOnWriteCallBack) then + begin + S:=FWriteStream.DataString; + FOnWriteCallBack(FCallBackData,PChar(S),Length(S)); + end; +end; + +{ TStubCreator } + +procedure TStubCreator.ReadConfig(const aFileName: String); + +Var + ini : TMemIniFile; + +begin + ini:=TMemIniFile.Create(AFileName); + try + ReadConfig(Ini); + finally + Ini.Free; + end; +end; + +procedure TStubCreator.ReadConfig(const aIni: TIniFile); + +Const + DelChars = [',',' ']; + +Var + O : TPaswriterOptions; + S : String; + I : Integer; + + +begin + O:=[]; + With aIni do + begin + if ReadBool('Config','addlinenumber',False) then + Include(O,woAddLineNumber); + if ReadBool('Config','addsourcelinenumber',False) then + Include(O,woAddLineNumber); + FOptions:=FOptions+O; + InputFilename:=ReadString('config','input',InputFilename); + OutputFilename:=ReadString('config','output',OutputFilename); + HeaderFilename:=ReadString('config','header',HeaderFilename); + FIndentSize:=ReadInteger('config','indentsize',FIndentSize); + FLineNumberWidth:=ReadInteger('config','linenumberwidth',FLineNumberWidth); + FExtraUnits:=ReadString('config','extra',FExtraUnits); + FForwardClasses:=ReadString('config','forwardclasses',FForwardClasses); + S:=ReadString('config','defines',''); + if (S<>'') then + For I:=1 to WordCount(S,DelChars) do + FDefines.Add(UpperCase(ExtractWord(I,S,DelChars))); + S:=ReadString('config','includepaths',''); + if (S<>'') then + For I:=1 to WordCount(S,[',',';']) do + FIncludePaths.Add(ExtractWord(I,S,[',',';'])); + end; + if (FForwardClasses<>'') or (FForwardClasses='all') then + Include(O,woForwardClasses); +end; + +procedure TStubCreator.Execute; + +begin + FLastErrorClass:=''; + FLastError:=''; + Try + DoExecute; + except + On E : Exception do + begin + FLastErrorClass:=E.Classname; + FLastError:=E.Message; + Raise; + end; + end; +end; + +procedure TStubCreator.GetLastError(out AError, AErrorClass: String); +begin + AError:=FLastError; + AErrorClass:=FLastErrorClass; +end; + +procedure TStubCreator.DoExecute; + +Var + M : TPasModule; + +begin + If (ConfigFileName<>'') then + ReadConfig(ConfigFileName); + if InputFilename = '' then + raise Exception.Create(SErrNoSourceGiven); + if (OutputFilename = '') and (FoutputStream=Nil) and (FWriteStream=Nil) then + raise Exception.Create(SErrNoDestGiven); + if CompareText(ForwardClasses,'all')=0 then + begin + Include(Foptions,woForwardClasses); + ForwardClasses:=''; + end + else if (ForwardClasses<>'') then + Include(Foptions,woForwardClasses); + Include(Foptions,woForceOverload); + M:=GetModule; + if M=Nil then + raise Exception.Create(SErrNoSourceParsed); + try + WriteModule(M); + finally + M.Free; + end; +end; + +{ TSimpleEngine } + +function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String; + AParent: TPasElement; AVisibility: TPasMemberVisibility; + const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; +begin + Result := AClass.Create(AName, AParent); + Result.Visibility := AVisibility; + Result.SourceFilename := ASourceFilename; + Result.SourceLinenumber := ASourceLinenumber; +end; + +function TSimpleEngine.FindElement(const AName: String): TPasElement; +begin + { dummy implementation, see TFPDocEngine.FindElement for a real example } + Result := nil; + if AName<>'' then ; // Keep compiler happy +end; + + + +Function TStubCreator.GetModule : TPasModule; + +Var + SE : TSimpleEngine; + FileResolver: TFileResolver; + Parser: TPasParser; + Scanner: TPascalScanner; + +var + s: String; + +begin + Result := nil; + FileResolver := nil; + Scanner := nil; + Parser := nil; + SE:=TSimpleEngine.Create; + try + // File resolver + FileResolver := TFileResolver.Create; + FileResolver.UseStreams:=True; + FileResolver.AddIncludePath(ExtractFilePath(InputFileName)); + For S in FIncludePaths do + FileResolver.AddIncludePath(S); + // Scanner + Scanner := TPascalScanner.Create(FileResolver); + Scanner.Options:=[po_AsmWhole,po_KeepClassForward]; + SCanner.LogEvents:=SE.ScannerLogEvents; + SCanner.OnLog:=SE.Onlog; + For S in FDefines do + Scanner.AddDefine(S); + Scanner.OpenFile(InputFilename); + // Parser + Parser:=TPasParser.Create(Scanner, FileResolver, SE); + Parser.LogEvents:=SE.ParserLogEvents; + Parser.OnLog:=SE.Onlog; + Parser.Options:=Parser.Options+[po_AsmWhole,po_delphi,po_KeepClassForward]; + Parser.ParseMain(Result); + finally + Parser.Free; + Scanner.Free; + FileResolver.Free; + SE.Free; + end; +end; + +function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream; +begin + If Assigned(AStream) then + Result:=AStream + else if (AFileName<>'') then + Result:=TFileStream.Create(AFileName,aFileMode) + else + Result:=Nil; +end; + +constructor TStubCreator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDefines:=TStringList.Create; + FIncludePaths:=TStringList.Create; + FLineNumberWidth:=4; + FIndentSize:=2; + FExtraUnits:=''; + FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc]; +end; + +destructor TStubCreator.Destroy; +begin + FreeAndNil(FWriteStream); + FreeAndNil(FOutputStream); + FreeAndNil(FHeaderStream); + FreeAndNil(FIncludePaths); + FreeAndNil(FDefines); + inherited Destroy; +end; + + +procedure TStubCreator.WriteModule(M : TPAsModule); + +Var + F,H : TStream; + W : TPasWriter; + U : String; + +begin + W:=Nil; + F:=MaybeGetFileStream(OutputStream,FOutputFile,fmCreate); + if (F=Nil) then + if FWriteStream<>nil then + F:=FWriteStream + else + F:=TIOStream.Create(iosOutPut); + try + H:=MaybeGetFileStream(HeaderStream,FHeaderFile,fmOpenRead or fmShareDenyWrite); + if Assigned(h) then + try + F.CopyFrom(H,H.Size); + finally + if H<>HeaderStream then + H.Free; + end; + W:=TPasWriter.Create(F); + W.Options:=FOptions; + U:=FExtraUnits; + if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then + begin + if (U<>'') then + U:=','+U; + U:=DTypesUnit+U; + end; + W.ExtraUnits:=U; + if FIndentSize<>-1 then + W.IndentSize:=FIndentSize; + if FLineNumberWidth>0 then + W.LineNumberWidth:=FLineNumberWidth; + + W.ForwardClasses.CommaText:=FForwardClasses; + W.WriteModule(M); + if Assigned(FWriteStream) then + DoWriteEvent; + finally + W.Free; + if (F<>OutputStream) and (F<>FWriteStream) then + F.Free; + end; +end; + +end. +