* Implemented project file writing functionality, based on patch from Hans-Peter Diettrich

git-svn-id: trunk@19724 -
This commit is contained in:
michael 2011-12-02 16:24:29 +00:00
parent 37abdd52df
commit e07646a653
4 changed files with 198 additions and 14 deletions

View File

@ -150,6 +150,8 @@ resourcestring
SUsageOption180 = '--mo-dir=dir Set directory where language files reside to dir';
SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too';
SUsageOption200 = '--dont-trim Don''t trim XML contents';
SUsageOption210 = '--write-project=file Do not write documentation, create project file instead';
SUsageFormats = 'The following output formats are supported by this fpdoc:';
SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';
SUsageFormatSpecific = 'Output format "%s" supports the following options:';

View File

@ -114,7 +114,7 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Version Value="11"/>
<Target>
<Filename Value="fpdoc"/>
</Target>

View File

@ -44,10 +44,12 @@ Type
FProject : TFPDocProject;
FProjectFile : Boolean;
FPackage : TFPDocPackage;
FWriteProjectFile : String;
Protected
procedure ParseCommandLine;
procedure Parseoption(const S: String);
Procedure Usage(AnExitCode : Byte);
Procedure CreateProjectFile(Const AFileName : String);
procedure CreateDocumentation(APackage : TFPDocPackage; Options : TEngineOptions);
Procedure DoRun; override;
Public
@ -88,6 +90,7 @@ begin
Writeln(SUsageOption180);
Writeln(SUsageOption190);
Writeln(SUsageOption200);
Writeln(SUsageOption210);
L:=TStringList.Create;
Try
Backend:=FProject.OPtions.Backend;
@ -123,6 +126,16 @@ begin
Halt(AnExitCode);
end;
procedure TFPDocAplication.CreateProjectFile(const AFileName: String);
begin
With TXMLFPDocOptions.Create(Self) do
try
SaveOptionsToFile(FProject,AFileName);
finally
Free;
end;
end;
destructor TFPDocAplication.Destroy;
begin
@ -188,11 +201,7 @@ begin
If Not (ProjectOpt(s) or PackageOpt(S)) then
ParseOption(s);
end;
if (FPackage=Nil) or (FPackage.Name='') then
begin
Writeln(SNeedPackageName);
Usage(1);
end;
SelectedPackage; // Will print error if none available.
end;
procedure TFPDocAplication.Parseoption(Const S : String);
@ -291,6 +300,8 @@ begin
FProject.Options.modir := Arg
else if Cmd = '--parse-impl' then
FProject.Options.InterfaceOnly:=false
else if Cmd = '--write-project' then
FWriteProjectFile:=Arg
else
begin
FProject.Options.BackendOptions.Add(Cmd);
@ -375,7 +386,10 @@ begin
WriteLn(SCopyright);
WriteLn;
ParseCommandLine;
CreateDocumentation(FPackage,FProject.Options);
if (FWriteProjectFile<>'') then
CreateProjectFile(FWriteProjectFile)
else
CreateDocumentation(FPackage,FProject.Options);
WriteLn(SDone);
Terminate;
end;

View File

