dw_basemd.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893
  1. unit dw_basemd;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, dwriter, DOM, pastree, dglobals;
  6. Const
  7. MaxIndents = 10;
  8. MaxLists = 10;
  9. Type
  10. THeaderLevel = 1..6;
  11. TRender = (rStrong,rEmphasis,rCode);
  12. TListType = (ltOrdered,ltUnordered, ltDefinition);
  13. TMarkdownEngine = (meMkDocs,meNone);
  14. { TBaseMarkdownWriter }
  15. TBaseMarkdownWriter = class(TMultifileDocWriter)
  16. private
  17. FIgnoreCount : Integer;
  18. FBaseImageURL: String;
  19. FContentPrefix: String;
  20. FCurrentIndentIndex: Word;
  21. FCurrentLine: UTF8String;
  22. FDefinitionSeparator: String;
  23. FDefinitionTermRender: TRender;
  24. FFileRendering: TRender;
  25. FIndentSize: Byte;
  26. FKeywordRendering: TRender;
  27. FModule: TPasModule;
  28. FPrefix : string;
  29. FMetadata,
  30. FMarkDown: TStrings;
  31. FSymbolRendering: TRender;
  32. FTheme: String;
  33. FUnderLineRendering: TRender;
  34. FVarRendering: TRender;
  35. FLink : String;
  36. FListStack : Integer;
  37. FIndents : Array[0..MaxIndents] of Word;
  38. FListTypes : Array[1..MaxLists] of TListType;
  39. FTableColCount : Integer;
  40. FMarkDownEngine: TMarkdownEngine;
  41. function GetCurrentIndent: Word;
  42. procedure SetIndentSize(AValue: Byte);
  43. procedure clearIndent;
  44. procedure CalcPrefix;
  45. Protected
  46. function CreateAllocator: TFileAllocator; override;
  47. Procedure DescrEmitNotesHeader(AContext : TPasElement); override;
  48. Procedure DescrEmitNotesFooter(AContext : TPasElement); override;
  49. procedure DescrWriteText(const AText: DOMString); override;
  50. procedure DescrBeginBold; override;
  51. procedure DescrEndBold; override;
  52. procedure DescrBeginItalic; override;
  53. procedure DescrEndItalic; override;
  54. procedure DescrBeginEmph; override;
  55. procedure DescrEndEmph; override;
  56. procedure DescrBeginUnderline; override;
  57. procedure DescrEndUnderline; override;
  58. procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
  59. procedure DescrWriteFileEl(const AText: DOMString); override;
  60. procedure DescrWriteKeywordEl(const AText: DOMString); override;
  61. procedure DescrWriteVarEl(const AText: DOMString); override;
  62. procedure DescrBeginLink(const AId: DOMString); override;
  63. procedure DescrEndLink; override;
  64. procedure DescrBeginURL(const AURL: DOMString); override;
  65. procedure DescrEndURL; override;
  66. procedure DescrWriteLinebreak; override;
  67. procedure DescrBeginParagraph; override;
  68. procedure DescrEndParagraph; override;
  69. procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
  70. procedure DescrWriteCodeLine(const ALine: String); override;
  71. procedure DescrEndCode; override;
  72. procedure DescrBeginOrderedList; override;
  73. procedure DescrEndOrderedList; override;
  74. procedure DescrBeginUnorderedList; override;
  75. procedure DescrEndUnorderedList; override;
  76. procedure DescrBeginDefinitionList; override;
  77. procedure DescrEndDefinitionList; override;
  78. procedure DescrBeginListItem; override;
  79. procedure DescrEndListItem; override;
  80. procedure DescrBeginDefinitionTerm; override;
  81. procedure DescrEndDefinitionTerm; override;
  82. procedure DescrBeginDefinitionEntry; override;
  83. procedure DescrEndDefinitionEntry; override;
  84. procedure DescrBeginSectionTitle; override;
  85. procedure DescrBeginSectionBody; override;
  86. procedure DescrEndSection; override;
  87. procedure DescrBeginRemark; override;
  88. procedure DescrEndRemark; override;
  89. procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
  90. procedure DescrEndTable; override;
  91. procedure DescrBeginTableCaption; override;
  92. procedure DescrEndTableCaption; override;
  93. procedure DescrBeginTableHeadRow; override;
  94. procedure DescrEndTableHeadRow; override;
  95. procedure DescrBeginTableRow; override;
  96. procedure DescrEndTableRow; override;
  97. procedure DescrBeginTableCell; override;
  98. procedure DescrEndTableCell; override;
  99. Protected
  100. // Emit current line, if any
  101. Function OutputCurrentLine : Boolean;
  102. function EscapeMarkDown(aText: Domstring): string;
  103. function EscapeMarkDown(aText: String): string;
  104. function CreateLink(Const aText,aLink : String) : String;
  105. // Append to current line
  106. procedure AppendToLine(aText: DomString; DoEscape: boolean = true);
  107. procedure AppendToLine(aText: UTF8String; DoEscape: boolean = true); virtual;
  108. procedure AppendToLine(aFmt: UTF8String; aArgs : Array of const; DoEscape: boolean = true);
  109. // Write current line and append new line
  110. procedure EmitLine(aText: UTF8String; DoEscape: boolean = true); virtual;
  111. procedure EmitLine(aFmt: UTF8String; aArgs : Array of const; DoEscape: boolean = true);
  112. // Append spans to current line
  113. procedure AppendLink(Const aText,aLink : String);
  114. Procedure AppendRendered(aText : String; aRender : TRender);
  115. Procedure AppendKeyWord(aText : String); inline;
  116. Procedure AppendSymbol(aText : String); inline;
  117. Procedure AppendTableHeader(aHeaders: Array of String);
  118. Procedure EmitCode(aCodeBlock : String; aIndent : Integer = 0);
  119. Procedure EmitCode(aCodeBlock : TStrings; aIndent : Integer = 0);
  120. Procedure EmitCodeLine(aCodeLine : string);
  121. procedure EndSpan(aRender: TRender);
  122. procedure StartSpan(aRender: TRender);
  123. Procedure PushIndent(aNewIndent : Byte);
  124. Procedure PopIndent;
  125. Procedure StartList(aType : TListType);
  126. Procedure StopList(aType : TListType);
  127. Procedure BeginIgnore;
  128. Procedure EndIgnore;
  129. Procedure DoLineBreak;
  130. Function InList : Boolean;
  131. Function CurrentList : TListType;
  132. Property ContentPrefix : String Read FContentPrefix Write FContentPrefix;
  133. Public
  134. Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
  135. destructor Destroy; override;
  136. Procedure AppendHeader(aLevel : THeaderLevel; const AHeader : String; DoEscape : Boolean = true);
  137. Procedure Indent;
  138. Procedure Undent;
  139. Procedure ClearMarkDown;
  140. Procedure EnsureEmptyLine;
  141. procedure SaveToFile(aFileName : string);
  142. procedure AddMetaData(Const aName,aValue : string);
  143. Property CurrentLine : UTF8String Read FCurrentLine Write FCurrentLine;
  144. Property MarkDown : TStrings Read FMarkDown;
  145. Property CurrentIndent : Word Read GetCurrentIndent;
  146. Property Prefix : String Read FPrefix;
  147. Property IndentSize : Byte Read FIndentSize Write SetIndentSize;
  148. Property UnderLineRendering : TRender Read FUnderLineRendering Write FUnderLineRendering;
  149. Property FileRendering : TRender Read FFileRendering Write FFileRendering;
  150. Property VarRendering : TRender Read FVarRendering Write FVarRendering;
  151. Property KeywordRendering : TRender Read FKeywordRendering Write FKeyWordRendering;
  152. Property SymbolRendering : TRender Read FSymbolRendering Write FSymbolRendering;
  153. Property DefinitionSeparator : String Read FDefinitionSeparator Write FDefinitionSeparator;
  154. Property DefinitionTermRender : TRender Read FDefinitionTermRender Write FDefinitionTermRender;
  155. Property BaseImageURL : String Read FBaseImageURL Write FBaseIMageURL;
  156. Property MetaData : TStrings Read FMetaData;
  157. Property MarkDownEngine : TMarkdownEngine Read FMarkDownEngine Write FMarkDownEngine;
  158. Property Theme : String Read FTheme Write FTheme;
  159. end;
  160. implementation
  161. resourcestring
  162. SErrCannotChangeIndentSizeWhenIndented = 'Cannot change indent size while text is indented.';
  163. SErrIndentMismatch = 'Indent mismatch: trying to undent when current indent too small';
  164. SErrNotInList = 'Not in list';
  165. SErrPopListStack = 'Pop list stack list type mismatch';
  166. SErrMinListStack = 'Min list stack reached';
  167. SErrMaxListStack = 'Max list stack reached';
  168. SErrMinIndentStack = 'Min indent stack reached';
  169. SErrMaxIndentStack = 'Max indent stack reached';
  170. procedure TBaseMarkdownWriter.SetIndentSize(AValue: Byte);
  171. begin
  172. if FIndentSize=AValue then Exit;
  173. if CurrentIndent>0 then
  174. FPDocError(SErrCannotChangeIndentSizeWhenIndented);
  175. FIndentSize:=AValue;
  176. end;
  177. function TBaseMarkdownWriter.GetCurrentIndent: Word;
  178. begin
  179. Result:=FIndents[FCurrentIndentIndex];
  180. end;
  181. procedure TBaseMarkdownWriter.clearIndent;
  182. begin
  183. FIndents[FCurrentIndentIndex]:=0;
  184. CalcPrefix;
  185. end;
  186. procedure TBaseMarkdownWriter.CalcPrefix;
  187. begin
  188. FPrefix:=StringOfChar(' ',CurrentIndent);
  189. end;
  190. function TBaseMarkdownWriter.CreateAllocator: TFileAllocator;
  191. begin
  192. Result:=TLongNameFileAllocator.Create('.md');
  193. end;
  194. procedure TBaseMarkdownWriter.DescrEmitNotesHeader(AContext: TPasElement);
  195. begin
  196. AppendHeader(2, SDocNotes);
  197. end;
  198. procedure TBaseMarkdownWriter.DescrEmitNotesFooter(AContext: TPasElement);
  199. begin
  200. EnsureEmptyLine;
  201. end;
  202. function TBaseMarkdownWriter.EscapeMarkDown(aText: Domstring): string;
  203. begin
  204. Result:=EscapeMarkDown(UTF8Encode(aText))
  205. end;
  206. function TBaseMarkdownWriter.EscapeMarkDown(aText: String): string;
  207. begin
  208. Result:=StringReplace(aText,'*','\*',[rfReplaceAll]);
  209. Result:=StringReplace(Result,'_','\_',[rfReplaceAll]);
  210. Result:=StringReplace(Result,'`','\`',[rfReplaceAll]);
  211. end;
  212. function TBaseMarkdownWriter.CreateLink(const aText, aLink: String): String;
  213. begin
  214. Result:=Format('[%s](%s)',[EscapeMarkDown(aText),aLink])
  215. end;
  216. procedure TBaseMarkdownWriter.AppendToLine(aText: DomString; DoEscape: boolean);
  217. begin
  218. If FIgnoreCount>0 then
  219. exit;
  220. AppendToLine(UTF8Encode(aText),DoEscape);
  221. end;
  222. procedure TBaseMarkdownWriter.AppendToLine(aText: UTF8String; DoEscape: boolean
  223. );
  224. begin
  225. if DoEscape then
  226. aText:=EscapeMarkDown(aText);
  227. if (FCurrentLine='') and (FContentPrefix<>'') then
  228. FCurrentLine:=FContentPrefix;
  229. FCurrentLine:=FCurrentLine+aText;
  230. end;
  231. procedure TBaseMarkdownWriter.AppendToLine(aFmt: UTF8String;
  232. aArgs: array of const; DoEscape: boolean);
  233. begin
  234. AppendToLine(Format(aFmt,aArgs),DoEscape);
  235. end;
  236. procedure TBaseMarkdownWriter.EmitLine(aText: UTF8String; DoEscape: boolean);
  237. begin
  238. OutputCurrentLine;
  239. AppendToLine(aText,DoEscape);
  240. OutputCurrentLine;
  241. end;
  242. procedure TBaseMarkdownWriter.EmitLine(aFmt: UTF8String; aArgs: array of const;
  243. DoEscape: boolean);
  244. begin
  245. EmitLine(Format(aFmt,aArgs),DoEscape);
  246. end;
  247. procedure TBaseMarkdownWriter.AppendLink(const aText, aLink: String);
  248. begin
  249. AppendToLine(CreateLink(aText,aLink),False);
  250. end;
  251. procedure TBaseMarkdownWriter.AppendRendered(aText: String; aRender: TRender);
  252. begin
  253. StartSpan(aRender);
  254. AppendToLine(aText);
  255. EndSpan(aRender);
  256. end;
  257. procedure TBaseMarkdownWriter.AppendKeyWord(aText: String);
  258. begin
  259. AppendRendered(aText,KeywordRendering);
  260. end;
  261. procedure TBaseMarkdownWriter.AppendSymbol(aText: String);
  262. begin
  263. AppendRendered(aText,SymbolRendering);
  264. end;
  265. procedure TBaseMarkdownWriter.AppendTableHeader(aHeaders: array of String);
  266. Var
  267. S : String;
  268. begin
  269. DescrBeginTable(Length(aHeaders),False);
  270. DescrBeginTableHeadRow;
  271. for S in aHeaders do
  272. begin
  273. DescrBeginTableCell;
  274. AppendToLine(S);
  275. DescrEndTableCell;
  276. end;
  277. DescrEndTableHeadRow;
  278. end;
  279. procedure TBaseMarkdownWriter.EmitCode(aCodeBlock: String; aIndent : Integer = 0);
  280. Var
  281. L : TStringList;
  282. begin
  283. L:=TStringList.Create;
  284. try
  285. L.Text:=aCodeBlock;
  286. EmitCode(L,aIndent);
  287. finally
  288. L.Free;
  289. end;
  290. end;
  291. procedure TBaseMarkdownWriter.EmitCode(aCodeBlock: TStrings; aIndent : Integer = 0);
  292. var
  293. S,aPrefix : string;
  294. begin
  295. aPrefix:=StringOfChar(' ',aIndent);
  296. For S in aCodeBlock do
  297. EmitCodeLine(aPrefix+S);
  298. end;
  299. procedure TBaseMarkdownWriter.EmitCodeLine(aCodeLine: string);
  300. begin
  301. EmitLine(aCodeLine,False);
  302. end;
  303. procedure TBaseMarkdownWriter.DescrWriteText(const AText: DOMString);
  304. begin
  305. AppendToLine(aText);
  306. end;
  307. procedure TBaseMarkdownWriter.DescrBeginBold;
  308. begin
  309. AppendToLine('**',False);
  310. end;
  311. procedure TBaseMarkdownWriter.DescrEndBold;
  312. begin
  313. AppendToLine('**',False);
  314. end;
  315. procedure TBaseMarkdownWriter.DescrBeginItalic;
  316. begin
  317. AppendToLine('*',False);
  318. end;
  319. procedure TBaseMarkdownWriter.DescrEndItalic;
  320. begin
  321. AppendToLine('*',False);
  322. end;
  323. procedure TBaseMarkdownWriter.DescrBeginEmph;
  324. begin
  325. AppendToLine('*',False);
  326. end;
  327. procedure TBaseMarkdownWriter.DescrEndEmph;
  328. begin
  329. AppendToLine('*',False);
  330. end;
  331. procedure TBaseMarkdownWriter.StartSpan(aRender : TRender);
  332. begin
  333. case aRender of
  334. rStrong : AppendToLine('**',False);
  335. rEmphasis : AppendToLine('*',False);
  336. rCode : AppendToLine('`',False);
  337. end;
  338. end;
  339. procedure TBaseMarkdownWriter.PushIndent(aNewIndent: Byte);
  340. begin
  341. if FCurrentIndentIndex>=MaxIndents then
  342. FPDocError(SErrMaxIndentStack);
  343. Inc(FCurrentIndentIndex);
  344. Findents[FCurrentIndentIndex]:=aNewIndent;
  345. CalcPrefix;
  346. end;
  347. procedure TBaseMarkdownWriter.PopIndent;
  348. begin
  349. if FCurrentIndentIndex<=0 then
  350. FPDocError(SErrMinIndentStack);
  351. Dec(FCurrentIndentIndex);
  352. end;
  353. procedure TBaseMarkdownWriter.StartList(aType: TListType);
  354. begin
  355. If FListStack>=MaxLists then
  356. FPDocError(SErrMaxListStack);
  357. Inc(FListStack);
  358. FListTypes[FListStack]:=aType;
  359. end;
  360. procedure TBaseMarkdownWriter.StopList(aType: TListType);
  361. begin
  362. If FListStack<=0 then
  363. FPDocError(SErrMinListStack);
  364. if FListTypes[FListStack]<>aType then
  365. FPDocError(SErrPopListStack);
  366. Dec(FListStack);
  367. end;
  368. procedure TBaseMarkdownWriter.BeginIgnore;
  369. begin
  370. Inc(FIgnoreCount);
  371. end;
  372. procedure TBaseMarkdownWriter.EndIgnore;
  373. begin
  374. If FignoreCount>0 then
  375. Dec(FIgnoreCount);
  376. end;
  377. procedure TBaseMarkdownWriter.DoLineBreak;
  378. begin
  379. if FCurrentLine<>'' then
  380. begin
  381. FCurrentLine:=FCurrentLine+' ';
  382. OutputCurrentLine;
  383. end;
  384. end;
  385. function TBaseMarkdownWriter.InList: Boolean;
  386. begin
  387. Result:=FlistStack>0;
  388. end;
  389. function TBaseMarkdownWriter.CurrentList: TListType;
  390. begin
  391. if FListStack=0 then
  392. FPDOcError(SErrNotInList);
  393. end;
  394. procedure TBaseMarkdownWriter.EndSpan(aRender : TRender);
  395. begin
  396. case aRender of
  397. rStrong : AppendToLine('**',False);
  398. rEmphasis : AppendToLine('*',False);
  399. rCode : AppendToLine('`',False);
  400. end;
  401. end;
  402. procedure TBaseMarkdownWriter.DescrBeginUnderline;
  403. begin
  404. StartSpan(UnderlineRendering);
  405. end;
  406. procedure TBaseMarkdownWriter.DescrEndUnderline;
  407. begin
  408. EndSpan(UnderlineRendering);
  409. end;
  410. procedure TBaseMarkdownWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
  411. Var
  412. D,FN : String;
  413. L : integer;
  414. begin
  415. // Determine URL for image.
  416. If (Module=Nil) then
  417. D:=Allocator.GetRelativePathToTop(Package)
  418. else
  419. D:=Allocator.GetRelativePathToTop(Module);
  420. L:=Length(D);
  421. If (L>0) and (D[L]<>'/') then
  422. D:=D+'/';
  423. FN:=UTF8Decode(D + BaseImageURL) + AFileName;
  424. EnsureEmptyLine;
  425. AppendToLine('!['+aCaption+']('+FN+')',False);
  426. end;
  427. procedure TBaseMarkdownWriter.DescrWriteFileEl(const AText: DOMString);
  428. begin
  429. AppendRendered(aText,FileRendering);
  430. end;
  431. procedure TBaseMarkdownWriter.DescrWriteKeywordEl(const AText: DOMString);
  432. begin
  433. AppendKeyWord(UTF8ENcode(aText));
  434. end;
  435. procedure TBaseMarkdownWriter.DescrWriteVarEl(const AText: DOMString);
  436. begin
  437. AppendRendered(aText,VarRendering);
  438. end;
  439. procedure TBaseMarkdownWriter.DescrBeginLink(const AId: DOMString);
  440. var
  441. a,s,n : String;
  442. begin
  443. a:=UTF8Encode(AId);
  444. s := UTF8Encode(ResolveLinkID(a));
  445. if Length(s) > 0 then
  446. begin
  447. FLink:=S;
  448. AppendToLine('[');
  449. end
  450. else
  451. begin
  452. FLink:='';
  453. if assigned(module) then
  454. s:=module.name
  455. else
  456. s:='?';
  457. if a='' then a:='<empty>';
  458. if Assigned(CurrentContext) then
  459. N:=CurrentContext.Name
  460. else
  461. N:='?';
  462. DoLog(SErrUnknownLinkID, [s,n,a]);
  463. end
  464. end;
  465. procedure TBaseMarkdownWriter.DescrEndLink;
  466. begin
  467. AppendToLine(']('+FLink+') ',false);
  468. FLink:='';
  469. end;
  470. procedure TBaseMarkdownWriter.DescrBeginURL(const AURL: DOMString);
  471. begin
  472. FLink:=aURL;
  473. AppendToLine('[');
  474. end;
  475. procedure TBaseMarkdownWriter.DescrEndURL;
  476. begin
  477. AppendToLine(']('+FLink+') ',false);
  478. FLink:='';
  479. end;
  480. procedure TBaseMarkdownWriter.DescrWriteLinebreak;
  481. begin
  482. AppendToLine(' ');
  483. OutputCurrentLine;
  484. end;
  485. procedure TBaseMarkdownWriter.DescrBeginParagraph;
  486. begin
  487. EnsureEmptyLine;
  488. end;
  489. procedure TBaseMarkdownWriter.DescrEndParagraph;
  490. begin
  491. EnsureEmptyLine;
  492. end;
  493. procedure TBaseMarkdownWriter.DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String);
  494. Var
  495. hl : string;
  496. begin
  497. hl:=AHighlighterName;
  498. if SameText(hl,'Pascal') or (hl='') then
  499. hl:='delphi';
  500. OutputCurrentLine;
  501. AppendToLine('```'+hl,False);
  502. PushIndent(0);
  503. end;
  504. procedure TBaseMarkdownWriter.DescrWriteCodeLine(const ALine: String);
  505. begin
  506. EmitCodeLine(aLine);
  507. end;
  508. procedure TBaseMarkdownWriter.DescrEndCode;
  509. begin
  510. OutputCurrentLine;
  511. AppendToLine('```',False);
  512. OutputCurrentLine;
  513. PopIndent;
  514. end;
  515. procedure TBaseMarkdownWriter.DescrBeginOrderedList;
  516. begin
  517. StartList(ltOrdered);
  518. end;
  519. procedure TBaseMarkdownWriter.DescrEndOrderedList;
  520. begin
  521. StopList(ltOrdered);
  522. end;
  523. procedure TBaseMarkdownWriter.DescrBeginUnorderedList;
  524. begin
  525. StartList(ltUnordered);
  526. end;
  527. procedure TBaseMarkdownWriter.DescrEndUnorderedList;
  528. begin
  529. StopList(ltUnordered);
  530. end;
  531. procedure TBaseMarkdownWriter.DescrBeginDefinitionList;
  532. begin
  533. StartList(ltDefinition);
  534. end;
  535. procedure TBaseMarkdownWriter.DescrEndDefinitionList;
  536. begin
  537. StopList(ltDefinition);
  538. end;
  539. procedure TBaseMarkdownWriter.DescrBeginListItem;
  540. begin
  541. Case CurrentList of
  542. ltOrdered : AppendToLine('1. ');
  543. ltUnordered : AppendToLine('- ');
  544. ltDefinition :
  545. begin
  546. AppendToLine('- ');
  547. end;
  548. end;
  549. end;
  550. procedure TBaseMarkdownWriter.DescrEndListItem;
  551. begin
  552. OutputCurrentLine;
  553. end;
  554. procedure TBaseMarkdownWriter.DescrBeginDefinitionTerm;
  555. begin
  556. if MarkDownEngine=meMkDocs then
  557. EnsureEmptyLine
  558. else
  559. begin
  560. AppendToLine('- ');
  561. StartSpan(DefinitionTermRender);
  562. end;
  563. end;
  564. procedure TBaseMarkdownWriter.DescrEndDefinitionTerm;
  565. begin
  566. if MarkDownEngine=meMkDocs then
  567. OutputCurrentLine
  568. else
  569. EndSpan(DefinitionTermRender);
  570. end;
  571. procedure TBaseMarkdownWriter.DescrBeginDefinitionEntry;
  572. begin
  573. if MarkDownEngine=meMkDocs then
  574. begin
  575. AppendToLine(': ');
  576. Indent;
  577. end
  578. else
  579. AppendToLine(DefinitionSeparator);
  580. end;
  581. procedure TBaseMarkdownWriter.DescrEndDefinitionEntry;
  582. begin
  583. OutputCurrentLine;
  584. if MarkDownEngine=meMkDocs then
  585. begin
  586. Undent;
  587. EnsureEmptyLine;
  588. end;
  589. end;
  590. procedure TBaseMarkdownWriter.DescrBeginSectionTitle;
  591. begin
  592. EnsureEmptyLine;
  593. end;
  594. procedure TBaseMarkdownWriter.DescrBeginSectionBody;
  595. begin
  596. EnsureEmptyLine;
  597. end;
  598. procedure TBaseMarkdownWriter.DescrEndSection;
  599. begin
  600. EnsureEmptyLine;
  601. end;
  602. procedure TBaseMarkdownWriter.DescrBeginRemark;
  603. begin
  604. if MarkDownEngine=meMkDocs then
  605. begin
  606. EnsureEmptyLine;
  607. AppendToLine('!!! Remark',False);
  608. OutputCurrentLine;
  609. end
  610. else
  611. FContentPrefix:='> ';
  612. end;
  613. procedure TBaseMarkdownWriter.DescrEndRemark;
  614. begin
  615. if MarkDownEngine=meMkDocs then
  616. begin
  617. OutputCurrentLine;
  618. AppendToLine('!!!',False);
  619. end;
  620. EnsureEmptyLine;
  621. FContentPrefix:='';
  622. end;
  623. procedure TBaseMarkdownWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
  624. begin
  625. EnsureEmptyLine;
  626. FTableColCount:=ColCount;
  627. end;
  628. procedure TBaseMarkdownWriter.DescrEndTable;
  629. begin
  630. EnsureEmptyLine;
  631. end;
  632. procedure TBaseMarkdownWriter.DescrBeginTableCaption;
  633. begin
  634. BeginIgnore;
  635. end;
  636. procedure TBaseMarkdownWriter.DescrEndTableCaption;
  637. begin
  638. EndIgnore;
  639. end;
  640. procedure TBaseMarkdownWriter.DescrBeginTableHeadRow;
  641. begin
  642. end;
  643. procedure TBaseMarkdownWriter.DescrEndTableHeadRow;
  644. Var
  645. I : Integer;
  646. begin
  647. AppendToLine(' |',False);
  648. OutputCurrentLine;
  649. AppendToLine('|',False);
  650. For I:=1 to FTableColCount do
  651. AppendToLine('---|',False);
  652. OutputCurrentLine;
  653. end;
  654. procedure TBaseMarkdownWriter.DescrBeginTableRow;
  655. begin
  656. end;
  657. procedure TBaseMarkdownWriter.DescrEndTableRow;
  658. begin
  659. AppendToLine(' |',False);
  660. OutputCurrentLine;
  661. end;
  662. procedure TBaseMarkdownWriter.DescrBeginTableCell;
  663. begin
  664. AppendToLine('| ',False);
  665. end;
  666. procedure TBaseMarkdownWriter.DescrEndTableCell;
  667. begin
  668. AppendToLine(' ',False);
  669. end;
  670. function TBaseMarkdownWriter.OutputCurrentLine: Boolean;
  671. begin
  672. If FIgnoreCount>0 then
  673. exit(False);
  674. Result:=FCurrentLine<>'';
  675. if Result then
  676. begin
  677. FMarkDown.Add(Prefix+FCurrentLine);
  678. FCurrentLine:='';
  679. end;
  680. end;
  681. constructor TBaseMarkdownWriter.Create(APackage: TPasPackage;
  682. AEngine: TFPDocEngine);
  683. begin
  684. inherited Create(APackage, AEngine);
  685. FMarkDown:=TStringList.Create;
  686. FMetaData:=TStringList.Create;
  687. FMetaData.NameValueSeparator:=':';
  688. FIndents[FCurrentIndentIndex]:=0;
  689. CalcPrefix;
  690. Theme:='readthedocs';
  691. end;
  692. destructor TBaseMarkdownWriter.Destroy;
  693. begin
  694. FreeAndNil(FMarkDown);
  695. inherited Destroy;
  696. end;
  697. procedure TBaseMarkdownWriter.AppendHeader(aLevel: THeaderLevel;
  698. const AHeader: String; DoEscape : Boolean = true);
  699. begin
  700. EnsureEmptyLine;
  701. AppendToLine(StringOfChar('#',aLevel)+' ',False);
  702. AppendToLine(aHeader,DoEscape);
  703. end;
  704. procedure TBaseMarkdownWriter.Indent;
  705. begin
  706. Inc(FIndents[FCurrentIndentIndex],IndentSize);
  707. CalcPrefix;
  708. end;
  709. procedure TBaseMarkdownWriter.Undent;
  710. begin
  711. if IndentSize>CurrentIndent then
  712. FPDocError(SErrIndentMismatch);
  713. Dec(FIndents[FCurrentIndentIndex],IndentSize);
  714. CalcPrefix;
  715. end;
  716. procedure TBaseMarkdownWriter.ClearMarkDown;
  717. begin
  718. FMarkDown.Clear;
  719. FMetaData.Clear;
  720. FCurrentLine:='';
  721. FContentPrefix:='';
  722. FCurrentIndentIndex:=0;;
  723. FIndents[FCurrentIndentIndex]:=0;
  724. CalcPrefix;
  725. end;
  726. procedure TBaseMarkdownWriter.EnsureEmptyLine;
  727. begin
  728. if OutputCurrentLine then
  729. FMarkDown.Add('')
  730. else if (FmarkDown.Count>0) and (FMarkDown[FmarkDown.Count-1]<>'') then
  731. FMarkDown.Add('');
  732. end;
  733. procedure TBaseMarkdownWriter.SaveToFile(aFileName: string);
  734. Var
  735. Doc: TStrings;
  736. I : Integer;
  737. N,V : String;
  738. begin
  739. Doc:=TStringList.Create;
  740. try
  741. if FMetadata.Count>0 then
  742. begin
  743. Doc.Add('---');
  744. For I:=0 to FMetadata.Count-1 do
  745. begin
  746. FMetaData.GetNameValue(I,N,V);
  747. Doc.Add(Lowercase(N)+': "'+V+'"');
  748. end;
  749. Doc.Add('---');
  750. end;
  751. Doc.AddStrings(FMarkDown);
  752. Doc.SaveToFile(aFileName);
  753. finally
  754. Doc.Free;
  755. end;
  756. end;
  757. procedure TBaseMarkdownWriter.AddMetaData(const aName, aValue: string);
  758. begin
  759. FMetadata.Values[aName]:=aValue;
  760. end;
  761. end.