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

* Some restructuring by Andrey, add fallback link

Browse Source 
git-svn-id: trunk@48170 -
This commit is contained in:
michael 2021-01-18 15:27:58 +00:00
parent 38b6bb7385
commit 005448f305
18 changed files with 206 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
utils/fpdoc/dglobals.pp
View File

@ -167,7 +167,7 @@ type
HasContentFile: Boolean;
HidePrivate: Boolean; // Hide private class members in output?
HideProtected: Boolean; // Hide protected class members in output?
FalbackSeeAlsoLinks: Boolean; // Simplify SeeAlso Links
constructor Create;
destructor Destroy; override;
procedure SetPackageName(const APackageName: String);
@ -188,6 +188,7 @@ type
// Link tree support
procedure AddLink(const APathName, ALinkTo: String);
function FindAbsoluteLink(const AName: String): String;
// resolve link inside actual AModule and AModule.Parent = APackage
function ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
function FindLinkedNode(ANode: TDocNode): TDocNode;
Function ShowElement(El : TPasElement) : Boolean; inline;
@ -1191,7 +1192,6 @@ end;
function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
var
i: Integer;
begin
{
if Assigned(AModule) then
@ -1202,14 +1202,18 @@ begin
if (ALinkDest='') then
Exit('');
if (ALinkDest[1] = '#') then
// Link has full path
Result := FindAbsoluteLink(ALinkDest)
else if (AModule=Nil) then
// Trying to add package name only
Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest)
else
begin
if Pos(AModule.Name,ALinkDest) = 1 then
if Pos(LowerCase(AModule.Name)+'.',LowerCase(ALinkDest)) = 1 then
// fix ERROR - Link starts from name of module
Result := ResolveLink(AModule, AModule.packagename + '.' + ALinkDest, Strict)
else
// Link should be a first level inside of module
Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict);
if (Result='') then
begin
@ -1220,12 +1224,17 @@ begin
end;
// Match on parent : class/enumerated/record/module
if (Result='') and not strict then
begin
// TODO: I didn't see a calling this code at entire lcl package
// Writeln('INFO UnStrinct(): ' + ALinkDest);
for i := Length(ALinkDest) downto 1 do
if ALinkDest[i] = '.' then
begin
Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict);
//if Result <> '' then Writeln('INFO LinkResolved UnStrinct(): '+Result);
exit;
end;
end;
end;
procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring);

9
utils/fpdoc/dw_basehtml.pp
View File

@ -428,6 +428,7 @@ begin
else
N:='?';
DoLog(SErrUnknownLinkID, [s,n,a]);
LinkUnresolvedInc();
PushOutputNode(CreateEl(CurOutputNode, 'b'));
end else
PushOutputNode(CreateLink(CurOutputNode, s));
@ -797,7 +798,10 @@ begin
TREl:=CreateTR(TableEl);
ParaEl:=CreatePara(CreateTD_vtop(TREl));
l:=El['id'];
s:= ResolveLinkID(UTF8ENcode(l));
if Assigned(Engine) and Engine.FalbackSeeAlsoLinks then
s:= ResolveLinkIDUnStrict(UTF8ENcode(l))
else
s:= ResolveLinkID(UTF8ENcode(l));
if Length(s)=0 then
begin
if assigned(module) then
@ -806,10 +810,11 @@ begin
s:='?';
if l='' then l:='<empty>';
if Assigned(AElement) then
N:=UTF8Decode(AElement.Name)
N:=UTF8Decode(AElement.PathName)
else
N:='?';
DoLog(SErrUnknownLinkID, [s,N,l]);
LinkUnresolvedInc();
NewEl := CreateEl(ParaEl,'b')
end
else

1
utils/fpdoc/dw_basemd.pp
View File

@ -551,6 +551,7 @@ begin
else
N:='?';
DoLog(SErrUnknownLinkID, [s,n,a]);
LinkUnresolvedInc();
end
end;

12
utils/fpdoc/dw_chm.pp
View File

