DocMgr: fixed problems with IniFiles

git-svn-id: trunk@34883 -

.gitattributes

@@ -3712,6 +3712,7 @@ examples/fpdocmanager/FPDocManager.lpi svneol=native#text/plain
 examples/fpdocmanager/FPDocManager.lpr svneol=native#text/plain
 examples/fpdocmanager/FilenameExtension.patch svneol=native#text/pascal
 examples/fpdocmanager/README.txt svneol=native#text/plain
+examples/fpdocmanager/configfile.pas svneol=native#text/pascal
 examples/fpdocmanager/docs/fconfig.xml svneol=native#text/plain
 examples/fpdocmanager/docs/flogview.xml svneol=native#text/plain
 examples/fpdocmanager/docs/fmain.xml svneol=native#text/plain

examples/fpdocmanager/FPDocManager.lpi

@@ -43,7 +43,7 @@
         <PackageName Value="LCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="8">
+    <Units Count="9">
       <Unit0>
         <Filename Value="FPDocManager.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -92,6 +92,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="uLpk"/>
       </Unit7>
+      <Unit8>
+        <Filename Value="configfile.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ConfigFile"/>
+      </Unit8>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -120,7 +125,7 @@
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
+    <Exceptions Count="4">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -130,6 +135,9 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="EStringListError"/>
+      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>

examples/fpdocmanager/FPDocManager.lpr

@@ -8,7 +8,7 @@ uses
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
   Forms, umakeskel, fMain, fConfig, uManager, fLogView,
-  fUpdateView, ulpk;
+  fUpdateView, ulpk, ConfigFile;
 
 {$R *.res}
 

examples/fpdocmanager/configfile.pas

