fpc/utils/fpdoc/dw_ipf.pp
fpc 790a4fe2d3 * log and id tags removed
git-svn-id: trunk@42 -
2005-05-21 09:42:41 +00:00

1342 lines
36 KiB
ObjectPascal
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{
FPDoc - Free Pascal Documentation Tool
Copyright (C) 2000 - 2003 by
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
* IPF 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.
}
unit dw_IPF;
{$MODE objfpc}
{$H+}
interface
uses SysUtils, Classes, dWriter, DOM, dGlobals, PasTree;
const
IPFHighLight : Boolean = False;
IPFExtension : String = '.ipf';
type
TLabelType = (ltConst,ltVar,ltType,ltFunction,ltProcedure,ltClass,
ltChapter,ltSection,ltSubsection,
ltTable,ltFigure);
{ TIPFWriter }
TIPFWriter = class(TFPDocWriter)
protected
f: Text;
FLink: String;
PackageName: String;
Module: TPasModule;
ModuleName: String;
FTableCount : Integer;
TableRowStartFlag, TableCaptionWritten: Boolean;
function GetLabel(AElement: TPasElement): String;
procedure Write(const s: String);
procedure WriteF(const s: String; const Args: array of const);
procedure WriteLn(const s: String);
procedure WriteLnF(const s: String; const Args: array of const);
// Tex functions
procedure WriteLabel(El: TPasElement);
procedure WriteLabel(const s: String);
procedure WriteIndex(El: TPasElement);
procedure WriteIndex(const s: String);
procedure StartListing(Frames: Boolean; const name: String);
procedure StartListing(Frames: Boolean);
procedure EndListing;
Function EscapeTex(S : String) : String;
Function StripTex(S : String) : String;
procedure WriteCommentLine;
procedure WriteComment(Comment : String);
procedure StartSection(SectionName : String; SectionLabel : String);
// procedure StartSection(SectionName : String);
procedure StartSubSection(SubSectionName : String; SubSectionLabel : String);
// procedure StartSubSection(SubSectionName : String);
procedure StartChapter(ChapterName : String; ChapterLabel : String);
procedure StartChapter(ChapterName : String);
// Description node conversion
procedure DescrWriteText(const AText: DOMString); override;
procedure DescrBeginBold; override;
procedure DescrEndBold; override;
procedure DescrBeginItalic; override;
procedure DescrEndItalic; override;
procedure DescrBeginEmph; override;
procedure DescrEndEmph; override;
procedure DescrWriteFileEl(const AText: DOMString); override;
procedure DescrWriteKeywordEl(const AText: DOMString); override;
procedure DescrWriteVarEl(const AText: DOMString); override;
procedure DescrBeginLink(const AId: DOMString); override;
procedure DescrEndLink; override;
procedure DescrWriteLinebreak; override;
procedure DescrBeginParagraph; override;
procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
procedure DescrWriteCodeLine(const ALine: String); override;
procedure DescrEndCode; override;
procedure DescrEndParagraph; override;
procedure DescrBeginOrderedList; override;
procedure DescrEndOrderedList; override;
procedure DescrBeginUnorderedList; override;
procedure DescrEndUnorderedList; override;
procedure DescrBeginDefinitionList; override;
procedure DescrEndDefinitionList; override;
procedure DescrBeginListItem; override;
procedure DescrEndListItem; override;
procedure DescrBeginDefinitionTerm; override;
procedure DescrEndDefinitionTerm; override;
procedure DescrBeginDefinitionEntry; override;
procedure DescrEndDefinitionEntry; override;
procedure DescrBeginSectionTitle; override;
procedure DescrBeginSectionBody; override;
procedure DescrEndSection; override;
procedure DescrBeginRemark; override;
procedure DescrEndRemark; override;
procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
procedure DescrEndTable; override;
procedure DescrBeginTableCaption; override;
procedure DescrEndTableCaption; override;
procedure DescrBeginTableHeadRow; override;
procedure DescrEndTableHeadRow; override;
procedure DescrBeginTableRow; override;
procedure DescrEndTableRow; override;
procedure DescrBeginTableCell; override;
procedure DescrEndTableCell; override;
function ConstValue(ConstDecl: TPasConst): String;
procedure ProcessSection(ASection: TPasSection);
// Documentation writing methods.
procedure WriteResourceStrings(ASection: TPasSection);
procedure WriteUnitOverview(ASection: TPasSection);
procedure WriteVarsConstsTypes(ASection: TPasSection);
procedure WriteConsts(ASection: TPasSection);
procedure WriteTypes(ASection: TPasSection);
procedure WriteEnumElements(TypeDecl : TPasEnumType);
procedure WriteVars(ASection: TPasSection);
procedure WriteFunctionsAndProcedures(ASection: TPasSection);
procedure WriteProcedure(ProcDecl: TPasProcedureBase);
procedure WriteClasses(ASection: TPasSection);
procedure WriteClassDecl(ClassDecl: TPasClassType);
procedure WriteClassMethodOverview(ClassDecl: TPasClassType);
procedure WriteClassPropertyOverview(ClassDecl: TPasClassType);
procedure WriteProperty(PropDecl: TPasProperty);
procedure WriteExample(ADocNode: TDocNode);
procedure WriteSeeAlso(ADocNode: TDocNode);
procedure SortElementList(List : TList);
Function ShowMember(M : TPasElement) : boolean;
public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
procedure WriteDoc; override;
end;
implementation
constructor TIPFWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
procedure AddLabel(AElement: TPasElement);
begin
Engine.AddLink(AElement.PathName, GetLabel(AElement));
end;
procedure AddList(AElement: TPasElement; AList: TList);
var
i: Integer;
begin
for i := 0 to AList.Count - 1 do
AddLabel(TPasElement(AList[i]));
end;
procedure ScanModule(AModule: TPasModule);
var
i, j, k: Integer;
s: String;
ClassEl: TPasClassType;
FPEl, AncestorMemberEl: TPasElement;
DocNode: TDocNode;
DidAutolink: Boolean;
begin
AddLabel(AModule);
with AModule do
begin
AddList(AModule, InterfaceSection.ResStrings);
AddList(AModule, InterfaceSection.Consts);
AddList(AModule, InterfaceSection.Types);
if InterfaceSection.Classes.Count > 0 then
begin
for i := 0 to InterfaceSection.Classes.Count - 1 do
begin
ClassEl := TPasClassType(InterfaceSection.Classes[i]);
AddLabel(ClassEl);
for j := 0 to ClassEl.Members.Count - 1 do
begin
FPEl := TPasElement(ClassEl.Members[j]);
if ((FPEl.Visibility = visPrivate) and Engine.HidePrivate) or
((FPEl.Visibility = visProtected) and Engine.HideProtected) then
continue;
DocNode := Engine.FindDocNode(FPEl);
if not Assigned(DocNode) then
begin
DidAutolink := False;
if Assigned(ClassEl.AncestorType) and
(ClassEl.AncestorType.ClassType = TPasClassType) then
begin
for k := 0 to TPasClassType(ClassEl.AncestorType).Members.Count - 1 do
begin
AncestorMemberEl :=
TPasElement(TPasClassType(ClassEl.AncestorType).Members[k]);
if AncestorMemberEl.Name = FPEl.Name then
begin
DocNode := Engine.FindDocNode(AncestorMemberEl);
if Assigned(DocNode) then
begin
DidAutolink := True;
Engine.AddLink(FPEl.PathName,
Engine.FindAbsoluteLink(AncestorMemberEl.PathName));
break;
end;
end;
end;
end;
if not DidAutolink then
AddLabel(FPEl);
end else
AddLabel(FPEl);
end;
end;
end;
AddList(AModule, InterfaceSection.Functions);
AddList(AModule, InterfaceSection.Variables);
end;
end;
var
i: Integer;
begin
inherited ;
{ Allocate labels for all elements for which we are going to create
documentation. This is needed for links to work correctly. }
// Allocate label for the package itself, if a name is given (i.e. <> '#')
if Length(Package.Name) > 1 then
AddLabel(Package);
for i := 0 to Package.Modules.Count - 1 do
ScanModule(TPasModule(Package.Modules[i]));
end;
procedure TIPFWriter.WriteDoc;
var
i : Integer;
begin
PackageName := LowerCase(Copy(Package.Name, 2, 255));
If (Engine.OutPut='') then
Engine.Output:=PackageName+IPFExtension;
Assign(f, Engine.Output);
Rewrite(f);
try
WriteLn('.* This file has been created automatically by FPDoc,');
WriteLn('.* (c) 2000-2003 by Areca Systems GmbH / Sebastian Guenther (sg@freepascal.org)');
for i := 0 to Package.Modules.Count - 1 do
begin
Module := TPasModule(Package.Modules[i]);
ModuleName := LowerCase(Module.Name);
WriteLn('');
Write(':h1 name=');
WriteLabel(Module);
WriteLnF('.%s', [EscapeTex(Format(SDocUnitTitle, [Module.Name]))]);
ProcessSection(Module.InterfaceSection);
end;
finally
Close(f);
end;
end;
function TIPFWriter.GetLabel(AElement: TPasElement): String;
var
i: Integer;
begin
if AElement.ClassType = TPasUnresolvedTypeRef then
Result := Engine.ResolveLink(Module, AElement.Name)
else
begin
Result := AElement.PathName;
Result := LowerCase(Copy(Result, 2, Length(Result) - 1));
end;
for i := 1 to Length(Result) do
if Result[i] = '.' then
Result[i] := '_';
end;
procedure TIPFWriter.Write(const s: String);
begin
System.Write(f, s);
end;
procedure TIPFWriter.WriteF(const s: String; const Args: array of const);
begin
System.Write(f, Format(s, Args));
end;
procedure TIPFWriter.WriteLn(const s: String);
begin
System.WriteLn(f, s);
end;
procedure TIPFWriter.WriteLnF(const s: String; const Args: array of const);
begin
System.WriteLn(f, Format(s, Args));
end;
Function TIPFWriter.EscapeTex(S : String) : String;
var
i: Integer;
begin
SetLength(Result, 0);
for i := 1 to Length(S) do
case S[i] of
'.': // Escape these characters
Result := Result + '&per.';
':':
Result := Result + '&colon.';
',':
Result := Result + '&comma.';
'&':
Result := Result + '&amp.';
(*
<EFBFBD>&amp. <20>ampersand <20>& <20>
<EFBFBD>&and. <20>and <20>^ <20>
<EFBFBD>&apos. <20>apostrophe <20>' <20>
<EFBFBD>&asterisk. <20>asterisk <20>* <20>
<EFBFBD>&atsign. <20>at sign <20>@ <20>
<EFBFBD>&bslash., &bsl. <20>back slash <20>\ <20>
<EFBFBD>&caret. <20>caret symbol <20>^ <20>
<EFBFBD>&cdq. <20>close double quote <20>" <20>
<EFBFBD>&csq. <20>close single quote <20>' <20>
<EFBFBD>&comma. <20>comma <20>, <20>
<EFBFBD>&colon. <20>colon <20>: <20>
<EFBFBD>&dash. <20>dash <20>- <20>
<EFBFBD>&degree., &deg. <20>degree <20><> <20>
<EFBFBD>&dollar. <20>dollar sign <20>$ <20>
<EFBFBD>&dot. <20>dot <20><> <20>
<EFBFBD>&darrow. <20>down arrow <20> <20>
<EFBFBD>&emdash. <20>em dash <20>- <20>
<EFBFBD>&endash. <20>en dash <20>- <20>
<EFBFBD>&eq., &equals., <20>equal sign <20>= <20>
<EFBFBD>&eqsym. <20> <20> <20>
<EFBFBD>&xclm., &xclam. <20>exclamation point <20>! <20>
<EFBFBD>&gtsym., &gt. <20>greater than <20>> <20>
<EFBFBD>&house. <20>house <20> <20>
<EFBFBD>&hyphen. <20>hyphen <20>- <20>
<EFBFBD>&larrow. <20>left arrow <20> <20>
<EFBFBD>&lahead. <20>left arrowhead <20> <20>
<EFBFBD>&lbrace., &lbrc. <20>left brace <20>{ <20>
<EFBFBD>&lbracket. &lbrk. <20>left bracket <20>[ <20>
<EFBFBD>&lpar. , &lparen. <20>left parenthesis <20>( <20>
<EFBFBD>&mdash. <20>em dash <20>- <20>
<EFBFBD>&minus. <20>minus sign <20>- <20>
<EFBFBD>&ndash. <20>en dash <20>- <20>
<EFBFBD>&numsign. <20>number sign <20># <20>
<EFBFBD>&odq. <20>open double quote <20>" <20>
<EFBFBD>&osq. <20>open single quote <20>` <20>
<EFBFBD>&percent. <20>percent <20>% <20>
<EFBFBD>&per. <20>period <20>. <20>
<EFBFBD>&plus. <20>plus sign <20>+ <20>
<EFBFBD>&rbrace., &rbrc. <20>right brace <20>} <20>
<EFBFBD>&rbracket., &rbrk. <20>right bracket <20>] <20>
<EFBFBD>&rpar., &rparen. <20>right parenthesis <20>) <20>
<EFBFBD>&slash., &slr. <20>slash <20>/ <20>
<EFBFBD>&splitvbar. <20>split vertical bar <20>| <20>
<EFBFBD> <20>(piping symbol) <20> <20>
<EFBFBD>&sqbul. <20>square bullet <20><> <20>
<EFBFBD>&tilde. <20>tilde <20>~ <20>
<EFBFBD>&us. <20>underscore <20>_ <20>
*)
else
Result := Result + S[i];
end;
end;
Function TIPFWriter.StripTex(S : String) : String;
var
I,L: Integer;
begin
Result:=S;
// SetLength(Result, 0);
// for i := 1 to Length(S) do
// If not (S[i] in ['&','{','}','#','_','$','%','''','~','^', '\']) then
// Result := Result + S[i];
end;
procedure TIPFWriter.DescrWriteText(const AText: DOMString);
begin
Write(EscapeTex(AText));
end;
procedure TIPFWriter.DescrBeginBold;
begin
Write(':hp2.');
end;
procedure TIPFWriter.DescrEndBold;
begin
WriteLn(':ehp2.');
end;
procedure TIPFWriter.DescrBeginItalic;
begin
Write(':hp1.');
end;
procedure TIPFWriter.DescrEndItalic;
begin
WriteLn(':ehp1.');
end;
procedure TIPFWriter.DescrBeginEmph;
begin
Write(':hp2.');
end;
procedure TIPFWriter.DescrEndEmph;
begin
Write(':ehp2.');
end;
procedure TIPFWriter.DescrWriteFileEl(const AText: DOMString);
begin
Write(':hp2.');
DescrWriteText(AText);
Write(':ehp2.');
end;
procedure TIPFWriter.DescrWriteKeywordEl(const AText: DOMString);
begin
Write(':hp2.');
DescrWriteText(AText);
Write(':ehp2.');
end;
procedure TIPFWriter.DescrWriteVarEl(const AText: DOMString);
begin
Write(':hp2.');
DescrWriteText(AText);
Write(':ehp2.');
end;
procedure TIPFWriter.DescrBeginLink(const AId: DOMString);
var
i: Integer;
begin
FLink := Engine.ResolveLink(Module, AId);
While pos(':',flink)>0 do flink[pos(':',flink)]:='_';
// System.WriteLn('Link "', AId, '" => ', FLink);
WriteF(':link reftype=hd refid=%s.', [flink]);
end;
procedure TIPFWriter.DescrEndLink;
begin
Write(':elink.');
end;
procedure TIPFWriter.DescrWriteLinebreak;
begin
WriteLn('.br');
end;
procedure TIPFWriter.DescrBeginParagraph;
begin
WriteLn(':p.');
// Do nothing
end;
procedure TIPFWriter.DescrEndParagraph;
begin
WriteLn('');
WriteLn('');
end;
procedure TIPFWriter.DescrBeginCode(HasBorder: Boolean;
const AHighlighterName: String);
begin
StartListing(HasBorder);
end;
procedure TIPFWriter.DescrWriteCodeLine(const ALine: String);
begin
WriteLn(EscapeTex(ALine));
end;
procedure TIPFWriter.DescrEndCode;
begin
EndListing
end;
procedure TIPFWriter.DescrBeginOrderedList;
begin
WriteLn(':ol.');
end;
procedure TIPFWriter.DescrEndOrderedList;
begin
WriteLn(':eol.');
end;
procedure TIPFWriter.DescrBeginUnorderedList;
begin
WriteLn(':ul.');
end;
procedure TIPFWriter.DescrEndUnorderedList;
begin
WriteLn(':eul.');
end;
procedure TIPFWriter.DescrBeginDefinitionList;
begin
WriteLn(':dl.');
end;
procedure TIPFWriter.DescrEndDefinitionList;
begin
WriteLn(':edl.');
end;
procedure TIPFWriter.DescrBeginListItem;
begin
Write(':li.');
end;
procedure TIPFWriter.DescrEndListItem;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrBeginDefinitionTerm;
begin
Write(':li.');
end;
procedure TIPFWriter.DescrEndDefinitionTerm;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrBeginDefinitionEntry;
begin
WriteLn('');
// Do nothing
end;
procedure TIPFWriter.DescrEndDefinitionEntry;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrBeginSectionTitle;
begin
Write(':h3.');
end;
procedure TIPFWriter.DescrBeginSectionBody;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrEndSection;
begin
WriteLn('');
// Do noting
end;
procedure TIPFWriter.DescrBeginRemark;
begin
WriteLn(':note.');
end;
procedure TIPFWriter.DescrEndRemark;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
begin
// !!!: How do we set the border?
// for i := 1 to ColCount do
// Write('l');
// write('}{');
TableCaptionWritten:=False;
end;
procedure TIPFWriter.DescrEndTable;
begin
WriteLn(':etable.');
end;
procedure TIPFWriter.DescrBeginTableCaption;
begin
// Do nothing.
end;
procedure TIPFWriter.DescrEndTableCaption;
begin
Write('');
// Inc(FTableCount);
// Write(IntToStr(FTableCount));
// Writeln('}');
TableCaptionWritten := True;
Write(':table cols=''30 50''.');
end;
procedure TIPFWriter.DescrBeginTableHeadRow;
begin
if not TableCaptionWritten then
DescrEndTableCaption;
TableRowStartFlag := True;
WriteLn(':row.:c.');
end;
procedure TIPFWriter.DescrEndTableHeadRow;
begin
WriteLn('');
end;
procedure TIPFWriter.DescrBeginTableRow;
begin
if not TableCaptionWritten then
DescrEndTableCaption;
TableRowStartFlag := True;
WriteLn(':row.:c.');
end;
procedure TIPFWriter.DescrEndTableRow;
begin
end;
procedure TIPFWriter.DescrBeginTableCell;
begin
if TableRowStartFlag then
TableRowStartFlag := False
else
WriteLn(':c.');
end;
procedure TIPFWriter.DescrEndTableCell;
begin
WriteLn('');
// Do nothing
end;
function TIPFWriter.ConstValue(ConstDecl: TPasConst): String;
begin
if Assigned(ConstDecl) then
Result := ConstDecl.ClassName
else
Result := '<nil>';
end;
procedure TIPFWriter.WriteUnitOverview(ASection: TPasSection);
var
i: Integer;
UnitRef: TPasType;
DocNode: TDocNode;
begin
if ASection.UsesList.Count > 0 then
begin
WriteLnF(':h2.%s', [SDocUsedUnits]);
WriteLn(':ol.');
for i := 0 to ASection.UsesList.Count - 1 do
begin
UnitRef := TPasType(ASection.UsesList[i]);
WriteLnF(':li.%s', [UnitRef.Name]);
end;
WriteLn(':eol.');
end;
DocNode := Engine.FindDocNode(ASection.Parent);
if Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr) then
begin
WriteLnF(':h2.%s', [EscapeTex(SDocOverview)]);
WriteDescr(ASection.Parent, DocNode.Descr);
Writeln('');
end;
end;
procedure TIPFWriter.WriteResourceStrings(ASection: TPasSection);
var
ResStrDecl: TPasResString;
i: Integer;
begin
if ASection.ResStrings.Count > 0 then
begin
StartSubSection(SDocResStrings,ModuleName+'ResStrings');
for i := 0 to ASection.ResStrings.Count - 1 do
begin
ResStrDecl := TPasResString(ASection.ResStrings[i]);
StartListing(false, '');
Writeln(ResStrDecl.GetDeclaration(True));
EndListing;
WriteLabel(ResStrDecl);
WriteIndex(ResStrDecl);
WriteDescr(ResStrDecl);
Writeln('');
end;
end;
end;
procedure TIPFWriter.WriteConsts(ASection: TPasSection);
var
i: Integer;
ConstDecl: TPasConst;
begin
if ASection.Consts.Count > 0 then
begin
WriteLnF(':h3 name=suse_%sconstants.%s', [EscapeTex(ModuleName), EscapeTex(SDocConstants)]);
for i := 0 to ASection.Consts.Count - 1 do
begin
ConstDecl := TPasConst(ASection.Consts[i]);
StartListing(False);
WriteLn(EscapeTex(ConstDecl.GetDeclaration(True)));
EndListing;
// WriteLabel(ConstDecl);
// WriteIndex(ConstDecl);
WriteDescr(ConstDecl);
end;
end;
end;
procedure TIPFWriter.WriteEnumElements(TypeDecl : TPasEnumType);
Var
EV : TPasEnumValue;
I : Integer;
DocNode : TDocNode;
begin
With TypeDecl do
begin
SortElementList(Values);
DescrBeginTable(2,True);
DescrBeginTableCaption;
Writeln(EscapeTex(Format(SDocValuesForEnum,[TypeDecl.Name])));
DescrEndTableCaption;
DescrBeginTableHeadRow;
DescrBeginTableCell;
Writeln(EscapeTex(SDocValue));
DescrEndTableCell;
DescrBeginTableCell;
Writeln(EscapeTex(SDocExplanation));
DescrEndTableCell;
DescrEndTableHeadRow;
For I:=0 to Values.Count-1 do
begin
EV:=TPasEnumValue(Values[i]);
DescrBeginTableRow;
DescrBeginTableCell;
Writeln(EscapeTex(EV.Name));
DescrEndTableCell;
DescrBeginTableCell;
DocNode := Engine.FindDocNode(EV);
if Assigned(DocNode) and (not IsDescrNodeEmpty(DocNode.ShortDescr)) then
WriteDescr(EV,DocNode.ShortDescr);
DescrEndTableCell;
DescrEndTableRow;
end;
DescrEndTable;
end;
end;
procedure TIPFWriter.WriteTypes(ASection: TPasSection);
var
i: Integer;
TypeDecl: TPasType;
begin
if ASection.Types.Count > 0 then
begin
StartSubSection(SDocTypes,ModuleName+'Types');
for i := 0 to ASection.Types.Count - 1 do
begin
TypeDecl := TPasType(ASection.Types[i]);
WriteLn(':h4 name='+GetLabel(TypeDecl)+'.');
// WriteLn(':hdref refid='+GetLabel(TypeDecl)+'.');
// WriteLabel(TypeDecl);
// WriteIndex(TypeDecl);
StartListing(False);
Writeln(EscapeTex(TypeDecl.GetDeclaration(True)));
EndListing;
If TypeDecl is TPasEnumType then
begin
WriteENumElements(TypeDecl as TPasEnumType);
end;
WriteDescr(TypeDecl);
end;
end;
end;
procedure TIPFWriter.WriteVars(ASection: TPasSection);
var
VarDecl: TPasVariable;
i: Integer;
begin
if ASection.Variables.Count > 0 then
begin
StartSubsection(SDocVariables,ModuleName+'Variables');
for i := 0 to ASection.Variables.Count - 1 do
begin
// WriteIndex(VarDecl);
VarDecl := TPasVariable(ASection.Variables[i]);
WriteLn(':h4 name='+GetLabel(VarDecl)+'.');
StartListing(False);
WriteLn(EscapeTex(VarDecl.GetDeclaration(True)));
EndListing;
WriteDescr(VarDecl);
end;
end;
end;
procedure TIPFWriter.WriteVarsConstsTypes(ASection: TPasSection);
begin
With Asection do
if (Consts.Count > 0) or
(Types.Count > 0) or
(Variables.Count > 0) or
(ResStrings.Count>0) then
begin
StartSection(SDocConstsTypesVars, ModuleName+'ConstsTypesVars');
WriteResourceStrings(ASection);
WriteConsts(ASection);
WriteTypes(ASection);
WriteVars(ASection);
end;
end;
procedure TIPFWriter.WriteProcedure(ProcDecl : TPasProcedureBase);
var
DocNode: TDocNode;
OP : TPasOverloadedProc;
i : integer;
begin
With ProcDecl do
begin
if Not (Assigned(Parent) and Parent.InheritsFrom(TPasClassType)) then
begin
StartSubSection(Name, GetLabel(ProcDecl));
// WriteLabel(ProcDecl);
// WriteIndex(ProcDecl);
end
else
begin // Parent assigned and hence method.
StartSubSection(Parent.Name+'&per.'+Name, GetLabel(ProcDecl));
// WriteLabel(ProcDecl);
// WriteIndex(Parent.Name+'.'+Name);
end;
// Writeln('\begin{FPCList}');
DocNode := Engine.FindDocNode(ProcDecl);
if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
begin
Writeln(':hp2.Synopsis:ehp2.&colon. ');
WriteDescr(ProcDecl, DocNode.ShortDescr);
WriteLn('');
WriteLn('.br');
end;
Writeln(':hp2.Declaration:ehp2.&colon. ');
StartListing(False);
if ClassType = TPasOverloadedProc then
begin
OP:=TPasOverloadedProc(ProcDecl);
for i := 0 to OP.Overloads.Count - 1 do
begin
WriteLn(TPasProcedure(OP.Overloads[i]).GetDeclaration(True));
end;
end
else
WriteLn(GetDeclaration(True));
EndListing;
WriteLn('');
WriteLn('.br');
If Assigned(Parent) then
begin
Writeln(':hp2.Visibility:ehp2.&colon. ');
Writeln(VisibilityNames[Visibility]);
WriteLn('');
WriteLn('.br');
end;
if Assigned(DocNode) and Assigned(DocNode.Descr) then
begin
Writeln(':hp2.Description:ehp2.&colon. ');
WriteDescr(ProcDecl);
WriteLn('');
WriteLn('.br');
end;
if Assigned(DocNode) and Assigned(DocNode.ErrorsDoc) then
begin
Writeln(':hp2.Errors:ehp2.&colon.');
WriteDescr(ProcDecl, DocNode.ErrorsDoc);
WriteLn('');
WriteLn('.br');
end;
WriteSeeAlso(DocNode);
WriteLn('');
WriteLn('.br');
// Writeln('\end{FPCList}');
WriteExample(DocNode);
end;
end;
procedure TIPFWriter.WriteFunctionsAndProcedures(ASection: TPasSection);
var
i: Integer;
begin
if ASection.Functions.Count > 0 then
begin
StartSection(SDocProceduresAndFunctions,ModuleName+'Functions');
for i := 0 to ASection.Functions.Count - 1 do
WriteProcedure(TPasProcedureBase(ASection.Functions[i]));
end;
end;
procedure TIPFWriter.WriteExample(ADocNode: TDocNode);
var
Example: TDOMElement;
begin
if Assigned(ADocNode) then
begin
Example := ADocNode.FirstExample;
while Assigned(Example) do
begin
WritelnF(':xmp.%s:exmp.', [EscapeTex(Engine.GetExampleFileName(Example))]);
if Assigned(Example.NextSibling) then
WriteLn('');
Example := TDomElement(Example.NextSibling);
end;
end;
end;
procedure TIPFWriter.WriteSeeAlso(ADocNode: TDocNode);
var
Node: TDOMNode;
s: String;
begin
if Assigned(ADocNode) and Assigned(ADocNode.SeeAlso) and
Assigned(ADocNode.SeeAlso.FirstChild) then
begin
Writeln(':hp2.SeeAlso:ehp2.');
Node := ADocNode.SeeAlso.FirstChild;
while Assigned(Node) do
begin
if (Node.NodeType = ELEMENT_NODE) and
(Node.NodeName = 'link') then
begin
S:=TDomElement(Node)['id'];
DescrBeginLink(S);
Writeln(S);
DescrEndLink();
if Assigned(Node.NextSibling) Then
Writeln(',');
end;
Node:=Node.NextSibling;
end;
end;
end;
procedure TIPFWriter.WriteClasses(ASection: TPasSection);
var
i: Integer;
begin
if (ASection.Classes.Count > 0) then
begin
for i := 0 to ASection.Classes.Count - 1 do
WriteClassDecl(TPasClassType(ASection.Classes[i]));
end;
end;
procedure TIPFWriter.ProcessSection(ASection: TPasSection);
begin
With ASection do
begin
SortElementList(UsesList);
SortElementList(Declarations);
SortElementList(ResStrings);
SortElementList(Types);
SortElementList(Consts);
SortElementList(Classes);
SortElementList(Functions);
SortElementList(Variables);
end;
WriteUnitOverView(ASection);
WriteVarsConstsTypes(ASection);
WriteFunctionsAndProcedures(ASection);
WriteClasses(ASection);
end;
Function TIPFWriter.ShowMember(M : TPasElement) : boolean;
begin
Result:=not ((M.Visibility=visPrivate) and Engine.HidePrivate);
If Result then
Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
end;
procedure TIPFWriter.WriteClassMethodOverview(ClassDecl : TPasClassType);
var
Member: TPasElement;
i: Integer;
DocNode: TDocNode;
List : TStringList;
begin
List:=TStringList.Create;
Try
List.Sorted:=True;
for i := 0 to ClassDecl.Members.Count - 1 do
begin
Member := TPasElement(ClassDecl.Members[i]);
With Member do
if InheritsFrom(TPasProcedureBase) and ShowMember(Member) then
List.AddObject(Member.Name,Member);
end;
If List.Count>0 then
begin
StartSubSection(SDocMethodOverview, GetLabel(ClassDecl) + ':Methods');
// WriteLabel();
WriteLn(':parml.');
// WriteLnF('%s & %s & %s \\ \hline', [EscapeTex(SDocPage), EscapeTex(SDocMethod), EscapeTex(SDocDescription)]);
For I:=0 to List.Count-1 do
begin
Member:=TPasElement(List.Objects[i]);
DocNode := Engine.FindDocNode(Member);
WriteF(':pt.:link reftype=hd refid=%s.%s:elink.:pd.',[StripTex(GetLabel(Member)), EscapeTex(Member.Name)]);
if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
WriteDescr(Member, DocNode.ShortDescr);
WriteLn('');
WriteLn('.br');
end;
WriteLn(':eparml.');
// WriteLn('\end{tabularx}');
end;
Finally
List.Free;
end;
end;
procedure TIPFWriter.WriteClassPropertyOverview(ClassDecl : TPasClassType);
var
Member: TPasElement;
i: Integer;
s: String;
DocNode: TDocNode;
List : TStringList;
begin
// Write property overview
List:=TStringList.Create;
Try
List.Sorted:=True;
for i := 0 to ClassDecl.Members.Count - 1 do
begin
Member := TPasElement(ClassDecl.Members[i]);
With Member do
if InheritsFrom(TPasProperty) and SHowMember(Member) then
List.AddObject(Member.Name,Member)
end;
If (List.Count>0) then
begin
StartSubSection(SDocPropertyOverview, GetLabel(ClassDecl) + ':Properties');
// WriteLabel(GetLabel(ClassDecl) + ':Properties');
WriteLn(':parml.');
// WriteLn('\begin{tabularx}{\textwidth}{lllX}');
// WriteLnF('%s & %s & %s & %s \\ \hline',
// [EscapeTex(SDocPage), EscapeTex(SDocProperty), EscapeTex(SDocAccess), EscapeTex(SDocDescription)]);
For I:=0 to List.Count-1 do
begin
Member:=TPasElement(List.objects[i]);
WriteF(':pt.:link reftype=hd refid=%s.%s:elink.:pd.',[StripTex(GetLabel(Member)), EscapeTex(Member.Name)]);
setlength(S,0);
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';
// Write(s + ' & ');
DocNode := Engine.FindDocNode(Member);
if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
WriteDescr(Member, DocNode.ShortDescr);
WriteLn('');
WriteLn('.br');
end;
WriteLn(':eparml.');
end;
Finally
List.Free;
end;
end;
procedure TIPFWriter.WriteClassDecl(ClassDecl: TPasClassType);
var
DocNode: TDocNode;
Vis: TPasMemberVisibilities;
Member: TPasElement;
i: Integer;
begin
StartSection(ClassDecl.Name, GetLabel(ClassDecl));
// WriteLabel(ClassDecl);
// WriteIndex(ClassDecl);
DocNode := Engine.FindDocNode(ClassDecl);
if Assigned(DocNode) and ((not IsDescrNodeEmpty(DocNode.Descr)) or
(not IsDescrNodeEmpty(DocNode.ShortDescr))) then
begin
// StartSubSection(SDocDescription, GetLabel(ClassDecl) + ':Description');
WriteDescr(ClassDecl);
end;
// Write method overview
WriteClassMethodOverView(ClassDecl);
// Write Property Overview;
WriteClassPropertyOverView(ClassDecl);
// Write method & property descriptions
// Determine visibilities
Vis := AllVisibilities;
if Engine.HidePrivate then
Exclude(Vis,visPrivate);
if Engine.HideProtected then
Exclude(Vis,visProtected);
for i := 0 to ClassDecl.Members.Count - 1 do
begin
Member := TPasElement(ClassDecl.Members[i]);
if ((Member.InheritsFrom(TPasProcedureBase)) and
(Member.Visibility in Vis)) then
WriteProcedure(TPasProcedureBase(Member));
end;
// properties.
for i := 0 to ClassDecl.Members.Count - 1 do
begin
Member := TPasElement(ClassDecl.Members[i]);
if ((Member.InheritsFrom(TPasProperty)) and
(Member.Visibility in Vis)) then
WriteProperty(TPasProperty(Member));
end;
end;
procedure TIPFWriter.WriteProperty(PropDecl : TPasProperty);
var
DocNode: TDocNode;
S: String;
begin
With PropDecl do
begin
StartSubSection(Parent.Name+'&per.'+Name, GetLabel(PropDecl));
// WriteLabel(PropDecl);
// WriteIndex(Parent.Name+'.'+Name);
// Writeln('\begin{FPCList}');
DocNode := Engine.FindDocNode(PropDecl);
if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
begin
Writeln(':hp2.Synopsis:ehp2.&colon. ');
WriteDescr(PropDecl, DocNode.ShortDescr);
WriteLn('');
WriteLn('.br');
end;
Writeln(':hp2.Declaration:ehp2.&colon. ');
StartListing(False);
WriteLn('Property '+GetDeclaration(True));
EndListing;
WriteLn('');
WriteLn('.br');
If Assigned(Parent) then
begin
Writeln(':hp2.Visibility:ehp2.&colon. ');
Writeln(VisibilityNames[Visibility]);
WriteLn('');
WriteLn('.br');
end;
Writeln(':hp2.Access:ehp2.&colon.');
Setlength(S,0);
If Length(ReadAccessorName) > 0 then
S:='Read';
if Length(WriteAccessorName) > 0 then
begin
If S<>'' then
S:=S+',';
S:=S+'Write';
end;
Writeln(S);
WriteLn('');
WriteLn('.br');
if Assigned(DocNode) and Assigned(DocNode.Descr) then
begin
Writeln(':hp2.Description:ehp2.&colon.');
WriteDescr(PropDecl);
WriteLn('');
WriteLn('.br');
end;
if Assigned(DocNode) and Assigned(DocNode.ErrorsDoc) then
begin
Writeln(':hp2.Errors:ehp2.&colon. ');
WriteDescr(PropDecl, DocNode.ErrorsDoc);
WriteLn('');
WriteLn('.br');
end;
WriteSeeAlso(DocNode);
WriteLn('');
WriteLn('.br');
// Writeln('\end{FPCList}');
WriteExample(DocNode);
end;
end;
Function CompareElements(P1,P2 : Pointer) : Integer;
begin
Result:=CompareText(TPasElement(P1).Name,TPasElement(P2).Name);
end;
procedure TIPFWriter.SortElementList(List : TList);
begin
List.Sort(@CompareElements)
end;
procedure TIPFWriter.WriteLabel(El: TPasElement);
begin
WriteLabel(GetLabel(El));
end;
procedure TIPFWriter.WriteLabel(const s: String);
var
x: String;
begin
X:=s;
While pos(':',x)>0 do x[pos(':',x)]:='_';
WriteF('%s', [LowerCase(StripTex(x))]);
end;
procedure TIPFWriter.WriteIndex(El : TPasElement);
begin
WriteIndex(El.Name);
end;
procedure TIPFWriter.WriteIndex(const s : String);
begin
// Write('\index{');
// Write(EscapeTex(s));
// Writeln('}');
end;
procedure TIPFWriter.StartListing(Frames: Boolean; const name: String);
begin
Writeln(':xmp.')
end;
procedure TIPFWriter.StartListing(Frames : Boolean);
begin
StartListing(Frames,'');
end;
procedure TIPFWriter.EndListing;
begin
Writeln(':exmp.')
end;
procedure TIPFWriter.WriteCommentLine;
const
CommentLine =
'.* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%';
begin
WriteLn('');
Writeln(CommentLine);
end;
procedure TIPFWriter.WriteComment(Comment : String);
begin
// Write('.* ');
// Writeln(Comment);
end;
procedure TIPFWriter.StartSection(SectionName : String; SectionLabel : String);
begin
// StartSection(SectionName);
WriteCommentLine;
WriteComment(SectionName);
Write(':h2 name=');
WriteLabel(SectionLabel);
WriteLn('.'+EscapeTex(SectionName));
end;
//procedure TIPFWriter.StartSection(SectionName : String);
//begin
//end;
procedure TIPFWriter.StartSubSection(SubSectionName : String; SubSectionLabel : String);
begin
Writeln('');
WriteComment(SubsectionName);
Write(':h3 name=');
WriteLabel(SubsectionLabel);
WriteLn('.'+{EscapeTex(}SubSectionName{)});
end;
//procedure TIPFWriter.StartSubSection(SubSectionName : String);
//begin
//end;
procedure TIPFWriter.StartChapter(ChapterName : String; ChapterLabel : String);
begin
StartChapter(ChapterName);
WriteLabel(ChapterLabel);
end;
procedure TIPFWriter.StartChapter(ChapterName : String);
begin
Writeln('');
WriteCommentLine;
WriteComment(ChapterName);
WriteCommentLine;
Writeln(':h1.'+{EscapeTex(}ChapterName{)});
end;
initialization
// Do not localize.
RegisterWriter(TIPFWriter,'ipf','IPF output.');
finalization
UnRegisterWriter('ipf');
end.