mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 06:20:57 +02:00
* Recursive parsing
git-svn-id: trunk@20213 -
This commit is contained in:
parent
6a5cf6cf8d
commit
2b60a95896
@ -172,6 +172,7 @@ resourcestring
|
||||
SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
|
||||
SErrCouldNotCreateFile = 'Could not create file "%s": %s';
|
||||
SSeeURL = '(See %s)'; // For linear text writers.
|
||||
SParsingUsedUnit = 'Parsing used unit "%s" with commandLine "%s"';
|
||||
|
||||
Const
|
||||
SVisibility: array[TPasMemberVisibility] of string =
|
||||
@ -272,11 +273,13 @@ type
|
||||
// The main FPDoc engine
|
||||
TFPDocLogLevel = (dleWarnNoNode);
|
||||
TFPDocLogLevels = set of TFPDocLogLevel;
|
||||
TOnParseUnitEvent = Procedure (Sender : TObject; Const AUnitName : String; Out AInputFile,OSTarget,CPUTarget : String) of Object;
|
||||
|
||||
{ TFPDocEngine }
|
||||
TFPDocEngine = class(TPasTreeContainer)
|
||||
private
|
||||
FDocLogLevels: TFPDocLogLevels;
|
||||
FOnParseUnit: TOnParseUnitEvent;
|
||||
protected
|
||||
DescrDocs: TObjectList; // List of XML documents
|
||||
DescrDocNames: TStringList; // Names of the XML documents
|
||||
@ -285,6 +288,7 @@ type
|
||||
FPackages: TFPList; // List of TFPPackage objects
|
||||
CurModule: TPasModule;
|
||||
CurPackageDocNode: TDocNode;
|
||||
function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
|
||||
Function LogEvent(E : TFPDocLogLevel) : Boolean;
|
||||
Procedure DoLog(Const Msg : String);overload;
|
||||
Procedure DoLog(Const Fmt : String; Args : Array of const);overload;
|
||||
@ -328,6 +332,7 @@ type
|
||||
property RootLinkNode: TLinkNode read FRootLinkNode;
|
||||
property RootDocNode: TDocNode read FRootDocNode;
|
||||
Property DocLogLevels : TFPDocLogLevels Read FDocLogLevels Write FDocLogLevels;
|
||||
Property OnParseUnit : TOnParseUnitEvent Read FOnParseUnit Write FOnParseUnit;
|
||||
end;
|
||||
|
||||
|
||||
@ -1168,6 +1173,8 @@ function TFPDocEngine.FindModule(const AName: String): TPasModule;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
AInPutLine,OSTarget,CPUTarget : String;
|
||||
|
||||
begin
|
||||
Result := FindInPackage(Package);
|
||||
if not Assigned(Result) then
|
||||
@ -1179,6 +1186,29 @@ begin
|
||||
if Assigned(Result) then
|
||||
exit;
|
||||
end;
|
||||
if Not Assigned(Result) and Assigned(FOnParseUnit) then
|
||||
begin
|
||||
FOnParseUnit(Self,AName,AInputLine,OSTarget,CPUTarget);
|
||||
If (AInPutLine<>'') then
|
||||
Result:=ParseUsedUnit(AName,AInputLine,OSTarget,CPUTarget);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TFPDocEngine.ParseUsedUnit(AName,AInputLine,AOSTarget,ACPUTarget : String) : TPasModule;
|
||||
|
||||
Var
|
||||
M : TPasModule;
|
||||
|
||||
begin
|
||||
DoLog(SParsingUsedUnit,[AName,AInputLine]);
|
||||
M:=CurModule;
|
||||
CurModule:=Nil;
|
||||
try
|
||||
ParseSource(Self,AInputLine,AOSTarget,ACPUTarget,True);
|
||||
Result:=CurModule;
|
||||
finally
|
||||
CurModule:=M;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
|
||||
|
@ -54,7 +54,7 @@
|
||||
<Unit2>
|
||||
<Filename Value="dw_dxml.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="dw_dxml"/>
|
||||
<UnitName Value="dw_dXML"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="dw_html.pp"/>
|
||||
|
@ -96,8 +96,58 @@ Type
|
||||
Property Options : TEngineOptions Read FOptions Write setOptions;
|
||||
end;
|
||||
|
||||
Procedure SplitInputFileOption(Const AInputFile : String; Out AFile,AOption : String);
|
||||
|
||||
implementation
|
||||
|
||||
Procedure SplitInputFileOption(Const AInputFile : String; Out AFile,AOption : String);
|
||||
|
||||
Function GetNextWord(Var s : string) : String;
|
||||
|
||||
Const
|
||||
WhiteSpace = [' ',#9,#10,#13];
|
||||
|
||||
var
|
||||
i,j: integer;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
While (I<=Length(S)) and (S[i] in WhiteSpace) do
|
||||
Inc(I);
|
||||
J:=I;
|
||||
While (J<=Length(S)) and (not (S[J] in WhiteSpace)) do
|
||||
Inc(J);
|
||||
if (I<=Length(S)) then
|
||||
Result:=Copy(S,I,J-I);
|
||||
Delete(S,1,J);
|
||||
end;
|
||||
|
||||
Var
|
||||
S,W,F,O : String;
|
||||
|
||||
begin
|
||||
S:=AInputFile;
|
||||
O:='';
|
||||
F:='';
|
||||
While (S<>'') do
|
||||
begin
|
||||
W:=GetNextWord(S);
|
||||
If (W<>'') then
|
||||
begin
|
||||
if W[1]='-' then
|
||||
begin
|
||||
if (O<>'') then
|
||||
O:=O+' ';
|
||||
o:=O+W;
|
||||
end
|
||||
else
|
||||
F:=W;
|
||||
end;
|
||||
end;
|
||||
AFile:=F;
|
||||
AOption:=O;
|
||||
end;
|
||||
|
||||
{ TEngineOptions }
|
||||
|
||||
procedure TEngineOptions.SetBackendOptions(const AValue: TStrings);
|
||||
|
@ -285,51 +285,14 @@ begin
|
||||
AddBool('dont-trim', Options.DontTrim);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TXMLFPDocOptions.SaveInputFile(Const AInputFile : String; XML : TXMLDocument; AParent: TDOMElement);
|
||||
|
||||
Function GetNextWord(Var s : string) : String;
|
||||
|
||||
Const
|
||||
WhiteSpace = [' ',#9,#10,#13];
|
||||
|
||||
var
|
||||
i,j: integer;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
While (I<=Length(S)) and (S[i] in WhiteSpace) do
|
||||
Inc(I);
|
||||
J:=I;
|
||||
While (J<=Length(S)) and (not (S[J] in WhiteSpace)) do
|
||||
Inc(J);
|
||||
if (I<=Length(S)) then
|
||||
Result:=Copy(S,I,J-I);
|
||||
Delete(S,1,J);
|
||||
end;
|
||||
|
||||
|
||||
Var
|
||||
S,W,F,O : String;
|
||||
F,O : String;
|
||||
|
||||
begin
|
||||
S:=AInputFile;
|
||||
O:='';
|
||||
F:='';
|
||||
While (S<>'') do
|
||||
begin
|
||||
W:=GetNextWord(S);
|
||||
If (W<>'') then
|
||||
begin
|
||||
if W[1]='-' then
|
||||
begin
|
||||
if (O<>'') then
|
||||
O:=O+' ';
|
||||
o:=O+W;
|
||||
end
|
||||
else
|
||||
F:=W;
|
||||
end;
|
||||
end;
|
||||
SplitInputFileOption(AInputFile,F,O);
|
||||
AParent['file']:=F;
|
||||
AParent['options']:=O;
|
||||
end;
|
||||
|
@ -19,6 +19,8 @@ Type
|
||||
|
||||
TFPDocCreator = Class(TComponent)
|
||||
Private
|
||||
FCurPackage : TFPDocPackage;
|
||||
FProcessedUnits : TStrings;
|
||||
FOnLog: TPasParserLogHandler;
|
||||
FPParserLogEvents: TPParserLogEvents;
|
||||
FProject : TFPDocProject;
|
||||
@ -27,6 +29,7 @@ Type
|
||||
function GetOptions: TEngineOptions;
|
||||
function GetPackages: TFPDocPackages;
|
||||
Protected
|
||||
procedure HandleOnParseUnit(Sender: TObject; const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
|
||||
procedure SetVerbose(AValue: Boolean); virtual;
|
||||
Procedure DoLog(Const Msg : String);
|
||||
procedure DoLog(Const Fmt : String; Args : Array of Const);
|
||||
@ -45,11 +48,11 @@ Type
|
||||
// Easy access
|
||||
Property Options : TEngineOptions Read GetOptions;
|
||||
Property Packages : TFPDocPackages Read GetPackages;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TFPDocCreator }
|
||||
|
||||
procedure TFPDocCreator.SetVerbose(AValue: Boolean);
|
||||
@ -79,6 +82,36 @@ begin
|
||||
DoLog(Format(Fmt,Args));
|
||||
end;
|
||||
|
||||
procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject;
|
||||
const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
S,un,opts : String;
|
||||
|
||||
begin
|
||||
AInputFile:='';
|
||||
OSTarget:='';
|
||||
CPUTarget:='';
|
||||
if Assigned(FCurPackage) then
|
||||
begin
|
||||
I:=0;
|
||||
While (AInputFIle='') and (I<FCurPackage.Inputs.Count) do
|
||||
begin
|
||||
S:=FCurPackage.Inputs[i];
|
||||
SplitInputFIleOption(S,UN,Opts);
|
||||
if CompareText(ChangeFileExt(ExtractFileName(Un),''),AUnitName)=0 then
|
||||
begin
|
||||
AInputFile:=S;
|
||||
OSTarget:=FProject.Options.OSTarget;
|
||||
CPUTarget:=FProject.Options.CPUTarget;
|
||||
FProcessedUnits.Add(AInputFile);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPDocCreator.GetOptions: TEngineOptions;
|
||||
begin
|
||||
Result:=FProject.Options;
|
||||
@ -96,10 +129,12 @@ begin
|
||||
FProject.Options.StopOnParseError:=False;
|
||||
FProject.Options.CPUTarget:=DefCPUTarget;
|
||||
FProject.Options.OSTarget:=DefOSTarget;
|
||||
FProcessedUnits:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TFPDocCreator.Destroy;
|
||||
begin
|
||||
FreeAndNil(FProcessedUnits);
|
||||
FreeAndNil(FProject);
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -144,6 +179,7 @@ var
|
||||
Cmd,Arg : String;
|
||||
|
||||
begin
|
||||
FCurPackage:=APackage;
|
||||
Engine:=TFPDocEngine.Create;
|
||||
try
|
||||
For J:=0 to Apackage.Imports.Count-1 do
|
||||
@ -161,11 +197,17 @@ begin
|
||||
Engine.ParserLogEvents:=Self.ParserLogEvents;
|
||||
Engine.HideProtected:=Options.HideProtected;
|
||||
Engine.HidePrivate:=Not Options.ShowPrivate;
|
||||
Engine.OnParseUnit:=@HandleOnParseUnit;
|
||||
if Length(Options.Language) > 0 then
|
||||
TranslateDocStrings(Options.Language);
|
||||
for i := 0 to APackage.Inputs.Count - 1 do
|
||||
try
|
||||
ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
|
||||
SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
|
||||
if FProcessedUnits.IndexOf(Cmd)=-1 then
|
||||
begin
|
||||
FProcessedUnits.Add(Cmd);
|
||||
ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
|
||||
end;
|
||||
except
|
||||
on e: EParserError do
|
||||
If Options.StopOnParseError then
|
||||
@ -177,6 +219,7 @@ begin
|
||||
CreateOutput(APackage,Engine);
|
||||
finally
|
||||
FreeAndNil(Engine);
|
||||
FCurPackage:=Nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user