@@ -0,0 +1,222 @@
+unit ConfigFile;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+type
+
+  { TConfigFile }
+
+  TConfigFile = class
+  private
+    FDirty: Boolean;
+    FFileName: string;
+    FSections: TStringList;
+    procedure LoadFromFile;
+    function  AddSection(s: string): TStringList;
+  public
+    constructor Create(const AFileName: string);
+    destructor Destroy; override;
+    function  ReadString(const Section, Ident, Default: string): string;
+    procedure WriteString(const Section, Ident, Value: String);
+    function  ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
+    procedure WriteBool(const Section, Ident: string; Value: Boolean);
+    procedure ReadSection(const Section: string; Strings: TStrings);
+    procedure WriteSection(const Section: string; Strings: TStrings);
+    procedure WriteSectionValues(const Section: string; Strings: TStrings);
+    function  FindSection(Section: string): TStringList;
+    function  SectionExists(const Section: string): Boolean;
+    procedure Flush;
+    property Dirty : Boolean Read FDirty;
+    property FileName: string read FFileName;
+    property Sections: TStringList read FSections;
+  end;
+
+implementation
+
+{ TConfigFile }
+
+constructor TConfigFile.Create(const AFileName: string);
+begin
+  FSections := TStringList.Create;
+  FSections.OwnsObjects := True;
+  if AFileName = '' then
+    exit; //nothing to do
+  FFileName:=AFileName;
+  LoadFromFile;
+end;
+
+destructor TConfigFile.Destroy;
+begin
+  Flush;
+  FreeAndNil(FSections); //recursive!
+  inherited Destroy;
+end;
+
+procedure TConfigFile.LoadFromFile;
+var
+  lst, sec: TStringList;
+  s: string;
+  i: integer;
+begin
+  if (FFileName = '') or not FileExists(FFileName) then
+    exit; //nothing to load
+  lst := TStringList.Create;
+  lst.LoadFromFile(FFileName);
+  sec := nil;
+  for i := 0 to lst.Count - 1 do begin
+    s := lst[i];
+    if s = '' then
+      continue;
+    if s[1] = '[' then
+      sec := AddSection(s)
+    else
+      sec.Add(s);
+  end;
+  lst.Free;
+  FDirty:=False; //in case it was set during initialization
+end;
+
+function TConfigFile.FindSection(Section: string): TStringList;
+var
+  i: integer;
+begin
+  Result := nil;
+  if Section = '' then
+    exit;
+  if Section[1] = '[' then
+    Section := Copy(Section, 2, Length(Section)-2); //strip []
+  i := FSections.IndexOf(Section);
+  if i >= 0 then
+    TObject(Result) := FSections.Objects[i];
+end;
+
+function TConfigFile.SectionExists(const Section: string): Boolean;
+begin
+  Result := FindSection(Section) <> nil;
+end;
+
+function TConfigFile.AddSection(s: string): TStringList;
+var
+  i: integer;
+begin
+  Result := nil;
+  if s = '' then
+    exit;
+  if s[1] = '[' then
+    s := Copy(s, 2, Length(s)-2);
+  i := FSections.IndexOf(s);
+  if i < 0 then begin
+    Result := TStringList.Create;
+    FSections.AddObject(s, Result);
+    FDirty:=True;
+  end else
+    TObject(Result) := FSections.Objects[i];
+end;
+
+function TConfigFile.ReadString(const Section, Ident, Default: string): string;
+var
+  sec: TStringList;
+  i: integer;
+begin
+  sec := FindSection(Section);
+  if sec = nil then
+    exit(Default);
+  i := sec.IndexOfName(Ident);
+  if i < 0 then
+    Result := Default
+  else
+    Result := sec.ValueFromIndex[i];
+end;
+
+procedure TConfigFile.WriteString(const Section, Ident, Value: String);
+var
+  sec: TStringList;
+  i: integer;
+  s: string;
+begin
+  if (Ident = '') {or (Value = '')} then
+    exit; //invalid Ident
+  sec := AddSection(Section);
+  s := Ident + '=' + Value;
+  i := sec.IndexOf(s);
+  if i >= 0 then
+    exit; //already stored
+  i := sec.IndexOfName(ident);
+  if i < 0 then
+    sec.Add(s)
+  else
+    sec.Strings[i] := s;
+  FDirty:=True;
+end;
+
+function TConfigFile.ReadBool(const Section, Ident: string; Default: Boolean
+  ): Boolean;
+var
+  s: string;
+begin
+  s := ReadString(Section, Ident, '');
+  if s = '' then
+    Result := Default
+  else
+    Result := s <> '0';
+end;
+
+procedure TConfigFile.WriteBool(const Section, Ident: string; Value: Boolean);
+const
+  aValues: array[boolean] of string = ('0', '1');
+begin
+  WriteString(Section, Ident, aValues[Value]);
+end;
+
+procedure TConfigFile.ReadSection(const Section: string; Strings: TStrings);
+var
+  sec: TStringList;
+begin
+  Strings.Clear;
+  sec := FindSection(Section);
+  if sec <> nil then
+    Strings.Assign(sec);
+end;
+
+procedure TConfigFile.WriteSection(const Section: string; Strings: TStrings);
+var
+  sec: TStringList;
+begin
+  sec := AddSection(Section);
+  sec.Assign(Strings);
+  FDirty:=True; //optimize?
+end;
+
+procedure TConfigFile.WriteSectionValues(const Section: string;
+  Strings: TStrings);
+begin
+  WriteSection(Section, Strings);
+end;
+
+procedure TConfigFile.Flush;
+var
+  lst, sec: TStringList;
+  i: integer;
+  s: string;
+begin
+  if (not FDirty) or (FFileName = '') then
+    exit;
+  lst := TStringList.Create;
+  for i := 0 to FSections.Count - 1 do begin
+    s := FSections[i];
+    TObject(sec) := FSections.Objects[i];
+    lst.Add('[' + s + ']');
+    lst.AddStrings(sec);
+  end;
+  lst.SaveToFile(FFileName);
+  lst.Free;
+  FDirty:=False;
+end;
+
+end.
+

examples/fpdocmanager/umakeskel.pas

@@ -49,10 +49,14 @@ interface
 {$mode objfpc}
 {$h+}
 
+{$IF FPC_FULLVERSION<20701}
+  {.$ERROR requires FPC 2.7.1 at least}
+{$ENDIF}
+
 uses
   SysUtils, Classes, Gettext,
   dGlobals, PasTree, PParser,PScanner,
-  IniFiles,
+  ConfigFile,
   mkfpdoc, fpdocproj;
 
 resourcestring
@@ -73,18 +77,6 @@ resourcestring
 type
   TCmdLineAction = (actionHelp, actionConvert);
 
