paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-18 12:02:31 +02:00
Code Issues Packages Projects Releases Wiki Activity
d22712e99e
fpc/utils/fpdoc/dw_markdown.pp
michael d22712e99e * Markdown support for fpdoc 
(cherry picked from commit 390be00327)

# Conflicts:
#	.gitattributes
2021-08-16 17:07:53 +02:00

1945 lines
50 KiB
ObjectPascal
Raw Blame History

{
FPDoc - Free Pascal Documentation Tool
Copyright (C) 2000 - 2005 by
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
* HTML/XHTML output generator
See the file COPYING, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$mode objfpc}
{$H+}
unit dw_markdown;
{$WARN 5024 off : Parameter "$1" not used}
interface
uses Classes, dGlobals, PasTree, dWriter, dw_basemd, DOM;
type
TMemberListOption = (mloAppendParent,mloAppendType,mloCheckVisibility);
TMemberListOptions = Set of TMemberListOption;
{ TMarkdownWriter }
TMarkdownWriter = class(TBaseMarkdownWriter)
private
FBaseImageURL: String;
FImageFileList: TStrings;
FIndexColCount: Integer;
FAdditionalConfig : TStrings;
FFooterMarkDown : TStrings;
FHeaderMarkDown : TStrings;
FOnTest: TNotifyEvent;
FNavigation : TStrings;
function GetAdditionalConfig: TStrings;
function GetClassDeclaration(aEl: TPasClassType): String;
function GetClassDeclarationFirstLine(aEl: TPasClassType): String;
function GetDeclaration(aEl: TPasElement): String;
function GetFooterMarkDown: TStrings;
function GetHeaderMarkDown: TStrings;
function GetPageCount: Integer;
procedure SetOnTest(const AValue: TNotifyEvent);
protected
function GetFileBaseDir(aOutput: String): String; override;
// MkDocs
procedure WriteMkdocsYaml; virtual;
procedure CreateMkdocsYaml(mkDocs: TStrings); virtual;
procedure AddToNavigation(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer);
// Some raw markdown functions
procedure AppendPageFooter; virtual;
procedure WriteMetadata; virtual;
procedure AppendPageHeader; virtual;
Procedure AppendText(Const S : String);
Procedure AppendTitle(Const S : String);
Procedure AppendTitle(Const Fmt : String; Const Args : Array of const);
// Description
Procedure AppendShortDescr(AContext : TPasElement; DocNode : TDocNode); virtual;
procedure AppendShortDescr(Element: TPasElement); virtual;
procedure AppendShortDescrCell(Element: TPasElement); virtual;
procedure AppendDescr(AContext: TPasElement; DescrNode: TDOMElement; AutoInsertBlock: Boolean); virtual;
procedure AppendDescrSection(AContext: TPasElement; DescrNode: TDOMElement; const ATitle: String); virtual;
procedure AppendDescrSection(AContext: TPasElement; DescrNode: TDOMElement; const ATitle: DOMString); virtual;
Procedure AppendHyperlink(Element: TPasElement);
Function CreateHyperlink(Element: TPasElement) : string;
// Reusable routines
procedure CollectDeclarationTypes(aList: TStringList; aElement: TPasElement );
procedure CollectSeeAlsoNodes(aList: TStringList; aSeeAlso: TDomNode);
procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
procedure AppendSourceRef(AElement: TPasElement); virtual;
procedure AppendDeclaration(aEl: TPasElement; aKind: string; PrependVisibility: Boolean); virtual;
procedure FinishElementPage(AElement: TPasElement; SkipDescription: Boolean=false); virtual;
Procedure AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode); virtual;
Procedure AppendExampleSection(AElement : TPasElement;DocNode : TDocNode); virtual;
procedure AppendProcArgsSection(Element: TPasProcedureBase); virtual;
procedure CreateMemberDeclarations(AParent: TPasElement; Members: TFPList; Options : TMemberListOptions); virtual;
Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement); virtual;
procedure CreateIndexPage(L : TStringList); virtual;
procedure CreateSimpleSubpage(aModule: TPasModule; const ATitle, aItem: String; AList: TFPList); virtual;
// Various kind of pages.
// Main entry
procedure CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer); virtual;
// Package
procedure CreatePackagePageBody; virtual;
procedure CreatePackageIndex; virtual;
procedure CreatePackageClassHierarchy; virtual;
procedure CreateClassHierarchyPage(AddUnit : Boolean); virtual;
// Module
procedure CreateModuleIndexPage(AModule: TPasModule); virtual;
procedure CreateModuleMainPageBody(AModule: TPasModule); virtual;
procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer); virtual;
// Per simple type
procedure CreateResStringsPage(aModule: TPasModule); virtual;
Procedure CreateTopicPageBody(AElement : TTopicElement); virtual;
procedure CreateConstPageBody(AConst: TPasConst); virtual;
procedure CreateTypePageBody(AType: TPasType); virtual;
procedure CreateVarPageBody(AVar: TPasVariable); virtual;
procedure CreateProcPageBody(AProc: TPasProcedureBase); virtual;
// Class/Record
procedure CreateClassMainPage(aClass: TPasClassType); virtual;
procedure CreateClassPageBody(AClass: TPasClassType; ASubpageIndex: Integer); virtual;
procedure CreateClassMemberPageBody(AElement: TPasElement); virtual;
procedure CreateInheritanceSubpage(aClass: TPasClassType; aTitle : string; AFilter: TMemberFilter); virtual;
procedure CreateSortedSubpage(ACLass: TPasClassType; aTitle : string; AFilter: TMemberFilter ); virtual;
public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
destructor Destroy; override;
// Single-page generation
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); override;
// Start producing html complete package documentation
function ModuleForElement(AnElement:TPasElement):TPasModule;
Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
Procedure WriteDoc; override;
Class Function FileNameExtension : String; override;
class procedure Usage(List: TStrings); override;
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
property OnTest: TNotifyEvent read FOnTest write SetOnTest;
Property IndexColCount : Integer Read FIndexColCount write FIndexColCount;
Property BaseImageURL : String Read FBaseImageURL Write FBaseImageURL;
Property HeaderMarkDown : TStrings Read GetHeaderMarkDown;
Property FooterMarkDown : TStrings Read GetFooterMarkDown;
property AdditionalConfig : TStrings Read GetAdditionalConfig;
end;
implementation
uses SysUtils, fpdocclasstree;
Function FixHTMLpath(S : String) : STring;
begin
Result:=StringReplace(S,'\','/',[rfReplaceAll]);
end;
constructor TMarkdownWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
begin
inherited Create(APackage, AEngine);
IndexColCount:=3;
FImageFileList := TStringList.Create;
FNavigation:=TStringList.Create;
end;
destructor TMarkdownWriter.Destroy;
begin
FreeAndNil(FImageFileList);
FreeAndNil(FAdditionalConfig);
FreeAndNil(FFooterMarkDown);
FreeAndNil(FHeaderMarkDown);
FreeAndNil(FNavigation);
inherited Destroy;
end;
procedure TMarkdownWriter.AddToNavigation(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer);
Procedure AddToNav(aLevel : Integer; aName,aFile : String);
begin
if aName<>'' then
aName:=''''+aName+''':';
if aFile<>'' then
aFile:=' '''+aFile+'''';
FNavigation.Add(StringOfChar(' ',aLevel*4)+'- '+aName+aFile);
end;
begin
if aElement is TPasPackage then
begin
case aSubPageIndex of
IdentifierIndex:
begin
AddToNav(1,SDocPackageLinkTitle,'');
AddToNav(2,SDocOverview,aFileName);
end;
IndexSubIndex : AddToNav(2,SDocIdentifierIndex,aFileName);
ClassHierarchySubIndex : AddToNav(2,SDocPackageClassHierarchy,aFileName);
end
end
else if (aElement is TPasModule) then
begin
case aSubPageIndex of
IdentifierIndex :
begin
AddToNav(1,Format(StringReplace(SDocUnitMenuTitle,'''','',[rfReplaceALl]),[aElement.Name]),'');
AddToNav(2,SDocOverview,aFileName);
end;
ResstrSubindex: AddToNav(2,SDocResStrings,aFileName);
ConstsSubindex: AddToNav(2,SDocConstants,aFileName);
TypesSubindex: AddToNav(2,SDocTypes,aFileName);
ClassesSubindex: AddToNav(2,SDocClasses,aFileName);
ProcsSubindex: AddToNav(2,SDocProceduresAndFunctions,aFileName);
VarsSubindex: AddToNav(2,SDocVariables,aFileName);
end;
end
end;
procedure TMarkdownWriter.WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer);
begin
if MarkDownEngine=meMkDocs then
AddToNavigation(aFileName,aElement,aSubPageIndex);
ClearMarkDown;
WriteMetaData;
AppendPageHeader;
CreatePageBody(AElement, ASubpageIndex);
AppendPageFooter;
SaveToFile(GetFileBaseDir(Engine.Output)+aFileName);
end;
procedure TMarkdownWriter.WriteMetadata;
begin
end;
procedure TMarkdownWriter.AppendPageHeader;
Var
S : String;
begin
if Assigned(FHeaderMarkDown) then
begin
EnsureEmptyLine;
For S in FHeaderMarkDown do
AppendToLine(S,False)
end;
end;
procedure TMarkdownWriter.WriteMkdocsYaml;
Var
mkDocs : TStrings;
begin
mkDocs:=TStringList.Create;
try
CreatemkDocsYaml(mkDocs);
mkDocs.SaveToFile(Engine.Output+PathDelim+'mkdocs.yml');
finally
Mkdocs.Free;
end;
end;
procedure TMarkdownWriter.CreateMkdocsYaml(mkDocs: TStrings);
begin
With MKDocs do
begin
add('site_name: '+SDocPackageTitle,[Package.Name]);
add('');
add('docs_dir: docs');
add('');
add('site_dir: site');
add('');
add('markdown_extensions:');
add(' - def_list');
add(' - codehilite');
add(' - admonition');
add('');
add('theme: '+Theme);
If Assigned(FAdditionalConfig) then
begin
add('');
AddStrings(FAdditionalConfig);
end;
add('');
add('nav:');
AddStrings(FNavigation);
end;
end;
procedure TMarkdownWriter.WriteDoc;
begin
Inherited;
If MarkDownEngine=memkDocs then
WriteMkdocsYaml;
end;
function TMarkdownWriter.GetFooterMarkDown: TStrings;
begin
If FFooterMarkDown=Nil then
FFooterMarkDown:=TStringList.Create;
Result:=FFooterMarkDown;
end;
function TMarkdownWriter.GetHeaderMarkDown: TStrings;
begin
If FHeaderMarkDown=Nil then
FHeaderMarkDown:=TStringList.Create;
Result:=FHeaderMarkDown;
end;
function TMarkdownWriter.ModuleForElement(AnElement:TPasElement):TPasModule;
begin
result:=TPasModule(AnElement);
while assigned(result) and not (result is TPasModule) do
result:=TPasModule(result.parent);
if not (result is TPasModule) then
result:=nil;
end;
procedure TMarkdownWriter.AppendShortDescr(AContext: TPasElement; DocNode: TDocNode) ;
Var
N : TDocNode;
begin
if Not Assigned(DocNode) then
exit;
N:=Nil;
If (DocNode.Link<>'') then
N:=Engine.FindLinkedNode(DocNode);
If (N=Nil) then
N:=DocNode;
If Assigned(N.ShortDescr) then
if not ConvertShort(AContext,N.ShortDescr) then
Warning(AContext, SErrInvalidShortDescr)
end;
procedure TMarkdownWriter.AppendShortDescr(Element: TPasElement);
begin
AppendShortDescr(Element,Engine.FindDocNode(Element));
end;
procedure TMarkdownWriter.AppendShortDescrCell(Element: TPasElement);
begin
if Not Assigned(Engine.FindShortDescr(Element)) then
exit;
DescrBeginTableCell;
AppendShortDescr(Element);
DescrEndTableCell;
end;
procedure TMarkdownWriter.AppendDescr(AContext: TPasElement; DescrNode: TDOMElement; AutoInsertBlock: Boolean);
begin
if Not Assigned(DescrNode) then
exit;
EnsureEmptyLine;
ConvertDescr(AContext, DescrNode, AutoInsertBlock);
end;
procedure TMarkdownWriter.AppendDescrSection(AContext: TPasElement; DescrNode: TDOMElement; const ATitle: String);
begin
if IsDescrNodeEmpty(DescrNode) then
exit;
If (ATitle<>'') then // Can be empty for topic.
AppendHeader(2,ATitle);
AppendDescr(AContext, DescrNode, True);
end;
procedure TMarkdownWriter.AppendDescrSection(AContext: TPasElement; DescrNode: TDOMElement; const ATitle: DOMString);
begin
AppendDescrSection(aContext,DescrNode,UTF8Encode(aTitle));
end;
procedure TMarkdownWriter.AppendHyperlink(Element: TPasElement);
begin
if Not Assigned(Element) then
begin
AppendText('<NIL>');
exit;
end;
AppendToLine(CreateHyperLink(Element),False)
end;
function TMarkdownWriter.CreateHyperlink(Element: TPasElement): string;
var
s: DOMString;
UnitList: TFPList;
i: Integer;
ThisPackage: TLinkNode;
begin
if Not Assigned(Element) then
Exit('\<NIL\>');
if Not Element.InheritsFrom(TPasUnresolvedTypeRef) then
begin
if Element is TPasEnumValue then
s := ResolveLinkID(Element.Parent.PathName)
else
s := ResolveLinkID(Element.PathName);
end
else
begin
s := ResolveLinkID(Element.Name);
if Length(s) = 0 then
begin
{ Try all packages }
ThisPackage := Engine.RootLinkNode.FirstChild;
while Assigned(ThisPackage) do
begin
s := ResolveLinkID(ThisPackage.Name + '.' + Element.Name);
if Length(s) > 0 then
break;
ThisPackage := ThisPackage.NextSibling;
end;
if Length(s) = 0 then
begin
{ Okay, then we have to try all imported units of the current module }
UnitList := Module.InterfaceSection.UsesList;
for i := UnitList.Count - 1 downto 0 do
begin
{ Try all packages }
ThisPackage := Engine.RootLinkNode.FirstChild;
while Assigned(ThisPackage) do
begin
s := ResolveLinkID(ThisPackage.Name + '.' +
TPasType(UnitList[i]).Name + '.' + Element.Name);
if Length(s) > 0 then
break;
ThisPackage := ThisPackage.NextSibling;
end;
if length(s)=0 then
s := ResolveLinkID('#rtl.System.' + Element.Name);
if Length(s) > 0 then
break;
end;
end;
end;
end;
if Length(s) > 0 then
Result:=CreateLink(Element.Name,UTF8Encode(S))
else
Result:=Element.Name;
end;
procedure TMarkdownWriter.AppendProcArgsSection(Element: TPasProcedureBase);
var
HasFullDescr, IsFirstType: Boolean;
ResultEl: TPasResultElement;
DocNode: TDocNode;
aList : TStringList;
Procedure CollectVariant(AProc: TPasProcedure);
var
i: Integer;
Arg: TPasArgument;
aType : TPasProcedureType;
begin
aType:=aProc.ProcType;
for I:=0 to aType.Args.Count-1 do
begin
Arg:=TPasArgument(aType.Args[i]);
if IsDescrNodeEmpty(Engine.FindShortDescr(Arg)) then
Continue;
aList.AddObject(Arg.Name,Arg);
end;
if (aType is TPasFunctionType) and (ResultEl=Nil) then
ResultEl:=TPasFunctionType(aType).ResultEl;
end;
Procedure WriteType(aProc : TPasProcedure; aName: string);
var
i: Integer;
Arg: TPasArgument;
aType : TPasProcedureType;
begin
aType:=aProc.ProcType;
for I:=0 to aType.Args.Count-1 do
begin
Arg:=TPasArgument(aType.Args[i]);
if SameText(Arg.Name,aName) then
begin
if not IsFirstType then
AppendText(', ');
AppendHyperlink(Arg.ArgType);
end;
if IsDescrNodeEmpty(Engine.FindShortDescr(Arg)) then
Continue;
aList.AddObject(Arg.Name,Arg);
end;
end;
Procedure WriteTypes(aName: string);
Var
I : Integer;
begin
IsFirstType:=True;
if Element.ClassType <> TPasOverloadedProc then
WriteType(TPasProcedure(Element),aName)
else for i := 0 to TPasOverloadedProc(Element).Overloads.Count - 1 do
WriteType(TPasProcedure(TPasOverloadedProc(Element).Overloads[i]),AName);
end;
Var
I: Integer;
begin
ResultEl:=Nil;
aList:=TStringList.Create;
try
AList.Duplicates:=DupIgnore;
if Element.ClassType <> TPasOverloadedProc then
CollectVariant(TPasProcedure(Element))
else for i := 0 to TPasOverloadedProc(Element).Overloads.Count - 1 do
CollectVariant(TPasProcedure(TPasOverloadedProc(Element).Overloads[i]));
If AList.Count<>0 then
begin
AppendHeader(2,SDocArguments);
AppendTableHeader([SDocName,SDocTypes,SDocDescription]);
for I:=0 to aList.Count-1 do
begin
DescrBeginTableRow;
DescrBeginTableCell;
AppendText(aList[i]);
DescrEndTableCell;
DescrBeginTableCell;
WriteTypes(aList[i]);
DescrEndTableCell;
AppendShortDescrCell(TPasArgument(aList.Objects[i]));
DescrEndTableRow;
end;
DescrEndTable;
end;
finally
aList.Free;
end;
if Not Assigned(ResultEl) then
Exit;
DocNode := Engine.FindDocNode(ResultEl);
HasFullDescr := Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr);
if HasFullDescr or
(Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.ShortDescr)) then
begin
AppendHeader(2, SDocFunctionResult);
if HasFullDescr then
AppendDescr(ResultEl,DocNode.Descr, True)
else
AppendDescr(ResultEl,DocNode.ShortDescr, False);
end;
end;
procedure TMarkdownWriter.AppendSourceRef(AElement: TPasElement);
begin
EnsureEmptyLine;
AppendToLine(Format(SDocSourcePosition,
[ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
EnsureEmptyLine;
end;
procedure TMarkdownWriter.CollectSeeAlsoNodes(aList : TStringList; aSeeAlso: TDomNode);
Var
Node : TDOMNode;
L : String;
El : TDOMElement;
begin
Node:=aSeeAlso.FirstChild;
While Assigned(Node) do
begin
if (Node.NodeType=ELEMENT_NODE) and (Node.NodeName='link') then
begin
El:=TDOMElement(Node);
l:=UTF8encode(El['id']);
aList.AddObject(L,El);
end;
Node:=Node.NextSibling;
end;
end;
procedure TMarkdownWriter.CollectDeclarationTypes(aList : TStringList; aElement : TPasElement);
Procedure MaybeAdd(aType : TPasType);
Var
N : TDocNode;
begin
if aType is TPasPointerType then
aType:=TPasPointerType(aType).DestType;
if (aType=Nil) or (aType.Name='') then
exit;
N:=Engine.FindDocNode(aType);
if N<>Nil then
aList.AddObject(aType.Name,aType);
end;
Var
I : integer;
begin
if aElement is TPasVariable then
MaybeAdd(TPasVariable(aElement).VarType)
else if aElement is TPasMembersType then
begin
for I:=0 to TPasMembersType(aElement).Members.Count-1 do
if TObject(TPasMembersType(aElement).Members[i]) is TPasVariable then
MaybeAdd(TPasVariable(TPasMembersType(aElement).Members[i]).VarType);
end;
end;
procedure TMarkdownWriter.AppendSeeAlsoSection(AElement: TPasElement; DocNode: TDocNode) ;
Procedure AppendSeeALso(aID : String; El: TDomElement);
Var
S,N : DOMString;
doBold : Boolean;
begin
s:= ResolveLinkID(aID);
doBold:=Length(S)=0;
if DoBold then
begin
if assigned(module) then
s:=UTF8Decode(module.name)
else
s:='?';
if aID='' then aID:='<empty>';
if Assigned(AElement) then
N:=UTF8Decode(AElement.Name)
else
N:='?';
DoLog(SErrUnknownLinkID, [s,N,aID]);
end ;
if doBold then
DescrBeginBold
else
DescrBeginURL(S);
if Not IsDescrNodeEmpty(El) then
ConvertBaseShortList(AElement, El, True)
else
AppendText(aID);
if doBold then
DescrEndBold
else
DescrEndURL();
end;
Procedure AppendTypeRef(aName : String; El: TPasType);
begin
AppendHyperLink(El);
end;
var
I : Integer;
aList : TStringList;
DescrEl : TDomElement;
begin
if Not (Assigned(DocNode) and Assigned(DocNode.SeeAlso)) then
Exit;
AList:=TStringList.Create;
Try
aList.Duplicates:=dupIgnore;
// AList will have a TDomElement (seealso) or a TPasType element as object
CollectSeeAlsoNodes(aList,DocNode.SeeAlso);
CollectDeclarationTypes(aList,aElement);
if aList.Count = 0 then
exit;
aList.Sort;
AppendHeader(2,SDocSeeAlso);
AppendTableHeader([SDocName,SDocDescription]);
For I:=0 to aList.Count-1 do
begin
DescrEl:=Nil;
DescrBeginTableRow;
DescrBeginTableCell;
if aList.Objects[I] is TDomElement then
AppendSeeAlso(aList[i],TDomElement(aList.Objects[i]))
else if aList.Objects[i] is TPasType then
AppendTypeRef(aList[i],TPasType(aList.Objects[i]));
DescrEndTableCell;
DescrBeginTableCell;
DescrEl:=Engine.FindShortDescr(ModuleForElement(AElement),UTF8Encode(aList[i]));
if Assigned(DescrEl) then
ConvertShort(AElement, DescrEl)
else
AppendToLine(' ',False);
DescrEndTableCell;
DescrEndTableRow;
end;
DescrEndTable;
Finally
aList.Free;
end;
end;
procedure TMarkdownWriter.AppendExampleSection ( AElement: TPasElement;
DocNode: TDocNode ) ;
var
Node: TDOMNode;
fn,s: String;
f: Text;
begin
if not (Assigned(DocNode) and Assigned(DocNode.FirstExample)) then
Exit;
Node := DocNode.FirstExample;
while Assigned(Node) do
begin
if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'example') then
begin
fn:=Engine.GetExampleFilename(TDOMElement(Node));
If (fn<>'') then
begin
AppendHeader(2, SDocExample);
try
Assign(f, FN);
Reset(f);
try
DescrBeginCode(False, UTF8Encode(TDOMElement(Node)['highlighter']));
while not EOF(f) do
begin
ReadLn(f, s);
DescrWriteCodeLine(s);
end;
finally
Close(f);
DescrEndCode;
end;
except
on e: Exception do
begin
e.Message := '[example] ' + e.Message;
raise;
end;
end;
end;
end;
Node := Node.NextSibling;
end;
end;
procedure TMarkdownWriter.AppendPageFooter;
Var
S : String;
begin
if Assigned(FFooterMarkDown) then
begin
EnsureEmptyLine;
For S in FFooterMarkDown do
AppendToLine(S,False)
end;
end;
procedure TMarkdownWriter.FinishElementPage(AElement: TPasElement; SkipDescription : Boolean = false);
var
DocNode: TDocNode;
begin
DocNode := Engine.FindDocNode(AElement);
If Not Assigned(DocNode) then
exit;
// Description
if Assigned(DocNode.Descr) and not SkipDescription then
AppendDescrSection(AElement, DocNode.Descr, UTF8Encode(SDocDescription));
// Append "Errors" section
if Assigned(DocNode.ErrorsDoc) then
AppendDescrSection(AElement, DocNode.ErrorsDoc, UTF8Encode(SDocErrors));
// Append Version info
if Assigned(DocNode.Version) then
AppendDescrSection(AElement, DocNode.Version, UTF8Encode(SDocVersion));
// Append "See also" section
AppendSeeAlsoSection(AElement,DocNode);
// Append examples, if present
AppendExampleSection(AElement,DocNode);
// Append notes, if present
ConvertNotes(AElement,DocNode.Notes);
end;
procedure TMarkdownWriter.CreateTopicPageBody(AElement: TTopicElement);
var
DocNode: TDocNode;
begin
DocNode:=AElement.TopicNode;
if not Assigned(DocNode) then // should always be true, but we're being careful.
exit;
AppendShortDescr(AElement, DocNode);
if Assigned(DocNode.Descr) then
AppendDescrSection(AElement, DocNode.Descr, '');
AppendSeeAlsoSection(AElement,DocNode);
CreateTopicLinks(DocNode,AElement);
AppendExampleSection(AElement,DocNode);
ConvertNotes(AElement,DocNode.Notes);
end;
procedure TMarkdownWriter.CreateClassHierarchyPage(AddUnit : Boolean);
type
TypeEN = (NPackage, NModule, NName);
Procedure AddClassList;
begin
DescrBeginUnorderedList;
end;
Procedure EndClassList;
begin
DescrEndUnorderedList;
end;
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
PE,PM : TPasElement;
I : Integer;
begin
if not Assigned(EN) then exit;
PE:=EN.Element;
DescrBeginListItem;
AppendHyperLink(PE);
PM:=ModuleForElement(PE);
if (PM<>Nil) then
begin
AppendText(' (');
AppendHyperLink(PM);
AppendText(')');
end
else
AppendText(EN.Element.Name);
if EN.ChildCount>0 then
begin
AddClassList;
For I:=0 to EN.ChildCount-1 do
AppendClass(EN.Children[i] as TPasElementNode);
EndClassList;
end;
DescrEndListItem;
end;
begin
AddClassList;
AppendClass(TreeClass.RootNode);
EndClassList;
end;
procedure TMarkdownWriter.CreatePackageClassHierarchy;
Var
S : String;
begin
S:=Package.Name;
If Length(S)>0 then
Delete(S,1,1);
AppendTitle(SDocPackageClassHierarchy, [S]);
CreateClassHierarchyPage(True);
end;
procedure TMarkdownWriter.CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer);
var
i: Integer;
Element: TPasElement;
begin
CurDirectory := Allocator.GetFilename(AElement, ASubpageIndex);
i := Length(CurDirectory);
while (i > 0) and not (CurDirectory[i] in AllowDirectorySeparators) do
Dec(i);
CurDirectory := Copy(CurDirectory, 1, i);
BaseDirectory := Allocator.GetRelativePathToTop(AElement);
if AElement.ClassType = TPasPackage then
begin
Module:=Nil;
If (ASubPageIndex=0) then
CreatePackagePageBody
else if ASubPageIndex=IndexSubIndex then
CreatePackageIndex
else if ASubPageIndex=ClassHierarchySubIndex then
CreatePackageClassHierarchy
end
else
begin
Element := AElement;
while (Element<>Nil) and (not (Element.ClassType.inheritsfrom(TPasModule))) do
Element := Element.Parent;
Module := TPasModule(Element);
if AElement.ClassType.inheritsfrom(TPasModule) then
CreateModulePageBody(TPasModule(AElement), ASubpageIndex)
else if AElement.Parent.InheritsFrom(TPasClassType) then
CreateClassMemberPageBody(AElement)
else if AElement.ClassType = TPasConst then
CreateConstPageBody(TPasConst(AElement))
else if AElement.InheritsFrom(TPasClassType) then
CreateClassPageBody(TPasClassType(AElement), ASubpageIndex)
else if AElement.InheritsFrom(TPasType) then
CreateTypePageBody(TPasType(AElement))
else if AElement.ClassType = TPasVariable then
CreateVarPageBody(TPasVariable(AElement))
else if AElement.InheritsFrom(TPasProcedureBase) then
CreateProcPageBody(TPasProcedureBase(AElement))
else if AElement.ClassType = TTopicELement then
CreateTopicPageBody(TTopicElement(AElement))
else if AElement.ClassType = TPasProperty then
CreateClassMemberPageBody(TPasProperty(AElement))
else
writeln('Unknown classtype: ',AElement.classtype.classname);
end;
end;
procedure TMarkdownWriter.CreateIndexPage(L : TStringList);
Var
Lists : Array['A'..'Z'] of TStringList;
CL : TStringList;
E : TPasElement;
CCount,I,Rows,J,Index : Integer;
S : String;
C : Char;
begin
For C:='A' to 'Z' do
Lists[C]:=Nil;
L.Sort;
Cl:=Nil;
// Divide over alphabet
For I:=0 to L.Count-1 do
begin
S:=L[i];
E:=TPasElement(L.Objects[i]);
If not (E is TPasUnresolvedTypeRef) then
begin
If (S<>'') then
begin
C:=Upcase(S[1]);
If C='_' then
C:='A';
If (C in ['A'..'Z']) and (Lists[C]=Nil) then
begin
CL:=TStringList.Create;
Lists[C]:=CL;
end;
end;
if assigned(cl) then
CL.AddObject(S,E);
end;
end;
Try
// Create a quick jump table to all available letters.
CCount:=0;
for C:='A' to 'Z' do
If (Lists[C]<>Nil) then
Inc(CCount);
DescrBeginTable(CCount,False);
DescrBeginTableHeadRow;
for C:='A' to 'Z' do
If (Lists[C]<>Nil) then
begin
DescrBeginTableCell;
AppendLink(C,'#'+LowerCase(C));
DescrendTableCell;
end;
DescrEndTableHeadRow;
// Now emit all identifiers.
For C:='A' to 'Z' do
begin
CL:=Lists[C];
If CL<>Nil then
begin
AppendHeader(3,C);
DescrBeginTable(IndexColCount,False);
DescrBeginTableHeadRow;
For I:=1 to IndexColCount do
begin
DescrBeginTableCell;
AppendToLine('&nbsp; ',False);
DescrEndTableCell;
end;
DescrEndTableHeadRow;
// Determine number of rows needed
Rows:=(CL.Count div IndexColCount);
If ((CL.Count Mod IndexColCount)<>0) then
Inc(Rows);
// Fill rows
For I:=0 to Rows-1 do
begin
DescrBeginTableRow;
For J:=0 to IndexColCount-1 do
begin
DescrBeginTableCell;
Index:=(J*Rows)+I;
If (Index<CL.Count) then
begin
S:=CL[Index];
E:=TPasElement(CL.Objects[Index]);
AppendHyperlink(E);
end;
end;
DescrEndTableRow;
end;
end; // have List
end; // For C:=
Finally
for C:='A' to 'Z' do
FreeAndNil(Lists[C]);
end;
end;
procedure TMarkdownWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
begin
if assigned(AModule.InterfaceSection) Then
begin
AddElementsFromList(L,AModule.InterfaceSection.Consts);
AddElementsFromList(L,AModule.InterfaceSection.Types);
AddElementsFromList(L,AModule.InterfaceSection.Functions);
AddElementsFromList(L,AModule.InterfaceSection.Classes);
AddElementsFromList(L,AModule.InterfaceSection.Variables);
AddElementsFromList(L,AModule.InterfaceSection.ResStrings);
end;
end;
procedure TMarkdownWriter.CreatePackageIndex;
Var
L : TStringList;
I : Integer;
M : TPasModule;
S : String;
begin
L:=TStringList.Create;
try
L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
For I:=0 to Package.Modules.Count-1 do
begin
M:=TPasModule(Package.Modules[i]);
L.AddObject(M.Name,M);
AddModuleIdentifiers(M,L);
end;
S:=Package.Name;
If Length(S)>0 then
Delete(S,1,1);
AppendTitle(SDocPackageIndex, [S]);
CreateIndexPage(L);
Finally
L.Free;
end;
end;
procedure TMarkdownWriter.CreatePackagePageBody;
var
DocNode: TDocNode;
i: Integer;
ThisModule: TPasModule;
L : TStringList;
begin
AppendTitle(SDocPackageTitle, [Copy(Package.Name, 2, 256)]);
AppendShortDescr(Package);
AppendHeader(2,SDocUnits);
L:=TStringList.Create;
Try
L.Sorted:=True;
// Sort modules.
For I:=0 to Package.Modules.Count-1 do
L.AddObject(TPasModule(Package.Modules[i]).Name,TPasModule(Package.Modules[i]));
AppendTableHeader([SDocUnits,SDocDescription]);
// Now create table.
for i:=0 to L.Count - 1 do
begin
ThisModule := TPasModule(L.Objects[i]);
DescrBeginTableRow;
DescrBeginTableCell;
AppendHyperlink(ThisModule);
DescrEndTableCell;
AppendShortDescrCell(ThisModule);
DescrEndTableRow;
end;
DescrEndTable;
Finally
L.Free;
end;
DocNode := Engine.FindDocNode(Package);
if Assigned(DocNode) then
begin
if Assigned(DocNode.Descr) then
AppendDescrSection(nil, DocNode.Descr, UTF8Decode(SDocDescription));
CreateTopicLinks(DocNode,Package);
end;
end;
procedure TMarkdownWriter.CreateTopicLinks ( Node: TDocNode; PasElement: TPasElement ) ;
var
DocNode: TDocNode;
First : Boolean;
ThisTopic: TPasElement;
begin
DocNode:=Node.FirstChild;
First:=True;
While Assigned(DocNode) do
begin
If DocNode.TopicNode then
begin
if first then
begin
First:=False;
AppendHeader(2,SDocRelatedTopics);
AppendTableHeader([SDocTopic,SDocDescription]);
end;
ThisTopic:=FindTopicElement(DocNode);
if Assigned(ThisTopic) then
begin
DescrBeginTableRow;
DescrBeginTableCell;
AppendHyperlink(ThisTopic);
DescrEndTableCell;
AppendShortDescrCell(ThisTopic);
DescrEndTableRow;
end;
end;
DocNode:=DocNode.NextSibling;
end;
if not First then
DescrEndTable;
end;
function TMarkdownWriter.GetFileBaseDir(aOutput: String): String;
begin
Result:=inherited GetFileBaseDir(aOutput)+'docs'+pathdelim;
end;
procedure TMarkdownWriter.CreateModuleIndexPage(AModule: TPasModule);
Var
L : TStringList;
begin
L:=TStringList.Create;
try
AddModuleIdentifiers(AModule,L);
AppendTitle(SDocModuleIndex, [AModule.Name]);
CreateIndexPage(L);
Finally
L.Free;
end;
end;
procedure TMarkdownWriter.CreateModuleMainPageBody(AModule: TPasModule);
var
i: Integer;
UnitRef: TPasType;
DocNode: TDocNode;
begin
AppendTitle(SDocUnitTitle, [AModule.Name]);
AppendShortDescr(AModule);
if AModule.InterfaceSection.UsesList.Count > 0 then
begin
AppendTableHeader(['Uses unit',SDocDescription]);
for i := 0 to AModule.InterfaceSection.UsesList.Count - 1 do
begin
UnitRef := TPasType(AModule.InterfaceSection.UsesList[i]);
DocNode := Engine.FindDocNode(UnitRef);
if Assigned(DocNode) and DocNode.IsSkipped then
continue;
DescrBeginTableRow;
DescrBeginTableCell;
AppendHyperlink(UnitRef);
DescrEndTableCell;
AppendShortDescrCell(UnitRef);
end;
DescrEndTable;
end;
DocNode := Engine.FindDocNode(AModule);
if Assigned(DocNode) then
begin
if Assigned(DocNode.Descr) then
AppendDescrSection(AModule, DocNode.Descr, UTF8Decode(SDocOverview));
ConvertNotes(AModule,DocNode.Notes);
CreateTopicLinks(DocNode,AModule);
end;
end;
procedure TMarkdownWriter.CreateSimpleSubpage(aModule : TPasModule; const ATitle,aItem: String; AList: TFPList);
var
i: Integer;
Decl: TPasElement;
SortedList: TFPList;
DocNode: TDocNode;
begin
AppendTitle(SDocUnitTitle + ': %s', [AModule.Name, aTitle]);
SortedList := TFPList.Create;
try
for i := 0 to AList.Count - 1 do
begin
Decl := TPasElement(AList[i]);
DocNode := Engine.FindDocNode(Decl);
if not (Assigned(DocNode) and DocNode.IsSkipped) then
SortedList.Add(Decl);
end;
SortedList.Sort(@SortPasElements);
AppendTableHeader([aItem,SDocDescription]);
for i := 0 to SortedList.Count - 1 do
begin
Decl:=TPasElement(SortedList[i]);
DescrBeginTableRow;
DescrBeginTableCell;
AppendHyperlink(Decl);
DescrEndTableCell;
AppendShortDescrCell(Decl);
DescrEndTableRow;
end;
DescrEndTable;
finally
SortedList.Free;
end;
end;
procedure TMarkdownWriter.CreateResStringsPage(aModule : TPasModule);
var
i: Integer;
Decl: TPasResString;
begin
AppendTitle(SDocUnitTitle + ': %s', [AModule.Name, SDocResStrings]);
If AModule.InterfaceSection.ResStrings.Count = 0 then
exit;
for i := 0 to AModule.InterfaceSection.ResStrings.Count - 1 do
begin
Decl := TPasResString(AModule.InterfaceSection.ResStrings[i]);
AppendToLine('<a name="%s"> %s',[LowerCase(Decl.Name),Decl.Name]);
Indent;
UTF8Decode(Decl.Expr.getDeclaration(true));
undent;
end;
end;
procedure TMarkdownWriter.CreateModulePageBody(AModule: TPasModule;
ASubpageIndex: Integer);
begin
case ASubpageIndex of
0:
CreateModuleMainPageBody(aModule);
ResstrSubindex:
CreateResStringsPage(aModule);
ConstsSubindex:
CreateSimpleSubpage(aModule,SDocConstants, SDocConstant, AModule.InterfaceSection.Consts);
TypesSubindex:
CreateSimpleSubpage(aModule,SDocTypes, SDocType, AModule.InterfaceSection.Types);
ClassesSubindex:
CreateSimpleSubpage(aModule,SDocClasses, SDocClass, AModule.InterfaceSection.Classes);
ProcsSubindex:
CreateSimpleSubpage(aModule,SDocProceduresAndFunctions, SDocProcedureOrFunction, AModule.InterfaceSection.Functions);
VarsSubindex:
CreateSimpleSubpage(aModule,SDocVariables, SDocVariable, AModule.InterfaceSection.Variables);
IndexSubIndex:
CreateModuleIndexPage(AModule);
end;
end;
procedure TMarkdownWriter.CreateConstPageBody(AConst: TPasConst);
begin
AppendTitle(AConst.Name);
AppendShortDescr(AConst);
AppendHeader(2,SDocDeclaration);
AppendSourceRef(AConst);
DescrBeginCode(False,'Pascal');
EmitLine('const');
EmitLine(aConst.GetDeclaration(True));
DescrEndCode;
FinishElementPage(AConst);
end;
procedure TMarkdownWriter.CreateTypePageBody(AType: TPasType);
begin
AppendTitle(AType.Name);
AppendShortDescr(AType);
AppendHeader(2,SDocDeclaration);
AppendSourceRef(AType);
DescrBeginCode(False,'Pascal');
EmitLine('Type');
EmitLine(aType.GetDeclaration(True));
DescrEndCode;
FinishElementPage(AType);
end;
procedure TMarkdownWriter.CreateMemberDeclarations(AParent: TPasElement; Members: TFPList; Options: TMemberListOptions);
function GetMemberType(aMember : TPasElement) : string;
begin
if aMember is TPasProcedure then
Result:=SDocMethod
else if aMember is TPasProperty then
Result:=SDocProperty
else if aMember is TPasConst then
Result:=SDocConstant
else if aMember is TPasType then
Result:=SDocType
else
Result:=SDocField;
end;
var
Member: TPasElement;
MVisibility : TPasMemberVisibility;
i,aCount: Integer;
// isRecord,
isOverLoad : Boolean;
begin
// isRecord:=AParent is TPasRecordType;
if Members.Count = 0 then
begin
AppendText(SDocNoneAVailable);
Exit;
end;
if mloAppendType in Options then
AppendTableHeader([SDocMember,SDocType,SDocVisibility,SDocDescription])
else
AppendTableHeader([SDocMember,SDocVisibility,SDocDescription]);
aCount:=0;
Members.Sort(@SortPasElements);
for i := 0 to Members.Count - 1 do
begin
Member := TPasElement(Members[i]);
MVisibility:=Member.Visibility;
if mloCheckVisibility in Options then
if not Engine.ShowElement(Member) then
Continue;
isOverLoad:=(Member is TPasOverloadedProc);
if isOverload then
Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]);
Inc(aCount);
DescrBeginTableRow;
DescrBeginTableCell;
AppendHyperlink(Member);
if mloAppendParent in options then
begin
AppendText('(');
AppendHyperLink(Member.Parent);
AppendText(')');
end;
DescrEndTableCell;
if mloAppendType in Options then
begin
DescrBeginTableCell;
AppendText(GetMemberType(Member));
DescrEndTableCell;
end;
DescrBeginTableCell;
AppendText(VisibilityNames[MVisibility]);
DescrEndTableCell;
AppendShortDescrCell(member);
DescrEndTableRow;
end;
DescrEndTable;
if ACount=0 then
AppendText(SDocNoneAVailable)
end;
procedure TMarkdownWriter.AppendTitle(const S: String);
begin
AddMetaData('title',S);
AppendHeader(1,S);
EnsureEmptyLine;
end;
procedure TMarkdownWriter.AppendTitle(const Fmt: String;
const Args: array of const);
begin
AppendTitle(Format(Fmt,Args));
end;
function TMarkdownWriter.GetClassDeclarationFirstLine(aEl: TPasClassType): String;
Var
aLine : string;
I : Integer;
begin
aLine:=aEL.Name;
if aEl.GenericTemplateTypes.Count>0 then
begin
aLine:='generic '+aLine+'<';
For I:=0 to aEl.GenericTemplateTypes.Count-1 do
begin
if I>0 then
aLine:=aLine+', ';
aLine:=aLine+TPasGenericTemplateType(aEl.GenericTemplateTypes[i]).Name;
end;
aLine:=aLine+'>';
end;
aLine:=aLine+' = '+aEl.ElementTypeName;
if aEl.HelperForType<>Nil then
aLine:=aLine+' for '+aEl.HelperForType.Name;
if aEL.ExternalName<>'' then
aLine:=aLine+' external name '''+ael.ExternalName+'''';
if Assigned(aEL.AncestorType) then
begin
aLine:=aLine+' ('+ael.AncestorType.Name;
if Assigned(ael.Interfaces) and (aEl.Interfaces.Count>0) then
For I:=0 to aEl.Interfaces.Count-1 do
aLine:=aLine+', '+TPasElement(aEl.Interfaces[i]).Name;
aLine:=aLine+')';
end;
if Assigned(aEl.GUIDExpr) then
aLine:=aLine+' ['+aEl.GUIDExpr.GetDeclaration(True)+']';
Result:=aLine;
end;
function TMarkdownWriter.GetClassDeclaration(aEl: TPasClassType): String;
Var
S,T : TStrings;
I,J : Integer;
LastVis : TPasMemberVisibility;
aMember : TPasElement;
begin
T:=Nil;
lastVis:=VisDefault;
S:=TStringList.Create;
try
T:=TStringList.Create;
S.Add(GetClassDeclarationFirstLine(aEl));
for I:=0 to aEl.Members.Count-1 do
begin
aMember:=TPasElement(aEl.Members[i]);
if aMember.Visibility<>LastVis then
begin
LastVis:=aMember.Visibility;
S.Add(VisibilityNames[LastVis]);
end;
T.Text:=GetDeclaration(aMember);
for J:=0 to T.count-1 do
S.Add(' '+T[J]);
end;
if not aEl.IsShortDefinition then
S.Add('end');
Result:=S.Text;
finally
S.Free;
T.Free;
end;
end;
function TMarkdownWriter.GetDeclaration(aEl: TPasElement): String;
Var
I : Integer;
Ovl : TPasOverloadedProc;
S : String;
begin
if (aEl is TPasClassType) then
exit(GetClassDeclaration(TPasClassType(aEl))+';');
if Not (aEl is TPasOverloadedProc) then
Exit(aEl.GetDeclaration(True)+';');
ovl:=aEl as TPasOverloadedProc;
S:='';
for I:=0 to ovl.Overloads.Count-1 do
begin
if s<>'' then
S:=S+sLineBreak;
S:=S+TPasElement(Ovl.Overloads[i]).GetDeclaration(True)+';';
end;
Result:=S;
end;
procedure TMarkdownWriter.AppendDeclaration(aEl : TPasElement; aKind : string; PrependVisibility : Boolean);
Var
S : String;
begin
DescrBeginCode(False,'Pascal');
if PrependVisibility then
S:=VisibilityNames[aEL.Visibility]+' '
else
S:='';
S:=S+aKind;
EmitLine(S);
S:=GetDeclaration(aEl);
EmitCode(S,2);
DescrEndCode;
end;
procedure TMarkdownWriter.CreateClassMainPage(aClass : TPasClassType);
procedure AppendMemberListLink(AListSubpageIndex: Integer; const AText: String);
begin
AppendToLine('\[',False);
AppendLink(aText,FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex)));
AppendText(' (');
AppendLink(SDocByName,FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex+1)));
AppendToLine(')\]',False);
end;
var
i: Integer;
ThisInterface,
ThisClass: TPasClassType;
ThisTreeNode: TPasElementNode;
DocNode: TDocNode;
begin
DocNode := Engine.FindDocNode(aClass);
//WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
AppendTitle(AClass.Name);
AppendMemberListLink(PropertiesByInheritanceSubindex,SDocProperties);
AppendMemberListLink(MethodsByInheritanceSubindex, SDocMethods);
AppendMemberListLink(EventsByInheritanceSubindex, SDocEvents);
EnsureEmptyLine;
AppendShortDescr(AClass);
AppendHeader(2,SDocDeclaration);
AppendSourceRef(AClass);
AppendDeclaration(aClass,'Type',False);
// Description
if Assigned(DocNode) and Assigned(DocNode.Descr) then
AppendDescrSection(aClass, DocNode.Descr, SDocDescription);
AppendHeader(2,SDocMembers);
CreateMemberDeclarations(aClass, AClass.Members,[mloAppendType]);
AppendHeader(2,SDocInheritance);
EnsureEmptyLine;
AppendTableHeader([SDocClass,SDocDescription]);
ThisClass := AClass;
ThisTreeNode := Nil;
if AClass.ObjKind = okInterface then
ThisTreeNode := TreeInterface.GetPasElNode(AClass)
else
ThisTreeNode := TreeClass.GetPasElNode(AClass);
while True do
begin
DescrBeginTableRow;
DescrBeginTableCell;
// Show class item
if Assigned(ThisClass) Then
AppendHyperlink(ThisClass);
if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
begin
AppendText('(');
for i:=0 to ThisClass.interfaces.count-1 do
begin
ThisInterface:=TPasClassType(ThisClass.Interfaces[i]);
if I>0 then
AppendText(', ');
AppendHyperlink( ThisInterface);
end;
AppendText(')');
end;
DescrEndTableCell;
AppendShortDescrCell(ThisClass);
DescrEndTableRow;
if Not Assigned(ThisTreeNode) then
Break
else if not Assigned(ThisTreeNode.ParentNode) then
begin
ThisClass := nil;
ThisTreeNode:= nil;
break;
end
else
begin
DescrBeginTableRow;
DescrBeginTableCell;
AppendText('|');
DescrEndTableCell;
DescrBeginTableCell;
DescrEndTableCell;
ThisClass := ThisTreeNode.ParentNode.Element;
ThisTreeNode := ThisTreeNode.ParentNode;
end;
end;
DescrEndTable;
FinishElementPage(AClass,True);
end;
procedure TMarkdownWriter.CreateInheritanceSubpage(aClass: TPasClassType; aTitle: string; AFilter: TMemberFilter);
var
ThisClass: TPasClassType;
i,aCount: Integer;
Member: TPasElement;
aList : TFPList;
begin
aTitle:=aClass.Name+' : '+aTitle+ ' '+SDocByInheritance;
AppendTitle(aTitle);
ThisClass := AClass;
aCount:=0;
aList:=TFPList.Create;
try
while assigned(ThisClass) do
begin
aList.Clear;
for i := 0 to ThisClass.Members.Count - 1 do
begin
Member := TPasElement(ThisClass.Members[i]);
if (Engine.ShowElement(Member) and AFilter(Member)) then
aList.Add(Member);
end;
aCount:=aCount+aList.Count;
if AList.Count>0 then
begin
AppendHeader(2,CreateHyperLink(ThisClass),False);
CreateMemberDeclarations(aClass, aList, []);
end;
if ThisClass.AncestorType is TPasClassType then
ThisClass := TPasClassType(ThisClass.AncestorType)
else
ThisClass:=Nil;
end;
if aCount=0 then
AppendText(SDocNoneAVailable);
finally
aList.Free;
end;
end;
procedure TMarkdownWriter.CreateSortedSubpage(ACLass: TPasClassType; aTitle: string; AFilter: TMemberFilter);
var
List: TFPList;
ThisClass: TPasClassType;
i : Integer;
Member: TPasElement;
begin
aTitle:=aClass.Name+' : '+aTitle+' '+SDocByName;
AppendTitle(aTitle);
List := TFPList.Create;
try
ThisClass := AClass;
while Assigned(ThisClass) do
begin
for i := 0 to ThisClass.Members.Count - 1 do
begin
Member := TPasElement(ThisClass.Members[i]);
if Engine.ShowElement(Member) and AFilter(Member) then
List.Add(Member)
end;
if (ThisClass.AncestorType is TPasClassType) then
ThisClass := TPasClassType(ThisClass.AncestorType)
else
ThisClass := Nil;
end;
CreateMemberDeclarations(aClass, List, [mloAppendParent]);
finally
List.Free;
end;
end;
function TMarkdownWriter.GetAdditionalConfig: TStrings;
begin
if FAdditionalConfig=Nil then
FAdditionalConfig:=TstringList.Create;
Result:=FAdditionalConfig;
end;
procedure TMarkdownWriter.CreateClassPageBody(AClass: TPasClassType;
ASubpageIndex: Integer);
begin
case ASubpageIndex of
0:
CreateClassMainPage(aClass);
PropertiesByInheritanceSubindex:
CreateInheritanceSubpage(aClass,SDocPropertyOverview,@PropertyFilter);
PropertiesByNameSubindex:
CreateSortedSubpage(aClass,SDocPropertyOverview, @PropertyFilter);
MethodsByInheritanceSubindex:
CreateInheritanceSubpage(aClass,SDocMethodOverview,@MethodFilter);
MethodsByNameSubindex:
CreateSortedSubpage(aClass,SDocMethodOverview,@MethodFilter);
EventsByInheritanceSubindex:
CreateInheritanceSubpage(aClass,SDocEventOverview,@EventFilter);
EventsByNameSubindex:
CreateSortedSubpage(aClass,SDocEventOverview, @EventFilter);
end;
end;
procedure TMarkdownWriter.CreateClassMemberPageBody(AElement: TPasElement);
procedure CreateVarPage(Element: TPasVariable);
begin
AppendDeclaration(Element,'Var',True);
end;
procedure CreateTypePage(Element: TPasType);
begin
AppendDeclaration(Element,'Type',True);
end;
procedure CreateConstPage(Element: TPasConst);
begin
AppendDeclaration(Element,'Const',True);
end;
procedure CreatePropertyPage(Element: TPasProperty);
begin
AppendDeclaration(Element,'Property',True);
end;
var
s: String;
begin
AppendTitle(aElement.FullName);
AppendShortDescr(AElement);
AppendHeader(2, SDocDeclaration);
AppendSourceRef(AElement);
if AElement is TPasProperty then
S:='Property'
else if AElement is TPasConst then
S:='Const'
else if (AElement is TPasVariable) then
S:='var'
else if AElement is TPasProcedureBase then
s:=''
else if AElement is TPasType then
S:='Type'
else
AppendText('<' + AElement.ClassName + '>');
AppendDeclaration(aElement,S,True);
FinishElementPage(AElement);
end;
procedure TMarkdownWriter.CreateVarPageBody(AVar: TPasVariable);
begin
AppendTitle(AVar.FullName);
AppendShortDescr(AVar);
AppendHeader(2, SDocDeclaration);
AppendSourceRef(AVar);
AppendDeclaration(aVar,'var',false);
FinishElementPage(AVar);
end;
procedure TMarkdownWriter.CreateProcPageBody(AProc: TPasProcedureBase);
begin
AppendTitle(AProc.Name);
AppendShortDescr(AProc);
AppendHeader(2,SDocDeclaration);
AppendSourceRef(AProc);
AppendDeclaration(AProc,'',False);
FinishElementPage(AProc);
end;
function TMarkdownWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
procedure ReadFile(aStrings : TStrings; aFileName : string);
begin
aFileName:= SetDirSeparators(aFileName);
if copy(aFileName,1,1)<>'@' then
aStrings.text:=aFileName
else
begin
Delete(aFileName,1,1);
aStrings.LoadFromFile(aFileName);
end;
end;
begin
Result:=True;
if Cmd = '--footer' then
ReadFile(FooterMarkDown,Arg)
else if Cmd = '--header' then
ReadFile(HeaderMarkDown,Arg)
else if Cmd = '--index-colcount' then
IndexColCount := StrToIntDef(Arg,IndexColCount)
else if Cmd = '--image-url' then
FBaseImageURL := Arg
else if Cmd = '--theme' then
if arg='-' then
Theme:=''
else
Theme := Arg
end;
class procedure TMarkdownWriter.Usage(List: TStrings);
begin
List.add('--header=file');
List.Add(SHTMLUsageHeader);
List.add('--footer=file');
List.Add(SHTMLUsageFooter);
List.Add('--index-colcount=N');
List.Add(SHTMLIndexColcount);
List.Add('--image-url=url');
List.Add(SHTMLImageUrl);
end;
class procedure TMarkdownWriter.SplitImport(var AFilename, ALinkPrefix: String);
var
i: integer;
begin
i := Pos(',', AFilename);
if i > 0 then
begin //split into filename and prefix
ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
SetLength(AFilename, i-1);
end
else if ALinkPrefix = '' then
begin //synthesize outdir\pgk.xct, ..\pkg
ALinkPrefix := '../' + ChangeFileExt(ExtractFileName(AFilename), '');
AFilename := ChangeFileExt(AFilename, '.xct');
end;
end;
class function TMarkdownWriter.FileNameExtension: String;
begin
result:='md';
end;
// private methods
function TMarkdownWriter.GetPageCount: Integer;
begin
Result := PageInfos.Count;
end;
procedure TMarkdownWriter.SetOnTest(const AValue: TNotifyEvent);
begin
if FOnTest=AValue then exit;
FOnTest:=AValue;
end;
procedure TMarkdownWriter.AppendText(const S: String);
begin
AppendToLine(S,True);
end;
initialization
// Do not localize.
RegisterWriter(TMarkdownWriter,'md','Markdown output.');
finalization
UnRegisterWriter('md');
end.
Reference in New Issue View Git Blame Copy Permalink