@ -40,7 +40,7 @@ type
FAutoIndex: Boolean;
FOtherFiles: String;
procedure ProcessOptions;
function ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
function ResolveLinkIDAbs(const Name: String): DOMString;
function RetrieveOtherFiles(const DataName: String; out PathInChm: String;
out FileName: String; var Stream: TStream): Boolean;
procedure LastFileAdded(Sender: TObject);
@ -50,10 +50,10 @@ type
APasEl: TPasElement; Prefix:String);
procedure GenerateTOC;
procedure GenerateIndex;
protected
procedure DoWriteDocumentation; override;
public
procedure WriteDoc; override;
function CreateAllocator: TFileAllocator; override;
function InterPretOption(const Cmd,Arg : String): boolean; override;
class procedure Usage(List: TStrings); override;
@ -163,7 +163,7 @@ end;
{ TCHMHTMLWriter }
function TCHMHTMLWriter.ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
function TCHMHTMLWriter.ResolveLinkIDAbs(const Name: String): DOMString;
begin
Result:=UTF8Decode(FixHTMLpath(Engine.ResolveLink(Module,Name, True)));
@ -623,7 +623,7 @@ begin
DoLog('Generating Index Done');
end;
procedure TCHMHTMLWriter.WriteDoc;
procedure TCHMHTMLWriter.DoWriteDocumentation;
var
i: Integer;
PageDoc: TXMLDocument;
@ -631,8 +631,6 @@ var
IFileName,FileName: String;
FilePath: String;
begin
FAllocator:=CreateAllocator;
FAllocator.SubPageNames:= SubPageNames;
AllocatePages;
DoLog(SWritingPages, [PageCount]);

4
utils/fpdoc/dw_dxml.pp
View File

@ -12,7 +12,7 @@ type
{ TXMLWriter }
TDXMLWriter = class(TFPDocWriter)
procedure WriteDoc; override;
procedure DoWriteDocumentation; override;
end;
{ TDocumentation }
@ -472,7 +472,7 @@ end;
{ TXMLWriter }
procedure TDXMLWriter.WriteDoc;
procedure TDXMLWriter.DoWriteDocumentation;
var
i: integer;
begin

10
utils/fpdoc/dw_html.pp
View File

@ -67,7 +67,6 @@ type
procedure FinishElementPage(AElement: TPasElement);virtual;
procedure AppendFooter;virtual;
procedure AppendClassMemberListLink(aClass: TPasClassType; ParaEl: TDomElement; AListSubpageIndex: Integer; const AText: DOMString);virtual;
procedure CreateClassMainPage(aClass: TPasClassType);virtual;
procedure CreateClassInheritanceSubpage(aClass: TPasClassType; AFilter: TMemberFilter);virtual;
@ -97,6 +96,9 @@ type
procedure CreateProcPageBody(AProc: TPasProcedureBase);
Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
// Main documentation process
Procedure DoWriteDocumentation; override;
Property HeaderHTML : TStringStream Read FHeaderHTML;
Property NavigatorHTML : TStringStream read FNavigatorHTML;
Property FooterHTML : TStringStream read FFooterHTML;
@ -104,7 +106,7 @@ type
Property HeadElement : TDomElement Read FHeadElement;
Property TitleElement: TDOMElement Read FTitleElement;
public
// Creating all module hierarchy classes is here !!!!
// Creating all module hierarchy classes happens here !
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
// Overrides
Class Function FileNameExtension : String; override;
@ -112,7 +114,6 @@ type
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
Procedure WriteDoc; override;
// Single-page generation
function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; virtual;
@ -207,7 +208,8 @@ begin
PageDoc.Free;
end;
procedure THTMLWriter.WriteDoc;
procedure THTMLWriter.DoWriteDocumentation;
begin
Inherited;

2
utils/fpdoc/dw_latex.pp
View File

@ -638,7 +638,7 @@ var
begin
Writer := TLaTeXWriter.Create(APackage, AEngine);
try
Writer.WriteDoc;
Writer.DoWriteDocumentation;
finally
Writer.Free;
end;

2
utils/fpdoc/dw_linrtf.pp
View File

@ -782,7 +782,7 @@ var
begin
Writer := TRTFWriter.Create(APackage, AEngine);
try
Writer.WriteDoc;
Writer.DoWriteDocumentation;
finally
Writer.Free;
end;

5
utils/fpdoc/dw_man.pp
View File