-(* Extended INI file
-*)
-
-  { TConfigFile }
-
-  TConfigFile = class(TIniFile)
-  public
-    function IsDirty: boolean;
-    procedure Flush;
-    procedure WriteSectionValues(const Section: string; Strings: TStrings);
-  end;
-
 (* EngineOptions plus MakeSkel options.
   Used in the commandline parsers, passed to the Engine.
   Project.Options are ignored by TFDocMaker.(?)
@@ -315,32 +307,6 @@ type
     Property DocNode : TDocNode Read FNode;
   end;
 
-{ TConfigFile }
-
-function TConfigFile.IsDirty: boolean;
-begin
-  Result := Dirty;
-end;
-
-procedure TConfigFile.Flush;
-begin
-  if Dirty then
-    UpdateFile; //only if dirty
-end;
-
-procedure TConfigFile.WriteSectionValues(const Section: string; Strings: TStrings);
-var
-  i: integer;
-begin
-//add missing: write Strings as a section
-  if (Strings = nil) or (Strings.Count = 0) then
-    exit; //nothing to write
-  for i := 0 to Strings.Count - 1 do begin
-    WriteString(Section, Strings.Names[i], Strings.ValueFromIndex[i]);
-    //WriteString(Section, Strings[i], ''); //???
-  end;
-end;
-
 { TCmdOptions }
 
 procedure TCmdOptions.Assign(Source: TPersistent);

examples/fpdocmanager/umanager.pas

@@ -45,7 +45,7 @@ interface
 
 uses
   Classes, SysUtils,
-  umakeskel, fpdocproj, dw_HTML;
+  umakeskel, ConfigFile, fpdocproj, dw_HTML;
 
 type
   TFPDocHelper = class;
@@ -124,7 +124,7 @@ type
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function  BeginTest(APkg: TDocPackage): boolean;
-    function  BeginTest(const AFile : string): boolean;
+    function  BeginTest(ADir: string): boolean;
     procedure EndTest;
     function  CmdToPrj(const AFileName: string): boolean;
     function  TestRun(APkg: TDocPackage; AUnit: string): boolean;
@@ -162,7 +162,7 @@ type
   protected
     Helper: TFPDocHelper; //temporary
     procedure Changed;
-    function  BeginTest(const AFile: string): boolean;
+    function  BeginTest(const ADir: string): boolean;
     procedure EndTest;
     function  RegisterPackage(APkg: TDocPackage): integer;
     Procedure DoLog(Const Msg : String);
@@ -234,28 +234,11 @@ end;
 procedure TDocPackage.SetDescriptions(AValue: TStrings);
 (* Shall we allow for multiple descriptions? (general + OS specific!?)
 *)
-
-  procedure Import;
-  var
-    i: integer;
-    s: string;
-  begin
-    FDescriptions.Clear; //assume full replace
-    for i := 0 to AValue.Count - 1 do begin
-      s := AValue[i]; //filespec
-      FDescriptions.Add(ExtractUnitName(s) + '=' + s);
-    end;
-  end;
-
 begin
   if FDescriptions=AValue then Exit;
   if AValue = nil then exit; //clear?
   if AValue.Count = 0 then exit;
-//import formatted: <unit>=<descr file> (multiple???)
+  FDescriptions.Assign(AValue);
-  if Pos('=', AValue[0]) > 0 then
-    FDescriptions.Assign(AValue) //clears previous content
-  else //if AValue.Count > 0 then
-    Import;
 end;
 
 (* Requires[] only contain package names.
@@ -365,7 +348,7 @@ begin
 //really do more?
   if FProjectFile = '' then
     exit;
-  FProjectDir:=ExtractFilePath(FProjectFile);
+  ProjectDir:=ExtractFilePath(FProjectFile);
   if ExtractFileExt(FProjectFile) <> '.xml' then
     ; //really change here???
   //import requires fpdocproject - must be created by Manager!
@@ -432,6 +415,9 @@ begin
     APrj.DescrDir := DescrDir; //needed by Update
     for i := 0 to Descriptions.Count - 1 do begin
       s := Descriptions[i];
+      if Pos('=', s) > 0 then
+        pkg.Descriptions.Add(Descriptions.ValueFromIndex[i])
+      else
         pkg.Descriptions.Add(s);
     end;
   end;
@@ -516,8 +502,8 @@ begin
   FDescrDir := Config.ReadString(SecDoc, 'descrdir', '');
   Requires.CommaText := Config.ReadString(SecDoc, 'requires', '');
 //units
-  Config.ReadSectionValues('units', Units);
+  Config.ReadSection('units', Units);
-  Config.ReadSectionValues('descrs', Descriptions);
+  Config.ReadSection('descrs', Descriptions);
 //more?
 //all done
   Loaded := True;
@@ -541,6 +527,8 @@ begin
   Config.WriteSectionValues('units', Units);
   Config.WriteSectionValues('descrs', Descriptions);
 //all done
+  Config.Flush;
+  //Config.UpdateFile; //not dirty???
   Loaded := True;
 end;
 
@@ -642,12 +630,12 @@ begin
     FOnChange(self);
 end;
 
-function TFPDocManager.BeginTest(const AFile: string): boolean;
+function TFPDocManager.BeginTest(const ADir: string): boolean;
 begin
   Helper.Free; //should have been done
   Helper := TFPDocHelper.Create(nil);
   Helper.OnLog := OnLog;
-  Result := Helper.BeginTest(AFile);
+  Result := Helper.BeginTest(ADir);
   if Result then
     Helper.CmdOptions := Options; //set reference AND propagate!?
 end;
@@ -697,13 +685,13 @@ begin
     //clear packages???
   end;
   Config := TConfigFile.Create(cf);
-  Config.CacheUpdates := True;
+  //Config.CacheUpdates := True;
   if not Result then
     exit; //nothing to read
 //read directories
   FFPDocDir := Config.ReadString(SecGen, 'fpc', '');
 //read packages
-  Config.ReadSectionValues(SecProjects, FPackages); //<prj>=<file>
+  Config.ReadSection(SecProjects, FPackages); //<prj>=<file>
 //read detailed package information - possibly multiple packages per project!
   BeginUpdate;  //turn of app notification!
   for i := 0 to Packages.Count - 1 do begin
@@ -899,12 +887,13 @@ var
   pkg: TDocPackage;
 begin
   Result := False;
-  BeginTest(AFile);
+  BeginTest(AFile); //directory!!!
   try
     Result := Helper.CmdToPrj(AFile);
     if not Result then
       exit;
     pkg := AddPackage(Helper.SelectedPackage.Name); //create [and register]
+    pkg.Loaded := False; //force reload
     if not pkg.Loaded then begin
       Result := pkg.ImportProject(Helper, Helper.Package, AFile);
     //register now, with project file known
@@ -920,7 +909,7 @@ end;
 function TFPDocManager.MakeDoc(APkg: TDocPackage; const AUnit, AOutput: string): boolean;
 begin
   Result := assigned(APkg)
-  and BeginTest(APkg.ProjectFile)
+  and BeginTest(APkg.ProjectDir)
   and APkg.CreateProject(Helper, ''); //only configure, don't create file
   if not Result then
     exit;
@@ -1003,13 +992,15 @@ begin
 //???
 end;
 
-function TFPDocHelper.BeginTest(const AFile: string): boolean;
+function TFPDocHelper.BeginTest(ADir: string): boolean;
 begin
-  Result := AFile <> '';
+  Result := ADir <> '';
   if not Result then
     exit;
 //remember dir!
-  ProjectDir:=ExtractFileDir(AFile);
+  if ExtractFileExt(ADir) <> '' then //todo: better check for directory!?
+    ADir := ExtractFileDir(ADir);
+  ProjectDir:=ADir;
   SetCurrentDir(ProjectDir);
 end;
 
@@ -1040,16 +1031,6 @@ begin
     w := GetNextWord(l);
     ParseFPDocOption(w);
   end;
-{
-  w := SelectedPackage.Name;
-  if w = '' then
-    exit; //no project name???
-  l := ChangeFileExt(AFileName, '_prj.xml'); //same directory!!!
-  //Result := CreateProject(l, Package);
-//now load the project into the manager
-  if Result then //add package/project to the manager?
-    Manager.AddProject(w, l); //.Packages.Add(w + '=' + l);
-}
   Result := True;
 end;