Ver código fonte

* Some fixes after first test round

git-svn-id: trunk@19735 -
michael 13 anos atrás
pai
commit
b09139a7c4

+ 3 - 72
utils/fpdoc/fpdocxmlopts.pas

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

+ 84 - 11
utils/fpdoc/mgrfpdocproj.pp

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

+ 1 - 0
utils/fpdoc/mkfpdocproj.lpi

@@ -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>

+ 68 - 34
utils/fpdoc/mkfpdocproj.pp

@@ -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