A Markdown Processor Library for Delphi, to process/convert markdown files to HTML.
34 |Latest Version 1.2.0 - 08 Apr 2025
35 | 36 |This is a Pascal (Delphi) library that processes markdown to HTML. 38 | At present the following dialects of markdown are supported:
39 |Declare a variable of the class TMarkdownProcessor:
49 | var
50 | md : TMarkdownProcessor;
51 | Create a TMarkdownProcessor (MarkdownProcessor.pas) of the dialect you want:
53 | md := TMarkdownProcessor.createDialect(mdDaringFireball)
54 | Decide whether you want to allow active content
56 | md.AllowUnSafe := true;
57 | Note: you should only set this to true if you need to - active content can be a significant safety/security issue.
Generate HTML fragments from Markdown content:
60 | html := md.process(markdown);
61 | Note that the HTML returned is an HTML fragment, not a full HTML page.
63 |Do not forget to dispose of the object after the use:
64 | md.free
65 | Large rework was made for adding support for tables, math formulas, etc.
67 |this library is used in two projects:
69 |A collection of tools for markdown files, to edit and view content, with an advanced Editor:
73 |
An integrated help system based on files in Markdown format (and also html), for Delphi applications:
78 |
08 Apr 2025: ver. 1.2.0
81 |16 Dec 2024: ver. 1.1.0
85 |22 Oct 2023: ver. 1.0.0
89 |Copyright (c) Ethea S.r.l.
96 |Licensed under the Apache License, Version 2.0 (the “License”);
97 |you may not use this file except in compliance with the License.
98 |You may obtain a copy of the License at
99 |http://www.apache.org/licenses/LICENSE-2.0
100 |Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an “AS IS” BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
101 |MarkdownProcessor implementation is a fork of FPC-markdown by Miguel A. Risco-Castillo 103 | FPC-markdown
104 |FPC-markdown implementation is a fork of Grahame Grieve pascal port 105 | Delphi-markdown
106 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Markdown Processor [](https://opensource.org/licenses/Apache-2.0) 2 | 3 | A Markdown Processor Library for Delphi, to process/convert markdown files to HTML. 4 | 5 | **Latest Version 1.2.0 - 08 Apr 2025** 6 | 7 | ============ 8 | 9 | Basic Information 10 | ----------------- 11 | 12 | This is a Pascal (Delphi) library that processes markdown to HTML. 13 | At present the following dialects of markdown are supported: 14 | 15 | * The Daring Fireball dialect 16 | (see`
31 |
32 | ~~Strike~~
33 |
34 | ++Underline++
35 |
36 | Subscript text
37 |
38 | Superscript text
39 |
40 | ==Mark==
41 |
42 | ```Delphi
43 | procedure HelloWorld;
44 | begin
45 | ShowMessage('Hello World');
46 | end;
47 | ```
48 | * Unordered List one
49 | * Unordered List two
50 | * Unordered List three
51 |
52 | 1. Ordered List one
53 | 1. Ordered List two
54 | 1. Ordered List three
55 |
56 | > Block quote
57 |
58 | ---
59 | ### Horizontal rule
60 |
61 | ## Tables
62 |
63 | | First Header | Second Header | Third Header |
64 | | :----------- | :-----------: | -----------: |
65 | | Left | Center | Right |
66 | | Second row | **strong** | *italic* |
67 |
68 | ## Formulas
69 |
70 | It is possible to use the [Google Chart API] using `TeX` language,
71 | but the translated formula can only to be seen using a browser,
72 | for insert a formula using `TeX` enclose the code between `$`
73 | without `spaces`:
74 |
75 | Quadratic formula |Zeta formula
76 | ---------------------------|-----------------------------
77 | $x=\frac{-b\pm\sqrt{b^2-4ac}}{2a}$ | $\zeta(s)=\sum_{n=1}^\infty\frac{1}{n^s}$
78 |
79 | [Google Chart API]:https://developers.google.com/chart/infographics/docs/formulas
80 |
--------------------------------------------------------------------------------
/TestFile/markdownlogo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/MarkdownProcessor/c1e1c1deb0e733607c0d1cd2fce5035329aa90d9/TestFile/markdownlogo.png
--------------------------------------------------------------------------------
/images/ContentPage.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/MarkdownProcessor/c1e1c1deb0e733607c0d1cd2fce5035329aa90d9/images/ContentPage.png
--------------------------------------------------------------------------------
/images/MDTextEditorLight.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/MarkdownProcessor/c1e1c1deb0e733607c0d1cd2fce5035329aa90d9/images/MDTextEditorLight.png
--------------------------------------------------------------------------------
/source/MarkdownCommonMark.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | Unit MarkdownCommonMark;
27 |
28 | {
29 | Copyright (c) 2011+, Health Intersections Pty Ltd (http://www.healthintersections.com.au)
30 | All rights reserved.
31 |
32 | Redistribution and use in source and binary forms, with or without modification,
33 | are permitted provided that the following conditions are met:
34 |
35 | * Redistributions of source code must retain the above copyright notice, this
36 | list of conditions and the following disclaimer.
37 | * Redistributions in binary form must reproduce the above copyright notice,
38 | this list of conditions and the following disclaimer in the documentation
39 | and/or other materials provided with the distribution.
40 | * Neither the name of HL7 nor the names of its contributors may be used to
41 | endorse or promote products derived from this software without specific
42 | prior written permission.
43 |
44 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 'AS IS' AND
45 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
46 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
47 | IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
48 | INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
49 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
50 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
51 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
52 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
53 | POSSIBILITY OF SUCH DAMAGE.
54 | }
55 | interface
56 |
57 | uses
58 | System.SysUtils
59 | , System.Classes
60 | , System.TypInfo
61 | , MarkdownProcessor
62 | , MarkdownDaringFireball
63 | , MarkdownUtils
64 | ;
65 |
66 | Type
67 |
68 | TMarkdownCommonMark = class(TMarkdownDaringFireball)
69 | private
70 | protected
71 | public
72 | Constructor Create;
73 | Destructor Destroy; override;
74 | function Process(const ASource: string): string; override;
75 | end;
76 |
77 | implementation
78 |
79 |
80 | { TMarkdownCommonMark }
81 |
82 | constructor TMarkdownCommonMark.Create;
83 | begin
84 | inherited;
85 | Config.Dialect:=mdCommonMark;
86 | end;
87 |
88 | destructor TMarkdownCommonMark.Destroy;
89 | begin
90 | inherited;
91 | end;
92 |
93 | function TMarkdownCommonMark.Process(const ASource: string): string;
94 | begin
95 | result := inherited Process(ASource);
96 | end;
97 |
98 |
99 | end.
100 |
--------------------------------------------------------------------------------
/source/MarkdownDaringFireball.pas:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/EtheaDev/MarkdownProcessor/c1e1c1deb0e733607c0d1cd2fce5035329aa90d9/source/MarkdownDaringFireball.pas
--------------------------------------------------------------------------------
/source/MarkdownMathCode.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | unit MarkdownMathCode;
27 |
28 | interface
29 |
30 | uses
31 | Classes, SysUtils, MarkdownUtils;
32 |
33 | function checkMathCode(out_: TStringBuilder; s: String; start: integer): integer;
34 |
35 | implementation
36 |
37 | function checkMathCode(out_: TStringBuilder; s: String; start: integer
38 | ): integer;
39 | var
40 | temp: TStringBuilder;
41 | position: integer;
42 | code: String;
43 | begin
44 | temp := TStringBuilder.Create();
45 | try
46 | // Check for mathcode {a^2+b^2=c^2} and generate link
47 | temp.Clear;
48 | position := TUtils.readUntil(temp, s, start + 1, [' ', '$', #10]);
49 | if (position <> -1) and (s[1 + position] = '$') and
50 | (s[position] <> '\') then
51 | begin
52 | code:= temp.ToString();
53 | out_.append(';
54 | TUtils.codeEncode(out_, code, 0);
55 | out_.append(')
');
58 | exit(position);
59 | end;
60 | result := -1;
61 | finally
62 | temp.Free;
63 | end;
64 | end;
65 |
66 | end.
67 |
68 |
--------------------------------------------------------------------------------
/source/MarkdownProcessor.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | {
27 | Copyright (c) 2011+, Health Intersections Pty Ltd (http://www.healthintersections.com.au)
28 | All rights reserved.
29 |
30 | Redistribution and use in source and binary forms, with or without modification,
31 | are permitted provided that the following conditions are met:
32 |
33 | * Redistributions of source code must retain the above copyright notice, this
34 | list of conditions and the following disclaimer.
35 | * Redistributions in binary form must reproduce the above copyright notice,
36 | this list of conditions and the following disclaimer in the documentation
37 | and/or other materials provided with the distribution.
38 | * Neither the name of HL7 nor the names of its contributors may be used to
39 | endorse or promote products derived from this software without specific
40 | prior written permission.
41 |
42 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 'AS IS' AND
43 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
44 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
45 | IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
46 | INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
47 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
48 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
49 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
50 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
51 | POSSIBILITY OF SUCH DAMAGE.
52 | }
53 | Unit MarkdownProcessor;
54 |
55 | interface
56 |
57 | uses
58 | System.Classes
59 | , System.SysUtils
60 | , MarkdownUtils
61 | ;
62 |
63 | Type
64 |
65 | { TMarkdownProcessor }
66 |
67 | TMarkdownProcessor = {abstract} class
68 | private
69 | FConfig: TConfiguration;
70 | protected
71 | function GetAllowUnSafe: boolean; virtual; abstract;
72 | procedure SetAllowUnSafe(const Value: boolean); virtual; abstract;
73 | public
74 | class function CreateDialect(dialect : TMarkdownProcessorDialect) : TMarkdownProcessor;
75 | function Process(const ASource : string) : string; virtual; abstract;
76 | function ProcessFile(const AFileName: TFileName;
77 | const AEncoding: TEncoding = nil): string; virtual;
78 | property config: TConfiguration read FConfig write FConfig;
79 | // when AllowUnsafe = true, then the processor can create scripts etc.
80 | property AllowUnsafe : boolean read GetAllowUnSafe write SetAllowUnSafe;
81 | end;
82 |
83 | implementation
84 |
85 | uses
86 | MarkdownDaringFireball
87 | , MarkdownCommonMark
88 | , MarkdownTxtMark
89 | ;
90 |
91 | { TMarkdownProcessor }
92 |
93 | class function TMarkdownProcessor.CreateDialect(dialect: TMarkdownProcessorDialect): TMarkdownProcessor;
94 | begin
95 | case dialect of
96 | mdDaringFireball : result := TMarkdownDaringFireball.Create;
97 | mdCommonMark : result := TMarkdownCommonMark.Create;
98 | mdTxtMark : result := TMarkdownTxtMark.Create;
99 | else
100 | raise Exception.Create('Unknown Markdown dialect');
101 | end;
102 | end;
103 |
104 | function TMarkdownProcessor.ProcessFile(const AFileName: TFileName;
105 | const AEncoding: TEncoding): string;
106 | var
107 | LMarkdown: TStringList;
108 | begin
109 | result:='';
110 | LMarkdown := TStringList.Create;
111 | try
112 | LMarkdown.LoadFromFile(AFileName, AEncoding);
113 | result:=process(LMarkdown.Text);
114 | finally
115 | if assigned(LMarkdown) then Lmarkdown.Free;
116 | end;
117 | end;
118 |
119 | end.
120 |
--------------------------------------------------------------------------------
/source/MarkdownTables.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | unit MarkdownTables;
27 |
28 | interface
29 |
30 | uses
31 | Classes, SysUtils, MarkdownUtils;
32 |
33 | type
34 |
35 | { TTable }
36 |
37 | TTable = class
38 | public
39 | class var
40 | Rows:integer;
41 | Cols:integer;
42 | Emitter:TEmitter;
43 | class procedure RowSplit (Input: string; const Strings: TStrings);
44 | class function ProcTable(var L: TLine): string;
45 | class procedure emitTableLines(out_: TStringBuilder; lines: TLine);
46 | class function hasFormatChars(L: Tline): integer;
47 | class function isRow(L: Tline): boolean;
48 | class function ColCount(L: Tline): integer;
49 | class procedure AlignFormat(f: string; sl: TStringList);
50 | end;
51 |
52 |
53 | implementation
54 |
55 | class procedure TTable.RowSplit (Input: string; const Strings: TStrings);
56 | var
57 | i,j:integer;
58 | s:string;
59 | begin
60 | if not Assigned(Strings) then exit;
61 | i:=1;
62 | j:=Length(Input);
63 | if Input[i]='|' then inc(i);
64 | if (Input[j]='|') and (Input[j-1]<>'\') then dec(j);
65 | s:='';
66 | Strings.Clear;
67 | while (i<=j) do
68 | begin
69 | if ((Input[i]='|') and (Input[i-1]<>'\')) then
70 | begin
71 | Strings.Append(s);
72 | s:='';
73 | end else s:=s+Input[i];
74 | inc(i);
75 | end;
76 | Strings.Append(s);
77 | end;
78 |
79 | class function TTable.ProcTable(var L: TLine): string;
80 | (*
81 | | First Header | Second Header | Third Header |
82 | | :----------- | :-----------: | -----------: |
83 | | Left | Center | Right |
84 | | Second row | **strong** | *italic* |
85 | *)
86 | var
87 | cell,outs,t,t2:string;
88 | orig:TLine;
89 | first:boolean;
90 | col:integer;
91 | tsl:TStringList;
92 | ColAlign:TStringList;
93 |
94 | begin
95 | outs:='';
96 | first:=true;
97 | tsl:=TStringList.Create;
98 | ColAlign:=TStringList.Create;
99 | orig:=L;
100 |
101 | while (orig<>nil) and not(orig.isEmpty) do
102 | begin
103 | t:=trim(orig.Value);
104 | t2:='';
105 | RowSplit(t, tsl);
106 | if (first) then // get header
107 | begin
108 | AlignFormat(orig.next.Value,ColAlign); // get format row
109 | col:=0;
110 | for cell in tsl do
111 | begin
112 | t2:=t2+' '#10;
113 | inc(col);
114 | end;
115 | first:=false;
116 | orig:=orig.next; // skip table format row
117 | end else
118 | begin
119 | col:=0;
120 | for cell in tsl do
121 | begin
122 | t2:=t2+' '#10;
123 | inc(col);
124 | end;
125 | end;
126 | if t2<>'' then
127 | begin
128 | outs := outs+' '#10+t2+' '#10;
129 | inc(Rows);
130 | end;
131 | orig:=orig.next;
132 | end;
133 | t:=''#10;
134 | t:=t+outs+'
'#10;
135 | tsl.free;
136 | ColAlign.free;
137 | ProcTable:=t;
138 | end;
139 |
140 | class procedure TTable.emitTableLines(out_: TStringBuilder; lines: TLine);
141 | var line:TLine;
142 | begin
143 | line := lines;
144 | if Assigned(Emitter) then Emitter.recursiveEmitLine(out_, ProcTable(line), 0, mtNONE);
145 | end;
146 |
147 | class function TTable.hasFormatChars(L: Tline): integer;
148 | var
149 | i,j:integer;
150 | begin
151 | result:=0;Cols:=0;
152 | if not Assigned(L) or L.isEmpty then exit(0);
153 | i:=L.leading+1;
154 | j:=Length(L.value)-L.trailing;
155 | if i>4 then exit(0); // more of 4 spaces of identation
156 | if L.value[i]='|' then inc(i);
157 | if L.value[j]='|' then dec(j);
158 | while (i<=j) do
159 | begin
160 | if not CharInSet(L.value[i], [' ','|','-',':']) then
161 | exit(0);
162 | if L.value[i]='|' then inc(result);
163 | inc(i);
164 | end;
165 | Cols:=result;
166 | end;
167 |
168 | class function TTable.isRow(L: Tline): boolean;
169 | var
170 | c:integer;
171 | begin
172 | c:=ColCount(L);
173 | exit((c>0) and (c<=Cols))
174 | end;
175 |
176 | class function TTable.ColCount(L: Tline): integer;
177 | var
178 | i,j,r:integer;
179 | begin
180 | if not Assigned(L) or L.isEmpty then exit(0);
181 | r:=0;
182 | i:=L.leading+1;
183 | j:=Length(L.value)-L.trailing;
184 | if i>4 then exit(0); // more of 4 spaces of identation
185 | if L.value[i]='|' then inc(i);
186 | if L.value[j]='|' then dec(j);
187 | while (i<=j) do
188 | begin
189 | if (L.value[i]='|') and (L.value[i-1]<>'\') then inc(r);
190 | inc(i);
191 | end;
192 | exit(r);
193 | end;
194 |
195 | class procedure TTable.AlignFormat(f: string; sl: TStringList);
196 | var
197 | i:integer;
198 | begin
199 | f:=trim(f);
200 | if f[1]='|' then f:=Copy(f,2);
201 | if f[length(f)]='|' then f:=Copy(f,1,length(f)-1);
202 | RowSplit(f, sl);
203 | for i:=0 to sl.Count-1 do
204 | begin
205 | if sl[i].Contains(':-') and sl[i].Contains('-:') then sl[i]:=' align="center">'
206 | else if sl[i].Contains(':-') then sl[i]:=' align="left">'
207 | else if sl[i].Contains('-:') then sl[i]:=' align="right">'
208 | else sl[i]:='>';
209 | end;
210 | end;
211 |
212 | end.
213 |
214 |
--------------------------------------------------------------------------------
/source/MarkdownTxtMark.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | Unit MarkdownTxtMark;
27 |
28 | interface
29 |
30 | uses
31 | System.SysUtils
32 | , System.Classes
33 | , System.TypInfo
34 | , MarkdownDaringFireball
35 | , MarkdownUtils;
36 |
37 | Type
38 |
39 | TMarkdownTxtMark = class(TMarkdownDaringFireball)
40 | private
41 | protected
42 | public
43 | Constructor Create;
44 | Destructor Destroy; override;
45 | function Process(const ASource: string): string; override;
46 | end;
47 |
48 | implementation
49 |
50 |
51 | { TMarkdownTxtMark }
52 |
53 | constructor TMarkdownTxtMark.Create;
54 | begin
55 | inherited;
56 | Config.Dialect:=mdTxtMark;
57 | end;
58 |
59 | destructor TMarkdownTxtMark.Destroy;
60 | begin
61 |
62 | inherited;
63 | end;
64 |
65 | function TMarkdownTxtMark.Process(const ASource: string): string;
66 | begin
67 | result := inherited Process(ASource);
68 | end;
69 |
70 |
71 | end.
72 |
--------------------------------------------------------------------------------
/source/MarkdownUtils.pas:
--------------------------------------------------------------------------------
1 | {******************************************************************************}
2 | { }
3 | { MarkDown Processor }
4 | { Delphi version of FPC-markdown by Miguel A. Risco-Castillo }
5 | { }
6 | { Copyright (c) 2022-2025 (Ethea S.r.l.) }
7 | { Author: Carlo Barazzetta }
8 | { }
9 | { https://github.com/EtheaDev/MarkdownProcessor }
10 | { }
11 | {******************************************************************************}
12 | { }
13 | { Licensed under the Apache License, Version 2.0 (the "License"); }
14 | { you may not use this file except in compliance with the License. }
15 | { You may obtain a copy of the License at }
16 | { }
17 | { http://www.apache.org/licenses/LICENSE-2.0 }
18 | { }
19 | { Unless required by applicable law or agreed to in writing, software }
20 | { distributed under the License is distributed on an "AS IS" BASIS, }
21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
22 | { See the License for the specific language governing permissions and }
23 | { limitations under the License. }
24 | { }
25 | {******************************************************************************}
26 | Unit MarkdownUtils;
27 |
28 | interface
29 |
30 | uses
31 | System.SysUtils
32 | , System.StrUtils
33 | , System.Classes
34 | , System.Character
35 | , System.TypInfo
36 | , System.Math
37 | ;
38 |
39 | Type
40 | TMarkdownProcessorDialect = (mdDaringFireball, mdCommonMark, mdTxtMark);
41 | TSeTMarkdownProcessorDialect = set of TMarkdownProcessorDialect;
42 |
43 | THTMLElement = (heNONE, hea, heabbr, heacronym, headdress, heapplet, hearea, heb, hebase, hebasefont, hebdo, hebig, heblockquote, hebody, hebr, hebutton, hecaption, hecite,
44 | hecode, hecol, hecolgroup, hedd, hedel, hedfn, hediv, hedl, hedt, heem, hefieldset, hefont, heform, heframe, heframeset, heh1, heh2, heh3, heh4, heh5, heh6, hehead, hehr,
45 | hehtml, hei, heiframe, heimg, heinput, heins, hekbd, helabel, helegend, heli, helink, hemap, hemeta, henoscript, heobject, heol, heoptgroup, heoption, hep, heparam, hepre, heq,
46 | hes, hesamp, hescript, heselect, hesmall, hespan, hestrike, hestrong, hestyle, hesub, hesup, hetable, hetbody, hetd, hetextarea, hetfoot, heth, hethead, hetitle, hetr, hett,
47 | heu, heul, hevar);
48 |
49 | const
50 | // pstfix
51 | ENTITY_NAMES: array[0..249] of String = ('Â', 'â', '´', 'Æ', 'æ', 'À', 'à', 'ℵ', 'Α', 'α', '&', '∧', '∠',
52 | ''', 'Å', 'å', '≈', 'Ã', 'ã', 'Ä', 'ä', '„', 'Β', 'β', '¦', '•', '∩', 'Ç', 'ç',
53 | '¸', '¢', 'Χ', 'χ', 'ˆ', '♣', '≅', '©', '↵', '∪', '¤', '‡', '†', '⇓', '↓', '°', 'Δ',
54 | 'δ', '♦', '÷', 'É', 'é', 'Ê', 'ê', 'È', 'è', '∅', ' ', ' ', 'Ε', 'ε', '≡',
55 | 'Η', 'η', 'Ð', 'ð', 'Ë', 'ë', '€', '∃', 'ƒ', '∀', '½', '¼', '¾', '⁄', 'Γ', 'γ', '≥',
56 | '>', '⇔', '↔', '♥', '…', 'Í', 'í', 'Î', 'î', '¡', 'Ì', 'ì', 'ℑ', '∞', '∫', 'Ι',
57 | 'ι', '¿', '∈', 'Ï', 'ï', 'Κ', 'κ', 'Λ', 'λ', '⟨', '«', '⇐', '←', '⌈', '“', '≤',
58 | '⌊', '∗', '◊', '', '‹', '‘', '<', '¯', '—', 'µ', '·', '−', 'Μ', 'μ', '∇', ' ', '–',
59 | '≠', '∋', '¬', '∉', '⊄', 'Ñ', 'ñ', 'Ν', 'ν', 'Ó', 'ó', 'Ô', 'ô', 'Œ', 'œ', 'Ò',
60 | 'ò', '‾', 'Ω', 'ω', 'Ο', 'ο', '⊕', '∨', 'ª', 'º', 'Ø', 'ø', 'Õ', 'õ', '⊗',
61 | 'Ö', 'ö', '¶', '∂', '‰', '⊥', 'Φ', 'φ', 'Π', 'π', 'ϖ', '±', '£', '″', '′', '∏', '∝',
62 | 'Ψ', 'ψ', '"', '√', '⟩', '»', '⇒', '→', '⌉', '”', 'ℜ', '®', '⌋', 'Ρ', 'ρ', '', '›',
63 | '’', '‚', 'Š', 'š', '⋅', '§', '', 'Σ', 'σ', 'ς', '∼', '♠', '⊂', '⊆', '∑', '⊃', '¹',
64 | '²', '³', '⊇', 'ß', 'Τ', 'τ', '∴', 'Θ', 'θ', 'ϑ', ' ', 'þ', '˜', '×', '™', 'Ú',
65 | 'ú', '⇑', '↑', 'Û', 'û', 'Ù', 'ù', '¨', 'ϒ', 'Υ', 'υ', 'Ü', 'ü', '℘', 'Ξ', 'ξ',
66 | 'Ý', 'ý', '¥', 'Ÿ', 'ÿ', 'Ζ', 'ζ', '', '');
67 |
68 | // Characters corresponding to ENTITY_NAMES. */
69 | // pstfix
70 | ENTITY_CHARS: array[0..249] of integer = ($00C2, $00E2, $00B4, $00C6, $00E6, $00C0, $00E0, $2135, $0391, $03B1, $0026, $2227, $2220, ord(''''), $00C5, $00E5, $2248, $00C3, $00E3, $00C4,
71 | $00E4, $201E, $0392, $03B2, $00A6, $2022, $2229, $00C7, $00E7, $00B8, $00A2, $03A7, $03C7, $02C6, $2663, $2245, $00A9, $21B5, $222A, $00A4, $2021, $2020, $21D3, $2193, $00B0,
72 | $0394, $03B4, $2666, $00F7, $00C9, $00E9, $00CA, $00EA, $00C8, $00E8, $2205, $2003, $2002, $0395, $03B5, $2261, $0397, $03B7, $00D0, $00F0, $00CB, $00EB, $20AC, $2203, $0192,
73 | $2200, $00BD, $00BC, $00BE, $2044, $0393, $03B3, $2265, $003E, $21D4, $2194, $2665, $2026, $00CD, $00ED, $00CE, $00EE, $00A1, $00CC, $00EC, $2111, $221E, $222B, $0399, $03B9,
74 | $00BF, $2208, $00CF, $00EF, $039A, $03BA, $039B, $03BB, $2329, $00AB, $21D0, $2190, $2308, $201C, $2264, $230A, $2217, $25CA, $200E, $2039, $2018, $003C, $00AF, $2014, $00B5,
75 | $00B7, $2212, $039C, $03BC, $2207, $00A0, $2013, $2260, $220B, $00AC, $2209, $2284, $00D1, $00F1, $039D, $03BD, $00D3, $00F3, $00D4, $00F4, $0152, $0153, $00D2, $00F2, $203E,
76 | $03A9, $03C9, $039F, $03BF, $2295, $2228, $00AA, $00BA, $00D8, $00F8, $00D5, $00F5, $2297, $00D6, $00F6, $00B6, $2202, $2030, $22A5, $03A6, $03C6, $03A0, $03C0, $03D6, $00B1,
77 | $00A3, $2033, $2032, $220F, $221D, $03A8, $03C8, $0022, $221A, $232A, $00BB, $21D2, $2192, $2309, $201D, $211C, $00AE, $230B, $03A1, $03C1, $200F, $203A, $2019, $201A, $0160,
78 | $0161, $22C5, $00A7, $00AD, $03A3, $03C3, $03C2, $223C, $2660, $2282, $2286, $2211, $2283, $00B9, $00B2, $00B3, $2287, $00DF, $03A4, $03C4, $2234, $0398, $03B8, $03D1, $00DE,
79 | $00FE, $02DC, $00D7, $2122, $00DA, $00FA, $21D1, $2191, $00DB, $00FB, $00D9, $00F9, $00A8, $03D2, $03A5, $03C5, $00DC, $00FC, $2118, $039E, $03BE, $00DD, $00FD, $00A5, $0178,
80 | $00FF, $0396, $03B6, $200D, $200C);
81 |
82 | LINK_PREFIXES: array[0..3] of String = ('http', 'https', 'ftp', 'ftps');
83 |
84 | BLOCK_ELEMENTS: set of THTMLElement = [headdress, heblockquote, hedel, hediv, hedl, hefieldset, heform, heh1, heh2, heh3, heh4, heh5, heh6, hehr, heins, henoscript, heol, hep,
85 | hepre, hetable, heul];
86 |
87 | UNSAFE_ELEMENTS: set of THTMLElement = [heapplet, hehead, hehtml, hebody, heframe, heframeset, heiframe, hescript, heobject];
88 |
89 | BUFFER_INCREMENT_SIZE = 1024;
90 |
91 | Type
92 | TMarkdownReader = class
93 | private
94 | FValue: String;
95 | FCursor: integer;
96 | public
97 | Constructor Create(source: String);
98 | function read: char;
99 | end;
100 |
101 | {$IFDEF FPC}
102 | TStringBuilder = class
103 | private
104 | FContent : String;
105 | FLength : Integer;
106 | FBufferSize : integer;
107 | function GetChar(index: integer): char;
108 | public
109 | Constructor Create;
110 | procedure Clear;
111 | procedure Append(value : String); overload;
112 | procedure Append(value : integer); overload;
113 | procedure Append(value : TStringBuilder); overload;
114 | property ch[index : integer] : char read GetChar; default;
115 | function toString : String; override;
116 | Property Length : Integer Read FLength;
117 | end;
118 | {$ENDIF}
119 |
120 | { TUtils }
121 |
122 | TUtils = class
123 | public
124 | // Skips spaces in the given String. return The new position or -1 if EOL has been reached.
125 | class function skipSpaces(s: String; start: integer): integer;
126 |
127 | // Process the given escape sequence. return The new position.
128 | class function escape(out_: TStringBuilder; ch: char; position: integer): integer;
129 |
130 | // Reads characters until any 'end' character is encountered. return The new position or -1 if no 'end' char was found.
131 | class function readUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer; overload;
132 |
133 | // Reads characters until the 'end' character is encountered. return The new position or -1 if no 'end' char was found.
134 | class function readUntil(out_: TStringBuilder; s: String; start: integer; cend: char): integer; overload;
135 |
136 | // Reads a markdown link. return The new position or -1 if this is no valid markdown link.
137 | class function readMdLink(out_: TStringBuilder; s: String; start: integer): integer;
138 | class function readMdLinkId(out_: TStringBuilder; s: String; start: integer): integer;
139 |
140 | // Reads characters until any 'end' character is encountered, ignoring escape sequences.
141 | class function readRawUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer; overload;
142 |
143 | // Reads characters until the end character is encountered, taking care of HTML/XML strings.
144 | class function readRawUntil(out_: TStringBuilder; s: String; start: integer; cend: char): integer; overload;
145 |
146 | // Reads characters until any 'end' character is encountered, ignoring escape sequences.
147 | class function readXMLUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer;
148 |
149 | // Appends the given string encoding special HTML characters.
150 | class procedure appendCode(out_: TStringBuilder; s: String; start: integer; e: integer);
151 |
152 | // Appends the given string encoding special HTML characters (used in HTML
153 | class procedure appendValue(out_: TStringBuilder; s: String; start: integer; e: integer);
154 |
155 | // Append the given char as a decimal HTML entity.
156 | class procedure appendDecEntity(out_: TStringBuilder; value: char);
157 |
158 | // Append the given char as a hexadecimal HTML entity.
159 | class procedure appendHexEntity(out_: TStringBuilder; value: char);
160 |
161 | // Appends the given mailto link using obfuscation.
162 | class procedure appendMailto(out_: TStringBuilder; s: String; start: integer; e: integer);
163 |
164 | // Extracts the tag from an XML element.
165 | class procedure getXMLTag(out_: TStringBuilder; bin: TStringBuilder); overload;
166 |
167 | // Extracts the tag from an XML element.
168 | class procedure getXMLTag(out_: TStringBuilder; s: String); overload;
169 |
170 | // Reads an XML element.
171 | // return The new position or -1 if this is no valid XML element.
172 | class function readXML(out_: TStringBuilder; s: String; start: integer; safeMode: boolean): integer;
173 |
174 | // Appends the given string to the given StringBuilder, replacing '&', '<' and '>' by their respective HTML entities.
175 | class procedure codeEncode(out_: TStringBuilder; value: String; offset: integer);
176 |
177 | // Removes trailing ` or ~ and trims spaces.
178 | class function getMetaFromFence(fenceLine: String): String;
179 |
180 | // Changes unsafe chars to %xx
181 | class function encodeURL(url: String): String;
182 | end;
183 |
184 | { THTML }
185 |
186 | THTML = class
187 | public
188 | class function isLinkPrefix(s: String): boolean;
189 | class function isEntity(s: String): boolean;
190 | class function isUnsafeHtmlElement(s: String): boolean;
191 | class function isHtmlBlockElement(s: String): boolean;
192 | end;
193 |
194 | { TDecorator }
195 |
196 | TDecorator = class
197 | private
198 | public
199 | procedure openParagraph(out_: TStringBuilder); virtual;
200 | procedure closeParagraph(out_: TStringBuilder); virtual;
201 |
202 | procedure openBlockQuote(out_: TStringBuilder); virtual;
203 | procedure closeBlockQuote(out_: TStringBuilder); virtual;
204 |
205 | procedure openCodeBlock(out_: TStringBuilder); virtual;
206 | procedure openFencedCodeBlock(out_: TStringBuilder; classlabel:string);
207 | procedure closeCodeBlock(out_: TStringBuilder); virtual;
208 |
209 | procedure openCodeSpan(out_: TStringBuilder); virtual;
210 | procedure closeCodeSpan(out_: TStringBuilder); virtual;
211 |
212 | procedure openHeadline(out_: TStringBuilder; level: integer); virtual;
213 | procedure closeHeadline(out_: TStringBuilder; level: integer); virtual;
214 |
215 | procedure openStrong(out_: TStringBuilder); virtual;
216 | procedure closeStrong(out_: TStringBuilder); virtual;
217 |
218 | procedure openEmphasis(out_: TStringBuilder); virtual;
219 | procedure closeEmphasis(out_: TStringBuilder); virtual;
220 |
221 | procedure openStrike(out_: TStringBuilder); virtual;
222 | procedure closeStrike(out_: TStringBuilder); virtual;
223 |
224 | procedure openIns(out_: TStringBuilder); virtual;
225 | procedure closeIns(out_: TStringBuilder); virtual;
226 |
227 | procedure openMark(out_: TStringBuilder); virtual;
228 | procedure closeMark(out_: TStringBuilder); virtual;
229 |
230 | procedure openSuper(out_: TStringBuilder); virtual;
231 | procedure closeSuper(out_: TStringBuilder); virtual;
232 |
233 | procedure openSub(out_: TStringBuilder); virtual;
234 | procedure closeSub(out_: TStringBuilder); virtual;
235 |
236 | procedure openOrderedList(out_: TStringBuilder); virtual;
237 | procedure closeOrderedList(out_: TStringBuilder); virtual;
238 |
239 | procedure openUnOrderedList(out_: TStringBuilder); virtual;
240 | procedure closeUnOrderedList(out_: TStringBuilder); virtual;
241 |
242 | procedure openListItem(out_: TStringBuilder); virtual;
243 | procedure closeListItem(out_: TStringBuilder); virtual;
244 |
245 | procedure checkedItem(out_: TStringBuilder); virtual;
246 | procedure uncheckedItem(out_: TStringBuilder); virtual;
247 |
248 | procedure horizontalRuler(out_: TStringBuilder); virtual;
249 |
250 | procedure openLink(out_: TStringBuilder); virtual;
251 | procedure closeLink(out_: TStringBuilder); virtual;
252 |
253 | procedure openImage(out_: TStringBuilder); virtual;
254 | procedure closeImage(out_: TStringBuilder); virtual;
255 |
256 | end;
257 |
258 | TSpanEmitter = class
259 | public
260 | procedure emitSpan(out_: TStringBuilder; content: String); virtual; abstract;
261 | end;
262 |
263 | TBlockEmitter = class
264 | public
265 | procedure emitBlock(out_: TStringBuilder; lines: TStringList; meta: String); virtual; abstract;
266 | end;
267 |
268 | { TConfiguration }
269 |
270 | TConfiguration = class
271 | private
272 | Fdecorator: TDecorator;
273 | FDialect: TMarkdownProcessorDialect;
274 | FsafeMode: boolean;
275 | FallowSpacesInFencedDelimiters: boolean;
276 | FcodeBlockEmitter: TBlockEmitter;
277 | FpanicMode: boolean;
278 | FspecialLinkEmitter: TSpanEmitter;
279 | procedure SetDialect(AValue: TMarkdownProcessorDialect);
280 | public
281 | Constructor Create(safe : boolean);
282 | Destructor Destroy; override;
283 | function isDialect(Dialects:TSeTMarkdownProcessorDialect):boolean;
284 | property Dialect:TMarkdownProcessorDialect read FDialect write SetDialect;
285 | property safeMode: boolean read FsafeMode write FsafeMode;
286 | property panicMode: boolean read FpanicMode write FpanicMode;
287 | property decorator: TDecorator read Fdecorator write Fdecorator;
288 | property codeBlockEmitter: TBlockEmitter read FcodeBlockEmitter write FcodeBlockEmitter;
289 | property allowSpacesInFencedDelimiters: boolean read FallowSpacesInFencedDelimiters write FallowSpacesInFencedDelimiters;
290 | property specialLinkEmitter: TSpanEmitter read FspecialLinkEmitter write FspecialLinkEmitter;
291 | end;
292 |
293 | TLineType = (
294 | // Empty line. */
295 | ltEMPTY,
296 | // Undefined content. */
297 | ltOTHER,
298 | // A markdown headline. */
299 | ltHEADLINE, ltHEADLINE1, ltHEADLINE2,
300 | // A code block line. */
301 | ltCODE,
302 | // A list. */
303 | ltULIST, //Unordered
304 | ltOLIST, //Ordered with dot
305 | ltBLIST, //Ordered with brackets
306 | // A block quote. */
307 | ltBQUOTE,
308 | // A horizontal ruler. */
309 | ltHR,
310 | // Start of a XML block. */
311 | ltXML,
312 | // Fenced code block start/end */
313 | ltFENCED_CODE,
314 | // Start of Table
315 | ltTABLE
316 | );
317 |
318 | TLine = class
319 | private
320 | FXmlEndLine: TLine;
321 | FPrevEmpty: boolean;
322 | FPrevious: TLine;
323 | FPosition: integer;
324 | FValue: string;
325 | FIsEmpty: boolean;
326 | FTrailing: integer;
327 | FNextEmpty: boolean;
328 | FLeading: integer;
329 | FNext: TLine;
330 | function countChars(ch: char): integer;
331 | function countCharsStart(ch: char; allowSpaces: boolean): integer;
332 | function readXMLComment(firstLine: TLine; start: integer): integer;
333 | function checkHTML(): boolean;
334 | public
335 | Constructor Create;
336 | Destructor Destroy; Override;
337 | // Current cursor position.
338 | property position: integer read FPosition write FPosition;
339 | // Leading and trailing spaces.
340 | property leading: integer read FLeading write FLeading;
341 | property trailing: integer read FTrailing write FTrailing;
342 | // Is this line empty?
343 | property isEmpty: boolean read FIsEmpty write FIsEmpty;
344 | // This line's value.
345 | property value: string read FValue write FValue;
346 | // Previous and next line.
347 | property previous: TLine read FPrevious write FPrevious;
348 | property next: TLine read FNext write FNext;
349 | // Is previous/next line empty?
350 | property prevEmpty: boolean read FPrevEmpty write FPrevEmpty;
351 | property nextEmpty: boolean read FNextEmpty write FNextEmpty;
352 | // Final line of a XML block.
353 | property xmlEndLine: TLine read FXmlEndLine write FXmlEndLine;
354 | procedure Init;
355 | procedure InitLeading;
356 | function skipSpaces: boolean;
357 | function readUntil(chend: TSysCharSet): String;
358 | procedure setEmpty;
359 | function getLineType(config: TConfiguration): TLineType;
360 | function stripID: String;
361 |
362 | end;
363 |
364 | TLinkRef = class
365 | private
366 | FLink: String;
367 | FTitle: String;
368 | FIsAbbrev: boolean;
369 | public
370 | Constructor Create(link, title: String; isAbbrev: boolean);
371 | property link: String read FLink write FLink;
372 | property title: String read FTitle write FTitle;
373 | property isAbbrev: boolean read FIsAbbrev write FIsAbbrev;
374 | end;
375 |
376 | TBlockType = (
377 | // Unspecified. Used for root block and list items without paragraphs.
378 | btNONE,
379 | // A block quote.
380 | btBLOCKQUOTE,
381 | // A code block.
382 | btCODE,
383 | // A fenced code block.
384 | btFENCED_CODE,
385 | // A headline.
386 | btHEADLINE,
387 | // A list item.
388 | btLIST_ITEM,
389 | // An ordered list
390 | btORDERED_LIST,
391 | // A paragraph.
392 | btPARAGRAPH,
393 | // A horizontal ruler.
394 | btRULER,
395 | // An unordered list.
396 | btUNORDERED_LIST,
397 | // A XML block.
398 | btXML,
399 | // A table elements block.
400 | btTABLE
401 | );
402 |
403 | TBlock = class
404 | private
405 | FType: TBlockType;
406 | FId: String;
407 | FBlocks: TBlock;
408 | FBlockTail: TBlock;
409 | FLines: TLine;
410 | FLineTail: TLine;
411 | FHlDepth: integer;
412 | FNext: TBlock;
413 | FMeta: String;
414 |
415 | public
416 | procedure AppendLine(line: TLine);
417 | function split(line: TLine): TBlock;
418 | procedure removeListIndent(config: TConfiguration);
419 | function removeLeadingEmptyLines: boolean;
420 | procedure removeTrailingEmptyLines;
421 | procedure transfromHeadline;
422 | procedure expandListParagraphs;
423 | function hasLines: boolean;
424 | procedure removeSurroundingEmptyLines;
425 | procedure removeBlockQuotePrefix;
426 | procedure removeLine(line: TLine);
427 | Constructor Create;
428 | Destructor Destroy; Override;
429 | // This block's type.
430 | property type_: TBlockType read FType write FType;
431 | property lines: TLine read FLines;
432 | property lineTail: TLine read FLineTail;
433 | // child blocks.
434 | property blocks: TBlock read FBlocks;
435 | property blockTail: TBlock read FBlockTail;
436 | // Next block.
437 | property next: TBlock read FNext write FNext;
438 | // Depth of headline BlockType.
439 | property hlDepth: integer read FHlDepth write FHlDepth;
440 | // ID for headlines and list items
441 | property id: String read FId write FId;
442 | // Block meta information
443 | property meta: String read FMeta write FMeta;
444 | end;
445 |
446 | TMarkToken = (
447 | // No token.
448 | mtNONE,
449 | // *
450 | mtEM_STAR, // x*x
451 | // _
452 | mtEM_UNDERSCORE, // x_x
453 | // ~
454 | mtSUB_TILDE, // x~x
455 | // **
456 | mtSTRONG_STAR, // x**x
457 | // __
458 | mtSTRONG_UNDERSCORE, // x__x
459 | // ~~
460 | mtSTRIKE_TILDE, // x~~x
461 | // ++
462 | mtINS_PLUS, // x++x
463 | // ==
464 | mtMARK_EQ, // x==x
465 | // $
466 | mtMATH_DOLLAR, // $
467 | // `
468 | mtCODE_SINGLE, // `
469 | // ``
470 | mtCODE_DOUBLE, // ``
471 | // [
472 | mtLINK, // [
473 | // <
474 | mtHTML, // <
475 | // ![
476 | mtIMAGE, // ![
477 | // &
478 | mtENTITY, // &
479 | // \
480 | mtESCAPE, // \x
481 | // Extended: ^
482 | mtSUPER, // ^
483 | // Extended: (C)
484 | mtX_COPY, // (C)
485 | // Extended: (R)
486 | mtX_REG, // (R)
487 | // Extended: (TM)
488 | mtX_TRADE, // (TM)
489 | // Extended: <<
490 | mtX_LAQUO, // <<
491 | // Extended: >>
492 | mtX_RAQUO, // >>
493 | // Extended: --
494 | mtX_NDASH, // --
495 | // Extended: ---
496 | mtX_MDASH, // ---
497 | // Extended: ...
498 | mtX_HELLIP, // ...
499 | // Extended: "x
500 | mtX_RDQUO, // "
501 | // Extended: x"
502 | mtX_LDQUO, // "
503 | // [[
504 | mtX_LINK_OPEN, // [[
505 | // ]]
506 | mtX_LINK_CLOSE // ]]
507 | );
508 |
509 | // Emitter class responsible for generating HTML output.
510 |
511 | { TEmitter }
512 |
513 | TEmitter = class
514 | private
515 | linkRefs: TStringList;
516 | FConfig: TConfiguration;
517 | public
518 | Constructor Create(config: TConfiguration);
519 | Destructor Destroy; override;
520 | procedure emitCodeLines(out_: TStringBuilder; lines: TLine; meta: String; removeIndent: boolean);
521 | procedure emitRawLines(out_: TStringBuilder; lines: TLine);
522 | procedure emitMarkedLines(out_: TStringBuilder; lines: TLine);
523 | function findToken(s: String; start: integer; token: TMarkToken): integer;
524 | function getToken(s: String; position: integer): TMarkToken;
525 | function checkLink(out_: TStringBuilder; s: String; start: integer; token: TMarkToken): integer;
526 | function recursiveEmitLine(out_: TStringBuilder; s: String; start: integer; token: TMarkToken): integer;
527 | function checkHTML(out_: TStringBuilder; s: String; start: integer): integer;
528 | class function checkEntity(out_: TStringBuilder; s: String; start: integer): integer;
529 | class function whitespaceToSpace(c: char): char;
530 | procedure addLinkRef(key: String; linkRef: TLinkRef);
531 | procedure emit(out_: TStringBuilder; root: TBlock);
532 | procedure emitLines(out_: TStringBuilder; block: TBlock);
533 | end;
534 |
535 | Function StringsContains(Const aNames: Array Of String; Const sName: String): boolean;
536 | function StringToEnum(ATypeInfo: PTypeInfo; const AStr: String; defValue: integer): integer;
537 |
538 | implementation
539 |
540 | uses MarkdownTables, MarkdownMathCode;
541 |
542 | Function StringsContains(Const aNames: Array Of String; Const sName: String): boolean;
543 | var
544 | i: integer;
545 | Begin
546 | for i := 0 to length(aNames) - 1 do
547 | if sName = aNames[i] then
548 | exit(true);
549 | result := false;
550 | End;
551 |
552 | function StringToEnum(ATypeInfo: PTypeInfo; const AStr: String; defValue: integer): integer;
553 | var
554 | LTypeData: PTypeData;
555 | LPChar: PAnsiChar;
556 | LValue: ShortString;
557 | begin
558 | LValue := ShortString(AStr);
559 |
560 | if ATypeInfo^.Kind = tkEnumeration then
561 | begin
562 | LTypeData := GetTypeData(ATypeInfo);
563 | if LTypeData^.MinValue <> 0 then
564 | exit(defValue);
565 | LPChar := @LTypeData^.NameList[0];
566 | result := 0;
567 | while (result <= LTypeData^.MaxValue) and (ShortString(pointer(LPChar)^) <> LValue) do
568 | begin
569 | inc(LPChar, ord(LPChar^) + 1); // move to next string
570 | inc(result);
571 | end;
572 | if result > LTypeData^.MaxValue then
573 | exit(defValue);
574 | end
575 | else
576 | exit(defValue);
577 | end;
578 |
579 | { TLine }
580 |
581 | constructor TLine.Create;
582 | begin
583 | inherited;
584 | FIsEmpty := true;
585 | end;
586 |
587 | destructor TLine.Destroy;
588 | begin
589 | FNext.Free;
590 | inherited;
591 | end;
592 |
593 | { TConfiguration }
594 |
595 | procedure TConfiguration.SetDialect(AValue: TMarkdownProcessorDialect);
596 | begin
597 | if FDialect=AValue then Exit;
598 | FDialect:=AValue;
599 | end;
600 |
601 | constructor TConfiguration.Create(safe : boolean);
602 | begin
603 | inherited Create;
604 | FallowSpacesInFencedDelimiters := true;
605 | Fdecorator := TDecorator.Create;
606 | FsafeMode := safe;
607 | end;
608 |
609 | destructor TConfiguration.Destroy;
610 | begin
611 | FcodeBlockEmitter.Free;
612 | Fdecorator.Free;
613 | FspecialLinkEmitter.Free;
614 | inherited;
615 | end;
616 |
617 | function TConfiguration.isDialect(Dialects: TSeTMarkdownProcessorDialect): boolean;
618 | var
619 | i: TMarkdownProcessorDialect;
620 | Begin
621 | for i in Dialects do
622 | if Dialect = i then
623 | exit(true);
624 | result := false;
625 | end;
626 |
627 | { TDecorator }
628 |
629 | procedure TDecorator.openParagraph(out_: TStringBuilder);
630 | begin
631 | out_.append('');
632 | end;
633 |
634 | procedure TDecorator.closeParagraph(out_: TStringBuilder);
635 | begin
636 | out_.append('
'#10);
637 | end;
638 |
639 | procedure TDecorator.openBlockQuote(out_: TStringBuilder);
640 | begin
641 | out_.append('');
642 | end;
643 |
644 | procedure TDecorator.closeBlockQuote(out_: TStringBuilder);
645 | begin
646 | out_.append('
'#10);
647 | end;
648 |
649 | procedure TDecorator.openCodeBlock(out_: TStringBuilder);
650 | begin
651 | out_.append('');
652 | end;
653 |
654 | procedure TDecorator.openFencedCodeBlock(out_: TStringBuilder;
655 | classlabel: string);
656 | begin
657 | out_.append('');
658 | end;
659 |
660 | procedure TDecorator.closeCodeBlock(out_: TStringBuilder);
661 | begin
662 | out_.append('
'#10);
663 | end;
664 |
665 | procedure TDecorator.openCodeSpan(out_: TStringBuilder);
666 | begin
667 | out_.append('');
668 | end;
669 |
670 | procedure TDecorator.closeCodeSpan(out_: TStringBuilder);
671 | begin
672 | out_.append('');
673 | end;
674 |
675 | procedure TDecorator.openHeadline(out_: TStringBuilder; level: integer);
676 | begin
677 | out_.append(''#10);
686 | end;
687 |
688 | procedure TDecorator.openStrong(out_: TStringBuilder);
689 | begin
690 | out_.append('');
691 | end;
692 |
693 | procedure TDecorator.closeStrong(out_: TStringBuilder);
694 | begin
695 | out_.append('');
696 | end;
697 |
698 | procedure TDecorator.openEmphasis(out_: TStringBuilder);
699 | begin
700 | out_.append('');
701 | end;
702 |
703 | procedure TDecorator.closeEmphasis(out_: TStringBuilder);
704 | begin
705 | out_.append('');
706 | end;
707 |
708 | procedure TDecorator.openStrike(out_: TStringBuilder);
709 | begin
710 | out_.append('');
711 | end;
712 |
713 | procedure TDecorator.closeStrike(out_: TStringBuilder);
714 | begin
715 | out_.append('');
716 | end;
717 |
718 | procedure TDecorator.openIns(out_: TStringBuilder);
719 | begin
720 | out_.append('');
721 | end;
722 |
723 | procedure TDecorator.closeIns(out_: TStringBuilder);
724 | begin
725 | out_.append('');
726 | end;
727 |
728 | procedure TDecorator.openMark(out_: TStringBuilder);
729 | begin
730 | out_.append('');
731 | end;
732 |
733 | procedure TDecorator.closeMark(out_: TStringBuilder);
734 | begin
735 | out_.append('');
736 | end;
737 |
738 | procedure TDecorator.openSuper(out_: TStringBuilder);
739 | begin
740 | out_.append('');
741 | end;
742 |
743 | procedure TDecorator.closeSuper(out_: TStringBuilder);
744 | begin
745 | out_.append('');
746 | end;
747 |
748 | procedure TDecorator.openSub(out_: TStringBuilder);
749 | begin
750 | out_.append('');
751 | end;
752 |
753 | procedure TDecorator.closeSub(out_: TStringBuilder);
754 | begin
755 | out_.append('');
756 | end;
757 |
758 | procedure TDecorator.openOrderedList(out_: TStringBuilder);
759 | begin
760 | out_.append(''#10);
761 | end;
762 |
763 | procedure TDecorator.closeOrderedList(out_: TStringBuilder);
764 | begin
765 | out_.append('
'#10);
766 | end;
767 |
768 | procedure TDecorator.openUnOrderedList(out_: TStringBuilder);
769 | begin
770 | out_.append(''#10);
771 | end;
772 |
773 | procedure TDecorator.closeUnOrderedList(out_: TStringBuilder);
774 | begin
775 | out_.append('
'#10);
776 | end;
777 |
778 | procedure TDecorator.openListItem(out_: TStringBuilder);
779 | begin
780 | out_.append(''#10);
786 | end;
787 |
788 | procedure TDecorator.checkedItem(out_: TStringBuilder);
789 | begin
790 | out_.append('');
791 | end;
792 |
793 | procedure TDecorator.uncheckedItem(out_: TStringBuilder);
794 | begin
795 | out_.append('');
796 | end;
797 |
798 | procedure TDecorator.horizontalRuler(out_: TStringBuilder);
799 | begin
800 | out_.append('
'#10);
801 | end;
802 |
803 | procedure TDecorator.openLink(out_: TStringBuilder);
804 | begin
805 | out_.append('');
811 | end;
812 |
813 | procedure TDecorator.openImage(out_: TStringBuilder);
814 | begin
815 | out_.append('
');
1683 | end;
1684 | if (line.next <> nil) then
1685 | s.append(#10);
1686 | line := line.next;
1687 | end;
1688 | recursiveEmitLine(out_, s.ToString(), 0, mtNONE);
1689 | finally
1690 | s.Free;
1691 | end;
1692 | end;
1693 |
1694 | procedure TEmitter.emitRawLines(out_: TStringBuilder; lines: TLine);
1695 | var
1696 | s: String;
1697 | line: TLine;
1698 | temp: TStringBuilder;
1699 | position, t: integer;
1700 | begin
1701 | line := lines;
1702 | if (FConfig.safeMode) then
1703 | begin
1704 | temp := TStringBuilder.Create();
1705 | try
1706 | while (line <> nil) do
1707 | begin
1708 | if (not line.isEmpty) then
1709 | temp.append(line.value);
1710 | temp.append(#10);
1711 | line := line.next;
1712 | end;
1713 | s := temp.ToString();
1714 | position := 0;
1715 | while position < length(s) do
1716 | begin
1717 | if (s[1 + position] = '<') then
1718 | begin
1719 | temp.Clear;
1720 | t := TUtils.readXML(temp, s, position, FConfig.safeMode);
1721 | if (t <> -1) then
1722 | begin
1723 | out_.append(temp);
1724 | position := t;
1725 | end
1726 | else
1727 | out_.append(s[1 + position]);
1728 | end
1729 | else
1730 | out_.append(s[1 + position]);
1731 | inc(position);
1732 | end
1733 | finally
1734 | temp.Free;
1735 | end;
1736 | end
1737 | else
1738 | begin
1739 | while (line <> nil) do
1740 | begin
1741 | if (not line.isEmpty) then
1742 | out_.append(line.value);
1743 | out_.append(#10);
1744 | line := line.next;
1745 | end;
1746 | end;
1747 | end;
1748 |
1749 | procedure TEmitter.emitCodeLines(out_: TStringBuilder; lines: TLine; meta: String; removeIndent: boolean);
1750 | var
1751 | line: TLine;
1752 | list: TStringList;
1753 | i, sp: integer;
1754 | c: char;
1755 | begin
1756 | line := lines;
1757 | if (FConfig.codeBlockEmitter <> nil) then
1758 | begin
1759 | list := TStringList.Create;
1760 | try
1761 | while (line <> nil) do
1762 | begin
1763 | if (line.isEmpty) then
1764 | list.add('')
1765 | else if removeIndent then
1766 | // list.add(line.value.substring(4)) P{STfix
1767 | list.Add( Copy(line.value, 5))
1768 | else
1769 | list.add(line.value);
1770 | line := line.next;
1771 | end;
1772 | FConfig.codeBlockEmitter.emitBlock(out_, list, meta);
1773 | finally
1774 | list.Free
1775 | end
1776 | end
1777 | else
1778 | begin
1779 | while (line <> nil) do
1780 | begin
1781 | if (not line.isEmpty) then
1782 | begin
1783 | if removeIndent then
1784 | sp := 4
1785 | else
1786 | sp := 0;
1787 | for i := sp to Length(line.value) - 1 do
1788 | begin
1789 | c := line.value[1 + i];
1790 | case c of
1791 | '&':
1792 | out_.append('&');
1793 | '<':
1794 | out_.append('<');
1795 | '>':
1796 | out_.append('>');
1797 | else
1798 | out_.append(c);
1799 | end;
1800 | end;
1801 | end;
1802 | out_.append(#10);
1803 | line := line.next;
1804 | end;
1805 | end;
1806 | end;
1807 |
1808 | { TMarkdownReader }
1809 |
1810 | constructor TMarkdownReader.Create(source: String);
1811 | begin
1812 | inherited Create;
1813 | FValue := source;
1814 | FCursor := 0;
1815 | end;
1816 |
1817 | function TMarkdownReader.read: char;
1818 | begin
1819 | inc(FCursor);
1820 | if FCursor > Length(FValue) then
1821 | result := #0
1822 | else
1823 | result := FValue[FCursor];
1824 | end;
1825 |
1826 | { TUtils }
1827 |
1828 | class function TUtils.skipSpaces(s: String; start: integer): integer;
1829 | var
1830 | position: integer;
1831 | begin
1832 | position := start;
1833 | while (position < Length(s)) and ((s[1 + position] = ' ') or (s[1 + position] = #10)) do
1834 | inc(position);
1835 | if position < Length(s) then
1836 | result := position
1837 | else
1838 | result := -1;
1839 | end;
1840 |
1841 | class function TUtils.escape(out_: TStringBuilder; ch: char; position: integer): integer;
1842 | begin
1843 | if CharInSet(ch, ['\', '[', ']', '(', ')', '{', '}', '#', '"', '''', '.', '>', '<', '*', '+', '-', '_', '!', '`', '^']) then
1844 | begin
1845 | out_.append(ch);
1846 | result := position + 1;
1847 | end
1848 | else
1849 | begin
1850 | out_.append('\');
1851 | result := position;
1852 | end;
1853 | end;
1854 |
1855 | class function TUtils.readUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer;
1856 | var
1857 | position: integer;
1858 | ch: char;
1859 | begin
1860 | position := start;
1861 | while (position < Length(s)) do
1862 | begin
1863 | ch := s[1 + position];
1864 | if (ch = '\') and (position + 1 < Length(s)) then
1865 | position := escape(out_, s[1 + position + 1], position)
1866 | else
1867 | begin
1868 | if CharInSet(ch, cend) then
1869 | break
1870 | else
1871 | out_.append(ch);
1872 | end;
1873 | inc(position);
1874 | end;
1875 | if position = Length(s) then
1876 | result := -1
1877 | else
1878 | result := position;
1879 | end;
1880 |
1881 | class function TUtils.readUntil(out_: TStringBuilder; s: String; start: integer; cend: char): integer;
1882 | var
1883 | position: integer;
1884 | ch: char;
1885 | begin
1886 | position := start;
1887 | while (position < Length(s)) do
1888 | begin
1889 | ch := s[1 + position];
1890 | if (ch = '\') and (position + 1 < Length(s)) then
1891 | position := escape(out_, s[1 + position + 1], position)
1892 | else
1893 | begin
1894 | if (ch = cend) then
1895 | break;
1896 | out_.append(ch);
1897 | end;
1898 | inc(position);
1899 | end;
1900 | if position = Length(s) then
1901 | result := -1
1902 | else
1903 | result := position;
1904 | end;
1905 |
1906 | class function TUtils.readMdLink(out_: TStringBuilder; s: String; start: integer): integer;
1907 | var
1908 | position, counter: integer;
1909 | ch: char;
1910 | endReached: boolean;
1911 | begin
1912 | position := start;
1913 | counter := 1;
1914 | while (position < Length(s)) do
1915 | begin
1916 | ch := s[1 + position];
1917 | if (ch = '\') and (position + 1 < Length(s)) then
1918 | position := escape(out_, s[1 + position + 1], position)
1919 | else
1920 | begin
1921 | endReached := false;
1922 | case ch of
1923 | '(':
1924 | inc(counter);
1925 | ' ':
1926 | if (counter = 1) then
1927 | endReached := true;
1928 | ')':
1929 | begin
1930 | dec(counter);
1931 | if (counter = 0) then
1932 | endReached := true;
1933 | end;
1934 | end;
1935 | if (endReached) then
1936 | break;
1937 | out_.append(ch);
1938 | end;
1939 | inc(position);
1940 | end;
1941 | if position = Length(s) then
1942 | result := -1
1943 | else
1944 | result := position;
1945 | end;
1946 |
1947 | class function TUtils.readMdLinkId(out_: TStringBuilder; s: String; start: integer): integer;
1948 | var
1949 | position, counter: integer;
1950 | ch: char;
1951 | endReached: boolean;
1952 | begin
1953 | position := start;
1954 | counter := 1;
1955 | while (position < Length(s)) do
1956 | begin
1957 | ch := s[1 + position];
1958 | endReached := false;
1959 | case ch of
1960 | #10:
1961 | out_.append(' ');
1962 | '[':
1963 | begin
1964 | inc(counter);
1965 | out_.append(ch);
1966 | end;
1967 | ']':
1968 | begin
1969 | dec(counter);
1970 | if (counter = 0) then
1971 | endReached := true
1972 | else
1973 | out_.append(ch);
1974 | end;
1975 | else
1976 | out_.append(ch);
1977 | end;
1978 | if (endReached) then
1979 | break;
1980 | inc(position);
1981 | end;
1982 | if position = Length(s) then
1983 | result := -1
1984 | else
1985 | result := position;
1986 | end;
1987 |
1988 | class function TUtils.readRawUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer;
1989 | var
1990 | position: integer;
1991 | ch: char;
1992 | begin
1993 | position := start;
1994 | while (position < Length(s)) do
1995 | begin
1996 | ch := s[1 + position];
1997 | if CharInSet(ch, cend) then
1998 | break;
1999 | out_.append(ch);
2000 | inc(position);
2001 | end;
2002 | if position = Length(s) then
2003 | result := -1
2004 | else
2005 | result := position;
2006 | end;
2007 |
2008 | class function TUtils.readRawUntil(out_: TStringBuilder; s: String; start: integer; cend: char): integer;
2009 | var
2010 | position: integer;
2011 | ch: char;
2012 | begin
2013 | position := start;
2014 | while (position < Length(s)) do
2015 | begin
2016 | ch := s[1 + position];
2017 | if (ch = cend) then
2018 | break;
2019 | out_.append(ch);
2020 | inc(position);
2021 | end;
2022 | if position = Length(s) then
2023 | result := -1
2024 | else
2025 | result := position;
2026 | end;
2027 |
2028 | class function TUtils.readXMLUntil(out_: TStringBuilder; s: String; start: integer; cend: TSysCharSet): integer;
2029 | var
2030 | position : integer;
2031 | ch, stringChar: char;
2032 | inString: boolean;
2033 | begin
2034 | position := start;
2035 | inString := false;
2036 | stringChar := #0;
2037 | while (position < Length(s)) do
2038 | begin
2039 | ch := s[1 + position];
2040 | if (inString) then
2041 | begin
2042 | if (ch = '\') then
2043 | begin
2044 | out_.append(ch);
2045 | inc(position);
2046 | if (position < Length(s)) then
2047 | begin
2048 | out_.append(ch);
2049 | inc(position);
2050 | end;
2051 | continue;
2052 | end;
2053 | if (ch = stringChar) then
2054 | begin
2055 | inString := false;
2056 | out_.append(ch);
2057 | inc(position);
2058 | continue;
2059 | end;
2060 | end;
2061 | if CharInSet(ch, ['"', '''']) then
2062 | begin
2063 | inString := true;
2064 | stringChar := ch;
2065 | end;
2066 | if (not inString) then
2067 | begin
2068 | if CharInSet(ch, cend) then
2069 | break;
2070 | end;
2071 | out_.append(ch);
2072 | inc(position);
2073 | end;
2074 | if position = Length(s) then
2075 | result := -1
2076 | else
2077 | result := position;
2078 | end;
2079 |
2080 | class procedure TUtils.appendCode(out_: TStringBuilder; s: String; start: integer; e: integer);
2081 | var
2082 | i: integer;
2083 | c: char;
2084 | begin
2085 | for i := start to e - 1 do
2086 | begin
2087 | c := s[1 + i];
2088 | case c of
2089 | '&':
2090 | out_.append('&');
2091 | '<':
2092 | out_.append('<');
2093 | '>':
2094 | out_.append('>');
2095 | else
2096 | out_.append(c);
2097 | end;
2098 | end;
2099 | end;
2100 |
2101 | class procedure TUtils.appendValue(out_: TStringBuilder; s: String; start: integer; e: integer);
2102 | var
2103 | i: integer;
2104 | c: char;
2105 | begin
2106 | for i := start to e - 1 do
2107 | begin
2108 | c := s[1 + i];
2109 | case c of
2110 | '&':
2111 | out_.append('&');
2112 | '<':
2113 | out_.append('<');
2114 | '>':
2115 | out_.append('>');
2116 | '"':
2117 | out_.append('"');
2118 | '''':
2119 | out_.append(''');
2120 | else
2121 | out_.append(c);
2122 | end;
2123 | end;
2124 | end;
2125 |
2126 | class procedure TUtils.appendDecEntity(out_: TStringBuilder; value: char);
2127 | begin
2128 | out_.append('&#');
2129 | out_.append(IntToStr(ord(value)));
2130 | out_.append(';');
2131 | end;
2132 |
2133 | class procedure TUtils.appendHexEntity(out_: TStringBuilder; value: char);
2134 | begin
2135 | out_.append('&#x');
2136 | out_.append(IntToHex(ord(value), 2));
2137 | out_.append(';');
2138 | end;
2139 |
2140 | class procedure TUtils.appendMailto(out_: TStringBuilder; s: String; start: integer; e: integer);
2141 | var
2142 | i: integer;
2143 | c: char;
2144 | begin
2145 | for i := start to e - 1 do
2146 | begin
2147 | c := s[1 + i];
2148 | if CharInSet(c, ['a'..'z','A'..'Z','0'..'9','&', '<', '>', '"', '''', '@']) then
2149 | if random(2)=0 then appendHexEntity(out_, c) else appendDecEntity(out_, c)
2150 | else
2151 | out_.append(c);
2152 | end;
2153 | end;
2154 |
2155 | class procedure TUtils.getXMLTag(out_: TStringBuilder; bin: TStringBuilder);
2156 | var
2157 | position: integer;
2158 | begin
2159 | position := 1;
2160 | if (bin[1] = '/') then
2161 | inc(position);
2162 | while (bin[position].isLetterOrDigit) do
2163 | begin
2164 | out_.append(bin[position]);
2165 | inc(position)
2166 | end;
2167 | end;
2168 |
2169 | class procedure TUtils.getXMLTag(out_: TStringBuilder; s: String);
2170 | var
2171 | position: integer;
2172 | begin
2173 | position := 1;
2174 | if (s[1 + 1] = '/') then
2175 | inc(position);
2176 | while (s[1 + position].isLetterOrDigit) do
2177 | begin
2178 | out_.append(s[1 + position]);
2179 | inc(position)
2180 | end;
2181 | end;
2182 |
2183 | class function TUtils.readXML(out_: TStringBuilder; s: String; start: integer; safeMode: boolean): integer;
2184 | var
2185 | position: integer;
2186 | isCloseTag: boolean;
2187 | temp: TStringBuilder;
2188 | tag: String;
2189 | begin
2190 | if (length(s)<1 + start +1 ) then exit(-1);
2191 | if (s[1 + start + 1] = '/') then
2192 | begin
2193 | isCloseTag := true;
2194 | position := start + 2;
2195 | end
2196 | else if (s[1 + start + 1] = '!') then
2197 | begin
2198 | out_.append('']);
2212 | if (position = -1) then
2213 | exit(-1);
2214 | // tag := temp.ToString().trim().ToLower; PSTFix
2215 | tag := LowerCase( Trim( temp.ToString));
2216 | if (THTML.isUnsafeHtmlElement(tag)) then
2217 | out_.append('<')
2218 | else
2219 | out_.append('<');
2220 | if (isCloseTag) then
2221 | out_.append('/');
2222 | out_.append(temp);
2223 | finally
2224 | temp.Free;
2225 | end;
2226 | end
2227 | else
2228 | begin
2229 | out_.append('<');
2230 | if (isCloseTag) then
2231 | out_.append('/');
2232 | position := readXMLUntil(out_, s, position, [' ', '/', '>']);
2233 | end;
2234 | if (position = -1) then
2235 | exit(-1);
2236 | position := readXMLUntil(out_, s, position, ['/', '>']);
2237 | if (position = -1) then
2238 | exit(-1);
2239 |
2240 | if (s[1 + position] = '/') then
2241 | begin
2242 | out_.append(' /');
2243 | position := readXMLUntil(out_, s, position + 1, ['>']);
2244 | if (position = -1) then
2245 | exit(-1);
2246 | end;
2247 |
2248 | if (s[1 + position] = '>') then
2249 | begin
2250 | out_.append('>');
2251 | exit(position);
2252 | end;
2253 | result := -1;
2254 | end;
2255 |
2256 | class procedure TUtils.codeEncode(out_: TStringBuilder; value: String; offset: integer);
2257 | var
2258 | i: integer;
2259 | c: char;
2260 | begin
2261 | for i := offset to Length(value) - 1 do
2262 | begin
2263 | c := value[1 + i];
2264 | case c of
2265 | '&':
2266 | out_.append('&');
2267 | '<':
2268 | out_.append('<');
2269 | '>':
2270 | out_.append('>');
2271 | '+':
2272 | out_.append('%2b');
2273 | else
2274 | out_.append(c);
2275 | end;
2276 | end;
2277 | end;
2278 |
2279 | class function TUtils.getMetaFromFence(fenceLine: String): String;
2280 | var
2281 | i: integer;
2282 | c: char;
2283 | begin
2284 | for i := 0 to Length(fenceLine) - 1 do
2285 | begin
2286 | c := fenceLine[1 + i];
2287 | if (not c.isWhitespace) and (c <> '`') and (c <> '~') then
2288 | // exit(fenceLine.substring(i).trim()); PSTfix
2289 | Exit( Trim( Copy(fenceLine, i+1)));
2290 | end;
2291 | result := '';
2292 | end;
2293 |
2294 | class function TUtils.encodeURL(url: String): String;
2295 | var
2296 | x: integer;
2297 | sBuff: string;
2298 | const
2299 | SafeMask = ['A'..'Z', '0'..'9', 'a'..'z', '*', '@', '.', '_', '-'];
2300 | begin
2301 | sBuff := '';
2302 | for x := 1 to Length(url) do
2303 | begin
2304 | if CharInSet(url[x], SafeMask) then
2305 | begin
2306 | sBuff := sBuff + url[x];
2307 | end
2308 | else if url[x] = ' ' then
2309 | begin
2310 | sBuff := sBuff + '+'; //Append space
2311 | end
2312 | else
2313 | begin
2314 | sBuff := sBuff + '%' + IntToHex(Ord(url[x]),2);
2315 | end;
2316 | end;
2317 | Result := sBuff;
2318 | end;
2319 |
2320 | { THTML }
2321 |
2322 | class function THTML.isHtmlBlockElement(s: String): boolean;
2323 | var
2324 | ht: THTMLElement;
2325 | begin
2326 | ht := THTMLElement(StringToEnum(TypeInfo(THTMLElement), 'he' + s, ord(heNONE)));
2327 | result := ht in BLOCK_ELEMENTS;
2328 | end;
2329 |
2330 | class function THTML.isLinkPrefix(s: String): boolean;
2331 | begin
2332 | result := StringsContains(LINK_PREFIXES, s);
2333 | end;
2334 |
2335 | class function THTML.isEntity(s: String): boolean;
2336 | begin
2337 | result := StringsContains(ENTITY_NAMES, s);
2338 | end;
2339 |
2340 | class function THTML.isUnsafeHtmlElement(s: String): boolean;
2341 | var
2342 | ht: THTMLElement;
2343 | begin
2344 | ht := THTMLElement(StringToEnum(TypeInfo(THTMLElement), s, ord(heNONE)));
2345 | result := ht in UNSAFE_ELEMENTS;
2346 | end;
2347 |
2348 | { TLine }
2349 |
2350 | procedure TLine.Init();
2351 | begin
2352 | FLeading := 0;
2353 | while (leading < Length(value)) and (value[1 + leading] = ' ') do
2354 | inc(FLeading);
2355 |
2356 | if (leading = Length(value)) then
2357 | setEmpty()
2358 | else
2359 | begin
2360 | isEmpty := false;
2361 | trailing := 0;
2362 | while (value[1 + Length(value) - trailing - 1] = ' ') do
2363 | inc(FTrailing);
2364 | end;
2365 | end;
2366 |
2367 | procedure TLine.InitLeading();
2368 | begin
2369 | FLeading := 0;
2370 | while (leading < Length(value)) and (value[1 + leading] = ' ') do
2371 | inc(FLeading);
2372 | if (leading = Length(value)) then
2373 | setEmpty();
2374 | end;
2375 |
2376 | // TODO use Util#skipSpaces
2377 | function TLine.skipSpaces(): boolean;
2378 | begin
2379 | while (position < Length(value)) and (value[1 + position] = ' ') do
2380 | inc(FPosition);
2381 | result := position < Length(value);
2382 | end;
2383 |
2384 | // TODO use Util#readUntil
2385 | function TLine.readUntil(chend: TSysCharSet): String;
2386 | var
2387 | sb: TStringBuilder;
2388 | p: integer;
2389 | ch, c: char;
2390 | begin
2391 | sb := TStringBuilder.Create();
2392 | try
2393 | p := self.position;
2394 | while (p < Length(value)) do
2395 | begin
2396 | ch := value[1 + p];
2397 | if (ch = '\') and (p + 1 < Length(value)) then
2398 | begin
2399 | c := value[1 + p + 1];
2400 | if CharInSet(c, ['\', '[', ']', '(', ')', '{', '}', '#', '"', '''', '.', '>', '*', '+', '-', '_', '!', '`', '~']) then
2401 | begin
2402 | sb.append(c);
2403 | inc(FPosition);
2404 | end
2405 | else
2406 | begin
2407 | sb.append(ch);
2408 | break;
2409 | end;
2410 | end
2411 | else if CharInSet(ch, chend) then
2412 | break
2413 | else
2414 | sb.append(ch);
2415 | inc(p);
2416 | end;
2417 |
2418 | if (p < Length(value)) then
2419 | ch := value[1 + p]
2420 | else
2421 | ch := #10;
2422 | if CharInSet(ch, chend) then
2423 | begin
2424 | self.position := p;
2425 | result := sb.ToString();
2426 | end
2427 | else
2428 | result := '';
2429 | finally
2430 | sb.Free;
2431 | end;
2432 | end;
2433 |
2434 | procedure TLine.setEmpty();
2435 | begin
2436 | value := '';
2437 | leading := 0;
2438 | trailing := 0;
2439 | isEmpty := true;
2440 | if (previous <> nil) then
2441 | previous.nextEmpty := true;
2442 | if (next <> nil) then
2443 | next.prevEmpty := true;
2444 | end;
2445 |
2446 | function TLine.countChars(ch: char): integer;
2447 | var
2448 | count, i: integer;
2449 | c: char;
2450 | begin
2451 | count := 0;
2452 | for i := 0 to Length(value) - 1 do
2453 | begin
2454 | c := value[1 + i];
2455 | if (c = ' ') then
2456 | continue;
2457 | if (c = ch) then
2458 | begin
2459 | inc(count);
2460 | continue;
2461 | end;
2462 | count := 0;
2463 | break;
2464 | end;
2465 | result := count;
2466 | end;
2467 |
2468 | function TLine.countCharsStart(ch: char; allowSpaces: boolean): integer;
2469 | var
2470 | count, i: integer;
2471 | c: char;
2472 | begin
2473 | count := 0;
2474 | for i := 0 to Length(value) - 1 do
2475 | begin
2476 | c := value[1 + i];
2477 | if (c = ' ') and (allowSpaces) then
2478 | begin
2479 | continue;
2480 | end;
2481 | if (c = ch) then
2482 | inc(count)
2483 | else
2484 | break;
2485 | end;
2486 | result := count;
2487 | end;
2488 |
2489 | function TLine.getLineType(config: TConfiguration): TLineType;
2490 | var
2491 | i: integer;
2492 | begin
2493 | if (isEmpty) then
2494 | exit(ltEMPTY);
2495 |
2496 | if (leading > 3) then
2497 | exit(ltCODE);
2498 |
2499 | if (value[1 + leading] = '#') then
2500 | begin
2501 | if config.isDialect([mdCommonMark]) then
2502 | begin
2503 | i:=1 + leading + 1;
2504 | while (i 2) then
2516 | begin
2517 | if (value[1 + leading] = '`') and (countCharsStart('`', config.allowSpacesInFencedDelimiters) >= 3) then
2518 | exit(ltFENCED_CODE);
2519 | if (value[1 + leading] = '~') and (countCharsStart('~', config.allowSpacesInFencedDelimiters) >= 3) then
2520 | exit(ltFENCED_CODE);
2521 | end;
2522 | end;
2523 |
2524 | if (Length(value) - leading - trailing > 2) and ((value[1 + leading] = '*') or (value[1 + leading] = '-') or (value[1 + leading] = '_')) then
2525 | begin
2526 | if (countChars(value[1 + leading]) >= 3) then
2527 | exit(ltHR);
2528 | end;
2529 |
2530 | if (Length(value) - leading >= 2) and (value[1 + leading + 1] = ' ') then
2531 | begin
2532 | if CharInSet(value[1 + leading], ['*', '-', '+']) then
2533 | exit(ltULIST);
2534 | end;
2535 |
2536 | if (Length(value) - leading >= 3) and (value[1 + leading].isDigit) then
2537 | begin
2538 | i := leading + 1;
2539 | while (i < Length(value)) and (value[1 + i].isDigit) do
2540 | inc(i);
2541 | if (i + 1 < Length(value)) and (value[1 + i] = '.') and (value[1 + i + 1] = ' ') then
2542 | exit(ltOLIST);
2543 | if (i + 1 < Length(value)) and (value[1 + i] = ')') and (value[1 + i + 1] = ' ') then
2544 | exit(ltBLIST);
2545 | end;
2546 |
2547 | if (value[1 + leading] = '<') then
2548 | begin
2549 | if (checkHTML()) then
2550 | exit(ltXML);
2551 | end;
2552 |
2553 | if (next <> nil) and (not next.isEmpty) then
2554 | begin
2555 | i:=1;
2556 | if config.isDialect([mdCommonMark]) then
2557 | while (length(next.value)>i) and (next.value[i] <> '-') and (next.value[i] <> '=') do
2558 | inc(i);
2559 | if (i<5) and (next.value[i] = '-') and (next.countChars('-') > 0) then
2560 | exit(ltHEADLINE2);
2561 | if (i<5) and (next.value[i] = '=') and (next.countChars('=') > 0) then
2562 | exit(ltHEADLINE1);
2563 | end;
2564 |
2565 | if config.isDialect([mdCommonMark]) and (next <>nil) and (not next.isEmpty) then
2566 | begin
2567 | if (TTable.hasFormatChars(next)>0) and (TTable.ColCount(self)=TTable.Cols) then exit(ltTABLE);
2568 | end;
2569 |
2570 | exit(ltOTHER);
2571 | end;
2572 |
2573 | function TLine.readXMLComment(firstLine: TLine; start: integer): integer;
2574 | var
2575 | line: TLine;
2576 | p: integer;
2577 | begin
2578 | line := firstLine;
2579 | if (start + 3 < Length(line.value)) then
2580 | begin
2581 | if (line.value[1 + 2] = '-') and (line.value[1 + 3] = '-') then
2582 | begin
2583 | p := start + 4;
2584 | while (line <> nil) do
2585 | begin
2586 | while (p < Length(line.value)) and (line.value[1 + p] <> '-') do
2587 | inc(p);
2588 | if (p = Length(line.value)) then
2589 | begin
2590 | line := line.next;
2591 | p := 0;
2592 | end
2593 | else
2594 | begin
2595 | if (p + 2 < Length(line.value)) then
2596 | begin
2597 | if (line.value[1 + p + 1] = '-') and (line.value[1 + p + 2] = '>') then
2598 | begin
2599 | xmlEndLine := line;
2600 | exit(p + 3);
2601 | end;
2602 | end;
2603 | inc(p);
2604 | end;
2605 | end;
2606 | end;
2607 | end;
2608 | exit(-1);
2609 | end;
2610 |
2611 | // FIXME ... hack - It is OK NOW
2612 | function TLine.stripID(): String;
2613 | var
2614 | p, start: integer;
2615 | found: boolean;
2616 | id: String;
2617 | begin
2618 | if (isEmpty or (value[1 + Length(value) - trailing - 1] <> '}')) then
2619 | exit('');
2620 |
2621 | p := leading;
2622 | found := false;
2623 | start := 0;
2624 | while (p < Length(value)) and (not found) do
2625 | begin
2626 | case value[1 + p] of
2627 | '\':
2628 | begin
2629 | if (p + 1 < Length(value)) then
2630 | begin
2631 | if (value[1 + p + 1]) = '{' then
2632 | begin
2633 | inc(p);
2634 | break;
2635 | end;
2636 | end;
2637 | inc(p);
2638 | break;
2639 | end;
2640 | '{':
2641 | begin
2642 | found := true;
2643 | break;
2644 | end
2645 | else
2646 | begin
2647 | inc(p);
2648 | end;
2649 | end;
2650 | end;
2651 |
2652 | if (found) then
2653 | begin
2654 | found := false;
2655 | if (p + 1 < Length(value)) and (value[1 + p + 1] = '#') then
2656 | begin
2657 | start := p + 2;
2658 | p := start;
2659 | while (p < Length(value)) and (not found) do
2660 | begin
2661 | case (value[1 + p]) of
2662 | '\':
2663 | begin
2664 | if (p + 1 < Length(value)) then
2665 | begin
2666 | if (value[1 + p + 1]) = '}' then
2667 | begin
2668 | inc(p);
2669 | break;
2670 | end;
2671 | end;
2672 | inc(p);
2673 | break;
2674 | end;
2675 | '}':
2676 | begin
2677 | found := true;
2678 | break;
2679 | end;
2680 | else
2681 | begin
2682 | inc(p);
2683 | end;
2684 | end;
2685 | end;
2686 | end;
2687 | end;
2688 |
2689 | if (found) then
2690 | begin
2691 | id := Trim( Copy(value, start + 1, p-start));
2692 | if (leading <> 0) then
2693 | begin
2694 | value := Copy(value, 1, leading) + Trim( Copy( value, leading + 1, start -2));
2695 | end
2696 | else
2697 | begin
2698 | value := Trim( Copy(value, leading +1, start -2));
2699 | end;
2700 | trailing := 0;
2701 | if (Length(id) > 0) then
2702 | exit(id)
2703 | else
2704 | exit('');
2705 | end;
2706 | exit('');
2707 | end;
2708 |
2709 | function TLine.checkHTML: boolean;
2710 | var
2711 | tags: TStringList;
2712 | temp: TStringBuilder;
2713 | element, tag: String;
2714 | line: TLine;
2715 | newPos: integer;
2716 | begin
2717 | result := false;
2718 | tags := TStringList.Create();
2719 | temp := TStringBuilder.Create();
2720 | try
2721 | position := leading;
2722 | if (value.length >= 1 + leading + 1) and (value[1 + leading + 1] = '!') then
2723 | begin
2724 | if (readXMLComment(self, leading) > 0) then
2725 | begin
2726 | exit(true);
2727 | end;
2728 | end;
2729 | position := TUtils.readXML(temp, value, leading, false);
2730 | if (position > -1) then
2731 | begin
2732 | element := temp.ToString();
2733 | temp.Clear;
2734 | TUtils.getXMLTag(temp, element);
2735 | tag := LowerCase(temp.ToString());
2736 | if (not THTML.isHtmlBlockElement(tag)) then
2737 | exit(false);
2738 | // if (tag.equals('hr') or element.endsWith('/>')) then PSTFix
2739 | if (tag = 'hr') or AnsiEndsText('/>', element) then
2740 |
2741 | begin
2742 | xmlEndLine := self;
2743 | exit(true);
2744 | end;
2745 | tags.add(tag);
2746 |
2747 | line := self;
2748 | while (line <> nil) do
2749 | begin
2750 | while (position < Length(line.value)) and (line.value[1 + position] <> '<') do
2751 | inc(FPosition);
2752 | if (position >= Length(line.value)) then
2753 | begin
2754 | line := line.next;
2755 | position := 0;
2756 | end
2757 | else
2758 | begin
2759 | temp.Clear;
2760 | newPos := TUtils.readXML(temp, line.value, position, false);
2761 | if (newPos > 0) then
2762 | begin
2763 | element := temp.ToString();
2764 | temp.Clear;
2765 | TUtils.getXMLTag(temp, element);
2766 | tag := LowerCase(temp.ToString());
2767 | if (THTML.isHtmlBlockElement(tag)) and (tag <> 'hr') and (not AnsiEndsText('/>', element)) then
2768 | begin
2769 | if (element[1 + 1] = '/') then
2770 | begin
2771 | if (tags[tags.Count - 1] <> tag) then
2772 | exit(false);
2773 | tags.Delete(tags.count - 1);
2774 | end
2775 | else
2776 | tags.add(tag);
2777 | end;
2778 | if (tags.count = 0) then
2779 | begin
2780 | xmlEndLine := line;
2781 | break;
2782 | end;
2783 | position := newPos;
2784 | end
2785 | else
2786 | begin
2787 | inc(FPosition);
2788 | end;
2789 | end;
2790 | end;
2791 | result := tags.count = 0;
2792 | end;
2793 | finally
2794 | temp.Free;
2795 | tags.Free;
2796 | end;
2797 | end;
2798 |
2799 | { TLinkRef }
2800 |
2801 | constructor TLinkRef.Create(link, title: String; isAbbrev: boolean);
2802 | begin
2803 | inherited Create;
2804 | FLink := link;
2805 | FTitle := title;
2806 | FIsAbbrev := isAbbrev;
2807 | end;
2808 |
2809 | { TBlock }
2810 |
2811 | constructor TBlock.Create;
2812 | begin
2813 | inherited;
2814 | end;
2815 |
2816 | destructor TBlock.Destroy;
2817 | begin
2818 | FLines.Free;
2819 | FBlocks.Free;
2820 | FNext.free;
2821 | inherited;
2822 | end;
2823 |
2824 | procedure TBlock.AppendLine(line: TLine);
2825 | begin
2826 | if (self.lineTail = nil) then
2827 | begin
2828 | self.FLines := line;
2829 | self.FLineTail := line;
2830 | end
2831 | else
2832 | begin
2833 | self.lineTail.nextEmpty := line.isEmpty;
2834 | line.prevEmpty := self.lineTail.isEmpty;
2835 | line.previous := self.lineTail;
2836 | self.lineTail.next := line;
2837 | self.FLineTail := line;
2838 | end;
2839 |
2840 | end;
2841 |
2842 | procedure TBlock.expandListParagraphs;
2843 | var
2844 | outer: TBlock;
2845 | inner: TBlock;
2846 | hasParagraph: boolean;
2847 | begin
2848 | if (self.type_ <> btORDERED_LIST) and (self.type_ <> btUNORDERED_LIST) then
2849 | exit;
2850 |
2851 | outer := self.blocks;
2852 | hasParagraph := false;
2853 | while (outer <> nil) and (not hasParagraph) do
2854 | begin
2855 | if (outer.type_ = btLIST_ITEM) then
2856 | begin
2857 | inner := outer.blocks;
2858 | while (inner <> nil) and (not hasParagraph) do
2859 | begin
2860 | if (inner.type_ = btPARAGRAPH) then
2861 | begin
2862 | hasParagraph := true;
2863 | end;
2864 | inner := inner.next;
2865 | end;
2866 | end;
2867 | outer := outer.next;
2868 | end;
2869 |
2870 | if (hasParagraph) then
2871 | begin
2872 | outer := self.blocks;
2873 | while (outer <> nil) do
2874 | begin
2875 | if (outer.type_ = btLIST_ITEM) then
2876 | begin
2877 | inner := outer.blocks;
2878 | while (inner <> nil) do
2879 | begin
2880 | if (inner.type_ = btNONE) then
2881 | begin
2882 | inner.type_ := btPARAGRAPH;
2883 | end;
2884 | inner := inner.next;
2885 | end;
2886 | end;
2887 | outer := outer.next;
2888 | end;
2889 | end;
2890 | end;
2891 |
2892 | function TBlock.hasLines: boolean;
2893 | begin
2894 | result := lines <> nil;
2895 | end;
2896 |
2897 | procedure TBlock.removeLine(line: TLine);
2898 | begin
2899 | if (line.previous = nil) then
2900 | begin
2901 | self.FLines := line.next;
2902 | end
2903 | else
2904 | begin
2905 | line.previous.next := line.next;
2906 | end;
2907 |
2908 | if (line.next = nil) then
2909 | begin
2910 | self.FLineTail := line.previous;
2911 | end
2912 | else
2913 | begin
2914 | line.next.previous := line.previous;
2915 | end;
2916 | line.previous := nil;
2917 |
2918 | line.next := nil;
2919 | line.free;
2920 | end;
2921 |
2922 | procedure TBlock.removeBlockQuotePrefix;
2923 | var
2924 | line: TLine;
2925 | rem: integer;
2926 | begin
2927 | line := self.lines;
2928 | while (line <> nil) do
2929 | begin
2930 | if (not line.isEmpty) then
2931 | begin
2932 | if (line.value[1 + line.leading] = '>') then
2933 | begin
2934 | rem := line.leading + 1;
2935 | if (line.leading + 1 < Length(line.value)) and (line.value[1 + line.leading + 1] = ' ') then
2936 | begin
2937 | inc(rem);
2938 | end;
2939 | line.value := Copy(line.value, rem+1);
2940 | line.InitLeading();
2941 | end;
2942 | end;
2943 | line := line.next;
2944 | end;
2945 | end;
2946 |
2947 | function TBlock.removeLeadingEmptyLines: boolean;
2948 | var
2949 | wasEmpty: boolean;
2950 | line: TLine;
2951 | begin
2952 | wasEmpty := false;
2953 | line := self.lines;
2954 | while (line <> nil) and (line.isEmpty) do
2955 | begin
2956 | self.removeLine(line);
2957 | line := self.lines;
2958 | wasEmpty := true;
2959 | end;
2960 | result := wasEmpty;
2961 | end;
2962 |
2963 | procedure TBlock.removeTrailingEmptyLines;
2964 | var
2965 | line: TLine;
2966 | begin
2967 | line := self.lineTail;
2968 | while (line <> nil) and (line.isEmpty) do
2969 | begin
2970 | self.removeLine(line);
2971 | line := self.lineTail;
2972 | end;
2973 | end;
2974 |
2975 | procedure TBlock.removeListIndent(config: TConfiguration);
2976 | var
2977 | line: TLine;
2978 | begin
2979 | line := self.lines;
2980 | while (line <> nil) do
2981 | begin
2982 | if (not line.isEmpty) then
2983 | begin
2984 | case (line.getLineType(config)) of
2985 | ltULIST:
2986 | line.value := Copy(line.value, line.leading +3);
2987 | ltOLIST:
2988 | line.value := Copy(line.value, pos('.', line.value) + 2);
2989 | ltBLIST:
2990 | line.value := Copy(line.value, pos(')', line.value) + 2);
2991 | else
2992 | // line.value := line.value.substring(Math.min(line.leading, 4)); pstfix
2993 | line.value := Copy(line.value, System.Math.Min(line.leading + 1, 5));
2994 | end;
2995 | line.InitLeading();
2996 | end;
2997 | line := line.next;
2998 | end;
2999 |
3000 | end;
3001 |
3002 | procedure TBlock.removeSurroundingEmptyLines;
3003 | begin
3004 | if (self.lines <> nil) then
3005 | begin
3006 | self.removeTrailingEmptyLines();
3007 | self.removeLeadingEmptyLines();
3008 | end;
3009 |
3010 | end;
3011 |
3012 | function TBlock.split(line: TLine): TBlock;
3013 | var
3014 | block: TBlock;
3015 | begin
3016 | block := TBlock.Create();
3017 | block.FLines := self.lines;
3018 | block.FLineTail := line;
3019 | self.FLines := line.next;
3020 | line.next := nil;
3021 | if (self.lines = nil) then
3022 | begin
3023 | self.FLineTail := nil;
3024 | end
3025 | else
3026 | begin
3027 | self.lines.previous := nil;
3028 | end;
3029 |
3030 | if (self.blocks = nil) then
3031 | begin
3032 | self.FBlocks := block;
3033 | self.FBlockTail := block;
3034 | end
3035 | else
3036 | begin
3037 | self.blockTail.next := block;
3038 | self.FBlockTail := block;
3039 | end;
3040 | result := block;
3041 | end;
3042 |
3043 | procedure TBlock.transfromHeadline;
3044 | var
3045 | level, start, end_: integer;
3046 | line: TLine;
3047 | begin
3048 | if (self.hlDepth > 0) then
3049 | begin
3050 | exit;
3051 | end;
3052 | level := 0;
3053 | line := self.lines;
3054 | if (line.isEmpty) then
3055 | begin
3056 | exit;
3057 | end;
3058 | start := line.leading;
3059 | while (start < Length(line.value)) and (line.value[1 + start] = '#') do
3060 | begin
3061 | inc(level);
3062 | inc(start);
3063 | end;
3064 | while (start < Length(line.value)) and (line.value[1 + start] = ' ') do
3065 | begin
3066 | inc(start);
3067 | end;
3068 | if (start >= Length(line.value)) then
3069 | begin
3070 | line.setEmpty();
3071 | end
3072 | else
3073 | begin
3074 | end_ := Length(line.value) - line.trailing - 1;
3075 | while (line.value[1 + end_] = '#') do
3076 | begin
3077 | dec(end_);
3078 | end;
3079 | while (line.value[1 + end_] = ' ') do
3080 | begin
3081 | dec(end_);
3082 | end;
3083 | if ((1 + end_) ' ') then end_:=Length(line.value);
3084 | line.value := Copy(line.value, start+1, end_-start+1);
3085 | line.leading := 0;
3086 | line.trailing := 0;
3087 | end;
3088 | self.hlDepth := System.Math.min(level, 6);
3089 | end;
3090 |
3091 | end.
3092 |
--------------------------------------------------------------------------------