dw_ipflin.pas 27 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123
  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 }
  25. TIPFNewWriter = class(TLinearWriter)
  26. private
  27. InPackageOverview: Boolean;
  28. InHeading: Boolean;
  29. FInHeadingText: string;
  30. OrderedList: boolean;
  31. TableRowStartFlag: Boolean;
  32. TableCaptionWritten: Boolean;
  33. InTableCell: Boolean;
  34. InTypesDeclaration: Boolean;
  35. SuspendWriting: Boolean;
  36. LastSubSection: String;
  37. protected
  38. FLink: String;
  39. FTableCount : Integer;
  40. FInVerbatim : Boolean;
  41. Inlist,
  42. fColCount: integer;
  43. // extras
  44. procedure Write(const s: String); override;
  45. procedure WriteBeginDocument; override;
  46. procedure WriteEndDocument; override;
  47. // Linear documentation methods overrides;
  48. procedure WriteLabel(Const S : String); override;
  49. procedure WriteIndex(Const S : String); override;
  50. procedure WriteType(const s: string); override;
  51. procedure WriteVariable(const s: string); override;
  52. procedure WriteConstant(const s: string); override;
  53. Procedure WriteExampleFile(FN : String); override;
  54. Procedure StartProcedure; override;
  55. Procedure EndProcedure; override;
  56. Procedure StartProperty; override;
  57. Procedure EndProperty; override;
  58. Procedure StartSynopsis; override;
  59. Procedure StartDeclaration; override;
  60. Procedure StartVisibility; override;
  61. Procedure StartDescription; override;
  62. Procedure StartAccess; override;
  63. Procedure StartErrors; override;
  64. Procedure StartVersion; override;
  65. Procedure StartSeealso; override;
  66. Procedure EndSeealso; override;
  67. procedure StartUnitOverview(AModuleName,AModuleLabel : String);override;
  68. procedure WriteUnitEntry(UnitRef : TPasType); override;
  69. Procedure EndUnitOverview; override;
  70. function GetLabel(AElement: TPasElement): String; override;
  71. procedure StartListing(Frames: Boolean; const name: String); override;
  72. procedure EndListing; override;
  73. Function EscapeText(S : String) : String; override;
  74. Function StripText(S : String) : String; override;
  75. procedure WriteCommentLine; override;
  76. procedure WriteComment(Comment : String);override;
  77. procedure StartSection(SectionName : String);override;
  78. procedure StartSubSection(SubSectionName : String);override;
  79. procedure StartSubSubSection(SubSubSectionName : String);override;
  80. procedure StartChapter(ChapterName : String); override;
  81. procedure StartOverview(Const What : String;WithAccess : Boolean); override;
  82. procedure EndOverview; override;
  83. procedure WriteOverviewMember(const ALabel,AName,Access,ADescr : String); override;
  84. procedure WriteOverviewMember(const ALabel,AName,ADescr : String); override;
  85. procedure DescrBeginURL(const AURL: DOMString); override;
  86. procedure DescrEndURL; override;
  87. // Description node conversion. Overrides for TFPDocWriter.
  88. procedure DescrBeginBold; override;
  89. procedure DescrEndBold; override;
  90. procedure DescrBeginItalic; override;
  91. procedure DescrEndItalic; override;
  92. procedure DescrBeginEmph; override;
  93. procedure DescrEndEmph; override;
  94. procedure DescrWriteText(const AText: DOMString); override;
  95. procedure DescrWriteFileEl(const AText: DOMString); override;
  96. procedure DescrWriteKeywordEl(const AText: DOMString); override;
  97. procedure DescrWriteVarEl(const AText: DOMString); override;
  98. procedure DescrBeginLink(const AId: DOMString); override;
  99. procedure DescrEndLink; override;
  100. procedure DescrWriteLinebreak; override;
  101. procedure DescrBeginParagraph; override;
  102. procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
  103. procedure DescrWriteCodeLine(const ALine: String); override;
  104. procedure DescrEndCode; override;
  105. procedure DescrEndParagraph; override;
  106. procedure DescrBeginOrderedList; override;
  107. procedure DescrEndOrderedList; override;
  108. procedure DescrBeginUnorderedList; override;
  109. procedure DescrEndUnorderedList; override;
  110. procedure DescrBeginDefinitionList; override;
  111. procedure DescrEndDefinitionList; override;
  112. procedure DescrBeginListItem; override;
  113. procedure DescrEndListItem; override;
  114. procedure DescrBeginDefinitionTerm; override;
  115. procedure DescrEndDefinitionTerm; override;
  116. procedure DescrBeginDefinitionEntry; override;
  117. procedure DescrEndDefinitionEntry; override;
  118. procedure DescrBeginSectionTitle; override;
  119. procedure DescrBeginSectionBody; override;
  120. procedure DescrEndSection; override;
  121. procedure DescrBeginRemark; override;
  122. procedure DescrEndRemark; override;
  123. procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
  124. procedure DescrEndTable; override;
  125. procedure DescrBeginTableCaption; override;
  126. procedure DescrEndTableCaption; override;
  127. procedure DescrBeginTableHeadRow; override;
  128. procedure DescrEndTableHeadRow; override;
  129. procedure DescrBeginTableRow; override;
  130. procedure DescrEndTableRow; override;
  131. procedure DescrBeginTableCell; override;
  132. procedure DescrEndTableCell; override;
  133. // TFPDocWriter class methods
  134. public
  135. constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  136. class function FileNameExtension: string; override;
  137. procedure WriteClassInheritanceOverview(ClassDecl: TPasClassType); override;
  138. end;
  139. implementation
  140. uses
  141. SysUtils, dwriter;
  142. { TFPDocWriter overrides }
  143. procedure TIPFNewWriter.DescrBeginBold;
  144. begin
  145. { Start bold output }
  146. WriteLn(':hp2.');
  147. end;
  148. procedure TIPFNewWriter.DescrEndBold;
  149. begin
  150. { End bold output }
  151. WriteLn(':ehp2.');
  152. end;
  153. procedure TIPFNewWriter.DescrBeginItalic;
  154. begin
  155. { Start italic output }
  156. WriteLn(':hp1.');
  157. end;
  158. procedure TIPFNewWriter.DescrEndItalic;
  159. begin
  160. { End italic output }
  161. WriteLn(':ehp1.');
  162. end;
  163. procedure TIPFNewWriter.DescrBeginEmph;
  164. begin
  165. { Start emphasized output }
  166. Write(':hp1.');
  167. end;
  168. procedure TIPFNewWriter.DescrEndEmph;
  169. begin
  170. { End emphasized output }
  171. Write(':ehp1.');
  172. end;
  173. procedure TIPFNewWriter.DescrWriteText(const AText: DOMString);
  174. const
  175. cMax = 100;
  176. var
  177. sl: TStringlist;
  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. if ClassDecl.Name <> o.Name then
  460. begin
  461. s := ChangeFileExt(ExtractFileName(o.SourceFilename), '');
  462. s := '#' + PackageName + '.' + s + '.' + o.Name;
  463. DescrBeginLink(s);
  464. Write(o.Name);
  465. DescrEndLink;
  466. writeln('');
  467. end
  468. else
  469. begin
  470. { The topic being viewed doesn't need a link to itself }
  471. writeln(List[i]);
  472. end;
  473. end
  474. else
  475. begin
  476. { we only have text for it. }
  477. Writeln(List[i]);
  478. end;
  479. end;
  480. begin
  481. List := TStringList.Create;
  482. List.Sorted := False;
  483. { add the initial class }
  484. List.AddObject(ClassDecl.Name, ClassDecl);
  485. ancestor := nil;
  486. if Assigned(ClassDecl.AncestorType) and ClassDecl.AncestorType.InheritsFrom(TPasClassType) then
  487. { all is well, we have our first ancestor to get us started with the hierarchy traversal }
  488. ancestor := TPasClassType(ClassDecl.AncestorType)
  489. else
  490. begin
  491. { here we only have one history item to output - and not part of fpdoc hierarchy data }
  492. if Assigned(ClassDecl.AncestorType) then
  493. begin
  494. ancestor2 := ClassDecl.AncestorType;
  495. if Assigned(ancestor2) then
  496. begin
  497. List.AddObject(ancestor2.Name, nil);
  498. ancestor2 := nil; { prevent any further attempts at traversal }
  499. end;
  500. end;
  501. end;
  502. while Assigned(ancestor) do
  503. begin
  504. List.AddObject(ancestor.Name, ancestor);
  505. if Assigned(ancestor.AncestorType) and ancestor.AncestorType.InheritsFrom(TPasClassType) then
  506. ancestor := TPasClassType(ancestor.AncestorType)
  507. else
  508. begin
  509. { we hit the end of the road }
  510. ancestor2 := ancestor.AncestorType;
  511. if Assigned(ancestor2) then
  512. List.AddObject(ancestor2.Name, nil);
  513. ancestor := nil; { prevent any further attempts at traversal }
  514. end;
  515. end;
  516. if List.Count > 1 then
  517. begin
  518. { output a title }
  519. Writeln(':p.');
  520. writeln(':lm margin=1.');
  521. DescrBeginBold;
  522. WriteLn(SDocInheritanceHierarchy);
  523. DescrEndBold;
  524. { now output the hierarchy }
  525. indent := 3;
  526. { we go from least significant to most, hence the reversed loop }
  527. for i := List.Count-1 downto 0 do
  528. begin
  529. Write(Format(':lm margin=%d.', [indent]));
  530. { each level is indented 2 character positions more than the previous one }
  531. if (indent > 3) then
  532. begin
  533. writeln('|');
  534. write('+--');
  535. end
  536. else
  537. write(':xmp.');
  538. WriteDescription(i);
  539. inc(indent, 2);
  540. end;
  541. WriteLn(':lm margin=1.:exmp.');
  542. end;
  543. List.Free;
  544. end;
  545. { TLinearWriter overrides}
  546. class function TIPFNewWriter.FileNameExtension: string;
  547. begin
  548. Result := TIPFExtension;
  549. end;
  550. procedure TIPFNewWriter.DescrBeginURL(const AURL: DOMString);
  551. begin
  552. Write(':link reftype=launch object=''netscape'' data=''' + AURL + '''.');
  553. end;
  554. procedure TIPFNewWriter.DescrEndURL;
  555. begin
  556. Write(':elink.');
  557. end;
  558. function TIPFNewWriter.GetLabel(AElement: TPasElement): String;
  559. begin
  560. if AElement.ClassType = TPasUnresolvedTypeRef then
  561. Result := Engine.ResolveLink(Module, AElement.Name)
  562. else
  563. begin
  564. Result := AElement.PathName;
  565. Result := LowerCase(Copy(Result, 2, Length(Result) - 1)); // Remove # infront of eg: '#Corelib' string
  566. end;
  567. Result := StringReplace(Result, '.', '_', [rfReplaceAll]);
  568. Result := StringReplace(Result, ' ', '_', [rfReplaceAll]);
  569. end;
  570. function TIPFNewWriter.EscapeText(S: String): String;
  571. var
  572. i: Integer;
  573. begin
  574. SetLength(Result, 0);
  575. for i := 1 to Length(S) do
  576. case S[i] of
  577. '.': // Escape these characters
  578. Result := Result + '&per.';
  579. ':':
  580. Result := Result + '&colon.';
  581. ',':
  582. Result := Result + '&comma.';
  583. '&':
  584. Result := Result + '&amp.';
  585. // '_':
  586. // Result := Result + '&us.';
  587. '^':
  588. Result := Result + '&caret.';
  589. '''':
  590. Result := Result + '&apos.';
  591. '*':
  592. Result := Result + '&asterisk.';
  593. '@':
  594. Result := Result + '&atsign.';
  595. '\':
  596. Result := Result + '&bslash.';
  597. '"':
  598. Result := Result + '&cdq.';
  599. '-':
  600. Result := Result + '&hyphen.';
  601. //'°':
  602. // Result := Result + '&degree.';
  603. '$':
  604. Result := Result + '&dollar.';
  605. '=':
  606. Result := Result + '&eq.';
  607. '!':
  608. Result := Result + '&xclam.';
  609. '>':
  610. Result := Result + '&gt.';
  611. '(':
  612. Result := Result + '&lpar.';
  613. ')':
  614. Result := Result + '&rpar.';
  615. '+':
  616. Result := Result + '&plus.';
  617. '[':
  618. Result := Result + '&lbracket.';
  619. ']':
  620. Result := Result + '&rbracket.';
  621. else
  622. Result := Result + S[i];
  623. end;
  624. end;
  625. function TIPFNewWriter.StripText(S: String): String;
  626. var
  627. I: Integer;
  628. begin
  629. //Result := S;
  630. SetLength(Result, 0);
  631. for i := 1 to Length(S) do
  632. if not (S[i] in ['&','{','}','#'{,'_'},'$','%','''','~','^', '\', ' ', '<', '>']) then
  633. Result := Result + S[i];
  634. end;
  635. procedure TIPFNewWriter.Write(const s: String);
  636. begin
  637. if SuspendWriting then
  638. Exit;
  639. inherited Write(s);
  640. end;
  641. procedure TIPFNewWriter.WriteBeginDocument;
  642. begin
  643. fColCount := 0;
  644. Writeln(':userdoc.');
  645. WriteComment('This file has been created automatically by FPDoc');
  646. WriteComment('IPF output (c) 2010-2012 by Graeme Geldenhuys ([email protected])');
  647. writeln('');
  648. Writeln(':docprof toc=12345.');
  649. WriteLn(':title.' + PackageName);
  650. writeln('');
  651. writeln('');
  652. writeln(':h1.' + PackageName);
  653. InPackageOverview := True;
  654. // inherited WriteBeginDocument;
  655. end;
  656. procedure TIPFNewWriter.WriteEndDocument;
  657. begin
  658. inherited WriteEndDocument;
  659. writeln('');
  660. writeln('');
  661. writeln(':euserdoc.');
  662. writeln('');
  663. end;
  664. procedure TIPFNewWriter.WriteLabel(const S: String);
  665. var
  666. x: String;
  667. begin
  668. x := StringReplace(s, ':', '_', [rfReplaceAll]);
  669. if InHeading and (x <> '') then
  670. begin
  671. WriteLnF(FInHeadingText, [ ' name=' + LowerCase(x)]); // LowerCase(StripTexT(x))]);
  672. Writeln('');
  673. FInHeadingText := '';
  674. InHeading := False;
  675. end
  676. else
  677. begin
  678. WriteLnF(FInHeadingText, [ '' ]);
  679. Writeln('');
  680. FInHeadingText := '';
  681. InHeading := False;
  682. end;
  683. end;
  684. procedure TIPFNewWriter.WriteIndex(const S: String);
  685. begin
  686. // writeln(':i1 id=' + s + '.');
  687. end;
  688. procedure TIPFNewWriter.WriteType(const s: string);
  689. begin
  690. writeln('');
  691. Writeln('.* -------------------------------------------------');
  692. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  693. // inherited WriteType(s);
  694. end;
  695. procedure TIPFNewWriter.WriteVariable(const s: string);
  696. begin
  697. writeln('');
  698. Writeln('.* -------------------------------------------------');
  699. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  700. end;
  701. procedure TIPFNewWriter.WriteConstant(const s: string);
  702. begin
  703. writeln('');
  704. Writeln('.* -------------------------------------------------');
  705. WriteLnF(':h5 name=%s.%s', [lowercase(PackageName+'_'+ModuleName+'_'+s), s]);
  706. end;
  707. procedure TIPFNewWriter.StartListing(Frames: Boolean; const name: String);
  708. begin
  709. // writeln('');
  710. writeln(':xmp.');
  711. end;
  712. procedure TIPFNewWriter.EndListing;
  713. begin
  714. writeln(':exmp.');
  715. end;
  716. procedure TIPFNewWriter.WriteCommentLine;
  717. begin
  718. Writeln('');
  719. Writeln('.* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
  720. end;
  721. procedure TIPFNewWriter.WriteComment(Comment : String);
  722. begin
  723. Writeln('.* ' + Comment);
  724. end;
  725. procedure TIPFNewWriter.StartChapter(ChapterName : String);
  726. begin
  727. InHeading := True;
  728. Writeln('');
  729. Writeln('');
  730. WriteCommentLine;
  731. WriteComment('Chapter: ' + ChapterName);
  732. WriteCommentLine;
  733. FInHeadingText := ':h2%s. ' + ChapterName;
  734. //Writeln(':h2.' + ChapterName);
  735. //Writeln('');
  736. end;
  737. procedure TIPFNewWriter.StartSection(SectionName : String);
  738. begin
  739. InHeading := True;
  740. Writeln('');
  741. Writeln('');
  742. WriteCommentLine;
  743. WriteComment('Section: ' + SectionName);
  744. WriteCommentLine;
  745. writeln('');
  746. if SameText(SectionName, SDocOverview) then
  747. begin
  748. writeln(':p.');
  749. writeln(':p.');
  750. writeln(':lm margin=1.');
  751. DescrBeginBold;
  752. WriteLn(SDocOverview);
  753. DescrEndBold;
  754. // writeln(':lm margin=3.');
  755. writeln('.br');
  756. end
  757. else if InPackageOverview then
  758. begin
  759. FInHeadingText := ':h2%s. ' + SectionName;
  760. // Writeln(':h2.' + SectionName);
  761. InPackageOverview := False;
  762. end
  763. else
  764. begin
  765. FInHeadingText := ':h3%s. ' + SectionName;
  766. // Writeln(':h3.' + SectionName);
  767. InPackageOverview := False;
  768. end;
  769. // Writeln('');
  770. end;
  771. procedure TIPFNewWriter.StartSubSection(SubSectionName : String);
  772. begin
  773. LastSubSection := Lowercase(SubSectionName);
  774. InHeading := True;
  775. Writeln('');
  776. WriteCommentLine;
  777. FInHeadingText := ':h4%s. ' + SubSectionName;
  778. //Writeln(':h4.' + SubSectionName);
  779. end;
  780. procedure TIPFNewWriter.StartSubSubSection(SubSubSectionName : String);
  781. begin
  782. InHeading := True;
  783. FInHeadingText := ':h5%s. ' + SubSubSectionName;
  784. //Writeln(':h5.' + SubSubSectionName);
  785. end;
  786. procedure TIPFNewWriter.StartProcedure;
  787. begin
  788. //writeln('');
  789. //writeln(':ul.');
  790. end;
  791. procedure TIPFNewWriter.EndProcedure;
  792. begin
  793. //writeln('');
  794. //writeln(':eul.');
  795. end;
  796. procedure TIPFNewWriter.StartSynopsis;
  797. begin
  798. writeln('');
  799. writeln(':p.');
  800. writeln(':lm margin=1.');
  801. writeln(':hp2.' + SDocSynopsis + ':ehp2.');
  802. writeln('.br');
  803. writeln(':lm margin=3.');
  804. end;
  805. procedure TIPFNewWriter.StartDeclaration;
  806. begin
  807. writeln('');
  808. writeln(':p.');
  809. writeln(':lm margin=1.');
  810. writeln(':hp2.' + SDocDeclaration + ':ehp2.');
  811. writeln(':lm margin=3.');
  812. end;
  813. procedure TIPFNewWriter.StartVisibility;
  814. begin
  815. writeln('');
  816. writeln(':p.');
  817. writeln(':lm margin=1.');
  818. writeln(':hp2.' + SDocVisibility + ':ehp2.');
  819. writeln(':lm margin=3.');
  820. writeln('.br');
  821. end;
  822. procedure TIPFNewWriter.StartDescription;
  823. begin
  824. writeln('');
  825. writeln(':p.');
  826. writeln(':lm margin=1.');
  827. writeln(':hp2.' + SDocDescription + ':ehp2.');
  828. writeln(':lm margin=3.');
  829. writeln('.br');
  830. end;
  831. procedure TIPFNewWriter.StartErrors;
  832. begin
  833. writeln('');
  834. writeln(':p.');
  835. writeln(':lm margin=1.');
  836. writeln(':hp2.' + SDocErrors + ':ehp2.');
  837. writeln(':lm margin=3.');
  838. writeln('.br');
  839. end;
  840. procedure TIPFNewWriter.StartVersion;
  841. begin
  842. writeln('');
  843. writeln(':p.');
  844. writeln(':lm margin=1.');
  845. writeln(':hp2.' + SDocVersion +':ehp2.');
  846. writeln(':lm margin=3.');
  847. writeln('.br');
  848. end;
  849. procedure TIPFNewWriter.StartAccess;
  850. begin
  851. writeln('');
  852. writeln(':p.');
  853. writeln(':lm margin=1.');
  854. writeln(':hp2.' + SDocAccess + ':ehp2.');
  855. writeln(':lm margin=3.');
  856. writeln('.br');
  857. end;
  858. procedure TIPFNewWriter.StartProperty;
  859. begin
  860. //writeln('');
  861. //Writeln('.* here I am');
  862. //writeln(':ul.');
  863. end;
  864. procedure TIPFNewWriter.EndProperty;
  865. begin
  866. //writeln('');
  867. //writeln(':eul.');
  868. end;
  869. procedure TIPFNewWriter.WriteExampleFile(FN : String);
  870. var
  871. sl: TStringList;
  872. i: integer;
  873. begin
  874. if (FN<>'') then
  875. begin
  876. writeln('');
  877. writeln('');
  878. Writeln(':p.');
  879. writeln(':lm margin=1.');
  880. Writeln(':hp2.Example:ehp2.');
  881. writeln(':lm margin=3.');
  882. writeln('.br');
  883. writeln('Filename&colon. :hp1.' + EscapeText(FN) + ':ehp1.');
  884. writeln(':p.');
  885. writeln(':xmp.');
  886. //writeln(':im ' + FN);
  887. sl := TStringList.Create;
  888. try
  889. sl.LoadFromFile(FN);
  890. for i := 0 to sl.Count-1 do
  891. Writeln(EscapeText(sl[i]));
  892. finally
  893. sl.Free;
  894. end;
  895. writeln(':exmp.');
  896. end;
  897. end;
  898. procedure TIPFNewWriter.StartOverview(const What: String; WithAccess: Boolean);
  899. begin
  900. {
  901. If With access then it is a property overview.
  902. Otherwise it is a method/function overview.
  903. If tabular output is generated, the preferred output order is:
  904. With access:
  905. Col 1 : Page reference
  906. Col 2 : Property Name
  907. Col 3 : Accessibility (r/w)
  908. Col 4 : Description
  909. Without access:
  910. Col 1 : Page reference
  911. Col 2 : Method name
  912. Col 3 : Description
  913. (See the two WriteOverviewMember functions)
  914. }
  915. writeln('');
  916. writeln(':parml tsize=30 break=none compact.');
  917. // FlushBuffer;
  918. end;
  919. procedure TIPFNewWriter.EndOverview;
  920. begin
  921. { End of overview }
  922. writeln('');
  923. writeln(':eparml.');
  924. writeln(':p.');
  925. // FlushBuffer;
  926. end;
  927. procedure TIPFNewWriter.WriteOverviewMember(const ALabel,AName,Access,ADescr : String);
  928. var
  929. s1, s2: string;
  930. begin
  931. { Write one entry in property overview:
  932. ALabel : Label, as returned by GetLabel
  933. AName : Property name
  934. Access : Property acces (r/w/a)
  935. Descr : Description
  936. }
  937. s1 := StringReplace(ALabel, ':', '_', [rfReplaceAll]);
  938. s2 := StringReplace(AName, ':', '_', [rfReplaceAll]);
  939. WriteLn(Format(':pt. :link reftype=hd refid=%s.%s:elink. [%s]',[s1, s2, Access]));
  940. WriteLn(Format(':pd. %s', [ADescr]));
  941. end;
  942. procedure TIPFNewWriter.WriteOverviewMember(const ALabel,AName,ADescr : String);
  943. var
  944. s1, s2: string;
  945. begin
  946. { Write one entry in method overview:
  947. ALabel : Label, as returned by GetLabel
  948. AName : Method name
  949. Descr : Description
  950. }
  951. s1 := StringReplace(ALabel, ':', '_', [rfReplaceAll]);
  952. s2 := StringReplace(AName, ':', '_', [rfReplaceAll]);
  953. WriteLn(Format(':pt. :link reftype=hd refid=%s.%s :elink.',[s1, s2]));
  954. WriteLn(Format(':pd. %s', [ADescr]));
  955. end;
  956. procedure TIPFNewWriter.StartSeealso;
  957. begin
  958. writeln('');
  959. writeln(':p.');
  960. writeln(':lm margin=1.');
  961. writeln(':hp2.See Also:ehp2.');
  962. writeln(':lm margin=3.');
  963. writeln('.br');
  964. end;
  965. procedure TIPFNewWriter.EndSeealso;
  966. begin
  967. writeln('');
  968. end;
  969. procedure TIPFNewWriter.StartUnitOverview(AModuleName,AModuleLabel : String);
  970. begin
  971. { Start of unit overview.
  972. AModuleName : Name of current unit.
  973. AModuleLabel : Label name of current unit.
  974. }
  975. writeln('');
  976. writeln(':p.');
  977. writeln(':lm margin=1.');
  978. DescrBeginBold;
  979. writeln(EscapeText(Format(SDocUsedUnitsByUnitXY, [AModuleName])));
  980. DescrEndBold;
  981. writeln(':lm margin=3.');
  982. writeln('.br');
  983. writeln(':p.');
  984. writeln(':ol.');
  985. end;
  986. procedure TIPFNewWriter.WriteUnitEntry(UnitRef : TPasType);
  987. begin
  988. { Write one unit entry }
  989. writeln(':li.' + EscapeText(UnitRef.Name));
  990. end;
  991. procedure TIPFNewWriter.EndUnitOverview;
  992. begin
  993. { end of unit overview }
  994. writeln(':eol.');
  995. end;
  996. initialization
  997. // Do not localize IPFWriterName
  998. RegisterWriter(TIPFNewWriter, IPFWriterName, SIPFUsageWriterDescr);
  999. finalization
  1000. UnRegisterWriter(IPFWriterName);
  1001. end.