2
0

dw_html.pp 111 KB

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