dw_ipflin.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125
  1. {
  2. FPDoc IPF Writer
  3. Copyright (c) 2010 by Graeme Geldenhuys ([email protected])
  4. * Linear IPF output for use with fpGUI or OS/2's help systems.
  5. See the file COPYING, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. }
  11. unit dw_ipflin;
  12. {$mode objfpc}{$H+}
  13. interface
  14. uses
  15. Classes, DOM, dGlobals, PasTree, dwLinear;
  16. const
  17. { Change this into the name of your writer}
  18. IPFWriterName = 'ipf';
  19. { Comprehensible description goes here:}
  20. SIPFUsageWriterDescr = 'Writes output in fpGUI and OS/2''s IPF help format';
  21. { Extension for the template }
  22. TIPFExtension = '.ipf';
  23. type
  24. TIPFNewWriter = class(TLinearWriter)
  25. private
  26. InPackageOverview: Boolean;
  27. InHeading: Boolean;
  28. FInHeadingText: string;
  29. OrderedList: boolean;
  30. TableRowStartFlag: Boolean;
  31. TableCaptionWritten: Boolean;
  32. InTableCell: Boolean;
  33. InTypesDeclaration: Boolean;
  34. SuspendWriting: Boolean;
  35. LastSubSection: String;
  36. protected
  37. FLink: String;
  38. FTableCount : Integer;
  39. FInVerbatim : Boolean;
  40. Inlist,
  41. fColCount: integer;
  42. // extras
  43. procedure Write(const s: String); override;
  44. procedure WriteBeginDocument; override;
  45. procedure WriteEndDocument; override;
  46. // Linear documentation methods overrides;
  47. procedure WriteLabel(Const S : String); override;
  48. procedure WriteIndex(Const S : String); override;
  49. procedure WriteType(const s: string); override;
  50. procedure WriteVariable(const s: string); override;
  51. procedure WriteConstant(const s: string); override;
  52. Procedure WriteExampleFile(FN : String); override;
  53. Procedure StartProcedure; override;
  54. Procedure EndProcedure; override;
  55. Procedure StartProperty; override;
  56. Procedure EndProperty; override;
  57. Procedure StartSynopsis; override;
  58. Procedure StartDeclaration; override;
  59. Procedure StartVisibility; override;
  60. Procedure StartDescription; override;
  61. Procedure StartAccess; override;
  62. Procedure StartErrors; override;
  63. Procedure StartVersion; override;
  64. Procedure StartSeealso; override;
  65. Procedure EndSeealso; override;
  66. procedure StartUnitOverview(AModuleName,AModuleLabel : String);override;
  67. procedure WriteUnitEntry(UnitRef : TPasType); override;
  68. Procedure EndUnitOverview; override;
  69. function GetLabel(AElement: TPasElement): String; override;
  70. procedure StartListing(Frames: Boolean; const name: String); override;
  71. procedure EndListing; override;
  72. Function EscapeText(S : String) : String; override;
  73. Function StripText(S : String) : String; override;
  74. procedure WriteCommentLine; override;
  75. procedure WriteComment(Comment : String);override;
  76. procedure StartSection(SectionName : String);override;
  77. procedure StartSubSection(SubSectionName : String);override;
  78. procedure StartSubSubSection(SubSubSectionName : String);override;
  79. procedure StartChapter(ChapterName : String); override;
  80. procedure StartOverview(WithAccess : Boolean); override;
  81. procedure EndOverview; override;
  82. procedure WriteOverviewMember(const ALabel,AName,Access,ADescr : String); override;
  83. procedure WriteOverviewMember(const ALabel,AName,ADescr : String); override;
  84. procedure DescrBeginURL(const AURL: DOMString); override;
  85. procedure DescrEndURL; override;
  86. // Description node conversion. Overrides for TFPDocWriter.
  87. procedure DescrBeginBold; override;
  88. procedure DescrEndBold; override;
  89. procedure DescrBeginItalic; override;
  90. procedure DescrEndItalic; override;
  91. procedure DescrBeginEmph; override;
  92. procedure DescrEndEmph; override;
  93. procedure DescrWriteText(const AText: DOMString); override;
  94. procedure DescrWriteFileEl(const AText: DOMString); override;
  95. procedure DescrWriteKeywordEl(const AText: DOMString); override;
  96. procedure DescrWriteVarEl(const AText: DOMString); override;
  97. procedure DescrBeginLink(const AId: DOMString); override;
  98. procedure DescrEndLink; override;
  99. procedure DescrWriteLinebreak; override;
  100. procedure DescrBeginParagraph; override;
  101. procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
  102. procedure DescrWriteCodeLine(const ALine: String); override;
  103. procedure DescrEndCode; override;
  104. procedure DescrEndParagraph; override;
  105. procedure DescrBeginOrderedList; override;
  106. procedure DescrEndOrderedList; override;
  107. procedure DescrBeginUnorderedList; override;
  108. procedure DescrEndUnorderedList; override;
  109. procedure DescrBeginDefinitionList; override;
  110. procedure DescrEndDefinitionList; override;
  111. procedure DescrBeginListItem; override;
  112. procedure DescrEndListItem; override;
  113. procedure DescrBeginDefinitionTerm; override;
  114. procedure DescrEndDefinitionTerm; override;
  115. procedure DescrBeginDefinitionEntry; override;
  116. procedure DescrEndDefinitionEntry; override;
  117. procedure DescrBeginSectionTitle; override;
  118. procedure DescrBeginSectionBody; override;
  119. procedure DescrEndSection; override;
  120. procedure DescrBeginRemark; override;
  121. procedure DescrEndRemark; override;
  122. procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
  123. procedure DescrEndTable; override;
  124. procedure DescrBeginTableCaption; override;
  125. procedure DescrEndTableCaption; override;
  126. procedure DescrBeginTableHeadRow; override;
  127. procedure DescrEndTableHeadRow; override;
  128. procedure DescrBeginTableRow; override;
  129. procedure DescrEndTableRow; override;
  130. procedure DescrBeginTableCell; override;
  131. procedure DescrEndTableCell; override;
  132. // TFPDocWriter class methods
  133. public
  134. constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  135. class function FileNameExtension: string; override;
  136. procedure WriteClassInheritanceOverview(ClassDecl: TPasClassType); override;
  137. end;
  138. implementation
  139. uses
  140. SysUtils, dwriter, dbugintf;
  141. { TFPDocWriter overrides }
  142. procedure TIPFNewWriter.DescrBeginBold;
  143. begin
  144. { Start bold output }
  145. WriteLn(':hp2.');
  146. end;
  147. procedure TIPFNewWriter.DescrEndBold;
  148. begin
  149. { End bold output }
  150. WriteLn(':ehp2.');
  151. end;
  152. procedure TIPFNewWriter.DescrBeginItalic;
  153. begin
  154. { Start italic output }
  155. WriteLn(':hp1.');
  156. end;
  157. procedure TIPFNewWriter.DescrEndItalic;
  158. begin
  159. { End italic output }
  160. WriteLn(':ehp1.');
  161. end;
  162. procedure TIPFNewWriter.DescrBeginEmph;
  163. begin
  164. { Start emphasized output }
  165. Write(':hp1.');
  166. end;
  167. procedure TIPFNewWriter.DescrEndEmph;
  168. begin
  169. { End emphasized output }
  170. Write(':ehp1.');
  171. end;
  172. procedure TIPFNewWriter.DescrWriteText(const AText: DOMString);
  173. const
  174. cMax = 100;
  175. var
  176. sl: TStringlist;
  177. ns: string;
  178. i: integer;
  179. lText: string;
  180. begin
  181. // IPF has an imposed line length limit.
  182. if (Length(AText) > cMax) then // then we need to wrap the text.
  183. begin
  184. lText := WrapText(AText, LineEnding, [' ', '-', #9], cMax);
  185. sl := TStringlist.Create;
  186. try
  187. sl.Text := lText;
  188. for i := 0 to sl.Count-1 do
  189. inherited DescrWriteText(sl.Strings[i] + LineEnding);
  190. finally
  191. sl.Free;
  192. end;
  193. end
  194. else
  195. inherited DescrWriteText(AText);
  196. end;
  197. procedure TIPFNewWriter.DescrWriteFileEl(const AText: DOMString);
  198. begin
  199. { format as file name }
  200. Write(':hp3.');
  201. DescrWriteText(AText);
  202. Write(':ehp3.');
  203. end;
  204. procedure TIPFNewWriter.DescrWriteKeywordEl(const AText: DOMString);
  205. begin
  206. { Format as keyword }
  207. Write(':hp1.');
  208. DescrWriteText(AText);
  209. Write(':ehp1.');
  210. end;
  211. procedure TIPFNewWriter.DescrWriteVarEl(const AText: DOMString);
  212. begin
  213. { Format as variable }
  214. Write(':hp1.');
  215. DescrWriteText(AText);
  216. Write(':ehp1.');
  217. end;
  218. procedure TIPFNewWriter.DescrBeginLink(const AId: DOMString);
  219. begin
  220. { Start link to label ID - links are never nested.}
  221. FLink := Engine.ResolveLink(Module, AId);
  222. FLink := StringReplace(FLink, ':', '_', [rfReplaceAll]);
  223. FLink := StringReplace(FLink, '.', '_', [rfReplaceAll]);
  224. WriteF(':link reftype=hd refid=%s.', [flink]);
  225. end;
  226. procedure TIPFNewWriter.DescrEndLink;
  227. begin
  228. { End link to label ID}
  229. Write(':elink.');
  230. end;
  231. procedure TIPFNewWriter.DescrWriteLinebreak;
  232. begin
  233. { Start a new line. }
  234. WriteLn('');
  235. WriteLn('.br'); // must be at the beginning of a line, hence the previous writeln call
  236. end;
  237. procedure TIPFNewWriter.DescrBeginParagraph;
  238. begin
  239. { Start a new paragraph }
  240. Writeln(':p.');
  241. end;
  242. procedure TIPFNewWriter.DescrEndParagraph;
  243. begin
  244. { End current paragraph }
  245. writeln('');
  246. end;
  247. procedure TIPFNewWriter.DescrBeginCode(HasBorder: Boolean;
  248. const AHighlighterName: String);
  249. begin
  250. { Start block of code }
  251. StartListing(HasBorder,'');
  252. end;
  253. procedure TIPFNewWriter.DescrWriteCodeLine(const ALine: String);
  254. begin
  255. { Write line of code }
  256. DescrWriteText(ALine + LineEnding);
  257. // writeln(EscapeText(ALine));
  258. end;
  259. procedure TIPFNewWriter.DescrEndCode;
  260. begin
  261. { End block of code }
  262. EndListing;
  263. end;
  264. procedure TIPFNewWriter.DescrBeginOrderedList;
  265. begin
  266. { Start numbered list }
  267. OrderedList := True;
  268. writeln('');
  269. writeln(':ol.');
  270. end;
  271. procedure TIPFNewWriter.DescrEndOrderedList;
  272. begin
  273. { End numbered list }
  274. writeln('');
  275. writeln(':eol.');
  276. // writeln(':p.');
  277. end;
  278. procedure TIPFNewWriter.DescrBeginUnorderedList;
  279. begin
  280. { Start bulleted list }
  281. OrderedList := False;
  282. writeln('');
  283. if not InTableCell then
  284. writeln(':ul.')
  285. else
  286. writeln(':lines.');
  287. end;
  288. procedure TIPFNewWriter.DescrEndUnorderedList;
  289. begin
  290. { End bulleted list }
  291. writeln('');
  292. if not InTableCell then
  293. writeln(':eul.')
  294. else
  295. writeln(':elines.');
  296. end;
  297. procedure TIPFNewWriter.DescrBeginDefinitionList;
  298. begin
  299. { Start definition list }
  300. writeln('');
  301. writeln(':dl tsize=25 compact.');
  302. end;
  303. procedure TIPFNewWriter.DescrEndDefinitionList;
  304. begin
  305. { End definition list }
  306. writeln('');
  307. writeln(':edl.');
  308. // writeln(':p.');
  309. end;
  310. procedure TIPFNewWriter.DescrBeginListItem;
  311. begin
  312. { Start list item (both bulleted/numbered) }
  313. if not InTableCell then
  314. write(':li.');
  315. end;
  316. procedure TIPFNewWriter.DescrEndListItem;
  317. begin
  318. { End list item (both bulleted/numbered) }
  319. writeln('');
  320. end;
  321. procedure TIPFNewWriter.DescrBeginDefinitionTerm;
  322. begin
  323. { Start definition term }
  324. writeln(':dt.');
  325. end;
  326. procedure TIPFNewWriter.DescrEndDefinitionTerm;
  327. begin
  328. { End definition term }
  329. writeln('');
  330. end;
  331. procedure TIPFNewWriter.DescrBeginDefinitionEntry;
  332. begin
  333. { start definition explanation }
  334. writeln(':dd.');
  335. end;
  336. procedure TIPFNewWriter.DescrEndDefinitionEntry;
  337. begin
  338. { End definition explanation }
  339. writeln('');
  340. end;
  341. procedure TIPFNewWriter.DescrBeginSectionTitle;
  342. begin
  343. { Start section title }
  344. end;
  345. procedure TIPFNewWriter.DescrBeginSectionBody;
  346. begin
  347. { Start section body }
  348. end;
  349. procedure TIPFNewWriter.DescrEndSection;
  350. begin
  351. { End section body }
  352. end;
  353. procedure TIPFNewWriter.DescrBeginRemark;
  354. begin
  355. { Start remark paragraph }
  356. writeln('');
  357. writeln(':nt text=''Remark: ''.');
  358. end;
  359. procedure TIPFNewWriter.DescrEndRemark;
  360. begin
  361. { End remark paragraph }
  362. writeln('');
  363. writeln(':ent.');
  364. end;
  365. procedure TIPFNewWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
  366. var
  367. i: integer;
  368. cols: string;
  369. f: string;
  370. begin
  371. { Start table with ColCount columns, and with border }
  372. cols := '';
  373. for i := 0 to ColCount-1 do
  374. begin
  375. if i = 0 then
  376. cols := cols + '35 ' // first colum is 30 characters
  377. else
  378. cols := cols + '50 '; // every other colum is 50 characters each
  379. end;
  380. if HasBorder then
  381. f := ' frame=box.'
  382. else
  383. f := ' frame=none.';
  384. writeln(':table cols=''' + Trim(cols) + ''' rules=both' + f);
  385. end;
  386. procedure TIPFNewWriter.DescrEndTable;
  387. begin
  388. writeln(':etable.');
  389. end;
  390. procedure TIPFNewWriter.DescrBeginTableCaption;
  391. begin
  392. //writeln('.* GG');
  393. SuspendWriting := True;
  394. // do nothing
  395. // TableCaptionWritten := False;
  396. end;
  397. procedure TIPFNewWriter.DescrEndTableCaption;
  398. begin
  399. // do nothing
  400. SuspendWriting := False;
  401. writeln('');
  402. end;
  403. procedure TIPFNewWriter.DescrBeginTableHeadRow;
  404. begin
  405. // TableCaptionWritten := True;
  406. SuspendWriting := False;
  407. writeln(':row.');
  408. end;
  409. procedure TIPFNewWriter.DescrEndTableHeadRow;
  410. begin
  411. // do nothing
  412. end;
  413. procedure TIPFNewWriter.DescrBeginTableRow;
  414. begin
  415. // TableCaptionWritten := True;
  416. SuspendWriting := False;
  417. writeln(':row.');
  418. end;
  419. procedure TIPFNewWriter.DescrEndTableRow;
  420. begin
  421. writeln('');
  422. end;
  423. procedure TIPFNewWriter.DescrBeginTableCell;
  424. begin
  425. write(':c.');
  426. InTableCell := True;
  427. end;
  428. procedure TIPFNewWriter.DescrEndTableCell;
  429. begin
  430. // do nothing
  431. writeln('');
  432. InTableCell := False;
  433. end;
  434. constructor TIPFNewWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
  435. begin
  436. inherited Create(APackage, AEngine);
  437. TableCaptionWritten := True;
  438. SuspendWriting := False;
  439. InTableCell := False;
  440. InTypesDeclaration := False;
  441. end;
  442. procedure TIPFNewWriter.WriteClassInheritanceOverview(ClassDecl: TPasClassType);
  443. var
  444. DocNode: TDocNode;
  445. ancestor: TPasClassType;
  446. ancestor2: TPasType;
  447. List: TStringList;
  448. i: integer;
  449. indent: integer;
  450. procedure WriteDescription(const Idx: integer);
  451. var
  452. s: string;
  453. o: TPasClassType;
  454. t: string;
  455. begin
  456. if List.Objects[i] <> nil then
  457. begin
  458. o := List.Objects[i] as TPasClassType;
  459. DocNode := Engine.FindDocNode(o);
  460. if Assigned(DocNode) then
  461. begin
  462. s := ExtractFileName(o.SourceFilename);
  463. t := ExtractFileExt(s);
  464. s := StringReplace(s, t, '', []);
  465. s := s + '.' + o.Name;
  466. DescrBeginLink(s);
  467. Write(o.Name);
  468. DescrEndLink;
  469. writeln('');
  470. end
  471. else
  472. begin
  473. writeln(List[i]);
  474. end;
  475. end
  476. else
  477. begin
  478. { we only have text for it. }
  479. Writeln(List[i]);
  480. end;
  481. end;
  482. begin
  483. List := TStringList.Create;
  484. List.Sorted := False;
  485. { add the initial class }
  486. List.AddObject(ClassDecl.Name, ClassDecl);
  487. ancestor := nil;
  488. if Assigned(ClassDecl.AncestorType) and ClassDecl.AncestorType.InheritsFrom(TPasClassType) then
  489. { all is well, we have our first ancestor to get us started with the hierarchy traversal }
  490. ancestor := TPasClassType(ClassDecl.AncestorType)
  491. else
  492. begin
  493. { here we only have one history item to output - and not part of fpdoc hierarchy data }
  494. if Assigned(ClassDecl.AncestorType) then
  495. begin
  496. ancestor2 := ClassDecl.AncestorType;
  497. if Assigned(ancestor2) then
  498. begin
  499. List.AddObject(ancestor2.Name, nil);
  500. ancestor2 := nil; { prevent any further attempts at traversal }
  501. end;
  502. end;
  503. end;
  504. while Assigned(ancestor) do
  505. begin
  506. List.AddObject(ancestor.Name, ancestor);
  507. if Assigned(ancestor.AncestorType) and ancestor.AncestorType.InheritsFrom(TPasClassType) then
  508. ancestor := TPasClassType(ancestor.AncestorType)
  509. else
  510. begin
  511. { we hit the end of the road }
  512. ancestor2 := ancestor.AncestorType;
  513. if Assigned(ancestor2) then
  514. List.AddObject(ancestor2.Name, nil);
  515. ancestor := nil; { prevent any further attempts at traversal }
  516. end;
  517. end;
  518. if List.Count > 1 then
  519. begin
  520. { output a title }
  521. Writeln(':p.');
  522. writeln(':lm margin=1.');
  523. DescrBeginBold;
  524. WriteLn(SDocInheritanceHierarchy);
  525. DescrEndBold;
  526. { now output the hierarchy }
  527. indent := 3;
  528. { we go from least significant to most, hence the reversed loop }
  529. for i := List.Count-1 downto 0 do
  530. begin
  531. Write(Format(':lm margin=%d.', [indent]));
  532. { each level is indented 2 character positions more than the previous one }
  533. if (indent > 3) then
  534. begin
  535. writeln('|');
  536. write('+--');
  537. end
  538. else
  539. write(':xmp.');
  540. WriteDescription(i);
  541. inc(indent, 2);
  542. end;
  543. WriteLn(':lm margin=1.:exmp.');
  544. end;
  545. List.Free;
  546. end;
  547. { TLinearWriter overrides}
  548. class function TIPFNewWriter.FileNameExtension: String;
  549. begin
  550. Result := TIPFExtension;
  551. end;
  552. procedure TIPFNewWriter.DescrBeginURL(const AURL: DOMString);
  553. begin
  554. //Write(EscapeText(AURL));
  555. end;
  556. procedure TIPFNewWriter.DescrEndURL;
  557. begin
  558. // do nothing
  559. end;
  560. function TIPFNewWriter.GetLabel(AElement: TPasElement): String;
  561. var
  562. i: Integer;
  563. begin
  564. if AElement.ClassType = TPasUnresolvedTypeRef then
  565. Result := Engine.ResolveLink(Module, AElement.Name)
  566. else
  567. begin
  568. Result := AElement.PathName;
  569. Result := LowerCase(Copy(Result, 2, Length(Result) - 1)); // Remove # infront of eg: '#Corelib' string
  570. end;
  571. Result := StringReplace(Result, '.', '_', [rfReplaceAll]);
  572. Result := StringReplace(Result, ' ', '_', [rfReplaceAll]);
  573. end;
  574. Function TIPFNewWriter.EscapeText(S : String) : String;
  575. var
  576. i: Integer;
  577. begin
  578. SetLength(Result, 0);
  579. for i := 1 to Length(S) do
  580. case S[i] of
  581. '.': // Escape these characters
  582. Result := Result + '&per.';
  583. ':':
  584. Result := Result + '&colon.';
  585. ',':
  586. Result := Result + '&comma.';
  587. '&':
  588. Result := Result + '&amp.';
  589. // '_':
  590. // Result := Result + '&us.';
  591. '^':
  592. Result := Result + '&caret.';
  593. '''':
  594. Result := Result + '&apos.';
  595. '*':
  596. Result := Result + '&asterisk.';
  597. '@':
  598. Result := Result + '&atsign.';
  599. '\':
  600. Result := Result + '&bslash.';
  601. '"':
  602. Result := Result + '&cdq.';
  603. '-':
  604. Result := Result + '&hyphen.';
  605. //'°':
  606. // Result := Result + '&degree.';
  607. '$':
  608. Result := Result + '&dollar.';
  609. '=':
  610. Result := Result + '&eq.';
  611. '!':
  612. Result := Result + '&xclam.';
  613. '>':
  614. Result := Result + '&gt.';
  615. '(':
  616. Result := Result + '&lpar.';
  617. ')':
  618. Result := Result + '&rpar.';
  619. '+':
  620. Result := Result + '&plus.';
  621. '[':
  622. Result := Result + '&lbracket.';
  623. ']':
  624. Result := Result + '&rbracket.';
  625. else
  626. Result := Result + S[i];
  627. end;
  628. end;
  629. Function TIPFNewWriter.StripText(S : String) : String;
  630. var
  631. I,L: Integer;
  632. begin
  633. //Result := S;
  634. SetLength(Result, 0);
  635. for i := 1 to Length(S) do
  636. if not (S[i] in ['&','{','}','#'{,'_'},'$','%','''','~','^', '\', ' ', '<', '>']) then
  637. Result := Result + S[i];
  638. end;
  639. procedure TIPFNewWriter.Write(const s: String);
  640. begin
  641. if SuspendWriting then
  642. Exit;
  643. inherited Write(s);
  644. end;
  645. procedure TIPFNewWriter.WriteBeginDocument;
  646. begin
  647. fColCount := 0;
  648. Writeln(':userdoc.');
  649. WriteComment('This file has been created automatically by FPDoc');
  650. WriteComment('IPF output (c) 2010-2012 by Graeme Geldenhuys ([email protected])');
  651. writeln('');
  652. Writeln(':docprof toc=12345.');
  653. WriteLn(':title.' + PackageName);
  654. writeln('');
  655. writeln('');
  656. writeln(':h1.' + PackageName);
  657. InPackageOverview := True;
  658. // inherited WriteBeginDocument;
  659. end;
  660. procedure TIPFNewWriter.WriteEndDocument;
  661. begin
  662. inherited WriteEndDocument;
  663. writeln('');
  664. writeln('');
  665. writeln(':euserdoc.');
  666. writeln('');
  667. end;
  668. procedure TIPFNewWriter.WriteLabel(const s: String);
  669. var
  670. x: String;
  671. begin
  672. x := StringReplace(s, ':', '_', [rfReplaceAll]);
  673. if InHeading and (x <> '') then
  674. begin
  675. WriteLnF(FInHeadingText, [ ' name=' + LowerCase(x)]); // LowerCase(StripTexT(x))]);
  676. Writeln('');
  677. FInHeadingText := '';
  678. InHeading := False;
  679. end
  680. else
  681. begin
  682. WriteLnF(FInHeadingText, [ '' ]);
  683. Writeln('');
  684. FInHeadingText := '';
  685. InHeading := False;
  686. end;
  687. end;
  688. procedure TIPFNewWriter.WriteIndex(const s : String);
  689. begin
  690. // writeln(':i1 id=' + s + '.');
  691. end;
  692. procedure TIPFNewWriter.WriteType(const s: string);
  693. begin
  694. writeln('');
  695. Writeln('.* -------------------------------------------------');
  696. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  697. // inherited WriteType(s);
  698. end;
  699. procedure TIPFNewWriter.WriteVariable(const s: string);
  700. begin
  701. writeln('');
  702. Writeln('.* -------------------------------------------------');
  703. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  704. end;
  705. procedure TIPFNewWriter.WriteConstant(const s: string);
  706. begin
  707. writeln('');
  708. Writeln('.* -------------------------------------------------');
  709. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  710. end;
  711. procedure TIPFNewWriter.StartListing(Frames: Boolean; const name: String);
  712. begin
  713. // writeln('');
  714. writeln(':xmp.');
  715. end;
  716. procedure TIPFNewWriter.EndListing;
  717. begin
  718. writeln(':exmp.');
  719. end;
  720. procedure TIPFNewWriter.WriteCommentLine;
  721. begin
  722. Writeln('');
  723. Writeln('.* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
  724. end;
  725. procedure TIPFNewWriter.WriteComment(Comment : String);
  726. begin
  727. Writeln('.* ' + Comment);
  728. end;
  729. procedure TIPFNewWriter.StartChapter(ChapterName : String);
  730. begin
  731. InHeading := True;
  732. Writeln('');
  733. Writeln('');
  734. WriteCommentLine;
  735. WriteComment('Chapter: ' + ChapterName);
  736. WriteCommentLine;
  737. FInHeadingText := ':h2%s. ' + ChapterName;
  738. //Writeln(':h2.' + ChapterName);
  739. //Writeln('');
  740. end;
  741. procedure TIPFNewWriter.StartSection(SectionName : String);
  742. begin
  743. InHeading := True;
  744. Writeln('');
  745. Writeln('');
  746. WriteCommentLine;
  747. WriteComment('Section: ' + SectionName);
  748. WriteCommentLine;
  749. writeln('');
  750. if SameText(SectionName, SDocOverview) then
  751. begin
  752. writeln(':p.');
  753. writeln(':p.');
  754. writeln(':lm margin=1.');
  755. DescrBeginBold;
  756. WriteLn(SDocOverview);
  757. DescrEndBold;
  758. // writeln(':lm margin=3.');
  759. writeln('.br');
  760. end
  761. else if InPackageOverview then
  762. begin
  763. FInHeadingText := ':h2%s. ' + SectionName;
  764. // Writeln(':h2.' + SectionName);
  765. InPackageOverview := False;
  766. end
  767. else
  768. begin
  769. FInHeadingText := ':h3%s. ' + SectionName;
  770. // Writeln(':h3.' + SectionName);
  771. InPackageOverview := False;
  772. end;
  773. // Writeln('');
  774. end;
  775. procedure TIPFNewWriter.StartSubSection(SubSectionName : String);
  776. begin
  777. LastSubSection := Lowercase(SubSectionName);
  778. InHeading := True;
  779. Writeln('');
  780. WriteCommentLine;
  781. FInHeadingText := ':h4%s. ' + SubSectionName;
  782. //Writeln(':h4.' + SubSectionName);
  783. end;
  784. procedure TIPFNewWriter.StartSubSubSection(SubSubSectionName : String);
  785. begin
  786. InHeading := True;
  787. FInHeadingText := ':h5%s. ' + SubSubSectionName;
  788. //Writeln(':h5.' + SubSubSectionName);
  789. end;
  790. Procedure TIPFNewWriter.StartProcedure;
  791. begin
  792. //writeln('');
  793. //writeln(':ul.');
  794. end;
  795. Procedure TIPFNewWriter.EndProcedure;
  796. begin
  797. //writeln('');
  798. //writeln(':eul.');
  799. end;
  800. Procedure TIPFNewWriter.StartSynopsis;
  801. begin
  802. writeln('');
  803. writeln(':p.');
  804. writeln(':lm margin=1.');
  805. writeln(':hp2.' + SDocSynopsis + ':ehp2.');
  806. writeln('.br');
  807. writeln(':lm margin=3.');
  808. end;
  809. Procedure TIPFNewWriter.StartDeclaration;
  810. begin
  811. writeln('');
  812. writeln(':p.');
  813. writeln(':lm margin=1.');
  814. writeln(':hp2.' + SDocDeclaration + ':ehp2.');
  815. writeln(':lm margin=3.');
  816. end;
  817. Procedure TIPFNewWriter.StartVisibility;
  818. begin
  819. writeln('');
  820. writeln(':p.');
  821. writeln(':lm margin=1.');
  822. writeln(':hp2.' + SDocVisibility + ':ehp2.');
  823. writeln(':lm margin=3.');
  824. writeln('.br');
  825. end;
  826. Procedure TIPFNewWriter.StartDescription;
  827. begin
  828. writeln('');
  829. writeln(':p.');
  830. writeln(':lm margin=1.');
  831. writeln(':hp2.' + SDocDescription + ':ehp2.');
  832. writeln(':lm margin=3.');
  833. writeln('.br');
  834. end;
  835. Procedure TIPFNewWriter.StartErrors;
  836. begin
  837. writeln('');
  838. writeln(':p.');
  839. writeln(':lm margin=1.');
  840. writeln(':hp2.' + SDocErrors + ':ehp2.');
  841. writeln(':lm margin=3.');
  842. writeln('.br');
  843. end;
  844. procedure TIPFNewWriter.StartVersion;
  845. begin
  846. writeln('');
  847. writeln(':p.');
  848. writeln(':lm margin=1.');
  849. writeln(':hp2.' + SDocVersion +':ehp2.');
  850. writeln(':lm margin=3.');
  851. writeln('.br');
  852. end;
  853. Procedure TIPFNewWriter.StartAccess;
  854. begin
  855. writeln('');
  856. writeln(':p.');
  857. writeln(':lm margin=1.');
  858. writeln(':hp2.' + SDocAccess + ':ehp2.');
  859. writeln(':lm margin=3.');
  860. writeln('.br');
  861. end;
  862. Procedure TIPFNewWriter.StartProperty;
  863. begin
  864. //writeln('');
  865. //Writeln('.* here I am');
  866. //writeln(':ul.');
  867. end;
  868. Procedure TIPFNewWriter.EndProperty;
  869. begin
  870. //writeln('');
  871. //writeln(':eul.');
  872. end;
  873. procedure TIPFNewWriter.WriteExampleFile(FN : String);
  874. var
  875. sl: TStringList;
  876. i: integer;
  877. begin
  878. if (FN<>'') then
  879. begin
  880. writeln('');
  881. writeln('');
  882. Writeln(':p.');
  883. writeln(':lm margin=1.');
  884. Writeln(':hp2.Example:ehp2.');
  885. writeln(':lm margin=3.');
  886. writeln('.br');
  887. writeln('Filename&colon. :hp1.' + EscapeText(FN) + ':ehp1.');
  888. writeln(':p.');
  889. writeln(':xmp.');
  890. //writeln(':im ' + FN);
  891. sl := TStringList.Create;
  892. try
  893. sl.LoadFromFile(FN);
  894. for i := 0 to sl.Count-1 do
  895. Writeln(EscapeText(sl[i]));
  896. finally
  897. sl.Free;
  898. end;
  899. writeln(':exmp.');
  900. end;
  901. end;
  902. procedure TIPFNewWriter.StartOverview(WithAccess : Boolean);
  903. begin
  904. {
  905. If With access then it is a property overview.
  906. Otherwise it is a method/function overview.
  907. If tabular output is generated, the preferred output order is:
  908. With access:
  909. Col 1 : Page reference
  910. Col 2 : Property Name
  911. Col 3 : Accessibility (r/w)
  912. Col 4 : Description
  913. Without access:
  914. Col 1 : Page reference
  915. Col 2 : Method name
  916. Col 3 : Description
  917. (See the two WriteOverviewMember functions)
  918. }
  919. writeln('');
  920. writeln(':parml tsize=30 break=none compact.');
  921. // FlushBuffer;
  922. end;
  923. procedure TIPFNewWriter.EndOverview;
  924. begin
  925. { End of overview }
  926. writeln('');
  927. writeln(':eparml.');
  928. writeln(':p.');
  929. // FlushBuffer;
  930. end;
  931. procedure TIPFNewWriter.WriteOverviewMember(const ALabel,AName,Access,ADescr : String);
  932. var
  933. s1, s2: string;
  934. begin
  935. { Write one entry in property overview:
  936. ALabel : Label, as returned by GetLabel
  937. AName : Property name
  938. Access : Property acces (r/w/a)
  939. Descr : Description
  940. }
  941. s1 := StringReplace(ALabel, ':', '_', [rfReplaceAll]);
  942. s2 := StringReplace(AName, ':', '_', [rfReplaceAll]);
  943. WriteLn(Format(':pt. :link reftype=hd refid=%s.%s:elink. [%s]',[s1, s2, Access]));
  944. WriteLn(Format(':pd. %s', [ADescr]));
  945. end;
  946. procedure TIPFNewWriter.WriteOverviewMember(const ALabel,AName,ADescr : String);
  947. var
  948. s1, s2: string;
  949. begin
  950. { Write one entry in method overview:
  951. ALabel : Label, as returned by GetLabel
  952. AName : Method name
  953. Descr : Description
  954. }
  955. s1 := StringReplace(ALabel, ':', '_', [rfReplaceAll]);
  956. s2 := StringReplace(AName, ':', '_', [rfReplaceAll]);
  957. WriteLn(Format(':pt. :link reftype=hd refid=%s.%s :elink.',[s1, s2]));
  958. WriteLn(Format(':pd. %s', [ADescr]));
  959. end;
  960. Procedure TIPFNewWriter.StartSeeAlso;
  961. begin
  962. writeln('');
  963. writeln(':p.');
  964. writeln(':lm margin=1.');
  965. writeln(':hp2.See Also:ehp2.');
  966. writeln(':lm margin=3.');
  967. writeln('.br');
  968. end;
  969. procedure TIPFNewWriter.EndSeealso;
  970. begin
  971. writeln('');
  972. end;
  973. procedure TIPFNewWriter.StartUnitOverview(AModuleName,AModuleLabel : String);
  974. begin
  975. { Start of unit overview.
  976. AModuleName : Name of current unit.
  977. AModuleLabel : Label name of current unit.
  978. }
  979. writeln('');
  980. writeln(':p.');
  981. writeln(':lm margin=1.');
  982. DescrBeginBold;
  983. writeln(EscapeText(Format(SDocUsedUnitsByUnitXY, [AModuleName])));
  984. DescrEndBold;
  985. writeln(':lm margin=3.');
  986. writeln('.br');
  987. writeln(':p.');
  988. writeln(':ol.');
  989. end;
  990. procedure TIPFNewWriter.WriteUnitEntry(UnitRef : TPasType);
  991. begin
  992. { Write one unit entry }
  993. writeln(':li.' + EscapeText(UnitRef.Name));
  994. end;
  995. procedure TIPFNewWriter.EndUnitOverview;
  996. begin
  997. { end of unit overview }
  998. writeln(':eol.');
  999. end;
  1000. initialization
  1001. // Do not localize IPFWriterName
  1002. RegisterWriter(TIPFNewWriter, IPFWriterName, SIPFUsageWriterDescr);
  1003. finalization
  1004. UnRegisterWriter(IPFWriterName);
  1005. end.