paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 17:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Andrey Sobol to improve names, improve XML structure

Browse Source 
git-svn-id: trunk@48103 -
(cherry picked from commit de28024427)
This commit is contained in:
michael 2021-01-07 13:24:12 +00:00 committed by Florian Klämpfl
parent 1f59452383
commit 80c42505cf
7 changed files with 98 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
utils/fpdoc/dglobals.pp
View File

@ -161,7 +161,6 @@ resourcestring
SMDNavSubtree = ' UnitSubTree : put all units in a sub tree of a Units node';
SMDNavTree = ' UnitTree : put every units as a node on the same level as packages node';
SXMLUsageFlatStructure = 'Use a flat output structure of XML files and directories';
SXMLUsageSource = 'Include source file and line info in generated XML';
@ -172,7 +171,7 @@ resourcestring
STitle = 'FPDoc - Free Pascal Documentation Tool';
SVersion = 'Version %s [%s]';
SCopyright1 = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org';
SCopyright2 = '(c) 2005 - 2012 various FPC contributors';
SCopyright2 = '(c) 2005 - 2021 various FPC contributors';
SCmdLineHelp = 'Usage: %s [options]';
SUsageOption008 = '--base-descr-dir=DIR prefix all description files with this directory';
@ -213,6 +212,7 @@ resourcestring
SUsageOption300 = '--dry-run Only parse sources and XML, do not create output';
SUsageOption310 = '--write-project=file';
SUsageOption320 = ' Write all command-line options to a project file';
SUsageSubNames = 'Use the file subnames instead the indexes as postfixes';
SUsageFormats = 'The following output formats are supported by this fpdoc:';
SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';

14
utils/fpdoc/dw_chm.pp
View File

@ -119,11 +119,8 @@ begin
Result := LowerCase(AElement.PathName);
excl := (ASubindex > 0);
end;
// searching for TPasModule - it is on the 2nd level
if Assigned(AElement.Parent) then
while Assigned(AElement.Parent.Parent) do
AElement := AElement.Parent;
// cut off Package Name
AElement:= AElement.GetModule;
Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
// to skip dots in unit name
i := Length(AElement.Name);
@ -142,10 +139,8 @@ begin
end;
if ASubindex > 0 then
Result := Result + '-' + IntToStr(ASubindex);
Result := Result + '-' + GetFilePostfix(ASubindex);
Result := Result + Extension;
// Writeln('Result filename : ',Result);
end;
{ TFpDocChmWriter }
@ -634,6 +629,11 @@ var
IFileName,FileName: String;
FilePath: String;
begin
FAllocator:=CreateAllocator;
FAllocator.SubPageNames:= SubPageNames;
AllocatePages;
DoLog(SWritingPages, [PageCount]);
FileName := Engine.Output;
if FileName = '' then
Raise Exception.Create('Error: no --output option used.');

4
utils/fpdoc/dw_html.pp
View File

@ -143,7 +143,6 @@ begin
UseMenuBrackets:=True;
IndexColCount:=3;
Charset:='iso-8859-1';
AllocatePages;
end;
function THTMLWriter.CreateHTMLPage(AElement: TPasElement;
@ -2297,7 +2296,7 @@ begin
else if Cmd = '--disable-menu-brackets' then
FUseMenuBrackets:=False
else
Result:=False;
Result:=inherited InterPretOption(Cmd, Arg);
end;
@ -2321,6 +2320,7 @@ begin
List.Add(SHTMLImageUrl);
List.Add('--disable-menu-brackets');
List.Add(SHTMLDisableMenuBrackets);
inherited Usage(List);
end;
class procedure THTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);

8
utils/fpdoc/dw_markdown.pp
View File

@ -1889,11 +1889,14 @@ begin
FNavigationMode:=nmUnitSubTree
else if SameText(Arg,'UnitTree') then
FNavigationMode:=nmUnitTree;
end;
end
else
Result:=inherited InterPretOption(Cmd, Arg);
end;
class procedure TMarkdownWriter.Usage(List: TStrings);
begin
inherited Usage(List);
List.add('--header=file');
List.Add(SMDUsageHeader);
List.add('--footer=file');
@ -1906,7 +1909,10 @@ begin
List.Add(SMDTheme);
List.Add('--navigation=scheme');
List.Add(SMDNavigation);
// we have to write even count of params into list either we will have a exception
List.Add('');
List.Add(SMDNavSubtree);
List.Add('');
List.Add(SMDNavTree);
end;

20
utils/fpdoc/dw_xml.pp
View File

