mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 00:59:30 +02:00
* Added lots of commands to fpdoc file manager, moved to separate class and unit for reuse
git-svn-id: trunk@19730 -
This commit is contained in:
michael
parent
9d30bf6a9f
commit
a051684e61
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -12910,6 +12910,7 @@ utils/fpdoc/intl/fpdocstr.de.po svneol=native#text/plain
|
||||
utils/fpdoc/intl/makeskel.de.po svneol=native#text/plain
|
||||
utils/fpdoc/makeskel.lpi svneol=native#text/plain
|
||||
utils/fpdoc/makeskel.pp svneol=native#text/plain
|
||||
utils/fpdoc/mgrfpdocproj.pp svneol=native#text/plain
|
||||
utils/fpdoc/mkfpdocproj.lpi svneol=native#text/plain
|
||||
utils/fpdoc/mkfpdocproj.pp svneol=native#text/plain
|
||||
utils/fpdoc/sample-project.xml svneol=native#text/plain
|
||||
|
||||
@ -5,12 +5,16 @@ unit fpdocxmlopts;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpdocproj, dom;
|
||||
Classes, SysUtils, fpdocproj, dom, fptemplate;
|
||||
|
||||
Type
|
||||
{ TXMLFPDocOptions }
|
||||
|
||||
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);
|
||||
@ -21,14 +25,30 @@ 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);
|
||||
|
||||
Function IndexOfString(S : String; List : Array of string) : Integer;
|
||||
|
||||
Const
|
||||
OptionCount = 11;
|
||||
OptionNames : Array[0..OptionCount] of string
|
||||
= ('hide-protected','warn-no-node','show-private',
|
||||
'stop-on-parser-error', 'ostarget','cputarget',
|
||||
'mo-dir','parse-impl','format', 'language',
|
||||
'package','dont-trim');
|
||||
|
||||
implementation
|
||||
|
||||
Uses XMLRead, XMLWrite;
|
||||
@ -39,9 +59,6 @@ Resourcestring
|
||||
SErrNoInputFile = 'unit tag without file attribute found';
|
||||
SErrNoDescrFile = 'description tag without file attribute';
|
||||
|
||||
const
|
||||
ProjectTemplate = 'template-project.xml';
|
||||
|
||||
{ TXMLFPDocOptions }
|
||||
|
||||
Function IndexOfString(S : String; List : Array of string) : Integer;
|
||||
@ -53,6 +70,12 @@ 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
|
||||
Raise EXMLFPDoc.Create(Msg);
|
||||
@ -83,19 +106,12 @@ procedure TXMLFPDocOptions.LoadPackage(APackage: TFPDocPackage; E: TDOMElement);
|
||||
|
||||
Function LoadDescription(I : TDOMElement) : String;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
|
||||
begin
|
||||
Result:=I['file'];
|
||||
If (Result='') then
|
||||
Error(SErrNoDescrFile);
|
||||
end;
|
||||
|
||||
Const
|
||||
OpCount = 0;
|
||||
OpNames : Array[0..OpCount] of string
|
||||
= ('');
|
||||
Var
|
||||
N,S : TDOMNode;
|
||||
O : TDomElement;
|
||||
@ -161,13 +177,6 @@ procedure TXMLFPDocOptions.LoadEngineOptions(Options: TEngineOptions;
|
||||
Result:=(v='true') or (v='1') or (v='yes');
|
||||
end;
|
||||
|
||||
Const
|
||||
NCount = 11;
|
||||
ONames : Array[0..NCount] of string
|
||||
= ('hide-protected','warn-no-node','show-private',
|
||||
'stop-on-parser-error', 'ostarget','cputarget',
|
||||
'mo-dir','parse-impl','format', 'language',
|
||||
'package','dont-trim');
|
||||
|
||||
Var
|
||||
O : TDOMnode;
|
||||
@ -181,7 +190,7 @@ begin
|
||||
begin
|
||||
N:=LowerCase(TDOMElement(o)['name']);
|
||||
V:=TDOMElement(o)['value'];
|
||||
Case IndexOfString(N,ONames) of
|
||||
Case IndexOfString(N,OptionNames) of
|
||||
0 : Options.HideProtected:=TrueValue(v);
|
||||
1 : Options.WarnNoNode:=TrueValue(v);
|
||||
2 : Options.ShowPrivate:=TrueValue(v);
|
||||
@ -248,10 +257,6 @@ Procedure TXMLFPDocOptions.SaveEngineOptions(Options : TEngineOptions; XML : TXM
|
||||
AddStr(Aname,'false');
|
||||
end;
|
||||
|
||||
var
|
||||
i: integer;
|
||||
n: string;
|
||||
|
||||
begin
|
||||
AddStr('ostarget', Options.OSTarget);
|
||||
AddStr('cputarget', Options.CPUTarget);
|
||||
@ -295,6 +300,8 @@ Var
|
||||
|
||||
begin
|
||||
S:=AInputFile;
|
||||
O:='';
|
||||
F:='';
|
||||
While (S<>'') do
|
||||
begin
|
||||
W:=GetNextWord(S);
|
||||
@ -351,18 +358,75 @@ 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
|
||||
XMLRead.ReadXMLFile(XML,AFileName);
|
||||
try
|
||||
LoadFromXML(AProject,XML);
|
||||
finally
|
||||
FreeAndNil(XML);
|
||||
end;
|
||||
If ExpandMacros then
|
||||
S:=ExpandMacrosInFile(AFileName)
|
||||
else
|
||||
S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
ReadXMLFile(XML,S,AFileName);
|
||||
try
|
||||
LoadFromXML(AProject,XML);
|
||||
finally
|
||||
FreeAndNil(XML);
|
||||
end;
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TXMLFPDocOptions.LoadFromXML(AProject: TFPDocProject;
|
||||
|
||||
254
utils/fpdoc/mgrfpdocproj.pp
Normal file
254
utils/fpdoc/mgrfpdocproj.pp
Normal file
@ -0,0 +1,254 @@
|
||||
unit mgrfpdocproj;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpdocproj, fpdocxmlopts;
|
||||
|
||||
Type
|
||||
{ TFPDocProjectManager }
|
||||
|
||||
TFPDocProjectManager = Class(TComponent)
|
||||
Private
|
||||
FProject : TFPDocProject;
|
||||
FPackage : TFPDocPackage;
|
||||
protected
|
||||
Procedure CheckPackage;
|
||||
procedure GetItemsFromDirectory(AList: TStrings; ADirectory, AMask: String; ARecurse: Boolean);
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
procedure AddDescrFilesFromDirectory(Const ADirectory, AMask : String; ARecurse: Boolean);
|
||||
procedure AddInputFilesFromDirectory(Const ADirectory, AMask, AOptions: String; ARecurse: Boolean);
|
||||
procedure AddInputFile(Const AFile : String; AOptions : String = '');
|
||||
procedure AddDescrFile(Const AFile : String);
|
||||
procedure RemoveInputFile(Const AFile : String);
|
||||
procedure RemoveDescrFile(Const AFile : String);
|
||||
procedure WriteOptionFile(const AFileName: String);
|
||||
procedure ReadOptionFile(const AFileName: String; AMacros : TStrings = Nil);
|
||||
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;
|
||||
end;
|
||||
|
||||
implementation
|
||||
Procedure TFPDocProjectManager.GetItemsFromDirectory(AList : TStrings; ADirectory,AMask : String; ARecurse : Boolean);
|
||||
|
||||
Var
|
||||
D : String;
|
||||
Info : TSearchRec;
|
||||
|
||||
begin
|
||||
D:=ADirectory;
|
||||
if (D<>'') then
|
||||
D:=includeTrailingPathDelimiter(D);
|
||||
If FindFirst(D+AMask,0,info)=0 then
|
||||
try
|
||||
Repeat
|
||||
if ((Info.Attr and faDirectory)=0) then
|
||||
AList.add(D+Info.Name);
|
||||
Until (FindNext(Info)<>0);
|
||||
finally
|
||||
FindClose(Info);
|
||||
end;
|
||||
If ARecurse and (FindFirst(ADirectory+AMask,0,info)=0) then
|
||||
try
|
||||
Repeat
|
||||
if ((Info.Attr and faDirectory)<>0) then
|
||||
GetItemsFromDirectory(Alist,IncludeTrailingPathDelimiter(D+Info.Name),AMask,ARecurse);
|
||||
Until (FindNext(Info)<>0);
|
||||
finally
|
||||
FindClose(Info);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFPDocProjectManager.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FProject:=TFPDocProject.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TFPDocProjectManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FProject);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Procedure TFPDocProjectManager.AddDescrFilesFromDirectory(const ADirectory,AMask : String; ARecurse : Boolean);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
M : String;
|
||||
|
||||
begin
|
||||
CheckPackage;
|
||||
M:=AMask;
|
||||
if (M='') then
|
||||
M:='*.xml';
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
GetItemsFromDirectory(L,ADirectory,M,ARecurse);
|
||||
FPackage.Descriptions.AddStrings(L);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TFPDocProjectManager.AddInputFilesFromDirectory(Const ADirectory,AMask,AOptions : String; ARecurse : Boolean);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
I : integer;
|
||||
M : String;
|
||||
|
||||
begin
|
||||
CheckPackage;
|
||||
M:=AMask;
|
||||
if (M='') then
|
||||
M:='*.pp';
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
GetItemsFromDirectory(L,ADirectory,AMask,ARecurse);
|
||||
For I:=0 to L.Count-1 do
|
||||
AddInputFile(L[i],AOPtions);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.AddInputFile(const AFile: String; AOptions : String = '');
|
||||
|
||||
Var
|
||||
S : String;
|
||||
|
||||
begin
|
||||
CheckPackage;
|
||||
S:=AFile;
|
||||
If (AOptions<>'') then
|
||||
S:=AOptions+' '+S;
|
||||
FPackage.Inputs.Add(S);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.AddDescrFile(const AFile: String);
|
||||
|
||||
begin
|
||||
CheckPackage;
|
||||
if FPackage.Descriptions.IndexOf(AFile)<>-1 then
|
||||
Raise Exception.Createfmt('Duplicate description file : "%s"',[AFile]);
|
||||
FPackage.Descriptions.Add(AFile);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.RemoveInputFile(const AFile: String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=FPackage.Inputs.IndexOf(AFile);
|
||||
If (I<>-1) then
|
||||
FPackage.Inputs.Delete(I);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.RemoveDescrFile(const AFile: String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=FPackage.Descriptions.IndexOf(AFile);
|
||||
If (I<>-1) then
|
||||
FPackage.Descriptions.Delete(I);
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String; AMacros : TStrings = Nil);
|
||||
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
if (AMacros<>Nil) then
|
||||
begin
|
||||
Macros.Assign(AMacros);
|
||||
ExpandMacros:=true;
|
||||
end;
|
||||
LoadOptionsFromFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.Selectpackage(const APackageName: String);
|
||||
begin
|
||||
FPackage:=FProject.Packages.FindPackage(APackageName);
|
||||
If (FPackage=Nil) then
|
||||
Raise Exception.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]);
|
||||
FPackage:=FProject.Packages.Add as TFPDocPackage;
|
||||
FPackage.Name:=APackageName;
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.SetOption(const AOption: String;
|
||||
Enable: Boolean = true);
|
||||
|
||||
Var
|
||||
O,V : String;
|
||||
P : Integer;
|
||||
EO : TEngineOptions;
|
||||
|
||||
begin
|
||||
V:=LowerCase(AOption);
|
||||
P:=Pos('=',V);
|
||||
If (P=0) then
|
||||
P:=Length(V)+1;
|
||||
O:=Copy(V,1,P-1);
|
||||
Delete(V,1,P);
|
||||
EO:=FProject.Options;
|
||||
Case IndexOfString(o,OptionNames) of
|
||||
0 : EO.HideProtected:=Enable;
|
||||
1 : EO.WarnNoNode:=Enable;
|
||||
2 : EO.ShowPrivate:=Enable;
|
||||
3 : EO.StopOnParseError:=Enable;
|
||||
4 : EO.ostarget:=v;
|
||||
5 : EO.cputarget:=v;
|
||||
6 : EO.MoDir:=V;
|
||||
7 : EO.InterfaceOnly:=Not Enable;
|
||||
8 : EO.Backend:=V;
|
||||
9 : EO.Language:=v;
|
||||
10 : EO.DefaultPackageName:=V;
|
||||
11 : EO.DontTrim:=Enable;
|
||||
else
|
||||
EO.BackendOptions.add('--'+O);
|
||||
EO.BackendOptions.add(v);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.WriteOptionFile(Const AFileName : String);
|
||||
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
SaveOptionsToFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocProjectManager.CheckPackage;
|
||||
|
||||
begin
|
||||
if (FPackage=Nil) then
|
||||
Raise Exception.Create('Error: No package selected');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -31,12 +31,17 @@
|
||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="mkfpdocproj.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mkfpdocproj"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mgrfpdocproj.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mgrfpdocproj"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -44,11 +49,6 @@
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
|
||||
@ -3,7 +3,7 @@ program mkfpdocproj;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpdocproj, fpdocxmlopts, CustApp;
|
||||
Classes, SysUtils, CustApp, mgrfpdocproj;
|
||||
|
||||
type
|
||||
|
||||
@ -11,25 +11,35 @@ type
|
||||
|
||||
TManageFPDocProjectApplication = class(TCustomApplication)
|
||||
private
|
||||
procedure ParseOptions;
|
||||
protected
|
||||
FRecurse : boolean;
|
||||
FDirectory,
|
||||
FMask,
|
||||
FMGR : TFPDocProjectManager;
|
||||
FPackageName,
|
||||
FInputFileName,
|
||||
FOutputFileName : String;
|
||||
FProject : TFPDocProject;
|
||||
FPackage : TFPDocPackage;
|
||||
procedure ReadOptionFile(const AFileName: String);
|
||||
FOutputFileName,
|
||||
FCmd : String;
|
||||
FCmdArgs,
|
||||
FCmdOptions: TStrings;
|
||||
procedure AddDescrFiles;
|
||||
procedure AddDescriptionDirs;
|
||||
procedure AddInputDirs;
|
||||
procedure AddInputFiles;
|
||||
procedure RemoveInputFiles;
|
||||
procedure RemoveDescrFiles;
|
||||
function CheckCmdOption(C: Char; S: String): Boolean;
|
||||
function GetCmdOption(C: Char; S: String): String;
|
||||
procedure SetOptions(Enable: Boolean);
|
||||
protected
|
||||
procedure ParseOptions;
|
||||
Procedure Error(Const Msg : String);
|
||||
procedure Usage(AExitCode: Integer);
|
||||
procedure WriteOptionFile(const AFileName: String);
|
||||
procedure AddFilesFromDirectory(ADirectory, AMask: String; ARecurse: Boolean);
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
Resourcestring
|
||||
SErrNeedArgument = 'Option at position %d needs an argument: %s';
|
||||
|
||||
{ TManageFPDocProjectApplication }
|
||||
|
||||
procedure TManageFPDocProjectApplication.Usage(AExitCode : Integer);
|
||||
@ -39,87 +49,265 @@ begin
|
||||
Halt(AExitCode);
|
||||
end;
|
||||
|
||||
Function CheckOptionStr(O : String;Short : Char;Long : String): Boolean;
|
||||
begin
|
||||
Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.ParseOptions;
|
||||
|
||||
Function CheckOption(Index : Integer;Short : char;Long : String): Boolean;
|
||||
begin
|
||||
Result:=CheckOptionStr(ParamStr(Index),Short,Long);
|
||||
end;
|
||||
|
||||
Function OptionArg(Var Index : Integer) : String;
|
||||
Var
|
||||
P : Integer;
|
||||
begin
|
||||
if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
|
||||
begin
|
||||
If Index<ParamCount then
|
||||
begin
|
||||
Inc(Index);
|
||||
Result:=Paramstr(Index);
|
||||
end
|
||||
else
|
||||
Error(Format(SErrNeedArgument,[Index,ParamStr(Index)]));
|
||||
end
|
||||
else If length(ParamStr(Index))>2 then
|
||||
begin
|
||||
P:=Pos('=',Paramstr(Index));
|
||||
If (P=0) then
|
||||
Error(Format(SErrNeedArgument,[Index,ParamStr(Index)]))
|
||||
else
|
||||
begin
|
||||
Result:=Paramstr(Index);
|
||||
Delete(Result,1,P);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Var
|
||||
PN : String;
|
||||
I : Integer;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
FInputFileName:=GetOptionValue('i','input');
|
||||
FOutputFileName:=GetOptionValue('o','output');
|
||||
FPackageName:=GetOptionValue('p','package');
|
||||
I:=0;
|
||||
// We can't use the TCustomApplication option handling,
|
||||
// because they cannot handle [general opts] [command] [cmd-opts] [args]
|
||||
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
|
||||
begin
|
||||
Usage(0);
|
||||
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);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
if (FOutputFileName='') then
|
||||
FOutputFileName:=FInputFileName;
|
||||
FDirectory:=GetOptionValue('d','directory');
|
||||
FMask:=GetOptionValue('m','mask');
|
||||
FRecurse:=HasOption('r','recurse');
|
||||
if HasOption('h','help') then
|
||||
Usage(0);
|
||||
If (FOutputFileName='') then
|
||||
Error('Need an output filename');
|
||||
if (FPackageName='') then
|
||||
Error('Need a package name');
|
||||
if (FCmd='') then
|
||||
Error('Need a command');
|
||||
end;
|
||||
|
||||
Procedure TManageFPDocProjectApplication.AddFilesFromDirectory(ADirectory,AMask : String; ARecurse : Boolean);
|
||||
procedure TManageFPDocProjectApplication.Error(Const Msg: String);
|
||||
begin
|
||||
Writeln('Error : ',Msg);
|
||||
Usage(1);
|
||||
end;
|
||||
|
||||
|
||||
Function TManageFPDocProjectApplication.CheckCmdOption(C : Char; S : String) : Boolean;
|
||||
|
||||
Var
|
||||
Info : TSearchRec;
|
||||
D : String;
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
if (AMask='') then
|
||||
AMask:='*.xml';
|
||||
D:=ADirectory;
|
||||
if (D<>'') then
|
||||
D:=includeTrailingPathDelimiter(D);
|
||||
If FindFirst(D+AMask,0,info)=0 then
|
||||
try
|
||||
Repeat
|
||||
if ((Info.Attr and faDirectory)=0) then
|
||||
FPackage.Descriptions.add(D+Info.Name);
|
||||
Until (FindNext(Info)<>0);
|
||||
finally
|
||||
FindClose(Info);
|
||||
end;
|
||||
If ARecurse and (FindFirst(ADirectory+AMask,0,info)=0) then
|
||||
try
|
||||
Repeat
|
||||
if ((Info.Attr and faDirectory)<>0) then
|
||||
AddFilesFromDirectory(IncludeTrailingPathDelimiter(D+Info.Name),AMask,ARecurse);
|
||||
Until (FindNext(Info)<>0);
|
||||
finally
|
||||
FindClose(Info);
|
||||
I:=0;
|
||||
Result:=False;
|
||||
While (Not Result) and (I<FCmdOptions.Count) do
|
||||
begin
|
||||
Result:=CheckOptionStr(FCmdOptions[i],C,S);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.ReadOptionFile(Const AFileName : String);
|
||||
Function TManageFPDocProjectApplication.GetCmdOption(C : Char; S : String) : String;
|
||||
|
||||
Var
|
||||
I,P : integer;
|
||||
B : Boolean;
|
||||
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
LoadOptionsFromFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
I:=0;
|
||||
B:=False;
|
||||
While (Not B) and (I<FCmdOptions.Count) do
|
||||
begin
|
||||
B:=CheckOptionStr(FCmdOptions[i],C,S);
|
||||
if B then
|
||||
begin
|
||||
Result:=FCmdArgs[I];
|
||||
if (Length(S)>1) and (S[2]<>'-') then
|
||||
begin
|
||||
If I<FCmdArgs.Count-1 then
|
||||
begin
|
||||
Inc(I);
|
||||
Result:=FCmdArgs[I];
|
||||
end
|
||||
else
|
||||
Error(Format(SErrNeedArgument,[I,Result]));
|
||||
end
|
||||
else If length(Result)>2 then
|
||||
begin
|
||||
P:=Pos('=',Result);
|
||||
If (P=0) then
|
||||
Error(Format(SErrNeedArgument,[I,Result]))
|
||||
else
|
||||
Delete(Result,1,P);
|
||||
end;
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.WriteOptionFile(Const AFileName : String);
|
||||
procedure TManageFPDocProjectApplication.AddDescriptionDirs;
|
||||
|
||||
Var
|
||||
Recursive: Boolean;
|
||||
Mask : String;
|
||||
I : Integer;
|
||||
begin
|
||||
Recursive:=CheckCmdOption('r','recursive');
|
||||
Mask:=GetCmdOption('m','mask');
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddDescrFilesFromDirectory(FCmdArgs[i],Mask,Recursive);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddInputDirs;
|
||||
|
||||
Var
|
||||
Recursive: Boolean;
|
||||
Options,Mask : String;
|
||||
I : Integer;
|
||||
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);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddInputFiles;
|
||||
|
||||
Var
|
||||
Options : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
SaveOptionsToFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
Options:=GetCmdOption('o','options');
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddInputFile(FCmdArgs[i],Options);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.RemoveInputFiles;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.RemoveInputFile(FCmdArgs[i]);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.RemoveDescrFiles;
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.RemoveDescrFile(FCmdArgs[i]);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.AddDescrFiles;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMGr.AddDescrFile(FCmdArgs[i]);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.SetOptions(Enable : Boolean);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FCmdArgs.Count-1 do
|
||||
FMgr.SetOption(FCmdArgs[i],Enable);
|
||||
end;
|
||||
|
||||
procedure TManageFPDocProjectApplication.DoRun;
|
||||
|
||||
begin
|
||||
ParseOptions;
|
||||
ReadOptionFile(FInputFileName);
|
||||
FPackage:=FProject.Packages.FindPackage(FPackageName);
|
||||
If (FDirectory<>'') or (FMask<>'') then
|
||||
AddFilesFromDirectory(FDirectory,FMask, FRecurse);
|
||||
WriteOptionFile(FOutputFileName);
|
||||
if (FInputFileName='') then
|
||||
FMGR.AddPackage(FPackageName)
|
||||
else
|
||||
begin
|
||||
if (FCmd='expand-macros') then
|
||||
FMGR.ReadOptionFile(FInputFileName)
|
||||
else
|
||||
FMGR.ReadOptionFile(FInputFileName,FCMdArgs);
|
||||
FMGR.SelectPackage(FPackageName);
|
||||
end;
|
||||
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
|
||||
AddDescrFiles
|
||||
else if (FCmd='remove-input-files') then
|
||||
RemoveInputFiles
|
||||
else if (FCmd='remove-descr-files') then
|
||||
RemoveDescrFiles
|
||||
else if (FCmd='set-options') then
|
||||
SetOptions(True)
|
||||
else if (FCmd='unset-options') then
|
||||
SetOptions(False)
|
||||
else if (FCMd<>'expand-macros') then
|
||||
Error(Format('Unknown command : "%s"',[FCmd]));
|
||||
FMgr.WriteOptionFile(FOutputFileName);
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
@ -127,7 +315,17 @@ constructor TManageFPDocProjectApplication.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
FProject:=TFPDocProject.Create(Self);
|
||||
FCmdArgs:=TStringList.Create;
|
||||
FCmdOptions:=TStringList.Create;
|
||||
FMGR:=TFPDocProjectManager.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TManageFPDocProjectApplication.Destroy;
|
||||
begin
|
||||
FreeAndNil(FMGR);
|
||||
FreeAndNil(FCmdArgs);
|
||||
FreeAndNil(FCmdOptions);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user