dw_basemd.pp 22 KB

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