paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 11:09:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Partially resolved ID 38141 : better handling of class hierarchy and cross-package links

Browse Source 
git-svn-id: trunk@47710 -
This commit is contained in:
michael 2020-12-07 11:55:51 +00:00
parent a7232669ff
commit 9fc390877e
9 changed files with 509 additions and 338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

265
utils/fpdoc/dglobals.pp
View File

@ -36,9 +36,12 @@ Var
resourcestring resourcestring
// Output strings // Output strings
SDocPackageTitle = 'Reference for package ''%s'''; SDocPackageTitle = 'Reference for package ''%s''';
SDocPackageMenuTitle = 'Package ''%s''';
SDocPackageLinkTitle = 'Package';
SDocPrograms = 'Programs'; SDocPrograms = 'Programs';
SDocUnits = 'Units'; SDocUnits = 'Units';
SDocUnitTitle = 'Reference for unit ''%s'''; SDocUnitTitle = 'Reference for unit ''%s''';
SDocUnitMenuTitle = 'Unit ''%s''';
SDocInheritanceHierarchy = 'Inheritance Hierarchy'; SDocInheritanceHierarchy = 'Inheritance Hierarchy';
SDocInterfaceSection = 'Interface section'; SDocInterfaceSection = 'Interface section';
SDocImplementationSection = 'Implementation section'; SDocImplementationSection = 'Implementation section';
@ -205,7 +208,9 @@ resourcestring
Const Const
SVisibility: array[TPasMemberVisibility] of string = SVisibility: array[TPasMemberVisibility] of string =
('Default', 'Private', 'Protected', 'Public', ('Default', 'Private', 'Protected', 'Public',
'Published', 'Automated','Strict Private','Strict Protected','Required','Optional'); 'Published', 'Automated','Strict Private','Strict Protected',
'Required', 'Optional' // ObjCClass
);
type type
TBufType = Array[1..ContentBufSize-1] of byte; TBufType = Array[1..ContentBufSize-1] of byte;
@ -319,9 +324,9 @@ type
FAlwaysVisible : TStringList; FAlwaysVisible : TStringList;
DescrDocs: TObjectList; // List of XML documents DescrDocs: TObjectList; // List of XML documents
DescrDocNames: TStringList; // Names of the XML documents DescrDocNames: TStringList; // Names of the XML documents
FRootLinkNode: TLinkNode; FRootLinkNode: TLinkNode; // Global tree of TlinkNode from the imported .xct files
FRootDocNode: TDocNode; FRootDocNode: TDocNode; // Global tree of TDocNode from the .xml documentation files
FPackages: TFPList; // List of TFPPackage objects FPackages: TFPList; // Global list of TPasPackage objects and full tree of sources
CurModule: TPasModule; CurModule: TPasModule;
CurPackageDocNode: TDocNode; CurPackageDocNode: TDocNode;
function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual; function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
@ -338,13 +343,16 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure SetPackageName(const APackageName: String); procedure SetPackageName(const APackageName: String);
// process the import objects from external .xct file
procedure ReadContentFile(const AFilename, ALinkPrefix: String); procedure ReadContentFile(const AFilename, ALinkPrefix: String);
// creation of an own .xct output file
procedure WriteContentFile(const AFilename: String); procedure WriteContentFile(const AFilename: String);
function CreateElement(AClass: TPTreeElement; const AName: String; function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility: TPasMemberVisibility; AParent: TPasElement; AVisibility: TPasMemberVisibility;
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
override; override;
function FindInModule(const AName: String ; AModule: TPasModule): TPasElement;
function FindElement(const AName: String): TPasElement; override; function FindElement(const AName: String): TPasElement; override;
function FindModule(const AName: String): TPasModule; override; function FindModule(const AName: String): TPasModule; override;
Function HintsToStr(Hints : TPasMemberHints) : String; Function HintsToStr(Hints : TPasMemberHints) : String;
@ -660,7 +668,9 @@ end;
procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String); procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
var var
f: Text; f: Text;
inheritanceinfo : TStringlist; inheritanceinfo : TStringlist; // contents list of TPasClass with inheritance info
// like this #PackageName.ModuleName.ClassName
tmpLinkPrefix : string;
procedure ReadLinkTree; procedure ReadLinkTree;
var var
@ -708,8 +718,10 @@ var
i := ThisSpaces + 1; i := ThisSpaces + 1;
while s[i] <> ' ' do while s[i] <> ' ' do
Inc(i); Inc(i);
if ALinkPrefix <> '' then
tmpLinkPrefix := ExcludeTrailingPathDelimiter(ALinkPrefix)+'/';
NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1), NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
ALinkPrefix + Copy(s, i + 1, Length(s))); tmpLinkPrefix + Copy(s, i + 1, Length(s)));
if pos(' ',newnode.link)>0 then if pos(' ',newnode.link)>0 then
writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"'); writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
if Assigned(PrevSibling) then if Assigned(PrevSibling) then
@ -721,56 +733,57 @@ var
end; end;
function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String; function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String;
var var
DotPos, DotPos2, i: Integer; DotPos, DotPos2, i: Integer;
s: String; s: String;
HPackage: TPasPackage; HPackage: TPasPackage;
begin
pkg:=nil; module:=nil; result:='';
// Find or create package
DotPos := Pos('.', AName);
s := Copy(AName, 1, DotPos - 1);
HPackage := nil;
for i := 0 to FPackages.Count - 1 do
if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
begin
HPackage := TPasPackage(FPackages[i]);
break;
end;
if not Assigned(HPackage) then
begin begin
pkg:=nil; module:=nil; result:=''; if not CreateNew then
exit;
HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
'', 0));
FPackages.Add(HPackage);
end;
// Find or create package // Find or create module
DotPos := Pos('.', AName); DotPos2 := DotPos;
s := Copy(AName, 1, DotPos - 1); repeat
HPackage := nil; Inc(DotPos2);
for i := 0 to FPackages.Count - 1 do until AName[DotPos2] = '.';
if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
begin Module := nil;
HPackage := TPasPackage(FPackages[i]); for i := 0 to HPackage.Modules.Count - 1 do
break; if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
end;
if not Assigned(HPackage) then
begin begin
if not CreateNew then Module := TPasModule(HPackage.Modules[i]);
exit; break;
HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
'', 0));
FPackages.Add(HPackage);
end; end;
if not Assigned(Module) then
// Find or create module begin
DotPos2 := DotPos; if not CreateNew then
repeat exit;
Inc(DotPos2); Module := TPasExternalModule.Create(s, HPackage);
until AName[DotPos2] = '.'; Module.InterfaceSection := TInterfaceSection.Create('', Module);
s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1); Module.PackageName:= HPackage.Name;
Module := nil; HPackage.Modules.Add(Module);
for i := 0 to HPackage.Modules.Count - 1 do end;
if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then pkg:=hpackage;
begin result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
Module := TPasModule(HPackage.Modules[i]);
break;
end;
if not Assigned(Module) then
begin
if not CreateNew then
exit;
Module := TPasExternalModule.Create(s, HPackage);
Module.InterfaceSection := TInterfaceSection.Create('', Module);
HPackage.Modules.Add(Module);
end;
pkg:=hpackage;
result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
end; end;
function SearchInList(clslist:TFPList;s:string):TPasElement; function SearchInList(clslist:TFPList;s:string):TPasElement;
@ -834,9 +847,9 @@ var
InheritanceInfo.AddObject(Inheritancestr,result); InheritanceInfo.AddObject(Inheritancestr,result);
end; end;
procedure splitalias(var instr:string;out outstr:string); procedure splitalias(var instr:string;out outstr:string);
var i,j:integer; var i,j:integer;
begin begin
if length(instr)=0 then exit; if length(instr)=0 then exit;
instr:=trim(instr); instr:=trim(instr);
i:=pos('(',instr); i:=pos('(',instr);
@ -848,10 +861,10 @@ var
outstr:=copy(instr,i+1,j); outstr:=copy(instr,i+1,j);
delete(instr,i,j+2); delete(instr,i,j+2);
end end
end; end;
Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType; Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
begin begin
result:=TPasClassType(ResolveClassType(clname)); result:=TPasClassType(ResolveClassType(clname));
if assigned(result) and not (cls=result) then // save from tobject=implicit tobject if assigned(result) and not (cls=result) then // save from tobject=implicit tobject
begin begin
@ -870,47 +883,47 @@ var
else else
if cls<>result then if cls<>result then
DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]); DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
end; end;
function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType; function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
// create alias clname = alname // create alias clname = alname
var var
pkg : TPasPackage; pkg : TPasPackage;
module : TPasModule; module : TPasModule;
s : string; s : string;
begin begin
Result:=nil; Result:=nil;
s:=ResolvePackageModule(Alname,pkg,module,True); s:=ResolvePackageModule(Alname,pkg,module,True);
if not assigned(module) then if not assigned(module) then
exit; exit;
cl2:=TPasClassType(ResolveClassType(alname)); cl2:=TPasClassType(ResolveClassType(alname));
if assigned( cl2) and not (parentclass=cl2) then if assigned( cl2) and not (parentclass=cl2) then
begin
result:=ResolveAliasType(clname);
if assigned(result) then
begin begin
// writeln('found alias ',clname,' (',s,') ',result.classname); result:=ResolveAliasType(clname);
if assigned(result) then
begin
// writeln('found alias ',clname,' (',s,') ',result.classname);
end
else
begin
// writeln('new alias ',clname,' (',s,') ');
cl2.addref;
Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
module.interfacesection.Declarations.Add(Result);
TPasAliasType(Result).DestType := cl2;
end
end end
else end;
begin
// writeln('new alias ',clname,' (',s,') ');
cl2.addref;
Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
module.interfacesection.Declarations.Add(Result);
TPasAliasType(Result).DestType := cl2;
end
end
end;
procedure ProcessInheritanceStrings(inhInfo:TStringList); procedure ProcessInheritanceStrings(inhInfo:TStringList);
var i,j : integer; var i,j : integer;
cls : TPasClassType; cls : TPasClassType;
cls2: TPasClassType; cls2: TPasClassType;
clname, clname,
alname : string; alname : string;
inhclass : TStringList; inhclass : TStringList;
begin begin
inhclass:=TStringList.Create; inhclass:=TStringList.Create;
inhclass.delimiter:=','; inhclass.delimiter:=',';
if InhInfo.Count>0 then if InhInfo.Count>0 then
@ -922,12 +935,12 @@ end;
for j:= 0 to inhclass.count-1 do for j:= 0 to inhclass.count-1 do
begin begin
//writeln('processing',inhclass[j]); // writeln('processing',inhclass[j]);
clname:=inhclass[j]; clname:=inhclass[j];
splitalias(clname,alname); splitalias(clname,alname);
if alname<>'' then // the class//interface we refered to is an alias if alname<>'' then // the class//interface we refered to is an alias
begin begin
// writeln('Found alias pair ',clname,' = ',alname); // writeln('Found alias pair ',clname,' = ',alname);
if not assigned(CreateAliasType(alname,clname,cls,cls2)) then if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
DoLog('Warning: creating alias %s for %s failed!',[alname,clname]); DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
end end
@ -936,7 +949,7 @@ end;
end; end;
end; end;
inhclass.free; inhclass.free;
end; end;
var var
s, Name: String; s, Name: String;
@ -993,10 +1006,10 @@ end;
CurClass.Members.Add(Member); CurClass.Members.Add(Member);
end; end;
end; end;
ProcessInheritanceStrings(Inheritanceinfo); ProcessInheritanceStrings(Inheritanceinfo);
finally finally
inheritanceinfo.Free; inheritanceinfo.Free;
end; end;
end; end;
var var
@ -1044,11 +1057,13 @@ var
end; end;
end; end;
function CheckImplicitInterfaceLink(const s : String):String; function CheckImplicitLink(const s : String):String;
begin begin
if uppercase(s)='IUNKNOWN' then if uppercase(s)='IUNKNOWN' then
Result:='#rtl.System.IUnknown' Result:='#rtl.System.IUnknown'
else else if uppercase(s)='TOBJECT' then
Result:='#rtl.System.TObject'
else
Result:=s; Result:=s;
end; end;
var var
@ -1096,13 +1111,13 @@ begin
ClassLikeDecl:=MemberDecl as TPasClassType ClassLikeDecl:=MemberDecl as TPasClassType
else else
ClassLikeDecl:=nil; ClassLikeDecl:=nil;
Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' '); Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' ');
if Assigned(ClassLikeDecl) then if Assigned(ClassLikeDecl) then
begin begin
if Assigned(ClassLikeDecl.AncestorType) then if Assigned(ClassLikeDecl.AncestorType) then
begin begin
// simple aliases to class types are coded as "alias(classtype)" // simple aliases to class types are coded as "alias(classtype)"
Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName)); Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName));
if ClassLikeDecl.AncestorType is TPasAliasType then if ClassLikeDecl.AncestorType is TPasAliasType then
begin begin
alias:= TPasAliasType(ClassLikeDecl.AncestorType); alias:= TPasAliasType(ClassLikeDecl.AncestorType);
@ -1118,12 +1133,12 @@ begin
begin begin
for k:=0 to ClassLikeDecl.Interfaces.count-1 do for k:=0 to ClassLikeDecl.Interfaces.count-1 do
begin begin
write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName)); write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
begin begin
alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]); alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
if assigned(alias.desttype) and (alias.desttype is TPasClassType) then if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')'); write(ContentFile,'(',CheckImplicitLink(alias.desttype.PathName),')');
end; end;
end; end;
end; end;
@ -1173,41 +1188,41 @@ begin
Result.SourceLinenumber := ASourceLinenumber; Result.SourceLinenumber := ASourceLinenumber;
end; end;
function TFPDocEngine.FindElement(const AName: String): TPasElement; function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule
) : TPasElement;
var
l: TFPList;
i: Integer;
function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement; begin
If Assigned(AModule) and Assigned(AModule.InterfaceSection) and
var Assigned(AModule.InterfaceSection.Declarations) then
l: TFPList; begin
i: Integer; l:=AModule.InterfaceSection.Declarations;
for i := 0 to l.Count - 1 do
begin
If assigned(AModule.InterfaceSection) and
Assigned(AModule.InterfaceSection.Declarations) then
begin begin
l:=AModule.InterfaceSection.Declarations; Result := TPasElement(l[i]);
for i := 0 to l.Count - 1 do if CompareText(Result.Name, AName) = 0 then
begin exit;
Result := TPasElement(l[i]); end;
if CompareText(Result.Name, LocalName) = 0 then end;
exit; Result := nil;
end; end;
end;
Result := nil; function TFPDocEngine.FindElement(const AName: String): TPasElement;
end;
var var
i: Integer; i: Integer;
Module: TPasElement; Module: TPasElement;
begin begin
Result := FindInModule(CurModule, AName); Result := FindInModule( AName, CurModule );
if not Assigned(Result) and assigned (CurModule.InterfaceSection) then if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
begin begin
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]); Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
if Module.ClassType.InheritsFrom(TPasModule) then if Module.ClassType.InheritsFrom(TPasModule) then
begin begin
Result := FindInModule(TPasModule(Module), AName); Result := FindInModule(AName, TPasModule(Module));
if Assigned(Result) then if Assigned(Result) then
exit; exit;
end; end;