@ -8,9 +8,6 @@ uses
Classes, SysUtils, fpdocproj, dom;
Type
{ TXMLFPocOptions }
{ TXMLFPDocOptions }
TXMLFPDocOptions = Class(TComponent)
@ -20,15 +17,21 @@ Type
Procedure LoadPackage(APackage : TFPDocPackage; E : TDOMElement); virtual;
Procedure LoadPackages(Packages : TFPDocPackages; E : TDOMElement);
Procedure LoadEngineOptions(Options : TEngineOptions; E : TDOMElement); virtual;
Procedure SaveEngineOptions(Options : TEngineOptions; 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 SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual;
Public
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;
end;
EXMLFPdoc = Class(Exception);
implementation
Uses XMLRead;
Uses XMLRead, XMLWrite;
Resourcestring
SErrInvalidRootNode = 'Invalid options root node: Got "%s", expected "docproject"';
@ -36,6 +39,9 @@ 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;
@ -97,7 +103,7 @@ Var
begin
APackage.Name:=E['name'];
APackage.output:=E['output'];
APackage.ContentFile:=E['contentfile'];
APackage.ContentFile:=E['content'];
N:=E.FirstChild;
While (N<>Nil) do
begin
@ -197,8 +203,155 @@ begin
end;
end;
procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject;
const AFileName: String);
procedure TXMLFPDocOptions.SaveToXML(AProject: TFPDocProject; ADoc: TXMLDocument);
var
i: integer;
E,PE: TDOMElement;
begin
E:=ADoc.CreateElement('docproject');
ADoc.AppendChild(E);
E:=ADoc.CreateElement('options');
ADoc.DocumentElement.AppendChild(E);
SaveEngineOptions(AProject.Options,ADoc,E);
E:=ADoc.CreateElement('packages');
ADoc.DocumentElement.AppendChild(E);
for i := 0 to AProject.Packages.Count - 1 do
begin
PE:=ADoc.CreateElement('package');
E.AppendChild(PE);
SavePackage(AProject.Packages[i],ADoc,PE);
end;
end;
Procedure TXMLFPDocOptions.SaveEngineOptions(Options : TEngineOptions; XML : TXMLDocument; AParent : TDOMElement);
procedure AddStr(const n, v: string);
var
E : TDOMElement;
begin
if (v='') then
Exit;
E:=XML.CreateElement('option');
AParent.AppendChild(E);
E['name'] := n;
E['value'] := v;
end;
procedure AddBool(const AName: string; B: Boolean);
begin
if B then
AddStr(Aname,'true')
else
AddStr(Aname,'false');
end;
var
i: integer;
n: string;
begin
AddStr('ostarget', Options.OSTarget);
AddStr('cputarget', Options.CPUTarget);
AddStr('mo-dir', Options.MoDir);
AddStr('format', Options.Backend);
AddStr('language', Options.Language);
AddStr('package', Options.DefaultPackageName);
AddBool('hide-protected', Options.HideProtected);
AddBool('warn-no-node', Options.WarnNoNode);
AddBool('show-private', Options.ShowPrivate);
AddBool('stop-on-parser-error', Options.StopOnParseError);
AddBool('parse-impl', Options.InterfaceOnly);
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;
begin
S:=AInputFile;
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;
AParent['file']:=F;
AParent['options']:=O;
end;
Procedure TXMLFPDocOptions.SaveDescription(Const ADescription : String; XML : TXMLDocument; AParent: TDOMElement);
begin
AParent['file']:=ADescription;
end;
Procedure TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage; XML : TXMLDocument; AParent: TDOMElement);
var
i: integer;
E,PE : TDomElement;
begin
AParent['name']:=APackage.Name;
AParent['output']:=APackage.Output;
AParent['content']:=APackage.ContentFile;
// Units
PE:=XML.CreateElement('units');
AParent.AppendChild(PE);
for i:=0 to APackage.Inputs.Count-1 do
begin
E:=XML.CreateElement('unit');
PE.AppendChild(E);
SaveInputFile(APackage.Inputs[i],XML,E);
end;
// Descriptions
PE:=XML.CreateElement('descriptions');
AParent.AppendChild(PE);
for i:=0 to APackage.Descriptions.Count-1 do
begin
E:=XML.CreateElement('description');
PE.AppendChild(E);
SaveDescription(APackage.Descriptions[i],XML,E);
end;
end;
procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject; const AFileName: String);
Var
XML : TXMLDocument;
@ -232,5 +385,20 @@ begin
LoadEngineOptions(AProject.Options,N as TDOMElement);
end;
Procedure TXMLFPDocOptions.SaveOptionsToFile(AProject: TFPDocProject; const AFileName: String);
Var
XML : TXMLDocument;
begin
XML:=TXMLDocument.Create;
try
SaveToXML(AProject,XML);
WriteXMLFile(XML, AFileName);
finally
XML.Free;
end;
end;
end.