mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 10:07:54 +02:00
* Add stub generator
git-svn-id: trunk@45976 -
This commit is contained in:
michael
parent
6f661e44d0
commit
eaeb21e6ae
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -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
|
||||
|
||||
67
utils/pas2js/libstub.lpi
Normal file
67
utils/pas2js/libstub.lpi
Normal file
@ -0,0 +1,67 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="libstub"/>
|
||||
<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>
|
||||
174
utils/pas2js/libstub.pp
Normal file
174
utils/pas2js/libstub.pp
Normal file
@ -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.
|
||||
|
||||
70
utils/pas2js/makestub.lpi
Normal file
70
utils/pas2js/makestub.lpi
Normal file
@ -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>
|
||||
121
utils/pas2js/makestub.pp
Normal file
121
utils/pas2js/makestub.pp
Normal file
@ -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.
|
||||
408
utils/pas2js/stubcreator.pp
Normal file
408
utils/pas2js/stubcreator.pp
Normal file
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user