326
utils/fpdoc/dw_html.pp
View File

@ -15,7 +15,7 @@
{$mode objfpc} {$mode objfpc}
{$H+} {$H+}
unit dw_HTML; unit dw_html;
{$WARN 5024 off : Parameter "$1" not used} {$WARN 5024 off : Parameter "$1" not used}
interface interface
@ -75,9 +75,7 @@ type
THTMLWriter = class(TFPDocWriter) THTMLWriter = class(TFPDocWriter)
private private
FImageFileList: TStrings; FImageFileList: TStrings;
FOnTest: TNotifyEvent; FOnTest: TNotifyEvent;
FPackage: TPasPackage;
FCharSet : String; FCharSet : String;
procedure CreateMinusImage; procedure CreateMinusImage;
procedure CreatePlusImage; procedure CreatePlusImage;
@ -233,7 +231,7 @@ type
procedure CreatePackagePageBody; procedure CreatePackagePageBody;
procedure CreatePackageIndex; procedure CreatePackageIndex;
procedure CreatePackageClassHierarchy; procedure CreatePackageClassHierarchy;
procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean); procedure CreateClassHierarchyPage(AddUnit : Boolean);
procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings); procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
Procedure CreateTopicPageBody(AElement : TTopicElement); Procedure CreateTopicPageBody(AElement : TTopicElement);
procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer); procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
@ -244,9 +242,9 @@ type
procedure CreateVarPageBody(AVar: TPasVariable); procedure CreateVarPageBody(AVar: TPasVariable);
procedure CreateProcPageBody(AProc: TPasProcedureBase); procedure CreateProcPageBody(AProc: TPasProcedureBase);
Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement); Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement); procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
public public
// Creating all module hierarchy classes is here !!!!
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override; constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
destructor Destroy; override; destructor Destroy; override;
@ -254,7 +252,7 @@ type
function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
// For producing complete package documentation // Start producing html complete package documentation
procedure WriteHTMLPages; virtual; procedure WriteHTMLPages; virtual;
procedure WriteXHTMLPages; procedure WriteXHTMLPages;
function ModuleForElement(AnElement:TPasElement):TPasModule; function ModuleForElement(AnElement:TPasElement):TPasModule;
@ -266,7 +264,7 @@ type
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override; Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
Property SearchPage: String Read FSearchPage Write FSearchPage; Property SearchPage: String Read FSearchPage Write FSearchPage;
property Allocator: TFileAllocator read FAllocator; property Allocator: TFileAllocator read FAllocator;
property Package: TPasPackage read FPackage;
property PageCount: Integer read GetPageCount; property PageCount: Integer read GetPageCount;
Property IncludeDateInFooter : Boolean Read FIDF Write FIDF; Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
Property DateFormat : String Read FDateFormat Write FDateFormat; Property DateFormat : String Read FDateFormat Write FDateFormat;
@ -326,13 +324,20 @@ function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: In
var var
n,s: String; n,s: String;
i: Integer; i: Integer;
excl: Boolean; //search
begin begin
Result:=''; Result:='';
excl := False;
if AElement.ClassType = TPasPackage then if AElement.ClassType = TPasPackage then
Result := 'index' begin
Result := 'index';
excl := True;
end
else if AElement.ClassType = TPasModule then else if AElement.ClassType = TPasModule then
Result := LowerCase(AElement.Name) + PathDelim + 'index' begin
Result := LowerCase(AElement.Name) + PathDelim + 'index';
excl := True;
end
else else
begin begin
if AElement is TPasOperator then if AElement is TPasOperator then
@ -361,8 +366,12 @@ begin
if (N<>'') and (N[1]=':') then if (N<>'') and (N[1]=':') then
Delete(N,1,1); Delete(N,1,1);
Result:=Result + '-'+ s + '-' + N; Result:=Result + '-'+ s + '-' + N;
end else end
else
begin
Result := LowerCase(AElement.PathName); Result := LowerCase(AElement.PathName);
excl := (ASubindex > 0);
end;
// searching for TPasModule - it is on the 2nd level // searching for TPasModule - it is on the 2nd level
if Assigned(AElement.Parent) then if Assigned(AElement.Parent) then
while Assigned(AElement.Parent.Parent) do while Assigned(AElement.Parent.Parent) do
@ -375,6 +384,14 @@ begin
Inc(i); Inc(i);
if (i <= Length(Result)) and (i > 0) then if (i <= Length(Result)) and (i > 0) then
Result[i] := PathDelim; Result[i] := PathDelim;
if excl or (Length(Result)=0) then
begin
// exclude the from full text search index
s:= '.'+ExtractFileName(Result + '.');
n:= ExtractFileDir(Result);
Result := n + DirectorySeparator + s;
Result := Copy(Result, 1, Length(Result)-1);
end;
end; end;
if ASubindex > 0 then if ASubindex > 0 then
@ -632,7 +649,7 @@ var
H : Boolean; H : Boolean;
begin begin
inherited ; inherited Create(APackage, AEngine);
// should default to true since this is the old behavior // should default to true since this is the old behavior
UseMenuBrackets:=True; UseMenuBrackets:=True;
@ -640,7 +657,6 @@ begin
IndexColCount:=3; IndexColCount:=3;
Charset:='iso-8859-1'; Charset:='iso-8859-1';
CreateAllocator; CreateAllocator;
FPackage := APackage;
OutputNodeStack := TList.Create; OutputNodeStack := TList.Create;
PageInfos := TObjectList.Create; PageInfos := TObjectList.Create;
@ -716,6 +732,7 @@ begin
HTMLEl.AppendChild(BodyElement); HTMLEl.AppendChild(BodyElement);
CreatePageBody(AElement, ASubpageIndex); CreatePageBody(AElement, ASubpageIndex);
AppendFooter; AppendFooter;
HeadEl.AppendChild(El); HeadEl.AppendChild(El);
@ -771,6 +788,7 @@ begin
Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex); Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
try try
CreatePath(Filename); CreatePath(Filename);
//writeln('Element: ',Element.PathName, ' FileName: ', Filename);
WriteHTMLFile(PageDoc, Filename); WriteHTMLFile(PageDoc, Filename);
except except
on E: Exception do on E: Exception do
@ -1534,7 +1552,8 @@ begin
end; end;
end; end;
Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode); procedure THTMLWriter.AppendShortDescr ( AContext: TPasElement;
Parent: TDOMNode; DocNode: TDocNode ) ;
Var Var
N : TDocNode; N : TDocNode;
@ -2093,7 +2112,7 @@ end;
procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer); procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
var var
TableEl, TREl, ParaEl, TitleEl: TDOMElement; TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement;
procedure AddLink(ALinkSubpageIndex: Integer; const AName: String); procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
begin begin
@ -2132,8 +2151,34 @@ begin
TableEl['border'] := '0'; TableEl['border'] := '0';
TableEl['width'] := '100%'; TableEl['width'] := '100%';
TableEl['class'] := 'bar'; TableEl['class'] := 'bar';
// Title Row
TREl := CreateTR(TableEl); TREl := CreateTR(TableEl);
ParaEl := CreateEl(CreateTD(TREl), 'b'); // Menu title
ParaEl := CreateTD(TREl);
ParaEl['align'] := 'left';
TitleEl := CreateEl(ParaEl, 'span');
TitleEl['class'] := 'bartitle';
if Assigned(Module) then
AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name]))
else
AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name]));
// Package link title
ParaEl := CreateTD(TREl);
ParaEl['align'] := 'right';
TitleEl := CreateEl(ParaEl, 'span');
TitleEl['class'] := 'bartitle';
if Assigned(Module) and Assigned(Package) then // Displays a Package page
begin
AppendText(TitleEl, SDocPackageLinkTitle);
end;
// Links Row
TRE2 := CreateTR(TableEl);
ParaEl := CreateTD(TRE2);
ParaEl['align'] := 'left';
ParaEl := CreateEl(ParaEl, 'span');
ParaEl['class']:= 'bartitle';
if Assigned(Module) then if Assigned(Module) then
begin begin
@ -2150,12 +2195,18 @@ begin
AddLink(ProcsSubindex, SDocProceduresAndFunctions); AddLink(ProcsSubindex, SDocProceduresAndFunctions);
if Module.InterfaceSection.Variables.Count > 0 then if Module.InterfaceSection.Variables.Count > 0 then
AddLink(VarsSubindex, SDocVariables); AddLink(VarsSubindex, SDocVariables);
AddLink(IndexSubIndex,SDocIdentifierIndex); AddLink(IndexSubIndex,SDocIdentifierIndex);
AppendFragment(ParaEl, NavigatorHTML); AppendFragment(ParaEl, NavigatorHTML);
end end
else else
begin begin
// Overview
AppendText(ParaEl, '[');
AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview);
AppendText(ParaEl, ']');
//Index
AddPackageLink(IndexSubIndex, SDocIdentifierIndex); AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
// Class TObject tree
AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy); AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
AppendFragment(ParaEl, NavigatorHTML) AppendFragment(ParaEl, NavigatorHTML)
end; end;
@ -2168,17 +2219,16 @@ begin
if FUseMenuBrackets then if FUseMenuBrackets then
AppendText(ParaEl, ']'); AppendText(ParaEl, ']');
end; end;
ParaEl := CreateTD(TREl);
ParaEl := CreateTD(TRE2);
ParaEl['align'] := 'right'; ParaEl['align'] := 'right';
TitleEl := CreateEl(ParaEl, 'span'); ParaEl := CreateEl(ParaEl, 'span');
TitleEl['class'] := 'bartitle'; ParaEl['class']:= 'bartitle';
if Assigned(Module) then if Assigned(Module) and Assigned(Package) then // Displays a Package page
AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
if Assigned(Package) then
begin begin
AppendText(TitleEl, ' ('); AppendText(ParaEl, '[');
AppendHyperlink(TitleEl, Package); AppendHyperlink(ParaEl, Package);
AppendText(TitleEl, ')'); AppendText(ParaEl, ']');
end; end;
AppendFragment(BodyElement,HeaderHTML); AppendFragment(BodyElement,HeaderHTML);
end; end;
@ -2189,7 +2239,8 @@ begin
[ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber])); [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
end; end;
Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode); procedure THTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement;
DocNode: TDocNode ) ;
var var
Node: TDOMNode; Node: TDOMNode;
@ -2263,7 +2314,8 @@ begin
end; // While end; // While
end; end;
Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode); procedure THTMLWriter.AppendExampleSection ( AElement: TPasElement;
DocNode: TDocNode ) ;
var var
Node: TDOMNode; Node: TDOMNode;
@ -2384,10 +2436,11 @@ begin
end; end;
end; end;
procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean); procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean);
type
TypeEN = (NPackage, NModule, NName);
Procedure PushClassElement; Procedure PushClassElement;
Var Var
H : THTMLElement; H : THTMLElement;
begin begin
@ -2403,7 +2456,6 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
end; end;
Procedure PushClassList; Procedure PushClassList;
Var Var
H : THTMLElement; H : THTMLElement;
begin begin
@ -2412,32 +2464,39 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
PushOutputNode(h); PushOutputNode(h);
end; end;
Procedure AppendClass(E : TPasElementNode); function ExtractName(APathName: String; Tp: TypeEN):String;
var
l:TStringList;
begin
Result:= Trim(APathName);
if Result = '' then exit;
l:=TStringList.Create;
try
l.AddDelimitedText(Result, '.', True);
if l.Count=3 then
Result:= l.Strings[Integer(Tp)]
else
Result:='';
finally
l.free;
end;
end;
Procedure AppendClass(EN : TPasElementNode);
Var Var
N : TDomNode; PE,PM : TPasElement;
P,PM,M : TPasElement; I : Integer;
EN : String;
LL : TstringList;
I,J : Integer;
begin begin
M:=E.Element.GetModule; if not Assigned(EN) then exit;
if (M<>Nil) then PE:=EN.Element;
EN:=Package.Name+'.'+UTF8Encode(M.Name)+'.'+UTF8Encode(E.Element.Name)
else
EN:=UTF8Encode(E.Element.Name);
J:=AList.IndexOf(EN);
If J<>-1 then
P:=AList.Objects[J] as TPasElement
else
P:=Engine.FindElement(EN);
PushClassElement; PushClassElement;
try try
if (P<>Nil) then if (PE<>Nil) then
begin begin
AppendHyperLink(CurOutputNode,P); AppendHyperLink(CurOutputNode,PE);
PM:=ModuleForElement(P); PM:=ModuleForElement(PE);
if (PM<>Nil) then if (PM<>Nil) then
begin begin
AppendText(CurOutputNode,' ('); AppendText(CurOutputNode,' (');
@ -2446,13 +2505,13 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
end end
end end
else else
AppendText(CurOutputNode,E.Element.Name); AppendText(CurOutputNode,EN.Element.Name);
if E.ChildCount>0 then if EN.ChildCount>0 then
begin begin
PushClassList; PushClassList;
try try
For I:=0 to E.ChildCount-1 do For I:=0 to EN.ChildCount-1 do
AppendClass(E.Children[i] as TPasElementNode); AppendClass(EN.Children[i] as TPasElementNode);
finally finally
PopOutputNode; PopOutputNode;
end; end;
@ -2462,29 +2521,12 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
end; end;
end; end;
Var
B : TClassTreeBuilder;
E : TPasElementNode;
begin begin
PushOutputNode(BodyElement); PushOutputNode(BodyElement);
try try
B:=TClassTreeBuilder.Create(Package,okClass); PushClassList;
try AppendClass(TreeClass.RootNode);
B.BuildTree(AList); //PopOutputNode;
// Classes
// WriteXMLFile(B.ClassTree,'tree.xml');
// Dummy TObject
E:=B.RootNode;
PushClassList;
try
AppendClass(E);
finally
PopOutputNode;
end;
finally
B.Free;
end;
finally finally
PopOutputNode; PopOutputNode;
end; end;
@ -2500,9 +2542,6 @@ Const
'}'; '}';
Var Var
L : TStringList;
I : Integer;
M : TPasModule;
S : String; S : String;
SE : THTMLElement; SE : THTMLElement;
@ -2510,24 +2549,12 @@ begin
SE := Doc.CreateElement('script'); SE := Doc.CreateElement('script');
AppendText(SE,SFunc); AppendText(SE,SFunc);
HeadElement.AppendChild(SE); HeadElement.AppendChild(SE);
L:=TStringList.Create; AppendMenuBar(ClassHierarchySubIndex);
try S:=Package.Name;
L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt. If Length(S)>0 then
For I:=0 to Package.Modules.Count-1 do Delete(S,1,1);
begin AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
M:=TPasModule(Package.Modules[i]); CreateClassHierarchyPage(True);
if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
end;
AppendMenuBar(ClassHierarchySubIndex);
S:=Package.Name;
If Length(S)>0 then
Delete(S,1,1);
AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
CreateClassHierarchyPage(L,True);
Finally
L.Free;
end;
end; end;
procedure THTMLWriter.CreatePageBody(AElement: TPasElement; procedure THTMLWriter.CreatePageBody(AElement: TPasElement;
@ -2673,29 +2700,6 @@ begin
end; end;
end; end;
Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
Var
I : Integer;
El : TPasElement;
N : TDocNode;
begin
For I:=0 to List.Count-1 do
begin
El:=TPasElement(List[I]);
N:=Engine.FindDocNode(El);
if (N=Nil) or (not N.IsSkipped) then
begin
if UsePathName then
L.AddObject(El.PathName,El)
else
L.AddObject(El.Name,El);
If el is TPasEnumType then
AddElementsFromList(L,TPasEnumType(el).Values);
end;
end;
end;
procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings); procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
@ -2783,7 +2787,8 @@ begin
end; end;
end; end;
Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement); procedure THTMLWriter.CreateTopicLinks ( Node: TDocNode;
PasElement: TPasElement ) ;
var var
DocNode: TDocNode; DocNode: TDocNode;
@ -3351,10 +3356,9 @@ var
i: Integer; i: Integer;
ThisInterface, ThisInterface,
ThisClass: TPasClassType; ThisClass: TPasClassType;
HaveSeenTObject: Boolean; ThisTreeNode: TPasElementNode;
LName : String;
ThisNode : TPasUnresolvedTypeRef;
begin begin
//WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
AppendMenuBar(-1); AppendMenuBar(-1);
AppendTitle(UTF8Decode(AClass.Name),AClass.Hints); AppendTitle(UTF8Decode(AClass.Name),AClass.Hints);
@ -3398,28 +3402,29 @@ var
end; end;
CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition); CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance)); AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance));
TableEl := CreateTable(BodyElement); TableEl := CreateTable(BodyElement);
HaveSeenTObject := AClass.ObjKind <> okClass;
// we try to track classes. But imported classes // Now we are using only TreeClass for show inheritance
// are TLinkNode's not the TPasClassType generated by the parser.
ThisClass := AClass; ThisNode := Nil; ThisClass := AClass; ThisTreeNode := Nil;
if AClass.ObjKind = okInterface then
ThisTreeNode := TreeInterface.GetPasElNode(AClass)
else
ThisTreeNode := TreeClass.GetPasElNode(AClass);
while True do while True do
begin begin
TREl := CreateTR(TableEl); TREl := CreateTR(TableEl);
TDEl := CreateTD_vtop(TREl); TDEl := CreateTD_vtop(TREl);
TDEl['align'] := 'center'; TDEl['align'] := 'center';
CodeEl := CreateCode(CreatePara(TDEl)); CodeEl := CreateCode(CreatePara(TDEl));
if Assigned(ThisClass) then
LName:=ThisClass.Name // Show class item
Else
LName:=ThisNode.Name;
if Assigned(ThisClass) Then if Assigned(ThisClass) Then
AppendHyperlink(CodeEl, ThisClass) AppendHyperlink(CodeEl, ThisClass);
else //else
AppendHyperlink(CodeEl, ThisNode); // AppendHyperlink(CodeEl, ThisTreeNode);
// Show links to class interfaces
if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
begin begin
for i:=0 to ThisClass.interfaces.count-1 do for i:=0 to ThisClass.interfaces.count-1 do
@ -3429,48 +3434,28 @@ var
AppendHyperlink(CodeEl, ThisInterface); AppendHyperlink(CodeEl, ThisInterface);
end; end;
end; end;
AppendShortDescrCell(TREl, ThisClass); // short class description
if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then if Assigned(ThisClass) then
HaveSeenTObject := True AppendShortDescrCell(TREl, ThisClass);
else
begin
TDEl := CreateTD(CreateTR(TableEl));
TDEl['align'] := 'center';
AppendText(TDEl, '|');
end;
if Assigned(ThisClass.AncestorType) then if Assigned(ThisTreeNode) then
begin if Assigned(ThisTreeNode.ParentNode) then
if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
ThisClass := TPasClassType(ThisClass.AncestorType)
else
begin begin
if thisclass.ancestortype is TPasUnresolvedTypeRef then
thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
TDEl := CreateTD(CreateTR(TableEl)); TDEl := CreateTD(CreateTR(TableEl));
TDEl['align'] := 'center'; TDEl['align'] := 'center';
AppendText(CreateCode(CreatePara(TDEl)), UTF8Decode(ThisClass.AncestorType.Name)); AppendText(TDEl, '|');
if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then ThisClass := ThisTreeNode.ParentNode.Element;
HaveSeenTObject := True ThisTreeNode := ThisTreeNode.ParentNode;
end
else else
begin begin
TDEl := CreateTD(CreateTR(TableEl)); ThisClass := nil;
TDEl['align'] := 'center'; ThisTreeNode:= nil;
AppendText(TDEl, '?');
end;
break; break;
end end
end else else
break; break;
end; end;
if not HaveSeenTObject then
begin
TDEl := CreateTD(CreateTR(TableEl));
TDEl['align'] := 'center';
AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
end;
FinishElementPage(AClass); FinishElementPage(AClass);
end; end;
@ -3847,11 +3832,12 @@ begin
FinishElementPage(AProc); FinishElementPage(AProc);
end; end;
Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean; function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
Function ReadFile(aFileName : string) : TstringStream; Function ReadFile(aFileName : string) : TstringStream;
begin begin
aFileName:= SetDirSeparators(aFileName);
try try
if copy(aFileName,1,1)<>'@' then if copy(aFileName,1,1)<>'@' then
Result:=TStringStream.Create(aFileName) Result:=TStringStream.Create(aFileName)
@ -3942,7 +3928,7 @@ begin
end; end;
end; end;
Class Function THTMLWriter.FileNameExtension : String; class function THTMLWriter.FileNameExtension: String;
begin begin
result:=''; result:='';
end; end;

