diff --git a/examples/fpdocmanager/FPDocManager.lpi b/examples/fpdocmanager/FPDocManager.lpi
index 737819fdf2..fa0cb2ba95 100644
--- a/examples/fpdocmanager/FPDocManager.lpi
+++ b/examples/fpdocmanager/FPDocManager.lpi
@@ -40,7 +40,7 @@
-
+
@@ -98,11 +98,6 @@
-
-
-
-
-
diff --git a/examples/fpdocmanager/FPDocManager.lpr b/examples/fpdocmanager/FPDocManager.lpr
index abe53dfb88..7301f4b7f2 100644
--- a/examples/fpdocmanager/FPDocManager.lpr
+++ b/examples/fpdocmanager/FPDocManager.lpr
@@ -7,7 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
- Forms, PParser, umakeskel, fMain, fConfig, uManager, fLogView,
+ Forms, umakeskel, fMain, fConfig, uManager, fLogView,
fUpdateView, ulpk, ConfigFile;
{$R *.res}
diff --git a/examples/fpdocmanager/docs/umanager.xml b/examples/fpdocmanager/docs/umanager.xml
index 9df74206c6..b3bc29671a 100644
--- a/examples/fpdocmanager/docs/umanager.xml
+++ b/examples/fpdocmanager/docs/umanager.xml
@@ -273,7 +273,7 @@
- Configures an engine for this project, optionally creates an project file.
+ Configures the engine (Helper) for this project, optionally creates an project file.
@@ -499,7 +499,7 @@
-
+ Counterpart for BeginTest. It does not reset the directory!
@@ -695,13 +695,13 @@
-
+ FPDoc project object, performs the currently requested task.
-
+ Checks Modified and eventually notifies the OnChange handler.
@@ -711,6 +711,7 @@
+ Creates an Helper, configures its Options.
@@ -722,7 +723,7 @@
-
+ Frees the helper, resets the current directory to the documentation RootDir.
@@ -736,7 +737,7 @@
-
+ Adds a package object to Packages, updates the Config.
@@ -744,7 +745,7 @@
-
+ Output a message using the OnLog handler.
@@ -812,7 +813,7 @@
- Dummy procedure for now, should flush an Dirty INI file.
+ Flush pending Config changes.
@@ -1019,7 +1020,7 @@
File to use for output options (FPDoc).
- FPC root directory, used to find source files.
+ FPC source directory, used to find source files.
All documentation options.
@@ -1034,7 +1035,49 @@
Create documentation for AUnit or the entire package.
- Add Lazarus description directory to RTL/FCL.
+ Add Lazarus description directory to the given package (RTL/FCL).
+ The directory is assumed to be $Lazarus/docs/xml/AName.
+The related source files must be part of the package, or must be added explicitly (see UpdateFCL).
+
+
+ Additional descriptor directory, relative Lazarus directory.
+ The XML files in this directory are added to the package in CreateProject. Override this method to also add the related input files to the project (see TFCLDocPackage.CreateProject).
+
+
+ Creates the documentation, for AUnit or the entire package.
+
+
+ Selects the FPDoc backend profile.
+
+
+ Checks for an additional description directory, returns package.AltDir
+
+
+ Adds (or removes) the Lazarus FCL descriptions to the FCL package.
+ The remaining work is done in the dedicated FCL package class.
+
+
+ Specialized package class for the FCL documentation.
+
+
+ Configures the Helper object, including the added Lazarus FCL descriptions and related FCL input files.
+ The FCL source files reside in a number of directories ($fpc/packages/pkg/src), not all of them are part of the official FCL documentation package.
+
+This method searches the units for the given description files and adds them to the fpdoc input files. When compiler options must be added, this has to be done explicitly (here).
+
+
+
+ Adjusts directory separators to the current DirectorySeparator.
+
+
+ Adds the names of all subdirectories of ARoot to AList.
+
+
+ Adds the filenames (without extension) specified by AMask (dir+mask) to AList. Used to collect XML description files.
+
+
+ Searches for source files in ADir, which match an unit name in AList, and returns -1 if none matches.
+ Used to find input files for description files. The Result is not very useful, because the matched entry is removed from AList.
diff --git a/examples/fpdocmanager/ulpk.pp b/examples/fpdocmanager/ulpk.pp
index 2bf6c3b735..ed99b32fa9 100644
--- a/examples/fpdocmanager/ulpk.pp
+++ b/examples/fpdocmanager/ulpk.pp
@@ -1,14 +1,20 @@
unit uLpk;
(* Convert LPK package into FPDoc project/package.
Relevant entries:
- //here: rename into LCL
+
+ //here: rename into LCL - packages ONLY!
+or
+
+
+
//-Fi
//-Fu
???
//Item1..Item291
//ignore .inc etc.
-
+
+
//required
*)
@@ -22,25 +28,28 @@ uses
function ImportLpk(const AFile: string): TDocPackage;
+var
+ PkgName: string;
+
implementation
uses
umakeskel;
type
- eKey = (kvEof, kvName, kvIncl, kvOther, kvFilename, kvDocPaths, kvReq, kvTitle
+ eKey = (kvEof, kvName, kvIncl, kvOther, kvFilename, kvLazDoc, kvReq
);
const
aKey: array[eKey] of string = (
'', 'Name', 'IncludeFiles', 'OtherUnitFiles',
- 'Filename', 'LazDoc' ,'PackageName', 'Title'
+ 'Filename', 'LazDoc' ,'PackageName'
);
- FirstKeys = 'NIOFLPT';
+ FirstKeys = 'NIOFLP';
var
f: TextFile;
- ln, value, ext: string;
- lt, eq, q2: integer;
+ ln, skey, attr, value, ext: string;
+ lt, att, eq, q2: integer;
key: eKey;
function ImportCompiled(const LpkFile: string; APkg: TDocPackage): boolean;
@@ -102,39 +111,84 @@ begin
key := eKey(i);
if CompareText(Copy(ln, lt+1, Length(aKey[key])), aKey[key]) <> 0 then
continue; //diff. case in "FileName", "Filename"
- if key = kvTitle then
- key := kvName; //LPR
+ skey:=aKey[key]; //the real key
//check value
eq := Pos('=', ln);
if (eq <= lt) or (ln[eq+1] <> '"') then
continue;
+ {$IFDEF SingleAttributeOnly}
q2 := Length(ln) - 2;
if ln[q2] <> '"' then
continue;
value:=Copy(ln, eq+2, q2-eq-2);
+ {$ELSE}
+ //extract attribute
+ att := lt+Length(skey)+2;
+ attr := Copy(ln, att, eq-att);
+ value := Copy(ln, eq+2, Length(ln));
+ q2 := Pos('"', value);
+ if q2 < 1 then
+ continue; //???
+ ln := Copy(value, q2+2, Length(value)); //to be parsed next
+ SetLength(value, q2-1);
+ {$ENDIF}
exit(True);
end;
Result := False;
end;
+function NextAttr: boolean;
+begin
+ //ln := Copy(ln, q2+2, Length(ln)); //now contains remaining attributes
+ eq := Pos('=', ln);
+ Result := eq > 1;
+ if not Result then
+ exit;
+ attr := Copy(ln, 1, eq-1);
+ value := Copy(ln, eq+2, Length(ln));
+ q2 := Pos('"', value);
+ if q2 < 1 then
+ exit(false);
+ ln := Copy(value, q2+2, Length(value)); //to be parsed next
+ SetLength(value, q2-1);
+end;
+
function ImportLpk(const AFile: string): TDocPackage;
var
pkg: TDocPackage;
dir: string;
begin
+ PkgName := LowerCase(ChangeFileExt(ExtractFileName(AFile), ''));
Result := Nil; // False; //assume fail
AssignFile(f, AFile);
Reset(f);
try
//read lines
//get Name
- if not GetLine or (key <> kvName) then
+ if not GetLine then
exit; //missing package name
- //fix case and LCLBase
- value := LowerCase(value);
- if value = 'lclbase' then
- value := 'lcl';
- pkg := Manager.AddPackage(value);
+ if key = kvName then begin
+ //lpk
+ //fix case and LCLBase
+ PkgName := LowerCase(value);
+ if PkgName = 'lclbase' then
+ PkgName:='lcl';
+ pkg := Manager.AddPackage(PkgName);
+ end else if key = kvLazDoc then begin
+ //lpi
+ if attr = 'Paths' then begin
+ //pkg.DescrDir := value;
+ dir := value;
+ if not NextAttr then
+ exit;
+ end;
+ if attr <> 'PackageName' then
+ exit;
+ PkgName := LowerCase(value);
+ pkg := Manager.AddPackage(PkgName);
+ pkg.DescrDir := dir;
+ end else
+ exit; //need pkg Name or PackageName
pkg.LazPkg := AFile;
dir := ExtractFilePath(AFile);
pkg.ProjectDir := dir; //ChDir on exec
@@ -153,7 +207,11 @@ begin
//pkg.Units.Add(value + '='); //!!! no dupes!? no options so far?
pkg.AddUnit(value);
end;
- kvDocPaths: pkg.DescrDir := value;
+ kvLazDoc: //followed by Path and/or PackageName (must be handled before!)
+ begin
+ if attr = 'Paths' then
+ pkg.DescrDir := value;
+ end;
kvReq: pkg.Requires.Add(LowerCase(value));
end;
end;
diff --git a/examples/fpdocmanager/umanager.pas b/examples/fpdocmanager/umanager.pas
index 4a1f5bde46..c23fab4713 100644
--- a/examples/fpdocmanager/umanager.pas
+++ b/examples/fpdocmanager/umanager.pas
@@ -219,6 +219,11 @@ type
var
Manager: TFPDocManager = nil; //init by application
+function FixPath(const s: string): string;
+procedure ListDirs(const ARoot: string; AList: TStrings);
+procedure ListUnits(const AMask: string; AList: TStrings);
+function MatchUnits(const ADir: string; AList: TStrings): integer;
+
implementation
uses
@@ -281,13 +286,10 @@ begin
Result := -1;
if FindFirst(ADir+DirectorySeparator+'*',faArchive,Info)=0 then begin
repeat
- //If (Attr and faDirectory) = faDirectory then
s := Info.Name;
ext := ExtractFileExt(s);
if (ext = '.pas') or (ext = '.pp') then begin
ext := ChangeFileExt(s, '');
- if ext='bmpcomn' then
- s := AList[0]; //full name!!!
Result := AList.IndexOf(ext); //ChangeFileExt(s, '.xml'));
if Result >= 0 then begin
AList.Delete(Result); //don't search any more
@@ -324,8 +326,6 @@ begin
//now match all files in the source dirs
for i := dirs.Count - 1 downto 0 do begin
d := s + dirs[i] + DirectorySeparator + 'src';
- if pos('fcl-image', d) > 0 then
- f := 'debug!';
if not DirectoryExists(d) then continue;
if MatchUnits(d, descs) >= 0 then begin
//add dir
@@ -334,10 +334,9 @@ begin
end;
//re-create project?
if AFile <> '' then begin
- f := ChangeFileExt(AFile, '_ext.xml');
- APrj.CreateProjectFile(f); //preserve unmodified project?
- end else
- APrj.CreateProjectFile(Manager.RootDir + 'fcl_ext.xml'); //preserve unmodified project?
+ f := ChangeFileExt(AFile, '_ext.xml'); //preserve unmodified project?
+ APrj.CreateProjectFile(f);
+ end; // else APrj.CreateProjectFile(Manager.RootDir + 'fcl_ext.xml'); //preserve unmodified project?
//finally
dirs.Free;
descs.Free;
@@ -365,6 +364,7 @@ end;
procedure TDocPackage.SetAltDir(AValue: string);
begin
+ AValue:=FixPath(AValue);
if FAltDir=AValue then Exit;
FAltDir:=AValue;
//we must signal config updated
@@ -708,7 +708,7 @@ destructor TFPDocManager.Destroy;
begin
SaveConfig;
FreeAndNil(Config);
- FPackages.Clear;
+ //FPackages.Clear; //destructor seems NOT to clear/destroy owned object!?
FreeAndNil(FPackages);
FreeAndNil(FOptions);
inherited Destroy;
@@ -736,10 +736,9 @@ var
begin
if LazarusDir = '' then exit;
s := {LazarusDir +} 'docs/xml/'+AName;
- if not DirectoryExists(LazarusDir + s) then
+ if not DirectoryExists(FixPath(LazarusDir + s)) then
exit;
- i := Packages.IndexOfName('rtl'); //???
- //i := Packages.IndexOf(AName);
+ i := Packages.IndexOfName(AName);
if i < 0 then
exit;
pkg := Packages.Objects[i] as TDocPackage;
@@ -760,7 +759,7 @@ begin
if pkg = nil then
exit(False);
if enabled then
- pkg.AltDir := {LazarusDir +} FixPath('docs/xml/fcl')
+ pkg.AltDir := 'docs/xml/fcl'
else
pkg.AltDir := '';
Result := True;
@@ -909,9 +908,6 @@ end;
function TFPDocManager.SaveConfig: boolean;
begin
-(* Protection against excessive saves requires a subclass of TIniFile,
- which flushes the file only if Dirty.
-*)
//Options? assume saved by application?
if Options.Modified then begin
Options.SaveConfig(Config, Profile);