* Some fixes after first test round

git-svn-id: trunk@19735 -
This commit is contained in:
michael 2011-12-03 16:46:15 +00:00
parent f89e32c034
commit b09139a7c4
4 changed files with 156 additions and 117 deletions

View File

@ -12,9 +12,6 @@ Type
TXMLFPDocOptions = Class(TComponent) TXMLFPDocOptions = Class(TComponent)
private private
FExpandMacros: Boolean;
FMacros: TStrings;
procedure SetMacros(AValue: TStrings);
Protected Protected
Procedure Error(Const Msg : String); Procedure Error(Const Msg : String);
Procedure Error(Const Fmt : String; Args : Array of Const); Procedure Error(Const Fmt : String; Args : Array of Const);
@ -25,17 +22,11 @@ Type
procedure SaveDescription(const ADescription: String; XML: TXMLDocument; AParent: TDOMElement); virtual; procedure SaveDescription(const ADescription: String; XML: TXMLDocument; AParent: TDOMElement); virtual;
procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument; AParent: TDOMElement);virtual; procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument; AParent: TDOMElement);virtual;
Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual; Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual;
procedure DoMacro(Sender: TObject; const TagString: String; TagParams: TStringList; out ReplaceText: String); virtual;
function ExpandMacrosInFile(AFileName: String): TStream; virtual;
Public Public
Constructor Create (AOwner : TComponent); override;
Destructor Destroy; override;
Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String); Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String);
Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual; Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual;
Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String); Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String);
procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual; procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
Property Macros : TStrings Read FMacros Write SetMacros;
Property ExpandMacros : Boolean Read FExpandMacros Write FExpandMacros;
end; end;
EXMLFPdoc = Class(Exception); EXMLFPdoc = Class(Exception);
@ -70,11 +61,6 @@ begin
Dec(Result); Dec(Result);
end; end;
procedure TXMLFPDocOptions.SetMacros(AValue: TStrings);
begin
if FMacros=AValue then Exit;
FMacros.Assign(AValue);
end;
procedure TXMLFPDocOptions.Error(Const Msg: String); procedure TXMLFPDocOptions.Error(Const Msg: String);
begin begin
@ -358,74 +344,19 @@ begin
end; end;
end; end;
constructor TXMLFPDocOptions.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMacros:=TStringList.Create;
end;
destructor TXMLFPDocOptions.Destroy;
begin
FreeAndNil(FMacros);
inherited Destroy;
end;
procedure TXMLFPDocOptions.DoMacro(Sender: TObject; const TagString: String;
TagParams: TStringList; out ReplaceText: String);
begin
ReplaceText:=FMacros.Values[TagString];
end;
Function TXMLFPDocOptions.ExpandMacrosInFile(AFileName : String) : TStream;
Var
F : TFileStream;
T : TTemplateParser;
begin
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
try
Result:=TMemoryStream.Create;
try
T:=TTemplateParser.Create;
try
T.StartDelimiter:='$(';
T.EndDelimiter:=')';
T.AllowTagParams:=true;
T.OnReplaceTag:=@DoMacro;
T.ParseStream(F,Result);
finally
T.Free;
end;
except
FreeAndNil(Result);
Raise;
end;
finally
F.Free;
end;
end;
procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject; const AFileName: String); procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject; const AFileName: String);
Var Var
XML : TXMLDocument; XML : TXMLDocument;
S : TStream;
begin begin
If ExpandMacros then ReadXMLFile(XML,AFileName);
S:=ExpandMacrosInFile(AFileName)
else
S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
try try
ReadXMLFile(XML,S,AFileName); LoadFromXML(AProject,XML);
try
LoadFromXML(AProject,XML);
finally
FreeAndNil(XML);
end;
finally finally
S.Free; FreeAndNil(XML);
end; end;
end; end;

View File