19
utils/fpdoc/dw_txt.pp
View File

@ -158,18 +158,19 @@ Function FindSpace(Const S : String; P : Integer) : Integer;
Var Var
I,L : Integer; I,L : Integer;
SP: set of char;
begin begin
Result:=0; Result:=0;
SP := [#10,#13,' ',#9];
I:=P; I:=P;
L:=Length(S); L:=Length(S);
While (I>0) and (I<=L) and not (S[i] in [#10,#13,' ',#9]) do While (I>0) and (I<=L) and not (S[i] in SP) do
Dec(i); Dec(I);
If (I=0) then If (I=0) then
begin begin
I:=P; Inc(I);
While (I<=L) and not (S[i] in [#10,#13,' ',#9]) do While (I<=L) and not (S[I] in SP) do
Inc(i); Inc(I);
end; end;
Result:=I; Result:=I;
end; end;
@ -186,7 +187,7 @@ begin
exit; exit;
N:=S; N:=S;
Repeat Repeat
If ((FCurrentPos+Length(N))>LineWidth) then If ((FCurrentPos+Length(N)+1)>LineWidth) then
begin begin
L:=FindSpace(N,LineWidth-FCurrentPos+1); L:=FindSpace(N,LineWidth-FCurrentPos+1);
inherited Write(Copy(N,1,L-1)); inherited Write(Copy(N,1,L-1));
@ -195,8 +196,8 @@ begin
end end
else else
begin begin
L:=Length(N)+1; L:=Length(N);
inherited Write(Copy(N,1,L-1)); inherited Write(Copy(N,1,L));
Inc(FCurrentPos,L); Inc(FCurrentPos,L);
If FCheckEOL then If FCheckEOL then
If (L>=LEOL) then If (L>=LEOL) then

74
utils/fpdoc/dwriter.pp
View File

@ -25,7 +25,7 @@ unit dWriter;
{$WARN 5024 off : Parameter "$1" not used} {$WARN 5024 off : Parameter "$1" not used}
interface interface
uses Classes, DOM, dGlobals, PasTree, SysUtils; uses Classes, DOM, dGlobals, PasTree, SysUtils, fpdocclasstree;
resourcestring resourcestring
SErrFileWriting = 'An error occurred during writing of file "%s": %s'; SErrFileWriting = 'An error occurred during writing of file "%s": %s';
@ -80,8 +80,12 @@ type
FImgExt : String; FImgExt : String;
FBeforeEmitNote : TWriterNoteEvent; FBeforeEmitNote : TWriterNoteEvent;
procedure ConvertURL(AContext: TPasElement; El: TDOMElement); procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
procedure CreateClassTree;
protected protected
TreeClass: TClassTreeBuilder; // Global class tree
TreeInterface: TClassTreeBuilder; // Global interface tree
procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
Procedure DoLog(Const Msg : String); Procedure DoLog(Const Msg : String);
Procedure DoLog(Const Fmt : String; Args : Array of const); Procedure DoLog(Const Fmt : String; Args : Array of const);
procedure Warning(AContext: TPasElement; const AMsg: String); procedure Warning(AContext: TPasElement; const AMsg: String);
@ -339,7 +343,8 @@ end;
} }
Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine); constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine
) ;
begin begin
inherited Create; inherited Create;
@ -347,6 +352,9 @@ begin
FPackage := APackage; FPackage := APackage;
FTopics:=Tlist.Create; FTopics:=Tlist.Create;
FImgExt:='.png'; FImgExt:='.png';
TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
CreateClassTree;
end; end;
destructor TFPDocWriter.Destroy; destructor TFPDocWriter.Destroy;
@ -358,6 +366,8 @@ begin
For I:=0 to FTopics.Count-1 do For I:=0 to FTopics.Count-1 do
TTopicElement(FTopics[i]).Free; TTopicElement(FTopics[i]).Free;
FTopics.Free; FTopics.Free;
TreeClass.free;
TreeInterface.Free;
Inherited; Inherited;
end; end;
@ -390,7 +400,7 @@ begin
end; end;
end; end;
Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement; function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
Var Var
I : Integer; I : Integer;
@ -713,6 +723,55 @@ begin
DescrEndURL; DescrEndURL;
end; end;
procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList;
UsePathName: Boolean ) ;
Var
I : Integer;
El : TPasElement;
N : TDocNode;
begin
For I:=0 to List.Count-1 do
begin
El:=TPasElement(List[I]);
N:=Engine.FindDocNode(El);
if (N=Nil) or (not N.IsSkipped) then
begin
if UsePathName then
L.AddObject(El.PathName,El)
else
L.AddObject(El.Name,El);
If el is TPasEnumType then
AddElementsFromList(L,TPasEnumType(el).Values);
end;
end;
end;
procedure TFPDocWriter.CreateClassTree;
var
L: TStringList;
M: TPasModule;
I:Integer;
begin
L:=TStringList.Create;
try
For I:=0 to Package.Modules.Count-1 do
begin
M:=TPasModule(Package.Modules[i]);
if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
end;
TreeClass.BuildTree(L);
TreeInterface.BuildTree(L);
{$IFDEF TREE_TEST}
TreeClass.SaveToXml('TreeClass.xml');
TreeInterface.SaveToXml('TreeInterface.xml');
{$ENDIF}
Finally
L.Free;
end;
end;
procedure TFPDocWriter.DoLog(const Msg: String); procedure TFPDocWriter.DoLog(const Msg: String);
begin begin
If Assigned(FEngine.OnLog) then If Assigned(FEngine.OnLog) then
@ -1126,7 +1185,7 @@ begin
Result := False; Result := False;
end; end;
Procedure TFPDocWriter.ConvertImage(El : TDomElement); procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ;
Var Var
FN,Cap,LinkName : DOMString; FN,Cap,LinkName : DOMString;
@ -1169,7 +1228,7 @@ begin
Inherited; Inherited;
end; end;
Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode; function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode;
begin begin
Result:=Engine.FindDocNode(Element); Result:=Engine.FindDocNode(Element);
@ -1211,7 +1270,8 @@ begin
Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected) Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
end; end;
Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList); procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType;
List: TStringList ) ;
Var Var
I : Integer; I : Integer;