@ -81,6 +81,8 @@ begin
else if AElement.ClassType = TPasModule then
Result := LowerCase(AElement.Name);
if ASubindex > 0 then
Result := Result + '-' + GetFilePostfix(ASubindex);
Result := Result + Extension;
end;
@ -641,12 +643,10 @@ begin
end;
procedure TXMLWriter.AllocatePackagePages;
var
H: Boolean;
begin
H:= false; // TODO: I want to public TreeClass for package
if H then
AddPage(Package,ClassHierarchySubIndex);
AddPage(Package, IdentifierIndex);
AddPage(Package, ClassHierarchySubIndex);
AddPage(Package, InterfaceHierarchySubIndex);
end;
procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
@ -654,7 +654,7 @@ procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
begin
if not assigned(Amodule.Interfacesection) then
exit;
AddPage(AModule, 0);
AddPage(AModule, IdentifierIndex);
end;
procedure TXMLWriter.WriteDocPage(const aFileName: String;
@ -667,6 +667,13 @@ begin
doc := ModuleToXMLStruct(TPasModule(aElement));
WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
doc.Free;
end
else if (aElement is TPasPackage) then
begin
if aSubPageIndex = ClassHierarchySubIndex then
TreeClass.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
if aSubPageIndex = InterfaceHierarchySubIndex then
TreeInterface.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
end;
end;
@ -679,6 +686,7 @@ end;
class procedure TXMLWriter.Usage(List: TStrings);
begin
inherited Usage(List);
List.AddStrings(['--source-info', SXMLUsageSource]);
List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
end;

76
utils/fpdoc/dwriter.pp
View File

@ -65,13 +65,21 @@ type
Destructor Destroy; override;
end;
{ TFileAllocator }
TFileAllocator = class
private
FSubPageNames: Boolean;
protected
function GetFilePostfix(ASubindex: Integer):String;
public
procedure Create(); overload;
procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); virtual;
function GetFilename(AElement: TPasElement;
ASubindex: Integer): String; virtual; abstract;
function GetRelativePathToTop(AElement: TPasElement): String; virtual;
function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
property SubPageNames: Boolean read FSubPageNames write FSubPageNames;
end;
TLongNameFileAllocator = class(TFileAllocator)
@ -228,6 +236,7 @@ const
TopicsSubIndex = 7;
IndexSubIndex = 8;
ClassHierarchySubIndex = 9;
InterfaceHierarchySubIndex = 10;
// Subpage indices for classes
PropertiesByInheritanceSubindex = 11;
@ -237,6 +246,7 @@ const
EventsByInheritanceSubindex = 15;
EventsByNameSubindex = 16;
Type
{ TMultiFileDocWriter }
@ -260,7 +270,7 @@ Type
TMultiFileDocWriter = Class(TFPDocWriter)
Private
FAllocator: TFileAllocator;
FSubPageNames: Boolean;
FBaseDirectory: String;
FCurDirectory: String;
FModule: TPasModule;
@ -268,6 +278,7 @@ Type
function GetPageCount: Integer;
Protected
FAllocator: TFileAllocator;
function ResolveLinkID(const Name: String; Level: Integer=0): DOMString;
function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
function ResolveLinkWithinPackage(AElement: TPasElement; ASubpageIndex: Integer): String;
@ -284,15 +295,17 @@ Type
procedure AllocatePackagePages; virtual;
// Prefix every filename generated with the result of this.
function GetFileBaseDir(aOutput: String): String; virtual;
function InterPretOption(const Cmd, Arg: String): boolean; override;
function ModuleHasClasses(AModule: TPasModule): Boolean;
Property PageInfos : TFPObjectList Read FPageInfos;
Property SubPageNames: Boolean Read FSubPageNames;
Public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
Destructor Destroy; override;
procedure WriteDoc; override;
class procedure Usage(List: TStrings); override;
property PageCount: Integer read GetPageCount;
Property Allocator : TFileAllocator Read FAllocator Write FAllocator;
Property Allocator : TFileAllocator Read FAllocator;
Property Module: TPasModule Read FModule Write FModule;
Property CurDirectory: String Read FCurDirectory Write FCurDirectory; // relative to curdir of process
property BaseDirectory: String read FBaseDirectory Write FBaseDirectory; // relative path to package base directory
@ -398,6 +411,7 @@ constructor TMultiFileDocWriter.Create(APackage: TPasPackage;
begin
inherited Create(APackage, AEngine);
FPageInfos:=TFPObjectList.Create;
FSubPageNames:= False;
end;
destructor TMultiFileDocWriter.Destroy;
@ -758,6 +772,7 @@ var
begin
FAllocator:=CreateAllocator;
FAllocator.SubPageNames:= SubPageNames;
AllocatePages;
DoLog(SWritingPages, [PageCount]);
if Engine.Output <> '' then
@ -772,7 +787,19 @@ begin
end;
end;
class procedure TMultiFileDocWriter.Usage(List: TStrings);
begin
List.AddStrings(['--use-subpagenames', SUsageSubNames]);
end;
function TMultiFileDocWriter.InterPretOption(const Cmd, Arg: String): boolean;
begin
Result := True;
if Cmd = '--use-subpagenames' then
FSubPageNames:= True
else
Result:=inherited InterPretOption(Cmd, Arg);
end;
{ TWriterRecord }
@ -882,6 +909,36 @@ end;
TFileAllocator
---------------------------------------------------------------------}
function TFileAllocator.GetFilePostfix(ASubindex: Integer): String;
begin
if FSubPageNames then
case ASubindex of
IdentifierIndex: Result:='';
ResstrSubindex: Result:='reestr';
ConstsSubindex: Result:='consts';
TypesSubindex: Result:='types';
ClassesSubindex: Result:='classes';
ProcsSubindex: Result:='procs';
VarsSubindex: Result:='vars';
TopicsSubIndex: Result:='topics';
IndexSubIndex: Result:='indexes';
ClassHierarchySubIndex: Result:='class-tree';
InterfaceHierarchySubIndex: Result:='interface-tree';
PropertiesByInheritanceSubindex: Result:='props';
PropertiesByNameSubindex: Result:='props-n';
MethodsByInheritanceSubindex: Result:='methods';
MethodsByNameSubindex: Result:='methods-n';
EventsByInheritanceSubindex: Result:='events';
EventsByNameSubindex: Result:='events-n';
end
else
Result:= IntToStr(ASubindex);
end;
procedure TFileAllocator.Create();
begin
FSubPageNames:= False;
end;
procedure TFileAllocator.AllocFilename(AElement: TPasElement;
ASubindex: Integer);
@ -951,11 +1008,8 @@ begin
Result:=Result + '-'+ s + '-' + N;
end else
Result := LowerCase(AElement.PathName);
// searching for TPasModule - it is on the 2nd level
if Assigned(AElement.Parent) then
while Assigned(AElement.Parent.Parent) do
AElement := AElement.Parent;
// cut off Package Name
AElement:= AElement.GetModule;
Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
// to skip dots in unit name
i := Length(AElement.Name);
@ -966,8 +1020,7 @@ begin
end;
if ASubindex > 0 then
Result := Result + '-' + IntToStr(ASubindex);
Result := Result + '-' + GetFilePostfix(ASubindex);
Result := Result + Extension;
end;
@ -1437,12 +1490,9 @@ begin
if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
end;
// You can see this tree by using --format=xml option
TreeClass.BuildTree(L);
TreeInterface.BuildTree(L);
{$IFDEF TREE_TEST}
TreeClass.SaveToXml('TreeClass.xml');
TreeInterface.SaveToXml('TreeInterface.xml');
{$ENDIF}
Finally
L.Free;
end;