@ -14,9 +14,14 @@ Type
Private Private
FProject : TFPDocProject; FProject : TFPDocProject;
FPackage : TFPDocPackage; FPackage : TFPDocPackage;
FExpandMacros: Boolean;
FMacros: TStrings;
procedure SetMacros(AValue: TStrings);
protected protected
Procedure CheckPackage; Procedure CheckPackage;
procedure GetItemsFromDirectory(AList: TStrings; ADirectory, AMask: String; ARecurse: Boolean); procedure GetItemsFromDirectory(AList: TStrings; ADirectory, AMask: String; ARecurse: Boolean);
procedure DoMacro(Sender: TObject; const TagString: String; TagParams: TStringList; out ReplaceText: String); virtual;
function ExpandMacrosInFile(AFileName: String): TStream; virtual;
Public Public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override; Destructor Destroy; override;
@ -27,15 +32,34 @@ Type
procedure RemoveInputFile(Const AFile : String); procedure RemoveInputFile(Const AFile : String);
procedure RemoveDescrFile(Const AFile : String); procedure RemoveDescrFile(Const AFile : String);
procedure WriteOptionFile(const AFileName: String); procedure WriteOptionFile(const AFileName: String);
procedure ReadOptionFile(const AFileName: String; AMacros : TStrings = Nil); procedure ReadOptionFile(const AFileName: String);
Procedure Selectpackage(Const APackageName : String); Procedure Selectpackage(Const APackageName : String);
Procedure AddPackage (Const APackageName : String); Procedure AddPackage (Const APackageName : String);
procedure SetOption(Const AOption : String; Enable : Boolean = True); procedure SetOption(Const AOption : String; Enable : Boolean = True);
Property Project : TFPDocProject Read FProject; Property Project : TFPDocProject Read FProject;
Property SelectedPackage : TFPDocPackage Read FPackage; Property SelectedPackage : TFPDocPackage Read FPackage;
Property Macros : TStrings Read FMacros Write SetMacros;
Property ExpandMacros : Boolean Read FExpandMacros Write FExpandMacros;
end; end;
EMgrFPDoc = Class(Exception);
implementation implementation
uses dom,xmlread,fptemplate;
procedure TFPDocProjectManager.SetMacros(AValue: TStrings);
begin
if FMacros=AValue then Exit;
FMacros.Assign(AValue);
end;
procedure TFPDocProjectManager.DoMacro(Sender: TObject; const TagString: String;
TagParams: TStringList; out ReplaceText: String);
begin
ReplaceText:=FMacros.Values[TagString];
end;
Procedure TFPDocProjectManager.GetItemsFromDirectory(AList : TStrings; ADirectory,AMask : String; ARecurse : Boolean); Procedure TFPDocProjectManager.GetItemsFromDirectory(AList : TStrings; ADirectory,AMask : String; ARecurse : Boolean);
Var Var
@ -44,6 +68,8 @@ Var
begin begin
D:=ADirectory; D:=ADirectory;
if (D='.') then
D:='';
if (D<>'') then if (D<>'') then
D:=includeTrailingPathDelimiter(D); D:=includeTrailingPathDelimiter(D);
If FindFirst(D+AMask,0,info)=0 then If FindFirst(D+AMask,0,info)=0 then
@ -70,14 +96,47 @@ constructor TFPDocProjectManager.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FProject:=TFPDocProject.Create(Self); FProject:=TFPDocProject.Create(Self);
FMacros:=TStringList.Create;
end; end;
destructor TFPDocProjectManager.Destroy; destructor TFPDocProjectManager.Destroy;
begin begin
FreeAndNil(FMacros);
FreeAndNil(FProject); FreeAndNil(FProject);
inherited Destroy; inherited Destroy;
end; end;
Function TFPDocProjectManager.ExpandMacrosInFile(AFileName : String) : TStream;
Var
F : TFileStream;
T : TTemplateParser;
begin
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
try
Result:=TMemoryStream.Create;
try
T:=TTemplateParser.Create;
try
T.StartDelimiter:='$(';
T.EndDelimiter:=')';
T.AllowTagParams:=true;
T.OnReplaceTag:=@DoMacro;
T.ParseStream(F,Result);
finally
T.Free;
end;
Result.Position:=0;
except
FreeAndNil(Result);
Raise;
end;
finally
F.Free;
end;
end;
Procedure TFPDocProjectManager.AddDescrFilesFromDirectory(const ADirectory,AMask : String; ARecurse : Boolean); Procedure TFPDocProjectManager.AddDescrFilesFromDirectory(const ADirectory,AMask : String; ARecurse : Boolean);
Var Var
@ -112,7 +171,7 @@ begin
M:='*.pp'; M:='*.pp';
L:=TStringList.Create; L:=TStringList.Create;
try try
GetItemsFromDirectory(L,ADirectory,AMask,ARecurse); GetItemsFromDirectory(L,ADirectory,M,ARecurse);
For I:=0 to L.Count-1 do For I:=0 to L.Count-1 do
AddInputFile(L[i],AOPtions); AddInputFile(L[i],AOPtions);
finally finally
@ -138,7 +197,7 @@ procedure TFPDocProjectManager.AddDescrFile(const AFile: String);
begin begin
CheckPackage; CheckPackage;
if FPackage.Descriptions.IndexOf(AFile)<>-1 then if FPackage.Descriptions.IndexOf(AFile)<>-1 then
Raise Exception.Createfmt('Duplicate description file : "%s"',[AFile]); Raise EMgrFPDoc.Createfmt('Duplicate description file : "%s"',[AFile]);
FPackage.Descriptions.Add(AFile); FPackage.Descriptions.Add(AFile);
end; end;
@ -164,17 +223,31 @@ begin
FPackage.Descriptions.Delete(I); FPackage.Descriptions.Delete(I);
end; end;
procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String; AMacros : TStrings = Nil); procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String);
Var
XML : TXMLDocument;
S : TStream;
begin begin
With TXMLFPDocOptions.Create(Self) do With TXMLFPDocOptions.Create(Self) do
try try
if (AMacros<>Nil) then if not (ExpandMacros) then
LoadOptionsFromFile(FProject,AFileName)
else
begin begin
Macros.Assign(AMacros); S:=ExpandMacrosInFile(AFileName);
ExpandMacros:=true; try
ReadXMLFile(XML,S,AFileName);
try
LoadFromXml(FProject,XML)
finally
XML.Free;
end;
finally
S.Free;
end;
end; end;
LoadOptionsFromFile(FProject,AFileName);
finally finally
Free; Free;
end; end;
@ -184,13 +257,13 @@ procedure TFPDocProjectManager.Selectpackage(const APackageName: String);
begin begin
FPackage:=FProject.Packages.FindPackage(APackageName); FPackage:=FProject.Packages.FindPackage(APackageName);
If (FPackage=Nil) then If (FPackage=Nil) then
Raise Exception.CreateFmt('Unknown package : "%s"',[APackageName]); Raise EMgrFPDoc.CreateFmt('Unknown package : "%s"',[APackageName]);
end; end;
procedure TFPDocProjectManager.AddPackage(const APackageName: String); procedure TFPDocProjectManager.AddPackage(const APackageName: String);
begin begin
if FProject.Packages.FindPackage(APackageName)<>Nil then if FProject.Packages.FindPackage(APackageName)<>Nil then
Raise Exception.CreateFmt('Duplicate package : "%s"',[APackageName]); Raise EMgrFPDoc.CreateFmt('Duplicate package : "%s"',[APackageName]);
FPackage:=FProject.Packages.Add as TFPDocPackage; FPackage:=FProject.Packages.Add as TFPDocPackage;
FPackage.Name:=APackageName; FPackage.Name:=APackageName;
end; end;
@ -245,7 +318,7 @@ procedure TFPDocProjectManager.CheckPackage;
begin begin
if (FPackage=Nil) then if (FPackage=Nil) then
Raise Exception.Create('Error: No package selected'); Raise EMgrFPDoc.Create('Error: No package selected');
end; end;