2
utils/fpdoc/fpclasschart.pp
View File

@ -447,7 +447,7 @@ Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPa
begin begin
FPackage:=TPasPackage.Create('dummy',Nil); FPackage:=TPasPackage.Create('dummy',Nil);
FTree:=TClassTreeBuilder.Create(FPackage,AObjectKind); FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind);
FObjects:=TStringList.Create; FObjects:=TStringList.Create;
Inherited Create; Inherited Create;
end; end;

5
utils/fpdoc/fpdoc.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="11"/> <Version Value="12"/>
<General> <General>
<Flags> <Flags>
<SaveClosedFiles Value="False"/> <SaveClosedFiles Value="False"/>
@ -10,9 +10,9 @@
<MainUnitHasTitleStatement Value="False"/> <MainUnitHasTitleStatement Value="False"/>
<SaveJumpHistory Value="False"/> <SaveJumpHistory Value="False"/>
<SaveFoldState Value="False"/> <SaveFoldState Value="False"/>
<CompatibilityMode Value="True"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="FPDoc Documentation generator"/> <Title Value="FPDoc Documentation generator"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
@ -65,7 +65,6 @@
<Unit3> <Unit3>
<Filename Value="dw_html.pp"/> <Filename Value="dw_html.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="dw_HTML"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="dw_ipflin.pas"/> <Filename Value="dw_ipflin.pas"/>

