12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890 |
- {
- 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;
- interface
- uses Classes, contnrs, DOM, DOM_HTML, dGlobals, PasTree, dWriter, ChmWriter, ChmBase;
- const
- // Subpage indices for modules
- ResstrSubindex = 1;
- ConstsSubindex = 2;
- TypesSubindex = 3;
- ClassesSubindex = 4;
- ProcsSubindex = 5;
- VarsSubindex = 6;
- // Maybe needed later for topic overview ??
- TopicsSubIndex = 7;
- IndexSubIndex = 8;
- ClassHierarchySubIndex = 9;
- // Subpage indices for classes
- PropertiesByInheritanceSubindex = 1;
- PropertiesByNameSubindex = 2;
- MethodsByInheritanceSubindex = 3;
- MethodsByNameSubindex = 4;
- EventsByInheritanceSubindex = 5;
- EventsByNameSubindex = 6;
- type
- TFileAllocator = class
- public
- procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); virtual;
- function GetFilename(AElement: TPasElement;
- ASubindex: Integer): String; virtual; abstract;
- function GetRelativePathToTop(AElement: TPasElement): String; virtual;
- function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
- end;
- TShortNameFileAllocator = class(TFileAllocator)
- private
- FExtension: String;
- public
- constructor Create(const AExtension: String);
- procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); override;
- property Extension: String read FExtension;
- end;
- TLongNameFileAllocator = class(TFileAllocator)
- private
- FExtension: String;
- public
- constructor Create(const AExtension: String);
- function GetFilename(AElement: TPasElement;
- ASubindex: Integer): String; override;
- function GetRelativePathToTop(AElement: TPasElement): String; override;
- property Extension: String read FExtension;
- end;
- TPageInfo = class
- Element: TPasElement;
- SubpageIndex: Integer;
- end;
- { THTMLWriter }
- THTMLWriter = class(TFPDocWriter)
- private
- FImageFileList: TStrings;
- FOnTest: TNotifyEvent;
- FPackage: TPasPackage;
- FCharSet : String;
- procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
- procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
- procedure CreateMinusImage;
- procedure CreatePlusImage;
- function GetPageCount: Integer;
- procedure SetOnTest(const AValue: TNotifyEvent);
- protected
- FCSSFile: String;
- FAllocator: TFileAllocator;
- CurDirectory: String; // relative to curdir of process
- BaseDirectory: String; // relative path to package base directory
- PageInfos: TObjectList; // list of TPageInfo objects
- Doc: THTMLDocument;
- HeadElement,
- BodyElement, TitleElement: TDOMElement;
- Module: TPasModule;
- OutputNodeStack: TList;
- CurOutputNode: TDOMNode;
- InsideHeadRow, DoPasHighlighting: Boolean;
- HighlighterFlags: Byte;
- FooterFile: string;
- FIDF : Boolean;
- FDateFormat: String;
- FIndexColCount : Integer;
- FSearchPage : String;
- FBaseImageURL : String;
- FUseMenuBrackets: Boolean;
- Procedure CreateAllocator; virtual;
- procedure CreateCSSFile; virtual;
- function ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
- function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
- function ResolveLinkWithinPackage(AElement: TPasElement;
- ASubpageIndex: Integer): String;
- // Helper functions for creating DOM elements
- function CreateEl(Parent: TDOMNode; const AName: DOMString): THTMLElement;
- function CreatePara(Parent: TDOMNode): THTMLElement;
- function CreateH1(Parent: TDOMNode): THTMLElement;
- function CreateH2(Parent: TDOMNode): THTMLElement;
- function CreateH3(Parent: TDOMNode): THTMLElement;
- function CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
- function CreateContentTable(Parent: TDOMNode): THTMLElement;
- function CreateTR(Parent: TDOMNode): THTMLElement;
- function CreateTD(Parent: TDOMNode): THTMLElement;
- function CreateTD_vtop(Parent: TDOMNode): THTMLElement;
- function CreateLink(Parent: TDOMNode; const AHRef: DOMString): THTMLElement;
- function CreateAnchor(Parent: TDOMNode; const AName: DOMString): THTMLElement;
- function CreateCode(Parent: TDOMNode): THTMLElement;
- function CreateWarning(Parent: TDOMNode): THTMLElement;
- // Description node conversion
- Procedure DescrEmitNotesHeader(AContext : TPasElement); override;
- Procedure DescrEmitNotesFooter(AContext : TPasElement); override;
- procedure PushOutputNode(ANode: TDOMNode);
- procedure PopOutputNode;
- 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 DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); 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 DescrBeginURL(const AURL: DOMString); override;
- procedure DescrEndURL; override;
- procedure DescrWriteLinebreak; override;
- procedure DescrBeginParagraph; override;
- procedure DescrEndParagraph; override;
- procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
- procedure DescrWriteCodeLine(const ALine: String); override;
- procedure DescrEndCode; 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;
- procedure AppendText(Parent: TDOMNode; const AText: DOMString);
- procedure AppendNbSp(Parent: TDOMNode; ACount: Integer);
- procedure AppendSym(Parent: TDOMNode; const AText: DOMString);
- procedure AppendKw(Parent: TDOMNode; const AText: DOMString);
- function AppendPasSHFragment(Parent: TDOMNode; const AText: String;
- AShFlags: Byte): Byte;
- Procedure AppendShortDescr(AContext : TPasElement;Parent: TDOMNode; DocNode : TDocNode);
- procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
- procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
- procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode;
- DescrNode: TDOMElement; AutoInsertBlock: Boolean);
- procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode;
- DescrNode: TDOMElement; const ATitle: DOMString);
- function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
- function AppendType(CodeEl, TableEl: TDOMElement;
- Element: TPasType; Expanded: Boolean;
- NestingLevel: Integer = 0): TDOMElement;
- function AppendProcType(CodeEl, TableEl: TDOMElement;
- Element: TPasProcedureType; Indent: Integer): TDOMElement;
- procedure AppendProcExt(CodeEl: TDOMElement; Element: TPasProcedure);
- procedure AppendProcDecl(CodeEl, TableEl: TDOMElement;
- Element: TPasProcedureBase);
- procedure AppendProcArgsSection(Parent: TDOMNode;
- Element: TPasProcedureType; SkipResult : Boolean = False);
- function AppendRecordType(CodeEl, TableEl: TDOMElement;
- Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
- procedure AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []);
- procedure AppendMenuBar(ASubpageIndex: Integer);
- procedure AppendTopicMenuBar(Topic : TTopicElement);
- procedure AppendSourceRef(AElement: TPasElement);
- procedure FinishElementPage(AElement: TPasElement);
- Procedure AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
- Procedure AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
- procedure AppendFooter;
- procedure CreateIndexPage(L : TStringList);
- procedure CreateModuleIndexPage(AModule: TPasModule);
- procedure CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer); virtual;
- procedure CreatePackagePageBody;
- procedure CreatePackageIndex;
- procedure CreatePackageClassHierarchy;
- procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean);
- procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
- Procedure CreateTopicPageBody(AElement : TTopicElement);
- procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
- 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);
- public
- constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
- destructor Destroy; override;
- // Single-page generation
- function CreateHTMLPage(AElement: TPasElement;
- ASubpageIndex: Integer): TXMLDocument;
- function CreateXHTMLPage(AElement: TPasElement;
- ASubpageIndex: Integer): TXMLDocument;
- // For producing complete package documentation
- procedure WriteHTMLPages; virtual;
- procedure WriteXHTMLPages;
- function ModuleForElement(AnElement:TPasElement):TPasModule;
- Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
- Procedure WriteDoc; override;
- Class Function FileNameExtension : String; override;
- class procedure Usage(List: TStrings); override;
- Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
- Property SearchPage: String Read FSearchPage Write FSearchPage;
- property Allocator: TFileAllocator read FAllocator;
- property Package: TPasPackage read FPackage;
- property PageCount: Integer read GetPageCount;
- Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
- 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 BaseImageURL : String Read FBaseImageURL Write FBaseImageURL;
- Property UseMenuBrackets : Boolean Read FUseMenuBrackets write FUseMenuBrackets;
- end;
- THTMWriter = class(THTMLWriter)
- Protected
- Procedure CreateAllocator; override;
- end;
- {$DEFINE chmInterface}
- {$I dw_htmlchm.inc}
- {$UNDEF chmInterface}
- implementation
- uses SysUtils, XHTML, XMLRead, XMLWrite, HTMWrite, sh_pas, fpdocclasstree,
- chmsitemap;
- {$i css.inc}
- {$i plusimage.inc}
- {$i minusimage.inc}
- Function FixHTMLpath(S : String) : STring;
- begin
- Result:=StringReplace(S,'\','/',[rfReplaceAll]);
- end;
- {$I dw_htmlchm.inc}
- procedure TFileAllocator.AllocFilename(AElement: TPasElement;
- ASubindex: Integer);
- begin
- end;
- function TFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
- begin
- SetLength(Result, 0);
- end;
- function TFileAllocator.GetCSSFilename(ARelativeTo: TPasElement): DOMString;
- begin
- Result := GetRelativePathToTop(ARelativeTo) + 'fpdoc.css';
- end;
- constructor TShortNameFileAllocator.Create(const AExtension: String);
- begin
- inherited Create;
- FExtension := AExtension;
- end;
- procedure TShortNameFileAllocator.AllocFilename(AElement: TPasElement;
- ASubindex: Integer);
- begin
- // !!!: Add element to file list
- end;
- constructor TLongNameFileAllocator.Create(const AExtension: String);
- begin
- inherited Create;
- FExtension := AExtension;
- end;
- function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
- ASubindex: Integer): String;
- var
- s: String;
- i: Integer;
- begin
- if AElement.ClassType = TPasPackage then
- Result := 'index'
- else if AElement.ClassType = TPasModule then
- Result := LowerCase(AElement.Name) + PathDelim + 'index'
- else
- begin
- if AElement is TPasOperator then
- begin
- Result := LowerCase(AElement.Parent.PathName) + '.op-';
- s := Copy(AElement.Name, Pos(' ', AElement.Name) + 1, Length(AElement.Name));
- s := Copy(s, 1, Pos('(', s) - 1);
- if s = ':=' then
- s := 'assign'
- else if s = '+' then
- s := 'add'
- else if s = '-' then
- s := 'sub'
- else if s = '*' then
- s := 'mul'
- else if s = '/' then
- s := 'div'
- else if s = '**' then
- s := 'power'
- else if s = '=' then
- s := 'equal'
- else if s = '<>' then
- s := 'unequal'
- else if s = '<' then
- s := 'less'
- else if s = '<=' then
- s := 'lessequal'
- else if s = '>' then
- s := 'greater'
- else if s = '>=' then
- s := 'greaterthan'
- else if s = '><' then
- s := 'symmetricdifference';
- Result := Result + s + '-';
- s := '';
- i := 1;
- while AElement.Name[i] <> '(' do
- Inc(i);
- Inc(i);
- while AElement.Name[i] <> ')' do
- begin
- if AElement.Name[i] = ',' then
- begin
- s := s + '-';
- Inc(i);
- end else
- s := s + AElement.Name[i];
- Inc(i);
- end;
- Result := Result + LowerCase(s) + '-' + LowerCase(Copy(AElement.Name,
- Pos('):', AElement.Name) + 3, Length(AElement.Name)));
- end else
- Result := LowerCase(AElement.PathName);
- // searching for TPasModule - it is on the 2nd level
- if Assigned(AElement.Parent) then
- while Assigned(AElement.Parent.Parent) do
- AElement := AElement.Parent;
- // cut off Package Name
- Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
- // to skip dots in unit name
- i := Length(AElement.Name);
- while (i <= Length(Result)) and (Result[i] <> '.') do
- Inc(i);
- if (i <= Length(Result)) and (i > 0) then
- Result[i] := PathDelim;
- end;
- if ASubindex > 0 then
- Result := Result + '-' + IntToStr(ASubindex);
- Result := Result + Extension;
- end;
- function TLongNameFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
- begin
- if (AElement.ClassType=TPasPackage) then
- Result := ''
- else if (AElement.ClassType=TTopicElement) then
- begin
- If (AElement.Parent.ClassType=TTopicElement) then
- Result:='../'+GetRelativePathToTop(AElement.Parent)
- else if (AElement.Parent.ClassType=TPasPackage) then
- Result:=''
- else if (AElement.Parent.ClassType=TPasModule) then
- Result:='../';
- end
- else
- Result := '../';
- end;
- Type
- { TLinkData }
- TLinkData = Class(TObject)
- FPathName,
- FLink,
- FModuleName : String;
- Constructor Create(Const APathName,ALink,AModuleName : string);
- end;
- { TLinkData }
- constructor TLinkData.Create(Const APathName, ALink, AModuleName: string);
- begin
- FPathName:=APathName;
- FLink:=ALink;
- FModuleName:=AModuleName;
- end;
- constructor THTMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
- procedure AddPage(AElement: TPasElement; ASubpageIndex: Integer);
- var
- PageInfo: TPageInfo;
- begin
- PageInfo := TPageInfo.Create;
- PageInfo.Element := AElement;
- PageInfo.SubpageIndex := ASubpageIndex;
- PageInfos.Add(PageInfo);
- Allocator.AllocFilename(AElement, ASubpageIndex);
- if ASubpageIndex = 0 then
- Engine.AddLink(AElement.PathName,
- Allocator.GetFilename(AElement, ASubpageIndex));
- end;
- procedure AddTopicPages(AElement: TPasElement);
- var
- PreviousTopic,
- TopicElement : TTopicElement;
- PageInfo : TPageInfo;
- DocNode,
- TopicNode : TDocNode;
- begin
- DocNode:=Engine.FindDocNode(AElement);
- If not Assigned(DocNode) then
- exit;
- TopicNode:=DocNode.FirstChild;
- PreviousTopic:=Nil;
- While Assigned(TopicNode) do
- begin
- If TopicNode.TopicNode then
- begin
- TopicElement:=TTopicElement.Create(TopicNode.Name,AElement);
- Topics.Add(TopicElement);
- TopicElement.TopicNode:=TopicNode;
- TopicElement.Previous:=PreviousTopic;
- If Assigned(PreviousTopic) then
- PreviousTopic.Next:=TopicElement;
- PreviousTopic:=TopicElement;
- if AElement is TTopicElement then
- TTopicElement(AElement).SubTopics.Add(TopicElement);
- PageInfo := TPageInfo.Create;
- PageInfo.Element := TopicElement;
- PageInfo.SubpageIndex := 0;
- PageInfos.Add(PageInfo);
- Allocator.AllocFilename(TopicElement,0);
- Engine.AddLink(TopicElement.PathName, Allocator.GetFilename(TopicElement,0));
- if AElement is TTopicElement then
- TTopicElement(AElement).SubTopics.Add(TopicElement)
- else // Only one level of recursion.
- AddTopicPages(TopicElement);
- end;
- TopicNode:=TopicNode.NextSibling;
- end;
- end;
- procedure AddPages(AElement: TPasElement; ASubpageIndex: Integer;
- AList: TFPList);
- var
- i: Integer;
- begin
- if AList.Count > 0 then
- begin
- AddPage(AElement, ASubpageIndex);
- for i := 0 to AList.Count - 1 do
- AddPage(TPasElement(AList[i]), 0);
- end;
- end;
- Function HaveClasses(AModule: TPasModule) : Boolean;
- begin
- result:=assigned(AModule)
- and assigned(AModule.InterfaceSection)
- and assigned(AModule.InterfaceSection.Classes)
- and (AModule.InterfaceSection.Classes.Count>0);
- end;
- procedure ScanModule(AModule: TPasModule; LinkList : TObjectList);
- var
- i, j, k: Integer;
- s: String;
- ClassEl: TPasClassType;
- FPEl, AncestorMemberEl: TPasElement;
- DocNode: TDocNode;
- ALink : DOMString;
- DidAutolink: Boolean;
- begin
- if not assigned(Amodule.Interfacesection) then
- exit;
- AddPage(AModule, 0);
- AddPage(AModule,IndexSubIndex);
- AddTopicPages(AModule);
- with AModule do
- begin
- if InterfaceSection.ResStrings.Count > 0 then
- begin
- AddPage(AModule, ResstrSubindex);
- s := Allocator.GetFilename(AModule, ResstrSubindex);
- for i := 0 to InterfaceSection.ResStrings.Count - 1 do
- with TPasResString(InterfaceSection.ResStrings[i]) do
- Engine.AddLink(PathName, s + '#' + LowerCase(Name));
- end;
- AddPages(AModule, ConstsSubindex, InterfaceSection.Consts);
- AddPages(AModule, TypesSubindex, InterfaceSection.Types);
- if InterfaceSection.Classes.Count > 0 then
- begin
- AddPage(AModule, ClassesSubindex);
- for i := 0 to InterfaceSection.Classes.Count - 1 do
- begin
- ClassEl := TPasClassType(InterfaceSection.Classes[i]);
- AddPage(ClassEl, 0);
- // !!!: Only add when there are items
- AddPage(ClassEl, PropertiesByInheritanceSubindex);
- AddPage(ClassEl, PropertiesByNameSubindex);
- AddPage(ClassEl, MethodsByInheritanceSubindex);
- AddPage(ClassEl, MethodsByNameSubindex);
- AddPage(ClassEl, EventsByInheritanceSubindex);
- AddPage(ClassEl, EventsByNameSubindex);
- for j := 0 to ClassEl.Members.Count - 1 do
- begin
- FPEl := TPasElement(ClassEl.Members[j]);
- if Not Engine.ShowElement(FPEl) then
- continue;
- DocNode := Engine.FindDocNode(FPEl);
- if Assigned(DocNode) then
- begin
- if Assigned(DocNode.Node) then
- ALink:=DocNode.Node['link']
- else
- ALink:='';
- If (ALink<>'') then
- LinkList.Add(TLinkData.Create(FPEl.PathName,ALink,AModule.name))
- else
- AddPage(FPEl, 0);
- end
- else
- begin
- DidAutolink := False;
- if Assigned(ClassEl.AncestorType) and
- (ClassEl.AncestorType.ClassType.inheritsfrom(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
- AddPage(FPEl, 0);
- end;
- end;
- end;
- end;
- AddPages(AModule, ProcsSubindex, InterfaceSection.Functions);
- AddPages(AModule, VarsSubindex, InterfaceSection.Variables);
- end;
- end;
- var
- i: Integer;
- L : TObjectList;
- H : Boolean;
- begin
- inherited ;
- // should default to true since this is the old behavior
- UseMenuBrackets:=True;
- IndexColCount:=3;
- Charset:='iso-8859-1';
- CreateAllocator;
- FPackage := APackage;
- OutputNodeStack := TList.Create;
- PageInfos := TObjectList.Create;
- FImageFileList := TStringList.Create;
- // Allocate page for the package itself, if a name is given (i.e. <> '#')
- if Length(Package.Name) > 1 then
- begin
- AddPage(Package, 0);
- AddPage(Package,IndexSubIndex);
- I:=0;
- H:=False;
- While (I<Package.Modules.Count) and Not H do
- begin
- H:=HaveClasses(TPasModule(Package.Modules[i]));
- Inc(I);
- end;
- if H then
- AddPage(Package,ClassHierarchySubIndex);
- AddTopicPages(Package);
- end;
- L:=TObjectList.Create;
- try
- for i := 0 to Package.Modules.Count - 1 do
- ScanModule(TPasModule(Package.Modules[i]),L);
- // Resolve links
- For I:=0 to L.Count-1 do
- With TLinkData(L[i]) do
- Engine.AddLink(FPathName,ResolveLinkIDInUnit(FLink,FModuleName));
- finally
- L.Free;
- end;
- end;
- destructor THTMLWriter.Destroy;
- begin
- PageInfos.Free;
- OutputNodeStack.Free;
- FAllocator.Free;
- FImageFileList.Free;
- inherited Destroy;
- end;
- function THTMLWriter.CreateHTMLPage(AElement: TPasElement;
- ASubpageIndex: Integer): TXMLDocument;
- var
- HTMLEl: THTMLHtmlElement;
- HeadEl: THTMLHeadElement;
- El: TDOMElement;
- begin
- Doc := THTMLDocument.Create;
- Result := Doc;
- 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;
- HeadElement:=HeadEl;
- HTMLEl.AppendChild(HeadEl);
- El := Doc.CreateElement('meta');
- HeadEl.AppendChild(El);
- El['http-equiv'] := 'Content-Type';
-
- El['content'] := 'text/html; charset=utf-8';
- TitleElement := Doc.CreateElement('title');
- HeadEl.AppendChild(TitleElement);
- El := Doc.CreateElement('link');
- BodyElement := Doc.CreateElement('body');
- HTMLEl.AppendChild(BodyElement);
- CreatePageBody(AElement, ASubpageIndex);
- AppendFooter;
- HeadEl.AppendChild(El);
- El['rel'] := 'stylesheet';
- El['type'] := 'text/css';
- El['href'] := FixHtmlPath(Allocator.GetCSSFilename(AElement));
- end;
- function THTMLWriter.CreateXHTMLPage(AElement: TPasElement;
- ASubpageIndex: Integer): TXMLDocument;
- begin
- Result := nil;
- end;
- procedure CreatePath(const AFilename: String);
- var
- EndIndex: Integer;
- Path: String;
- begin
- EndIndex := Length(AFilename);
- if EndIndex = 0 then
- exit;
- while not (AFilename[EndIndex] in AllowDirectorySeparators) do
- begin
- Dec(EndIndex);
- if EndIndex = 0 then
- exit;
- end;
- Path := Copy(AFilename, 1, EndIndex - 1);
- if not DirectoryExists(Path) then
- begin
- CreatePath(Path);
- MkDir(Path);
- end;
- end;
- procedure THTMLWriter.WriteHTMLPages;
- var
- i: Integer;
- PageDoc: TXMLDocument;
- Filename: String;
- begin
- if Engine.Output <> '' then
- Engine.Output := IncludeTrailingBackSlash(Engine.Output);
- for i := 0 to PageInfos.Count - 1 do
- with TPageInfo(PageInfos[i]) do
- begin
- PageDoc := CreateHTMLPage(Element, SubpageIndex);
- try
- Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
- try
- CreatePath(Filename);
- WriteHTMLFile(PageDoc, Filename);
- except
- on E: Exception do
- DoLog(SErrCouldNotCreateFile, [FileName, e.Message]);
- end;
- finally
- PageDoc.Free;
- end;
- end;
- 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;
- function THTMLWriter.ModuleForElement(AnElement:TPasElement):TPasModule;
- begin
- result:=TPasModule(AnElement);
- while assigned(result) and not (result is TPasModule) do
- result:=TPasModule(result.parent);
- if not (result is TPasModule) then
- result:=nil;
- end;
- procedure 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;
- procedure THTMLWriter.WriteXHTMLPages;
- begin
- end;
- {procedure THTMLWriter.CreateDoc(const ATitle: DOMString;
- AElement: TPasElement; const AFilename: String);
- var
- El: TDOMElement;
- DocInfo: TDocInfo;
- CSSName: String;
- begin
- Doc := TXHTMLDocument.Create;
- with TXHTMLDocument(Doc) do
- begin
- Encoding := 'ISO8859-1';
- CSSName := 'fpdoc.css';
- if Assigned(Module) then
- CSSName := '../' + CSSName;
- $IFNDEF ver1_0
- StylesheetType := 'text/css';
- StylesheetHRef := CSSName;
- $ENDIF
- CreateRoot(xhtmlStrict);
- with RequestHeadElement do
- begin
- AppendText(RequestTitleElement, ATitle);
- El := CreateElement('link');
- AppendChild(El);
- El['rel'] := 'stylesheet';
- El['type'] := 'text/css';
- El['href'] := FixHtmlPath(CSSName);
- end;
- Self.BodyElement := RequestBodyElement('en');
- end;
- if Length(AFilename) > 0 then
- begin
- DocInfo := TDocInfo.Create;
- DocInfos.Add(DocInfo);
- DocInfo.Element := AElement;
- DocInfo.Filename := AFilename;
- end;
- end;
- }
- { Used for:
- - <link> elements in descriptions
- - "see also" entries
- - AppendHyperlink (for unresolved parse tree element links)
- }
- function THTMLWriter.ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
- begin
- Result:=ResolveLinkID(Name);
- If (Result='') and (AUnitName<>'') and (length(Name)>0) and (Name[1]<>'#') then
- Result:=ResolveLinkID(AUnitName+'.'+Name);
- end;
- function THTMLWriter.ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
- var
- i: Integer;
- ThisPackage: TLinkNode;
- begin
- Result:=Engine.ResolveLink(Module,Name, True);
- if Length(Result) > 0 then
- if Copy(Result, 1, Length(CurDirectory) + 1) = CurDirectory + '/' then
- Result := Copy(Result, Length(CurDirectory) + 2, Length(Result))
- else if not IsLinkAbsolute(Result) then
- Result := BaseDirectory + Result;
- end;
- function THTMLWriter.ResolveLinkWithinPackage(AElement: TPasElement;
- ASubpageIndex: Integer): String;
- var
- ParentEl: TPasElement;
- begin
- ParentEl := AElement;
- while Assigned(ParentEl) and not (ParentEl.ClassType = TPasPackage) do
- ParentEl := ParentEl.Parent;
- if Assigned(ParentEl) and (TPasPackage(ParentEl) = Engine.Package) then
- begin
- Result := Allocator.GetFilename(AElement, ASubpageIndex);
- if Copy(Result, 1, Length(CurDirectory) + 1) = CurDirectory + '/' then
- Result := Copy(Result, Length(CurDirectory) + 2, Length(Result))
- else
- Result := BaseDirectory + Result;
- end else
- SetLength(Result, 0);
- end;
- function THTMLWriter.CreateEl(Parent: TDOMNode;
- const AName: DOMString): THTMLElement;
- begin
- Result := Doc.CreateElement(AName);
- Parent.AppendChild(Result);
- end;
- function THTMLWriter.CreatePara(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'p');
- end;
- function THTMLWriter.CreateH1(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'h1');
- end;
- function THTMLWriter.CreateH2(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'h2');
- end;
- function THTMLWriter.CreateH3(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'h3');
- end;
- function THTMLWriter.CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
- begin
- Result := CreateEl(Parent, 'table');
- Result['cellspacing'] := '0';
- Result['cellpadding'] := '0';
- if AClass <> '' then
- Result['class'] := AClass;
- end;
- function THTMLWriter.CreateContentTable(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'table');
- end;
- function THTMLWriter.CreateTR(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'tr');
- end;
- function THTMLWriter.CreateTD(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'td');
- end;
- function THTMLWriter.CreateTD_vtop(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'td');
- Result['valign'] := 'top';
- end;
- function THTMLWriter.CreateLink(Parent: TDOMNode;
- const AHRef: DOMString): THTMLElement;
- begin
- Result := CreateEl(Parent, 'a');
- Result['href'] := FixHtmlPath(AHRef);
- end;
- function THTMLWriter.CreateAnchor(Parent: TDOMNode;
- const AName: DOMString): THTMLElement;
- begin
- Result := CreateEl(Parent, 'a');
- Result['name'] := AName;
- end;
- function THTMLWriter.CreateCode(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(CreateEl(Parent, 'tt'), 'span');
- Result['class'] := 'code';
- end;
- function THTMLWriter.CreateWarning(Parent: TDOMNode): THTMLElement;
- begin
- Result := CreateEl(Parent, 'span');
- Result['class'] := 'warning';
- end;
- procedure THTMLWriter.DescrEmitNotesHeader(AContext: TPasElement);
- begin
- AppendText(CreateH2(BodyElement), SDocNotes);
- PushOutputNode(BodyElement);
- end;
- procedure THTMLWriter.DescrEmitNotesFooter(AContext: TPasElement);
- begin
- PopOutPutNode;
- end;
- procedure THTMLWriter.PushOutputNode(ANode: TDOMNode);
- begin
- OutputNodeStack.Add(CurOutputNode);
- CurOutputNode := ANode;
- end;
- procedure THTMLWriter.PopOutputNode;
- begin
- CurOutputNode := TDOMNode(OutputNodeStack[OutputNodeStack.Count - 1]);
- OutputNodeStack.Delete(OutputNodeStack.Count - 1);
- end;
- procedure THTMLWriter.DescrWriteText(const AText: DOMString);
- begin
- AppendText(CurOutputNode, AText);
- end;
- procedure THTMLWriter.DescrBeginBold;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'b'));
- end;
- procedure THTMLWriter.DescrEndBold;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginItalic;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'i'));
- end;
- procedure THTMLWriter.DescrEndItalic;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginEmph;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'em'));
- end;
- procedure THTMLWriter.DescrEndEmph;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
- Var
- Pel,Cel,Lel : TDOMNode;
- El :TDomElement;
- D : String;
- L : Integer;
-
- begin
- // Determine parent node.
- If (ACaption='') then
- Pel:=CurOutputNode
- else
- begin
- Cel:=CreateTable(CurOutputNode, 'imagetable');
- Pel:=CreateTD(CreateTR(Cel));
- Cel:=CreateTD(CreateTR(Cel));
- El := CreateEl(Cel, 'span');
- El['class'] := 'imagecaption';
- Cel := El;
- If (ALinkName<>'') then
- Cel:=CreateAnchor(Cel,ALinkName);
- AppendText(Cel,ACaption);
- end;
- // Determine URL for image.
- If (Module=Nil) then
- D:=Allocator.GetRelativePathToTop(Package)
- else
- D:=Allocator.GetRelativePathToTop(Module);
- L:=Length(D);
- If (L>0) and (D[L]<>'/') then
- D:=D+'/';
- // Create image node.
- El:=CreateEl(Pel,'img');
- EL['src']:=D + BaseImageURL + AFileName;
- El['alt']:=ACaption;
- //cache image filename, so it can be used later (CHM)
- FImageFileList.Add(BaseImageURL + AFileName);
- end;
- procedure THTMLWriter.DescrWriteFileEl(const AText: DOMString);
- var
- NewEl: TDOMElement;
- begin
- NewEl := CreateEl(CurOutputNode, 'span');
- NewEl['class'] := 'file';
- AppendText(NewEl, AText);
- end;
- procedure THTMLWriter.DescrWriteKeywordEl(const AText: DOMString);
- var
- NewEl: TDOMElement;
- begin
- NewEl := CreateEl(CurOutputNode, 'span');
- NewEl['class'] := 'kw';
- AppendText(NewEl, AText);
- end;
- procedure THTMLWriter.DescrWriteVarEl(const AText: DOMString);
- begin
- AppendText(CreateEl(CurOutputNode, 'var'), AText);
- end;
- procedure THTMLWriter.DescrBeginLink(const AId: DOMString);
- var
- a,s,n : String;
- begin
- a:=AId;
- s := ResolveLinkID(a);
- if Length(s) = 0 then
- begin
- if assigned(module) then
- s:=module.name
- else
- s:='?';
- if a='' then a:='<empty>';
- if Assigned(CurrentContext) then
- N:=CurrentContext.Name
- else
- N:='?';
- DoLog(SErrUnknownLinkID, [s,n,a]);
- PushOutputNode(CreateEl(CurOutputNode, 'b'));
- end else
- PushOutputNode(CreateLink(CurOutputNode, s));
- end;
- procedure THTMLWriter.DescrEndLink;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginURL(const AURL: DOMString);
- begin
- PushOutputNode(CreateLink(CurOutputNode, AURL));
- end;
- procedure THTMLWriter.DescrEndURL;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrWriteLinebreak;
- begin
- CreateEl(CurOutputNode, 'br');
- end;
- procedure THTMLWriter.DescrBeginParagraph;
- begin
- PushOutputNode(CreatePara(CurOutputNode));
- end;
- procedure THTMLWriter.DescrEndParagraph;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String);
- begin
- DoPasHighlighting := (AHighlighterName = '') or (AHighlighterName = 'Pascal');
- HighlighterFlags := 0;
- PushOutputNode(CreateEl(CurOutputNode, 'pre'));
- end;
- procedure THTMLWriter.DescrWriteCodeLine(const ALine: String);
- begin
- if DoPasHighlighting then
- begin
- HighlighterFlags := AppendPasSHFragment(CurOutputNode, ALine,
- HighlighterFlags);
- AppendText(CurOutputNode, #10);
- end else
- AppendText(CurOutputNode, ALine + #10);
- end;
- procedure THTMLWriter.DescrEndCode;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginOrderedList;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'ol'));
- end;
- procedure THTMLWriter.DescrEndOrderedList;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginUnorderedList;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'ul'));
- end;
- procedure THTMLWriter.DescrEndUnorderedList;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginDefinitionList;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'dl'));
- end;
- procedure THTMLWriter.DescrEndDefinitionList;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginListItem;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'li'));
- end;
- procedure THTMLWriter.DescrEndListItem;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginDefinitionTerm;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'dt'));
- end;
- procedure THTMLWriter.DescrEndDefinitionTerm;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginDefinitionEntry;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'dd'));
- end;
- procedure THTMLWriter.DescrEndDefinitionEntry;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginSectionTitle;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'h3'));
- end;
- procedure THTMLWriter.DescrBeginSectionBody;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrEndSection;
- begin
- end;
- procedure THTMLWriter.DescrBeginRemark;
- var
- NewEl, TDEl: TDOMElement;
- begin
- NewEl := CreateEl(CurOutputNode, 'table');
- NewEl['width'] := '100%';
- NewEl['border'] := '0';
- NewEl['CellSpacing'] := '0';
- NewEl['class'] := 'remark';
- NewEl := CreateTR(NewEl);
- TDEl := CreateTD(NewEl);
- TDEl['valign'] := 'top';
- TDEl['class'] := 'pre';
- AppendText(CreateEl(TDEl, 'b'), SDocRemark);
- PushOutputNode(CreateTD(NewEl));
- end;
- procedure THTMLWriter.DescrEndRemark;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
- var
- Table: TDOMElement;
- begin
- Table := CreateEl(CurOutputNode, 'table');
- Table['border'] := IntToStr(Ord(HasBorder));
- PushOutputNode(Table);
- end;
- procedure THTMLWriter.DescrEndTable;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginTableCaption;
- begin
- PushOutputNode(CreateEl(CurOutputNode, 'caption'));
- end;
- procedure THTMLWriter.DescrEndTableCaption;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginTableHeadRow;
- begin
- PushOutputNode(CreateTr(CurOutputNode));
- InsideHeadRow := True;
- end;
- procedure THTMLWriter.DescrEndTableHeadRow;
- begin
- InsideHeadRow := False;
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginTableRow;
- begin
- PushOutputNode(CreateTR(CurOutputNode));
- end;
- procedure THTMLWriter.DescrEndTableRow;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.DescrBeginTableCell;
- begin
- if InsideHeadRow then
- PushOutputNode(CreateEl(CurOutputNode, 'th'))
- else
- PushOutputNode(CreateTD(CurOutputNode));
- end;
- procedure THTMLWriter.DescrEndTableCell;
- begin
- PopOutputNode;
- end;
- procedure THTMLWriter.AppendText(Parent: TDOMNode; const AText: DOMString);
- begin
- Parent.AppendChild(Doc.CreateTextNode(AText));
- end;
- procedure THTMLWriter.AppendNbSp(Parent: TDOMNode; ACount: Integer);
- begin
- while ACount > 0 do
- begin
- Parent.AppendChild(Doc.CreateEntityReference('nbsp'));
- Dec(ACount);
- end;
- end;
- procedure THTMLWriter.AppendSym(Parent: TDOMNode; const AText: DOMString);
- var
- El: TDOMElement;
- begin
- El := CreateEl(Parent, 'span');
- El['class'] := 'sym';
- AppendText(El, AText);
- end;
- procedure THTMLWriter.AppendKw(Parent: TDOMNode; const AText: DOMString);
- var
- El: TDOMElement;
- begin
- El := CreateEl(Parent, 'span');
- El['class'] := 'kw';
- AppendText(El, AText);
- end;
- function THTMLWriter.AppendPasSHFragment(Parent: TDOMNode;
- const AText: String; AShFlags: Byte): Byte;
- var
- Line, Last, p: PChar;
- IsInSpecial: Boolean;
- lastwasasm : boolean;
- El: TDOMElement;
- Procedure MaybeOutput;
- Var
- CurParent: TDomNode;
- begin
- If (Last<>Nil) then
- begin
- If (el<>Nil) then
- CurParent:=El
- else
- CurParent:=Parent;
- AppendText(CurParent,Last);
- El:=Nil;
- Last:=Nil;
- end;
- end;
- Function NewEl(Const ElType,Attr,AttrVal : String) : TDomElement;
- begin
- Result:=CreateEl(Parent,ElType);
- Result[Attr]:=AttrVal;
- end;
- Function NewSpan(Const AttrVal : String) : TDomElement;
- begin
- Result:=CreateEl(Parent,'span');
- Result['class']:=AttrVal;
- end;
- begin
- GetMem(Line, Length(AText) * 3 + 4);
- Try
- DoPascalHighlighting(AShFlags, PChar(AText), Line);
- Result := AShFlags;
- IsInSpecial := False;
- Last := Nil;
- p := Line;
- el:=nil;
- while p[0] <> #0 do
- begin
- if p[0] = LF_ESCAPE then
- begin
- p[0] := #0;
- MaybeOutput;
- case Ord(p[1]) of
- shDefault: El:=Nil;
- shInvalid: El:=newel('font','color','red');
- shSymbol : El:=newspan('sym');
- shKeyword: El:=newspan('kw');
- shComment: El:=newspan('cmt');
- shDirective: El:=newspan('dir');
- shNumbers: El:=newspan('num');
- shCharacters: El:=newspan('chr');
- shStrings: El:=newspan('str');
- shAssembler: El:=newspan('asm');
- end;
- Inc(P);
- end
- else If (Last=Nil) then
- Last:=P;
- Inc(p);
- end;
- MaybeOutput;
- Finally
- FreeMem(Line);
- end;
- end;
- Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
- Var
- N : TDocNode;
- begin
- if Assigned(DocNode) then
- begin
- If (DocNode.Link<>'') then
- begin
- N:=Engine.FindLinkedNode(DocNode);
- If (N<>Nil) then
- DocNode:=N;
- end;
- If Assigned(DocNode.ShortDescr) then
- begin
- PushOutputNode(Parent);
- try
- if not ConvertShort(AContext,TDomElement(DocNode.ShortDescr)) then
- Warning(AContext, SErrInvalidShortDescr)
- finally
- PopOutputNode;
- end;
- end;
- end;
- end;
- procedure THTMLWriter.AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
- begin
- AppendShortDescr(Element,Parent,Engine.FindDocNode(Element));
- end;
- procedure THTMLWriter.AppendShortDescrCell(Parent: TDOMNode;
- Element: TPasElement);
- var
- ParaEl: TDOMElement;
- begin
- if Assigned(Engine.FindShortDescr(Element)) then
- begin
- AppendNbSp(CreatePara(CreateTD(Parent)), 2);
- ParaEl := CreatePara(CreateTD(Parent));
- ParaEl['class'] := 'cmt';
- AppendShortDescr(ParaEl, Element);
- end;
- end;
- procedure THTMLWriter.AppendDescr(AContext: TPasElement; Parent: TDOMNode;
- DescrNode: TDOMElement; AutoInsertBlock: Boolean);
- begin
- if Assigned(DescrNode) then
- begin
- PushOutputNode(Parent);
- try
- ConvertDescr(AContext, DescrNode, AutoInsertBlock);
- finally
- PopOutputNode;
- end;
- end;
- end;
- procedure THTMLWriter.AppendDescrSection(AContext: TPasElement;
- Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString);
- begin
- if not IsDescrNodeEmpty(DescrNode) then
- begin
- If (ATitle<>'') then // Can be empty for topic.
- AppendText(CreateH2(Parent), ATitle);
- AppendDescr(AContext, Parent, DescrNode, True);
- end;
- end;
- function THTMLWriter.AppendHyperlink(Parent: TDOMNode;
- Element: TPasElement): TDOMElement;
- var
- s: String;
- UnitList: TFPList;
- i: Integer;
- ThisPackage: TLinkNode;
- begin
- if Assigned(Element) then
- begin
- if Element.InheritsFrom(TPasUnresolvedTypeRef) then
- begin
- s := ResolveLinkID(Element.Name);
- if Length(s) = 0 then
- begin
- { Try all packages }
- ThisPackage := Engine.RootLinkNode.FirstChild;
- while Assigned(ThisPackage) do
- begin
- s := ResolveLinkID(ThisPackage.Name + '.' + Element.Name);
- if Length(s) > 0 then
- break;
- ThisPackage := ThisPackage.NextSibling;
- end;
- if Length(s) = 0 then
- begin
- { Okay, then we have to try all imported units of the current module }
- UnitList := Module.InterfaceSection.UsesList;
- for i := UnitList.Count - 1 downto 0 do
- begin
- { Try all packages }
- ThisPackage := Engine.RootLinkNode.FirstChild;
- while Assigned(ThisPackage) do
- begin
- s := ResolveLinkID(ThisPackage.Name + '.' +
- TPasType(UnitList[i]).Name + '.' + Element.Name);
- if Length(s) > 0 then
- break;
- ThisPackage := ThisPackage.NextSibling;
- end;
- if length(s)=0 then
- s := ResolveLinkID('#rtl.System.' + Element.Name);
- if Length(s) > 0 then
- break;
- end;
- end;
- end;
- end else if Element is TPasEnumValue then
- s := ResolveLinkID(Element.Parent.PathName)
- else
- s := ResolveLinkID(Element.PathName);
- if Length(s) > 0 then
- begin
- Result := CreateLink(Parent, s);
- AppendText(Result, Element.Name);
- end else
- begin
- Result := nil;
- AppendText(Parent, Element.Name);
- end;
- end else
- begin
- Result := nil;
- AppendText(CreateWarning(Parent), '<NIL>');
- 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;
- 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);
- case Arg.Access of
- argConst: AppendKw(CodeEl, 'const ');
- argVar: AppendKw(CodeEl, 'var ');
- argOut: AppendKw(CodeEl, 'out ');
- end;
- 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 then
- begin
- AppendText(CodeEl, ' ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, AProc.Name);
- end 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, TDEl: TDOMElement;
- CurVariant: TPasVariant;
- 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');
- 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.VariantType) then
- begin
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendNbSp(CodeEl, NestingLevel * 2 + 2);
- AppendKw(CodeEl, 'case ');
- if TPasRecordType(Element).VariantName <> '' then
- begin
- AppendText(CodeEl, TPasRecordType(Element).VariantName);
- AppendSym(CodeEl, ': ');
- end;
- CodeEl := AppendType(CodeEl, TableEl, TPasRecordType(Element).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.AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []);
- Var
- T : String;
- begin
- T:=AText;
- if (Hints<>[]) then
- T:=T+' ('+Engine.HintsToStr(Hints)+')';
- AppendText(TitleElement, AText);
- AppendText(CreateH1(BodyElement), T);
- 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(BodyElement, '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;
- procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
- var
- TableEl, TREl, 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(BodyElement, '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(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);
- end
- else
- begin
- AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
- AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
- 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(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;
- procedure THTMLWriter.AppendSourceRef(AElement: TPasElement);
- begin
- AppendText(CreatePara(BodyElement), Format(SDocSourcePosition,
- [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
- end;
- Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
- var
- Node: TDOMNode;
- TableEl, El, TREl, TDEl, ParaEl, NewEl, DescrEl: TDOMElement;
- l,s,n: String;
- f: Text;
- IsFirstSeeAlso : Boolean;
- begin
- if Not (Assigned(DocNode) and Assigned(DocNode.SeeAlso)) then
- Exit;
- IsFirstSeeAlso := True;
- Node:=DocNode.SeeAlso.FirstChild;
- While Assigned(Node) do
- begin
- if (Node.NodeType=ELEMENT_NODE) and (Node.NodeName='link') then
- begin
- if IsFirstSeeAlso then
- begin
- IsFirstSeeAlso := False;
- AppendText(CreateH2(BodyElement), SDocSeeAlso);
- TableEl := CreateTable(BodyElement);
- end;
- El:=TDOMElement(Node);
- TREl:=CreateTR(TableEl);
- ParaEl:=CreatePara(CreateTD_vtop(TREl));
- l:=El['id'];
- s:= ResolveLinkID(l);
- if Length(s)=0 then
- begin
- if assigned(module) then
- s:=module.name
- else
- s:='?';
- if l='' then l:='<empty>';
- if Assigned(AElement) then
- N:=AElement.Name
- else
- N:='?';
- DoLog(SErrUnknownLinkID, [s,N,l]);
- NewEl := CreateEl(ParaEl,'b')
- end
- else
- NewEl := CreateLink(ParaEl,s);
- if Not IsDescrNodeEmpty(El) then
- begin
- PushOutputNode(NewEl);
- Try
- ConvertBaseShortList(AElement, El, True)
- Finally
- PopOutputNode;
- end;
- end
- else
- AppendText(NewEl,El['id']);
- l:=El['id'];
- DescrEl := Engine.FindShortDescr(ModuleForElement(AElement),L);
- if Assigned(DescrEl) then
- begin
- AppendNbSp(CreatePara(CreateTD(TREl)), 2);
- ParaEl := CreatePara(CreateTD(TREl));
- ParaEl['class'] := 'cmt';
- PushOutputNode(ParaEl);
- try
- ConvertShort(AElement, DescrEl);
- finally
- PopOutputNode;
- end;
- end;
- end; // Link node
- Node := Node.NextSibling;
- end; // While
- end;
- Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
- var
- Node: TDOMNode;
- // TableEl, El, TREl, TDEl, ParaEl, NewEl, DescrEl: TDOMElement;
- fn,s: String;
- f: Text;
- begin
- if not (Assigned(DocNode) and Assigned(DocNode.FirstExample)) then
- Exit;
- Node := DocNode.FirstExample;
- while Assigned(Node) do
- begin
- if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'example') then
- begin
- fn:=Engine.GetExampleFilename(TDOMElement(Node));
- If (fn<>'') then
- begin
- AppendText(CreateH2(BodyElement), SDocExample);
- try
- Assign(f, FN);
- Reset(f);
- try
- PushOutputNode(BodyElement);
- DescrBeginCode(False, TDOMElement(Node)['highlighter']);
- while not EOF(f) do
- begin
- ReadLn(f, s);
- DescrWriteCodeLine(s);
- end;
- DescrEndCode;
- PopOutputNode;
- finally
- Close(f);
- end;
- except
- on e: Exception do
- begin
- e.Message := '[example] ' + e.Message;
- raise;
- end;
- end;
- end;
- end;
- Node := Node.NextSibling;
- end;
- end;
- procedure THTMLWriter.AppendFooter;
- Var
- S : String;
- F : TDomElement;
- begin
- if FooterFile<>'' then
- ReadXMLFragment(BodyElement, FooterFile)
- else if IncludeDateInFooter then
- begin
- CreateEl(BodyElement, 'hr');
- F:=CreateEl(BodyElement,'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 Assigned(DocNode) then
- begin
- // Description
- if Assigned(DocNode.Descr) then
- AppendDescrSection(AElement, BodyElement, DocNode.Descr, SDocDescription);
- // Append "Errors" section
- if Assigned(DocNode.ErrorsDoc) then
- AppendDescrSection(AElement, BodyElement, DocNode.ErrorsDoc, SDocErrors);
- // Append Version info
- if Assigned(DocNode.Version) then
- AppendDescrSection(AElement, BodyElement, DocNode.Version, SDocVersion);
- // Append "See also" section
- AppendSeeAlsoSection(AElement,DocNode);
- // Append examples, if present
- AppendExampleSection(AElement,DocNode);
- // Append notes, if present
- ConvertNotes(AElement,DocNode.Notes);
- end;
- end;
- Procedure THTMLWriter.CreateTopicPageBody(AElement : TTopicElement);
- var
- DocNode: TDocNode;
- TableEl, TREl: TDOMElement;
- I : Integer;
- S : String;
- 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(BodyElement), DocNode);
- if Assigned(DocNode.Descr) then
- AppendDescrSection(AElement, BodyElement, DocNode.Descr, '');
- AppendSeeAlsoSection(AElement,DocNode);
- CreateTopicLinks(DocNode,AElement);
- AppendExampleSection(AElement,DocNode);
- ConvertNotes(AElement,DocNode.Notes);
- end;
- end;
- procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean);
- 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;
- Procedure AppendClass(E : TDomElement);
- Var
- N : TDomNode;
- P,PM : TPasElement;
- NN : String;
- EN : String;
- LL : TstringList;
- I,J : Integer;
- begin
- EN:=Package.Name+'.'+E['unit']+'.'+E.NodeName;
- J:=AList.IndexOf(EN);
- If J<>-1 then
- P:=AList.Objects[J] as TPasElement
- else
- P:=Engine.FindElement(EN);
- PushClassElement;
- try
- if (P<>Nil) then
- begin
- AppendHyperLink(CurOutputNode,P);
- PM:=ModuleForElement(P);
- if (PM<>Nil) then
- begin
- AppendText(CurOutputNode,' (');
- AppendHyperLink(CurOutputNode,PM);
- AppendText(CurOutputNode,')');
- end
- end
- else
- AppendText(CurOutputNode,E.Nodename);
- LL:=TStringList.Create;
- try
- N:=E.FirstChild;
- While (N<>Nil) do
- begin
- if (N.NodeType=ELEMENT_NODE) then
- LL.AddObject(N.NodeName,N);
- N:=N.NextSibling;
- end;
- if (LL.Count>0) then
- begin
- LL.Sorted:=true;
- PushClassList;
- try
- For I:=0 to LL.Count-1 do
- AppendClass(LL.Objects[i] as TDomElement);
- finally
- PopOutputNode;
- end;
- end;
- finally
- LL.Free;
- end;
- Finally
- PopOutputNode;
- end;
- end;
- Var
- B : TClassTreeBuilder;
- E : TDomElement;
- F : TFileStream;
- begin
- PushOutputNode(BodyElement);
- try
- B:=TClassTreeBuilder.Create(Package,okClass);
- try
- B.BuildTree(AList);
- // Classes
- WriteXMLFile(B.ClassTree,'tree.xml');
- // Dummy TObject
- E:=B.ClassTree.DocumentElement;
- PushClassList;
- try
- AppendClass(E);
- finally
- PopOutputNode;
- end;
- finally
- B.Free;
- end;
- 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
- L : TStringList;
- I : Integer;
- M : TPasModule;
- E : TPasElement;
- S : String;
- SE : THTMLElement;
- begin
- SE := Doc.CreateElement('script');
- AppendText(SE,SFunc);
- HeadElement.AppendChild(SE);
- 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]);
- if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
- Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
- end;
- AppendMenuBar(ClassHierarchySubIndex);
- S:=Package.Name;
- If Length(S)>0 then
- Delete(S,1,1);
- AppendTitle(Format(SDocPackageClassHierarchy, [S]));
- CreateClassHierarchyPage(L,True);
- Finally
- L.Free;
- end;
- 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
- writeln('Unknown classtype: ',AElement.classtype.classname);
- end;
- end;
- procedure THTMLWriter.CreateIndexPage(L : TStringList);
- Var
- Lists : Array['A'..'Z'] of TStringList;
- LOther : 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(BodyElement);
- 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,'#SECTION'+C),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(BodyElement);
- AppendText(El,C);
- CreateAnchor(El,'SECTION'+C);
- TableEl := CreateTable(BodyElement);
- 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.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
- Var
- I : Integer;
- El : TPasElement;
- begin
- For I:=0 to List.Count-1 do
- begin
- El:=TPasElement(List[I]);
- if UsePathName then
- L.AddObject(El.PathName,El)
- else
- L.AddObject(El.Name,El);
- If el is TPasEnumType then
- AddElementsFromList(L,TPasEnumType(el).Values);
- end;
- end;
- procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
- begin
- if assigned(AModule.InterfaceSection) Then
- begin
- AddElementsFromList(L,AModule.InterfaceSection.Consts);
- AddElementsFromList(L,AModule.InterfaceSection.Types);
- AddElementsFromList(L,AModule.InterfaceSection.Functions);
- AddElementsFromList(L,AModule.InterfaceSection.Classes);
- AddElementsFromList(L,AModule.InterfaceSection.Variables);
- AddElementsFromList(L,AModule.InterfaceSection.ResStrings);
- end;
- end;
- procedure THTMLWriter.CreatePackageIndex;
- Var
- L : TStringList;
- I : Integer;
- M : TPasModule;
- E : TPasElement;
- 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(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(Format(SDocPackageTitle, [Copy(Package.Name, 2, 256)]));
- AppendShortDescr(CreatePara(BodyElement), Package);
- AppendText(CreateH2(BodyElement), SDocUnits);
- TableEl := CreateTable(BodyElement);
- 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, BodyElement, DocNode.Descr, 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(BodyElement), SDocRelatedTopics);
- TableEl := CreateTable(BodyElement);
- 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(Format(SDocModuleIndex, [AModule.Name]));
- CreateIndexPage(L);
- Finally
- L.Free;
- end;
- end;
- procedure THTMLWriter.CreateModulePageBody(AModule: TPasModule;
- ASubpageIndex: Integer);
- procedure CreateMainPage;
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- i: Integer;
- UnitRef: TPasType;
- DocNode: TDocNode;
- begin
- AppendMenuBar(0);
- AppendTitle(Format(SDocUnitTitle, [AModule.Name]),AModule.Hints);
- AppendShortDescr(CreatePara(BodyElement), AModule);
- if AModule.InterfaceSection.UsesList.Count > 0 then
- begin
- TableEl := CreateTable(BodyElement);
- 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, BodyElement, DocNode.Descr, SDocOverview);
- ConvertNotes(AModule,DocNode.Notes);
- CreateTopicLinks(DocNode,AModule);
- end;
- end;
- procedure CreateSimpleSubpage(const ATitle: DOMString; AList: TFPList);
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- i, j: Integer;
- Decl: TPasElement;
- SortedList: TFPList;
- DocNode: TDocNode;
- S : String;
- begin
- AppendMenuBar(ASubpageIndex);
- S:=ATitle;
- AppendTitle(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(BodyElement);
- 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 CreateResStringsPage;
- var
- ParaEl: TDOMElement;
- i, j: Integer;
- Decl: TPasResString;
- DocNode: TDocNode;
- begin
- AppendMenuBar(ResstrSubindex);
- AppendTitle(Format(SDocUnitTitle + ': %s', [AModule.Name, SDocResStrings]));
- for i := 0 to AModule.InterfaceSection.ResStrings.Count - 1 do
- begin
- Decl := TPasResString(AModule.InterfaceSection.ResStrings[i]);
- CreateEl(BodyElement, 'a')['name'] := LowerCase(Decl.Name);
- ParaEl := CreatePara(BodyElement);
- AppendText(CreateCode(ParaEl), Decl.Name);
- CreateEl(ParaEl, 'br');
- AppendText(ParaEl, Decl.Expr.getDeclaration(true));
- end;
- end;
-
- begin
- case ASubpageIndex of
- 0:
- CreateMainPage;
- ResstrSubindex:
- CreateResStringsPage;
- ConstsSubindex:
- CreateSimpleSubpage(SDocConstants, AModule.InterfaceSection.Consts);
- TypesSubindex:
- CreateSimpleSubpage(SDocTypes, AModule.InterfaceSection.Types);
- ClassesSubindex:
- CreateSimpleSubpage(SDocClasses, AModule.InterfaceSection.Classes);
- ProcsSubindex:
- CreateSimpleSubpage(SDocProceduresAndFunctions, AModule.InterfaceSection.Functions);
- VarsSubindex:
- CreateSimpleSubpage(SDocVariables, AModule.InterfaceSection.Variables);
- IndexSubIndex:
- CreateModuleIndexPage(AModule);
- end;
- end;
- procedure THTMLWriter.CreateConstPageBody(AConst: TPasConst);
- var
- TableEl, CodeEl: TDOMElement;
- begin
- AppendMenuBar(-1);
- AppendTitle(AConst.Name,AConst.Hints);
- AppendShortDescr(CreatePara(BodyElement), AConst);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AConst);
- TableEl := CreateTable(BodyElement);
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- AppendKw(CodeEl, 'const');
- AppendText(CodeEl, ' ' + 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;
- Variable: TPasVariable;
- 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(BodyElement, 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;
- i: Integer;
- s: String;
- EnumType: TPasEnumType;
- EnumValue: TPasEnumValue;
- Variable: TPasVariable;
- begin
- AppendMenuBar(-1);
- AppendTitle(AType.Name,AType.Hints);
- AppendShortDescr(CreatePara(BodyElement), AType);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AType);
- TableEl := CreateTable(BodyElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- DocNode := Engine.FindDocNode(AType);
- AppendKw(CodeEl, 'type ');
- AppendText(CodeEl, AType.Name);
- AppendSym(CodeEl, ' = ');
- If Assigned(DocNode) and
- Assigned(DocNode.Node) and
- (Docnode.Node['opaque']='1') then
- AppendText(CodeEl,SDocOpaque)
- else
- begin
- AppendTypeDecl(AType,TableEl,CodeEl);
- end;
- FinishElementPage(AType);
- end;
- function PropertyFilter(AMember: TPasElement): Boolean;
- begin
- Result := (AMember.ClassType = TPasProperty) and
- (Copy(AMember.Name, 1, 2) <> 'On');
- end;
- function MethodFilter(AMember: TPasElement): Boolean;
- begin
- Result := AMember.InheritsFrom(TPasProcedureBase);
- end;
- function EventFilter(AMember: TPasElement): Boolean;
- begin
- Result := (AMember.ClassType = TPasProperty) and
- (Copy(AMember.Name, 1, 2) = 'On');
- end;
- procedure THTMLWriter.CreateClassPageBody(AClass: TPasClassType;
- ASubpageIndex: Integer);
- type
- TMemberFilter = function(AMember: TPasElement): Boolean;
- var
- ParaEl: TDOMElement;
- procedure AppendMemberListLink(AListSubpageIndex: Integer;
- const AText: DOMString);
- var
- LinkEl: TDOMElement;
- begin
- if FUseMenuBrackets then
- AppendText(ParaEl, '[');
- LinkEl := CreateEl(ParaEl, 'a');
- LinkEl['href'] :=
- 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'] :=
- 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, SDocByName);
- AppendText(ParaEl, ')');
- if FUseMenuBrackets then
- AppendText(ParaEl, '] ')
- else
- AppendText(ParaEl, ' ');
- end;
- 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,TPasGenericTemplateType(AList[i]).Name);
- end;
- AppendSym(CodeEl, '>');
- end;
- procedure CreateMainPage;
- var
- TableEl, TREl, TDEl, CodeEl: TDOMElement;
- DocNode: TDocNode;
- Member: TPasElement;
- MVisibility,
- CurVisibility: TPasMemberVisibility;
- i: Integer;
- s: String;
- t : TPasType;
- ah,ol,wt,ct,wc,cc : boolean;
- ThisInterface,
- ThisClass: TPasClassType;
- HaveSeenTObject: Boolean;
- LName : String;
- ThisNode : TPasUnresolvedTypeRef;
- begin
- AppendMenuBar(-1);
- AppendTitle(AClass.Name,AClass.Hints);
- ParaEl := CreatePara(BodyElement);
- AppendMemberListLink(PropertiesByInheritanceSubindex, SDocProperties);
- AppendMemberListLink(MethodsByInheritanceSubindex, SDocMethods);
- AppendMemberListLink(EventsByInheritanceSubindex, SDocEvents);
- AppendShortDescr(CreatePara(BodyElement), AClass);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AClass);
- TableEl := CreateTable(BodyElement);
- TREl := CreateTR(TableEl);
- TDEl := CreateTD(TREl);
- CodeEl := CreateCode(CreatePara(TDEl));
- AppendKw(CodeEl, 'type');
- if AClass.ObjKind=okGeneric then
- AppendKw(CodeEl, ' generic ');
- AppendText(CodeEl, ' ' + AClass.Name + ' ');
- if AClass.ObjKind=okGeneric then
- AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,false);
- AppendSym(CodeEl, '=');
- AppendText(CodeEl, ' ');
- if AClass.ObjKind<>okSpecialize then
- AppendKw(CodeEl, ObjKindNames[AClass.ObjKind])
- else
- AppendKw(CodeEl, ' specialize ');
- if Assigned(AClass.AncestorType) then
- begin
- if AClass.ObjKind=okSpecialize then
- begin
- AppendHyperlink(CodeEl, AClass.AncestorType);
- AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,true)
- end
- else
- begin
- AppendSym(CodeEl, '(');
- AppendHyperlink(CodeEl, AClass.AncestorType);
- if AClass.Interfaces.count>0 Then
- begin
- for i:=0 to AClass.interfaces.count-1 do
- begin
- AppendSym(CodeEl, ', ');
- AppendHyperlink(CodeEl,TPasClassType(AClass.Interfaces[i]));
- end;
- end;
- AppendSym(CodeEl, ')');
- end;
- end;
- if AClass.Members.Count > 0 then
- begin
- wt:=False;
- wc:=False;
- CurVisibility := visDefault;
- for i := 0 to AClass.Members.Count - 1 do
- begin
- Member := TPasElement(AClass.Members[i]);
- MVisibility:=Member.Visibility;
- 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) then
- begin
- CurVisibility := MVisibility;
- s:=VisibilityNames[MVisibility];
- AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), s);
- end;
- ct:=(Member is TPasType);
- if ct and (not wt) then
- begin
- AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Type');
- end;
- wt:=ct;
- cc:=(Member is TPasConst);
- if cc and (not wc) then
- begin
- AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Const');
- end;
- wc:=cc;
- TREl := CreateTR(TableEl);
- CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
- AppendNbSp(CodeEl, 2);
- AppendShortDescrCell(TREl, Member);
- if (Member is TPasProcedureBase) then
- begin
- AppendKw(CodeEl, 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(Member),TableEl,CodeEl);
- end;
- AppendSym(CodeEl, ' = ');
- AppendText(CodeEl,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(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, ' '+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, ' [' + s + ']');
- end
- else if (Member is TPasVariable) then
- begin
- AppendHyperlink(CodeEl, Member);
- AppendSym(CodeEl, ': ');
- AppendHyperlink(CodeEl, TPasVariable(Member).VarType);
- AppendSym(CodeEl, ';');
- end
- else
- AppendText(CreateWarning(CodeEl), '<' + Member.ClassName + '>');
- if (Member.Hints<>[]) then
- begin
- AppendKW(CodeEl,' '+Engine.HintsToStr(Member.Hints));
- AppendText(CodeEl, ' ');
- AppendSym(CodeEl, ';');
- end;
- end;
- CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
- end;
- AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
- if not AClass.IsShortDefinition then
- AppendKw(CodeEl, 'end');
- AppendSym(CodeEl, ';');
- AppendText(CreateH2(BodyElement), SDocInheritance);
- TableEl := CreateTable(BodyElement);
- HaveSeenTObject := AClass.ObjKind <> okClass;
- // we try to track classes. But imported classes
- // are TLinkNode's not the TPasClassType generated by the parser.
- ThisClass := AClass; ThisNode := Nil;
- while True do
- begin
- TREl := CreateTR(TableEl);
- TDEl := CreateTD_vtop(TREl);
- TDEl['align'] := 'center';
- CodeEl := CreateCode(CreatePara(TDEl));
- if Assigned(ThisClass) then
- LName:=ThisClass.Name
- Else
- LName:=ThisNode.Name;
- if Assigned(ThisClass) Then
- AppendHyperlink(CodeEl, ThisClass)
- else
- AppendHyperlink(CodeEl, ThisNode);
- if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
- begin
- for i:=0 to ThisClass.interfaces.count-1 do
- begin
- ThisInterface:=TPasClassType(ThisClass.Interfaces[i]);
- AppendText(CodeEl,',');
- AppendHyperlink(CodeEl, ThisInterface);
- end;
- end;
- AppendShortDescrCell(TREl, ThisClass);
- if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then
- HaveSeenTObject := True
- else
- begin
- TDEl := CreateTD(CreateTR(TableEl));
- TDEl['align'] := 'center';
- AppendText(TDEl, '|');
- end;
- if Assigned(ThisClass.AncestorType) then
- begin
- if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
- ThisClass := TPasClassType(ThisClass.AncestorType)
- else
- begin
- if thisclass.ancestortype is TPasUnresolvedTypeRef then
- thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
- TDEl := CreateTD(CreateTR(TableEl));
- TDEl['align'] := 'center';
- AppendText(CreateCode(CreatePara(TDEl)), ThisClass.AncestorType.Name);
- if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then
- HaveSeenTObject := True
- else
- begin
- TDEl := CreateTD(CreateTR(TableEl));
- TDEl['align'] := 'center';
- AppendText(TDEl, '?');
- end;
- break;
- end
- end else
- break;
- end;
- if not HaveSeenTObject then
- begin
- TDEl := CreateTD(CreateTR(TableEl));
- TDEl['align'] := 'center';
- AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
- end;
- FinishElementPage(AClass);
- end;
- procedure CreateInheritanceSubpage(AFilter: TMemberFilter);
- var
- ThisClass: TPasClassType;
- i: Integer;
- Member: TPasElement;
- TableEl, TREl, TDEl, ParaEl, LinkEl: TDOMElement;
- begin
- TableEl := CreateTable(BodyElement);
- 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');
- 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 CreateSortedSubpage(AFilter: TMemberFilter);
- var
- List: TFPList;
- ThisClass: TPasClassType;
- i, j: Integer;
- Member: TPasElement;
- TableEl, TREl, TDEl, ParaEl, 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(BodyElement);
- 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');
- 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;
- begin
- case ASubpageIndex of
- 0:
- CreateMainPage;
- PropertiesByInheritanceSubindex:
- CreateInheritanceSubpage(@PropertyFilter);
- PropertiesByNameSubindex:
- CreateSortedSubpage(@PropertyFilter);
- MethodsByInheritanceSubindex:
- CreateInheritanceSubpage(@MethodFilter);
- MethodsByNameSubindex:
- CreateSortedSubpage(@MethodFilter);
- EventsByInheritanceSubindex:
- CreateInheritanceSubpage(@EventFilter);
- EventsByNameSubindex:
- CreateSortedSubpage(@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, 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, 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, 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;
- begin
- AppendKw(CodeEl, 'property ');
- AppendHyperlink(CodeEl, Element.Parent);
- AppendSym(CodeEl, '.');
- AppendText(CodeEl, Element.Name);
- 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, 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, 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, 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;
- DocNode: TDocNode;
- begin
- AppendMenuBar(-1);
- AppendTitle(AElement.FullName,AElement.Hints);
- AppendShortDescr(CreatePara(BodyElement), AElement);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AElement);
- TableEl := CreateTable(BodyElement);
- 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(BodyElement), '<' + AElement.ClassName + '>');
- FinishElementPage(AElement);
- end;
- procedure THTMLWriter.CreateVarPageBody(AVar: TPasVariable);
- var
- TableEl, TREl, TDEl, CodeEl, El: TDOMElement;
- DocNode: TDocNode;
- begin
- AppendMenuBar(-1);
- AppendTitle(AVar.FullName,AVar.Hints);
- AppendShortDescr(CreatePara(BodyElement), AVar);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AVar);
- TableEl := CreateTable(BodyElement);
- 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(AProc.Name,AProc.Hints);
- AppendShortDescr(CreatePara(BodyElement), AProc);
- AppendText(CreateH2(BodyElement), SDocDeclaration);
- AppendSourceRef(AProc);
- TableEl := CreateTable(BodyElement);
- 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;
- begin
- Result:=True;
- if Cmd = '--html-search' then
- SearchPage := Arg
- else if Cmd = '--footer' then
- FooterFile := Arg
- else if Cmd = '--charset' then
- CharSet := Arg
- else if Cmd = '--index-colcount' then
- IndexColCount := StrToIntDef(Arg,IndexColCount)
- else if Cmd = '--image-url' then
- FBaseImageURL := Arg
- else if Cmd = '--css-file' then
- FCSSFile := arg
- else if Cmd = '--footer-date' then
- begin
- FIDF:=True;
- FDateFormat:=Arg;
- end
- else if Cmd = '--disable-menu-brackets' then
- FUseMenuBrackets:=False
- else
- Result:=False;
- end;
- procedure THTMLWriter.WriteDoc;
- begin
- DoLog(SWritingPages, [PageCount]);
- WriteHTMLPages;
- end;
- class procedure THTMLWriter.Usage(List: TStrings);
- begin
- List.add('--footer');
- List.Add(SHTMLUsageFooter);
- 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);
- 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
- function THTMLWriter.GetPageCount: Integer;
- begin
- Result := PageInfos.Count;
- end;
- procedure THTMLWriter.SetOnTest(const AValue: TNotifyEvent);
- begin
- if FOnTest=AValue then exit;
- FOnTest:=AValue;
- end;
- procedure THTMLWriter.CreateAllocator;
- begin
- FAllocator:=TLongNameFileAllocator.Create('.html');
- end;
- procedure THTMWriter.CreateAllocator;
- begin
- FAllocator:=TShortNameFileAllocator.Create('.htm');
- end;
- initialization
- // Do not localize.
- RegisterWriter(THTMLWriter,'html','HTML output using fpdoc.css stylesheet.');
- RegisterWriter(THTMWriter,'htm','HTM (8.3 filenames) output using fpdoc.css stylesheet.');
- RegisterWriter(TCHMHTMLWriter,'chm','Compressed HTML file output using fpdoc.css stylesheet.');
- finalization
- UnRegisterWriter('html');
- UnRegisterWriter('htm');
- UnRegisterWriter('chm');
- end.
|