diff --git a/.gitattributes b/.gitattributes
index 40eddc7305..ce5e56c574 100644
--- a/.gitattributes
+++ b/.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
diff --git a/examples/fpdocmanager/FPDocManager.lpi b/examples/fpdocmanager/FPDocManager.lpi
index 5eee9270ac..358911447c 100644
--- a/examples/fpdocmanager/FPDocManager.lpi
+++ b/examples/fpdocmanager/FPDocManager.lpi
@@ -43,7 +43,7 @@
-
+
@@ -92,6 +92,11 @@
+
+
+
+
+
@@ -120,7 +125,7 @@
-
+
@@ -130,6 +135,9 @@
+
+
+
diff --git a/examples/fpdocmanager/FPDocManager.lpr b/examples/fpdocmanager/FPDocManager.lpr
index e64d2be788..9eb16b5840 100644
--- a/examples/fpdocmanager/FPDocManager.lpr
+++ b/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}
diff --git a/examples/fpdocmanager/configfile.pas b/examples/fpdocmanager/configfile.pas
new file mode 100644
index 0000000000..b42764372d
--- /dev/null
+++ b/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.
+
diff --git a/examples/fpdocmanager/umakeskel.pas b/examples/fpdocmanager/umakeskel.pas
index 83f6e81e36..ebb0b5cf6f 100644
--- a/examples/fpdocmanager/umakeskel.pas
+++ b/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);
diff --git a/examples/fpdocmanager/umanager.pas b/examples/fpdocmanager/umanager.pas
index 898e4611b0..c9436625d9 100644
--- a/examples/fpdocmanager/umanager.pas
+++ b/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: = (multiple???)
- if Pos('=', AValue[0]) > 0 then
- FDescriptions.Assign(AValue) //clears previous content
- else //if AValue.Count > 0 then
- Import;
+ FDescriptions.Assign(AValue);
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,7 +415,10 @@ begin
APrj.DescrDir := DescrDir; //needed by Update
for i := 0 to Descriptions.Count - 1 do begin
s := Descriptions[i];
- pkg.Descriptions.Add(s);
+ if Pos('=', s) > 0 then
+ pkg.Descriptions.Add(Descriptions.ValueFromIndex[i])
+ else
+ pkg.Descriptions.Add(s);
end;
end;
//add Imports
@@ -516,8 +502,8 @@ begin
FDescrDir := Config.ReadString(SecDoc, 'descrdir', '');
Requires.CommaText := Config.ReadString(SecDoc, 'requires', '');
//units
- Config.ReadSectionValues('units', Units);
- Config.ReadSectionValues('descrs', Descriptions);
+ Config.ReadSection('units', Units);
+ 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); //=
+ Config.ReadSection(SecProjects, FPackages); //=
//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;