9
utils/fpdoc/fpdocclasstree.pp
View File

@ -5,7 +5,7 @@ unit fpdocclasstree;
interface
uses
Classes, SysUtils, dGlobals, pastree, contnrs{$IFDEF TREE_TEST}, DOM ,XMLWrite{$ENDIF};
Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
Type
@ -48,9 +48,7 @@ Type
AObjectKind : TPasObjKind = okClass);
Destructor Destroy; override;
Function BuildTree(AObjects : TStringList) : Integer;
{$IFDEF TREE_TEST}
Procedure SaveToXml(AFileName: String);
{$ENDIF}
Property RootNode : TPasElementNode Read FRootNode;
Property PasElToNodes: TFPObjectHashTable read FElementList;
function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
@ -214,8 +212,7 @@ begin
Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
end;
{$IFDEF TREE_TEST}
procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
procedure TClassTreeBuilder.SaveToXml ( AFileName: String );
procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
var
@ -245,6 +242,7 @@ var
M: TPasModule;
begin
XmlDoc:= TXMLDocument.Create;
XmlDoc.AppendChild(XmlDoc.CreateComment(UTF8Decode(SDocGeneratedByComment)));
try
XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
M:= FRootNode.Element.GetModule;
@ -265,7 +263,6 @@ begin
XmlDoc.Free;
end;
end;
{$ENDIF}
end.