View File

@ -28,6 +28,7 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<CommandLineParams Value="--input=test.xml --output=test.xml --package=test add-input-files -o me testunit3.pp"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>

View File

@ -22,8 +22,10 @@ type
procedure AddDescriptionDirs; procedure AddDescriptionDirs;
procedure AddInputDirs; procedure AddInputDirs;
procedure AddInputFiles; procedure AddInputFiles;
function CmdNeedsPackage: Boolean;
procedure RemoveInputFiles; procedure RemoveInputFiles;
procedure RemoveDescrFiles; procedure RemoveDescrFiles;
procedure AddPackages;
function CheckCmdOption(C: Char; S: String): Boolean; function CheckCmdOption(C: Char; S: String): Boolean;
function GetCmdOption(C: Char; S: String): String; function GetCmdOption(C: Char; S: String): String;
procedure SetOptions(Enable: Boolean); procedure SetOptions(Enable: Boolean);
@ -54,6 +56,12 @@ begin
Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'=')); Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
end; end;
function TManageFPDocProjectApplication.CmdNeedsPackage : Boolean;
begin
Result:=(FCMd<>'expand-macros') and (FCMD<>'set-options') and (FCmd<>'unset-options');
end;
procedure TManageFPDocProjectApplication.ParseOptions; procedure TManageFPDocProjectApplication.ParseOptions;
Function CheckOption(Index : Integer;Short : char;Long : String): Boolean; Function CheckOption(Index : Integer;Short : char;Long : String): Boolean;
@ -99,39 +107,40 @@ begin
While (I<ParamCount) do While (I<ParamCount) do
begin begin
Inc(I); Inc(I);
if Checkoption(I,'i','input') then if (FCmd='') then
FInputFileName:=OptionArg(i)
else if Checkoption(I,'o','output') then
FOutputFileName:=OptionArg(i)
else if CheckOption(I,'p','package') then
FPackageName:=OptionArg(i)
else if CheckOption(I,'h','help') then
begin begin
Usage(0); if Checkoption(I,'i','input') then
FInputFileName:=OptionArg(i)
else if Checkoption(I,'o','output') then
FOutputFileName:=OptionArg(i)
else if CheckOption(I,'p','package') then
FPackageName:=OptionArg(i)
else if CheckOption(I,'h','help') then
Usage(0)
else if (ParamStr(i)<>'') then
begin
S:=ParamStr(i);
if (S[1]='-') then
Error('Unknown option : '+S)
else
FCmd:=lowercase(S)
end
end end
else else
begin begin
S:=ParamStr(I); S:=ParamStr(I);
If (S<>'') then if (S<>'') then
begin if (S[1]<>'-') then
if (S[1]<>'-') then FCmdArgs.Add(S)
begin else
if (FCmd='') then FCmdOptions.Add(S);
FCmd:=lowercase(S)
else
FCmdArgs.Add(S)
end
end
else
FCmdOptions.Add(S);
end; end;
Inc(I);
end; end;
if (FOutputFileName='') then if (FOutputFileName='') then
FOutputFileName:=FInputFileName; FOutputFileName:=FInputFileName;
If (FOutputFileName='') then If (FOutputFileName='') then
Error('Need an output filename'); Error('Need an output filename');
if (FPackageName='') then if (FPackageName='') and CmdNeedsPackage then
Error('Need a package name'); Error('Need a package name');
if (FCmd='') then if (FCmd='') then
Error('Need a command'); Error('Need a command');
@ -173,13 +182,13 @@ begin
B:=CheckOptionStr(FCmdOptions[i],C,S); B:=CheckOptionStr(FCmdOptions[i],C,S);
if B then if B then
begin begin
Result:=FCmdArgs[I]; Result:=FCmdOptions[I];
if (Length(S)>1) and (S[2]<>'-') then if (Length(Result)>1) and (Result[2]<>'-') then
begin begin
If I<FCmdArgs.Count-1 then If I<FCmdOptions.Count-1 then
begin begin
Inc(I); Inc(I);
Result:=FCmdArgs[I]; Result:=FCmdOptions[I];
end end
else else
Error(Format(SErrNeedArgument,[I,Result])); Error(Format(SErrNeedArgument,[I,Result]));
@ -206,8 +215,11 @@ Var
begin begin
Recursive:=CheckCmdOption('r','recursive'); Recursive:=CheckCmdOption('r','recursive');
Mask:=GetCmdOption('m','mask'); Mask:=GetCmdOption('m','mask');
For I:=0 to FCmdArgs.Count-1 do if FCmdArgs.Count=0 then
FMGr.AddDescrFilesFromDirectory(FCmdArgs[i],Mask,Recursive); FMGr.AddDescrFilesFromDirectory('',Mask,Recursive)
else
For I:=0 to FCmdArgs.Count-1 do
FMGr.AddDescrFilesFromDirectory(FCmdArgs[i],Mask,Recursive);
end; end;
procedure TManageFPDocProjectApplication.AddInputDirs; procedure TManageFPDocProjectApplication.AddInputDirs;
@ -220,8 +232,11 @@ begin
Recursive:=CheckCmdOption('r','recursive'); Recursive:=CheckCmdOption('r','recursive');
Mask:=GetCmdOption('m','mask'); Mask:=GetCmdOption('m','mask');
Options:=GetCmdOption('o','options'); Options:=GetCmdOption('o','options');
For I:=0 to FCmdArgs.Count-1 do if FCmdArgs.Count=0 then
FMGr.AddInputFilesFromDirectory(FCmdArgs[i],Mask,Options,Recursive); FMGr.AddInputFilesFromDirectory('',Mask,Options,Recursive)
else
For I:=0 to FCmdArgs.Count-1 do
FMGr.AddInputFilesFromDirectory(FCmdArgs[i],Mask,Options,Recursive);
end; end;
procedure TManageFPDocProjectApplication.AddInputFiles; procedure TManageFPDocProjectApplication.AddInputFiles;
@ -255,6 +270,16 @@ begin
FMGr.RemoveDescrFile(FCmdArgs[i]); FMGr.RemoveDescrFile(FCmdArgs[i]);
end; end;
procedure TManageFPDocProjectApplication.AddPackages;
var
I : Integer;
begin
For I:=0 to FCmdArgs.Count-1 do
FMgr.AddPackage(FCmdArgs[i]);
end;
procedure TManageFPDocProjectApplication.AddDescrFiles; procedure TManageFPDocProjectApplication.AddDescrFiles;
Var Var
@ -284,18 +309,27 @@ begin
else else
begin begin
if (FCmd='expand-macros') then if (FCmd='expand-macros') then
begin
FMGR.Macros:=FCmdArgs;
FMGR.ExpandMacros:=true;
FMGR.ReadOptionFile(FInputFileName) FMGR.ReadOptionFile(FInputFileName)
end
else else
FMGR.ReadOptionFile(FInputFileName,FCMdArgs); begin
FMGR.SelectPackage(FPackageName); FMGR.ReadOptionFile(FInputFileName);
if CmdNeedsPackage then
FMGR.SelectPackage(FPackageName);
end
end; end;
if (FCmd='add-description-dirs') then if (FCmd='add-packages') then
AddPackages
else if (FCmd='add-description-dirs') then
AddDescriptionDirs AddDescriptionDirs
else if (FCmd='add-input-dirs') then else if (FCmd='add-input-dirs') then
AddInputDirs AddInputDirs
else if (FCmd='add-input-files') then else if (FCmd='add-input-files') then
AddInputFiles AddInputFiles
else if (FCmd='add-descr-files') then else if (FCmd='add-description-files') then
AddDescrFiles AddDescrFiles
else if (FCmd='remove-input-files') then else if (FCmd='remove-input-files') then
RemoveInputFiles RemoveInputFiles