mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 18:25:58 +02:00
* Some fixes after first test round
git-svn-id: trunk@19735 -
This commit is contained in:
michael
parent
f89e32c034
commit
b09139a7c4
@ -12,9 +12,6 @@ Type
|
||||
|
||||
TXMLFPDocOptions = Class(TComponent)
|
||||
private
|
||||
FExpandMacros: Boolean;
|
||||
FMacros: TStrings;
|
||||
procedure SetMacros(AValue: TStrings);
|
||||
Protected
|
||||
Procedure Error(Const Msg : String);
|
||||
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 SaveInputFile(const AInputFile: String; 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
|
||||
Constructor Create (AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String);
|
||||
Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual;
|
||||
Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String);
|
||||
procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
|
||||
Property Macros : TStrings Read FMacros Write SetMacros;
|
||||
Property ExpandMacros : Boolean Read FExpandMacros Write FExpandMacros;
|
||||
end;
|
||||
EXMLFPdoc = Class(Exception);
|
||||
|
||||
@ -70,11 +61,6 @@ begin
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
procedure TXMLFPDocOptions.SetMacros(AValue: TStrings);
|
||||
begin
|
||||
if FMacros=AValue then Exit;
|
||||
FMacros.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TXMLFPDocOptions.Error(Const Msg: String);
|
||||
begin
|
||||
@ -358,74 +344,19 @@ begin
|
||||
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);
|
||||
|
||||
Var
|
||||
XML : TXMLDocument;
|
||||
S : TStream;
|
||||
|
||||
begin
|
||||
If ExpandMacros then
|
||||
S:=ExpandMacrosInFile(AFileName)
|
||||
else
|
||||
S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
||||
ReadXMLFile(XML,AFileName);
|
||||
try
|
||||
ReadXMLFile(XML,S,AFileName);
|
||||
try
|
||||
LoadFromXML(AProject,XML);
|
||||
finally
|
||||
FreeAndNil(XML);
|
||||
end;
|
||||
LoadFromXML(AProject,XML);
|
||||
finally
|
||||
S.Free;
|
||||
FreeAndNil(XML);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -14,9 +14,14 @@ Type
|
||||
Private
|
||||
FProject : TFPDocProject;
|
||||
FPackage : TFPDocPackage;
|
||||
FExpandMacros: Boolean;
|
||||
FMacros: TStrings;
|
||||
procedure SetMacros(AValue: TStrings);
|
||||
protected
|
||||
Procedure CheckPackage;
|
||||
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
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
@ -27,15 +32,34 @@ Type
|
||||
procedure RemoveInputFile(Const AFile : String);
|
||||
procedure RemoveDescrFile(Const AFile : 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 AddPackage (Const APackageName : String);
|
||||
procedure SetOption(Const AOption : String; Enable : Boolean = True);
|
||||
Property Project : TFPDocProject Read FProject;
|
||||
Property SelectedPackage : TFPDocPackage Read FPackage;
|
||||
Property Macros : TStrings Read FMacros Write SetMacros;
|
||||
Property ExpandMacros : Boolean Read FExpandMacros Write FExpandMacros;
|
||||
end;
|
||||
EMgrFPDoc = Class(Exception);
|
||||
|
||||
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);
|
||||
|
||||
Var
|
||||
@ -44,6 +68,8 @@ Var
|
||||
|
||||
begin
|
||||
D:=ADirectory;
|
||||
if (D='.') then
|
||||
D:='';
|
||||
if (D<>'') then
|
||||
D:=includeTrailingPathDelimiter(D);
|
||||
If FindFirst(D+AMask,0,info)=0 then
|
||||
@ -70,14 +96,47 @@ constructor TFPDocProjectManager.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FProject:=TFPDocProject.Create(Self);
|
||||
FMacros:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TFPDocProjectManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FMacros);
|
||||
FreeAndNil(FProject);
|
||||
inherited Destroy;
|
||||
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);
|
||||
|
||||
Var
|
||||
@ -112,7 +171,7 @@ begin
|
||||
M:='*.pp';
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
GetItemsFromDirectory(L,ADirectory,AMask,ARecurse);
|
||||
GetItemsFromDirectory(L,ADirectory,M,ARecurse);
|
||||
For I:=0 to L.Count-1 do
|
||||
AddInputFile(L[i],AOPtions);
|
||||
finally
|
||||
@ -138,7 +197,7 @@ procedure TFPDocProjectManager.AddDescrFile(const AFile: String);
|
||||
begin
|
||||
CheckPackage;
|
||||
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);
|
||||
end;
|
||||
|
||||
@ -164,17 +223,31 @@ begin
|
||||
FPackage.Descriptions.Delete(I);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String; AMacros : TStrings = Nil);
|
||||
procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String);
|
||||
|
||||
Var
|
||||
XML : TXMLDocument;
|
||||
S : TStream;
|
||||
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
if (AMacros<>Nil) then
|
||||
if not (ExpandMacros) then
|
||||
LoadOptionsFromFile(FProject,AFileName)
|
||||
else
|
||||
begin
|
||||
Macros.Assign(AMacros);
|
||||
ExpandMacros:=true;
|
||||
S:=ExpandMacrosInFile(AFileName);
|
||||
try
|
||||
ReadXMLFile(XML,S,AFileName);
|
||||
try
|
||||
LoadFromXml(FProject,XML)
|
||||
finally
|
||||
XML.Free;
|
||||
end;
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
LoadOptionsFromFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
@ -184,13 +257,13 @@ procedure TFPDocProjectManager.Selectpackage(const APackageName: String);
|
||||
begin
|
||||
FPackage:=FProject.Packages.FindPackage(APackageName);
|
||||
If (FPackage=Nil) then
|
||||
Raise Exception.CreateFmt('Unknown package : "%s"',[APackageName]);
|
||||
Raise EMgrFPDoc.CreateFmt('Unknown package : "%s"',[APackageName]);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.AddPackage(const APackageName: String);
|
||||
begin
|
||||
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.Name:=APackageName;
|
||||
end;
|
||||
@ -245,7 +318,7 @@ procedure TFPDocProjectManager.CheckPackage;
|
||||
|
||||
begin
|
||||
if (FPackage=Nil) then
|
||||
Raise Exception.Create('Error: No package selected');
|
||||
Raise EMgrFPDoc.Create('Error: No package selected');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -28,6 +28,7 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<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)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
|
||||
@ -22,8 +22,10 @@ type
|
||||
procedure AddDescriptionDirs;
|
||||
procedure AddInputDirs;
|
||||
procedure AddInputFiles;
|
||||
function CmdNeedsPackage: Boolean;
|
||||
procedure RemoveInputFiles;
|
||||
procedure RemoveDescrFiles;
|
||||
procedure AddPackages;
|
||||
function CheckCmdOption(C: Char; S: String): Boolean;
|
||||
function GetCmdOption(C: Char; S: String): String;
|
||||
procedure SetOptions(Enable: Boolean);
|
||||
@ -54,6 +56,12 @@ begin
|
||||
Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
|
||||
end;
|
||||
|
||||
function TManageFPDocProjectApplication.CmdNeedsPackage : Boolean;
|
||||
|
||||
begin
|
||||
Result:=(FCMd<>'expand-macros') and (FCMD<>'set-options') and (FCmd<>'unset-options');
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.ParseOptions;
|
||||
|
||||
Function CheckOption(Index : Integer;Short : char;Long : String): Boolean;
|
||||
@ -99,39 +107,40 @@ begin
|
||||
While (I<ParamCount) do
|
||||
begin
|
||||
Inc(I);
|
||||
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
|
||||
if (FCmd='') then
|
||||
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
|
||||
else
|
||||
begin
|
||||
S:=ParamStr(I);
|
||||
If (S<>'') then
|
||||
begin
|
||||
if (S[1]<>'-') then
|
||||
begin
|
||||
if (FCmd='') then
|
||||
FCmd:=lowercase(S)
|
||||
else
|
||||
FCmdArgs.Add(S)
|
||||
end
|
||||
end
|
||||
else
|
||||
FCmdOptions.Add(S);
|
||||
if (S<>'') then
|
||||
if (S[1]<>'-') then
|
||||
FCmdArgs.Add(S)
|
||||
else
|
||||
FCmdOptions.Add(S);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
if (FOutputFileName='') then
|
||||
FOutputFileName:=FInputFileName;
|
||||
If (FOutputFileName='') then
|
||||
Error('Need an output filename');
|
||||
if (FPackageName='') then
|
||||
if (FPackageName='') and CmdNeedsPackage then
|
||||
Error('Need a package name');
|
||||
if (FCmd='') then
|
||||
Error('Need a command');
|
||||
@ -173,13 +182,13 @@ begin
|
||||
B:=CheckOptionStr(FCmdOptions[i],C,S);
|
||||
if B then
|
||||
begin
|
||||
Result:=FCmdArgs[I];
|
||||
if (Length(S)>1) and (S[2]<>'-') then
|
||||
Result:=FCmdOptions[I];
|
||||
if (Length(Result)>1) and (Result[2]<>'-') then
|
||||
begin
|
||||
If I<FCmdArgs.Count-1 then
|
||||
If I<FCmdOptions.Count-1 then
|
||||
begin
|
||||
Inc(I);
|
||||
Result:=FCmdArgs[I];
|
||||
Result:=FCmdOptions[I];
|
||||
end
|
||||
else
|
||||
Error(Format(SErrNeedArgument,[I,Result]));
|
||||
@ -206,8 +215,11 @@ Var
|
||||
begin
|
||||
Recursive:=CheckCmdOption('r','recursive');
|
||||
Mask:=GetCmdOption('m','mask');
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddDescrFilesFromDirectory(FCmdArgs[i],Mask,Recursive);
|
||||
if FCmdArgs.Count=0 then
|
||||
FMGr.AddDescrFilesFromDirectory('',Mask,Recursive)
|
||||
else
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddDescrFilesFromDirectory(FCmdArgs[i],Mask,Recursive);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddInputDirs;
|
||||
@ -220,8 +232,11 @@ begin
|
||||
Recursive:=CheckCmdOption('r','recursive');
|
||||
Mask:=GetCmdOption('m','mask');
|
||||
Options:=GetCmdOption('o','options');
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddInputFilesFromDirectory(FCmdArgs[i],Mask,Options,Recursive);
|
||||
if FCmdArgs.Count=0 then
|
||||
FMGr.AddInputFilesFromDirectory('',Mask,Options,Recursive)
|
||||
else
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddInputFilesFromDirectory(FCmdArgs[i],Mask,Options,Recursive);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddInputFiles;
|
||||
@ -255,6 +270,16 @@ begin
|
||||
FMGr.RemoveDescrFile(FCmdArgs[i]);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddPackages;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMgr.AddPackage(FCmdArgs[i]);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddDescrFiles;
|
||||
|
||||
Var
|
||||
@ -284,18 +309,27 @@ begin
|
||||
else
|
||||
begin
|
||||
if (FCmd='expand-macros') then
|
||||
begin
|
||||
FMGR.Macros:=FCmdArgs;
|
||||
FMGR.ExpandMacros:=true;
|
||||
FMGR.ReadOptionFile(FInputFileName)
|
||||
end
|
||||
else
|
||||
FMGR.ReadOptionFile(FInputFileName,FCMdArgs);
|
||||
FMGR.SelectPackage(FPackageName);
|
||||
begin
|
||||
FMGR.ReadOptionFile(FInputFileName);
|
||||
if CmdNeedsPackage then
|
||||
FMGR.SelectPackage(FPackageName);
|
||||
end
|
||||
end;
|
||||
if (FCmd='add-description-dirs') then
|
||||
if (FCmd='add-packages') then
|
||||
AddPackages
|
||||
else if (FCmd='add-description-dirs') then
|
||||
AddDescriptionDirs
|
||||
else if (FCmd='add-input-dirs') then
|
||||
AddInputDirs
|
||||
else if (FCmd='add-input-files') then
|
||||
AddInputFiles
|
||||
else if (FCmd='add-descr-files') then
|
||||
else if (FCmd='add-description-files') then
|
||||
AddDescrFiles
|
||||
else if (FCmd='remove-input-files') then
|
||||
RemoveInputFiles
|
||||
|
||||
Loading…
Reference in New Issue
Block a user