@ -99,9 +99,10 @@ Type
Procedure WriteExampleFile(FN : String); virtual;
procedure WriteExample(ADocNode: TDocNode);
procedure WriteSeeAlso(ADocNode: TDocNode; Comma : Boolean);
// Here we write the documentation.
procedure DoWriteDocumentation; override;
Public
Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
procedure WriteDoc; override;
// Documentation writing methods.
// Package
Procedure WritePackagePage;
@ -970,7 +971,7 @@ end;
Actual man page writing
---------------------------------------------------------------------}
procedure TManWriter.WriteDoc;
procedure TManWriter.DoWriteDocumentation;
var
i : Integer;

9
utils/fpdoc/dw_markdown.pp
View File

@ -116,6 +116,8 @@ type
procedure CreateClassMemberPageBody(AElement: TPasElement); virtual;
procedure CreateInheritanceSubpage(aClass: TPasClassType; aTitle : string; AFilter: TMemberFilter); virtual;
procedure CreateSortedSubpage(ACLass: TPasClassType; aTitle : string; AFilter: TMemberFilter ); virtual;
// Here we write the documentation
Procedure DoWriteDocumentation; override;
public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
destructor Destroy; override;
@ -126,7 +128,6 @@ type
// Start producing html complete package documentation
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;
@ -300,9 +301,7 @@ begin
end;
end;
procedure TMarkdownWriter.WriteDoc;
procedure TMarkdownWriter.DoWriteDocumentation;
begin
Inherited;
@ -310,7 +309,6 @@ begin
WriteMkdocsYaml;
end;
function TMarkdownWriter.GetFooterMarkDown: TStrings;
begin
If FFooterMarkDown=Nil then
@ -650,6 +648,7 @@ procedure TMarkdownWriter.AppendSeeAlsoSection(AElement: TPasElement; DocNode: T
else
N:='?';
DoLog(SErrUnknownLinkID, [s,N,aID]);
LinkUnresolvedInc();
end ;
if doBold then
DescrBeginBold

2
utils/fpdoc/dw_txt.pp
View File

@ -603,7 +603,7 @@ var
begin
Writer := TTxtWriter.Create(APackage, AEngine);
try
Writer.WriteDoc;
Writer.DoWriteDocumentation;
finally
Writer.Free;
end;

7
utils/fpdoc/dw_xml.pp
View File

@ -38,10 +38,11 @@ Type
procedure AllocatePackagePages; override;
procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
// Here we write the documentation.
Procedure DoWriteDocumentation; override;
public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
Procedure WriteDoc; override;
class procedure Usage(List: TStrings); override;
function InterPretOption(const Cmd,Arg : String): boolean; override;
end;
@ -633,9 +634,9 @@ end;
{ TXMLWriter }
procedure TXMLWriter.WriteDoc;
procedure TXMLWriter.DoWriteDocumentation;
begin
inherited WriteDoc;
inherited DoWriteDocumentation;
end;
function TXMLWriter.CreateAllocator: TFileAllocator;

5
utils/fpdoc/dwlinear.pp
View File

@ -89,11 +89,12 @@ Type
Property LastURL : DomString Read FLastURL Write FLastURL;
// Overriden from fpdocwriter;
procedure DescrWriteText(const AText: DOMString); override;
// Actual writing happens here.
Procedure DoWriteDocumentation; override;
Public
Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
function InterpretOption(const Cmd, Arg: String): Boolean; override;
class procedure Usage(List: TStrings); override;
procedure WriteDoc; override;
// Linear Documentation writing methods.
Procedure ProcessPackage;
Procedure ProcessTopics(DocNode : TDocNode; Alevel : Integer);
@ -593,7 +594,7 @@ begin
Result := '<nil>';
end;
procedure TLinearWriter.WriteDoc;
procedure TLinearWriter.DoWriteDocumentation;
var
i : Integer;

108
utils/fpdoc/dwriter.pp
View File

@ -91,6 +91,7 @@ type
procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
Procedure DoLog(Const Msg : String);
Procedure DoLog(Const Fmt : String; Args : Array of const);
Procedure OutputResults(); virtual;
procedure Warning(AContext: TPasElement; const AMsg: String);
procedure Warning(AContext: TPasElement; const AMsg: String;
const Args: array of const);
@ -169,6 +170,9 @@ type
procedure DescrEndTableRow; virtual; abstract;
procedure DescrBeginTableCell; virtual; abstract;
procedure DescrEndTableCell; virtual; abstract;
procedure PrepareDocumentation; virtual;
// Descendents must override this.
procedure DoWriteDocumentation; virtual; Abstract;
Property CurrentContext : TPasElement Read FContext ;
public
@ -184,7 +188,8 @@ type
Class Function FileNameExtension : String; virtual;
Class Procedure Usage(List : TStrings); virtual;
Class procedure SplitImport(var AFilename, ALinkPrefix: String); virtual;
procedure WriteDoc; virtual; Abstract;
// Here we start the generation of documentation
procedure WriteDocumentation;
Function WriteDescr(Element: TPasElement) : TDocNode;
procedure WriteDescr(Element: TPasElement; DocNode: TDocNode);
procedure WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); virtual;
@ -250,14 +255,21 @@ Type
FCurDirectory: String;
FModule: TPasModule;
FPageInfos: TFPObjectList; // list of TPageInfo objects
FLinkUnresolvedCnt: Integer;
function GetPageCount: Integer;
Protected
FAllocator: TFileAllocator;
function ResolveLinkID(const Name: String; Level: Integer=0): DOMString;
Procedure LinkUnresolvedInc();
// General resolving routine
function ResolveLinkID(const Name: String): DOMString;
// Simplified resolving routine. Excluded last path after dot
function ResolveLinkIDUnStrict(const Name: String): DOMString;
function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
function ResolveLinkWithinPackage(AElement: TPasElement; ASubpageIndex: Integer): String;
Function CreateAllocator : TFileAllocator; virtual; abstract;
procedure PrepareDocumentation; override;
function CreateAllocator() : TFileAllocator; virtual; abstract;
Procedure OutputResults(); override;
// aFileName is the filename allocated by the Allocator, nothing prefixed.
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); virtual; abstract;
procedure AllocatePages; virtual;
@ -272,12 +284,14 @@ Type
function GetFileBaseDir(aOutput: String): String; virtual;
function InterPretOption(const Cmd, Arg: String): boolean; override;
function ModuleHasClasses(AModule: TPasModule): Boolean;
// Allocate pages etc.
Procedure DoWriteDocumentation; override;
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;
@ -389,6 +403,7 @@ begin
inherited Create(APackage, AEngine);
FPageInfos:=TFPObjectList.Create;
FSubPageNames:= False;
FLinkUnresolvedCnt:=0;
end;
destructor TMultiFileDocWriter.Destroy;
@ -403,8 +418,18 @@ begin
Result := PageInfos.Count;
end;
function TMultiFileDocWriter.ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
procedure TMultiFileDocWriter.OutputResults();
begin
DoLog('Unresolved links: %d', [FLinkUnresolvedCnt]);
inherited OutputResults();
end;
procedure TMultiFileDocWriter.LinkUnresolvedInc();
begin
Inc(FLinkUnresolvedCnt);
end;
function TMultiFileDocWriter.ResolveLinkID(const Name: String): DOMString;
var
res,s: String;
@ -412,16 +437,46 @@ begin
res:=Engine.ResolveLink(Module,Name, True);
// engine can return backslashes on Windows
if Length(res) > 0 then
begin
s:=Copy(Res, 1, Length(CurDirectory) + 1);
begin
s:=Copy(Res, 1, Length(CurDirectory) + 1);
if (S= CurDirectory + '/') or (s= CurDirectory + '\') then
Res := Copy(Res, Length(CurDirectory) + 2, Length(Res))
begin
// TODO: I didn`t see a call to this code on a processing the lcl ana lazutil. What is that?
Res := Copy(Res, Length(CurDirectory) + 2, Length(Res));
//writeLn('INFO: ResolveLinkID "\" - ', Res);
end
else if not IsLinkAbsolute(Res) then
Res := BaseDirectory + Res;
end;
end;
Result:=UTF8Decode(Res);
end;
function TMultiFileDocWriter.ResolveLinkIDUnStrict(const Name: String
): DOMString;
var
idDot, idLast: Integer;
res: String;
begin
res:=Engine.ResolveLink(Module,Name, True);
if res = '' then
begin
// do simplify on one level from end.
// TOCO: I want to move that code to last check of Engine.ResolveLink() for not Strict
IdDot:= Pos('.', Name);
IdLast:= 0;
// search last dot
while idDot > 0 do
begin
IdLast:= idDot;
IdDot:= Pos('.', Name, IdLast+1);
end;
if idLast > 0 then
// have cut last element
res:= Engine.ResolveLink(Module, Copy(Name, 1, IdLast-1), True);
end;
Result:=UTF8Decode(res);
end;
{ Used for:
- <link> elements in descriptions
- "see also" entries
@ -459,8 +514,15 @@ begin
SetLength(Result, 0);
end;
procedure TMultiFileDocWriter.PrepareDocumentation;
begin
inherited PrepareDocumentation;
FAllocator:= CreateAllocator();
FAllocator.SubPageNames:= SubPageNames;
end;
Function TMultiFileDocWriter.AddPage(AElement: TPasElement; ASubpageIndex: Integer) : TPageInfo;
function TMultiFileDocWriter.AddPage(AElement: TPasElement;
ASubpageIndex: Integer): TPageInfo;
begin
Result:= TPageInfo.Create(aElement,aSubPageIndex);
@ -508,7 +570,7 @@ begin
end;
Function TMultiFileDocWriter.ModuleHasClasses(AModule: TPasModule) : Boolean;
function TMultiFileDocWriter.ModuleHasClasses(AModule: TPasModule): Boolean;
begin
result:=assigned(AModule)
@ -551,7 +613,8 @@ begin
end;
end;
Procedure TMultiFileDocWriter.AllocateClassMemberPages(AModule: TPasModule; LinkList : TObjectList);
procedure TMultiFileDocWriter.AllocateClassMemberPages(AModule: TPasModule;
LinkList: TObjectList);
var
i, j, k: Integer;
ClassEl: TPasClassType;
@ -715,7 +778,7 @@ begin
Result:=IncludeTrailingPathDelimiter(Result);
end;
procedure TMultiFileDocWriter.WriteDoc;
procedure TMultiFileDocWriter.DoWriteDocumentation;
procedure CreatePath(const AFilename: String);
@ -748,8 +811,6 @@ var
FinalFilename: String;
begin
FAllocator:=CreateAllocator;
FAllocator.SubPageNames:= SubPageNames;
AllocatePages;
DoLog(SWritingPages, [PageCount]);
if Engine.Output <> '' then
@ -1106,6 +1167,13 @@ begin
end;
end;
procedure TFPDocWriter.WriteDocumentation;
begin
PrepareDocumentation();
DoWriteDocumentation();
OutputResults();
end;
function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
Var
@ -1129,6 +1197,11 @@ begin
DoLog('%s : No support for images yet: %s (caption: "%s")',[ClassName,AFileName,ACaption]);
end;
procedure TFPDocWriter.PrepareDocumentation;
begin
// Ancestors can call AllocatePages();CreateAllocator(); into base class
end;
{ ---------------------------------------------------------------------
Generic documentation node conversion
---------------------------------------------------------------------}
@ -1486,6 +1559,11 @@ begin
DoLog(Format(Fmt,Args));
end;
procedure TFPDocWriter.OutputResults();
begin
DoLog('Documentation process finished.');
end;
function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
Node: TDOMNode): Boolean;
begin

16
utils/fpdoc/fpdoc.pp
View File

@ -101,6 +101,8 @@ begin
Writeln(SUsageOption190);
Writeln(SUsageOption200);
Writeln(SUsageOption210);
Writeln(SUsageOption211);
Writeln(SUsageOption212);
Writeln(SUsageOption215);
Writeln(SUsageOption215A);
Writeln(SUsageOption220);
@ -154,6 +156,8 @@ end;
procedure TFPDocApplication.ExceptProc(Sender: TObject; E: Exception);
begin
OutputLog(Sender, Format('Exception: Class - %s', [E.ClassName]));
OutputLog(Sender, E.Message);
{$IFDEF EXCEPTION_STACK}
OutputLog(Sender, DumpExceptionCallStack(E));
{$ENDIF}
@ -310,12 +314,14 @@ begin
Usage(0)
else if s = '--hide-protected' then
FCreator.Options.HideProtected := True
else if s = '--fallback-seealso-links' Then
FCreator.Options.FallBackSeeAlsoLinks := True
else if s = '--warn-no-node' then
FCreator.Options.WarnNoNode := True
else if s = '--warn-documentation-empty' then
FCreator.Options.WarnDocumentationEmpty := True
else if s = '--warn-used-file' then
FCreator.Options.WarnUsedFile := True
else if s = '--info-used-file' then
FCreator.Options.InfoUsedFile := True
else if s = '--warn-XCT' then
FCreator.Options.WarnXCT := True
else if s = '--show-private' then
@ -441,15 +447,15 @@ end;
constructor TFPDocApplication.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
StopOnException:=true;
StopOnException:=false;
FCreator:=TFPDocCreator.Create(Self);
FCreator.OnLog:=@OutputLog;
OnException:= @ExceptProc;
end;
begin
//AssignFile(Output, 'fpdoc.log');
//rewrite(Output);
//AssignFile(StdErr, 'fpdoc_err.log');
//rewrite(StdErr);
With TFPDocApplication.Create(Nil) do
try
Run;

8
utils/fpdoc/fpdocproj.pas
View File

@ -55,6 +55,7 @@ Type
FFormat: String;
FHidePrivate: Boolean;
FHideProtected: Boolean;
FFallBackSeeAlsoLinks: Boolean;
FIO: Boolean;
FLanguage: String;
FMoDir: String;
@ -63,7 +64,7 @@ Type
FWarnDocumentationEmpty: Boolean;
FWarnNoNode: Boolean;
FDontTrim : Boolean;
FWarnUsedFile: Boolean;
FInfoUsedFile: Boolean;
FWarnXCT: Boolean;
procedure SetBackendOptions(const AValue: TStrings);
Public
@ -79,8 +80,9 @@ Type
Property BackendOptions : TStrings Read FBackEndoptions Write SetBackendOptions;
Property StopOnParseError : Boolean Read FSOPE Write FSOPE;
Property HideProtected : Boolean Read FHideProtected Write FHideProtected;
Property FallBackSeeAlsoLinks :Boolean Read FFallBackSeeAlsoLinks Write FFallBackSeeAlsoLinks;
Property WarnNoNode : Boolean Read FWarnNoNode Write FWarnNoNode;
Property WarnUsedFile : Boolean Read FWarnUsedFile Write FWarnUsedFile;
Property InfoUsedFile : Boolean Read FInfoUsedFile Write FInfoUsedFile;
Property WarnDocumentationEmpty : Boolean Read FWarnDocumentationEmpty Write FWarnDocumentationEmpty;
Property WarnXCT : Boolean Read FWarnXCT Write FWarnXCT;
Property ShowPrivate : Boolean Read FHidePrivate Write FHidePrivate;
@ -195,7 +197,7 @@ begin
FSOPE:=O.StopOnParseError;
HideProtected:=O.HideProtected;
WarnNoNode:=O.WarnNoNode;
WarnUsedFile:=O.WarnUsedFile;
InfoUsedFile:=O.InfoUsedFile;
WarnDocumentationEmpty:=O.WarnDocumentationEmpty;
WarnXCT:=O.WarnXCT;
ShowPrivate:=O.ShowPrivate;

4
utils/fpdoc/fpdocstrs.pp
View File

@ -170,12 +170,14 @@ resourcestring
SUsageOption190 = ' e.g. --package=fcl';
SUsageOption200 = '--project=file Use file as project file';
SUsageOption210 = '--show-private Show private methods.';
SUsageOption211 = '--fallback-seealso-links';
SUsageOption212 = ' Simplify seealso links by exluding last link level';
SUsageOption215 = '--stop-on-parser-error';
SUsageOption215A = ' Stop when a parser error occurs. Default is to ignore parser errors.';
SUsageOption220 = '--warn-no-node Warn if no documentation node was found.';
SUsageOption221 = '--warn-documentation-empty Warn if documentation is empty.';
SUsageOption222 = '--warn-xct Warn if an external class could not be resolved.';
SUsageOption223 = '--warn-used-file Warn if an external class could not be resolved.';
SUsageOption223 = '--info-used-file Output the file path of an implicitly processed file.';
SUsageOption230 = '--mo-dir=dir Set directory where language files reside to dir';
SUsageOption240 = '--parse-impl (Experimental) try to parse implementation too';
SUsageOption250 = '--dont-trim Do not trim XML contents. Useful for preserving';

67
utils/fpdoc/mkfpdoc.pp
View File

@ -86,6 +86,9 @@ begin
begin
ScannerLogEvents:=[sleFile];
ParserLogEvents:=[];
Options.InfoUsedFile:= true;
Options.WarnDocumentationEmpty:= true;
Options.WarnXCT:= true;
end
else
begin
@ -245,8 +248,8 @@ begin
If not InterPretOption(Cmd,Arg) then
DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
end;
// Output created Documentation
WriteDoc;
// Create documentation by writer
WriteDocumentation();
Finally
Free;
end;
@ -269,7 +272,7 @@ Function TFPDocCreator.GetLogLevels : TFPDocLogLevels;
begin
Result:=[];
DoOpt(Options.WarnNoNode,dleWarnNoNode);
DoOpt(Options.WarnUsedFile,dleWarnUsedFile);
DoOpt(Options.InfoUsedFile,dleWarnUsedFile);
DoOpt(Options.WarnDocumentationEmpty,dleDocumentationEmpty);
DoOpt(Options.WarnXCT,dleXCT);
end;
@ -282,7 +285,7 @@ var
Engine : TFPDocEngine;
Cmd,Arg : String;
WriterClass: TFPDocWriterClass;
eMsg: String;
begin
Cmd:='';
FCurPackage:=APackage;
@ -311,34 +314,52 @@ begin
Engine.HidePrivate:=Not Options.ShowPrivate;
Engine.OnParseUnit:=@HandleOnParseUnit;
Engine.DocLogLevels:=GetLogLevels;
Engine.FalbackSeeAlsoLinks:= Options.FallBackSeeAlsoLinks;
if Length(Options.Language) > 0 then
TranslateDocStrings(Options.Language);
// scan the input source files
for i := 0 to APackage.Inputs.Count - 1 do
try
// get options from input packages
SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
arg:=Arg+' -d'+Options.EndianNess;
// make absolute filepath
Cmd:=FixInputFile(Cmd);
if FProcessedUnits.IndexOf(Cmd)=-1 then
try
eMsg:='';
// get options from input packages
SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
arg:=Arg+' -d'+Options.EndianNess;
// make absolute filepath
Cmd:=FixInputFile(Cmd);
if FProcessedUnits.IndexOf(Cmd)=-1 then
begin
FProcessedUnits.Add(Cmd);
// Parce sources for OS Target
//WriteLn(Format('Parsing unit: %s', [ExtractFilenameOnly(Cmd)]));
ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
FProcessedUnits.Add(Cmd);
// Parce sources for OS Target
//WriteLn(Format('Parsing unit: %s', [ExtractFilenameOnly(Cmd)]));
ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]); // poSkipDefaultDefs
end;
except
on E: EParserError do
If Options.StopOnParseError then
Raise
else
//else WriteLn(Format('Processed unit: %s', [ExtractFilenameOnly(Cmd)]));
except
on E: EParserError do
begin
DoLog('Error: %s(%d,%d): %s',[E.Filename, E.Row, E.Column, E.Message]);
DoLog('Ignoring error, continuing with next unit (if any).');
eMsg:= Format('Error of parcer: %s(%d,%d): %s',[E.Filename, E.Row, E.Column, E.Message]);
If Options.StopOnParseError then Raise;
end;
end;
on E: EFileNotFoundError do
begin
eMsg:= Format('Error: file not found - %s', [E.Message]);
If Options.StopOnParseError then Raise;
end;
on E: Exception do
begin
eMsg:= Format('Error: %s', [E.Message]);
If Options.StopOnParseError then Raise;
end;
end; // try except
finally
if eMsg <> '' then
begin
DoLog(eMsg);
If not Options.StopOnParseError then
DoLog('Ignoring error, continuing with next unit (if any).');
end;
end; // try finally
if Not ParseOnly then
begin
Engine.StartDocumenting;