dw_html.pp 110 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963
  1. {
  2. FPDoc - Free Pascal Documentation Tool
  3. Copyright (C) 2000 - 2005 by
  4. Areca Systems GmbH / Sebastian Guenther, [email protected]
  5. * HTML/XHTML output generator
  6. See the file COPYING, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. }
  12. {$mode objfpc}
  13. {$H+}
  14. unit dw_HTML;
  15. interface
  16. uses Classes, contnrs, DOM, DOM_HTML, dGlobals, PasTree, dWriter, ChmWriter, ChmBase;
  17. const
  18. // Subpage indices for modules
  19. ResstrSubindex = 1;
  20. ConstsSubindex = 2;
  21. TypesSubindex = 3;
  22. ClassesSubindex = 4;
  23. ProcsSubindex = 5;
  24. VarsSubindex = 6;
  25. // Maybe needed later for topic overview ??
  26. TopicsSubIndex = 7;
  27. IndexSubIndex = 8;
  28. ClassHierarchySubIndex = 9;
  29. // Subpage indices for classes
  30. PropertiesByInheritanceSubindex = 1;
  31. PropertiesByNameSubindex = 2;
  32. MethodsByInheritanceSubindex = 3;
  33. MethodsByNameSubindex = 4;
  34. EventsByInheritanceSubindex = 5;
  35. EventsByNameSubindex = 6;
  36. type
  37. TFileAllocator = class
  38. public
  39. procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); virtual;
  40. function GetFilename(AElement: TPasElement;
  41. ASubindex: Integer): String; virtual; abstract;
  42. function GetRelativePathToTop(AElement: TPasElement): String; virtual;
  43. function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
  44. end;
  45. TShortNameFileAllocator = class(TFileAllocator)
  46. private
  47. FExtension: String;
  48. public
  49. constructor Create(const AExtension: String);
  50. procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); override;
  51. property Extension: String read FExtension;
  52. end;
  53. TLongNameFileAllocator = class(TFileAllocator)
  54. private
  55. FExtension: String;
  56. public
  57. constructor Create(const AExtension: String);
  58. function GetFilename(AElement: TPasElement;
  59. ASubindex: Integer): String; override;
  60. function GetRelativePathToTop(AElement: TPasElement): String; override;
  61. property Extension: String read FExtension;
  62. end;
  63. TPageInfo = class
  64. Element: TPasElement;
  65. SubpageIndex: Integer;
  66. end;
  67. { THTMLWriter }
  68. THTMLWriter = class(TFPDocWriter)
  69. private
  70. FImageFileList: TStrings;
  71. FOnTest: TNotifyEvent;
  72. FPackage: TPasPackage;
  73. FCharSet : String;
  74. procedure CreateMinusImage;
  75. procedure CreatePlusImage;
  76. function GetPageCount: Integer;
  77. procedure SetOnTest(const AValue: TNotifyEvent);
  78. protected
  79. FCSSFile: String;
  80. FAllocator: TFileAllocator;
  81. CurDirectory: String; // relative to curdir of process
  82. BaseDirectory: String; // relative path to package base directory
  83. PageInfos: TObjectList; // list of TPageInfo objects
  84. Doc: THTMLDocument;
  85. HeadElement,
  86. BodyElement, TitleElement: TDOMElement;
  87. Module: TPasModule;
  88. OutputNodeStack: TList;
  89. CurOutputNode: TDOMNode;
  90. InsideHeadRow, DoPasHighlighting: Boolean;
  91. HighlighterFlags: Byte;
  92. FooterFile: string;
  93. FIDF : Boolean;
  94. FDateFormat: String;
  95. FIndexColCount : Integer;
  96. FSearchPage : String;
  97. FBaseImageURL : String;
  98. FUseMenuBrackets: Boolean;
  99. Procedure CreateAllocator; virtual;
  100. procedure CreateCSSFile; virtual;
  101. function ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
  102. function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
  103. function ResolveLinkWithinPackage(AElement: TPasElement;
  104. ASubpageIndex: Integer): String;
  105. // Helper functions for creating DOM elements
  106. function CreateEl(Parent: TDOMNode; const AName: DOMString): THTMLElement;
  107. function CreatePara(Parent: TDOMNode): THTMLElement;
  108. function CreateH1(Parent: TDOMNode): THTMLElement;
  109. function CreateH2(Parent: TDOMNode): THTMLElement;
  110. function CreateH3(Parent: TDOMNode): THTMLElement;
  111. function CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
  112. function CreateContentTable(Parent: TDOMNode): THTMLElement;
  113. function CreateTR(Parent: TDOMNode): THTMLElement;
  114. function CreateTD(Parent: TDOMNode): THTMLElement;
  115. function CreateTD_vtop(Parent: TDOMNode): THTMLElement;
  116. function CreateLink(Parent: TDOMNode; const AHRef: DOMString): THTMLElement;
  117. function CreateAnchor(Parent: TDOMNode; const AName: DOMString): THTMLElement;
  118. function CreateCode(Parent: TDOMNode): THTMLElement;
  119. function CreateWarning(Parent: TDOMNode): THTMLElement;
  120. // Description node conversion
  121. Procedure DescrEmitNotesHeader(AContext : TPasElement); override;
  122. Procedure DescrEmitNotesFooter(AContext : TPasElement); override;
  123. procedure PushOutputNode(ANode: TDOMNode);
  124. procedure PopOutputNode;
  125. procedure DescrWriteText(const AText: DOMString); override;
  126. procedure DescrBeginBold; override;
  127. procedure DescrEndBold; override;
  128. procedure DescrBeginItalic; override;
  129. procedure DescrEndItalic; override;
  130. procedure DescrBeginEmph; override;
  131. procedure DescrEndEmph; override;
  132. procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
  133. procedure DescrWriteFileEl(const AText: DOMString); override;
  134. procedure DescrWriteKeywordEl(const AText: DOMString); override;
  135. procedure DescrWriteVarEl(const AText: DOMString); override;
  136. procedure DescrBeginLink(const AId: DOMString); override;
  137. procedure DescrEndLink; override;
  138. procedure DescrBeginURL(const AURL: DOMString); override;
  139. procedure DescrEndURL; override;
  140. procedure DescrWriteLinebreak; override;
  141. procedure DescrBeginParagraph; override;
  142. procedure DescrEndParagraph; override;
  143. procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
  144. procedure DescrWriteCodeLine(const ALine: String); override;
  145. procedure DescrEndCode; override;
  146. procedure DescrBeginOrderedList; override;
  147. procedure DescrEndOrderedList; override;
  148. procedure DescrBeginUnorderedList; override;
  149. procedure DescrEndUnorderedList; override;
  150. procedure DescrBeginDefinitionList; override;
  151. procedure DescrEndDefinitionList; override;
  152. procedure DescrBeginListItem; override;
  153. procedure DescrEndListItem; override;
  154. procedure DescrBeginDefinitionTerm; override;
  155. procedure DescrEndDefinitionTerm; override;
  156. procedure DescrBeginDefinitionEntry; override;
  157. procedure DescrEndDefinitionEntry; override;
  158. procedure DescrBeginSectionTitle; override;
  159. procedure DescrBeginSectionBody; override;
  160. procedure DescrEndSection; override;
  161. procedure DescrBeginRemark; override;
  162. procedure DescrEndRemark; override;
  163. procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
  164. procedure DescrEndTable; override;
  165. procedure DescrBeginTableCaption; override;
  166. procedure DescrEndTableCaption; override;
  167. procedure DescrBeginTableHeadRow; override;
  168. procedure DescrEndTableHeadRow; override;
  169. procedure DescrBeginTableRow; override;
  170. procedure DescrEndTableRow; override;
  171. procedure DescrBeginTableCell; override;
  172. procedure DescrEndTableCell; override;
  173. procedure AppendText(Parent: TDOMNode; const AText: DOMString);
  174. procedure AppendNbSp(Parent: TDOMNode; ACount: Integer);
  175. procedure AppendSym(Parent: TDOMNode; const AText: DOMString);
  176. procedure AppendKw(Parent: TDOMNode; const AText: DOMString);
  177. function AppendPasSHFragment(Parent: TDOMNode; const AText: String;
  178. AShFlags: Byte): Byte;
  179. Procedure AppendShortDescr(AContext : TPasElement;Parent: TDOMNode; DocNode : TDocNode);
  180. procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
  181. procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
  182. procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode;
  183. DescrNode: TDOMElement; AutoInsertBlock: Boolean);
  184. procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode;
  185. DescrNode: TDOMElement; const ATitle: DOMString);
  186. function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
  187. function AppendType(CodeEl, TableEl: TDOMElement;
  188. Element: TPasType; Expanded: Boolean;
  189. NestingLevel: Integer = 0): TDOMElement;
  190. function AppendProcType(CodeEl, TableEl: TDOMElement;
  191. Element: TPasProcedureType; Indent: Integer): TDOMElement;
  192. procedure AppendProcExt(CodeEl: TDOMElement; Element: TPasProcedure);
  193. procedure AppendProcDecl(CodeEl, TableEl: TDOMElement; Element: TPasProcedureBase);
  194. procedure AppendProcArgsSection(Parent: TDOMNode; Element: TPasProcedureType; SkipResult : Boolean = False);
  195. function AppendRecordType(CodeEl, TableEl: TDOMElement; Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
  196. procedure CreateMemberDeclarations(AParent: TPasElement; Members: TFPList; TableEl: TDOmelement; AddEnd: Boolean);
  197. procedure AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []);
  198. procedure AppendMenuBar(ASubpageIndex: Integer);
  199. procedure AppendTopicMenuBar(Topic : TTopicElement);
  200. procedure AppendSourceRef(AElement: TPasElement);
  201. procedure FinishElementPage(AElement: TPasElement);
  202. Procedure AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
  203. Procedure AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
  204. procedure AppendFooter;
  205. procedure CreateIndexPage(L : TStringList);
  206. procedure CreateModuleIndexPage(AModule: TPasModule);
  207. procedure CreatePageBody(AElement: TPasElement; ASubpageIndex: Integer); virtual;
  208. procedure CreatePackagePageBody;
  209. procedure CreatePackageIndex;
  210. procedure CreatePackageClassHierarchy;
  211. procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean);
  212. procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
  213. Procedure CreateTopicPageBody(AElement : TTopicElement);
  214. procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
  215. procedure CreateConstPageBody(AConst: TPasConst);
  216. procedure CreateTypePageBody(AType: TPasType);
  217. procedure CreateClassPageBody(AClass: TPasClassType; ASubpageIndex: Integer);
  218. procedure CreateClassMemberPageBody(AElement: TPasElement);
  219. procedure CreateVarPageBody(AVar: TPasVariable);
  220. procedure CreateProcPageBody(AProc: TPasProcedureBase);
  221. Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
  222. procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
  223. procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
  224. public
  225. constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  226. destructor Destroy; override;
  227. // Single-page generation
  228. function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
  229. function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
  230. // For producing complete package documentation
  231. procedure WriteHTMLPages; virtual;
  232. procedure WriteXHTMLPages;
  233. function ModuleForElement(AnElement:TPasElement):TPasModule;
  234. Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
  235. Procedure WriteDoc; override;
  236. Class Function FileNameExtension : String; override;
  237. class procedure Usage(List: TStrings); override;
  238. Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
  239. Property SearchPage: String Read FSearchPage Write FSearchPage;
  240. property Allocator: TFileAllocator read FAllocator;
  241. property Package: TPasPackage read FPackage;
  242. property PageCount: Integer read GetPageCount;
  243. Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
  244. Property DateFormat : String Read FDateFormat Write FDateFormat;
  245. property OnTest: TNotifyEvent read FOnTest write SetOnTest;
  246. Property CharSet : String Read FCharSet Write FCharSet;
  247. Property IndexColCount : Integer Read FIndexColCount write FIndexColCount;
  248. Property BaseImageURL : String Read FBaseImageURL Write FBaseImageURL;
  249. Property UseMenuBrackets : Boolean Read FUseMenuBrackets write FUseMenuBrackets;
  250. end;
  251. THTMWriter = class(THTMLWriter)
  252. Protected
  253. Procedure CreateAllocator; override;
  254. end;
  255. {$DEFINE chmInterface}
  256. {$I dw_htmlchm.inc}
  257. {$UNDEF chmInterface}
  258. implementation
  259. uses SysUtils, XHTML, XMLRead, XMLWrite, HTMWrite, sh_pas, fpdocclasstree,
  260. chmsitemap;
  261. {$i css.inc}
  262. {$i plusimage.inc}
  263. {$i minusimage.inc}
  264. Function FixHTMLpath(S : String) : STring;
  265. begin
  266. Result:=StringReplace(S,'\','/',[rfReplaceAll]);
  267. end;
  268. {$I dw_htmlchm.inc}
  269. procedure TFileAllocator.AllocFilename(AElement: TPasElement;
  270. ASubindex: Integer);
  271. begin
  272. end;
  273. function TFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
  274. begin
  275. SetLength(Result, 0);
  276. end;
  277. function TFileAllocator.GetCSSFilename(ARelativeTo: TPasElement): DOMString;
  278. begin
  279. Result := GetRelativePathToTop(ARelativeTo) + 'fpdoc.css';
  280. end;
  281. constructor TShortNameFileAllocator.Create(const AExtension: String);
  282. begin
  283. inherited Create;
  284. FExtension := AExtension;
  285. end;
  286. procedure TShortNameFileAllocator.AllocFilename(AElement: TPasElement;
  287. ASubindex: Integer);
  288. begin
  289. // !!!: Add element to file list
  290. end;
  291. constructor TLongNameFileAllocator.Create(const AExtension: String);
  292. begin
  293. inherited Create;
  294. FExtension := AExtension;
  295. end;
  296. function TLongNameFileAllocator.GetFilename(AElement: TPasElement;
  297. ASubindex: Integer): String;
  298. var
  299. s: String;
  300. i: Integer;
  301. begin
  302. if AElement.ClassType = TPasPackage then
  303. Result := 'index'
  304. else if AElement.ClassType = TPasModule then
  305. Result := LowerCase(AElement.Name) + PathDelim + 'index'
  306. else
  307. begin
  308. if AElement is TPasOperator then
  309. begin
  310. Result := LowerCase(AElement.Parent.PathName) + '.op-';
  311. s := Copy(AElement.Name, Pos(' ', AElement.Name) + 1, Length(AElement.Name));
  312. s := Copy(s, 1, Pos('(', s) - 1);
  313. if s = ':=' then
  314. s := 'assign'
  315. else if s = '+' then
  316. s := 'add'
  317. else if s = '-' then
  318. s := 'sub'
  319. else if s = '*' then
  320. s := 'mul'
  321. else if s = '/' then
  322. s := 'div'
  323. else if s = '**' then
  324. s := 'power'
  325. else if s = '=' then
  326. s := 'equal'
  327. else if s = '<>' then
  328. s := 'unequal'
  329. else if s = '<' then
  330. s := 'less'
  331. else if s = '<=' then
  332. s := 'lessequal'
  333. else if s = '>' then
  334. s := 'greater'
  335. else if s = '>=' then
  336. s := 'greaterthan'
  337. else if s = '><' then
  338. s := 'symmetricdifference';
  339. Result := Result + s + '-';
  340. s := '';
  341. i := 1;
  342. while AElement.Name[i] <> '(' do
  343. Inc(i);
  344. Inc(i);
  345. while AElement.Name[i] <> ')' do
  346. begin
  347. if AElement.Name[i] = ',' then
  348. begin
  349. s := s + '-';
  350. Inc(i);
  351. end else
  352. s := s + AElement.Name[i];
  353. Inc(i);
  354. end;
  355. Result := Result + LowerCase(s) + '-' + LowerCase(Copy(AElement.Name,
  356. Pos('):', AElement.Name) + 3, Length(AElement.Name)));
  357. end else
  358. Result := LowerCase(AElement.PathName);
  359. // searching for TPasModule - it is on the 2nd level
  360. if Assigned(AElement.Parent) then
  361. while Assigned(AElement.Parent.Parent) do
  362. AElement := AElement.Parent;
  363. // cut off Package Name
  364. Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
  365. // to skip dots in unit name
  366. i := Length(AElement.Name);
  367. while (i <= Length(Result)) and (Result[i] <> '.') do
  368. Inc(i);
  369. if (i <= Length(Result)) and (i > 0) then
  370. Result[i] := PathDelim;
  371. end;
  372. if ASubindex > 0 then
  373. Result := Result + '-' + IntToStr(ASubindex);
  374. Result := Result + Extension;
  375. end;
  376. function TLongNameFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
  377. begin
  378. if (AElement.ClassType=TPasPackage) then
  379. Result := ''
  380. else if (AElement.ClassType=TTopicElement) then
  381. begin
  382. If (AElement.Parent.ClassType=TTopicElement) then
  383. Result:='../'+GetRelativePathToTop(AElement.Parent)
  384. else if (AElement.Parent.ClassType=TPasPackage) then
  385. Result:=''
  386. else if (AElement.Parent.ClassType=TPasModule) then
  387. Result:='../';
  388. end
  389. else
  390. Result := '../';
  391. end;
  392. Type
  393. { TLinkData }
  394. TLinkData = Class(TObject)
  395. FPathName,
  396. FLink,
  397. FModuleName : String;
  398. Constructor Create(Const APathName,ALink,AModuleName : string);
  399. end;
  400. { TLinkData }
  401. constructor TLinkData.Create(Const APathName, ALink, AModuleName: string);
  402. begin
  403. FPathName:=APathName;
  404. FLink:=ALink;
  405. FModuleName:=AModuleName;
  406. end;
  407. constructor THTMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
  408. procedure AddPage(AElement: TPasElement; ASubpageIndex: Integer);
  409. var
  410. PageInfo: TPageInfo;
  411. begin
  412. PageInfo := TPageInfo.Create;
  413. PageInfo.Element := AElement;
  414. PageInfo.SubpageIndex := ASubpageIndex;
  415. PageInfos.Add(PageInfo);
  416. Allocator.AllocFilename(AElement, ASubpageIndex);
  417. if ASubpageIndex = 0 then
  418. Engine.AddLink(AElement.PathName,
  419. Allocator.GetFilename(AElement, ASubpageIndex));
  420. end;
  421. procedure AddTopicPages(AElement: TPasElement);
  422. var
  423. PreviousTopic,
  424. TopicElement : TTopicElement;
  425. PageInfo : TPageInfo;
  426. DocNode,
  427. TopicNode : TDocNode;
  428. begin
  429. DocNode:=Engine.FindDocNode(AElement);
  430. If not Assigned(DocNode) then
  431. exit;
  432. TopicNode:=DocNode.FirstChild;
  433. PreviousTopic:=Nil;
  434. While Assigned(TopicNode) do
  435. begin
  436. If TopicNode.TopicNode then
  437. begin
  438. TopicElement:=TTopicElement.Create(TopicNode.Name,AElement);
  439. Topics.Add(TopicElement);
  440. TopicElement.TopicNode:=TopicNode;
  441. TopicElement.Previous:=PreviousTopic;
  442. If Assigned(PreviousTopic) then
  443. PreviousTopic.Next:=TopicElement;
  444. PreviousTopic:=TopicElement;
  445. if AElement is TTopicElement then
  446. TTopicElement(AElement).SubTopics.Add(TopicElement);
  447. PageInfo := TPageInfo.Create;
  448. PageInfo.Element := TopicElement;
  449. PageInfo.SubpageIndex := 0;
  450. PageInfos.Add(PageInfo);
  451. Allocator.AllocFilename(TopicElement,0);
  452. Engine.AddLink(TopicElement.PathName, Allocator.GetFilename(TopicElement,0));
  453. if AElement is TTopicElement then
  454. TTopicElement(AElement).SubTopics.Add(TopicElement)
  455. else // Only one level of recursion.
  456. AddTopicPages(TopicElement);
  457. end;
  458. TopicNode:=TopicNode.NextSibling;
  459. end;
  460. end;
  461. Function HaveClasses(AModule: TPasModule) : Boolean;
  462. begin
  463. result:=assigned(AModule)
  464. and assigned(AModule.InterfaceSection)
  465. and assigned(AModule.InterfaceSection.Classes)
  466. and (AModule.InterfaceSection.Classes.Count>0);
  467. end;
  468. procedure AddPages(AElement: TPasElement; ASubpageIndex: Integer;
  469. AList: TFPList);
  470. var
  471. i,j: Integer;
  472. R : TPasRecordtype;
  473. FPEl : TPasElement;
  474. DocNode: TDocNode;
  475. begin
  476. if AList.Count > 0 then
  477. begin
  478. AddPage(AElement, ASubpageIndex);
  479. for i := 0 to AList.Count - 1 do
  480. begin
  481. AddPage(TPasElement(AList[i]), 0);
  482. if (TObject(AList[i]) is TPasRecordType) then
  483. begin
  484. R:=TObject(AList[I]) as TPasRecordType;
  485. For J:=0 to R.Members.Count-1 do
  486. begin
  487. FPEl:=TPasElement(R.Members[J]);
  488. if ((FPEL is TPasProperty) or (FPEL is TPasProcedureBase))
  489. and Engine.ShowElement(FPEl) then
  490. begin
  491. DocNode := Engine.FindDocNode(FPEl);
  492. if Assigned(DocNode) then
  493. AddPage(FPEl, 0);
  494. end;
  495. end;
  496. end;
  497. end;
  498. end;
  499. end;
  500. Procedure AddClassMemberPages(AModule: TPasModule; LinkList : TObjectList);
  501. var
  502. i, j, k: Integer;
  503. s: String;
  504. ClassEl: TPasClassType;
  505. FPEl, AncestorMemberEl: TPasElement;
  506. DocNode: TDocNode;
  507. ALink : DOMString;
  508. DidAutolink: Boolean;
  509. begin
  510. for i := 0 to AModule.InterfaceSection.Classes.Count - 1 do
  511. begin
  512. ClassEl := TPasClassType(AModule.InterfaceSection.Classes[i]);
  513. AddPage(ClassEl, 0);
  514. // !!!: Only add when there are items
  515. AddPage(ClassEl, PropertiesByInheritanceSubindex);
  516. AddPage(ClassEl, PropertiesByNameSubindex);
  517. AddPage(ClassEl, MethodsByInheritanceSubindex);
  518. AddPage(ClassEl, MethodsByNameSubindex);
  519. AddPage(ClassEl, EventsByInheritanceSubindex);
  520. AddPage(ClassEl, EventsByNameSubindex);
  521. for j := 0 to ClassEl.Members.Count - 1 do
  522. begin
  523. FPEl := TPasElement(ClassEl.Members[j]);
  524. if Not Engine.ShowElement(FPEl) then
  525. continue;
  526. DocNode := Engine.FindDocNode(FPEl);
  527. if Assigned(DocNode) then
  528. begin
  529. if Assigned(DocNode.Node) then
  530. ALink:=DocNode.Node['link']
  531. else
  532. ALink:='';
  533. If (ALink<>'') then
  534. LinkList.Add(TLinkData.Create(FPEl.PathName,ALink,AModule.name))
  535. else
  536. AddPage(FPEl, 0);
  537. end
  538. else
  539. begin
  540. DidAutolink := False;
  541. if Assigned(ClassEl.AncestorType) and
  542. (ClassEl.AncestorType.ClassType.inheritsfrom(TPasClassType)) then
  543. begin
  544. for k := 0 to TPasClassType(ClassEl.AncestorType).Members.Count - 1 do
  545. begin
  546. AncestorMemberEl :=
  547. TPasElement(TPasClassType(ClassEl.AncestorType).Members[k]);
  548. if AncestorMemberEl.Name = FPEl.Name then
  549. begin
  550. DocNode := Engine.FindDocNode(AncestorMemberEl);
  551. if Assigned(DocNode) then
  552. begin
  553. DidAutolink := True;
  554. Engine.AddLink(FPEl.PathName,
  555. Engine.FindAbsoluteLink(AncestorMemberEl.PathName));
  556. break;
  557. end;
  558. end;
  559. end;
  560. end;
  561. if not DidAutolink then
  562. AddPage(FPEl, 0);
  563. end;
  564. end;
  565. end;
  566. end;
  567. procedure ScanModule(AModule: TPasModule; LinkList : TObjectList);
  568. var
  569. i: Integer;
  570. s: String;
  571. begin
  572. if not assigned(Amodule.Interfacesection) then
  573. exit;
  574. AddPage(AModule, 0);
  575. AddPage(AModule,IndexSubIndex);
  576. AddTopicPages(AModule);
  577. with AModule do
  578. begin
  579. if InterfaceSection.ResStrings.Count > 0 then
  580. begin
  581. AddPage(AModule, ResstrSubindex);
  582. s := Allocator.GetFilename(AModule, ResstrSubindex);
  583. for i := 0 to InterfaceSection.ResStrings.Count - 1 do
  584. with TPasResString(InterfaceSection.ResStrings[i]) do
  585. Engine.AddLink(PathName, s + '#' + LowerCase(Name));
  586. end;
  587. AddPages(AModule, ConstsSubindex, InterfaceSection.Consts);
  588. AddPages(AModule, TypesSubindex, InterfaceSection.Types);
  589. if InterfaceSection.Classes.Count > 0 then
  590. begin
  591. AddPage(AModule, ClassesSubindex);
  592. AddClassMemberPages(AModule,LinkList);
  593. end;
  594. AddPages(AModule, ProcsSubindex, InterfaceSection.Functions);
  595. AddPages(AModule, VarsSubindex, InterfaceSection.Variables);
  596. end;
  597. end;
  598. var
  599. i: Integer;
  600. L : TObjectList;
  601. H : Boolean;
  602. begin
  603. inherited ;
  604. // should default to true since this is the old behavior
  605. UseMenuBrackets:=True;
  606. IndexColCount:=3;
  607. Charset:='iso-8859-1';
  608. CreateAllocator;
  609. FPackage := APackage;
  610. OutputNodeStack := TList.Create;
  611. PageInfos := TObjectList.Create;
  612. FImageFileList := TStringList.Create;
  613. // Allocate page for the package itself, if a name is given (i.e. <> '#')
  614. if Length(Package.Name) > 1 then
  615. begin
  616. AddPage(Package, 0);
  617. AddPage(Package,IndexSubIndex);
  618. I:=0;
  619. H:=False;
  620. While (I<Package.Modules.Count) and Not H do
  621. begin
  622. H:=HaveClasses(TPasModule(Package.Modules[i]));
  623. Inc(I);
  624. end;
  625. if H then
  626. AddPage(Package,ClassHierarchySubIndex);
  627. AddTopicPages(Package);
  628. end;
  629. L:=TObjectList.Create;
  630. try
  631. for i := 0 to Package.Modules.Count - 1 do
  632. ScanModule(TPasModule(Package.Modules[i]),L);
  633. // Resolve links
  634. For I:=0 to L.Count-1 do
  635. With TLinkData(L[i]) do
  636. Engine.AddLink(FPathName,ResolveLinkIDInUnit(FLink,FModuleName));
  637. finally
  638. L.Free;
  639. end;
  640. end;
  641. destructor THTMLWriter.Destroy;
  642. begin
  643. PageInfos.Free;
  644. OutputNodeStack.Free;
  645. FAllocator.Free;
  646. FImageFileList.Free;
  647. inherited Destroy;
  648. end;
  649. function THTMLWriter.CreateHTMLPage(AElement: TPasElement;
  650. ASubpageIndex: Integer): TXMLDocument;
  651. var
  652. HTMLEl: THTMLHtmlElement;
  653. HeadEl: THTMLHeadElement;
  654. El: TDOMElement;
  655. begin
  656. Doc := THTMLDocument.Create;
  657. Result := Doc;
  658. Doc.AppendChild(Doc.Impl.CreateDocumentType(
  659. 'HTML', '-//W3C//DTD HTML 4.01 Transitional//EN',
  660. 'http://www.w3.org/TR/html4/loose.dtd'));
  661. HTMLEl := Doc.CreateHtmlElement;
  662. Doc.AppendChild(HTMLEl);
  663. HeadEl := Doc.CreateHeadElement;
  664. HeadElement:=HeadEl;
  665. HTMLEl.AppendChild(HeadEl);
  666. El := Doc.CreateElement('meta');
  667. HeadEl.AppendChild(El);
  668. El['http-equiv'] := 'Content-Type';
  669. El['content'] := 'text/html; charset=utf-8';
  670. TitleElement := Doc.CreateElement('title');
  671. HeadEl.AppendChild(TitleElement);
  672. El := Doc.CreateElement('link');
  673. BodyElement := Doc.CreateElement('body');
  674. HTMLEl.AppendChild(BodyElement);
  675. CreatePageBody(AElement, ASubpageIndex);
  676. AppendFooter;
  677. HeadEl.AppendChild(El);
  678. El['rel'] := 'stylesheet';
  679. El['type'] := 'text/css';
  680. El['href'] := FixHtmlPath(Allocator.GetCSSFilename(AElement));
  681. end;
  682. function THTMLWriter.CreateXHTMLPage(AElement: TPasElement;
  683. ASubpageIndex: Integer): TXMLDocument;
  684. begin
  685. Result := nil;
  686. end;
  687. procedure CreatePath(const AFilename: String);
  688. var
  689. EndIndex: Integer;
  690. Path: String;
  691. begin
  692. EndIndex := Length(AFilename);
  693. if EndIndex = 0 then
  694. exit;
  695. while not (AFilename[EndIndex] in AllowDirectorySeparators) do
  696. begin
  697. Dec(EndIndex);
  698. if EndIndex = 0 then
  699. exit;
  700. end;
  701. Path := Copy(AFilename, 1, EndIndex - 1);
  702. if not DirectoryExists(Path) then
  703. begin
  704. CreatePath(Path);
  705. MkDir(Path);
  706. end;
  707. end;
  708. procedure THTMLWriter.WriteHTMLPages;
  709. var
  710. i: Integer;
  711. PageDoc: TXMLDocument;
  712. Filename: String;
  713. begin
  714. if Engine.Output <> '' then
  715. Engine.Output := IncludeTrailingBackSlash(Engine.Output);
  716. for i := 0 to PageInfos.Count - 1 do
  717. with TPageInfo(PageInfos[i]) do
  718. begin
  719. PageDoc := CreateHTMLPage(Element, SubpageIndex);
  720. try
  721. Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
  722. try
  723. CreatePath(Filename);
  724. WriteHTMLFile(PageDoc, Filename);
  725. except
  726. on E: Exception do
  727. DoLog(SErrCouldNotCreateFile, [FileName, e.Message]);
  728. end;
  729. finally
  730. PageDoc.Free;
  731. end;
  732. end;
  733. CreateCSSFile;
  734. CreatePlusImage;
  735. CreateMinusImage;
  736. end;
  737. procedure THTMLWriter.CreatePlusImage;
  738. Var
  739. TempStream: TMemoryStream;
  740. begin
  741. TempStream := TMemoryStream.Create;
  742. try
  743. DoLog('Creating plus image',[]);
  744. TempStream.WriteBuffer(PlusImageData,SizeOf(PlusImageData));
  745. TempStream.Position := 0;
  746. TempStream.SaveToFile(Engine.output+'plus.png');
  747. finally
  748. TempStream.Free;
  749. end;
  750. end;
  751. procedure THTMLWriter.CreateMinusImage;
  752. Var
  753. TempStream: TMemoryStream;
  754. begin
  755. TempStream := TMemoryStream.Create;
  756. try
  757. DoLog('Creating minus image',[]);
  758. TempStream.WriteBuffer(MinusImageData,SizeOf(MinusImageData));
  759. TempStream.Position := 0;
  760. TempStream.SaveToFile(Engine.output+'minus.png');
  761. finally
  762. TempStream.Free;
  763. end;
  764. end;
  765. function THTMLWriter.ModuleForElement(AnElement:TPasElement):TPasModule;
  766. begin
  767. result:=TPasModule(AnElement);
  768. while assigned(result) and not (result is TPasModule) do
  769. result:=TPasModule(result.parent);
  770. if not (result is TPasModule) then
  771. result:=nil;
  772. end;
  773. procedure THTMLWriter.CreateCSSFile;
  774. Var
  775. TempStream: TMemoryStream;
  776. begin
  777. TempStream := TMemoryStream.Create;
  778. try
  779. if (FCSSFile<>'') then
  780. begin
  781. if not FileExists(FCSSFile) then
  782. begin
  783. DoLog('Can''t find CSS file "%s"',[FCSSFILE]);
  784. halt(1);
  785. end;
  786. TempStream.LoadFromFile(FCSSFile);
  787. end
  788. else
  789. begin
  790. DoLog('Using built-in CSS file',[]);
  791. TempStream.WriteBuffer(DefaultCSS,SizeOf(DefaultCSS));
  792. end;
  793. TempStream.Position := 0;
  794. TempStream.SaveToFile(Engine.output+'fpdoc.css');
  795. finally
  796. TempStream.Free;
  797. end;
  798. end;
  799. procedure THTMLWriter.WriteXHTMLPages;
  800. begin
  801. end;
  802. {procedure THTMLWriter.CreateDoc(const ATitle: DOMString;
  803. AElement: TPasElement; const AFilename: String);
  804. var
  805. El: TDOMElement;
  806. DocInfo: TDocInfo;
  807. CSSName: String;
  808. begin
  809. Doc := TXHTMLDocument.Create;
  810. with TXHTMLDocument(Doc) do
  811. begin
  812. Encoding := 'ISO8859-1';
  813. CSSName := 'fpdoc.css';
  814. if Assigned(Module) then
  815. CSSName := '../' + CSSName;
  816. $IFNDEF ver1_0
  817. StylesheetType := 'text/css';
  818. StylesheetHRef := CSSName;
  819. $ENDIF
  820. CreateRoot(xhtmlStrict);
  821. with RequestHeadElement do
  822. begin
  823. AppendText(RequestTitleElement, ATitle);
  824. El := CreateElement('link');
  825. AppendChild(El);
  826. El['rel'] := 'stylesheet';
  827. El['type'] := 'text/css';
  828. El['href'] := FixHtmlPath(CSSName);
  829. end;
  830. Self.BodyElement := RequestBodyElement('en');
  831. end;
  832. if Length(AFilename) > 0 then
  833. begin
  834. DocInfo := TDocInfo.Create;
  835. DocInfos.Add(DocInfo);
  836. DocInfo.Element := AElement;
  837. DocInfo.Filename := AFilename;
  838. end;
  839. end;
  840. }
  841. { Used for:
  842. - <link> elements in descriptions
  843. - "see also" entries
  844. - AppendHyperlink (for unresolved parse tree element links)
  845. }
  846. function THTMLWriter.ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
  847. begin
  848. Result:=ResolveLinkID(Name);
  849. If (Result='') and (AUnitName<>'') and (length(Name)>0) and (Name[1]<>'#') then
  850. Result:=ResolveLinkID(AUnitName+'.'+Name);
  851. end;
  852. function THTMLWriter.ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
  853. var
  854. i: Integer;
  855. ThisPackage: TLinkNode;
  856. begin
  857. Result:=Engine.ResolveLink(Module,Name, True);
  858. if Length(Result) > 0 then
  859. if Copy(Result, 1, Length(CurDirectory) + 1) = CurDirectory + '/' then
  860. Result := Copy(Result, Length(CurDirectory) + 2, Length(Result))
  861. else if not IsLinkAbsolute(Result) then
  862. Result := BaseDirectory + Result;
  863. end;
  864. function THTMLWriter.ResolveLinkWithinPackage(AElement: TPasElement;
  865. ASubpageIndex: Integer): String;
  866. var
  867. ParentEl: TPasElement;
  868. begin
  869. ParentEl := AElement;
  870. while Assigned(ParentEl) and not (ParentEl.ClassType = TPasPackage) do
  871. ParentEl := ParentEl.Parent;
  872. if Assigned(ParentEl) and (TPasPackage(ParentEl) = Engine.Package) then
  873. begin
  874. Result := Allocator.GetFilename(AElement, ASubpageIndex);
  875. if Copy(Result, 1, Length(CurDirectory) + 1) = CurDirectory + '/' then
  876. Result := Copy(Result, Length(CurDirectory) + 2, Length(Result))
  877. else
  878. Result := BaseDirectory + Result;
  879. end else
  880. SetLength(Result, 0);
  881. end;
  882. function THTMLWriter.CreateEl(Parent: TDOMNode;
  883. const AName: DOMString): THTMLElement;
  884. begin
  885. Result := Doc.CreateElement(AName);
  886. Parent.AppendChild(Result);
  887. end;
  888. function THTMLWriter.CreatePara(Parent: TDOMNode): THTMLElement;
  889. begin
  890. Result := CreateEl(Parent, 'p');
  891. end;
  892. function THTMLWriter.CreateH1(Parent: TDOMNode): THTMLElement;
  893. begin
  894. Result := CreateEl(Parent, 'h1');
  895. end;
  896. function THTMLWriter.CreateH2(Parent: TDOMNode): THTMLElement;
  897. begin
  898. Result := CreateEl(Parent, 'h2');
  899. end;
  900. function THTMLWriter.CreateH3(Parent: TDOMNode): THTMLElement;
  901. begin
  902. Result := CreateEl(Parent, 'h3');
  903. end;
  904. function THTMLWriter.CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
  905. begin
  906. Result := CreateEl(Parent, 'table');
  907. Result['cellspacing'] := '0';
  908. Result['cellpadding'] := '0';
  909. if AClass <> '' then
  910. Result['class'] := AClass;
  911. end;
  912. function THTMLWriter.CreateContentTable(Parent: TDOMNode): THTMLElement;
  913. begin
  914. Result := CreateEl(Parent, 'table');
  915. end;
  916. function THTMLWriter.CreateTR(Parent: TDOMNode): THTMLElement;
  917. begin
  918. Result := CreateEl(Parent, 'tr');
  919. end;
  920. function THTMLWriter.CreateTD(Parent: TDOMNode): THTMLElement;
  921. begin
  922. Result := CreateEl(Parent, 'td');
  923. end;
  924. function THTMLWriter.CreateTD_vtop(Parent: TDOMNode): THTMLElement;
  925. begin
  926. Result := CreateEl(Parent, 'td');
  927. Result['valign'] := 'top';
  928. end;
  929. function THTMLWriter.CreateLink(Parent: TDOMNode;
  930. const AHRef: DOMString): THTMLElement;
  931. begin
  932. Result := CreateEl(Parent, 'a');
  933. Result['href'] := FixHtmlPath(AHRef);
  934. end;
  935. function THTMLWriter.CreateAnchor(Parent: TDOMNode;
  936. const AName: DOMString): THTMLElement;
  937. begin
  938. Result := CreateEl(Parent, 'a');
  939. Result['name'] := AName;
  940. end;
  941. function THTMLWriter.CreateCode(Parent: TDOMNode): THTMLElement;
  942. begin
  943. Result := CreateEl(CreateEl(Parent, 'tt'), 'span');
  944. Result['class'] := 'code';
  945. end;
  946. function THTMLWriter.CreateWarning(Parent: TDOMNode): THTMLElement;
  947. begin
  948. Result := CreateEl(Parent, 'span');
  949. Result['class'] := 'warning';
  950. end;
  951. procedure THTMLWriter.DescrEmitNotesHeader(AContext: TPasElement);
  952. begin
  953. AppendText(CreateH2(BodyElement), SDocNotes);
  954. PushOutputNode(BodyElement);
  955. end;
  956. procedure THTMLWriter.DescrEmitNotesFooter(AContext: TPasElement);
  957. begin
  958. PopOutPutNode;
  959. end;
  960. procedure THTMLWriter.PushOutputNode(ANode: TDOMNode);
  961. begin
  962. OutputNodeStack.Add(CurOutputNode);
  963. CurOutputNode := ANode;
  964. end;
  965. procedure THTMLWriter.PopOutputNode;
  966. begin
  967. CurOutputNode := TDOMNode(OutputNodeStack[OutputNodeStack.Count - 1]);
  968. OutputNodeStack.Delete(OutputNodeStack.Count - 1);
  969. end;
  970. procedure THTMLWriter.DescrWriteText(const AText: DOMString);
  971. begin
  972. AppendText(CurOutputNode, AText);
  973. end;
  974. procedure THTMLWriter.DescrBeginBold;
  975. begin
  976. PushOutputNode(CreateEl(CurOutputNode, 'b'));
  977. end;
  978. procedure THTMLWriter.DescrEndBold;
  979. begin
  980. PopOutputNode;
  981. end;
  982. procedure THTMLWriter.DescrBeginItalic;
  983. begin
  984. PushOutputNode(CreateEl(CurOutputNode, 'i'));
  985. end;
  986. procedure THTMLWriter.DescrEndItalic;
  987. begin
  988. PopOutputNode;
  989. end;
  990. procedure THTMLWriter.DescrBeginEmph;
  991. begin
  992. PushOutputNode(CreateEl(CurOutputNode, 'em'));
  993. end;
  994. procedure THTMLWriter.DescrEndEmph;
  995. begin
  996. PopOutputNode;
  997. end;
  998. procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
  999. Var
  1000. Pel,Cel,Lel : TDOMNode;
  1001. El :TDomElement;
  1002. D : String;
  1003. L : Integer;
  1004. begin
  1005. // Determine parent node.
  1006. If (ACaption='') then
  1007. Pel:=CurOutputNode
  1008. else
  1009. begin
  1010. Cel:=CreateTable(CurOutputNode, 'imagetable');
  1011. Pel:=CreateTD(CreateTR(Cel));
  1012. Cel:=CreateTD(CreateTR(Cel));
  1013. El := CreateEl(Cel, 'span');
  1014. El['class'] := 'imagecaption';
  1015. Cel := El;
  1016. If (ALinkName<>'') then
  1017. Cel:=CreateAnchor(Cel,ALinkName);
  1018. AppendText(Cel,ACaption);
  1019. end;
  1020. // Determine URL for image.
  1021. If (Module=Nil) then
  1022. D:=Allocator.GetRelativePathToTop(Package)
  1023. else
  1024. D:=Allocator.GetRelativePathToTop(Module);
  1025. L:=Length(D);
  1026. If (L>0) and (D[L]<>'/') then
  1027. D:=D+'/';
  1028. // Create image node.
  1029. El:=CreateEl(Pel,'img');
  1030. EL['src']:=D + BaseImageURL + AFileName;
  1031. El['alt']:=ACaption;
  1032. //cache image filename, so it can be used later (CHM)
  1033. FImageFileList.Add(BaseImageURL + AFileName);
  1034. end;
  1035. procedure THTMLWriter.DescrWriteFileEl(const AText: DOMString);
  1036. var
  1037. NewEl: TDOMElement;
  1038. begin
  1039. NewEl := CreateEl(CurOutputNode, 'span');
  1040. NewEl['class'] := 'file';
  1041. AppendText(NewEl, AText);
  1042. end;
  1043. procedure THTMLWriter.DescrWriteKeywordEl(const AText: DOMString);
  1044. var
  1045. NewEl: TDOMElement;
  1046. begin
  1047. NewEl := CreateEl(CurOutputNode, 'span');
  1048. NewEl['class'] := 'kw';
  1049. AppendText(NewEl, AText);
  1050. end;
  1051. procedure THTMLWriter.DescrWriteVarEl(const AText: DOMString);
  1052. begin
  1053. AppendText(CreateEl(CurOutputNode, 'var'), AText);
  1054. end;
  1055. procedure THTMLWriter.DescrBeginLink(const AId: DOMString);
  1056. var
  1057. a,s,n : String;
  1058. begin
  1059. a:=AId;
  1060. s := ResolveLinkID(a);
  1061. if Length(s) = 0 then
  1062. begin
  1063. if assigned(module) then
  1064. s:=module.name
  1065. else
  1066. s:='?';
  1067. if a='' then a:='<empty>';
  1068. if Assigned(CurrentContext) then
  1069. N:=CurrentContext.Name
  1070. else
  1071. N:='?';
  1072. DoLog(SErrUnknownLinkID, [s,n,a]);
  1073. PushOutputNode(CreateEl(CurOutputNode, 'b'));
  1074. end else
  1075. PushOutputNode(CreateLink(CurOutputNode, s));
  1076. end;
  1077. procedure THTMLWriter.DescrEndLink;
  1078. begin
  1079. PopOutputNode;
  1080. end;
  1081. procedure THTMLWriter.DescrBeginURL(const AURL: DOMString);
  1082. begin
  1083. PushOutputNode(CreateLink(CurOutputNode, AURL));
  1084. end;
  1085. procedure THTMLWriter.DescrEndURL;
  1086. begin
  1087. PopOutputNode;
  1088. end;
  1089. procedure THTMLWriter.DescrWriteLinebreak;
  1090. begin
  1091. CreateEl(CurOutputNode, 'br');
  1092. end;
  1093. procedure THTMLWriter.DescrBeginParagraph;
  1094. begin
  1095. PushOutputNode(CreatePara(CurOutputNode));
  1096. end;
  1097. procedure THTMLWriter.DescrEndParagraph;
  1098. begin
  1099. PopOutputNode;
  1100. end;
  1101. procedure THTMLWriter.DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String);
  1102. begin
  1103. DoPasHighlighting := (AHighlighterName = '') or (AHighlighterName = 'Pascal');
  1104. HighlighterFlags := 0;
  1105. PushOutputNode(CreateEl(CurOutputNode, 'pre'));
  1106. end;
  1107. procedure THTMLWriter.DescrWriteCodeLine(const ALine: String);
  1108. begin
  1109. if DoPasHighlighting then
  1110. begin
  1111. HighlighterFlags := AppendPasSHFragment(CurOutputNode, ALine,
  1112. HighlighterFlags);
  1113. AppendText(CurOutputNode, #10);
  1114. end else
  1115. AppendText(CurOutputNode, ALine + #10);
  1116. end;
  1117. procedure THTMLWriter.DescrEndCode;
  1118. begin
  1119. PopOutputNode;
  1120. end;
  1121. procedure THTMLWriter.DescrBeginOrderedList;
  1122. begin
  1123. PushOutputNode(CreateEl(CurOutputNode, 'ol'));
  1124. end;
  1125. procedure THTMLWriter.DescrEndOrderedList;
  1126. begin
  1127. PopOutputNode;
  1128. end;
  1129. procedure THTMLWriter.DescrBeginUnorderedList;
  1130. begin
  1131. PushOutputNode(CreateEl(CurOutputNode, 'ul'));
  1132. end;
  1133. procedure THTMLWriter.DescrEndUnorderedList;
  1134. begin
  1135. PopOutputNode;
  1136. end;
  1137. procedure THTMLWriter.DescrBeginDefinitionList;
  1138. begin
  1139. PushOutputNode(CreateEl(CurOutputNode, 'dl'));
  1140. end;
  1141. procedure THTMLWriter.DescrEndDefinitionList;
  1142. begin
  1143. PopOutputNode;
  1144. end;
  1145. procedure THTMLWriter.DescrBeginListItem;
  1146. begin
  1147. PushOutputNode(CreateEl(CurOutputNode, 'li'));
  1148. end;
  1149. procedure THTMLWriter.DescrEndListItem;
  1150. begin
  1151. PopOutputNode;
  1152. end;
  1153. procedure THTMLWriter.DescrBeginDefinitionTerm;
  1154. begin
  1155. PushOutputNode(CreateEl(CurOutputNode, 'dt'));
  1156. end;
  1157. procedure THTMLWriter.DescrEndDefinitionTerm;
  1158. begin
  1159. PopOutputNode;
  1160. end;
  1161. procedure THTMLWriter.DescrBeginDefinitionEntry;
  1162. begin
  1163. PushOutputNode(CreateEl(CurOutputNode, 'dd'));
  1164. end;
  1165. procedure THTMLWriter.DescrEndDefinitionEntry;
  1166. begin
  1167. PopOutputNode;
  1168. end;
  1169. procedure THTMLWriter.DescrBeginSectionTitle;
  1170. begin
  1171. PushOutputNode(CreateEl(CurOutputNode, 'h3'));
  1172. end;
  1173. procedure THTMLWriter.DescrBeginSectionBody;
  1174. begin
  1175. PopOutputNode;
  1176. end;
  1177. procedure THTMLWriter.DescrEndSection;
  1178. begin
  1179. end;
  1180. procedure THTMLWriter.DescrBeginRemark;
  1181. var
  1182. NewEl, TDEl: TDOMElement;
  1183. begin
  1184. NewEl := CreateEl(CurOutputNode, 'table');
  1185. NewEl['width'] := '100%';
  1186. NewEl['border'] := '0';
  1187. NewEl['CellSpacing'] := '0';
  1188. NewEl['class'] := 'remark';
  1189. NewEl := CreateTR(NewEl);
  1190. TDEl := CreateTD(NewEl);
  1191. TDEl['valign'] := 'top';
  1192. TDEl['class'] := 'pre';
  1193. AppendText(CreateEl(TDEl, 'b'), SDocRemark);
  1194. PushOutputNode(CreateTD(NewEl));
  1195. end;
  1196. procedure THTMLWriter.DescrEndRemark;
  1197. begin
  1198. PopOutputNode;
  1199. end;
  1200. procedure THTMLWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
  1201. var
  1202. Table: TDOMElement;
  1203. begin
  1204. Table := CreateEl(CurOutputNode, 'table');
  1205. Table['border'] := IntToStr(Ord(HasBorder));
  1206. PushOutputNode(Table);
  1207. end;
  1208. procedure THTMLWriter.DescrEndTable;
  1209. begin
  1210. PopOutputNode;
  1211. end;
  1212. procedure THTMLWriter.DescrBeginTableCaption;
  1213. begin
  1214. PushOutputNode(CreateEl(CurOutputNode, 'caption'));
  1215. end;
  1216. procedure THTMLWriter.DescrEndTableCaption;
  1217. begin
  1218. PopOutputNode;
  1219. end;
  1220. procedure THTMLWriter.DescrBeginTableHeadRow;
  1221. begin
  1222. PushOutputNode(CreateTr(CurOutputNode));
  1223. InsideHeadRow := True;
  1224. end;
  1225. procedure THTMLWriter.DescrEndTableHeadRow;
  1226. begin
  1227. InsideHeadRow := False;
  1228. PopOutputNode;
  1229. end;
  1230. procedure THTMLWriter.DescrBeginTableRow;
  1231. begin
  1232. PushOutputNode(CreateTR(CurOutputNode));
  1233. end;
  1234. procedure THTMLWriter.DescrEndTableRow;
  1235. begin
  1236. PopOutputNode;
  1237. end;
  1238. procedure THTMLWriter.DescrBeginTableCell;
  1239. begin
  1240. if InsideHeadRow then
  1241. PushOutputNode(CreateEl(CurOutputNode, 'th'))
  1242. else
  1243. PushOutputNode(CreateTD(CurOutputNode));
  1244. end;
  1245. procedure THTMLWriter.DescrEndTableCell;
  1246. begin
  1247. PopOutputNode;
  1248. end;
  1249. procedure THTMLWriter.AppendText(Parent: TDOMNode; const AText: DOMString);
  1250. begin
  1251. Parent.AppendChild(Doc.CreateTextNode(AText));
  1252. end;
  1253. procedure THTMLWriter.AppendNbSp(Parent: TDOMNode; ACount: Integer);
  1254. begin
  1255. while ACount > 0 do
  1256. begin
  1257. Parent.AppendChild(Doc.CreateEntityReference('nbsp'));
  1258. Dec(ACount);
  1259. end;
  1260. end;
  1261. procedure THTMLWriter.AppendSym(Parent: TDOMNode; const AText: DOMString);
  1262. var
  1263. El: TDOMElement;
  1264. begin
  1265. El := CreateEl(Parent, 'span');
  1266. El['class'] := 'sym';
  1267. AppendText(El, AText);
  1268. end;
  1269. procedure THTMLWriter.AppendKw(Parent: TDOMNode; const AText: DOMString);
  1270. var
  1271. El: TDOMElement;
  1272. begin
  1273. El := CreateEl(Parent, 'span');
  1274. El['class'] := 'kw';
  1275. AppendText(El, AText);
  1276. end;
  1277. function THTMLWriter.AppendPasSHFragment(Parent: TDOMNode;
  1278. const AText: String; AShFlags: Byte): Byte;
  1279. var
  1280. Line, Last, p: PChar;
  1281. IsInSpecial: Boolean;
  1282. lastwasasm : boolean;
  1283. El: TDOMElement;
  1284. Procedure MaybeOutput;
  1285. Var
  1286. CurParent: TDomNode;
  1287. begin
  1288. If (Last<>Nil) then
  1289. begin
  1290. If (el<>Nil) then
  1291. CurParent:=El
  1292. else
  1293. CurParent:=Parent;
  1294. AppendText(CurParent,Last);
  1295. El:=Nil;
  1296. Last:=Nil;
  1297. end;
  1298. end;
  1299. Function NewEl(Const ElType,Attr,AttrVal : String) : TDomElement;
  1300. begin
  1301. Result:=CreateEl(Parent,ElType);
  1302. Result[Attr]:=AttrVal;
  1303. end;
  1304. Function NewSpan(Const AttrVal : String) : TDomElement;
  1305. begin
  1306. Result:=CreateEl(Parent,'span');
  1307. Result['class']:=AttrVal;
  1308. end;
  1309. begin
  1310. GetMem(Line, Length(AText) * 3 + 4);
  1311. Try
  1312. DoPascalHighlighting(AShFlags, PChar(AText), Line);
  1313. Result := AShFlags;
  1314. IsInSpecial := False;
  1315. Last := Nil;
  1316. p := Line;
  1317. el:=nil;
  1318. while p[0] <> #0 do
  1319. begin
  1320. if p[0] = LF_ESCAPE then
  1321. begin
  1322. p[0] := #0;
  1323. MaybeOutput;
  1324. case Ord(p[1]) of
  1325. shDefault: El:=Nil;
  1326. shInvalid: El:=newel('font','color','red');
  1327. shSymbol : El:=newspan('sym');
  1328. shKeyword: El:=newspan('kw');
  1329. shComment: El:=newspan('cmt');
  1330. shDirective: El:=newspan('dir');
  1331. shNumbers: El:=newspan('num');
  1332. shCharacters: El:=newspan('chr');
  1333. shStrings: El:=newspan('str');
  1334. shAssembler: El:=newspan('asm');
  1335. end;
  1336. Inc(P);
  1337. end
  1338. else If (Last=Nil) then
  1339. Last:=P;
  1340. Inc(p);
  1341. end;
  1342. MaybeOutput;
  1343. Finally
  1344. FreeMem(Line);
  1345. end;
  1346. end;
  1347. Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
  1348. Var
  1349. N : TDocNode;
  1350. begin
  1351. if Assigned(DocNode) then
  1352. begin
  1353. If (DocNode.Link<>'') then
  1354. begin
  1355. N:=Engine.FindLinkedNode(DocNode);
  1356. If (N<>Nil) then
  1357. DocNode:=N;
  1358. end;
  1359. If Assigned(DocNode.ShortDescr) then
  1360. begin
  1361. PushOutputNode(Parent);
  1362. try
  1363. if not ConvertShort(AContext,TDomElement(DocNode.ShortDescr)) then
  1364. Warning(AContext, SErrInvalidShortDescr)
  1365. finally
  1366. PopOutputNode;
  1367. end;
  1368. end;
  1369. end;
  1370. end;
  1371. procedure THTMLWriter.AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
  1372. begin
  1373. AppendShortDescr(Element,Parent,Engine.FindDocNode(Element));
  1374. end;
  1375. procedure THTMLWriter.AppendShortDescrCell(Parent: TDOMNode;
  1376. Element: TPasElement);
  1377. var
  1378. ParaEl: TDOMElement;
  1379. begin
  1380. if Assigned(Engine.FindShortDescr(Element)) then
  1381. begin
  1382. AppendNbSp(CreatePara(CreateTD(Parent)), 2);
  1383. ParaEl := CreatePara(CreateTD(Parent));
  1384. ParaEl['class'] := 'cmt';
  1385. AppendShortDescr(ParaEl, Element);
  1386. end;
  1387. end;
  1388. procedure THTMLWriter.AppendDescr(AContext: TPasElement; Parent: TDOMNode;
  1389. DescrNode: TDOMElement; AutoInsertBlock: Boolean);
  1390. begin
  1391. if Assigned(DescrNode) then
  1392. begin
  1393. PushOutputNode(Parent);
  1394. try
  1395. ConvertDescr(AContext, DescrNode, AutoInsertBlock);
  1396. finally
  1397. PopOutputNode;
  1398. end;
  1399. end;
  1400. end;
  1401. procedure THTMLWriter.AppendDescrSection(AContext: TPasElement;
  1402. Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString);
  1403. begin
  1404. if not IsDescrNodeEmpty(DescrNode) then
  1405. begin
  1406. If (ATitle<>'') then // Can be empty for topic.
  1407. AppendText(CreateH2(Parent), ATitle);
  1408. AppendDescr(AContext, Parent, DescrNode, True);
  1409. end;
  1410. end;
  1411. function THTMLWriter.AppendHyperlink(Parent: TDOMNode;
  1412. Element: TPasElement): TDOMElement;
  1413. var
  1414. s: String;
  1415. UnitList: TFPList;
  1416. i: Integer;
  1417. ThisPackage: TLinkNode;
  1418. begin
  1419. if Assigned(Element) then
  1420. begin
  1421. if Element.InheritsFrom(TPasUnresolvedTypeRef) then
  1422. begin
  1423. s := ResolveLinkID(Element.Name);
  1424. if Length(s) = 0 then
  1425. begin
  1426. { Try all packages }
  1427. ThisPackage := Engine.RootLinkNode.FirstChild;
  1428. while Assigned(ThisPackage) do
  1429. begin
  1430. s := ResolveLinkID(ThisPackage.Name + '.' + Element.Name);
  1431. if Length(s) > 0 then
  1432. break;
  1433. ThisPackage := ThisPackage.NextSibling;
  1434. end;
  1435. if Length(s) = 0 then
  1436. begin
  1437. { Okay, then we have to try all imported units of the current module }
  1438. UnitList := Module.InterfaceSection.UsesList;
  1439. for i := UnitList.Count - 1 downto 0 do
  1440. begin
  1441. { Try all packages }
  1442. ThisPackage := Engine.RootLinkNode.FirstChild;
  1443. while Assigned(ThisPackage) do
  1444. begin
  1445. s := ResolveLinkID(ThisPackage.Name + '.' +
  1446. TPasType(UnitList[i]).Name + '.' + Element.Name);
  1447. if Length(s) > 0 then
  1448. break;
  1449. ThisPackage := ThisPackage.NextSibling;
  1450. end;
  1451. if length(s)=0 then
  1452. s := ResolveLinkID('#rtl.System.' + Element.Name);
  1453. if Length(s) > 0 then
  1454. break;
  1455. end;
  1456. end;
  1457. end;
  1458. end else if Element is TPasEnumValue then
  1459. s := ResolveLinkID(Element.Parent.PathName)
  1460. else
  1461. s := ResolveLinkID(Element.PathName);
  1462. if Length(s) > 0 then
  1463. begin
  1464. Result := CreateLink(Parent, s);
  1465. AppendText(Result, Element.Name);
  1466. end else
  1467. begin
  1468. Result := nil;
  1469. AppendText(Parent, Element.Name);
  1470. end;
  1471. end else
  1472. begin
  1473. Result := nil;
  1474. AppendText(CreateWarning(Parent), '<NIL>');
  1475. end;
  1476. end;
  1477. { Returns the new CodeEl, which will be the old CodeEl in most cases }
  1478. function THTMLWriter.AppendType(CodeEl, TableEl: TDOMElement;
  1479. Element: TPasType; Expanded: Boolean; NestingLevel: Integer): TDOMElement;
  1480. Var
  1481. S : String;
  1482. begin
  1483. Result := CodeEl;
  1484. if not Assigned(Element) then
  1485. AppendText(CreateWarning(CodeEl), '<NIL>')
  1486. else if (not Expanded) and (Length(Element.Name) > 0) then
  1487. AppendHyperlink(CodeEl, Element)
  1488. else
  1489. // Array
  1490. if Element.ClassType = TPasArrayType then
  1491. begin
  1492. S:='array ';
  1493. If (TPasArrayType(Element).IndexRange<>'') then
  1494. S:=S+'[' + TPasArrayType(Element).IndexRange + '] ';
  1495. S:=S+'of ';
  1496. If (TPasArrayType(Element).ElType=Nil) then
  1497. S:=S+'Const';
  1498. AppendPasSHFragment(CodeEl,S,0);
  1499. If (TPasArrayType(Element).ElType<>Nil) then
  1500. Result := AppendType(CodeEl, TableEl, TPasArrayType(Element).ElType, False);
  1501. end else
  1502. // Procedure or funtion type
  1503. if Element.InheritsFrom(TPasProcedureType) then
  1504. begin
  1505. AppendKw(CodeEl, TPasProcedureType(Element).TypeName);
  1506. Result := AppendProcType(CodeEl, TableEl, TPasProcedureType(Element), 0)
  1507. end else
  1508. // Range type
  1509. if Element.InheritsFrom(TPasRangeType) then
  1510. AppendPasSHFragment(CodeEl, TPasRangeType(Element).RangeStart + '..' +
  1511. TPasRangeType(Element).RangeEnd, 0)
  1512. // Record type
  1513. else if Element.ClassType = TPasRecordType then
  1514. Result := AppendRecordType(CodeEl, TableEl, TPasRecordType(Element), NestingLevel)
  1515. else if (Element.ClassType = TPasFileType) and (TPasFileType(Element).elType=Nil) then
  1516. AppendPasSHFragment(CodeEl,'file',0)
  1517. else
  1518. // Other types
  1519. AppendHyperlink(CodeEl, Element);
  1520. end;
  1521. function THTMLWriter.AppendProcType(CodeEl, TableEl: TDOMElement;
  1522. Element: TPasProcedureType; Indent: Integer): TDOMElement;
  1523. function CreateIndentedCodeEl(Indent: Integer): TDOMElement;
  1524. begin
  1525. Result := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
  1526. AppendNbSp(Result, Indent);
  1527. end;
  1528. var
  1529. i: Integer;
  1530. Arg: TPasArgument;
  1531. begin
  1532. if Element.Args.Count > 0 then
  1533. begin
  1534. AppendSym(CodeEl, '(');
  1535. for i := 0 to Element.Args.Count - 1 do
  1536. begin
  1537. Arg := TPasArgument(Element.Args[i]);
  1538. CodeEl := CreateIndentedCodeEl(Indent + 2);
  1539. case Arg.Access of
  1540. argConst: AppendKw(CodeEl, 'const ');
  1541. argVar: AppendKw(CodeEl, 'var ');
  1542. argOut: AppendKw(CodeEl, 'out ');
  1543. end;
  1544. AppendText(CodeEl, Arg.Name);
  1545. if Assigned(Arg.ArgType) then
  1546. begin
  1547. AppendSym(CodeEl, ': ');
  1548. CodeEl := AppendType(CodeEl, TableEl, Arg.ArgType, False);
  1549. end;
  1550. if Length(Arg.Value) > 0 then
  1551. AppendPasSHFragment(CodeEl, ' = ' + Arg.Value, 0);
  1552. if i < Element.Args.Count - 1 then
  1553. AppendSym(CodeEl, ';');
  1554. end;
  1555. if Element.InheritsFrom(TPasFunctionType) or Element.IsOfObject then
  1556. begin
  1557. CodeEl := CreateIndentedCodeEl(Indent);
  1558. if Element.InheritsFrom(TPasFunctionType) then
  1559. begin
  1560. AppendSym(CodeEl, '):');
  1561. AppendHyperlink(CodeEl, TPasFunctionType(Element).ResultEl.ResultType);
  1562. end else
  1563. AppendSym(CodeEl, ')');
  1564. if Element.IsOfObject then
  1565. begin
  1566. AppendText(CodeEl, ' '); // Don't remove
  1567. AppendKw(CodeEl, 'of object');
  1568. end;
  1569. end else
  1570. if Indent > 0 then
  1571. AppendSym(CodeEl, ')')
  1572. else
  1573. begin
  1574. CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
  1575. AppendSym(CodeEl, ')');
  1576. end;
  1577. end
  1578. else
  1579. begin
  1580. { Procedure or function without arguments }
  1581. if Element.InheritsFrom(TPasFunctionType) then
  1582. begin
  1583. AppendSym(CodeEl, ': ');
  1584. AppendHyperlink(CodeEl, TPasFunctionType(Element).ResultEl.ResultType);
  1585. end;
  1586. if Element.IsOfObject then
  1587. AppendKw(CodeEl, ' of object');
  1588. end;
  1589. Result := CodeEl;
  1590. end;
  1591. procedure THTMLWriter.AppendProcExt(CodeEl: TDOMElement;
  1592. Element: TPasProcedure);
  1593. procedure AppendExt(const Ext: String);
  1594. begin
  1595. AppendKw(CodeEl, ' ' + Ext);
  1596. AppendSym(CodeEl, ';');
  1597. end;
  1598. begin
  1599. if Element.IsVirtual then
  1600. AppendExt('virtual');
  1601. if Element.IsDynamic then
  1602. AppendExt('dynamic');
  1603. if Element.IsAbstract then
  1604. AppendExt('abstract');
  1605. if Element.IsOverride then
  1606. AppendExt('override');
  1607. if Element.IsOverload then
  1608. AppendExt('overload');
  1609. if Element.IsMessage then
  1610. AppendExt('message');
  1611. end;
  1612. { Used in two places:
  1613. - Page for the method of a class
  1614. - Page for a tandalone procedure or function. }
  1615. procedure THTMLWriter.AppendProcDecl(CodeEl, TableEl: TDOMElement;
  1616. Element: TPasProcedureBase);
  1617. procedure WriteVariant(AProc: TPasProcedure; SkipResult : Boolean);
  1618. begin
  1619. AppendProcArgsSection(TableEl.ParentNode, AProc.ProcType, SkipResult);
  1620. AppendKw(CodeEl, AProc.TypeName);
  1621. if (Element.Parent.ClassType = TPasClassType) or (Element.Parent.ClassType = TPasRecordType) then
  1622. begin
  1623. AppendText(CodeEl, ' ');
  1624. AppendHyperlink(CodeEl, Element.Parent);
  1625. AppendSym(CodeEl, '.');
  1626. AppendText(CodeEl, AProc.Name);
  1627. end else
  1628. if (Element is TPasOperator) then
  1629. AppendText(CodeEl, ' ' + TPasOperator(AProc).GetOperatorDeclaration(True))
  1630. else
  1631. AppendText(CodeEl, ' ' + AProc.FullName);
  1632. CodeEl := AppendProcType(CodeEl, TableEl, AProc.ProcType, 0);
  1633. AppendSym(CodeEl, ';');
  1634. AppendProcExt(CodeEl, AProc);
  1635. end;
  1636. var
  1637. i,fc: Integer;
  1638. P : TPasProcedure;
  1639. begin
  1640. fc:=0;
  1641. if Element.ClassType = TPasOverloadedProc then
  1642. for i := 0 to TPasOverloadedProc(Element).Overloads.Count - 1 do
  1643. begin
  1644. P:=TPasProcedure(TPasOverloadedProc(Element).Overloads[i]);
  1645. if (P.ProcType is TPasFunctionType) then
  1646. Inc(fc);
  1647. if i > 0 then
  1648. begin
  1649. CreateEl(CodeEl, 'br');
  1650. CreateEl(CodeEl, 'br');
  1651. end;
  1652. WriteVariant(P,fc>1);
  1653. end
  1654. else
  1655. WriteVariant(TPasProcedure(Element),False);
  1656. end;
  1657. procedure THTMLWriter.AppendProcArgsSection(Parent: TDOMNode;
  1658. Element: TPasProcedureType; SkipResult : Boolean = False);
  1659. var
  1660. HasFullDescr, IsFirst: Boolean;
  1661. ResultEl: TPasResultElement;
  1662. ArgTableEl, TREl: TDOMElement;
  1663. DocNode: TDocNode;
  1664. i: Integer;
  1665. Arg: TPasArgument;
  1666. begin
  1667. IsFirst := True;
  1668. for i := 0 to Element.Args.Count - 1 do
  1669. begin
  1670. Arg := TPasArgument(Element.Args[i]);
  1671. if IsDescrNodeEmpty(Engine.FindShortDescr(Arg)) then
  1672. continue;
  1673. if IsFirst then
  1674. begin
  1675. IsFirst := False;
  1676. AppendText(CreateH2(Parent), SDocArguments);
  1677. ArgTableEl := CreateTable(Parent);
  1678. end;
  1679. TREl := CreateTR(ArgTableEl);
  1680. AppendText(CreateCode(CreatePara(CreateTD_vtop(TREl))), Arg.Name);
  1681. AppendShortDescrCell(TREl, Arg);
  1682. end;
  1683. if (Element.ClassType = TPasFunctionType) and not SkipResult then
  1684. begin
  1685. ResultEl := TPasFunctionType(Element).ResultEl;
  1686. DocNode := Engine.FindDocNode(ResultEl);
  1687. HasFullDescr := Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr);
  1688. if HasFullDescr or
  1689. (Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.ShortDescr)) then
  1690. begin
  1691. AppendText(CreateH2(Parent), SDocFunctionResult);
  1692. if HasFullDescr then
  1693. AppendDescr(ResultEl, Parent, DocNode.Descr, True)
  1694. else
  1695. AppendDescr(ResultEl, CreatePara(Parent), DocNode.ShortDescr, False);
  1696. end;
  1697. end;
  1698. end;
  1699. function THTMLWriter.AppendRecordType(CodeEl, TableEl: TDOMElement;
  1700. Element: TPasRecordType; NestingLevel: Integer): TDOMElement;
  1701. var
  1702. i, j: Integer;
  1703. Variable: TPasVariable;
  1704. TREl, TDEl: TDOMElement;
  1705. CurVariant: TPasVariant;
  1706. isExtended : Boolean;
  1707. VariantEl: TPasElement;
  1708. VariantType: TPasType;
  1709. begin
  1710. if not (Element.Parent is TPasVariant) then
  1711. if Element.IsPacked then
  1712. If Element.IsBitPacked then
  1713. AppendKw(CodeEl, 'bitpacked record')
  1714. else
  1715. AppendKW(CodeEl, 'packed record')
  1716. else
  1717. AppendKw(CodeEl, 'record');
  1718. isExtended:=False;
  1719. I:=0;
  1720. while (not isExtended) and (I<Element.Members.Count) do
  1721. begin
  1722. isExtended:=Not (TObject(Element.Members[i]) is TPasVariable);
  1723. Inc(i);
  1724. end;
  1725. if isExtended then
  1726. CreateMemberDeclarations(Element,Element.Members,TableEl,False)
  1727. else
  1728. for i := 0 to Element.Members.Count - 1 do
  1729. begin
  1730. Variable := TPasVariable(Element.Members[i]);
  1731. TREl := CreateTR(TableEl);
  1732. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  1733. AppendShortDescrCell(TREl, Variable);
  1734. AppendNbSp(CodeEl, NestingLevel * 2 + 2);
  1735. AppendText(CodeEl, Variable.Name);
  1736. AppendSym(CodeEl, ': ');
  1737. CodeEl := AppendType(CodeEl, TableEl, Variable.VarType, False, NestingLevel + 1);
  1738. AppendSym(CodeEl, ';');
  1739. end;
  1740. if Assigned(Element.VariantEl) then
  1741. begin
  1742. TREl := CreateTR(TableEl);
  1743. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  1744. AppendNbSp(CodeEl, NestingLevel * 2 + 2);
  1745. AppendKw(CodeEl, 'case ');
  1746. VariantEl:=TPasRecordType(Element).VariantEl;
  1747. if VariantEl is TPasVariable then
  1748. begin
  1749. AppendText(CodeEl, TPasVariable(VariantEl).Name);
  1750. AppendSym(CodeEl, ': ');
  1751. VariantType:=TPasVariable(VariantEl).VarType;
  1752. end else
  1753. VariantType:=VariantEl as TPasType;
  1754. CodeEl := AppendType(CodeEl, TableEl, VariantType, True);
  1755. AppendKw(CodeEl, ' of');
  1756. for i := 0 to TPasRecordType(Element).Variants.Count - 1 do
  1757. begin
  1758. CurVariant := TPasVariant(Element.Variants[i]);
  1759. TREl := CreateTR(TableEl);
  1760. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  1761. AppendNbSp(CodeEl, NestingLevel * 2 + 4);
  1762. for j := 0 to CurVariant.Values.Count - 1 do
  1763. begin
  1764. if j > 0 then
  1765. AppendSym(CodeEl, ', ');
  1766. AppendPasSHFragment(CodeEl, TPasElement(CurVariant.Values[j]).GetDeclaration(true), 0);
  1767. end;
  1768. AppendSym(CodeEl, ': (');
  1769. AppendType(CodeEl, TableEl, CurVariant.Members, True, NestingLevel + 3);
  1770. CodeEl := CreateCode(CreatePara(CreateTD_vtop(CreateTR(TableEl))));
  1771. AppendNbSp(CodeEl, NestingLevel * 2 + 6);
  1772. AppendSym(CodeEl, ');');
  1773. end;
  1774. end;
  1775. if not (Element.Parent is TPasVariant) then
  1776. begin
  1777. CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
  1778. AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
  1779. AppendNbSp(CodeEl, NestingLevel * 2);
  1780. AppendKw(CodeEl, 'end');
  1781. end;
  1782. Result := CodeEl;
  1783. end;
  1784. procedure THTMLWriter.AppendTitle(const AText: DOMString; Hints : TPasMemberHints = []);
  1785. Var
  1786. T : String;
  1787. begin
  1788. T:=AText;
  1789. if (Hints<>[]) then
  1790. T:=T+' ('+Engine.HintsToStr(Hints)+')';
  1791. AppendText(TitleElement, AText);
  1792. AppendText(CreateH1(BodyElement), T);
  1793. end;
  1794. procedure THTMLWriter.AppendTopicMenuBar(Topic : TTopicElement);
  1795. var
  1796. TableEl, TREl, ParaEl, TitleEl: TDOMElement;
  1797. procedure AddLink(El : TPasElement; const AName: String);
  1798. begin
  1799. if FUseMenuBrackets then
  1800. AppendText(ParaEl, '[');
  1801. AppendText(CreateLink(ParaEl, ResolveLinkWithinPackage(El,0)),AName);
  1802. if FUseMenuBrackets then
  1803. AppendText(ParaEl, ']');
  1804. end;
  1805. begin
  1806. TableEl := CreateEl(BodyElement, 'table');
  1807. TableEl['cellpadding'] := '4';
  1808. TableEl['cellspacing'] := '0';
  1809. TableEl['border'] := '0';
  1810. TableEl['width'] := '100%';
  1811. TableEl['class'] := 'bar';
  1812. TREl := CreateTR(TableEl);
  1813. ParaEl := CreateEl(CreateTD(TREl), 'b');
  1814. If Assigned(Topic.Previous) then
  1815. AddLink(Topic.Previous,SDocPrevious);
  1816. If Assigned(Topic.Parent) then
  1817. AddLink(Topic.Parent,SDocUp);
  1818. if Assigned(Topic.Next) then
  1819. AddLink(Topic.Next,SDocNext);
  1820. if Length(SearchPage) > 0 then
  1821. begin
  1822. if FUseMenuBrackets then
  1823. AppendText(ParaEl, '[');
  1824. AppendText(CreateLink(ParaEl, SearchPage), SDocSearch);
  1825. if FUseMenuBrackets then
  1826. AppendText(ParaEl, ']');
  1827. end;
  1828. ParaEl := CreateTD(TREl);
  1829. ParaEl['align'] := 'right';
  1830. TitleEl := CreateEl(ParaEl, 'span');
  1831. TitleEl['class'] := 'bartitle';
  1832. if Assigned(Module) then
  1833. AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
  1834. if Assigned(Package) then
  1835. begin
  1836. AppendText(TitleEl, ' (');
  1837. AppendHyperlink(TitleEl, Package);
  1838. AppendText(TitleEl, ')');
  1839. end;
  1840. end;
  1841. procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
  1842. var
  1843. TableEl, TREl, ParaEl, TitleEl: TDOMElement;
  1844. procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
  1845. begin
  1846. if FUseMenuBrackets then
  1847. AppendText(ParaEl, '[');
  1848. if ALinkSubpageIndex = ASubpageIndex then
  1849. AppendText(ParaEl, AName)
  1850. else
  1851. AppendText(
  1852. CreateLink(ParaEl, ResolveLinkWithinPackage(Module, ALinkSubpageIndex)),
  1853. AName);
  1854. if FUseMenuBrackets then
  1855. AppendText(ParaEl, ']');
  1856. end;
  1857. procedure AddPackageLink(ALinkSubpageIndex: Integer; const AName: String);
  1858. begin
  1859. if FUseMenuBrackets then
  1860. AppendText(ParaEl, '[');
  1861. if ALinkSubpageIndex = ASubpageIndex then
  1862. AppendText(ParaEl, AName)
  1863. else
  1864. AppendText(
  1865. CreateLink(ParaEl, ResolveLinkWithinPackage(Package, ALinkSubpageIndex)),
  1866. AName);
  1867. if FUseMenuBrackets then
  1868. AppendText(ParaEl, ']');
  1869. end;
  1870. begin
  1871. TableEl := CreateEl(BodyElement, 'table');
  1872. TableEl['cellpadding'] := '4';
  1873. TableEl['cellspacing'] := '0';
  1874. TableEl['border'] := '0';
  1875. TableEl['width'] := '100%';
  1876. TableEl['class'] := 'bar';
  1877. TREl := CreateTR(TableEl);
  1878. ParaEl := CreateEl(CreateTD(TREl), 'b');
  1879. if Assigned(Module) then
  1880. begin
  1881. AddLink(0, SDocOverview);
  1882. if Module.InterfaceSection.ResStrings.Count > 0 then
  1883. AddLink(ResstrSubindex, SDocResStrings);
  1884. if Module.InterfaceSection.Consts.Count > 0 then
  1885. AddLink(ConstsSubindex, SDocConstants);
  1886. if Module.InterfaceSection.Types.Count > 0 then
  1887. AddLink(TypesSubindex, SDocTypes);
  1888. if Module.InterfaceSection.Classes.Count > 0 then
  1889. AddLink(ClassesSubindex, SDocClasses);
  1890. if Module.InterfaceSection.Functions.Count > 0 then
  1891. AddLink(ProcsSubindex, SDocProceduresAndFunctions);
  1892. if Module.InterfaceSection.Variables.Count > 0 then
  1893. AddLink(VarsSubindex, SDocVariables);
  1894. AddLink(IndexSubIndex,SDocIdentifierIndex);
  1895. end
  1896. else
  1897. begin
  1898. AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
  1899. AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
  1900. end;
  1901. if Length(SearchPage) > 0 then
  1902. begin
  1903. if FUseMenuBrackets then
  1904. AppendText(ParaEl, '[');
  1905. AppendText(CreateLink(ParaEl, SearchPage), SDocSearch);
  1906. if FUseMenuBrackets then
  1907. AppendText(ParaEl, ']');
  1908. end;
  1909. ParaEl := CreateTD(TREl);
  1910. ParaEl['align'] := 'right';
  1911. TitleEl := CreateEl(ParaEl, 'span');
  1912. TitleEl['class'] := 'bartitle';
  1913. if Assigned(Module) then
  1914. AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
  1915. if Assigned(Package) then
  1916. begin
  1917. AppendText(TitleEl, ' (');
  1918. AppendHyperlink(TitleEl, Package);
  1919. AppendText(TitleEl, ')');
  1920. end;
  1921. end;
  1922. procedure THTMLWriter.AppendSourceRef(AElement: TPasElement);
  1923. begin
  1924. AppendText(CreatePara(BodyElement), Format(SDocSourcePosition,
  1925. [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
  1926. end;
  1927. Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
  1928. var
  1929. Node: TDOMNode;
  1930. TableEl, El, TREl, TDEl, ParaEl, NewEl, DescrEl: TDOMElement;
  1931. l,s,n: String;
  1932. f: Text;
  1933. IsFirstSeeAlso : Boolean;
  1934. begin
  1935. if Not (Assigned(DocNode) and Assigned(DocNode.SeeAlso)) then
  1936. Exit;
  1937. IsFirstSeeAlso := True;
  1938. Node:=DocNode.SeeAlso.FirstChild;
  1939. While Assigned(Node) do
  1940. begin
  1941. if (Node.NodeType=ELEMENT_NODE) and (Node.NodeName='link') then
  1942. begin
  1943. if IsFirstSeeAlso then
  1944. begin
  1945. IsFirstSeeAlso := False;
  1946. AppendText(CreateH2(BodyElement), SDocSeeAlso);
  1947. TableEl := CreateTable(BodyElement);
  1948. end;
  1949. El:=TDOMElement(Node);
  1950. TREl:=CreateTR(TableEl);
  1951. ParaEl:=CreatePara(CreateTD_vtop(TREl));
  1952. l:=El['id'];
  1953. s:= ResolveLinkID(l);
  1954. if Length(s)=0 then
  1955. begin
  1956. if assigned(module) then
  1957. s:=module.name
  1958. else
  1959. s:='?';
  1960. if l='' then l:='<empty>';
  1961. if Assigned(AElement) then
  1962. N:=AElement.Name
  1963. else
  1964. N:='?';
  1965. DoLog(SErrUnknownLinkID, [s,N,l]);
  1966. NewEl := CreateEl(ParaEl,'b')
  1967. end
  1968. else
  1969. NewEl := CreateLink(ParaEl,s);
  1970. if Not IsDescrNodeEmpty(El) then
  1971. begin
  1972. PushOutputNode(NewEl);
  1973. Try
  1974. ConvertBaseShortList(AElement, El, True)
  1975. Finally
  1976. PopOutputNode;
  1977. end;
  1978. end
  1979. else
  1980. AppendText(NewEl,El['id']);
  1981. l:=El['id'];
  1982. DescrEl := Engine.FindShortDescr(ModuleForElement(AElement),L);
  1983. if Assigned(DescrEl) then
  1984. begin
  1985. AppendNbSp(CreatePara(CreateTD(TREl)), 2);
  1986. ParaEl := CreatePara(CreateTD(TREl));
  1987. ParaEl['class'] := 'cmt';
  1988. PushOutputNode(ParaEl);
  1989. try
  1990. ConvertShort(AElement, DescrEl);
  1991. finally
  1992. PopOutputNode;
  1993. end;
  1994. end;
  1995. end; // Link node
  1996. Node := Node.NextSibling;
  1997. end; // While
  1998. end;
  1999. Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
  2000. var
  2001. Node: TDOMNode;
  2002. // TableEl, El, TREl, TDEl, ParaEl, NewEl, DescrEl: TDOMElement;
  2003. fn,s: String;
  2004. f: Text;
  2005. begin
  2006. if not (Assigned(DocNode) and Assigned(DocNode.FirstExample)) then
  2007. Exit;
  2008. Node := DocNode.FirstExample;
  2009. while Assigned(Node) do
  2010. begin
  2011. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'example') then
  2012. begin
  2013. fn:=Engine.GetExampleFilename(TDOMElement(Node));
  2014. If (fn<>'') then
  2015. begin
  2016. AppendText(CreateH2(BodyElement), SDocExample);
  2017. try
  2018. Assign(f, FN);
  2019. Reset(f);
  2020. try
  2021. PushOutputNode(BodyElement);
  2022. DescrBeginCode(False, TDOMElement(Node)['highlighter']);
  2023. while not EOF(f) do
  2024. begin
  2025. ReadLn(f, s);
  2026. DescrWriteCodeLine(s);
  2027. end;
  2028. DescrEndCode;
  2029. PopOutputNode;
  2030. finally
  2031. Close(f);
  2032. end;
  2033. except
  2034. on e: Exception do
  2035. begin
  2036. e.Message := '[example] ' + e.Message;
  2037. raise;
  2038. end;
  2039. end;
  2040. end;
  2041. end;
  2042. Node := Node.NextSibling;
  2043. end;
  2044. end;
  2045. procedure THTMLWriter.AppendFooter;
  2046. Var
  2047. S : String;
  2048. F : TDomElement;
  2049. begin
  2050. if FooterFile<>'' then
  2051. ReadXMLFragment(BodyElement, FooterFile)
  2052. else if IncludeDateInFooter then
  2053. begin
  2054. CreateEl(BodyElement, 'hr');
  2055. F:=CreateEl(BodyElement,'span');
  2056. F['class']:='footer';
  2057. If (FDateFormat='') then
  2058. S:=DateToStr(Date)
  2059. else
  2060. S:=FormatDateTime(FDateFormat,Date);
  2061. AppendText(F,Format(SDocDateGenerated,[S]));
  2062. end;
  2063. end;
  2064. procedure THTMLWriter.FinishElementPage(AElement: TPasElement);
  2065. var
  2066. DocNode: TDocNode;
  2067. begin
  2068. DocNode := Engine.FindDocNode(AElement);
  2069. If Assigned(DocNode) then
  2070. begin
  2071. // Description
  2072. if Assigned(DocNode.Descr) then
  2073. AppendDescrSection(AElement, BodyElement, DocNode.Descr, SDocDescription);
  2074. // Append "Errors" section
  2075. if Assigned(DocNode.ErrorsDoc) then
  2076. AppendDescrSection(AElement, BodyElement, DocNode.ErrorsDoc, SDocErrors);
  2077. // Append Version info
  2078. if Assigned(DocNode.Version) then
  2079. AppendDescrSection(AElement, BodyElement, DocNode.Version, SDocVersion);
  2080. // Append "See also" section
  2081. AppendSeeAlsoSection(AElement,DocNode);
  2082. // Append examples, if present
  2083. AppendExampleSection(AElement,DocNode);
  2084. // Append notes, if present
  2085. ConvertNotes(AElement,DocNode.Notes);
  2086. end;
  2087. end;
  2088. Procedure THTMLWriter.CreateTopicPageBody(AElement : TTopicElement);
  2089. var
  2090. DocNode: TDocNode;
  2091. TableEl, TREl: TDOMElement;
  2092. I : Integer;
  2093. S : String;
  2094. begin
  2095. AppendTopicMenuBar(AElement);
  2096. DocNode:=AElement.TopicNode;
  2097. if Assigned(DocNode) then // should always be true, but we're being careful.
  2098. begin
  2099. AppendShortDescr(AElement,TitleElement, DocNode);
  2100. AppendShortDescr(AElement,CreateH2(BodyElement), DocNode);
  2101. if Assigned(DocNode.Descr) then
  2102. AppendDescrSection(AElement, BodyElement, DocNode.Descr, '');
  2103. AppendSeeAlsoSection(AElement,DocNode);
  2104. CreateTopicLinks(DocNode,AElement);
  2105. AppendExampleSection(AElement,DocNode);
  2106. ConvertNotes(AElement,DocNode.Notes);
  2107. end;
  2108. end;
  2109. procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean);
  2110. Procedure PushClassElement;
  2111. Var
  2112. H : THTMLElement;
  2113. begin
  2114. H:=CreateEl(CurOutputNode, 'li');
  2115. H['class']:='classtree';
  2116. PushOutputNode(H);
  2117. H:=CreateEl(CurOutputNode, 'span');
  2118. H['class']:='toggletreeclose';
  2119. H['onclick']:='expandorcollapse(this)';
  2120. PushOutputNode(h);
  2121. AppendNbSp(h,1);
  2122. PopOutputNode;
  2123. end;
  2124. Procedure PushClassList;
  2125. Var
  2126. H : THTMLElement;
  2127. begin
  2128. H:=CreateEl(CurOutputNode, 'ul');
  2129. H['class']:='classtreelist';
  2130. PushOutputNode(h);
  2131. end;
  2132. Procedure AppendClass(E : TDomElement);
  2133. Var
  2134. N : TDomNode;
  2135. P,PM : TPasElement;
  2136. NN : String;
  2137. EN : String;
  2138. LL : TstringList;
  2139. I,J : Integer;
  2140. begin
  2141. EN:=Package.Name+'.'+E['unit']+'.'+E.NodeName;
  2142. J:=AList.IndexOf(EN);
  2143. If J<>-1 then
  2144. P:=AList.Objects[J] as TPasElement
  2145. else
  2146. P:=Engine.FindElement(EN);
  2147. PushClassElement;
  2148. try
  2149. if (P<>Nil) then
  2150. begin
  2151. AppendHyperLink(CurOutputNode,P);
  2152. PM:=ModuleForElement(P);
  2153. if (PM<>Nil) then
  2154. begin
  2155. AppendText(CurOutputNode,' (');
  2156. AppendHyperLink(CurOutputNode,PM);
  2157. AppendText(CurOutputNode,')');
  2158. end
  2159. end
  2160. else
  2161. AppendText(CurOutputNode,E.Nodename);
  2162. LL:=TStringList.Create;
  2163. try
  2164. N:=E.FirstChild;
  2165. While (N<>Nil) do
  2166. begin
  2167. if (N.NodeType=ELEMENT_NODE) then
  2168. LL.AddObject(N.NodeName,N);
  2169. N:=N.NextSibling;
  2170. end;
  2171. if (LL.Count>0) then
  2172. begin
  2173. LL.Sorted:=true;
  2174. PushClassList;
  2175. try
  2176. For I:=0 to LL.Count-1 do
  2177. AppendClass(LL.Objects[i] as TDomElement);
  2178. finally
  2179. PopOutputNode;
  2180. end;
  2181. end;
  2182. finally
  2183. LL.Free;
  2184. end;
  2185. Finally
  2186. PopOutputNode;
  2187. end;
  2188. end;
  2189. Var
  2190. B : TClassTreeBuilder;
  2191. E : TDomElement;
  2192. F : TFileStream;
  2193. begin
  2194. PushOutputNode(BodyElement);
  2195. try
  2196. B:=TClassTreeBuilder.Create(Package,okClass);
  2197. try
  2198. B.BuildTree(AList);
  2199. // Classes
  2200. // WriteXMLFile(B.ClassTree,'tree.xml');
  2201. // Dummy TObject
  2202. E:=B.ClassTree.DocumentElement;
  2203. PushClassList;
  2204. try
  2205. AppendClass(E);
  2206. finally
  2207. PopOutputNode;
  2208. end;
  2209. finally
  2210. B.Free;
  2211. end;
  2212. finally
  2213. PopOutputNode;
  2214. end;
  2215. end;
  2216. procedure THTMLWriter.CreatePackageClassHierarchy;
  2217. Const
  2218. SFunc = 'function expandorcollapse (o) {'+sLineBreak+
  2219. ' o.className = (o.className=="toggletreeclose") ? "toggletreeopen" : "toggletreeclose";'+sLineBreak+
  2220. ' o.parentNode.className = (o.className=="toggletreeclose") ? "classtree" : "classtreeclosed";'+sLineBreak+
  2221. ' return false;'+sLineBreak+
  2222. '}';
  2223. Var
  2224. L : TStringList;
  2225. I : Integer;
  2226. M : TPasModule;
  2227. E : TPasElement;
  2228. S : String;
  2229. SE : THTMLElement;
  2230. begin
  2231. SE := Doc.CreateElement('script');
  2232. AppendText(SE,SFunc);
  2233. HeadElement.AppendChild(SE);
  2234. L:=TStringList.Create;
  2235. try
  2236. L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
  2237. For I:=0 to Package.Modules.Count-1 do
  2238. begin
  2239. M:=TPasModule(Package.Modules[i]);
  2240. if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
  2241. Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
  2242. end;
  2243. AppendMenuBar(ClassHierarchySubIndex);
  2244. S:=Package.Name;
  2245. If Length(S)>0 then
  2246. Delete(S,1,1);
  2247. AppendTitle(Format(SDocPackageClassHierarchy, [S]));
  2248. CreateClassHierarchyPage(L,True);
  2249. Finally
  2250. L.Free;
  2251. end;
  2252. end;
  2253. procedure THTMLWriter.CreatePageBody(AElement: TPasElement;
  2254. ASubpageIndex: Integer);
  2255. var
  2256. i: Integer;
  2257. Element: TPasElement;
  2258. begin
  2259. CurDirectory := Allocator.GetFilename(AElement, ASubpageIndex);
  2260. i := Length(CurDirectory);
  2261. while (i > 0) and not (CurDirectory[i] in AllowDirectorySeparators) do
  2262. Dec(i);
  2263. CurDirectory := Copy(CurDirectory, 1, i);
  2264. BaseDirectory := Allocator.GetRelativePathToTop(AElement);
  2265. if AElement.ClassType = TPasPackage then
  2266. begin
  2267. Module:=Nil;
  2268. If (ASubPageIndex=0) then
  2269. CreatePackagePageBody
  2270. else if ASubPageIndex=IndexSubIndex then
  2271. CreatePackageIndex
  2272. else if ASubPageIndex=ClassHierarchySubIndex then
  2273. CreatePackageClassHierarchy
  2274. end
  2275. else
  2276. begin
  2277. Element := AElement;
  2278. while (Element<>Nil) and (not (Element.ClassType.inheritsfrom(TPasModule))) do
  2279. Element := Element.Parent;
  2280. Module := TPasModule(Element);
  2281. if AElement.ClassType.inheritsfrom(TPasModule) then
  2282. CreateModulePageBody(TPasModule(AElement), ASubpageIndex)
  2283. else if AElement.Parent.InheritsFrom(TPasClassType) then
  2284. CreateClassMemberPageBody(AElement)
  2285. else if AElement.ClassType = TPasConst then
  2286. CreateConstPageBody(TPasConst(AElement))
  2287. else if AElement.InheritsFrom(TPasClassType) then
  2288. CreateClassPageBody(TPasClassType(AElement), ASubpageIndex)
  2289. else if AElement.InheritsFrom(TPasType) then
  2290. CreateTypePageBody(TPasType(AElement))
  2291. else if AElement.ClassType = TPasVariable then
  2292. CreateVarPageBody(TPasVariable(AElement))
  2293. else if AElement.InheritsFrom(TPasProcedureBase) then
  2294. CreateProcPageBody(TPasProcedureBase(AElement))
  2295. else if AElement.ClassType = TTopicELement then
  2296. CreateTopicPageBody(TTopicElement(AElement))
  2297. else if AElement.ClassType = TPasProperty then
  2298. CreateClassMemberPageBody(TPasProperty(AElement))
  2299. else
  2300. writeln('Unknown classtype: ',AElement.classtype.classname);
  2301. end;
  2302. end;
  2303. procedure THTMLWriter.CreateIndexPage(L : TStringList);
  2304. Var
  2305. Lists : Array['A'..'Z'] of TStringList;
  2306. LOther : TStringList;
  2307. CL : TStringList;
  2308. TableEl, TREl, EL: TDOMElement;
  2309. E : TPasElement;
  2310. I,Rows,J,Index : Integer;
  2311. S : String;
  2312. C : Char;
  2313. begin
  2314. For C:='A' to 'Z' do
  2315. Lists[C]:=Nil;
  2316. L.Sort;
  2317. Cl:=Nil;
  2318. // Divide over alphabet
  2319. For I:=0 to L.Count-1 do
  2320. begin
  2321. S:=L[i];
  2322. E:=TPasElement(L.Objects[i]);
  2323. If not (E is TPasUnresolvedTypeRef) then
  2324. begin
  2325. If (S<>'') then
  2326. begin
  2327. C:=Upcase(S[1]);
  2328. If C='_' then
  2329. C:='A';
  2330. If (C in ['A'..'Z']) and (Lists[C]=Nil) then
  2331. begin
  2332. CL:=TStringList.Create;
  2333. Lists[C]:=CL;
  2334. end;
  2335. end;
  2336. if assigned(cl) then
  2337. CL.AddObject(S,E);
  2338. end;
  2339. end;
  2340. Try
  2341. // Create a quick jump table to all available letters.
  2342. TableEl := CreateTable(BodyElement);
  2343. TableEl['border']:='1';
  2344. TableEl['width']:='50%';
  2345. TREl := CreateTR(TableEl);
  2346. for C:='A' to 'Z' do
  2347. If (Lists[C]<>Nil) then
  2348. begin
  2349. El:=CreateTD_vtop(TREl);
  2350. AppendText(CreateLink(El,'#SECTION'+C),C);
  2351. If C<>'Z' then
  2352. AppendNBsp(El,1);
  2353. end;
  2354. // Now emit all identifiers.
  2355. TableEl:=Nil;
  2356. For C:='A' to 'Z' do
  2357. begin
  2358. CL:=Lists[C];
  2359. If CL<>Nil then
  2360. begin
  2361. El:=CreateH2(BodyElement);
  2362. AppendText(El,C);
  2363. CreateAnchor(El,'SECTION'+C);
  2364. TableEl := CreateTable(BodyElement);
  2365. TableEl['Width']:='80%';
  2366. // Determine number of rows needed
  2367. Rows:=(CL.Count div IndexColCount);
  2368. If ((CL.Count Mod IndexColCount)<>0) then
  2369. Inc(Rows);
  2370. // Fill rows
  2371. For I:=0 to Rows-1 do
  2372. begin
  2373. TREl := CreateTR(TableEl);
  2374. For J:=0 to IndexColCount-1 do
  2375. begin
  2376. El:=CreateTD_vtop(TREl);
  2377. Index:=(J*Rows)+I;
  2378. If (Index<CL.Count) then
  2379. begin
  2380. S:=CL[Index];
  2381. E:=TPasElement(CL.Objects[Index]);
  2382. AppendHyperlink(El,E);
  2383. end;
  2384. end;
  2385. end;
  2386. end; // have List
  2387. end; // For C:=
  2388. Finally
  2389. for C:='A' to 'Z' do
  2390. FreeAndNil(Lists[C]);
  2391. end;
  2392. end;
  2393. Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
  2394. Var
  2395. I : Integer;
  2396. El : TPasElement;
  2397. begin
  2398. For I:=0 to List.Count-1 do
  2399. begin
  2400. El:=TPasElement(List[I]);
  2401. if UsePathName then
  2402. L.AddObject(El.PathName,El)
  2403. else
  2404. L.AddObject(El.Name,El);
  2405. If el is TPasEnumType then
  2406. AddElementsFromList(L,TPasEnumType(el).Values);
  2407. end;
  2408. end;
  2409. procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
  2410. begin
  2411. if assigned(AModule.InterfaceSection) Then
  2412. begin
  2413. AddElementsFromList(L,AModule.InterfaceSection.Consts);
  2414. AddElementsFromList(L,AModule.InterfaceSection.Types);
  2415. AddElementsFromList(L,AModule.InterfaceSection.Functions);
  2416. AddElementsFromList(L,AModule.InterfaceSection.Classes);
  2417. AddElementsFromList(L,AModule.InterfaceSection.Variables);
  2418. AddElementsFromList(L,AModule.InterfaceSection.ResStrings);
  2419. end;
  2420. end;
  2421. procedure THTMLWriter.CreatePackageIndex;
  2422. Var
  2423. L : TStringList;
  2424. I : Integer;
  2425. M : TPasModule;
  2426. E : TPasElement;
  2427. S : String;
  2428. begin
  2429. L:=TStringList.Create;
  2430. try
  2431. L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
  2432. For I:=0 to Package.Modules.Count-1 do
  2433. begin
  2434. M:=TPasModule(Package.Modules[i]);
  2435. L.AddObject(M.Name,M);
  2436. AddModuleIdentifiers(M,L);
  2437. end;
  2438. AppendMenuBar(IndexSubIndex);
  2439. S:=Package.Name;
  2440. If Length(S)>0 then
  2441. Delete(S,1,1);
  2442. AppendTitle(Format(SDocPackageIndex, [S]));
  2443. CreateIndexPage(L);
  2444. Finally
  2445. L.Free;
  2446. end;
  2447. end;
  2448. procedure THTMLWriter.CreatePackagePageBody;
  2449. var
  2450. DocNode: TDocNode;
  2451. TableEl, TREl: TDOMElement;
  2452. i: Integer;
  2453. ThisModule: TPasModule;
  2454. L : TStringList;
  2455. begin
  2456. AppendMenuBar(0);
  2457. AppendTitle(Format(SDocPackageTitle, [Copy(Package.Name, 2, 256)]));
  2458. AppendShortDescr(CreatePara(BodyElement), Package);
  2459. AppendText(CreateH2(BodyElement), SDocUnits);
  2460. TableEl := CreateTable(BodyElement);
  2461. L:=TStringList.Create;
  2462. Try
  2463. L.Sorted:=True;
  2464. // Sort modules.
  2465. For I:=0 to Package.Modules.Count-1 do
  2466. L.AddObject(TPasModule(Package.Modules[i]).Name,TPasModule(Package.Modules[i]));
  2467. // Now create table.
  2468. for i:=0 to L.Count - 1 do
  2469. begin
  2470. ThisModule := TPasModule(L.Objects[i]);
  2471. TREl := CreateTR(TableEl);
  2472. AppendHyperlink(CreateCode(CreatePara(CreateTD_vtop(TREl))), ThisModule);
  2473. AppendShortDescrCell(TREl, ThisModule);
  2474. end;
  2475. Finally
  2476. L.Free;
  2477. end;
  2478. DocNode := Engine.FindDocNode(Package);
  2479. if Assigned(DocNode) then
  2480. begin
  2481. if Assigned(DocNode.Descr) then
  2482. AppendDescrSection(nil, BodyElement, DocNode.Descr, SDocDescription);
  2483. CreateTopicLinks(DocNode,Package);
  2484. end;
  2485. end;
  2486. Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
  2487. var
  2488. DocNode: TDocNode;
  2489. TableEl, TREl: TDOMElement;
  2490. First : Boolean;
  2491. ThisTopic: TPasElement;
  2492. begin
  2493. DocNode:=Node.FirstChild;
  2494. First:=True;
  2495. While Assigned(DocNode) do
  2496. begin
  2497. If DocNode.TopicNode then
  2498. begin
  2499. if first then
  2500. begin
  2501. First:=False;
  2502. AppendText(CreateH2(BodyElement), SDocRelatedTopics);
  2503. TableEl := CreateTable(BodyElement);
  2504. end;
  2505. TREl := CreateTR(TableEl);
  2506. ThisTopic:=FindTopicElement(DocNode);
  2507. if Assigned(ThisTopic) then
  2508. AppendHyperlink(CreateCode(CreatePara(CreateTD_vtop(TREl))), ThisTopic);
  2509. AppendShortDescrCell(TREl, ThisTopic);
  2510. end;
  2511. DocNode:=DocNode.NextSibling;
  2512. end;
  2513. end;
  2514. procedure THTMLWriter.CreateModuleIndexPage(AModule: TPasModule);
  2515. Var
  2516. L : TStringList;
  2517. begin
  2518. L:=TStringList.Create;
  2519. try
  2520. AddModuleIdentifiers(AModule,L);
  2521. AppendMenuBar(IndexSubIndex);
  2522. AppendTitle(Format(SDocModuleIndex, [AModule.Name]));
  2523. CreateIndexPage(L);
  2524. Finally
  2525. L.Free;
  2526. end;
  2527. end;
  2528. procedure THTMLWriter.CreateModulePageBody(AModule: TPasModule;
  2529. ASubpageIndex: Integer);
  2530. procedure CreateMainPage;
  2531. var
  2532. TableEl, TREl, TDEl, CodeEl: TDOMElement;
  2533. i: Integer;
  2534. UnitRef: TPasType;
  2535. DocNode: TDocNode;
  2536. begin
  2537. AppendMenuBar(0);
  2538. AppendTitle(Format(SDocUnitTitle, [AModule.Name]),AModule.Hints);
  2539. AppendShortDescr(CreatePara(BodyElement), AModule);
  2540. if AModule.InterfaceSection.UsesList.Count > 0 then
  2541. begin
  2542. TableEl := CreateTable(BodyElement);
  2543. AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'uses');
  2544. for i := 0 to AModule.InterfaceSection.UsesList.Count - 1 do
  2545. begin
  2546. UnitRef := TPasType(AModule.InterfaceSection.UsesList[i]);
  2547. DocNode := Engine.FindDocNode(UnitRef);
  2548. if Assigned(DocNode) and DocNode.IsSkipped then
  2549. continue;
  2550. TREl := CreateTR(TableEl);
  2551. TDEl := CreateTD_vtop(TREl);
  2552. CodeEl := CreateCode(CreatePara(TDEl));
  2553. AppendNbSp(CodeEl, 2);
  2554. AppendHyperlink(CodeEl, UnitRef);
  2555. if i < AModule.InterfaceSection.UsesList.Count - 1 then
  2556. AppendSym(CodeEl, ',')
  2557. else
  2558. AppendSym(CodeEl, ';');
  2559. AppendText(CodeEl, ' '); // Space for descriptions
  2560. AppendShortDescrCell(TREl, UnitRef);
  2561. end;
  2562. end;
  2563. DocNode := Engine.FindDocNode(AModule);
  2564. if Assigned(DocNode) then
  2565. begin
  2566. if Assigned(DocNode.Descr) then
  2567. AppendDescrSection(AModule, BodyElement, DocNode.Descr, SDocOverview);
  2568. ConvertNotes(AModule,DocNode.Notes);
  2569. CreateTopicLinks(DocNode,AModule);
  2570. end;
  2571. end;
  2572. procedure CreateSimpleSubpage(const ATitle: DOMString; AList: TFPList);
  2573. var
  2574. TableEl, TREl, TDEl, CodeEl: TDOMElement;
  2575. i, j: Integer;
  2576. Decl: TPasElement;
  2577. SortedList: TFPList;
  2578. DocNode: TDocNode;
  2579. S : String;
  2580. begin
  2581. AppendMenuBar(ASubpageIndex);
  2582. S:=ATitle;
  2583. AppendTitle(Format(SDocUnitTitle + ': %s', [AModule.Name, S]));
  2584. SortedList := TFPList.Create;
  2585. try
  2586. for i := 0 to AList.Count - 1 do
  2587. begin
  2588. Decl := TPasElement(AList[i]);
  2589. DocNode := Engine.FindDocNode(Decl);
  2590. if (not Assigned(DocNode)) or (not DocNode.IsSkipped) then
  2591. begin
  2592. j := 0;
  2593. while (j < SortedList.Count) and (CompareText(
  2594. TPasElement(SortedList[j]).PathName, Decl.PathName) < 0) do
  2595. Inc(j);
  2596. SortedList.Insert(j, Decl);
  2597. end;
  2598. end;
  2599. TableEl := CreateTable(BodyElement);
  2600. for i := 0 to SortedList.Count - 1 do
  2601. begin
  2602. Decl := TPasElement(SortedList[i]);
  2603. TREl := CreateTR(TableEl);
  2604. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  2605. AppendHyperlink(CodeEl, Decl);
  2606. AppendShortDescrCell(TREl, Decl);
  2607. end;
  2608. finally
  2609. SortedList.Free;
  2610. end;
  2611. end;
  2612. procedure CreateResStringsPage;
  2613. var
  2614. ParaEl: TDOMElement;
  2615. i, j: Integer;
  2616. Decl: TPasResString;
  2617. DocNode: TDocNode;
  2618. begin
  2619. AppendMenuBar(ResstrSubindex);
  2620. AppendTitle(Format(SDocUnitTitle + ': %s', [AModule.Name, SDocResStrings]));
  2621. for i := 0 to AModule.InterfaceSection.ResStrings.Count - 1 do
  2622. begin
  2623. Decl := TPasResString(AModule.InterfaceSection.ResStrings[i]);
  2624. CreateEl(BodyElement, 'a')['name'] := LowerCase(Decl.Name);
  2625. ParaEl := CreatePara(BodyElement);
  2626. AppendText(CreateCode(ParaEl), Decl.Name);
  2627. CreateEl(ParaEl, 'br');
  2628. AppendText(ParaEl, Decl.Expr.getDeclaration(true));
  2629. end;
  2630. end;
  2631. begin
  2632. case ASubpageIndex of
  2633. 0:
  2634. CreateMainPage;
  2635. ResstrSubindex:
  2636. CreateResStringsPage;
  2637. ConstsSubindex:
  2638. CreateSimpleSubpage(SDocConstants, AModule.InterfaceSection.Consts);
  2639. TypesSubindex:
  2640. CreateSimpleSubpage(SDocTypes, AModule.InterfaceSection.Types);
  2641. ClassesSubindex:
  2642. CreateSimpleSubpage(SDocClasses, AModule.InterfaceSection.Classes);
  2643. ProcsSubindex:
  2644. CreateSimpleSubpage(SDocProceduresAndFunctions, AModule.InterfaceSection.Functions);
  2645. VarsSubindex:
  2646. CreateSimpleSubpage(SDocVariables, AModule.InterfaceSection.Variables);
  2647. IndexSubIndex:
  2648. CreateModuleIndexPage(AModule);
  2649. end;
  2650. end;
  2651. procedure THTMLWriter.CreateConstPageBody(AConst: TPasConst);
  2652. var
  2653. TableEl, CodeEl: TDOMElement;
  2654. begin
  2655. AppendMenuBar(-1);
  2656. AppendTitle(AConst.Name,AConst.Hints);
  2657. AppendShortDescr(CreatePara(BodyElement), AConst);
  2658. AppendText(CreateH2(BodyElement), SDocDeclaration);
  2659. AppendSourceRef(AConst);
  2660. TableEl := CreateTable(BodyElement);
  2661. CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
  2662. AppendKw(CodeEl, 'const');
  2663. AppendText(CodeEl, ' ' + AConst.Name);
  2664. if Assigned(AConst.VarType) then
  2665. begin
  2666. AppendSym(CodeEl, ': ');
  2667. AppendType(CodeEl, TableEl, AConst.VarType, False);
  2668. end;
  2669. AppendPasSHFragment(CodeEl, ' = ' + AConst.Expr.GetDeclaration(True) + ';', 0);
  2670. FinishElementPage(AConst);
  2671. end;
  2672. procedure THTMLWriter.AppendTypeDecl(AType: TPasType; TableEl,CodeEl : TDomElement);
  2673. Var
  2674. TREl : TDomElement;
  2675. i: Integer;
  2676. s: String;
  2677. EnumType: TPasEnumType;
  2678. EnumValue: TPasEnumValue;
  2679. Variable: TPasVariable;
  2680. begin
  2681. // Alias
  2682. if AType.ClassType = TPasAliasType then
  2683. begin
  2684. if Assigned(TPasAliasType(AType).DestType) then
  2685. AppendHyperlink(CodeEl, TPasAliasType(AType).DestType)
  2686. else
  2687. AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
  2688. AppendSym(CodeEl, ';');
  2689. end else
  2690. // Class of
  2691. if AType.ClassType = TPasClassOfType then
  2692. begin
  2693. AppendKw(CodeEl, 'class of ');
  2694. AppendHyperlink(CodeEl, TPasClassOfType(AType).DestType);
  2695. AppendSym(CodeEl, ';');
  2696. end else
  2697. // Enumeration
  2698. if AType.ClassType = TPasEnumType then
  2699. begin
  2700. AppendSym(CodeEl, '(');
  2701. for i := 0 to TPasEnumType(AType).Values.Count - 1 do
  2702. begin
  2703. EnumValue := TPasEnumValue(TPasEnumType(AType).Values[i]);
  2704. TREl := CreateTR(TableEl);
  2705. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  2706. AppendShortDescrCell(TREl, EnumValue);
  2707. AppendNbSp(CodeEl, 2);
  2708. s := EnumValue.Name;
  2709. if EnumValue.AssignedValue<>'' then
  2710. s := s + ' = ' + EnumValue.AssignedValue;
  2711. if i < TPasEnumType(AType).Values.Count - 1 then
  2712. s := s + ',';
  2713. AppendPasSHFragment(CodeEl, s, 0);
  2714. end;
  2715. AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
  2716. end else
  2717. // Pointer type
  2718. if AType.ClassType = TPasPointerType then
  2719. begin
  2720. AppendSym(CodeEl, '^');
  2721. if Assigned(TPasPointerType(AType).DestType) then
  2722. AppendHyperlink(CodeEl, TPasPointerType(AType).DestType)
  2723. else
  2724. AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
  2725. AppendSym(CodeEl, ';');
  2726. end else
  2727. if AType.InheritsFrom(TPasProcedureType) then
  2728. begin
  2729. AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
  2730. AppendProcArgsSection(BodyElement, TPasProcedureType(AType));
  2731. end else
  2732. // Record
  2733. if AType.ClassType = TPasRecordType then
  2734. begin
  2735. CodeEl := AppendRecordType(CodeEl, TableEl, TPasRecordType(AType), 0);
  2736. AppendSym(CodeEl, ';');
  2737. end else
  2738. // Set
  2739. if AType.ClassType = TPasSetType then
  2740. begin
  2741. AppendKw(CodeEl, 'set of ');
  2742. if TPasSetType(AType).EnumType.ClassType = TPasEnumType then
  2743. begin
  2744. AppendSym(CodeEl, '(');
  2745. EnumType := TPasEnumType(TPasSetType(AType).EnumType);
  2746. for i := 0 to EnumType.Values.Count - 1 do
  2747. begin
  2748. EnumValue := TPasEnumValue(EnumType.Values[i]);
  2749. TREl := CreateTR(TableEl);
  2750. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  2751. AppendShortDescrCell(TREl, EnumValue);
  2752. AppendNbSp(CodeEl, 2);
  2753. s := EnumValue.Name;
  2754. if (EnumValue.AssignedValue<>'') then
  2755. s := s + ' = ' + EnumValue.AssignedValue;
  2756. if i < EnumType.Values.Count - 1 then
  2757. s := s + ',';
  2758. AppendPasSHFragment(CodeEl, s, 0);
  2759. end;
  2760. AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
  2761. end else
  2762. begin
  2763. AppendHyperlink(CodeEl, TPasSetType(AType).EnumType);
  2764. AppendSym(CodeEl, ';');
  2765. end;
  2766. end else
  2767. // Type alias
  2768. if AType.ClassType = TPasTypeAliasType then
  2769. begin
  2770. AppendKw(CodeEl, 'type ');
  2771. AppendHyperlink(CodeEl, TPasTypeAliasType(AType).DestType);
  2772. AppendSym(CodeEl, ';');
  2773. end else
  2774. // Probably one of the simple types, which allowed in other places as wel...
  2775. AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
  2776. end;
  2777. procedure THTMLWriter.CreateTypePageBody(AType: TPasType);
  2778. var
  2779. TableEl, TREl, TDEl, CodeEl: TDOMElement;
  2780. DocNode: TDocNode;
  2781. i: Integer;
  2782. s: String;
  2783. EnumType: TPasEnumType;
  2784. EnumValue: TPasEnumValue;
  2785. Variable: TPasVariable;
  2786. begin
  2787. AppendMenuBar(-1);
  2788. AppendTitle(AType.Name,AType.Hints);
  2789. AppendShortDescr(CreatePara(BodyElement), AType);
  2790. AppendText(CreateH2(BodyElement), SDocDeclaration);
  2791. AppendSourceRef(AType);
  2792. TableEl := CreateTable(BodyElement);
  2793. TREl := CreateTR(TableEl);
  2794. TDEl := CreateTD(TREl);
  2795. CodeEl := CreateCode(CreatePara(TDEl));
  2796. DocNode := Engine.FindDocNode(AType);
  2797. AppendKw(CodeEl, 'type ');
  2798. AppendText(CodeEl, AType.Name);
  2799. AppendSym(CodeEl, ' = ');
  2800. If Assigned(DocNode) and
  2801. Assigned(DocNode.Node) and
  2802. (Docnode.Node['opaque']='1') then
  2803. AppendText(CodeEl,SDocOpaque)
  2804. else
  2805. begin
  2806. AppendTypeDecl(AType,TableEl,CodeEl);
  2807. end;
  2808. FinishElementPage(AType);
  2809. end;
  2810. function PropertyFilter(AMember: TPasElement): Boolean;
  2811. begin
  2812. Result := (AMember.ClassType = TPasProperty) and
  2813. (Copy(AMember.Name, 1, 2) <> 'On');
  2814. end;
  2815. function MethodFilter(AMember: TPasElement): Boolean;
  2816. begin
  2817. Result := AMember.InheritsFrom(TPasProcedureBase);
  2818. end;
  2819. function EventFilter(AMember: TPasElement): Boolean;
  2820. begin
  2821. Result := (AMember.ClassType = TPasProperty) and
  2822. (Copy(AMember.Name, 1, 2) = 'On');
  2823. end;
  2824. procedure THTMLWriter.CreateMemberDeclarations(AParent : TPasElement; Members : TFPList; TableEl : TDOmelement; AddEnd : Boolean);
  2825. var
  2826. TREl, CodeEl: TDOMElement;
  2827. Member: TPasElement;
  2828. MVisibility,
  2829. CurVisibility: TPasMemberVisibility;
  2830. i: Integer;
  2831. s: String;
  2832. t : TPasType;
  2833. ah,ol,wt,ct,wc,cc : boolean;
  2834. isRecord : Boolean;
  2835. begin
  2836. isRecord:=AParent is TPasRecordType;
  2837. if Members.Count > 0 then
  2838. begin
  2839. wt:=False;
  2840. wc:=False;
  2841. CurVisibility := visDefault;
  2842. for i := 0 to Members.Count - 1 do
  2843. begin
  2844. Member := TPasElement(Members[i]);
  2845. MVisibility:=Member.Visibility;
  2846. ol:=(Member is TPasOverloadedProc);
  2847. ah:=ol or ((Member is TPasProcedure) and (TPasProcedure(Member).ProcType.Args.Count > 0));
  2848. if ol then
  2849. Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]);
  2850. if Not Engine.ShowElement(Member) then
  2851. continue;
  2852. if (CurVisibility <> MVisibility) then
  2853. begin
  2854. CurVisibility := MVisibility;
  2855. s:=VisibilityNames[MVisibility];
  2856. AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), s);
  2857. end;
  2858. ct:=(Member is TPasType);
  2859. if ct and (not wt) then
  2860. begin
  2861. AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Type');
  2862. end;
  2863. wt:=ct;
  2864. cc:=(Member is TPasConst);
  2865. if cc and (not wc) then
  2866. begin
  2867. AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Const');
  2868. end;
  2869. wc:=cc;
  2870. TREl := CreateTR(TableEl);
  2871. CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
  2872. AppendNbSp(CodeEl, 2);
  2873. AppendShortDescrCell(TREl, Member);
  2874. if (Member is TPasProcedureBase) then
  2875. begin
  2876. AppendKw(CodeEl, TPasProcedureBase(Member).TypeName + ' ');
  2877. AppendHyperlink(CodeEl, Member);
  2878. if ah then
  2879. AppendSym(CodeEl, '();')
  2880. else
  2881. AppendSym(CodeEl, ';');
  2882. if Not OL then
  2883. AppendProcExt(CodeEl, TPasProcedure(Member));
  2884. end
  2885. else if (Member is TPasConst) then
  2886. begin
  2887. AppendHyperlink(CodeEl, Member);
  2888. If Assigned(TPasConst(Member).VarType) then
  2889. begin
  2890. AppendSym(CodeEl, ' = ');
  2891. AppendTypeDecl(TPasType(Member),TableEl,CodeEl);
  2892. end;
  2893. AppendSym(CodeEl, ' = ');
  2894. AppendText(CodeEl,TPasConst(Member).Expr.GetDeclaration(True));
  2895. end
  2896. else if (Member is TPasType) then
  2897. begin
  2898. AppendHyperlink(CodeEl, Member);
  2899. AppendSym(CodeEl, ' = ');
  2900. AppendTypeDecl(TPasType(Member),TableEl,CodeEl);
  2901. end
  2902. else if (Member is TPasProperty) then
  2903. begin
  2904. AppendKw(CodeEl, 'property ');
  2905. AppendHyperlink(CodeEl, Member);
  2906. t:=TPasProperty(Member).ResolvedType;
  2907. if Assigned(TPasProperty(Member).Args) and (TPasProperty(Member).Args.Count>0) then
  2908. AppendText(CodeEl, ' []');
  2909. if Assigned(T) then
  2910. begin
  2911. AppendSym(CodeEl, ': ');
  2912. AppendHyperlink(CodeEl, T);
  2913. end;
  2914. AppendSym(CodeEl, ';');
  2915. if TPasProperty(Member).IsDefault then
  2916. begin
  2917. AppendKw(CodeEl, ' default');
  2918. AppendSym(CodeEl, ';');
  2919. end;
  2920. if (TPasProperty(Member).ImplementsName<>'') then
  2921. begin
  2922. AppendKw(CodeEl, ' implements');
  2923. AppendText(CodeEl, ' '+TPasProperty(Member).ImplementsName);
  2924. AppendSym(CodeEl, ';');
  2925. end;
  2926. SetLength(s, 0);
  2927. if Length(TPasProperty(Member).ReadAccessorName) > 0 then
  2928. s := s + 'r';
  2929. if Length(TPasProperty(Member).WriteAccessorName) > 0 then
  2930. s := s + 'w';
  2931. if Length(TPasProperty(Member).StoredAccessorName) > 0 then
  2932. s := s + 's';
  2933. if Length(s) > 0 then
  2934. AppendText(CodeEl, ' [' + s + ']');
  2935. end
  2936. else if (Member is TPasVariable) then
  2937. begin
  2938. if not isRecord then
  2939. AppendHyperlink(CodeEl, Member)
  2940. else
  2941. AppendText(CodeEl, Member.Name);
  2942. AppendSym(CodeEl, ': ');
  2943. AppendHyperlink(CodeEl, TPasVariable(Member).VarType);
  2944. AppendSym(CodeEl, ';');
  2945. end
  2946. else
  2947. AppendText(CreateWarning(CodeEl), '<' + Member.ClassName + '>');
  2948. if (Member.Hints<>[]) then
  2949. begin
  2950. AppendKW(CodeEl,' '+Engine.HintsToStr(Member.Hints));
  2951. AppendText(CodeEl, ' ');
  2952. AppendSym(CodeEl, ';');
  2953. end;
  2954. end;
  2955. CodeEl := CreateCode(CreatePara(CreateTD(CreateTR(TableEl))));
  2956. end;
  2957. AppendText(CodeEl, ' '); // !!!: Dirty trick, necessary for current XML writer
  2958. If AddEnd then
  2959. begin
  2960. AppendKw(CodeEl, 'end');
  2961. AppendSym(CodeEl, ';');
  2962. end;
  2963. end;
  2964. procedure THTMLWriter.CreateClassPageBody(AClass: TPasClassType;
  2965. ASubpageIndex: Integer);
  2966. type
  2967. TMemberFilter = function(AMember: TPasElement): Boolean;
  2968. var
  2969. ParaEl: TDOMElement;
  2970. procedure AppendMemberListLink(AListSubpageIndex: Integer;
  2971. const AText: DOMString);
  2972. var
  2973. LinkEl: TDOMElement;
  2974. begin
  2975. if FUseMenuBrackets then
  2976. AppendText(ParaEl, '[');
  2977. LinkEl := CreateEl(ParaEl, 'a');
  2978. LinkEl['href'] :=
  2979. FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex));
  2980. LinkEl['onClick'] := 'window.open(''' + LinkEl['href'] + ''', ''list'', ' +
  2981. '''dependent=yes,resizable=yes,scrollbars=yes,height=400,width=300''); return false;';
  2982. AppendText(LinkEl, AText);
  2983. AppendText(ParaEl, ' (');
  2984. LinkEl := CreateEl(ParaEl, 'a');
  2985. LinkEl['href'] :=
  2986. FixHtmlPath(ResolveLinkWithinPackage(AClass, AListSubpageIndex + 1));
  2987. LinkEl['onClick'] := 'window.open(''' + LinkEl['href'] + ''', ''list'', ' +
  2988. '''dependent=yes,resizable=yes,scrollbars=yes,height=400,width=300''); return false;';
  2989. AppendText(LinkEl, SDocByName);
  2990. AppendText(ParaEl, ')');
  2991. if FUseMenuBrackets then
  2992. AppendText(ParaEl, '] ')
  2993. else
  2994. AppendText(ParaEl, ' ');
  2995. end;
  2996. procedure AppendGenericTypes(CodeEl : TDomElement; AList : TFPList; isSpecialize : Boolean);
  2997. Var
  2998. I : integer;
  2999. begin
  3000. for I:=0 to AList.Count-1 do
  3001. begin
  3002. if I=0 then
  3003. AppendSym(CodeEl, '<')
  3004. else
  3005. AppendSym(CodeEl, ',');
  3006. AppendText(CodeEl,TPasGenericTemplateType(AList[i]).Name);
  3007. end;
  3008. AppendSym(CodeEl, '>');
  3009. end;
  3010. procedure CreateMainPage;
  3011. var
  3012. TableEl, TREl, TDEl, CodeEl: TDOMElement;
  3013. i: Integer;
  3014. ThisInterface,
  3015. ThisClass: TPasClassType;
  3016. HaveSeenTObject: Boolean;
  3017. LName : String;
  3018. ThisNode : TPasUnresolvedTypeRef;
  3019. begin
  3020. AppendMenuBar(-1);
  3021. AppendTitle(AClass.Name,AClass.Hints);
  3022. ParaEl := CreatePara(BodyElement);
  3023. AppendMemberListLink(PropertiesByInheritanceSubindex, SDocProperties);
  3024. AppendMemberListLink(MethodsByInheritanceSubindex, SDocMethods);
  3025. AppendMemberListLink(EventsByInheritanceSubindex, SDocEvents);
  3026. AppendShortDescr(CreatePara(BodyElement), AClass);
  3027. AppendText(CreateH2(BodyElement), SDocDeclaration);
  3028. AppendSourceRef(AClass);
  3029. TableEl := CreateTable(BodyElement);
  3030. TREl := CreateTR(TableEl);
  3031. TDEl := CreateTD(TREl);
  3032. CodeEl := CreateCode(CreatePara(TDEl));
  3033. AppendKw(CodeEl, 'type');
  3034. if AClass.ObjKind=okGeneric then
  3035. AppendKw(CodeEl, ' generic ');
  3036. AppendText(CodeEl, ' ' + AClass.Name + ' ');
  3037. if AClass.ObjKind=okGeneric then
  3038. AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,false);
  3039. AppendSym(CodeEl, '=');
  3040. AppendText(CodeEl, ' ');
  3041. AppendKw(CodeEl, ObjKindNames[AClass.ObjKind]);
  3042. if Assigned(AClass.AncestorType) then
  3043. begin
  3044. AppendSym(CodeEl, '(');
  3045. AppendHyperlink(CodeEl, AClass.AncestorType);
  3046. if AClass.Interfaces.count>0 Then
  3047. begin
  3048. for i:=0 to AClass.interfaces.count-1 do
  3049. begin
  3050. AppendSym(CodeEl, ', ');
  3051. AppendHyperlink(CodeEl,TPasClassType(AClass.Interfaces[i]));
  3052. end;
  3053. end;
  3054. AppendSym(CodeEl, ')');
  3055. end;
  3056. CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
  3057. AppendText(CreateH2(BodyElement), SDocInheritance);
  3058. TableEl := CreateTable(BodyElement);
  3059. HaveSeenTObject := AClass.ObjKind <> okClass;
  3060. // we try to track classes. But imported classes
  3061. // are TLinkNode's not the TPasClassType generated by the parser.
  3062. ThisClass := AClass; ThisNode := Nil;
  3063. while True do
  3064. begin
  3065. TREl := CreateTR(TableEl);
  3066. TDEl := CreateTD_vtop(TREl);
  3067. TDEl['align'] := 'center';
  3068. CodeEl := CreateCode(CreatePara(TDEl));
  3069. if Assigned(ThisClass) then
  3070. LName:=ThisClass.Name
  3071. Else
  3072. LName:=ThisNode.Name;
  3073. if Assigned(ThisClass) Then
  3074. AppendHyperlink(CodeEl, ThisClass)
  3075. else
  3076. AppendHyperlink(CodeEl, ThisNode);
  3077. if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
  3078. begin
  3079. for i:=0 to ThisClass.interfaces.count-1 do
  3080. begin
  3081. ThisInterface:=TPasClassType(ThisClass.Interfaces[i]);
  3082. AppendText(CodeEl,',');
  3083. AppendHyperlink(CodeEl, ThisInterface);
  3084. end;
  3085. end;
  3086. AppendShortDescrCell(TREl, ThisClass);
  3087. if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then
  3088. HaveSeenTObject := True
  3089. else
  3090. begin
  3091. TDEl := CreateTD(CreateTR(TableEl));
  3092. TDEl['align'] := 'center';
  3093. AppendText(TDEl, '|');
  3094. end;
  3095. if Assigned(ThisClass.AncestorType) then
  3096. begin
  3097. if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
  3098. ThisClass := TPasClassType(ThisClass.AncestorType)
  3099. else
  3100. begin
  3101. if thisclass.ancestortype is TPasUnresolvedTypeRef then
  3102. thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
  3103. TDEl := CreateTD(CreateTR(TableEl));
  3104. TDEl['align'] := 'center';
  3105. AppendText(CreateCode(CreatePara(TDEl)), ThisClass.AncestorType.Name);
  3106. if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then
  3107. HaveSeenTObject := True
  3108. else
  3109. begin
  3110. TDEl := CreateTD(CreateTR(TableEl));
  3111. TDEl['align'] := 'center';
  3112. AppendText(TDEl, '?');
  3113. end;
  3114. break;
  3115. end
  3116. end else
  3117. break;
  3118. end;
  3119. if not HaveSeenTObject then
  3120. begin
  3121. TDEl := CreateTD(CreateTR(TableEl));
  3122. TDEl['align'] := 'center';
  3123. AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
  3124. end;
  3125. FinishElementPage(AClass);
  3126. end;
  3127. procedure CreateInheritanceSubpage(AFilter: TMemberFilter);
  3128. var
  3129. ThisClass: TPasClassType;
  3130. i: Integer;
  3131. Member: TPasElement;
  3132. TableEl, TREl, TDEl, ParaEl, LinkEl: TDOMElement;
  3133. begin
  3134. TableEl := CreateTable(BodyElement);
  3135. ThisClass := AClass;
  3136. while True do
  3137. begin
  3138. TREl := CreateTR(TableEl);
  3139. TDEl := CreateTD(TREl);
  3140. TDEl['colspan'] := '3';
  3141. CreateTD(TREl);
  3142. LinkEl := AppendHyperlink(CreateEl(CreateCode(CreatePara(TDEl)), 'b'), ThisClass);
  3143. if Assigned(LinkEl) then
  3144. LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
  3145. '''; return false;';
  3146. for i := 0 to ThisClass.Members.Count - 1 do
  3147. begin
  3148. Member := TPasElement(ThisClass.Members[i]);
  3149. if Not (Engine.ShowElement(Member) and AFilter(Member)) then
  3150. continue;
  3151. TREl := CreateTR(TableEl);
  3152. ParaEl := CreatePara(CreateTD(TREl));
  3153. case Member.Visibility of
  3154. visPrivate:
  3155. AppendText(ParaEl, 'pv');
  3156. visProtected:
  3157. AppendText(ParaEl, 'pt');
  3158. visPublished:
  3159. AppendText(ParaEl, 'pl');
  3160. end;
  3161. AppendNbSp(ParaEl, 1);
  3162. ParaEl := CreateTD(TREl);
  3163. if (Member.ClassType = TPasProperty) and
  3164. (Length(TPasProperty(Member).WriteAccessorName) = 0) then
  3165. begin
  3166. AppendText(ParaEl, 'ro');
  3167. AppendNbSp(ParaEl, 1);
  3168. end;
  3169. LinkEl := AppendHyperlink(CreatePara(CreateTD(TREl)), Member);
  3170. if Assigned(LinkEl) then
  3171. LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
  3172. '''; return false;';
  3173. end;
  3174. if (not Assigned(ThisClass.AncestorType)) or
  3175. (not (ThisClass.AncestorType.ClassType.inheritsfrom(TPasClassType))) then
  3176. break;
  3177. ThisClass := TPasClassType(ThisClass.AncestorType);
  3178. AppendNbSp(CreatePara(CreateTD(CreateTR(TableEl))), 1);
  3179. end;
  3180. end;
  3181. procedure CreateSortedSubpage(AFilter: TMemberFilter);
  3182. var
  3183. List: TFPList;
  3184. ThisClass: TPasClassType;
  3185. i, j: Integer;
  3186. Member: TPasElement;
  3187. TableEl, TREl, TDEl, ParaEl, LinkEl: TDOMElement;
  3188. begin
  3189. List := TFPList.Create;
  3190. try
  3191. ThisClass := AClass;
  3192. while True do
  3193. begin
  3194. for i := 0 to ThisClass.Members.Count - 1 do
  3195. begin
  3196. Member := TPasElement(ThisClass.Members[i]);
  3197. if Engine.ShowElement(Member) and AFilter(Member) then
  3198. begin
  3199. j := 0;
  3200. while (j < List.Count) and
  3201. (CompareText(TPasElement(List[j]).Name, Member.Name) < 0) do
  3202. Inc(j);
  3203. List.Insert(j, Member);
  3204. end;
  3205. end;
  3206. if (not Assigned(ThisClass.AncestorType)) or
  3207. (not (ThisClass.AncestorType.ClassType.inheritsfrom(TPasClassType))) then
  3208. break;
  3209. ThisClass := TPasClassType(ThisClass.AncestorType);
  3210. end;
  3211. TableEl := CreateTable(BodyElement);
  3212. for i := 0 to List.Count - 1 do
  3213. begin
  3214. Member := TPasElement(List[i]);
  3215. TREl := CreateTR(TableEl);
  3216. ParaEl := CreatePara(CreateTD(TREl));
  3217. case Member.Visibility of
  3218. visPrivate:
  3219. AppendText(ParaEl, 'pv');
  3220. visProtected:
  3221. AppendText(ParaEl, 'pt');
  3222. visPublished:
  3223. AppendText(ParaEl, 'pl');
  3224. end;
  3225. AppendNbSp(ParaEl, 1);
  3226. ParaEl := CreatePara(CreateTD(TREl));
  3227. if (Member.ClassType = TPasProperty) and
  3228. (Length(TPasProperty(Member).WriteAccessorName) = 0) then
  3229. begin
  3230. AppendText(ParaEl, 'ro');
  3231. AppendNbSp(ParaEl, 1);
  3232. end;
  3233. TDEl := CreateTD(TREl);
  3234. TDEl['nowrap'] := 'nowrap';
  3235. ParaEl := CreatePara(TDEl);
  3236. LinkEl := AppendHyperlink(ParaEl, Member);
  3237. if Assigned(LinkEl) then
  3238. LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
  3239. '''; return false;';
  3240. AppendText(ParaEl, ' (');
  3241. LinkEl := AppendHyperlink(ParaEl, Member.Parent);
  3242. if Assigned(LinkEl) then
  3243. LinkEl['onClick'] := 'opener.location.href = ''' + LinkEl['href'] +
  3244. '''; return false;';
  3245. AppendText(ParaEl, ')');
  3246. end;
  3247. finally
  3248. List.Free;
  3249. end;
  3250. end;
  3251. begin
  3252. case ASubpageIndex of
  3253. 0:
  3254. CreateMainPage;
  3255. PropertiesByInheritanceSubindex:
  3256. CreateInheritanceSubpage(@PropertyFilter);
  3257. PropertiesByNameSubindex:
  3258. CreateSortedSubpage(@PropertyFilter);
  3259. MethodsByInheritanceSubindex:
  3260. CreateInheritanceSubpage(@MethodFilter);
  3261. MethodsByNameSubindex:
  3262. CreateSortedSubpage(@MethodFilter);
  3263. EventsByInheritanceSubindex:
  3264. CreateInheritanceSubpage(@EventFilter);
  3265. EventsByNameSubindex:
  3266. CreateSortedSubpage(@EventFilter);
  3267. end;
  3268. end;
  3269. procedure THTMLWriter.CreateClassMemberPageBody(AElement: TPasElement);
  3270. var
  3271. TableEl, TREl, CodeEl: TDOMElement;
  3272. procedure CreateVarPage(Element: TPasVariable);
  3273. begin
  3274. AppendHyperlink(CodeEl, Element.Parent);
  3275. AppendSym(CodeEl, '.');
  3276. AppendText(CodeEl, Element.Name);
  3277. if Assigned(Element.VarType) then
  3278. begin
  3279. AppendSym(CodeEl, ' : ');
  3280. AppendSym(AppendType(CodeEl, TableEl, Element.VarType, False), ';');
  3281. end;
  3282. end;
  3283. procedure CreateTypePage(Element: TPasType);
  3284. begin
  3285. AppendKw(CodeEl, 'type ');
  3286. AppendHyperlink(CodeEl, Element.Parent);
  3287. AppendSym(CodeEl, '.');
  3288. AppendText(CodeEl, Element.Name);
  3289. AppendSym(CodeEl, ' = ');
  3290. AppendTypeDecl(Element,TableEl,CodeEl)
  3291. end;
  3292. procedure CreateConstPage(Element: TPasConst);
  3293. begin
  3294. AppendKw(CodeEl, 'const ');
  3295. AppendHyperlink(CodeEl, Element.Parent);
  3296. AppendSym(CodeEl, '.');
  3297. AppendText(CodeEl, Element.Name);
  3298. if Assigned(Element.VarType) then
  3299. begin
  3300. AppendSym(CodeEl, ': ');
  3301. AppendType(CodeEl, TableEl, Element.VarType, False);
  3302. end;
  3303. AppendPasSHFragment(CodeEl, ' = ' + Element.Expr.GetDeclaration(True) + ';', 0);
  3304. end;
  3305. procedure CreatePropertyPage(Element: TPasProperty);
  3306. var
  3307. NeedBreak: Boolean;
  3308. T : TPasType;
  3309. A : TPasArgument;
  3310. I : integer;
  3311. begin
  3312. AppendKw(CodeEl, 'property ');
  3313. AppendHyperlink(CodeEl, Element.Parent);
  3314. AppendSym(CodeEl, '.');
  3315. AppendText(CodeEl, Element.Name);
  3316. if Assigned(Element.Args) and (Element.Args.Count>0) then
  3317. begin
  3318. AppendSym(CodeEl,'[');
  3319. For I:=0 to Element.Args.Count-1 do
  3320. begin
  3321. If I>0 then
  3322. AppendSym(CodeEl,',');
  3323. A:=TPasArgument(Element.Args[i]);
  3324. AppendText(CodeEl, A.Name);
  3325. AppendSym(CodeEl,': ');
  3326. if Assigned(A.ArgType) then
  3327. AppendText(CodeEl,A.ArgType.Name)
  3328. else
  3329. AppendText(CodeEl,'<Unknown>');
  3330. end;
  3331. AppendSym(CodeEl,']');
  3332. end;
  3333. T:=Element.ResolvedType;
  3334. if Assigned(T) then
  3335. begin
  3336. AppendSym(CodeEl, ' : ');
  3337. AppendType(CodeEl, TableEl, T, False);
  3338. end;
  3339. NeedBreak := False;
  3340. if Length(TPasProperty(Element).IndexValue) <> 0 then
  3341. begin
  3342. CreateEl(CodeEl, 'br');
  3343. AppendNbsp(CodeEl, 2);
  3344. AppendKw(CodeEl, 'index ');
  3345. AppendPasSHFragment(CodeEl, TPasProperty(Element).IndexValue, 0);
  3346. NeedBreak := True;
  3347. end;
  3348. if Length(TPasProperty(Element).ReadAccessorName) <> 0 then
  3349. begin
  3350. CreateEl(CodeEl, 'br');
  3351. AppendNbsp(CodeEl, 2);
  3352. AppendKw(CodeEl, 'read ');
  3353. AppendText(CodeEl, TPasProperty(Element).ReadAccessorName);
  3354. NeedBreak := True;
  3355. end;
  3356. if Length(TPasProperty(Element).WriteAccessorName) <> 0 then
  3357. begin
  3358. CreateEl(CodeEl, 'br');
  3359. AppendNbsp(CodeEl, 2);
  3360. AppendKw(CodeEl, 'write ');
  3361. AppendText(CodeEl, TPasProperty(Element).WriteAccessorName);
  3362. NeedBreak := True;
  3363. end;
  3364. if Length(TPasProperty(Element).StoredAccessorName) <> 0 then
  3365. begin
  3366. CreateEl(CodeEl, 'br');
  3367. AppendNbsp(CodeEl, 2);
  3368. AppendKw(CodeEl, 'stored ');
  3369. AppendText(CodeEl, TPasProperty(Element).StoredAccessorName);
  3370. NeedBreak := True;
  3371. end;
  3372. if Length(TPasProperty(Element).DefaultValue) <> 0 then
  3373. begin
  3374. CreateEl(CodeEl, 'br');
  3375. AppendNbsp(CodeEl, 2);
  3376. AppendKw(CodeEl, 'default ');
  3377. AppendPasSHFragment(CodeEl, TPasProperty(Element).DefaultValue, 0);
  3378. NeedBreak := True;
  3379. end;
  3380. AppendSym(CodeEl, ';');
  3381. if TPasProperty(Element).IsDefault or TPasProperty(Element).IsNodefault then
  3382. begin
  3383. if NeedBreak then
  3384. begin
  3385. CreateEl(CodeEl, 'br');
  3386. AppendNbsp(CodeEl, 2);
  3387. end;
  3388. if TPasProperty(Element).IsDefault then
  3389. AppendKw(CodeEl, 'default')
  3390. else
  3391. AppendKw(CodeEl, 'nodefault');
  3392. AppendSym(CodeEl, ';');
  3393. end;
  3394. end;
  3395. var
  3396. s: String;
  3397. DocNode: TDocNode;
  3398. begin
  3399. AppendMenuBar(-1);
  3400. AppendTitle(AElement.FullName,AElement.Hints);
  3401. AppendShortDescr(CreatePara(BodyElement), AElement);
  3402. AppendText(CreateH2(BodyElement), SDocDeclaration);
  3403. AppendSourceRef(AElement);
  3404. TableEl := CreateTable(BodyElement);
  3405. TREl := CreateTR(TableEl);
  3406. CodeEl := CreateCode(CreatePara(CreateTD(TREl)));
  3407. AppendText(CodeEl, ' '); // !!!: Workaround for current HTML writer
  3408. if (AElement.Visibility<>visDefault) then
  3409. begin
  3410. s:=VisibilityNames[AElement.Visibility];
  3411. AppendKw(CodeEl, s);
  3412. end;
  3413. AppendText(CodeEl, ' ');
  3414. if AElement is TPasProperty then
  3415. CreatePropertyPage(TPasProperty(AElement))
  3416. else if AElement is TPasConst then
  3417. CreateConstPage(TPasConst(AElement))
  3418. else if (AElement is TPasVariable) then
  3419. CreateVarPage(TPasVariable(AElement))
  3420. else if AElement is TPasProcedureBase then
  3421. AppendProcDecl(CodeEl, TableEl, TPasProcedureBase(AElement))
  3422. else if AElement is TPasType then
  3423. CreateTypePage(TPasType(AElement))
  3424. else
  3425. AppendText(CreateWarning(BodyElement), '<' + AElement.ClassName + '>');
  3426. FinishElementPage(AElement);
  3427. end;
  3428. procedure THTMLWriter.CreateVarPageBody(AVar: TPasVariable);
  3429. var
  3430. TableEl, TREl, TDEl, CodeEl, El: TDOMElement;
  3431. DocNode: TDocNode;
  3432. begin
  3433. AppendMenuBar(-1);
  3434. AppendTitle(AVar.FullName,AVar.Hints);
  3435. AppendShortDescr(CreatePara(BodyElement), AVar);
  3436. AppendText(CreateH2(BodyElement), SDocDeclaration);
  3437. AppendSourceRef(AVar);
  3438. TableEl := CreateTable(BodyElement);
  3439. TREl := CreateTR(TableEl);
  3440. TDEl := CreateTD(TREl);
  3441. CodeEl := CreateCode(CreatePara(TDEl));
  3442. AppendKw(CodeEl, 'var');
  3443. AppendText(CodeEl, ' ' + AVar.Name);
  3444. if Assigned(AVar.VarType) then
  3445. begin
  3446. AppendSym(CodeEl, ': ');
  3447. El := AppendType(CodeEl, TableEl, AVar.VarType, False);
  3448. end else
  3449. El := CodeEl;
  3450. if Length(AVar.Value) > 0 then
  3451. AppendPasSHFragment(El, ' = ' + AVar.Value + ';', 0)
  3452. else
  3453. AppendSym(El, ';');
  3454. FinishElementPage(AVar);
  3455. end;
  3456. procedure THTMLWriter.CreateProcPageBody(AProc: TPasProcedureBase);
  3457. var
  3458. TableEl, TREl, TDEl, CodeEl: TDOMElement;
  3459. begin
  3460. AppendMenuBar(-1);
  3461. AppendTitle(AProc.Name,AProc.Hints);
  3462. AppendShortDescr(CreatePara(BodyElement), AProc);
  3463. AppendText(CreateH2(BodyElement), SDocDeclaration);
  3464. AppendSourceRef(AProc);
  3465. TableEl := CreateTable(BodyElement);
  3466. TREl := CreateTR(TableEl);
  3467. TDEl := CreateTD(TREl);
  3468. CodeEl := CreateCode(CreatePara(TDEl));
  3469. AppendProcDecl(CodeEl, TableEl, AProc);
  3470. FinishElementPage(AProc);
  3471. end;
  3472. Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean;
  3473. begin
  3474. Result:=True;
  3475. if Cmd = '--html-search' then
  3476. SearchPage := Arg
  3477. else if Cmd = '--footer' then
  3478. FooterFile := Arg
  3479. else if Cmd = '--charset' then
  3480. CharSet := Arg
  3481. else if Cmd = '--index-colcount' then
  3482. IndexColCount := StrToIntDef(Arg,IndexColCount)
  3483. else if Cmd = '--image-url' then
  3484. FBaseImageURL := Arg
  3485. else if Cmd = '--css-file' then
  3486. FCSSFile := arg
  3487. else if Cmd = '--footer-date' then
  3488. begin
  3489. FIDF:=True;
  3490. FDateFormat:=Arg;
  3491. end
  3492. else if Cmd = '--disable-menu-brackets' then
  3493. FUseMenuBrackets:=False
  3494. else
  3495. Result:=False;
  3496. end;
  3497. procedure THTMLWriter.WriteDoc;
  3498. begin
  3499. DoLog(SWritingPages, [PageCount]);
  3500. WriteHTMLPages;
  3501. end;
  3502. class procedure THTMLWriter.Usage(List: TStrings);
  3503. begin
  3504. List.add('--footer');
  3505. List.Add(SHTMLUsageFooter);
  3506. List.Add('--footer-date[=Fmt]');
  3507. List.Add(SHTMLUsageFooterDate);
  3508. List.Add('--charset=set');
  3509. List.Add(SHTMLUsageCharset);
  3510. List.Add('--html-search=pagename');
  3511. List.Add(SHTMLHtmlSearch);
  3512. List.Add('--index-colcount=N');
  3513. List.Add(SHTMLIndexColcount);
  3514. List.Add('--image-url=url');
  3515. List.Add(SHTMLImageUrl);
  3516. List.Add('--disable-menu-brackets');
  3517. List.Add(SHTMLDisableMenuBrackets);
  3518. end;
  3519. class procedure THTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);
  3520. var
  3521. i: integer;
  3522. begin
  3523. i := Pos(',', AFilename);
  3524. if i > 0 then
  3525. begin //split into filename and prefix
  3526. ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
  3527. SetLength(AFilename, i-1);
  3528. end
  3529. else if ALinkPrefix = '' then
  3530. begin //synthesize outdir\pgk.xct, ..\pkg
  3531. ALinkPrefix := '../' + ChangeFileExt(ExtractFileName(AFilename), '');
  3532. AFilename := ChangeFileExt(AFilename, '.xct');
  3533. end;
  3534. end;
  3535. Class Function THTMLWriter.FileNameExtension : String;
  3536. begin
  3537. result:='';
  3538. end;
  3539. // private methods
  3540. function THTMLWriter.GetPageCount: Integer;
  3541. begin
  3542. Result := PageInfos.Count;
  3543. end;
  3544. procedure THTMLWriter.SetOnTest(const AValue: TNotifyEvent);
  3545. begin
  3546. if FOnTest=AValue then exit;
  3547. FOnTest:=AValue;
  3548. end;
  3549. procedure THTMLWriter.CreateAllocator;
  3550. begin
  3551. FAllocator:=TLongNameFileAllocator.Create('.html');
  3552. end;
  3553. procedure THTMWriter.CreateAllocator;
  3554. begin
  3555. FAllocator:=TShortNameFileAllocator.Create('.htm');
  3556. end;
  3557. initialization
  3558. // Do not localize.
  3559. RegisterWriter(THTMLWriter,'html','HTML output using fpdoc.css stylesheet.');
  3560. RegisterWriter(THTMWriter,'htm','HTM (8.3 filenames) output using fpdoc.css stylesheet.');
  3561. RegisterWriter(TCHMHTMLWriter,'chm','Compressed HTML file output using fpdoc.css stylesheet.');
  3562. finalization
  3563. UnRegisterWriter('html');
  3564. UnRegisterWriter('htm');
  3565. UnRegisterWriter('chm');
  3566. end.