* Recursive parsing

git-svn-id: trunk@20213 -
This commit is contained in:
michael 2012-02-01 20:06:50 +00:00
parent 6a5cf6cf8d
commit 2b60a95896
5 changed files with 129 additions and 43 deletions

View File

@ -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);

View File

@ -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"/>

View File

@ -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);

View File

@ -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;

View File

@ -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;