1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389 |
- {
- FPDoc - Free Pascal Documentation Tool
- Copyright (C) 2000 - 2005 by
- Areca Systems GmbH / Sebastian Guenther, [email protected]
- * HTML/XHTML output generator
- See the file COPYING, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- }
- {$mode objfpc}
- {$H+}
- unit dw_html;
- {$WARN 5024 off : Parameter "$1" not used}
- interface
- uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter, dw_basehtml;
- type
- { THTMLWriter }
- THTMLWriter = class(TBaseHTMLWriter)
- private
- FHeadElement: TDomElement;
- FOnTest: TNotifyEvent;
- FCSSFile: String;
- FCharSet : String;
- FHeaderHTML,
- FNavigatorHTML,
- FFooterHTML: TStringStream;
- FTitleElement: TDOMElement;
- FIncludeDateInFooter : Boolean;
- FUseMenuBrackets: Boolean;
- FDateFormat: String;
- FIndexColCount : Integer;
- FSearchPage : String;
- procedure CreateMinusImage;
- procedure CreatePlusImage;
- procedure SetOnTest(const AValue: TNotifyEvent);
- protected
- function CreateAllocator : TFileAllocator; override;
- procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); override;
- procedure CreateCSSFile; virtual;
- procedure AppendTitle(const AText: String; Hints : TPasMemberHints = []); virtual;
- procedure AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []); virtual;
- function AppendType(CodeEl, TableEl: TDOMElement;
- Element: TPasType; Expanded: Boolean;
- NestingLevel: Integer = 0): TDOMElement; virtual;
- function AppendProcType(CodeEl, TableEl: TDOMElement; Element: TPasProcedureType; Indent: Integer): TDOMElement; virtual;
- procedure AppendProcExt(CodeEl: TDOMElement; Element: TPasProcedure); virtual;
- procedure AppendProcDecl(CodeEl, TableEl: TDOMElement; Element: TPasProcedureBase); virtual;
- procedure AppendProcArgsSection(Parent: TDOMNode; Element: TPasProcedureType; SkipResult : Boolean = False); virtual;
- function AppendRecordType(CodeEl, TableEl: TDOMElement; Element: TPasRecordType; NestingLevel: Integer): TDOMElement; virtual;
- procedure CreateMemberDeclarations(AParent: TPasElement; Members: TFPList; TableEl: TDOmelement; AddEnd: Boolean); virtual;
- procedure AppendMenuBar(ASubpageIndex: Integer);virtual;
- procedure AppendTopicMenuBar(Topic : TTopicElement);virtual;
- 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;
- procedure CreateClassSortedSubpage(AClass: TPasClassType; AFilter: TMemberFilter);virtual;
- procedure CreateIndexPage(L : TStringList); virtual;
- procedure CreateModuleIndexPage(AModule: TPasModule); virtual;
- // Package
- procedure CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer); virtual;
- procedure CreatePackagePageBody;virtual;
- procedure CreatePackageIndex;
- procedure CreatePackageClassHierarchy;
- procedure CreateClassHierarchyPage(AddUnit : Boolean);
- // Topic
- Procedure CreateTopicPageBody(AElement : TTopicElement);
- // Module
- procedure CreateModuleMainPage(aModule: TPasModule);virtual;
- procedure CreateModuleSimpleSubpage(aModule: TPasModule; ASubpageIndex: Integer; const ATitle: DOMString; AList: TFPList);virtual;
- procedure CreateModuleResStringsPage(aModule: TPasModule);virtual;
- procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
- // Identifiers
- procedure CreateConstPageBody(AConst: TPasConst);
- procedure CreateTypePageBody(AType: TPasType);
- procedure CreateClassPageBody(AClass: TPasClassType; ASubpageIndex: Integer);
- procedure CreateClassMemberPageBody(AElement: TPasElement);
- procedure CreateVarPageBody(AVar: TPasVariable);
- 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;
- Property CSSFile : String Read FCSSFile;
- Property HeadElement : TDomElement Read FHeadElement;
- Property TitleElement: TDOMElement Read FTitleElement;
- public
- // Creating all module hierarchy classes happens here !
- constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
- // Overrides
- Class Function FileNameExtension : String; override;
- class procedure Usage(List: TStrings); override;
- Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
- Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
- // Single-page generation
- function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; virtual;
- Property SearchPage: String Read FSearchPage Write FSearchPage;
- Property IncludeDateInFooter : Boolean Read FIncludeDateInFooter Write FIncludeDateInFooter;
- Property DateFormat : String Read FDateFormat Write FDateFormat;
- property OnTest: TNotifyEvent read FOnTest write SetOnTest;
- Property CharSet : String Read FCharSet Write FCharSet;
- Property IndexColCount : Integer Read FIndexColCount write FIndexColCount;
- Property UseMenuBrackets : Boolean Read FUseMenuBrackets write FUseMenuBrackets;
- end;
- implementation
- uses fpdocstrs, SysUtils, HTMWrite, fpdocclasstree;
- {$i css.inc}
- {$i plusimage.inc}
- {$i minusimage.inc}
- constructor THTMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
- begin
- inherited Create(APackage, AEngine);
- // should default to true since this is the old behavior
- UseMenuBrackets:=True;
- IndexColCount:=3;
- Charset:='iso-8859-1';
- end;
- function THTMLWriter.CreateHTMLPage(AElement: TPasElement;
- ASubpageIndex: Integer): TXMLDocument;
- var
- HTMLEl: THTMLHtmlElement;
- HeadEl: THTMLHeadElement;
- BodyElement : THTMLElement;
- El: TDOMElement;
- begin
- Result := THTMLDocument.Create;
- SetHTMLDocument(THTMLDocument(Result));
- Doc.AppendChild(Doc.Impl.CreateDocumentType(
- 'HTML', '-//W3C//DTD HTML 4.01 Transitional//EN',
- 'http://www.w3.org/TR/html4/loose.dtd'));
- HTMLEl := Doc.CreateHtmlElement;
- Doc.AppendChild(HTMLEl);
- HeadEl := Doc.CreateHeadElement;
- FHeadElement:=HeadEl;
- HTMLEl.AppendChild(HeadEl);
- El := Doc.CreateElement('meta');
- HeadEl.AppendChild(El);
- El['http-equiv'] := 'Content-Type';
-
- El['content'] := 'text/html; charset=utf-8';
- FTitleElement := Doc.CreateElement('title');
- HeadEl.AppendChild(TitleElement);
- El := Doc.CreateElement('link');
- BodyElement := Doc.CreateElement('body');
- ContentElement:=BodyElement;
- HTMLEl.AppendChild(BodyElement);
- CreatePageBody(AElement, ASubpageIndex);
- AppendFooter;
- HeadEl.AppendChild(El);
- El['rel'] := 'stylesheet';
- El['type'] := 'text/css';
- El['href'] := UTF8Decode(FixHtmlPath(UTF8Encode(Allocator.GetCSSFilename(AElement))));
- end;
- procedure THTMLWriter.WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer);
- Var
- PageDoc: TXMLDocument;
- FN : String;
- begin
- PageDoc := CreateHTMLPage(aElement, aSubpageIndex);
- try
- FN:=GetFileBaseDir(Engine.Output)+aFilename;
- //writeln('Element: ',Element.PathName, ' FileName: ', FN);
- WriteHTMLFile(PageDoc, FN);
- except
- on E: Exception do
- DoLog(SErrCouldNotCreateFile, [aFileName, e.Message]);
- end;
- PageDoc.Free;
- end;
- procedure THTMLWriter.DoWriteDocumentation;
- begin
- Inherited;
- CreateCSSFile;
- CreatePlusImage;
- CreateMinusImage;
- end;
- procedure THTMLWriter.CreatePlusImage;
- Var
- TempStream: TMemoryStream;
- begin
- TempStream := TMemoryStream.Create;
- try
- DoLog('Creating plus image',[]);
- TempStream.WriteBuffer(PlusImageData,SizeOf(PlusImageData));
- TempStream.Position := 0;
- TempStream.SaveToFile(Engine.output+'plus.png');
- finally
- TempStream.Free;
- end;
- end;
- procedure THTMLWriter.CreateMinusImage;
- Var
- TempStream: TMemoryStream;
- begin
- TempStream := TMemoryStream.Create;
- try
- DoLog('Creating minus image',[]);
- TempStream.WriteBuffer(MinusImageData,SizeOf(MinusImageData));
- TempStream.Position := 0;
- TempStream.SaveToFile(Engine.output+'minus.png');
- finally
- TempStream.Free;
- end;
- end;
- procedure THTMLWriter.CreateCSSFile;
- Var
- TempStream: TMemoryStream;
- begin
- TempStream := TMemoryStream.Create;
- try
- if (FCSSFile<>'') then
- begin
- if not FileExists(FCSSFile) then
- begin
- DoLog('Can''t find CSS file "%s"',[FCSSFILE]);
- halt(1);
- end;
- TempStream.LoadFromFile(FCSSFile);
- end
- else
- begin
- DoLog('Using built-in CSS file',[]);
- TempStream.WriteBuffer(DefaultCSS,SizeOf(DefaultCSS));
- end;
- TempStream.Position := 0;
- TempStream.SaveToFile(Engine.output+'fpdoc.css');
- finally
- TempStream.Free;
- end;
- end;
- { Returns the new CodeEl, which will be the old CodeEl in most cases }
- function THTMLWriter.AppendType(CodeEl, TableEl: TDOMElement; Element: TPasType; Expanded: Boolean; NestingLevel: Integer): TDOMElement;
- Var
- S : String;
- begin
- Result := CodeEl;
- if not Assigned(Element) then
- AppendText(CreateWarning(CodeEl), '<NIL>')
- else if (not Expanded) and (Length(Element.Name) > 0) then
- AppendHyperlink(CodeEl, Element)
- else
- // Array
- if Element.ClassType = TPasArrayType then
- begin
- S:='array ';
- If (TPasArrayType(Element).IndexRange<>'') then
- S:=S+'[' + TPasArrayType(Element).IndexRange + '] ';
- S:=S+'of ';
- If (TPasArrayType(Element).ElType=Nil) then
- S:=S+'Const';
- AppendPasSHFragment(CodeEl,S,0);
- If (TPasArrayType(Element).ElType<>Nil) then
- Result := AppendType(CodeEl, TableEl, TPasArrayType(Element).ElType, False);
- end else
- // Procedure or funtion type
- if Element.InheritsFrom(TPasProcedureType) then
- begin
- AppendKw(CodeEl, TPasProcedureType(Element).TypeName);
- Result := AppendProcType(CodeEl, TableEl, TPasProcedureType(Element), 0)
- end else
- // Range type
- if Element.InheritsFrom(TPasRangeType) then
- AppendPasSHFragment(CodeEl, TPasRangeType(Element).RangeStart + '..' +
- TPasRangeType(Element).RangeEnd, 0)
- // Record type
- else if Element.ClassType = TPasRecordType then
- Result := AppendRecordType(CodeEl, TableEl, TPasRecordType(Element), NestingLevel)
- else if (Element.ClassType = TPasFileType) and (TPasFileType(Element).elType=Nil) then
- AppendPasSHFragment(CodeEl,'file',0)
- else
- // Other types
- AppendHyperlink(CodeEl, Element);
- end;
- function THTMLWriter.AppendProcType(CodeEl, TableEl: TDOMElement;
- Element: TPasProcedureType; Indent: Integer): TDOMElement;
- function CreateIndentedCodeEl(Indent: Integer): TDOMElement;
- begin
- Result := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- AppendNbSp(Result, Indent);
- end;
- var
- i: Integer;
- Arg: TPasArgument;
- S : String;
- begin
- if Element.Args.Count > 0 then
- begin
- AppendSym(CodeEl, '(');
- for i := 0 to Element.Args.Count - 1 do
- begin
- Arg := TPasArgument(Element.Args[i]);
- CodeEl := CreateIndentedCodeEl(Indent + 2);
- S:=AccessNames[Arg.Access];
- if (S<>'') then
- AppendKw(CodeEl,S);
- AppendText(CodeEl, Arg.Name);
- if Assigned(Arg.ArgType) then
- begin
- AppendSym(CodeEl, ': ');
- CodeEl := AppendType(CodeEl, TableEl, Arg.ArgType, False);
- end;
- if Length(Arg.Value) > 0 then
- AppendPasSHFragment(CodeEl, ' = ' + Arg.Value, 0);
- if i < Element.Args.Count - 1 then
- AppendSym(CodeEl, ';');
- end;
- if Element.InheritsFrom(TPasFunctionType) or Element.IsOfObject then
- begin
- CodeEl := CreateIndentedCodeEl(Indent);
- if Element.InheritsFrom(TPasFunctionType) then
- begin
- AppendSym(CodeEl, '):');
- AppendHyperlink(CodeEl, TPasFunctionType(Element).ResultEl.ResultType);
- end else
- AppendSym(CodeEl, ')');
- if Element.IsOfObject then
- begin
- AppendText(CodeEl, ' '); // Don't remove
- AppendKw(CodeEl, 'of object');
- end;
- end else
- if Indent > 0 then
- AppendSym(CodeEl, ')')
- else
- begin
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- AppendSym(CodeEl, ')');
- end;
- end
- else
- begin
- { Procedure or function without arguments }
- if Element.InheritsFrom(TPasFunctionType) then
- begin
- AppendSym(CodeEl, ': ');
- AppendHyperlink(CodeEl, TPasFunctionType(Element).ResultEl.ResultType);
- end;
- if Element.IsOfObject then
- AppendKw(CodeEl, ' of object');
- end;
- Result := CodeEl;
- end;
- procedure THTMLWriter.AppendProcExt(CodeEl: TDOMElement;
- Element: TPasProcedure);
- procedure AppendExt(const Ext: String);
- begin
- AppendKw(CodeEl, ' ' + Ext);
- AppendSym(CodeEl, ';');
- end;
- begin
- if Element.IsVirtual then
- AppendExt('virtual');
- if Element.IsDynamic then
- AppendExt('dynamic');
- if Element.IsAbstract then
- AppendExt('abstract');
- if Element.IsOverride then
- AppendExt('override');
- if Element.IsOverload then
- AppendExt('overload');
- if Element.IsMessage then
- AppendExt('message');
- end;
- { Used in two places:
- - Page for the method of a class
- - Page for a tandalone procedure or function. }
- procedure THTMLWriter.AppendProcDecl(CodeEl, TableEl: TDOMElement;
- Element: TPasProcedureBase);
- procedure WriteVariant(AProc: TPasProcedure; SkipResult : Boolean);
- begin
- AppendProcArgsSection(TableEl.ParentNode, AProc.ProcType, SkipResult);
- AppendKw(CodeEl, AProc.TypeName);
- if (Element.Parent.ClassType = TPasClassType) or (Element.Parent.ClassType = TPasRecordType) then
- begin
- AppendText(CodeEl, ' ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, AProc.Name);
- end else
- if (Element is TPasOperator) then
- AppendText(CodeEl, ' ' + TPasOperator(AProc).GetOperatorDeclaration(True))
- else
- AppendText(CodeEl, ' ' + AProc.FullName);
- CodeEl := AppendProcType(CodeEl, TableEl, AProc.ProcType, 0);
- AppendSym(CodeEl, ';');
- AppendProcExt(CodeEl, AProc);
- end;
- var
- i,fc: Integer;
- P : TPasProcedure;
- begin
- fc:=0;
- if Element.ClassType = TPasOverloadedProc then
- for i := 0 to TPasOverloadedProc(Element).Overloads.Count - 1 do
- begin
- P:=TPasProcedure(TPasOverloadedProc(Element).Overloads[i]);
- if (P.ProcType is TPasFunctionType) then
- Inc(fc);
- if i > 0 then
- begin
- CreateEl(CodeEl, 'br');
- CreateEl(CodeEl, 'br');
- end;
- WriteVariant(P,fc>1);
- end
- else
- WriteVariant(TPasProcedure(Element),False);
- end;
- procedure THTMLWriter.AppendProcArgsSection(Parent: TDOMNode;
- Element: TPasProcedureType; SkipResult : Boolean = False);
- var
- HasFullDescr, IsFirst: Boolean;
- ResultEl: TPasResultElement;
- ArgTableEl, TREl: TDOMElement;
- DocNode: TDocNode;
- i: Integer;
- Arg: TPasArgument;
- begin
- IsFirst := True;
- for i := 0 to Element.Args.Count - 1 do
- begin
- Arg := TPasArgument(Element.Args[i]);
- if IsDescrNodeEmpty(Engine.FindShortDescr(Arg)) then
- continue;
- if IsFirst then
- begin
- IsFirst := False;
- AppendText(CreateH2(Parent), SDocArguments);
- ArgTableEl := CreateTable(Parent);
- end;
- TREl := CreateTR(ArgTableEl);
- AppendText(CreateCode(CreatePara(CreateTD_vtop(TREl))), Arg.Name);
- AppendShortDescrCell(TREl, Arg);
- end;
- if (Element.ClassType = TPasFunctionType) and not SkipResult then
- begin
- ResultEl := TPasFunctionType(Element).ResultEl;
- DocNode := Engine.FindDocNode(ResultEl);
- HasFullDescr := Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr);
- if HasFullDescr or
- (Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.ShortDescr)) then
- begin
- AppendText(CreateH2(Parent), SDocFunctionResult);
- if HasFullDescr then
- AppendDescr(ResultEl, Parent, DocNode.Descr, True)
- else
- AppendDescr(ResultEl, CreatePara(Parent), DocNode.ShortDescr, False);
- end;
- end;
- end;
- function THTMLWriter.AppendRecordType(CodeEl, TableEl: TDOMElement;
- Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
- var
- i, j: Integer;
- Variable: TPasVariable;
- TREl: TDOMElement;
- CurVariant: TPasVariant;
- isExtended : Boolean;
- VariantEl: TPasElement;
- VariantType: TPasType;
- begin
- if not (Element.Parent is TPasVariant) then
- if Element.IsPacked then
- If Element.IsBitPacked then
- AppendKw(CodeEl, 'bitpacked record')
- else
- AppendKW(CodeEl, 'packed record')
- else
- AppendKw(CodeEl, 'record');
- isExtended:=False;
- I:=0;
- while (not isExtended) and (I<Element.Members.Count) do
- begin
- isExtended:=Not (TObject(Element.Members[i]) is TPasVariable);
- Inc(i);
- end;
- if isExtended then
- CreateMemberDeclarations(Element,Element.Members,TableEl,False)
- else
- for i := 0 to Element.Members.Count - 1 do
- begin
- Variable := TPasVariable(Element.Members[i]);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendShortDescrCell(TREl, Variable);
- AppendNbSp(CodeEl, NestingLevel * 2 + 2);
- AppendText(CodeEl, Variable.Name);
- AppendSym(CodeEl, ': ');
- CodeEl := AppendType(CodeEl, TableEl, Variable.VarType, False, NestingLevel + 1);
- AppendSym(CodeEl, ';');
- end;
- if Assigned(Element.VariantEl) then
- begin
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendNbSp(CodeEl, NestingLevel * 2 + 2);
- AppendKw(CodeEl, 'case ');
- VariantEl:=TPasRecordType(Element).VariantEl;
- if VariantEl is TPasVariable then
- begin
- AppendText(CodeEl, TPasVariable(VariantEl).Name);
- AppendSym(CodeEl, ': ');
- VariantType:=TPasVariable(VariantEl).VarType;
- end else
- VariantType:=VariantEl as TPasType;
- CodeEl := AppendType(CodeEl, TableEl, VariantType, True);
- AppendKw(CodeEl, ' of');
- for i := 0 to TPasRecordType(Element).Variants.Count - 1 do
- begin
- CurVariant := TPasVariant(Element.Variants[i]);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendNbSp(CodeEl, NestingLevel * 2 + 4);
- for j := 0 to CurVariant.Values.Count - 1 do
- begin
- if j > 0 then
- AppendSym(CodeEl, ', ');
- AppendPasSHFragment(CodeEl, TPasElement(CurVariant.Values[j]).GetDeclaration(true), 0);
- end;
- AppendSym(CodeEl, ': (');
- AppendType(CodeEl, TableEl, CurVariant.Members, True, NestingLevel + 3);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(CreateTR(TableEl))));
- AppendNbSp(CodeEl, NestingLevel * 2 + 6);
- AppendSym(CodeEl, ');');
- end;
- end;
- if not (Element.Parent is TPasVariant) then
- begin
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
- AppendNbSp(CodeEl, NestingLevel * 2);
- AppendKw(CodeEl, 'end');
- end;
- Result := CodeEl;
- end;
- procedure THTMLWriter.AppendTopicMenuBar(Topic : TTopicElement);
- var
- TableEl, TREl, ParaEl, TitleEl: TDOMElement;
- procedure AddLink(El : TPasElement; const AName: String);
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- AppendText(CreateLink(ParaEl, ResolveLinkWithinPackage(El,0)),AName);
- if FUseMenuBrackets then
- AppendText(ParaEl, ']');
- end;
- begin
- TableEl := CreateEl(ContentElement, 'table');
- TableEl['cellpadding'] := '4';
- TableEl['cellspacing'] := '0';
- TableEl['border'] := '0';
- TableEl['width'] := '100%';
- TableEl['class'] := 'bar';
- TREl := CreateTR(TableEl);
- ParaEl := CreateEl(CreateTD(TREl), 'b');
- If Assigned(Topic.Previous) then
- AddLink(Topic.Previous,SDocPrevious);
- If Assigned(Topic.Parent) then
- AddLink(Topic.Parent,SDocUp);
- if Assigned(Topic.Next) then
- AddLink(Topic.Next,SDocNext);
- if Length(SearchPage) > 0 then
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- AppendText(CreateLink(ParaEl, SearchPage), SDocSearch);
- if FUseMenuBrackets then
- AppendText(ParaEl, ']');
- end;
- ParaEl := CreateTD(TREl);
- ParaEl['align'] := 'right';
- TitleEl := CreateEl(ParaEl, 'span');
- TitleEl['class'] := 'bartitle';
- if Assigned(Module) then
- AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
- if Assigned(Package) then
- begin
- AppendText(TitleEl, ' (');
- AppendHyperlink(TitleEl, Package);
- AppendText(TitleEl, ')');
- end;
- end;
- function THTMLWriter.CreateAllocator: TFileAllocator;
- begin
- Result:=TLongNameFileAllocator.Create('.html');
- end;
- procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
- var
- TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement;
- procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- if ALinkSubpageIndex = ASubpageIndex then
- AppendText(ParaEl, AName)
- else
- AppendText(
- CreateLink(ParaEl, ResolveLinkWithinPackage(Module, ALinkSubpageIndex)),
- AName);
- if FUseMenuBrackets then
- AppendText(ParaEl, ']');
- end;
- procedure AddPackageLink(ALinkSubpageIndex: Integer; const AName: String);
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- if ALinkSubpageIndex = ASubpageIndex then
- AppendText(ParaEl, AName)
- else
- AppendText(
- CreateLink(ParaEl, ResolveLinkWithinPackage(Package, ALinkSubpageIndex)),
- AName);
- if FUseMenuBrackets then
- AppendText(ParaEl, ']');
- end;
- begin
- TableEl := CreateEl(ContentElement, 'table');
- TableEl['cellpadding'] := '4';
- TableEl['cellspacing'] := '0';
- TableEl['border'] := '0';
- TableEl['width'] := '100%';
- TableEl['class'] := 'bar';
- // Title Row
- TREl := CreateTR(TableEl);
- // Menu title
- ParaEl := CreateTD(TREl);
- ParaEl['align'] := 'left';
- TitleEl := CreateEl(ParaEl, 'span');
- TitleEl['class'] := 'bartitle';
- if Assigned(Module) then
- AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name]))
- else
- AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name]));
- // Package link title
- ParaEl := CreateTD(TREl);
- ParaEl['align'] := 'right';
- TitleEl := CreateEl(ParaEl, 'span');
- TitleEl['class'] := 'bartitle';
- if Assigned(Module) and Assigned(Package) then // Displays a Package page
- begin
- AppendText(TitleEl, SDocPackageLinkTitle);
- end;
- // Links Row
- TRE2 := CreateTR(TableEl);
- ParaEl := CreateTD(TRE2);
- ParaEl['align'] := 'left';
- ParaEl := CreateEl(ParaEl, 'span');
- ParaEl['class']:= 'bartitle';
- if Assigned(Module) then
- begin
- AddLink(0, SDocOverview);
- if Module.InterfaceSection.ResStrings.Count > 0 then
- AddLink(ResstrSubindex, SDocResStrings);
- if Module.InterfaceSection.Consts.Count > 0 then
- AddLink(ConstsSubindex, SDocConstants);
- if Module.InterfaceSection.Types.Count > 0 then
- AddLink(TypesSubindex, SDocTypes);
- if Module.InterfaceSection.Classes.Count > 0 then
- AddLink(ClassesSubindex, SDocClasses);
- if Module.InterfaceSection.Functions.Count > 0 then
- AddLink(ProcsSubindex, SDocProceduresAndFunctions);
- if Module.InterfaceSection.Variables.Count > 0 then
- AddLink(VarsSubindex, SDocVariables);
- AddLink(IndexSubIndex,SDocIdentifierIndex);
- AppendFragment(ParaEl, NavigatorHTML);
- end
- else
- begin
- // Overview
- AppendText(ParaEl, '[');
- AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview);
- AppendText(ParaEl, ']');
- //Index
- AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
- // Class TObject tree
- AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
- AppendFragment(ParaEl, NavigatorHTML)
- end;
- if Length(SearchPage) > 0 then
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- AppendText(CreateLink(ParaEl, SearchPage), SDocSearch);
- if FUseMenuBrackets then
- AppendText(ParaEl, ']');
- end;
- ParaEl := CreateTD(TRE2);
- ParaEl['align'] := 'right';
- ParaEl := CreateEl(ParaEl, 'span');
- ParaEl['class']:= 'bartitle';
- if Assigned(Module) and Assigned(Package) then // Displays a Package page
- begin
- AppendText(ParaEl, '[');
- AppendHyperlink(ParaEl, Package);
- AppendText(ParaEl, ']');
- end;
- AppendFragment(ContentElement,HeaderHTML);
- end;
- procedure THTMLWriter.AppendFooter;
- Var
- S : String;
- F : TDomElement;
- begin
- if Assigned(FooterHTML) then
- AppendFragment(ContentElement, FooterHTML)
- else if IncludeDateInFooter then
- begin
- CreateEl(ContentElement, 'hr');
- F:=CreateEl(ContentElement,'span');
- F['class']:='footer';
- If (FDateFormat='') then
- S:=DateToStr(Date)
- else
- S:=FormatDateTime(FDateFormat,Date);
- AppendText(F,Format(SDocDateGenerated,[S]));
- end;
- end;
- procedure THTMLWriter.FinishElementPage(AElement: TPasElement);
- var
- DocNode: TDocNode;
- begin
- DocNode := Engine.FindDocNode(AElement);
- If Not Assigned(DocNode) then
- exit;
- // Description
- if Assigned(DocNode.Descr) then
- AppendDescrSection(AElement, ContentElement, DocNode.Descr, UTF8Encode(SDocDescription));
- // Append "Errors" section
- if Assigned(DocNode.ErrorsDoc) then
- AppendDescrSection(AElement, ContentElement, DocNode.ErrorsDoc, UTF8Encode(SDocErrors));
- // Append Version info
- if Assigned(DocNode.Version) then
- AppendDescrSection(AElement, ContentElement, DocNode.Version, UTF8Encode(SDocVersion));
- // Append "See also" section
- AppendSeeAlsoSection(AElement,DocNode);
- // Append examples, if present
- AppendExampleSection(AElement,DocNode);
- // Append notes, if present
- ConvertNotes(AElement,DocNode.Notes);
- end;
- procedure THTMLWriter.CreateTopicPageBody(AElement: TTopicElement);
- var
- DocNode: TDocNode;
- begin
- AppendTopicMenuBar(AElement);
- DocNode:=AElement.TopicNode;
- if Assigned(DocNode) then // should always be true, but we're being careful.
- begin
- AppendShortDescr(AElement,TitleElement, DocNode);
- AppendShortDescr(AElement,CreateH2(ContentElement), DocNode);
- if Assigned(DocNode.Descr) then
- AppendDescrSection(AElement, ContentElement, DocNode.Descr, '');
- AppendSeeAlsoSection(AElement,DocNode);
- CreateTopicLinks(DocNode,AElement);
- AppendExampleSection(AElement,DocNode);
- ConvertNotes(AElement,DocNode.Notes);
- end;
- end;
- procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean);
- type
- TypeEN = (NPackage, NModule, NName);
- Procedure PushClassElement;
- Var
- H : THTMLElement;
- begin
- H:=CreateEl(CurOutputNode, 'li');
- H['class']:='classtree';
- PushOutputNode(H);
- H:=CreateEl(CurOutputNode, 'span');
- H['class']:='toggletreeclose';
- H['onclick']:='expandorcollapse(this)';
- PushOutputNode(h);
- AppendNbSp(h,1);
- PopOutputNode;
- end;
- Procedure PushClassList;
- Var
- H : THTMLElement;
- begin
- H:=CreateEl(CurOutputNode, 'ul');
- H['class']:='classtreelist';
- PushOutputNode(h);
- end;
- function ExtractName(APathName: String; Tp: TypeEN):String;
- var
- l:TStringList;
- begin
- Result:= Trim(APathName);
- if Result = '' then exit;
- l:=TStringList.Create;
- try
- l.AddDelimitedText(Result, '.', True);
- if l.Count=3 then
- Result:= l.Strings[Integer(Tp)]
- else
- Result:='';
- finally
- l.free;
- end;
- end;
- Procedure AppendClass(EN : TPasElementNode);
- Var
- PE,PM : TPasElement;
- I : Integer;
- begin
- if not Assigned(EN) then exit;
- PE:=EN.Element;
- PushClassElement;
- try
- if (PE<>Nil) then
- begin
- AppendHyperLink(CurOutputNode,PE);
- PM:=PE.GetModule();
- if (PM<>Nil) then
- begin
- AppendText(CurOutputNode,' (');
- AppendHyperLink(CurOutputNode,PM);
- AppendText(CurOutputNode,')');
- end
- end
- else
- AppendText(CurOutputNode,EN.Element.Name);
- if EN.ChildCount>0 then
- begin
- PushClassList;
- try
- For I:=0 to EN.ChildCount-1 do
- AppendClass(EN.Children[i] as TPasElementNode);
- finally
- PopOutputNode;
- end;
- end;
- Finally
- PopOutputNode;
- end;
- end;
- begin
- PushOutputNode(ContentElement);
- try
- PushClassList;
- AppendClass(TreeClass.RootNode);
- //PopOutputNode;
- finally
- PopOutputNode;
- end;
- end;
- procedure THTMLWriter.CreatePackageClassHierarchy;
- Const
- SFunc = 'function expandorcollapse (o) {'+sLineBreak+
- ' o.className = (o.className=="toggletreeclose") ? "toggletreeopen" : "toggletreeclose";'+sLineBreak+
- ' o.parentNode.className = (o.className=="toggletreeclose") ? "classtree" : "classtreeclosed";'+sLineBreak+
- ' return false;'+sLineBreak+
- '}';
- Var
- S : String;
- SE : THTMLElement;
- begin
- SE := Doc.CreateElement('script');
- AppendText(SE,SFunc);
- HeadElement.AppendChild(SE);
- AppendMenuBar(ClassHierarchySubIndex);
- S:=Package.Name;
- If Length(S)>0 then
- Delete(S,1,1);
- AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
- CreateClassHierarchyPage(True);
- end;
- procedure THTMLWriter.CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer);
- var
- i: Integer;
- Element: TPasElement;
- begin
- CurDirectory := Allocator.GetFilename(AElement, ASubpageIndex);
- i := Length(CurDirectory);
- while (i > 0) and not (CurDirectory[i] in AllowDirectorySeparators) do
- Dec(i);
- CurDirectory := Copy(CurDirectory, 1, i);
- BaseDirectory := Allocator.GetRelativePathToTop(AElement);
- if AElement.ClassType = TPasPackage then
- begin
- Module:=Nil;
- If (ASubPageIndex=0) then
- CreatePackagePageBody
- else if ASubPageIndex=IndexSubIndex then
- CreatePackageIndex
- else if ASubPageIndex=ClassHierarchySubIndex then
- CreatePackageClassHierarchy
- end
- else
- begin
- Element := AElement;
- while (Element<>Nil) and (not (Element.ClassType.inheritsfrom(TPasModule))) do
- Element := Element.Parent;
- Module := TPasModule(Element);
- if AElement.ClassType.inheritsfrom(TPasModule) then
- CreateModulePageBody(TPasModule(AElement), ASubpageIndex)
- else if AElement.Parent.InheritsFrom(TPasClassType) then
- CreateClassMemberPageBody(AElement)
- else if AElement.ClassType = TPasConst then
- CreateConstPageBody(TPasConst(AElement))
- else if AElement.InheritsFrom(TPasClassType) then
- CreateClassPageBody(TPasClassType(AElement), ASubpageIndex)
- else if AElement.InheritsFrom(TPasType) then
- CreateTypePageBody(TPasType(AElement))
- else if AElement.ClassType = TPasVariable then
- CreateVarPageBody(TPasVariable(AElement))
- else if AElement.InheritsFrom(TPasProcedureBase) then
- CreateProcPageBody(TPasProcedureBase(AElement))
- else if AElement.ClassType = TTopicELement then
- CreateTopicPageBody(TTopicElement(AElement))
- else if AElement.ClassType = TPasProperty then
- CreateClassMemberPageBody(TPasProperty(AElement))
- else
- writeln('Unknown classtype: ',AElement.classtype.classname);
- end;
- end;
- procedure THTMLWriter.CreateIndexPage(L : TStringList);
- Var
- Lists : Array['A'..'Z'] of TStringList;
- CL : TStringList;
- TableEl, TREl, EL: TDOMElement;
- E : TPasElement;
- I,Rows,J,Index : Integer;
- S : String;
- C : Char;
- begin
- For C:='A' to 'Z' do
- Lists[C]:=Nil;
- L.Sort;
- Cl:=Nil;
- // Divide over alphabet
- For I:=0 to L.Count-1 do
- begin
- S:=L[i];
- E:=TPasElement(L.Objects[i]);
- If not (E is TPasUnresolvedTypeRef) then
- begin
- If (S<>'') then
- begin
- C:=Upcase(S[1]);
- If C='_' then
- C:='A';
- If (C in ['A'..'Z']) and (Lists[C]=Nil) then
- begin
- CL:=TStringList.Create;
- Lists[C]:=CL;
- end;
- end;
- if assigned(cl) then
- CL.AddObject(S,E);
- end;
- end;
- Try
- // Create a quick jump table to all available letters.
- TableEl := CreateTable(ContentElement);
- TableEl['border']:='1';
- TableEl['width']:='50%';
- TREl := CreateTR(TableEl);
- for C:='A' to 'Z' do
- If (Lists[C]<>Nil) then
- begin
- El:=CreateTD_vtop(TREl);
- AppendText(CreateLink(El,UTF8Decode('#SECTION'+C)),UTF8Decode(C));
- If C<>'Z' then
- AppendNBsp(El,1);
- end;
- // Now emit all identifiers.
- TableEl:=Nil;
- For C:='A' to 'Z' do
- begin
- CL:=Lists[C];
- If CL<>Nil then
- begin
- El:=CreateH2(ContentElement);
- AppendText(El,UTF8Decode(C));
- CreateAnchor(El,UTF8Decode('SECTION'+C));
- TableEl := CreateTable(ContentElement);
- TableEl['Width']:='80%';
- // Determine number of rows needed
- Rows:=(CL.Count div IndexColCount);
- If ((CL.Count Mod IndexColCount)<>0) then
- Inc(Rows);
- // Fill rows
- For I:=0 to Rows-1 do
- begin
- TREl := CreateTR(TableEl);
- For J:=0 to IndexColCount-1 do
- begin
- El:=CreateTD_vtop(TREl);
- Index:=(J*Rows)+I;
- If (Index<CL.Count) then
- begin
- S:=CL[Index];
- E:=TPasElement(CL.Objects[Index]);
- AppendHyperlink(El,E);
- end;
- end;
- end;
- end; // have List
- end; // For C:=
- Finally
- for C:='A' to 'Z' do
- FreeAndNil(Lists[C]);
- end;
- end;
- procedure THTMLWriter.CreatePackageIndex;
- Var
- L : TStringList;
- I : Integer;
- M : TPasModule;
- S : String;
-
- begin
- L:=TStringList.Create;
- try
- L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
- For I:=0 to Package.Modules.Count-1 do
- begin
- M:=TPasModule(Package.Modules[i]);
- L.AddObject(M.Name,M);
- AddModuleIdentifiers(M,L);
- end;
- AppendMenuBar(IndexSubIndex);
- S:=Package.Name;
- If Length(S)>0 then
- Delete(S,1,1);
- AppendTitle(UTF8Decode(Format(SDocPackageIndex, [S])));
- CreateIndexPage(L);
- Finally
- L.Free;
- end;
- end;
- procedure THTMLWriter.CreatePackagePageBody;
- var
- DocNode: TDocNode;
- TableEl, TREl: TDOMElement;
- i: Integer;
- ThisModule: TPasModule;
- L : TStringList;
- begin
- AppendMenuBar(0);
- AppendTitle(UTF8Encode(Format(SDocPackageTitle, [Copy(Package.Name, 2, 256)])));
- AppendShortDescr(CreatePara(ContentElement), Package);
- AppendText(CreateH2(ContentElement), UTF8Encode(SDocUnits));
- TableEl := CreateTable(ContentElement);
- L:=TStringList.Create;
- Try
- L.Sorted:=True;
- // Sort modules.
- For I:=0 to Package.Modules.Count-1 do
- L.AddObject(TPasModule(Package.Modules[i]).Name,TPasModule(Package.Modules[i]));
- // Now create table.
- for i:=0 to L.Count - 1 do
- begin
- ThisModule := TPasModule(L.Objects[i]);
- TREl := CreateTR(TableEl);
- AppendHyperlink(CreateCode(CreatePara(CreateTD_vtop(TREl))), ThisModule);
- AppendShortDescrCell(TREl, ThisModule);
- end;
- Finally
- L.Free;
- end;
- DocNode := Engine.FindDocNode(Package);
- if Assigned(DocNode) then
- begin
- if Assigned(DocNode.Descr) then
- AppendDescrSection(nil, ContentElement, DocNode.Descr, UTF8Decode(SDocDescription));
- CreateTopicLinks(DocNode,Package);
- end;
- end;
- procedure THTMLWriter.CreateTopicLinks (Node: TDocNode; PasElement: TPasElement) ;
- var
- DocNode: TDocNode;
- TableEl, TREl: TDOMElement;
- First : Boolean;
- ThisTopic: TPasElement;
- begin
- DocNode:=Node.FirstChild;
- First:=True;
- While Assigned(DocNode) do
- begin
- If DocNode.TopicNode then
- begin
- if first then
- begin
- First:=False;
- AppendText(CreateH2(ContentElement), UTF8Decode(SDocRelatedTopics));
- TableEl := CreateTable(ContentElement);
- end;
- TREl := CreateTR(TableEl);
- ThisTopic:=FindTopicElement(DocNode);
- if Assigned(ThisTopic) then
- AppendHyperlink(CreateCode(CreatePara(CreateTD_vtop(TREl))), ThisTopic);
- AppendShortDescrCell(TREl, ThisTopic);
- end;
- DocNode:=DocNode.NextSibling;
- end;
- end;
- procedure THTMLWriter.CreateModuleIndexPage(AModule: TPasModule);
- Var
- L : TStringList;
- begin
- L:=TStringList.Create;
- try
- AddModuleIdentifiers(AModule,L);
- AppendMenuBar(IndexSubIndex);
- AppendTitle(UTF8Decode(Format(SDocModuleIndex, [AModule.Name])));
- CreateIndexPage(L);
- Finally
- L.Free;
- end;
- end;
- procedure THTMLWriter.CreateModuleMainPage(aModule : TPasModule);
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- i: Integer;
- UnitRef: TPasType;
- DocNode: TDocNode;
- begin
- AppendMenuBar(0);
- AppendTitle(UTF8Decode(Format(SDocUnitTitle, [AModule.Name])),AModule.Hints);
- AppendShortDescr(CreatePara(ContentElement), AModule);
- if AModule.InterfaceSection.UsesList.Count > 0 then
- begin
- TableEl := CreateTable(ContentElement);
- AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'uses');
- for i := 0 to AModule.InterfaceSection.UsesList.Count - 1 do
- begin
- UnitRef := TPasType(AModule.InterfaceSection.UsesList[i]);
- DocNode := Engine.FindDocNode(UnitRef);
- if Assigned(DocNode) and DocNode.IsSkipped then
- continue;
- TREl := CreateTR(TableEl);
- TDEl := CreateTD_vtop(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- AppendNbSp(CodeEl, 2);
- AppendHyperlink(CodeEl, UnitRef);
- if i < AModule.InterfaceSection.UsesList.Count - 1 then
- AppendSym(CodeEl, ',')
- else
- AppendSym(CodeEl, ';');
- AppendText(CodeEl, ' '); // Space for descriptions
- AppendShortDescrCell(TREl, UnitRef);
- end;
- end;
- DocNode := Engine.FindDocNode(AModule);
- if Assigned(DocNode) then
- begin
- if Assigned(DocNode.Descr) then
- AppendDescrSection(AModule, ContentElement, DocNode.Descr, UTF8Decode(SDocOverview));
- ConvertNotes(AModule,DocNode.Notes);
- CreateTopicLinks(DocNode,AModule);
- end;
- end;
- procedure THTMLWriter.CreateModuleSimpleSubpage(aModule: TPasModule; ASubpageIndex: Integer; const ATitle: DOMString; AList: TFPList);
- var
- TableEl, TREl, CodeEl: TDOMElement;
- i, j: Integer;
- Decl: TPasElement;
- SortedList: TFPList;
- DocNode: TDocNode;
- S : String;
- begin
- AppendMenuBar(ASubpageIndex);
- S:=UTF8Encode(ATitle);
- AppendTitle(UTF8Decode(Format(SDocUnitTitle + ': %s', [AModule.Name, S])));
- SortedList := TFPList.Create;
- try
- for i := 0 to AList.Count - 1 do
- begin
- Decl := TPasElement(AList[i]);
- DocNode := Engine.FindDocNode(Decl);
- if (not Assigned(DocNode)) or (not DocNode.IsSkipped) then
- begin
- j := 0;
- while (j < SortedList.Count) and (CompareText(
- TPasElement(SortedList[j]).PathName, Decl.PathName) < 0) do
- Inc(j);
- SortedList.Insert(j, Decl);
- end;
- end;
- TableEl := CreateTable(ContentElement);
- for i := 0 to SortedList.Count - 1 do
- begin
- Decl := TPasElement(SortedList[i]);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendHyperlink(CodeEl, Decl);
- AppendShortDescrCell(TREl, Decl);
- end;
- finally
- SortedList.Free;
- end;
- end;
- procedure THTMLWriter.CreateModuleResStringsPage(aModule : TPasModule);
- var
- ParaEl: TDOMElement;
- i: Integer;
- Decl: TPasResString;
- begin
- AppendMenuBar(ResstrSubindex);
- AppendTitle(UTF8Decode(Format(SDocUnitTitle + ': %s', [AModule.Name, SDocResStrings])));
- for i := 0 to AModule.InterfaceSection.ResStrings.Count - 1 do
- begin
- Decl := TPasResString(AModule.InterfaceSection.ResStrings[i]);
- CreateEl(ContentElement, 'a')['name'] := UTF8Decode(LowerCase(Decl.Name));
- ParaEl := CreatePara(ContentElement);
- AppendText(CreateCode(ParaEl), UTF8Decode(Decl.Name));
- CreateEl(ParaEl, 'br');
- AppendText(ParaEl, UTF8Decode(Decl.Expr.getDeclaration(true)));
- end;
- end;
- procedure THTMLWriter.CreateModulePageBody(AModule: TPasModule;
- ASubpageIndex: Integer);
- begin
- case ASubpageIndex of
- 0:
- CreateModuleMainPage(aModule);
- ResstrSubindex:
- CreateModuleResStringsPage(aModule);
- ConstsSubindex:
- CreateModuleSimpleSubpage(aModule, ConstsSubindex,UTF8Decode(SDocConstants), AModule.InterfaceSection.Consts);
- TypesSubindex:
- CreateModuleSimpleSubpage(aModule, TypesSubindex,UTF8Decode(SDocTypes), AModule.InterfaceSection.Types);
- ClassesSubindex:
- CreateModuleSimpleSubpage(aModule, ClassesSubindex,UTF8Decode(SDocClasses), AModule.InterfaceSection.Classes);
- ProcsSubindex:
- CreateModuleSimpleSubpage(aModule, ProcsSubindex, UTF8Decode(SDocProceduresAndFunctions), AModule.InterfaceSection.Functions);
- VarsSubindex:
- CreateModuleSimpleSubpage(aModule, VarsSubindex,UTF8Decode(SDocVariables), AModule.InterfaceSection.Variables);
- IndexSubIndex:
- CreateModuleIndexPage(AModule);
- end;
- end;
- procedure THTMLWriter.CreateConstPageBody(AConst: TPasConst);
- var
- TableEl, CodeEl: TDOMElement;
- begin
- AppendMenuBar(-1);
- AppendTitle(UTF8Decode(AConst.Name),AConst.Hints);
- AppendShortDescr(CreatePara(ContentElement), AConst);
- AppendText(CreateH2(ContentElement), UTF8Decode(SDocDeclaration));
- AppendSourceRef(ContentElement,AConst);
- TableEl := CreateTable(ContentElement);
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- AppendKw(CodeEl, 'const');
- AppendText(CodeEl, ' ' + UTF8Decode(AConst.Name));
- if Assigned(AConst.VarType) then
- begin
- AppendSym(CodeEl, ': ');
- AppendType(CodeEl, TableEl, AConst.VarType, False);
- end;
- AppendPasSHFragment(CodeEl, ' = ' + AConst.Expr.GetDeclaration(True) + ';', 0);
- FinishElementPage(AConst);
- end;
- procedure THTMLWriter.AppendTypeDecl(AType: TPasType; TableEl,CodeEl : TDomElement);
- Var
- TREl : TDomElement;
- i: Integer;
- s: String;
- EnumType: TPasEnumType;
- EnumValue: TPasEnumValue;
- begin
- // Alias
- if AType.ClassType = TPasAliasType then
- begin
- if Assigned(TPasAliasType(AType).DestType) then
- AppendHyperlink(CodeEl, TPasAliasType(AType).DestType)
- else
- AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
- AppendSym(CodeEl, ';');
- end else
- // Class of
- if AType.ClassType = TPasClassOfType then
- begin
- AppendKw(CodeEl, 'class of ');
- AppendHyperlink(CodeEl, TPasClassOfType(AType).DestType);
- AppendSym(CodeEl, ';');
- end else
- // Enumeration
- if AType.ClassType = TPasEnumType then
- begin
- AppendSym(CodeEl, '(');
- for i := 0 to TPasEnumType(AType).Values.Count - 1 do
- begin
- EnumValue := TPasEnumValue(TPasEnumType(AType).Values[i]);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendShortDescrCell(TREl, EnumValue);
- AppendNbSp(CodeEl, 2);
- s := EnumValue.Name;
- if EnumValue.AssignedValue<>'' then
- s := s + ' = ' + EnumValue.AssignedValue;
- if i < TPasEnumType(AType).Values.Count - 1 then
- s := s + ',';
- AppendPasSHFragment(CodeEl, s, 0);
- end;
- AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
- end else
- // Pointer type
- if AType.ClassType = TPasPointerType then
- begin
- AppendSym(CodeEl, '^');
- if Assigned(TPasPointerType(AType).DestType) then
- AppendHyperlink(CodeEl, TPasPointerType(AType).DestType)
- else
- AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
- AppendSym(CodeEl, ';');
- end else
- if AType.InheritsFrom(TPasProcedureType) then
- begin
- AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
- AppendProcArgsSection(ContentElement, TPasProcedureType(AType));
- end else
- // Record
- if AType.ClassType = TPasRecordType then
- begin
- CodeEl := AppendRecordType(CodeEl, TableEl, TPasRecordType(AType), 0);
- AppendSym(CodeEl, ';');
- end else
- // Set
- if AType.ClassType = TPasSetType then
- begin
- AppendKw(CodeEl, 'set of ');
- if TPasSetType(AType).EnumType.ClassType = TPasEnumType then
- begin
- AppendSym(CodeEl, '(');
- EnumType := TPasEnumType(TPasSetType(AType).EnumType);
- for i := 0 to EnumType.Values.Count - 1 do
- begin
- EnumValue := TPasEnumValue(EnumType.Values[i]);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendShortDescrCell(TREl, EnumValue);
- AppendNbSp(CodeEl, 2);
- s := EnumValue.Name;
- if (EnumValue.AssignedValue<>'') then
- s := s + ' = ' + EnumValue.AssignedValue;
- if i < EnumType.Values.Count - 1 then
- s := s + ',';
- AppendPasSHFragment(CodeEl, s, 0);
- end;
- AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
- end else
- begin
- AppendHyperlink(CodeEl, TPasSetType(AType).EnumType);
- AppendSym(CodeEl, ';');
- end;
- end else
- // Type alias
- if AType.ClassType = TPasTypeAliasType then
- begin
- AppendKw(CodeEl, 'type ');
- AppendHyperlink(CodeEl, TPasTypeAliasType(AType).DestType);
- AppendSym(CodeEl, ';');
- end else
- // Probably one of the simple types, which allowed in other places as wel...
- AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
- end;
- procedure THTMLWriter.CreateTypePageBody(AType: TPasType);
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- DocNode: TDocNode;
- begin
- AppendMenuBar(-1);
- AppendTitle(UTF8Decode(AType.Name),AType.Hints);
- AppendShortDescr(CreatePara(ContentElement), AType);
- AppendText(CreateH2(ContentElement), UTF8Decode(SDocDeclaration));
- AppendSourceRef(ContentElement,AType);
- TableEl := CreateTable(ContentElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- DocNode := Engine.FindDocNode(AType);
- AppendKw(CodeEl, 'type ');
- AppendText(CodeEl, UTF8Decode(AType.Name));
- AppendSym(CodeEl, ' = ');
- If Assigned(DocNode) and
- Assigned(DocNode.Node) and
- (Docnode.Node['opaque']='1') then
- AppendText(CodeEl,UTF8Decode(SDocOpaque))
- else
- begin
- AppendTypeDecl(AType,TableEl,CodeEl);
- end;
- FinishElementPage(AType);
- end;
- procedure THTMLWriter.CreateMemberDeclarations(AParent : TPasElement; Members : TFPList; TableEl : TDOmelement; AddEnd : Boolean);
- var
- TREl, CodeEl: TDOMElement;
- Member: TPasElement;
- MVisibility,
- CurVisibility: TPasMemberVisibility;
- i: Integer;
- s: String;
- t : TPasType;
- ah,ol,wt,ct,wc,cc : boolean;
- isRecord : Boolean;
- begin
- isRecord:=AParent is TPasRecordType;
- CodeEl:=nil;
- if Members.Count > 0 then
- begin
- wt:=False;
- wc:=False;
- CurVisibility := visDefault;
- for i := 0 to Members.Count - 1 do
- begin
- Member := TPasElement(Members[i]);
- MVisibility:=Member.Visibility;
- cc:=(Member is TPasConst);
- ct:=(Member is TPasType);
- ol:=(Member is TPasOverloadedProc);
- ah:=ol or ((Member is TPasProcedure) and (TPasProcedure(Member).ProcType.Args.Count > 0));
- if ol then
- Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]);
- if Not Engine.ShowElement(Member) then
- continue;
- if (CurVisibility <> MVisibility) or (cc <> wc) or (ct <> wt) then
- begin
- CurVisibility := MVisibility;
- wc:=cc;
- wt:=ct;
- s:=VisibilityNames[MVisibility];
- AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), UTF8Decode(s));
- if (ct) then AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'type');
- if (cc) then AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'const');
- end;
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendNbSp(CodeEl, 2);
- AppendShortDescrCell(TREl, Member);
- if (Member is TPasProcedureBase) then
- begin
- AppendKw(CodeEl, UTF8Decode(TPasProcedureBase(Member).TypeName) + ' ');
- AppendHyperlink(CodeEl, Member);
- if ah then
- AppendSym(CodeEl, '();')
- else
- AppendSym(CodeEl, ';');
- if Not OL then
- AppendProcExt(CodeEl, TPasProcedure(Member));
- end
- else if (Member is TPasConst) then
- begin
- AppendHyperlink(CodeEl, Member);
- If Assigned(TPasConst(Member).VarType) then
- begin
- AppendSym(CodeEl, ' = ');
- AppendTypeDecl(TPasType(TPasConst(Member).VarType),TableEl,CodeEl);
- end;
- AppendSym(CodeEl, ' = ');
- AppendText(CodeEl,UTF8Decode(TPasConst(Member).Expr.GetDeclaration(True)));
- end
- else if (Member is TPasType) then
- begin
- AppendHyperlink(CodeEl, Member);
- AppendSym(CodeEl, ' = ');
- AppendTypeDecl(TPasType(Member),TableEl,CodeEl);
- end
- else if (Member is TPasProperty) then
- begin
- AppendKw(CodeEl, 'property ');
- AppendHyperlink(CodeEl, Member);
- t:=TPasProperty(Member).ResolvedType;
- if Assigned(TPasProperty(Member).Args) and (TPasProperty(Member).Args.Count>0) then
- AppendText(CodeEl, ' []');
- if Assigned(T) then
- begin
- AppendSym(CodeEl, ': ');
- AppendHyperlink(CodeEl, T);
- end;
- AppendSym(CodeEl, ';');
- if TPasProperty(Member).IsDefault then
- begin
- AppendKw(CodeEl, ' default');
- AppendSym(CodeEl, ';');
- end;
- if (TPasProperty(Member).ImplementsName<>'') then
- begin
- AppendKw(CodeEl, ' implements');
- AppendText(CodeEl, ' '+UTF8Decode(TPasProperty(Member).ImplementsName));
- AppendSym(CodeEl, ';');
- end;
- 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';
- if Length(s) > 0 then
- AppendText(CodeEl, ' [' + UTF8Decode(s) + ']');
- end
- else if (Member is TPasVariable) then
- begin
- if not isRecord then
- AppendHyperlink(CodeEl, Member)
- else
- AppendText(CodeEl, UTF8Decode(Member.Name));
- AppendSym(CodeEl, ': ');
- AppendType(CodeEl, TableEl, TPasVariable(Member).VarType,False);
- AppendSym(CodeEl, ';');
- end
- else
- AppendText(CreateWarning(CodeEl), '<' + UTF8Decode(Member.ClassName) + '>');
- if (Member.Hints<>[]) then
- begin
- AppendKW(CodeEl,' '+UTF8Decode(Engine.HintsToStr(Member.Hints)));
- AppendText(CodeEl, ' ');
- AppendSym(CodeEl, ';');
- end;
- end;
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- end;
- if assigned(CodeEl) Then
- begin
- AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
- If AddEnd then
- begin
- AppendKw(CodeEl, 'end');
- AppendSym(CodeEl, ';');
- end;
- end;
- end;
- procedure THTMLWriter.AppendTitle(const AText: String; Hints: TPasMemberHints);
- begin
- AppendTitle(UTF8Decode(aText),Hints);
- end;
- procedure THTMLWriter.AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []);
- Var
- T : UnicodeString;
- begin
- T:=AText;
- if (Hints<>[]) then
- T:=T+' ('+UTF8Decode(Engine.HintsToStr(Hints))+')';
- AppendText(TitleElement, AText);
- AppendText(CreateH1(ContentElement), T);
- end;
- procedure THTMLWriter.AppendClassMemberListLink(aClass : TPasClassType; ParaEl : TDomElement; AListSubpageIndex: Integer; const AText: DOMString);
- var
- LinkEl: TDOMElement;
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- LinkEl := CreateEl(ParaEl, 'a');
- LinkEl['href'] :=UTF8Decode(FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex)));
- LinkEl['onClick'] := 'window.open(''' + LinkEl['href'] + ''', ''list'', ' +
- '''dependent=yes,resizable=yes,scrollbars=yes,height=400,width=300''); return false;';
- AppendText(LinkEl, AText);
- AppendText(ParaEl, ' (');
- LinkEl := CreateEl(ParaEl, 'a');
- LinkEl['href'] :=UTF8Decode(FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex + 1)));
- LinkEl['onClick'] := 'window.open(''' + LinkEl['href'] + ''', ''list'', ' +
- '''dependent=yes,resizable=yes,scrollbars=yes,height=400,width=300''); return false;';
- AppendText(LinkEl, UTF8Decode(SDocByName));
- AppendText(ParaEl, ')');
- if FUseMenuBrackets then
- AppendText(ParaEl, '] ')
- else
- AppendText(ParaEl, ' ');
- end;
- procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
- procedure AppendGenericTypes(CodeEl : TDomElement; AList : TFPList; isSpecialize : Boolean);
- Var
- I : integer;
- begin
- for I:=0 to AList.Count-1 do
- begin
- if I=0 then
- AppendSym(CodeEl, '<')
- else
- AppendSym(CodeEl, ',');
- AppendText(CodeEl,UTF8Decode(TPasGenericTemplateType(AList[i]).Name));
- end;
- AppendSym(CodeEl, '>');
- end;
- procedure AppendGeneric(ACodeEl : TDomElement ; AGenericObject: TPasClassType);
- begin
- if AGenericObject.GenericTemplateTypes.Count>0 then
- begin
- AppendKw(ACodeEl, ' generic ');
- AppendText(ACodeEl, ' ' + UTF8Decode(AGenericObject.Name) + ' ');
- AppendGenericTypes(ACodeEl,AGenericObject.GenericTemplateTypes,false);
- end;
- end;
- procedure AppendInterfaceInfo(ACodeEl : TDomElement ; AThisClass: TPasClassType);
- var
- i:Integer;
- ThisInterface:TPasClassType;
- begin
- if Assigned(AThisClass) and (AThisClass.Interfaces.count>0) then
- begin
- for i:=0 to AThisClass.interfaces.count-1 do
- begin
- ThisInterface:=TPasClassType(AThisClass.Interfaces[i]);
- AppendText(ACodeEl,',');
- AppendHyperlink(ACodeEl, ThisInterface);
- end;
- end;
- end;
- var
- ParaEl,TableEl, TREl, TDEl, CodeEl: TDOMElement;
- ThisClass, PrevClass: TPasType;
- ThisTreeNode: TPasElementNode;
- begin
- //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
- AppendMenuBar(-1);
- AppendTitle(UTF8Decode(AClass.Name),AClass.Hints);
- ParaEl := CreatePara(ContentElement);
- AppendClassMemberListLink(aClass,ParaEl,PropertiesByInheritanceSubindex, UTF8Decode(SDocProperties));
- AppendClassMemberListLink(aClass,ParaEl,MethodsByInheritanceSubindex, UTF8Decode(SDocMethods));
- AppendClassMemberListLink(aClass,ParaEl,EventsByInheritanceSubindex, UTF8Decode(SDocEvents));
- AppendShortDescr(CreatePara(ContentElement), AClass);
- AppendText(CreateH2(ContentElement), UTF8Decode(SDocDeclaration));
- AppendSourceRef(ContentElement,AClass);
- TableEl := CreateTable(ContentElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- AppendKw(CodeEl, 'type');
- if Assigned(AClass.GenericTemplateTypes) and (AClass.GenericTemplateTypes.Count>0) then
- AppendGeneric(CodeEl, AClass)
- else
- AppendText(CodeEl, ' ' + UTF8Decode(AClass.Name) + ' ');
- AppendSym(CodeEl, '=');
- AppendText(CodeEl, ' ');
- AppendKw(CodeEl, UTF8Decode(ObjKindNames[AClass.ObjKind]));
- // Now we are using only TreeClass for show inheritance
- ThisClass := AClass; ThisTreeNode := Nil;
- if AClass.ObjKind = okInterface then
- ThisTreeNode := TreeInterface.GetPasElNode(AClass)
- else
- ThisTreeNode := TreeClass.GetPasElNode(AClass);
- //if not Assigned(ThisTreeNode) Then
- // DoLog('ERROR Tree Class information: '+ThisClass.PathName);
- if Assigned(AClass.AncestorType) then
- begin
- AppendSym(CodeEl, '(');
- // Show parent class information
- if (AClass.AncestorType is TPasSpecializeType) then
- begin
- AppendText(CodeEl, 'specialize ');
- AppendHyperlink(CodeEl, TPasSpecializeType(AClass.AncestorType).DestType);
- AppendText(CodeEl, '<,>');
- end
- else
- begin
- AppendHyperlink(CodeEl, AClass.AncestorType);
- AppendInterfaceInfo(CodeEl, AClass);
- end;
- AppendSym(CodeEl, ')');
- end;
- // Class members
- CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
- AppendText(CreateH2(ContentElement), UTF8Decode(SDocInheritance));
- TableEl := CreateTable(ContentElement);
- // Process tree class information
- // First tree class link is to This class
- PrevClass:= nil;
- while True do
- begin
- TREl := CreateTR(TableEl);
- TDEl := CreateTD_vtop(TREl);
- TDEl['align'] := 'center';
- CodeEl := CreateCode(CreatePara(TDEl));
- // Show class item
- AppendHyperlink(CodeEl, ThisClass);
- if Assigned(PrevClass) and (PrevClass Is TPasClassType) then // Interfaces from prevClass
- AppendInterfaceInfo(CodeEl, TPasClassType(PrevClass));
- AppendShortDescrCell(TREl, ThisClass);
- if Assigned(ThisTreeNode) then
- if Assigned(ThisTreeNode.ParentNode) then
- begin
- TDEl := CreateTD(CreateTR(TableEl));
- TDEl['align'] := 'center';
- AppendText(TDEl, '|');
- PrevClass:= ThisClass;
- ThisClass := ThisTreeNode.ParentNode.Element;
- ThisTreeNode := ThisTreeNode.ParentNode;
- end
- else
- begin
- ThisClass := nil;
- ThisTreeNode:= nil;
- PrevClass:= nil;
- break;
- end
- else
- break;
- end;
- FinishElementPage(AClass);
- end;
- procedure THTMLWriter.CreateClassInheritanceSubpage(aClass : TPasClassType; AFilter: TMemberFilter);
- var
- ThisClass: TPasClassType;
- i: Integer;
- Member: TPasElement;
- TableEl, TREl, TDEl, ParaEl, LinkEl: TDOMElement;
- begin
- TableEl := CreateTable(ContentElement);
- ThisClass := AClass;
- while True do
- begin
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- TDEl['colspan'] := '3';
- CreateTD(TREl);
- LinkEl := AppendHyperlink(CreateEl(CreateCode(CreatePara(TDEl)), 'b'), ThisClass);
- if Assigned(LinkEl) then
- LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
- '''; return false;';
- for i := 0 to ThisClass.Members.Count - 1 do
- begin
- Member := TPasElement(ThisClass.Members[i]);
- if Not (Engine.ShowElement(Member) and AFilter(Member)) then
- continue;
- TREl := CreateTR(TableEl);
- ParaEl := CreatePara(CreateTD(TREl));
- case Member.Visibility of
- visPrivate:
- AppendText(ParaEl, 'pv');
- visProtected:
- AppendText(ParaEl, 'pt');
- visPublished:
- AppendText(ParaEl, 'pl');
- else
- end;
- AppendNbSp(ParaEl, 1);
- ParaEl := CreateTD(TREl);
- if (Member.ClassType = TPasProperty) and
- (Length(TPasProperty(Member).WriteAccessorName) = 0) then
- begin
- AppendText(ParaEl, 'ro');
- AppendNbSp(ParaEl, 1);
- end;
- LinkEl := AppendHyperlink(CreatePara(CreateTD(TREl)), Member);
- if Assigned(LinkEl) then
- LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
- '''; return false;';
- end;
- if (not Assigned(ThisClass.AncestorType)) or
- (not (ThisClass.AncestorType.ClassType.inheritsfrom(TPasClassType))) then
- break;
- ThisClass := TPasClassType(ThisClass.AncestorType);
- AppendNbSp(CreatePara(CreateTD(CreateTR(TableEl))), 1);
- end;
- end;
- procedure THTMLWriter.CreateClassSortedSubpage(AClass: TPasClassType; AFilter: TMemberFilter);
- var
- List: TFPList;
- ThisClass: TPasClassType;
- i, j: Integer;
- Member: TPasElement;
- ParaEl, TableEl, TREl, TDEl, LinkEl: TDOMElement;
- begin
- List := TFPList.Create;
- try
- ThisClass := AClass;
- while True do
- begin
- for i := 0 to ThisClass.Members.Count - 1 do
- begin
- Member := TPasElement(ThisClass.Members[i]);
- if Engine.ShowElement(Member) and AFilter(Member) then
- begin
- j := 0;
- while (j < List.Count) and
- (CompareText(TPasElement(List[j]).Name, Member.Name) < 0) do
- Inc(j);
- List.Insert(j, Member);
- end;
- end;
- if (not Assigned(ThisClass.AncestorType)) or
- (not (ThisClass.AncestorType.ClassType.inheritsfrom(TPasClassType))) then
- break;
- ThisClass := TPasClassType(ThisClass.AncestorType);
- end;
- TableEl := CreateTable(ContentElement);
- for i := 0 to List.Count - 1 do
- begin
- Member := TPasElement(List[i]);
- TREl := CreateTR(TableEl);
- ParaEl := CreatePara(CreateTD(TREl));
- case Member.Visibility of
- visPrivate:
- AppendText(ParaEl, 'pv');
- visProtected:
- AppendText(ParaEl, 'pt');
- visPublished:
- AppendText(ParaEl, 'pl');
- else
- end;
- AppendNbSp(ParaEl, 1);
- ParaEl := CreatePara(CreateTD(TREl));
- if (Member.ClassType = TPasProperty) and
- (Length(TPasProperty(Member).WriteAccessorName) = 0) then
- begin
- AppendText(ParaEl, 'ro');
- AppendNbSp(ParaEl, 1);
- end;
- TDEl := CreateTD(TREl);
- TDEl['nowrap'] := 'nowrap';
- ParaEl := CreatePara(TDEl);
- LinkEl := AppendHyperlink(ParaEl, Member);
- if Assigned(LinkEl) then
- LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
- '''; return false;';
- AppendText(ParaEl, ' (');
- LinkEl := AppendHyperlink(ParaEl, Member.Parent);
- if Assigned(LinkEl) then
- LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
- '''; return false;';
- AppendText(ParaEl, ')');
- end;
- finally
- List.Free;
- end;
- end;
- procedure THTMLWriter.CreateClassPageBody(AClass: TPasClassType; ASubpageIndex: Integer);
- begin
- case ASubpageIndex of
- 0:
- CreateClassMainPage(aClass);
- PropertiesByInheritanceSubindex:
- CreateClassInheritanceSubpage(aClass,@PropertyFilter);
- PropertiesByNameSubindex:
- CreateClassSortedSubpage(aClass,@PropertyFilter);
- MethodsByInheritanceSubindex:
- CreateClassInheritanceSubpage(aClass,@MethodFilter);
- MethodsByNameSubindex:
- CreateClassSortedSubpage(aClass,@MethodFilter);
- EventsByInheritanceSubindex:
- CreateClassInheritanceSubpage(aClass,@EventFilter);
- EventsByNameSubindex:
- CreateClassSortedSubpage(aClass,@EventFilter);
- end;
- end;
- procedure THTMLWriter.CreateClassMemberPageBody(AElement: TPasElement);
- var
- TableEl, TREl, CodeEl: TDOMElement;
- procedure CreateVarPage(Element: TPasVariable);
- begin
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, UTF8Decode(Element.Name));
- if Assigned(Element.VarType) then
- begin
- AppendSym(CodeEl, ' : ');
- AppendSym(AppendType(CodeEl, TableEl, Element.VarType, False), ';');
- end;
- end;
- procedure CreateTypePage(Element: TPasType);
- begin
- AppendKw(CodeEl, 'type ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, UTF8Decode(Element.Name));
- AppendSym(CodeEl, ' = ');
- AppendTypeDecl(Element,TableEl,CodeEl)
- end;
- procedure CreateConstPage(Element: TPasConst);
- begin
- AppendKw(CodeEl, 'const ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, UTF8Decode(Element.Name));
- if Assigned(Element.VarType) then
- begin
- AppendSym(CodeEl, ': ');
- AppendType(CodeEl, TableEl, Element.VarType, False);
- end;
- AppendPasSHFragment(CodeEl, ' = ' + Element.Expr.GetDeclaration(True) + ';', 0);
- end;
- procedure CreatePropertyPage(Element: TPasProperty);
- var
- NeedBreak: Boolean;
- T : TPasType;
- A : TPasArgument;
- I : integer;
- begin
- AppendKw(CodeEl, 'property ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, UTF8Decode(Element.Name));
- if Assigned(Element.Args) and (Element.Args.Count>0) then
- begin
- AppendSym(CodeEl,'[');
- For I:=0 to Element.Args.Count-1 do
- begin
- If I>0 then
- AppendSym(CodeEl,',');
- A:=TPasArgument(Element.Args[i]);
- AppendText(CodeEl, UTF8Decode(A.Name));
- AppendSym(CodeEl,': ');
- if Assigned(A.ArgType) then
- AppendText(CodeEl,UTF8Decode(A.ArgType.Name))
- else
- AppendText(CodeEl,'<Unknown>');
- end;
- AppendSym(CodeEl,']');
- end;
- T:=Element.ResolvedType;
- if Assigned(T) then
- begin
- AppendSym(CodeEl, ' : ');
- AppendType(CodeEl, TableEl, T, False);
- end;
- NeedBreak := False;
- if Length(TPasProperty(Element).IndexValue) <> 0 then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- AppendKw(CodeEl, 'index ');
- AppendPasSHFragment(CodeEl, TPasProperty(Element).IndexValue, 0);
- NeedBreak := True;
- end;
- if Length(TPasProperty(Element).ReadAccessorName) <> 0 then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- AppendKw(CodeEl, 'read ');
- AppendText(CodeEl, UTF8Decode(TPasProperty(Element).ReadAccessorName));
- NeedBreak := True;
- end;
- if Length(TPasProperty(Element).WriteAccessorName) <> 0 then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- AppendKw(CodeEl, 'write ');
- AppendText(CodeEl, UTF8Decode(TPasProperty(Element).WriteAccessorName));
- NeedBreak := True;
- end;
- if Length(TPasProperty(Element).StoredAccessorName) <> 0 then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- AppendKw(CodeEl, 'stored ');
- AppendText(CodeEl, UTF8Decode(TPasProperty(Element).StoredAccessorName));
- NeedBreak := True;
- end;
- if Length(TPasProperty(Element).DefaultValue) <> 0 then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- AppendKw(CodeEl, 'default ');
- AppendPasSHFragment(CodeEl, TPasProperty(Element).DefaultValue, 0);
- NeedBreak := True;
- end;
- AppendSym(CodeEl, ';');
- if TPasProperty(Element).IsDefault or TPasProperty(Element).IsNodefault then
- begin
- if NeedBreak then
- begin
- CreateEl(CodeEl, 'br');
- AppendNbsp(CodeEl, 2);
- end;
- if TPasProperty(Element).IsDefault then
- AppendKw(CodeEl, 'default')
- else
- AppendKw(CodeEl, 'nodefault');
- AppendSym(CodeEl, ';');
- end;
- end;
- var
- s: String;
- begin
- AppendMenuBar(-1);
- AppendTitle(UTF8Decode(AElement.FullName),AElement.Hints);
- AppendShortDescr(CreatePara(ContentElement), AElement);
- AppendText(CreateH2(ContentElement), SDocDeclaration);
- AppendSourceRef(ContentElement,AElement);
- TableEl := CreateTable(ContentElement);
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD(TREl)));
- AppendText(CodeEl, ' '); // !!!: Workaround for current HTML writer
- if (AElement.Visibility<>visDefault) then
- begin
- s:=VisibilityNames[AElement.Visibility];
- AppendKw(CodeEl, s);
- end;
- AppendText(CodeEl, ' ');
- if AElement is TPasProperty then
- CreatePropertyPage(TPasProperty(AElement))
- else if AElement is TPasConst then
- CreateConstPage(TPasConst(AElement))
- else if (AElement is TPasVariable) then
- CreateVarPage(TPasVariable(AElement))
- else if AElement is TPasProcedureBase then
- AppendProcDecl(CodeEl, TableEl, TPasProcedureBase(AElement))
- else if AElement is TPasType then
- CreateTypePage(TPasType(AElement))
- else
- AppendText(CreateWarning(ContentElement), '<' + AElement.ClassName + '>');
- FinishElementPage(AElement);
- end;
- procedure THTMLWriter.CreateVarPageBody(AVar: TPasVariable);
- var
- TableEl, TREl, TDEl, CodeEl, El: TDOMElement;
- begin
- AppendMenuBar(-1);
- AppendTitle(AVar.FullName,AVar.Hints);
- AppendShortDescr(CreatePara(ContentElement), AVar);
- AppendText(CreateH2(ContentElement), SDocDeclaration);
- AppendSourceRef(ContentElement,AVar);
- TableEl := CreateTable(ContentElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- AppendKw(CodeEl, 'var');
- AppendText(CodeEl, ' ' + AVar.Name);
- if Assigned(AVar.VarType) then
- begin
- AppendSym(CodeEl, ': ');
- El := AppendType(CodeEl, TableEl, AVar.VarType, False);
- end else
- El := CodeEl;
- if Length(AVar.Value) > 0 then
- AppendPasSHFragment(El, ' = ' + AVar.Value + ';', 0)
- else
- AppendSym(El, ';');
- FinishElementPage(AVar);
- end;
- procedure THTMLWriter.CreateProcPageBody(AProc: TPasProcedureBase);
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- begin
- AppendMenuBar(-1);
- AppendTitle(UTF8Decode(AProc.Name),AProc.Hints);
- AppendShortDescr(CreatePara(ContentElement), AProc);
- AppendText(CreateH2(ContentElement), SDocDeclaration);
- AppendSourceRef(ContentElement,AProc);
- TableEl := CreateTable(ContentElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- AppendProcDecl(CodeEl, TableEl, AProc);
- FinishElementPage(AProc);
- end;
- function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
- Function ReadFile(aFileName : string) : TstringStream;
- begin
- aFileName:= SetDirSeparators(aFileName);
- try
- if copy(aFileName,1,1)<>'@' then
- Result:=TStringStream.Create(aFileName)
- else
- begin
- Delete(aFileName,1,1);
- Result:=TStringStream.Create('');
- Result.LoadFromFile(aFileName);
- Result.Position:=0;
- end;
- except
- Result.Free;
- Raise;
- end;
- end;
- begin
- Result:=True;
- if Cmd = '--html-search' then
- SearchPage := Arg
- else if Cmd = '--footer' then
- FFooterHTML := ReadFile(Arg)
- else if Cmd = '--header' then
- FHeaderHTML := ReadFile(Arg)
- else if Cmd = '--navigator' then
- FNavigatorHTML := ReadFile(Arg)
- else if Cmd = '--charset' then
- CharSet := Arg
- else if Cmd = '--index-colcount' then
- IndexColCount := StrToIntDef(Arg,IndexColCount)
- else if Cmd = '--image-url' then
- BaseImageURL := Arg
- else if Cmd = '--css-file' then
- FCSSFile := arg
- else if Cmd = '--footer-date' then
- begin
- FIncludeDateInFooter:=True;
- FDateFormat:=Arg;
- end
- else if Cmd = '--disable-menu-brackets' then
- FUseMenuBrackets:=False
- else
- Result:=inherited InterPretOption(Cmd, Arg);
- end;
- class procedure THTMLWriter.Usage(List: TStrings);
- begin
- List.add('--header=file');
- List.Add(SHTMLUsageHeader);
- List.add('--footer=file');
- List.Add(SHTMLUsageFooter);
- List.add('--navigator=file');
- List.Add(SHTMLUsageNavigator);
- List.Add('--footer-date[=Fmt]');
- List.Add(SHTMLUsageFooterDate);
- List.Add('--charset=set');
- List.Add(SHTMLUsageCharset);
- List.Add('--html-search=pagename');
- List.Add(SHTMLHtmlSearch);
- List.Add('--index-colcount=N');
- List.Add(SHTMLIndexColcount);
- List.Add('--image-url=url');
- List.Add(SHTMLImageUrl);
- List.Add('--disable-menu-brackets');
- List.Add(SHTMLDisableMenuBrackets);
- inherited Usage(List);
- end;
- class procedure THTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);
- var
- i: integer;
- begin
- i := Pos(',', AFilename);
- if i > 0 then
- begin //split into filename and prefix
- ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
- SetLength(AFilename, i-1);
- end
- else if ALinkPrefix = '' then
- begin //synthesize outdir\pgk.xct, ..\pkg
- ALinkPrefix := '../' + ChangeFileExt(ExtractFileName(AFilename), '');
- AFilename := ChangeFileExt(AFilename, '.xct');
- end;
- end;
- class function THTMLWriter.FileNameExtension: String;
- begin
- result:='';
- end;
- // private methods
- procedure THTMLWriter.SetOnTest(const AValue: TNotifyEvent);
- begin
- if FOnTest=AValue then exit;
- FOnTest:=AValue;
- end;
- initialization
- // Do not localize.
- RegisterWriter(THTMLWriter,'html','HTML output using fpdoc.css stylesheet.');
- finalization
- UnRegisterWriter('html');
- end.
|