dw_html.pp 111 KB

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