dw_ipflin.pas 27 KB

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