2
utils/fpdoc/fpdoc.pp
View File

@ -428,6 +428,8 @@ begin
end; end;
begin begin
//AssignFile(Output, 'fpdoc.log');
//rewrite(Output);
With TFPDocApplication.Create(Nil) do With TFPDocApplication.Create(Nil) do
try try
Run; Run;

129
utils/fpdoc/fpdocclasstree.pp
View File

@ -5,7 +5,7 @@ unit fpdocclasstree;
interface interface
uses uses
Classes, SysUtils, DOM, pastree, contnrs; Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
Type Type
@ -13,16 +13,18 @@ Type
TPasElementNode = Class TPasElementNode = Class
Private Private
FElement : TPasElement; FElement : TPasClassType;
FParentNode: TPasElementNode;
FChildren : TFPObjectList; FChildren : TFPObjectList;
function GetChild(aIndex : Integer): TPasElementNode; function GetChild(aIndex : Integer): TPasElementNode;
function GetChildCount: Integer; function GetChildCount: Integer;
Public Public
Constructor Create (aElement : TPaselement); Constructor Create (aElement : TPasClassType);
Destructor Destroy; override; Destructor Destroy; override;
Procedure AddChild(C : TPasElementNode); Procedure AddChild(C : TPasElementNode);
Procedure SortChildren; Procedure SortChildren;
Property Element : TPasElement Read FElement; Property Element : TPasClassType Read FElement;
Property ParentNode : TPasElementNode read FParentNode;
Property Children [aIndex : Integer] : TPasElementNode Read GetChild; Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
Property ChildCount : Integer Read GetChildCount; Property ChildCount : Integer Read GetChildCount;
end; end;
@ -31,20 +33,27 @@ Type
TClassTreeBuilder = Class TClassTreeBuilder = Class
Private Private
// Full name -> TDomElement; FEngine:TFPDocEngine;
FElementList : TFPObjectHashTable; FElementList : TFPObjectHashTable;
FObjectKind : TPasObjKind; FObjectKind : TPasObjKind;
FPackage: TPasPackage; FPackage: TPasPackage;
FParentObject : TPasClassType; FParentObject : TPasClassType;
FRootNode : TPasElementNode; FRootNode : TPasElementNode;
FRootObjectName : string; FRootObjectName : string;
FRootObjectPathName : string;
Protected Protected
function AddToList(aElement: TPasClassType): TPasElementNode; function AddToList(aElement: TPasClassType): TPasElementNode;
Public Public
Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass); Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
AObjectKind : TPasObjKind = okClass);
Destructor Destroy; override; Destructor Destroy; override;
Function BuildTree(AObjects : TStringList) : Integer; Function BuildTree(AObjects : TStringList) : Integer;
{$IFDEF TREE_TEST}
Procedure SaveToXml(AFileName: String);
{$ENDIF}
Property RootNode : TPasElementNode Read FRootNode; Property RootNode : TPasElementNode Read FRootNode;
Property PasElToNodes: TFPObjectHashTable read FElementList;
function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
end; end;
implementation implementation
@ -72,7 +81,7 @@ begin
Result:=0 Result:=0
end; end;
constructor TPasElementNode.Create(aElement: TPaselement); constructor TPasElementNode.Create(aElement: TPasClassType);
begin begin
FElement:=aElement; FElement:=aElement;
end; end;
@ -96,24 +105,38 @@ begin
FChildren.Sort(@SortOnElementName); FChildren.Sort(@SortOnElementName);
end; end;
constructor TClassTreeBuilder.Create(APackage : TPasPackage; constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage;
AObjectKind: TPasObjKind); AObjectKind: TPasObjKind);
begin begin
FPackage:=APAckage; FEngine:= AEngine;
FPackage:= APAckage;
FObjectKind:=AObjectKind; FObjectKind:=AObjectKind;
Case FObjectkind of Case FObjectkind of
okInterface : FRootObjectName:='#rtl.System.IInterface'; okInterface :
okObject, begin
okClass : FRootObjectName:='#rtl.System.TObject'; FRootObjectPathName:='#rtl.System.IInterface';
FRootObjectName:= 'IInterface';
end;
okObject, okClass :
begin
FRootObjectPathName:='#rtl.System.TObject';
FRootObjectName:= 'TObject';
end
else else
FRootObjectName:='#rtl.System.TObject'; begin
FRootObjectPathName:='#rtl.System.TObject';
FRootObjectName:= 'TObject';
end;
end; end;
FParentObject:=TPasClassType.Create(FRootObjectName,FPackage); FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System'));
if not Assigned(FParentObject) then
FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
FParentObject.ObjKind:=FObjectKind; FParentObject.ObjKind:=FObjectKind;
FRootNode:=TPasElementNode.Create(FParentObject); FRootNode:=TPasElementNode.Create(FParentObject);
FRootNode.FParentNode := nil;
FElementList:=TFPObjectHashTable.Create(False); FElementList:=TFPObjectHashTable.Create(False);
FElementList.Add(FRootObjectName,FRootNode); FElementList.Add(FRootObjectPathName,FRootNode);
end; end;
destructor TClassTreeBuilder.Destroy; destructor TClassTreeBuilder.Destroy;
@ -124,34 +147,37 @@ begin
Inherited; Inherited;
end; end;
Function TClassTreeBuilder.AddToList(aElement : TPasClassType) : TPasElementNode; function TClassTreeBuilder.AddToList ( aElement: TPasClassType
) : TPasElementNode;
Var Var
aParentNode : TPasElementNode; aParentNode : TPasElementNode;
aName : String; aName : String;
begin begin
Result:= nil;
if (aElement.ObjKind <> FObjectKind) then exit;
aParentNode:= nil;
if aElement=Nil then if aElement=Nil then
aName:=FRootObjectName aName:=FRootObjectName
else else
begin
aName:=aElement.PathName; aName:=aElement.PathName;
end;
Result:=TPasElementNode(FElementList.Items[aName]); Result:=TPasElementNode(FElementList.Items[aName]);
if (Result=Nil) then if (Result=Nil) then
begin begin
if aElement.AncestorType is TPasClassType then if aElement.AncestorType is TPasClassType then
aParentNode:=AddToList(aElement.AncestorType as TPasClassType) aParentNode:=AddToList(aElement.AncestorType as TPasClassType);
else if not Assigned(aParentNode) then
aParentNode:=FRootNode; aParentNode:=FRootNode;
Result:=TPasElementNode.Create(aElement); Result:=TPasElementNode.Create(aElement);
aParentNode.AddChild(Result); aParentNode.AddChild(Result);
Result.FParentNode := aParentNode;
FElementList.Add(aName,Result); FElementList.Add(aName,Result);
end; end;
end; end;
Function TClassTreeBuilder.BuildTree(AObjects : TStringList) : Integer; function TClassTreeBuilder.BuildTree ( AObjects: TStringList ) : Integer;
(* (*
Procedure DumpNode(Prefix : String; N : TPasElementNode); Procedure DumpNode(Prefix : String; N : TPasElementNode);
@ -182,7 +208,64 @@ begin
end; end;
end; end;
function TClassTreeBuilder.GetPasElNode ( APasEl: TPasElement
) : TPasElementNode;
begin
Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
end;
{$IFDEF TREE_TEST}
procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
var
CounterVar: Integer;
PasElNode: TPasElementNode;
AXmlDoc: TDOMDocument;
xmlEl: TDOMElement;
M: TPasModule;
begin
if not Assigned(ParentPasEl) or (ParentPasEl.ChildCount = 0) then exit;
AXmlDoc:= ParentxmlEl.OwnerDocument;
for CounterVar := 0 to ParentPasEl.ChildCount-1 do
begin
PasElNode:= ParentPasEl.Children[CounterVar];
xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name));
M:= PasElNode.Element.GetModule;
xmlEl['unit'] := UnicodeString(M.Name);
xmlEl['package'] := UnicodeString(M.PackageName);
ParentxmlEl.AppendChild(xmlEl);
AddPasElChildsToXml(xmlEl, PasElNode);
end;
end;
var
XmlDoc: TXMLDocument;
XmlRootEl: TDOMElement;
M: TPasModule;
begin
XmlDoc:= TXMLDocument.Create;
try
XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
M:= FRootNode.Element.GetModule;
if Assigned(M) then
begin
XmlRootEl['unit'] := UnicodeString(M.Name);
XmlRootEl['package'] := UnicodeString(M.PackageName);
end
else
begin
XmlRootEl['unit'] := 'system';
XmlRootEl['package'] := 'rtl';
end;
XmlDoc.AppendChild(XmlRootEl);
AddPasElChildsToXml(XmlRootEl, FRootNode);
WriteXMLFile(XmlDoc, AFileName);
finally
XmlDoc.Free;
end;
end;
{$ENDIF}
end. end.

