mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 21:29:43 +02:00
1568 lines
46 KiB
ObjectPascal
1568 lines
46 KiB
ObjectPascal
{
|
|
|
|
FPDoc - Free Pascal Documentation Tool
|
|
Copyright (C) 2000 - 2002 by
|
|
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
|
|
|
|
* Global declarations
|
|
* Link list management
|
|
* Document node tree
|
|
* Main engine
|
|
|
|
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 dGlobals;
|
|
|
|
|
|
interface
|
|
|
|
uses Classes, DOM, PasTree, PParser, StrUtils;
|
|
|
|
Var
|
|
LEOL : Integer;
|
|
modir : string;
|
|
|
|
resourcestring
|
|
// Output strings
|
|
SDocPackageTitle = 'Reference for package ''%s''';
|
|
SDocPrograms = 'Programs';
|
|
SDocUnits = 'Units';
|
|
SDocUnitTitle = 'Reference for unit ''%s''';
|
|
SDocInterfaceSection = 'Interface section';
|
|
SDocImplementationSection = 'Implementation section';
|
|
SDocUsedUnits = 'Used units';
|
|
SDocUsedUnitsByUnitXY = 'Used units by unit ''%s''';
|
|
SDocConstsTypesVars = 'Constants, types and variables';
|
|
SDocResStrings = 'Resource strings';
|
|
SDocTypes = 'Types';
|
|
SDocConstants = 'Constants';
|
|
SDocClasses = 'Classes';
|
|
SDocProceduresAndFunctions = 'Procedures and functions';
|
|
SDocVariables = 'Variables';
|
|
SDocIdentifierIndex = 'Index';
|
|
SDocModuleIndex = 'Index of all identifiers in unit ''%s''';
|
|
SDocPackageIndex = 'Index of all identifiers in package ''%s''';
|
|
SDocUnitOverview = 'Overview of unit ''%s''';
|
|
SDocOverview = 'Overview';
|
|
SDocSearch = 'Search';
|
|
SDocDeclaration = 'Declaration';
|
|
SDocDescription = 'Description';
|
|
SDocErrors = 'Errors';
|
|
SDocVersion = 'Version info';
|
|
SDocSeeAlso = 'See also';
|
|
SDocExample = 'Example';
|
|
SDocArguments = 'Arguments';
|
|
SDocFunctionResult = 'Function result';
|
|
SDocRemark = 'Remark: ';
|
|
SDocMethodOverview = 'Method overview';
|
|
SDocPropertyOverview = 'Property overview';
|
|
SDocInterfacesOverview = 'Interfaces overview';
|
|
SDocPage = 'Page';
|
|
SDocMethod = 'Method';
|
|
SDocProperty = 'Property';
|
|
SDocAccess = 'Access';
|
|
SDocInheritance = 'Inheritance';
|
|
SDocProperties = 'Properties';
|
|
SDocMethods = 'Methods';
|
|
SDocEvents = 'Events';
|
|
SDocByName = 'by Name';
|
|
SDocValue = 'Value';
|
|
SDocExplanation = 'Explanation';
|
|
SDocProcedure = 'Procedure';
|
|
SDocValuesForEnum = 'Enumeration values for type %s';
|
|
SDocSourcePosition = 'Source position: %s line %d';
|
|
SDocSynopsis = 'Synopsis';
|
|
SDocVisibility = 'Visibility';
|
|
SDocOpaque = 'Opaque type';
|
|
SDocDateGenerated = 'Documentation generated on: %s';
|
|
|
|
// Topics
|
|
SDocRelatedTopics = 'Related topics';
|
|
SDocUp = 'Up';
|
|
SDocNext = 'Next';
|
|
SDocPrevious = 'Previous';
|
|
|
|
// Various backend constants
|
|
SDocChapter = 'Chapter';
|
|
SDocSection = 'Section';
|
|
SDocSubSection = 'Subsection';
|
|
SDocTable = 'Table';
|
|
SDocListing = 'Listing';
|
|
|
|
// Man page usage
|
|
SManUsageManSection = 'Use ASection as the man page section';
|
|
SManUsageNoUnitPrefix = 'Do not prefix man pages with unit name.';
|
|
SManUsageWriterDescr = 'UNIX man page output.';
|
|
SManUsagePackageDescription = 'Use descr as the description of man pages';
|
|
|
|
// HTML usage
|
|
SHTMLUsageFooter = 'Append xhtml from file as footer to html page';
|
|
SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime';
|
|
SHTMLUsageCharset = 'Set the HTML character set';
|
|
SHTMLHtmlSearch = 'Add search page with given name to the menu bar';
|
|
SHTMLIndexColcount = 'Use N columns in the identifier index pages';
|
|
SHTMLImageUrl = 'Prefix image URLs with url';
|
|
|
|
// CHM usage
|
|
SCHMUsageTOC = 'Use [File] as the table of contents. Usually a .hhc file.';
|
|
SCHMUsageIndex = 'Use [File] as the index. Usually a .hhk file.';
|
|
SCHMUsageDefPage = 'Set the "Home" page relative to where it lives in the chm. i.e. "/index.html"';
|
|
SCHMUsageOtrFiles= 'A txt file containing a list of files to be added relative to the working directory.';
|
|
SCHMUsageCSSFile = 'Filename of a .css file to be included in the chm.';
|
|
SCHMUsageAutoTOC = 'Automatically generate a Table of Contents. Ignores --toc-file';
|
|
SCHMUsageAutoIDX = 'Automatically generate an Index. Ignores --index-file';
|
|
SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
|
|
SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
|
|
|
|
// Linear usage
|
|
SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
|
|
SLinearUsageDupLinkedDocsP2 = 'descendant classes.';
|
|
|
|
STitle = 'FPDoc - Free Pascal Documentation Tool';
|
|
SVersion = 'Version %s [%s]';
|
|
SCopyright = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org';
|
|
|
|
SCmdLineHelp = 'Usage: %s [options]';
|
|
SUsageOption010 = '--content Create content file for package cross-references';
|
|
SUsageOption020 = '--cputarget=value Set the target CPU for the scanner.';
|
|
SUsageOption030 = '--descr=name use name as description file. ';
|
|
SUsageOption040 = ' This option is allowed more than once';
|
|
SUsageOption050 = '--format=fmt Select output format.';
|
|
SUsageOption060 = '--help Show this help.';
|
|
SUsageOption070 = '--hide-protected Do not show protected methods in overview';
|
|
SUsageOption080 = '--import=file Import content file for package cross-references';
|
|
SUsageOption090 = '--input=cmd use cmd as input for the parser.';
|
|
SUsageOption100 = ' At least one input option is required.';
|
|
SUsageOption110 = '--lang=lng Select output language.';
|
|
SUsageOption120 = '--ostarget=value Set the target OS for the scanner.';
|
|
SUsageOption130 = '--output=name use name as the output name.';
|
|
SUsageOption140 = ' Each backend interpretes this as needed.';
|
|
SUsageOption150 = '--package=name Set the package name for which to create output';
|
|
SUsageOption160 = '--show-private Show private methods.';
|
|
SUsageOption170 = '--warn-no-node Warn if no documentation node was found.';
|
|
SUsageOption180 = '--mo-dir=dir Set directory where language files reside to dir';
|
|
SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too';
|
|
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.';
|
|
SUsageFormatSpecific = 'Output format "%s" supports the following options:';
|
|
|
|
SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
|
|
SCmdLineInvalidFormat = 'Invalid format "%s" specified';
|
|
SCmdLineOutputOptionMissing = 'Need an output filename, please specify one with --output=<filename>';
|
|
SWritingPages = 'Writing %d pages...';
|
|
SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
|
|
SDone = 'Done.';
|
|
SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
|
|
SErrCouldNotCreateFile = 'Could not create file "%s": %s';
|
|
SSeeURL = '(See %s)'; // For linear text writers.
|
|
|
|
Const
|
|
SVisibility: array[TPasMemberVisibility] of string =
|
|
('Default', 'Private', 'Protected', 'Public',
|
|
'Published', 'Automated','Strict Private','Strict Protected');
|
|
|
|
type
|
|
|
|
// Assumes a list of TObject instances and frees them on destruction
|
|
|
|
TObjectList = class(TList)
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
{ Link entry tree
|
|
TFPDocEngine stores the root of the entry tree in its property
|
|
"RootLinkNode". The root has one child node for each package, for which
|
|
documentation links are available. The children of a package node
|
|
are module nodes; and the children of a module node are the top-level
|
|
declarations of this module; the next level in the tree stores e.g. record
|
|
members, and so on...
|
|
}
|
|
|
|
TLinkNode = class
|
|
private
|
|
FFirstChild, FNextSibling: TLinkNode;
|
|
FName: String;
|
|
FLink: String;
|
|
public
|
|
constructor Create(const AName, ALink: String);
|
|
destructor Destroy; override;
|
|
function FindChild(const APathName: String): TLinkNode;
|
|
function CreateChildren(const APathName, ALinkTo: String): TLinkNode;
|
|
// Properties for tree structure
|
|
property FirstChild: TLinkNode read FFirstChild;
|
|
property NextSibling: TLinkNode read FNextSibling;
|
|
// Link properties
|
|
property Name: String read FName;
|
|
property Link: String read FLink;
|
|
end;
|
|
|
|
|
|
{ Documentation entry tree
|
|
TFPDocEngine stores the root of the entry tree in its property
|
|
"RootDocNode". The root has one child node for each package, for which
|
|
documentation is being provided by the user. The children of a package node
|
|
are module nodes; and the children of a module node are the top-level
|
|
declarations of this module; the next level in the tree stores e.g. record
|
|
members, and so on...
|
|
}
|
|
|
|
{ TDocNode }
|
|
|
|
TDocNode = class
|
|
private
|
|
FFirstChild, FNextSibling: TDocNode;
|
|
FName: String;
|
|
FNode: TDOMElement;
|
|
FIsSkipped: Boolean;
|
|
FShortDescr: TDOMElement;
|
|
FDescr: TDOMElement;
|
|
FErrorsDoc: TDOMElement;
|
|
FSeeAlso: TDOMElement;
|
|
FFirstExample: TDOMElement;
|
|
FLink: String;
|
|
FTopicNode : Boolean;
|
|
FRefCount : Integer;
|
|
FVersion: TDomElement;
|
|
public
|
|
constructor Create(const AName: String; ANode: TDOMElement);
|
|
destructor Destroy; override;
|
|
Function IncRefcount : Integer;
|
|
function FindChild(const APathName: String): TDocNode;
|
|
function CreateChildren(const APathName: String): TDocNode;
|
|
// Properties for tree structure
|
|
property FirstChild: TDocNode read FFirstChild;
|
|
property NextSibling: TDocNode read FNextSibling;
|
|
// Basic properties
|
|
property Name: String read FName;
|
|
property Node: TDOMElement read FNode;
|
|
// Data fetched from the XML document
|
|
property IsSkipped: Boolean read FIsSkipped;
|
|
property ShortDescr: TDOMElement read FShortDescr;
|
|
property Descr: TDOMElement read FDescr;
|
|
property ErrorsDoc: TDOMElement read FErrorsDoc;
|
|
Property Version : TDomElement Read FVersion;
|
|
property SeeAlso: TDOMElement read FSeeAlso;
|
|
property FirstExample: TDOMElement read FFirstExample;
|
|
property Link: String read FLink;
|
|
Property TopicNode : Boolean Read FTopicNode;
|
|
Property RefCount : Integer Read FRefCount;
|
|
end;
|
|
|
|
|
|
|
|
// The main FPDoc engine
|
|
|
|
{ TFPDocEngine }
|
|
|
|
TFPDocEngine = class(TPasTreeContainer)
|
|
private
|
|
protected
|
|
DescrDocs: TObjectList; // List of XML documents
|
|
DescrDocNames: TStringList; // Names of the XML documents
|
|
FRootLinkNode: TLinkNode;
|
|
FRootDocNode: TDocNode;
|
|
FPackages: TList; // List of TFPPackage objects
|
|
CurModule: TPasModule;
|
|
CurPackageDocNode: TDocNode;
|
|
public
|
|
Output: String;
|
|
HasContentFile: Boolean;
|
|
HidePrivate: Boolean; // Hide private class members in output?
|
|
HideProtected: Boolean; // Hide protected class members in output?
|
|
WarnNoNode : Boolean; // Warn if no description node found for element.
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure SetPackageName(const APackageName: String);
|
|
procedure ReadContentFile(const AFilename, ALinkPrefix: String);
|
|
procedure WriteContentFile(const AFilename: String);
|
|
|
|
function CreateElement(AClass: TPTreeElement; const AName: String;
|
|
AParent: TPasElement; AVisibility: TPasMemberVisibility;
|
|
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
|
|
override;
|
|
function FindElement(const AName: String): TPasElement; override;
|
|
function FindModule(const AName: String): TPasModule; override;
|
|
|
|
// Link tree support
|
|
procedure AddLink(const APathName, ALinkTo: String);
|
|
function FindAbsoluteLink(const AName: String): String;
|
|
function ResolveLink(AModule: TPasModule; const ALinkDest: String): String;
|
|
function FindLinkedNode(ANode: TDocNode): TDocNode;
|
|
|
|
// Documentation file support
|
|
procedure AddDocFile(const AFilename: String);
|
|
|
|
// Documentation retrieval
|
|
function FindDocNode(AElement: TPasElement): TDocNode;
|
|
function FindDocNode(ARefModule: TPasModule; const AName: String): TDocNode;
|
|
function FindShortDescr(AElement: TPasElement): TDOMElement;
|
|
function FindShortDescr(ARefModule: TPasModule;
|
|
const AName: String): TDOMElement;
|
|
function GetExampleFilename(const ExElement: TDOMElement): String;
|
|
|
|
property RootLinkNode: TLinkNode read FRootLinkNode;
|
|
property RootDocNode: TDocNode read FRootDocNode;
|
|
property Package: TPasPackage read FPackage;
|
|
end;
|
|
|
|
|
|
procedure TranslateDocStrings(const Lang: String);
|
|
|
|
Function IsLinkNode(Node : TDomNode) : Boolean;
|
|
Function IsExampleNode(Example : TDomNode) : Boolean;
|
|
|
|
// returns true is link is an absolute URI
|
|
Function IsLinkAbsolute(ALink: String): boolean;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, Gettext, XMLRead;
|
|
|
|
const
|
|
AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:');
|
|
|
|
|
|
{ TObjectList }
|
|
|
|
destructor TObjectList.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
TObject(Items[i]).Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
{ TLinkNode }
|
|
|
|
constructor TLinkNode.Create(const AName, ALink: String);
|
|
begin
|
|
inherited Create;
|
|
FName := AName;
|
|
FLink := ALink;
|
|
end;
|
|
|
|
destructor TLinkNode.Destroy;
|
|
begin
|
|
if Assigned(FirstChild) then
|
|
FirstChild.Free;
|
|
if Assigned(NextSibling) then
|
|
NextSibling.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLinkNode.FindChild(const APathName: String): TLinkNode;
|
|
var
|
|
DotPos: Integer;
|
|
ChildName: String;
|
|
Child: TLinkNode;
|
|
begin
|
|
if Length(APathName) = 0 then
|
|
Result := Self
|
|
else
|
|
begin
|
|
DotPos := Pos('.', APathName);
|
|
if DotPos = 0 then
|
|
ChildName := APathName
|
|
else
|
|
ChildName := Copy(APathName, 1, DotPos - 1);
|
|
Child := FirstChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
if CompareText(Child.Name, ChildName) = 0 then
|
|
begin
|
|
if DotPos = 0 then
|
|
Result := Child
|
|
else
|
|
Result := Child.FindChild(
|
|
Copy(APathName, DotPos + 1, Length(APathName)));
|
|
exit;
|
|
end;
|
|
Child := Child.NextSibling;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TLinkNode.CreateChildren(const APathName, ALinkTo: String): TLinkNode;
|
|
var
|
|
DotPos: Integer;
|
|
ChildName: String;
|
|
Child, LastChild: TLinkNode;
|
|
begin
|
|
if Length(APathName) = 0 then
|
|
Result := Self
|
|
else
|
|
begin
|
|
DotPos := Pos('.', APathName);
|
|
if DotPos = 0 then
|
|
ChildName := APathName
|
|
else
|
|
ChildName := Copy(APathName, 1, DotPos - 1);
|
|
Child := FirstChild;
|
|
LastChild := nil;
|
|
while Assigned(Child) do
|
|
begin
|
|
if CompareText(Child.Name, ChildName) = 0 then
|
|
begin
|
|
if DotPos = 0 then
|
|
Result := Child
|
|
else
|
|
Result := Child.CreateChildren(
|
|
Copy(APathName, DotPos + 1, Length(APathName)), ALinkTo);
|
|
exit;
|
|
end;
|
|
LastChild := Child;
|
|
Child := Child.NextSibling;
|
|
end;
|
|
{ No child found, let's create one if we are at the end of the path }
|
|
if DotPos > 0 then
|
|
// !!!: better throw an exception
|
|
WriteLn('Link path does not exist: ', APathName);
|
|
Result := TLinkNode.Create(ChildName, ALinkTo);
|
|
if Assigned(LastChild) then
|
|
LastChild.FNextSibling := Result
|
|
else
|
|
FFirstChild := Result;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDocNode }
|
|
|
|
constructor TDocNode.Create(const AName: String; ANode: TDOMElement);
|
|
begin
|
|
inherited Create;
|
|
FName := AName;
|
|
FNode := ANode;
|
|
end;
|
|
|
|
destructor TDocNode.Destroy;
|
|
begin
|
|
if Assigned(FirstChild) then
|
|
FirstChild.Free;
|
|
if Assigned(NextSibling) then
|
|
NextSibling.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
Function TDocNode.IncRefcount : Integer;
|
|
|
|
begin
|
|
Inc(FRefCount);
|
|
Result:=FRefCount;
|
|
end;
|
|
|
|
function TDocNode.FindChild(const APathName: String): TDocNode;
|
|
var
|
|
DotPos: Integer;
|
|
ChildName: String;
|
|
Child: TDocNode;
|
|
begin
|
|
if Length(APathName) = 0 then
|
|
Result := Self
|
|
else
|
|
begin
|
|
DotPos := Pos('.', APathName);
|
|
if DotPos = 0 then
|
|
ChildName := APathName
|
|
else
|
|
ChildName := Copy(APathName, 1, DotPos - 1);
|
|
Child := FirstChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
if CompareText(Child.Name, ChildName) = 0 then
|
|
begin
|
|
if DotPos = 0 then
|
|
Result := Child
|
|
else
|
|
Result := Child.FindChild(
|
|
Copy(APathName, DotPos + 1, Length(APathName)));
|
|
exit;
|
|
end;
|
|
Child := Child.NextSibling;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TDocNode.CreateChildren(const APathName: String): TDocNode;
|
|
var
|
|
DotPos: Integer;
|
|
ChildName: String;
|
|
Child: TDocNode;
|
|
begin
|
|
if Length(APathName) = 0 then
|
|
Result := Self
|
|
else
|
|
begin
|
|
DotPos := Pos('.', APathName);
|
|
if DotPos = 0 then
|
|
ChildName := APathName
|
|
else
|
|
ChildName := Copy(APathName, 1, DotPos - 1);
|
|
Child := FirstChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
if CompareText(Child.Name, ChildName) = 0 then
|
|
begin
|
|
if DotPos = 0 then
|
|
Result := Child
|
|
else
|
|
Result := Child.CreateChildren(
|
|
Copy(APathName, DotPos + 1, Length(APathName)));
|
|
exit;
|
|
end;
|
|
Child := Child.NextSibling;
|
|
end;
|
|
// No child found, let's create one
|
|
Result := TDocNode.Create(ChildName, nil);
|
|
if Assigned(FirstChild) then
|
|
begin
|
|
Result.FNextSibling := FirstChild;
|
|
FFirstChild := Result;
|
|
end else
|
|
FFirstChild := Result;
|
|
|
|
if DotPos > 0 then
|
|
Result := Result.CreateChildren(
|
|
Copy(APathName, DotPos + 1, Length(APathName)));
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TFPDocEngine }
|
|
|
|
constructor TFPDocEngine.Create;
|
|
begin
|
|
inherited Create;
|
|
DescrDocs := TObjectList.Create;
|
|
DescrDocNames := TStringList.Create;
|
|
FRootLinkNode := TLinkNode.Create('', '');
|
|
FRootDocNode := TDocNode.Create('', nil);
|
|
HidePrivate := True;
|
|
InterfaceOnly:=True;
|
|
FPackages := TList.Create;
|
|
end;
|
|
|
|
destructor TFPDocEngine.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FPackages.Count - 1 do
|
|
TPasPackage(FPackages[i]).Release;
|
|
FPackages.Free;
|
|
FRootDocNode.Free;
|
|
FRootLinkNode.Free;
|
|
DescrDocNames.Free;
|
|
DescrDocs.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPDocEngine.SetPackageName(const APackageName: String);
|
|
begin
|
|
ASSERT(not Assigned(Package));
|
|
FPackage := TPasPackage(inherited CreateElement(TPasPackage,
|
|
'#' + APackageName, nil, '', 0));
|
|
FPackages.Add(FPackage);
|
|
CurPackageDocNode := RootDocNode.FindChild('#' + APackageName);
|
|
If Assigned(CurPackageDocNode) then
|
|
CurPackageDocNode.IncRefCount;
|
|
end;
|
|
|
|
procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
|
|
var
|
|
f: Text;
|
|
inheritanceinfo : TStringlist;
|
|
|
|
procedure ReadLinkTree;
|
|
var
|
|
s: String;
|
|
PrevSpaces, ThisSpaces, i, StackIndex: Integer;
|
|
CurParent, PrevSibling, NewNode: TLinkNode;
|
|
ParentStack, SiblingStack: array[0..7] of TLinkNode;
|
|
begin
|
|
PrevSpaces := 0;
|
|
CurParent := RootLinkNode;
|
|
PrevSibling := CurParent.FirstChild;
|
|
if assigned(PrevSibling) then
|
|
while assigned(PrevSibling.NextSibling) do
|
|
PrevSibling := PrevSibling.NextSibling;
|
|
StackIndex := 0;
|
|
while True do
|
|
begin
|
|
ReadLn(f, s);
|
|
if Length(s) = 0 then
|
|
break;
|
|
ThisSpaces := 0;
|
|
while s[ThisSpaces + 1] = ' ' do
|
|
Inc(ThisSpaces);
|
|
if ThisSpaces <> PrevSpaces then
|
|
begin
|
|
if ThisSpaces > PrevSpaces then
|
|
begin
|
|
{ Dive down one level }
|
|
ParentStack[StackIndex] := CurParent;
|
|
SiblingStack[StackIndex] := PrevSibling;
|
|
Inc(StackIndex);
|
|
CurParent := PrevSibling;
|
|
PrevSibling := nil;
|
|
end else
|
|
while PrevSpaces > ThisSpaces do
|
|
begin
|
|
Dec(StackIndex);
|
|
CurParent := ParentStack[StackIndex];
|
|
PrevSibling := SiblingStack[StackIndex];
|
|
Dec(PrevSpaces);
|
|
end;
|
|
PrevSpaces := ThisSpaces;
|
|
end;
|
|
|
|
i := ThisSpaces + 1;
|
|
while s[i] <> ' ' do
|
|
Inc(i);
|
|
NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
|
|
ALinkPrefix + Copy(s, i + 1, Length(s)));
|
|
if Assigned(PrevSibling) then
|
|
PrevSibling.FNextSibling := NewNode
|
|
else
|
|
CurParent.FFirstChild := NewNode;
|
|
PrevSibling := NewNode;
|
|
end;
|
|
end;
|
|
|
|
function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
|
|
var
|
|
DotPos, DotPos2, i,j: Integer;
|
|
s: String;
|
|
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
|
|
if not CreateNew then
|
|
exit;
|
|
HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
|
|
'', 0));
|
|
FPackages.Add(HPackage);
|
|
end;
|
|
|
|
// Find or create module
|
|
DotPos2 := DotPos;
|
|
repeat
|
|
Inc(DotPos2);
|
|
until AName[DotPos2] = '.';
|
|
s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
|
|
Module := nil;
|
|
for i := 0 to HPackage.Modules.Count - 1 do
|
|
if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
|
|
begin
|
|
Module := TPasModule(HPackage.Modules[i]);
|
|
break;
|
|
end;
|
|
if not Assigned(Module) then
|
|
begin
|
|
if not CreateNew then
|
|
exit;
|
|
Module := TPasModule.Create(s, HPackage);
|
|
Module.InterfaceSection := TInterfaceSection.Create('', Module);
|
|
HPackage.Modules.Add(Module);
|
|
end;
|
|
pkg:=hpackage;
|
|
result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
|
|
end;
|
|
|
|
function SearchInList(clslist:TList;s:string):TPasElement;
|
|
var i : integer;
|
|
ClassEl: TPasElement;
|
|
begin
|
|
result:=nil;
|
|
for i:=0 to clslist.count-1 do
|
|
begin
|
|
ClassEl := TPasElement(clslist[i]);
|
|
if CompareText(ClassEl.Name,s) =0 then
|
|
exit(Classel);
|
|
end;
|
|
end;
|
|
|
|
function ResolveClassType(AName:String):TPasClassType;
|
|
var
|
|
pkg : TPasPackage;
|
|
module : TPasModule;
|
|
s : string;
|
|
begin
|
|
Result:=nil;
|
|
s:=ResolvePackageModule(AName,pkg,module,False);
|
|
if not assigned(module) then
|
|
exit;
|
|
result:=TPasClassType(SearchInList(Module.InterfaceSection.Classes,s));
|
|
end;
|
|
|
|
function ResolveAliasType(AName:String):TPasAliasType;
|
|
var
|
|
pkg : TPasPackage;
|
|
module : TPasModule;
|
|
s : string;
|
|
begin
|
|
Result:=nil;
|
|
s:=ResolvePackageModule(AName,pkg,module,False);
|
|
if not assigned(module) then
|
|
exit;
|
|
result:=TPasAliasType(SearchInList(Module.InterfaceSection.Types,s));
|
|
if not (result is TPasAliasType) then
|
|
result:=nil;
|
|
end;
|
|
|
|
procedure ReadClasses;
|
|
|
|
function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
|
|
var
|
|
DotPos, DotPos2, i,j: Integer;
|
|
s: String;
|
|
HPackage: TPasPackage;
|
|
Module: TPasModule;
|
|
|
|
begin
|
|
s:= ResolvePackageModule(AName,HPackage,Module,True);
|
|
// Create node for class
|
|
Result := TPasClassType.Create(s, Module.InterfaceSection);
|
|
Result.ObjKind := okClass;
|
|
Module.InterfaceSection.Declarations.Add(Result);
|
|
Module.InterfaceSection.Classes.Add(Result);
|
|
// defer processing inheritancestr till all classes are loaded.
|
|
if inheritancestr<>'' then
|
|
InheritanceInfo.AddObject(Inheritancestr,result);
|
|
end;
|
|
|
|
procedure splitalias(var instr:string;out outstr:string);
|
|
var i,j:integer;
|
|
begin
|
|
if length(instr)=0 then exit;
|
|
instr:=trim(instr);
|
|
i:=pos('(',instr);
|
|
if i>0 then
|
|
begin
|
|
j:=length(instr)-i;
|
|
if instr[length(instr)]=')' then
|
|
dec(j);
|
|
outstr:=copy(instr,i+1,j);
|
|
delete(instr,i,j+2);
|
|
end
|
|
end;
|
|
|
|
Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
|
|
begin
|
|
result:=TPasClassType(ResolveClassType(clname));
|
|
if assigned(result) and not (cls=result) then // save from tobject=implicit tobject
|
|
begin
|
|
result.addref;
|
|
if IsClass then
|
|
begin
|
|
cls.ancestortype:=result;
|
|
// writeln(cls.name, ' has as ancestor ',result.pathname);
|
|
end
|
|
else
|
|
begin
|
|
cls.interfaces.add(result);
|
|
// writeln(cls.name, ' implements ',result.pathname);
|
|
end;
|
|
end
|
|
else
|
|
if cls<>result then
|
|
writeln(cls.name,'''s dependency ' ,clname,' could not be resolved');
|
|
end;
|
|
|
|
function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
|
|
// create alias clname = alname
|
|
var
|
|
pkg : TPasPackage;
|
|
module : TPasModule;
|
|
s : string;
|
|
begin
|
|
Result:=nil;
|
|
s:=ResolvePackageModule(Alname,pkg,module,True);
|
|
if not assigned(module) then
|
|
exit;
|
|
cl2:=TPasClassType(ResolveClassType(alname));
|
|
if assigned( cl2) and not (parentclass=cl2) then
|
|
begin
|
|
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;
|
|
|
|
procedure ProcessInheritanceStrings(inhInfo:TStringList);
|
|
|
|
var i,j : integer;
|
|
cls : TPasClassType;
|
|
cls2: TPasClassType;
|
|
clname,
|
|
alname : string;
|
|
inhclass : TStringList;
|
|
begin
|
|
inhclass:=TStringList.Create;
|
|
inhclass.delimiter:=',';
|
|
if InhInfo.Count>0 then
|
|
for i:=0 to InhInfo.Count-1 do
|
|
begin
|
|
cls:=TPasClassType(InhInfo.Objects[i]);
|
|
inhclass.clear;
|
|
inhclass.delimitedtext:=InhInfo[i];
|
|
|
|
for j:= 0 to inhclass.count-1 do
|
|
begin
|
|
//writeln('processing',inhclass[j]);
|
|
clname:=inhclass[j];
|
|
splitalias(clname,alname);
|
|
if alname<>'' then // the class//interface we refered to is an alias
|
|
begin
|
|
// writeln('Found alias pair ',clname,' = ',alname);
|
|
if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
|
|
writeln('creating alias failed!');
|
|
end
|
|
else
|
|
cls2:=ResolveAndLinkClass(clname,j=0,cls);
|
|
end;
|
|
end;
|
|
inhclass.free;
|
|
end;
|
|
|
|
var
|
|
s, Name: String;
|
|
CurClass: TPasClassType;
|
|
i: Integer;
|
|
Member: TPasElement;
|
|
begin
|
|
inheritanceinfo :=TStringlist.Create;
|
|
Try
|
|
CurClass := nil;
|
|
while True do
|
|
begin
|
|
ReadLn(f, s);
|
|
if Length(s) = 0 then
|
|
break;
|
|
if s[1] = '#' then
|
|
begin
|
|
// New class
|
|
i := Pos(' ', s);
|
|
CurClass := CreateClass(Copy(s, 1, i - 1), copy(s,i+1,length(s)));
|
|
end else
|
|
begin
|
|
i := Pos(' ', s);
|
|
if i = 0 then
|
|
Name := Copy(s, 3, Length(s))
|
|
else
|
|
Name := Copy(s, 3, i - 3);
|
|
|
|
case s[2] of
|
|
'M':
|
|
Member := TPasProcedure.Create(Name, CurClass);
|
|
'P':
|
|
begin
|
|
Member := TPasProperty.Create(Name, CurClass);
|
|
if i > 0 then
|
|
while i <= Length(s) do
|
|
begin
|
|
case s[i] of
|
|
'r':
|
|
TPasProperty(Member).ReadAccessorName := '<dummy>';
|
|
'w':
|
|
TPasProperty(Member).WriteAccessorName := '<dummy>';
|
|
's':
|
|
TPasProperty(Member).StoredAccessorName := '<dummy>';
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
'V':
|
|
Member := TPasVariable.Create(Name, CurClass);
|
|
else
|
|
raise Exception.Create('Invalid member type: ' + s[2]);
|
|
end;
|
|
CurClass.Members.Add(Member);
|
|
end;
|
|
end;
|
|
ProcessInheritanceStrings(Inheritanceinfo);
|
|
finally
|
|
inheritanceinfo.Free;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
s: String;
|
|
begin
|
|
if not FileExists(AFileName) then
|
|
raise EInOutError.Create('File not found: ' + AFileName);
|
|
Assign(f, AFilename);
|
|
Reset(f);
|
|
while not EOF(f) do
|
|
begin
|
|
ReadLn(f, s);
|
|
if (Length(s) = 0) or (s[1] = '#') then
|
|
continue;
|
|
if s = ':link tree' then
|
|
ReadLinkTree
|
|
else if s = ':classes' then
|
|
ReadClasses
|
|
else
|
|
repeat
|
|
ReadLn(f, s);
|
|
until EOF(f) or (Length(s) = 0);
|
|
end;
|
|
Close(f);
|
|
end;
|
|
|
|
procedure TFPDocEngine.WriteContentFile(const AFilename: String);
|
|
var
|
|
ContentFile: Text;
|
|
|
|
procedure ProcessLinkNode(ALinkNode: TLinkNode; const AIdent: String);
|
|
var
|
|
ChildNode: TLinkNode;
|
|
begin
|
|
WriteLn(ContentFile, AIdent, ALinkNode.Name, ' ', ALinkNode.Link);
|
|
ChildNode := ALinkNode.FirstChild;
|
|
while Assigned(ChildNode) do
|
|
begin
|
|
ProcessLinkNode(ChildNode, AIdent + ' ');
|
|
ChildNode := ChildNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
function CheckImplicitInterfaceLink(const s : String):String;
|
|
begin
|
|
if uppercase(s)='IUNKNOWN' then
|
|
Result:='#rtl.System.IUnknown'
|
|
else
|
|
Result:=s;
|
|
end;
|
|
var
|
|
LinkNode: TLinkNode;
|
|
i, j, k: Integer;
|
|
Module: TPasModule;
|
|
Alias : TPasAliasType;
|
|
ClassDecl: TPasClassType;
|
|
Member: TPasElement;
|
|
s: String;
|
|
begin
|
|
Assign(ContentFile, AFilename);
|
|
Rewrite(ContentFile);
|
|
try
|
|
WriteLn(ContentFile, '# FPDoc Content File');
|
|
WriteLn(ContentFile, ':link tree');
|
|
LinkNode := RootLinkNode.FirstChild;
|
|
while Assigned(LinkNode) do
|
|
begin
|
|
if LinkNode.Name = Package.Name then
|
|
begin
|
|
ProcessLinkNode(LinkNode, '');
|
|
end;
|
|
LinkNode := LinkNode.NextSibling;
|
|
end;
|
|
|
|
if Assigned(Package) then
|
|
begin
|
|
WriteLn(ContentFile);
|
|
WriteLn(ContentFile, ':classes');
|
|
for i := 0 to Package.Modules.Count - 1 do
|
|
begin
|
|
Module := TPasModule(Package.Modules[i]);
|
|
for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
|
|
begin
|
|
ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
|
|
Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' ');
|
|
if Assigned(ClassDecl.AncestorType) then
|
|
begin
|
|
// simple aliases to class types are coded as "alias(classtype)"
|
|
Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName));
|
|
if ClassDecl.AncestorType is TPasAliasType then
|
|
begin
|
|
alias:= TPasAliasType(ClassDecl.AncestorType);
|
|
if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
|
|
write(ContentFile,'(',alias.desttype.PathName,')');
|
|
end;
|
|
end
|
|
else if ClassDecl.ObjKind = okClass then
|
|
Write(ContentFile, '#rtl.System.TObject')
|
|
else if ClassDecl.ObjKind = okInterface then
|
|
Write(ContentFile, '#rtl.System.IUnknown');
|
|
if ClassDecl.Interfaces.Count>0 then
|
|
begin
|
|
for k:=0 to ClassDecl.Interfaces.count-1 do
|
|
begin
|
|
write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName));
|
|
if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then
|
|
begin
|
|
alias:= TPasAliasType(ClassDecl.Interfaces[k]);
|
|
if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
|
|
write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');
|
|
end;
|
|
end;
|
|
end;
|
|
writeln(contentfile);
|
|
for k := 0 to ClassDecl.Members.Count - 1 do
|
|
begin
|
|
Member := TPasElement(ClassDecl.Members[k]);
|
|
Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
|
|
SetLength(s, 0);
|
|
if Member.ClassType = TPasVariable then
|
|
Write(ContentFile, 'V')
|
|
else if Member.ClassType = TPasProperty then
|
|
begin
|
|
Write(ContentFile, 'P');
|
|
if Length(TPasProperty(Member).ReadAccessorName) > 0 then
|
|
s := s + 'r';
|
|
if Length(TPasProperty(Member).WriteAccessorName) > 0 then
|
|
s := s + 'w';
|
|
if Length(TPasProperty(Member).StoredAccessorName) > 0 then
|
|
s := s + 's';
|
|
end else
|
|
Write(ContentFile, 'M'); // Member must be a method
|
|
Write(ContentFile, Member.Name);
|
|
if Length(s) > 0 then
|
|
WriteLn(ContentFile, ' ', s)
|
|
else
|
|
WriteLn(ContentFile);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Close(ContentFile);
|
|
end;
|
|
end;
|
|
|
|
function TFPDocEngine.CreateElement(AClass: TPTreeElement; const AName: String;
|
|
AParent: TPasElement; AVisibility: TPasMemberVisibility;
|
|
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
|
|
begin
|
|
Result := AClass.Create(AName, AParent);
|
|
Result.Visibility := AVisibility;
|
|
if AClass.InheritsFrom(TPasModule) then
|
|
CurModule := TPasModule(Result);
|
|
Result.SourceFilename := ASourceFilename;
|
|
Result.SourceLinenumber := ASourceLinenumber;
|
|
end;
|
|
|
|
function TFPDocEngine.FindElement(const AName: String): TPasElement;
|
|
|
|
function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
|
|
|
|
var
|
|
l: TList;
|
|
i: Integer;
|
|
|
|
begin
|
|
If assigned(AModule.InterfaceSection) and
|
|
Assigned(AModule.InterfaceSection.Declarations) then
|
|
begin
|
|
l:=AModule.InterfaceSection.Declarations;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
Result := TPasElement(l[i]);
|
|
if CompareText(Result.Name, LocalName) = 0 then
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
//ModuleName, LocalName: String;
|
|
Module: TPasElement;
|
|
begin
|
|
{!!!: Don't know if we ever will have to use the following:
|
|
i := Pos('.', AName);
|
|
if i <> 0 then
|
|
begin
|
|
WriteLn('Dot found in name: ', AName);
|
|
Result := nil;
|
|
end else
|
|
begin}
|
|
Result := FindInModule(CurModule, AName);
|
|
if not Assigned(Result) then
|
|
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
|
|
begin
|
|
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
|
|
if Module.ClassType = TPasModule then
|
|
begin
|
|
Result := FindInModule(TPasModule(Module), AName);
|
|
if Assigned(Result) then
|
|
exit;
|
|
end;
|
|
end;
|
|
{end;}
|
|
end;
|
|
|
|
function TFPDocEngine.FindModule(const AName: String): TPasModule;
|
|
|
|
function FindInPackage(APackage: TPasPackage): TPasModule;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to APackage.Modules.Count - 1 do
|
|
begin
|
|
Result := TPasModule(APackage.Modules[i]);
|
|
if CompareText(Result.Name, AName) = 0 then
|
|
exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := FindInPackage(Package);
|
|
if not Assigned(Result) then
|
|
for i := FPackages.Count - 1 downto 0 do
|
|
begin
|
|
if TPasPackage(FPackages[i]) = Package then
|
|
continue;
|
|
Result := FindInPackage(TPasPackage(FPackages[i]));
|
|
if Assigned(Result) then
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
|
|
begin
|
|
RootLinkNode.CreateChildren(APathName, ALinkTo);
|
|
end;
|
|
|
|
function TFPDocEngine.FindAbsoluteLink(const AName: String): String;
|
|
var
|
|
LinkNode: TLinkNode;
|
|
begin
|
|
LinkNode := RootLinkNode.FindChild(AName);
|
|
if Assigned(LinkNode) then
|
|
Result := LinkNode.Link
|
|
else
|
|
SetLength(Result, 0);
|
|
end;
|
|
|
|
function TFPDocEngine.ResolveLink(AModule: TPasModule;
|
|
const ALinkDest: String): String;
|
|
var
|
|
i: Integer;
|
|
ThisPackage: TLinkNode;
|
|
UnitList: TList;
|
|
|
|
function CanWeExit(AResult: string): boolean;
|
|
var
|
|
s: string;
|
|
begin
|
|
s := StringReplace(Lowercase(ALinkDest), '.', '_', [rfReplaceAll]);
|
|
Result := pos(s, AResult) > 0;
|
|
end;
|
|
|
|
begin
|
|
//system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ');
|
|
if Length(ALinkDest) = 0 then
|
|
begin
|
|
SetLength(Result, 0);
|
|
exit;
|
|
end;
|
|
|
|
if (ALinkDest[1] = '#') or (not assigned(AModule)) then
|
|
Result := FindAbsoluteLink(ALinkDest)
|
|
else
|
|
begin
|
|
if Pos(AModule.Name, ALinkDest) = 1 then
|
|
begin
|
|
Result := ResolveLink(AModule, amodule.packagename + '.' + ALinkDest);
|
|
if CanWeExit(Result) then
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest);
|
|
if CanWeExit(Result) then
|
|
Exit;
|
|
end;
|
|
|
|
{ Try all packages }
|
|
SetLength(Result, 0);
|
|
ThisPackage := RootLinkNode.FirstChild;
|
|
while Assigned(ThisPackage) do
|
|
begin
|
|
Result := ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest);
|
|
if CanWeExit(Result) then
|
|
Exit;
|
|
ThisPackage := ThisPackage.NextSibling;
|
|
end;
|
|
|
|
if not CanWeExit(Result) then
|
|
begin
|
|
{ Okay, then we have to try all imported units of the current module }
|
|
UnitList := AModule.InterfaceSection.UsesList;
|
|
for i := UnitList.Count - 1 downto 0 do
|
|
begin
|
|
{ Try all packages }
|
|
ThisPackage := RootLinkNode.FirstChild;
|
|
while Assigned(ThisPackage) do
|
|
begin
|
|
Result := ResolveLink(AModule, ThisPackage.Name + '.' +
|
|
TPasType(UnitList[i]).Name + '.' + ALinkDest);
|
|
if CanWeExit(Result) then
|
|
Exit;
|
|
ThisPackage := ThisPackage.NextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if Length(Result) = 0 then
|
|
for i := Length(ALinkDest) downto 1 do
|
|
if ALinkDest[i] = '.' then
|
|
begin
|
|
Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1));
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPDocEngine.AddDocFile(const AFilename: String);
|
|
|
|
function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
|
|
var
|
|
Subnode: TDOMNode;
|
|
begin
|
|
if OwnerDocNode = RootDocNode then
|
|
Result := OwnerDocNode.CreateChildren('#' + Element['name'])
|
|
else
|
|
Result := OwnerDocNode.CreateChildren(Element['name']);
|
|
Result.FNode := Element;
|
|
Result.FLink := Element['link'];
|
|
Result.FIsSkipped := Element['skip'] = '1';
|
|
Subnode := Element.FirstChild;
|
|
while Assigned(Subnode) do
|
|
begin
|
|
if Subnode.NodeType = ELEMENT_NODE then
|
|
begin
|
|
if Subnode.NodeName = 'short' then
|
|
Result.FShortDescr := TDOMElement(Subnode)
|
|
else if Subnode.NodeName = 'descr' then
|
|
Result.FDescr := TDOMElement(Subnode)
|
|
else if Subnode.NodeName = 'version' then
|
|
begin
|
|
Result.FVersion := TDOMElement(Subnode)
|
|
end
|
|
else if Subnode.NodeName = 'errors' then
|
|
Result.FErrorsDoc := TDOMElement(Subnode)
|
|
else if Subnode.NodeName = 'seealso' then
|
|
Result.FSeeAlso := TDOMElement(Subnode)
|
|
else if (Subnode.NodeName = 'example') and
|
|
not Assigned(Result.FirstExample) then
|
|
Result.FFirstExample := TDOMElement(Subnode);
|
|
end;
|
|
Subnode := Subnode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
Procedure ReadTopics(TopicNode : TDocNode);
|
|
|
|
Var
|
|
SubNode : TDOMNode;
|
|
|
|
begin
|
|
SubNode:=TopicNode.FNode.FirstChilD;
|
|
While Assigned(SubNode) do
|
|
begin
|
|
If (SubNode.NodeType=ELEMENT_NODE) and (SubNode.NodeName='topic') then
|
|
With ReadNode(TopicNode,TDomElement(SubNode)) do
|
|
// We could allow recursion here, but we won't, because it doesn't work on paper.
|
|
FTopicNode:=True;
|
|
SubNode:=Subnode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Node, Subnode, Subsubnode: TDOMNode;
|
|
Element: TDOMElement;
|
|
Doc: TXMLDocument;
|
|
PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
|
|
|
|
begin
|
|
ReadXMLFile(Doc, AFilename);
|
|
DescrDocs.Add(Doc);
|
|
DescrDocNames.Add(AFilename);
|
|
|
|
Node := Doc.DocumentElement.FirstChild;
|
|
while Assigned(Node) do
|
|
begin
|
|
if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
|
|
begin
|
|
PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
|
|
PackageDocNode.IncRefCount;
|
|
// Scan all 'module' elements within this package element
|
|
Subnode := Node.FirstChild;
|
|
while Assigned(Subnode) do
|
|
begin
|
|
if (Subnode.NodeType = ELEMENT_NODE) then
|
|
begin
|
|
If (Subnode.NodeName = 'module') then
|
|
begin
|
|
ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
|
|
// Scan all 'element' elements within this module element
|
|
Subsubnode := Subnode.FirstChild;
|
|
while Assigned(Subsubnode) do
|
|
begin
|
|
if (Subsubnode.NodeType = ELEMENT_NODE) then
|
|
begin
|
|
if (Subsubnode.NodeName = 'element') then
|
|
ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
|
|
else if (SubSubNode.NodeName='topic') then
|
|
begin
|
|
TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
|
|
TopicNode.FTopicNode:=True;
|
|
ReadTopics(TopicNode);
|
|
end;
|
|
end;
|
|
Subsubnode := Subsubnode.NextSibling;
|
|
end;
|
|
end
|
|
else if (SubNode.NodeName='topic') then
|
|
begin
|
|
TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
|
|
TopicNode.FTopicNode:=True;
|
|
ReadTopics(TopicNode);
|
|
end;
|
|
end;
|
|
Subnode := Subnode.NextSibling;
|
|
end;
|
|
end;
|
|
Node := Node.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
|
|
begin
|
|
Result:=Nil;
|
|
If Assigned(AElement) then
|
|
begin
|
|
if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
|
|
Result := FindDocNode(AElement.GetModule, AElement.Name)
|
|
else
|
|
Result := RootDocNode.FindChild(AElement.PathName);
|
|
if (Result=Nil) and
|
|
WarnNoNode and
|
|
(Length(AElement.PathName)>0) and
|
|
(AElement.PathName[1]='#') then
|
|
Writeln('No documentation node found for identifier : ',AElement.PathName);
|
|
end;
|
|
end;
|
|
|
|
function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
|
|
const AName: String): TDocNode;
|
|
var
|
|
CurPackage: TDocNode;
|
|
UnitList: TList;
|
|
i: Integer;
|
|
begin
|
|
if Length(AName) = 0 then
|
|
Result := nil
|
|
else
|
|
begin
|
|
if AName[1] = '#' then
|
|
Result := RootDocNode.FindChild(AName)
|
|
else
|
|
Result := RootDocNode.FindChild(Package.Name + '.' + AName);
|
|
if (not Assigned(Result)) and Assigned(ARefModule) then
|
|
Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
|
|
|
|
if (not Assigned(Result)) and (AName[1] <> '#') then
|
|
begin
|
|
CurPackage := RootDocNode.FirstChild;
|
|
while Assigned(CurPackage) do
|
|
begin
|
|
Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
|
|
if Assigned(Result) then
|
|
break;
|
|
CurPackage := CurPackage.NextSibling;
|
|
end;
|
|
if not Assigned(Result) then
|
|
begin
|
|
{ Okay, then we have to try all imported units of the current module }
|
|
UnitList := CurModule.InterfaceSection.UsesList;
|
|
for i := UnitList.Count - 1 downto 0 do
|
|
begin
|
|
{ Try all packages }
|
|
CurPackage := RootDocNode.FirstChild;
|
|
while Assigned(CurPackage) do
|
|
begin
|
|
Result := RootDocNode.FindChild(CurPackage.Name + '.' +
|
|
TPasType(UnitList[i]).Name + '.' + AName);
|
|
if Assigned(Result) then
|
|
break;
|
|
CurPackage := CurPackage.NextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
|
|
|
|
var
|
|
DocNode,N: TDocNode;
|
|
|
|
begin
|
|
DocNode := FindDocNode(AElement);
|
|
if Assigned(DocNode) then
|
|
begin
|
|
N:=FindLinkedNode(DocNode);
|
|
If (N<>Nil) then
|
|
DocNode:=N;
|
|
Result := DocNode.ShortDescr;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
|
|
function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
|
|
|
|
Var
|
|
S: String;
|
|
|
|
begin
|
|
If (ANode.Link='') then
|
|
Result:=Nil
|
|
else
|
|
Result:=FindDocNode(CurModule,ANode.Link);
|
|
end;
|
|
|
|
function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
|
|
const AName: String): TDOMElement;
|
|
|
|
var
|
|
N,DocNode: TDocNode;
|
|
|
|
begin
|
|
DocNode := FindDocNode(ARefModule, AName);
|
|
if Assigned(DocNode) then
|
|
begin
|
|
N:=FindLinkedNode(DocNode);
|
|
If (N<>Nil) then
|
|
DocNode:=N;
|
|
Result := DocNode.ShortDescr;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFPDocEngine.GetExampleFilename(const ExElement: TDOMElement): String;
|
|
var
|
|
i: Integer;
|
|
fn : String;
|
|
|
|
begin
|
|
Result:='';
|
|
for i := 0 to DescrDocs.Count - 1 do
|
|
begin
|
|
Fn:=ExElement['file'];
|
|
if (FN<>'') and (TDOMDocument(DescrDocs[i]) = ExElement.OwnerDocument) then
|
|
begin
|
|
Result := ExtractFilePath(DescrDocNames[i]) + FN;
|
|
if (ExtractFileExt(Result)='') then
|
|
Result:=Result+'.pp';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Global helpers }
|
|
|
|
procedure TranslateDocStrings(const Lang: String);
|
|
|
|
Const
|
|
{$ifdef unix}
|
|
DefDir = '/usr/local/share/locale';
|
|
{$else}
|
|
DefDir = 'intl';
|
|
{$endif}
|
|
|
|
var
|
|
mo: TMOFile;
|
|
dir : string;
|
|
begin
|
|
dir:=modir;
|
|
If Dir='' then
|
|
Dir:=DefDir;
|
|
Dir:=IncludeTrailingPathDelimiter(Dir);
|
|
{$IFDEF Unix}
|
|
mo := TMOFile.Create(Format(Dir+'%s/LC_MESSAGES/dglobals.mo', [Lang]));
|
|
{$ELSE}
|
|
mo := TMOFile.Create(Format(Dir+'dglobals.%s.mo', [Lang]));
|
|
{$ENDIF}
|
|
try
|
|
TranslateResourceStrings(mo);
|
|
finally
|
|
mo.Free;
|
|
end;
|
|
end;
|
|
|
|
Function IsLinkNode(Node : TDomNode) : Boolean;
|
|
|
|
begin
|
|
Result:=Assigned(Node) and (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link');
|
|
end;
|
|
|
|
Function IsExampleNode(Example : TDomNode) : Boolean;
|
|
|
|
begin
|
|
Result:=Assigned(Example) and (Example.NodeType = ELEMENT_NODE) and (Example.NodeName = 'example')
|
|
end;
|
|
|
|
function IsLinkAbsolute(ALink: String): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := false;
|
|
for i := low(AbsoluteLinkPrefixes) to high(AbsoluteLinkPrefixes) do
|
|
if CompareText(AbsoluteLinkPrefixes[i], copy(ALink,1,length(AbsoluteLinkPrefixes[i])))=0 then begin
|
|
Result := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
LEOL:=Length(LineEnding);
|
|
end.
|