paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 10:00:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

DocMgr: updated Imports

Browse Source 
git-svn-id: trunk@35330 -
This commit is contained in:
dodi 2012-02-12 17:37:50 +00:00
parent 998b336ccb
commit 78ca2e4f3b
5 changed files with 142 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
examples/fpdocmanager/FPDocManager.lpi
View File

@ -40,7 +40,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="11">
<Units Count="10">
<Unit0>
<Filename Value="FPDocManager.lpr"/>
<IsPartOfProject Value="True"/>
@ -98,11 +98,6 @@
<Filename Value="text.txt"/>
<IsPartOfProject Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\fpc-trunk\packages\fcl-passrc\src\pparser.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PParser"/>
</Unit10>
</Units>
</ProjectOptions>
<CompilerOptions>

2
examples/fpdocmanager/FPDocManager.lpr
View File

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

63
examples/fpdocmanager/docs/umanager.xml
View File

@ -273,7 +273,7 @@
</element>
<!-- function Visibility: public -->
<element name="TDocPackage.CreateProject">
<short>Configures an engine for this project, optionally creates an project file.</short>
<short>Configures the engine (Helper) for this project, optionally creates an project file.</short>
<descr/>
<errors/>
<seealso/>
@ -499,7 +499,7 @@
</element>
<!-- procedure Visibility: public -->
<element name="TFPDocHelper.EndTest">
<short/>
<short>Counterpart for BeginTest. It does not reset the directory!</short>
<descr/>
<errors/>
<seealso/>
@ -695,13 +695,13 @@
</element>
<!-- variable Visibility: protected -->
<element name="TFPDocManager.Helper">
<short/>
<short>FPDoc project object, performs the currently requested task.</short>
<descr/>
<seealso/>
</element>
<!-- procedure Visibility: protected -->
<element name="TFPDocManager.Changed">
<short/>
<short>Checks Modified and eventually notifies the OnChange handler.</short>
<descr/>
<errors/>
<seealso/>
@ -711,6 +711,7 @@
<descr/>
<errors/>
<seealso/>
<short>Creates an Helper, configures its Options.</short>
</element>
<!-- function result Visibility: default -->
<element name="TFPDocManager.BeginTest.Result">
@ -722,7 +723,7 @@
</element>
<!-- procedure Visibility: protected -->
<element name="TFPDocManager.EndTest">
<short/>
<short>Frees the helper, resets the current directory to the documentation RootDir.</short>
<descr/>
<errors/>
<seealso/>
@ -736,7 +737,7 @@
</element>
<!-- function result Visibility: default -->
<element name="TFPDocManager.RegisterPackage.Result">
<short/>
<short>Adds a package object to Packages, updates the Config.</short>
</element>
<!-- argument Visibility: default -->
<element name="TFPDocManager.RegisterPackage.APkg">
@ -744,7 +745,7 @@
</element>
<!-- procedure Visibility: protected -->
<element name="TFPDocManager.DoLog">
<short/>
<short>Output a message using the OnLog handler.</short>
<descr/>
<errors/>
<seealso/>
@ -812,7 +813,7 @@
</element>
<!-- function Visibility: public -->
<element name="TFPDocManager.SaveConfig">
<short>Dummy procedure for now, should flush an Dirty INI file.</short>
<short>Flush pending Config changes.</short>
<descr/>
<errors/>
<seealso/>
@ -1019,7 +1020,7 @@
<short>File to use for output options (FPDoc).</short>
</element>
<element name="TFPDocManager.FpcDir">
<short>FPC root directory, used to find source files.</short>
<short>FPC source directory, used to find source files.</short>
</element>
<element name="TFPDocManager.Options">
<short>All documentation options.</short>
@ -1034,7 +1035,49 @@
<short>Create documentation for AUnit or the entire package.</short>
</element>
<element name="TFPDocManager.UpdatePackage">
<short>Add Lazarus description directory to RTL/FCL.</short>
<short>Add Lazarus description directory to the given package (RTL/FCL).</short>
<descr>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).</descr>
</element>
<element name="TDocPackage.AltDir">
<short>Additional descriptor directory, relative Lazarus directory.</short>
<descr>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).</descr>
</element>
<element name="TFPDocHelper.MakeDocs">
<short>Creates the documentation, for AUnit or the entire package.</short>
</element>
<element name="TFPDocManager.AddProfile">
<short>Selects the FPDoc backend profile.</short>
</element>
<element name="TFPDocManager.IsExtended">
<short>Checks for an additional description directory, returns package.AltDir</short>
</element>
<element name="TFPDocManager.UpdateFCL">
<short>Adds (or removes) the Lazarus FCL descriptions to the FCL package.</short>
<descr>The remaining work is done in the dedicated FCL package class.</descr>
</element>
<element name="TFCLDocPackage">
<short>Specialized package class for the FCL documentation.</short>
</element>
<element name="TFCLDocPackage.CreateProject">
<short>Configures the Helper object, including the added Lazarus FCL descriptions and related FCL input files.</short>
<descr>The FCL source files reside in a number of directories ($fpc/packages/<b>pkg</b>/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).
</descr>
</element>
<element name="FixPath">
<short>Adjusts directory separators to the current DirectorySeparator.</short>
</element>
<element name="ListDirs">
<short>Adds the names of all subdirectories of ARoot to AList.</short>
</element>
<element name="ListUnits">
<short>Adds the filenames (without extension) specified by AMask (dir+mask) to AList. Used to collect XML description files.</short>
</element>
<element name="MatchUnits">
<short>Searches for source files in ADir, which match an unit name in AList, and returns -1 if none matches.</short>
<descr>Used to find input files for description files. The Result is not very useful, because the matched entry is removed from AList.</descr>
</element>
</module>
<!-- uManager -->

90
examples/fpdocmanager/ulpk.pp
View File

@ -1,14 +1,20 @@
unit uLpk;
(* Convert LPK package into FPDoc project/package.
Relevant entries:
<Name Value="LCLBase"/> //here: rename into LCL
<Package Version=n/>
<Name Value="LCLBase"/> //here: rename into LCL - packages ONLY!
or
<ProjectOptions>
<MainUnit Values=n/>
<IncludeFiles Value="..."/> //-Fi
<OtherUnitFiles Value="forms;widgetset"/> //-Fu
<CustomOptions Value="$(IDEBuildOptions)"/> ???
<Files Count="291"> //Item1..Item291
<Filename Value="...pas"/> //ignore .inc etc.
<LazDoc Paths="../docs/xml/lcl"/>
<LazDoc Paths="docs" PackageName="LazDE"/>
<RequiredPkgs Count="1">
<RequiredPackages Count="1">
<PackageName Value="LazUtils"/> //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;

30
examples/fpdocmanager/umanager.pas
View File

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