25
utils/fpdoc/mkfpdoc.pp
View File

@ -42,6 +42,8 @@ Type
procedure SetVerbose(AValue: Boolean); virtual; procedure SetVerbose(AValue: Boolean); virtual;
Procedure DoLog(Const Msg : String); Procedure DoLog(Const Msg : String);
procedure DoLog(Const Fmt : String; Args : Array of Const); procedure DoLog(Const Fmt : String; Args : Array of Const);
Procedure DoLogSender(Sender : TObject; Const Msg : String);
// Create documetation by specified Writer class
procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual; procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual;
Public Public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
@ -96,6 +98,14 @@ begin
DoLog(Format(Fmt,Args)); DoLog(Format(Fmt,Args));
end; end;
procedure TFPDocCreator.DoLogSender ( Sender: TObject; const Msg: String ) ;
begin
if Assigned(Sender) then
DoLog(Format('%s - Sender: %s', [Msg, Sender.ClassName]))
else
DoLog(Msg);
end;
procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject; procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject;
const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String); const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
@ -208,7 +218,9 @@ Var
Cmd,Arg : String; Cmd,Arg : String;
begin begin
// Now is used the specified writer
WriterClass:=GetWriterClass(Options.Backend); WriterClass:=GetWriterClass(Options.Backend);
// ALL CONTENT CREATED HERE
Writer:=WriterClass.Create(Engine.Package,Engine); Writer:=WriterClass.Create(Engine.Package,Engine);
With Writer do With Writer do
Try Try
@ -225,10 +237,12 @@ begin
If not InterPretOption(Cmd,Arg) then If not InterPretOption(Cmd,Arg) then
DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]); DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
end; end;
// Output created Documentation
WriteDoc; WriteDoc;
Finally Finally
Free; Free;
end; end;
// Output content files
Writeln('Content file : ',APackage.ContentFile); Writeln('Content file : ',APackage.ContentFile);
if Length(APackage.ContentFile) > 0 then if Length(APackage.ContentFile) > 0 then
Engine.WriteContentFile(APackage.ContentFile); Engine.WriteContentFile(APackage.ContentFile);
@ -247,16 +261,21 @@ begin
Cmd:=''; Cmd:='';
FCurPackage:=APackage; FCurPackage:=APackage;
Engine:=TFPDocEngine.Create; Engine:=TFPDocEngine.Create;
Engine.OnLog:= @DoLogSender;
try try
// get documentation Writer html, latex, and other
WriterClass:=GetWriterClass(Options.Backend); WriterClass:=GetWriterClass(Options.Backend);
For J:=0 to Apackage.Imports.Count-1 do For J:=0 to Apackage.Imports.Count-1 do
begin begin
Arg:=Apackage.Imports[j]; Arg:=Apackage.Imports[j];
// conversion import FilePathes
WriterClass.SplitImport(Arg,Cmd); WriterClass.SplitImport(Arg,Cmd);
// create tree of imported objects
Engine.ReadContentFile(Arg, Cmd); Engine.ReadContentFile(Arg, Cmd);
end; end;
for i := 0 to APackage.Descriptions.Count - 1 do for i := 0 to APackage.Descriptions.Count - 1 do
Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim); Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
// set engine options
Engine.SetPackageName(APackage.Name); Engine.SetPackageName(APackage.Name);
Engine.Output:=APackage.Output; Engine.Output:=APackage.Output;
Engine.OnLog:=Self.OnLog; Engine.OnLog:=Self.OnLog;
@ -268,13 +287,18 @@ begin
Engine.WarnNoNode:=Options.WarnNoNode; Engine.WarnNoNode:=Options.WarnNoNode;
if Length(Options.Language) > 0 then if Length(Options.Language) > 0 then
TranslateDocStrings(Options.Language); TranslateDocStrings(Options.Language);
// scan the input source files
for i := 0 to APackage.Inputs.Count - 1 do for i := 0 to APackage.Inputs.Count - 1 do
try try
// get options from input packages
SplitInputFileOption(APackage.Inputs[i],Cmd,Arg); SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
// make absolute filepath
Cmd:=FixInputFile(Cmd); Cmd:=FixInputFile(Cmd);
if FProcessedUnits.IndexOf(Cmd)=-1 then if FProcessedUnits.IndexOf(Cmd)=-1 then
begin begin
FProcessedUnits.Add(Cmd); FProcessedUnits.Add(Cmd);
// Parce sources for OS Target
//WriteLn(Format('Parcing unit: %s', [ExtractFilenameOnly(Cmd)]));
ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]); ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
end; end;
except except
@ -290,6 +314,7 @@ begin
if Not ParseOnly then if Not ParseOnly then
begin begin
Engine.StartDocumenting; Engine.StartDocumenting;
// Create documentation
CreateOutput(APackage,Engine); CreateOutput(APackage,Engine);
end; end;
finally finally