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

git-svn-id: trunk@19724 -

utils/fpdoc/dglobals.pp

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

utils/fpdoc/fpdoc.lpi

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

utils/fpdoc/fpdoc.pp

@@ -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
+  SelectedPackage; // Will print error if none available.
-    begin
-    Writeln(SNeedPackageName);
-    Usage(1);
-    end;
 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;

utils/fpdoc/fpdocxmlopts.pas

@@ -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;
+procedure TXMLFPDocOptions.SaveToXML(AProject: TFPDocProject; ADoc: TXMLDocument);
-  const AFileName: String);
+
+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.