← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/wiki/lazwiki/wikiparser.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/wiki/lazwiki/wikiparser.pas
 
1
{ Simple Wiki parser for the FreePascal/Lazarus Wiki export pages
 
2
 
 
3
  Copyright (C) 2012  Mattias Gaertner  mattias@freepascal.org
 
4
 
 
5
  This source is free software; you can redistribute it and/or modify it under
 
6
  the terms of the GNU General Public License as published by the Free
 
7
  Software Foundation; either version 2 of the License, or (at your option)
 
8
  any later version.
 
9
 
 
10
  This code is distributed in the hope that it will be useful, but WITHOUT ANY
 
11
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
12
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
13
  details.
 
14
 
 
15
  A copy of the GNU General Public License is available on the World Wide Web
 
16
  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
 
17
  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 
18
  MA 02111-1307, USA.
 
19
 
 
20
ToDo:
 
21
  links without brackets: http://...  see bidimode
 
22
  div, div class="key", font: this is pure HTML and maybe should be better fixed in the wiki
 
23
  attributes in pre  <pre>'''Text'''</pre> see page BidiMode
 
24
  code in list items, see Compile_and_Develop_on_Maemo_device
 
25
}
 
26
unit WikiParser;
 
27
 
 
28
{$mode objfpc}{$H+}
 
29
 
 
30
{ $DEFINE VerboseWikiStack}
 
31
{ $DEFINE VerboseWikiOnToken}
 
32
{ $DEFINE VerboseUnknownOpenTags}
 
33
 
 
34
interface
 
35
 
 
36
uses
 
37
  Classes, SysUtils, laz2_XMLRead, laz2_DOM, LazUTF8, LazLogger,
 
38
  BasicCodeTools, KeywordFuncLists;
 
39
 
 
40
const
 
41
  MaxHeaderDepth = 6;
 
42
type
 
43
  TWPTokenType = (
 
44
    wptText,  // TWPTextToken
 
45
    wptAttribute, // e.g. class="code" TWPNameValueToken
 
46
    wptLineBreak, // <br> /br> <br/>
 
47
    wptBold,    // '''
 
48
    wptBoldTag, // <b>
 
49
    wptItalic,  // ''
 
50
    wptItalicTag, // <i>
 
51
    wptStrikeTagShort, // <s>
 
52
    wptStrikeTagLong, // <strike>
 
53
    wptUnderlineTag, // <u>
 
54
    wptTT, // <tt>
 
55
    wptSup, // <sup>
 
56
    wptSub, // <sub>
 
57
    wptSmall, // <small>
 
58
    wptEm, // <em>
 
59
    wptString, // <string>
 
60
    wptVar, // <var>
 
61
    wptKey, // <key>
 
62
    wptCmt, // <cmt>
 
63
    wptSpan, // <span>
 
64
    wptCode, // TWPNameValueToken
 
65
    wptSpecial, // {{text}}
 
66
    wptPre,  // space at line start
 
67
    wptPreTag,  // <pre>
 
68
    wptP, // paragraph
 
69
    wptPTag, // <p>
 
70
    wptDivTag, // <div>
 
71
    wptCenter, // <center>
 
72
    wptInternLink, // [[]]
 
73
    wptExternLink, // []
 
74
    wptHorizontalRow, // ----
 
75
    wptNumberedList, // #
 
76
    wptOrderedListTag, // <ol>
 
77
    wptBulletList, // *
 
78
    wptUnorderedListTag, // <ul>
 
79
    wptDefinitionList, // : or ;
 
80
    wptListItem,
 
81
    wptListItemTag, // <li>
 
82
    wptTable, // wiki tag for table
 
83
    wptTableTag, // <table>
 
84
    wptTableRow, // wiki tag for table row
 
85
    wptTableRowTag, // <tr>
 
86
    wptTableHeadCell, // wiki tag for table head cell
 
87
    wptTableHeadCellTag, // <th>
 
88
    wptTableCell, // wiki tag for table cell
 
89
    wptTableCellTag, // <td>
 
90
    wptSection, // started/ended by =
 
91
    wptSubSection, // started automatically, ended on empty line
 
92
    wptHeader, // =Text=
 
93
    wptHeader1, // <h1>
 
94
    wptHeader2, // <h2>
 
95
    wptHeader3  // <h3>
 
96
    );
 
97
  TWPTokenTypes = set of TWPTokenType;
 
98
 
 
99
  TWPTokenInfoFlag = (
 
100
    wpifCanStart,
 
101
    wpifCanEnd,
 
102
    wpifWarnOnAutoClose
 
103
    );
 
104
  TWPTokenInfoFlags = set of TWPTokenInfoFlag;
 
105
 
 
106
  TWPTokenGroup = (
 
107
    wpgFont,
 
108
    wpgParagraph,
 
109
    wpgList,
 
110
    wpgTable,
 
111
    wpgSubSection,
 
112
    wpgSection
 
113
    );
 
114
  TWPTokenGroups = set of TWPTokenGroup;
 
115
 
 
116
  TWPTokenRange = (
 
117
    wprNone,
 
118
    wprOpen,
 
119
    wprClose
 
120
    );
 
121
 
 
122
  TWPTokenInfo = record
 
123
    Caption: string;
 
124
    Flags: TWPTokenInfoFlags;
 
125
    Group: TWPTokenGroup;
 
126
    BaseToken: TWPTokenType;
 
127
  end;
 
128
 
 
129
const
 
130
  WPTWikiLists = [wptNumberedList,wptBulletList,wptDefinitionList,wptListItem];
 
131
 
 
132
  WPTokenInfos: array[TWPTokenType] of TWPTokenInfo = (
 
133
    (Caption: 'Text'; Flags: []; Group: wpgFont; BaseToken: wptText), // wptText,
 
134
    (Caption: 'Attribute'; Flags: []; Group: wpgFont; BaseToken: wptAttribute), // wptAttribute,
 
135
    (Caption: 'LineBreak'; Flags: []; Group: wpgFont; BaseToken: wptLineBreak), // wptLineBreak,
 
136
    (Caption: 'Bold'; Flags: []; Group: wpgFont; BaseToken: wptBold), // wptBold,
 
137
    (Caption: 'BoldTag'; Flags: []; Group: wpgFont; BaseToken: wptBold), // wptBoldTag,
 
138
    (Caption: 'Italic'; Flags: []; Group: wpgFont; BaseToken: wptItalic), // wptItalic,
 
139
    (Caption: 'ItalicTag'; Flags: []; Group: wpgFont; BaseToken: wptItalic), // wptItalicTag,
 
140
    (Caption: 'StrikeTagShort'; Flags: []; Group: wpgFont; BaseToken: wptStrikeTagShort), // wptStrikeTagShort,
 
141
    (Caption: 'StrikeTagLong'; Flags: []; Group: wpgFont; BaseToken: wptStrikeTagShort), // wptStrikeTagLong,
 
142
    (Caption: 'UnderlineTag'; Flags: []; Group: wpgFont; BaseToken: wptUnderlineTag), // wptUnderlineTag,
 
143
    (Caption: 'TT'; Flags: []; Group: wpgFont; BaseToken: wptTT), // wptTT,
 
144
    (Caption: 'Sup'; Flags: []; Group: wpgFont; BaseToken: wptSup), // wptSup,
 
145
    (Caption: 'Sub'; Flags: []; Group: wpgFont; BaseToken: wptSub), // wptSub,
 
146
    (Caption: 'Small'; Flags: []; Group: wpgFont; BaseToken: wptSmall), // wptSmall,
 
147
    (Caption: 'Em'; Flags: []; Group: wpgFont; BaseToken: wptEm), // wptEm,
 
148
    (Caption: 'String'; Flags: []; Group: wpgFont; BaseToken: wptString), // wptString,
 
149
    (Caption: 'Var'; Flags: []; Group: wpgFont; BaseToken: wptVar), // wptVar,
 
150
    (Caption: 'Key'; Flags: []; Group: wpgFont; BaseToken: wptKey), // wptKey,
 
151
    (Caption: 'Cmt'; Flags: []; Group: wpgFont; BaseToken: wptCmt), // wptCmt,
 
152
    (Caption: 'Span'; Flags: []; Group: wpgFont; BaseToken: wptSpan), // wptSpan,
 
153
    (Caption: 'Code'; Flags: []; Group: wpgFont; BaseToken: wptCode), // wptCode,
 
154
    (Caption: 'Special'; Flags: []; Group: wpgFont; BaseToken: wptSpecial), // wptSpecial,
 
155
    (Caption: 'Pre'; Flags: []; Group: wpgParagraph; BaseToken: wptPre), // wptPre,
 
156
    (Caption: 'PreTag'; Flags: []; Group: wpgParagraph; BaseToken: wptPre), // wptPreTag,
 
157
    (Caption: 'P'; Flags: []; Group: wpgParagraph; BaseToken: wptP), // wptP,
 
158
    (Caption: 'PTag'; Flags: []; Group: wpgParagraph; BaseToken: wptP), // wptPTag,
 
159
    (Caption: 'DivTag'; Flags: []; Group: wpgParagraph; BaseToken: wptP), // wptDivTag,
 
160
    (Caption: 'Center'; Flags: []; Group: wpgParagraph; BaseToken: wptCenter), // wptCenter
 
161
    (Caption: 'InternLink'; Flags: []; Group: wpgParagraph; BaseToken: wptInternLink), // wptInternLink,
 
162
    (Caption: 'ExternLink'; Flags: []; Group: wpgParagraph; BaseToken: wptExternLink),  // wptExternLink,
 
163
    (Caption: 'HorizontalRow'; Flags: []; Group: wpgParagraph; BaseToken: wptHorizontalRow), // wptHorizontalRow,
 
164
    (Caption: 'NumberedList'; Flags: []; Group: wpgList; BaseToken: wptNumberedList),  // wptNumberedList,
 
165
    (Caption: 'OrderedListTag'; Flags: []; Group: wpgList; BaseToken: wptNumberedList),  // wptOrderedListTag,
 
166
    (Caption: 'BulletList'; Flags: []; Group: wpgList; BaseToken: wptBulletList),  // wptBulletList,
 
167
    (Caption: 'UnorderedListTag'; Flags: []; Group: wpgList; BaseToken: wptBulletList),  // wptUnorderedListTag,
 
168
    (Caption: 'DefinitionList'; Flags: []; Group: wpgList; BaseToken: wptDefinitionList),  // wptDefinitionList,
 
169
    (Caption: 'ListItem'; Flags: []; Group: wpgList; BaseToken: wptListItem),  // wptListItem,
 
170
    (Caption: 'ListItemTag'; Flags: []; Group: wpgList; BaseToken: wptListItem), // wptListItemTag,
 
171
    (Caption: 'Table'; Flags: []; Group: wpgTable; BaseToken: wptTable), // wptTable,
 
172
    (Caption: 'TableTag'; Flags: []; Group: wpgTable; BaseToken: wptTable), // wptTableTag,
 
173
    (Caption: 'TableRow'; Flags: []; Group: wpgTable; BaseToken: wptTableRow), // wptTableRow,
 
174
    (Caption: 'TableRowTag'; Flags: []; Group: wpgTable; BaseToken: wptTableRow), // wptTableRowTag,
 
175
    (Caption: 'TableHeadCell'; Flags: []; Group: wpgTable; BaseToken: wptTableHeadCell), // wptTableHeadCell,
 
176
    (Caption: 'TableHeadCellTag'; Flags: []; Group: wpgTable; BaseToken: wptTableHeadCell), // wptTableHeadCellTag,
 
177
    (Caption: 'TableCell'; Flags: []; Group: wpgTable; BaseToken: wptTableCell), // wptTableCell,
 
178
    (Caption: 'TableCellTag'; Flags: []; Group: wpgTable; BaseToken: wptTableCell), // wptTableCellTag,
 
179
    (Caption: 'Section'; Flags: []; Group: wpgSection; BaseToken: wptSection), // wptSection,
 
180
    (Caption: 'SubSection'; Flags: []; Group: wpgSubSection; BaseToken: wptP), // wptSubSection,
 
181
    (Caption: 'Header'; Flags: []; Group: wpgSection; BaseToken: wptHeader), // wptHeader,
 
182
    (Caption: 'Header1'; Flags: []; Group: wpgSection; BaseToken: wptHeader), // wptHeader1,
 
183
    (Caption: 'Header2'; Flags: []; Group: wpgSection; BaseToken: wptHeader), // wptHeader2,
 
184
    (Caption: 'Header3'; Flags: []; Group: wpgSection; BaseToken: wptHeader) // wptHeader3,
 
185
  );
 
186
  WPTokenRangeNames: array[TWPTokenRange] of string = (
 
187
    'Point' ,// wprNone
 
188
    'Open', // wprOpen,
 
189
    'Close' // wprClose,
 
190
    );
 
191
 
 
192
type
 
193
  TWikiPage = class;
 
194
 
 
195
  { TWPToken }
 
196
 
 
197
  TWPToken = class
 
198
  public
 
199
    Token: TWPTokenType;
 
200
    SubToken: TWPTokenType;
 
201
    Range: TWPTokenRange;
 
202
    UserData: Pointer;
 
203
    Page: TWikiPage;
 
204
    constructor Create(ThePage: TWikiPage; TheUserDate: Pointer);
 
205
  end;
 
206
 
 
207
  TWPTextToken = class(TWPToken)
 
208
  public
 
209
    StartPos, EndPos: integer;
 
210
  end;
 
211
 
 
212
  TWPLinkToken = class(TWPToken)
 
213
  public
 
214
    LinkStartPos, LinkEndPos: integer;
 
215
    Link: string; // trimmed and cleaned up
 
216
    CaptionStartPos, CaptionEndPos: integer;
 
217
  end;
 
218
 
 
219
  TWPNameValueToken = class(TWPToken)
 
220
  public
 
221
    NameStartPos, NameEndPos: integer;
 
222
    ValueStartPos, ValueEndPos: integer;
 
223
  end;
 
224
 
 
225
  TWikiTokenEvent = procedure(Token: TWPToken) of object;
 
226
 
 
227
  TWikiPageVerbosity = (
 
228
    wpvNone,
 
229
    wpvFatal,
 
230
    wpvError,
 
231
    wpvWarning,
 
232
    wpvHint
 
233
    );
 
234
 
 
235
  TWikiOnLog = procedure(Msg: string) of object;
 
236
 
 
237
  { TWikiPage }
 
238
 
 
239
  TWikiPage = class
 
240
  private
 
241
    type
 
242
      TWPStackItem = record
 
243
        Token: TWPTokenType;
 
244
        StartPos: PChar;
 
245
      end;
 
246
      PStackItem = ^TWPStackItem;
 
247
  private
 
248
    FBaseURL: string;
 
249
    FFilename: string;
 
250
    FAutoFixUTF8: boolean;
 
251
    FLanguageTags: TKeyWordFunctionList;
 
252
    FOnLog: TWikiOnLog;
 
253
    FStack: PStackItem;
 
254
    FStackPtr: integer;
 
255
    FStackCapacity: integer;
 
256
    FID: String;
 
257
    FRevision: String;
 
258
    FTimeStamp: String;
 
259
    FTitle: String;
 
260
    FCurP: PChar;
 
261
    FLine: integer;
 
262
    FLastEmitPos: PChar;
 
263
    FRangeToken: TWPToken;
 
264
    FSrc: string;
 
265
    FTextToken: TWPTextToken;
 
266
    FLinkToken: TWPLinkToken;
 
267
    FNameValueToken: TWPNameValueToken;
 
268
    FOnToken: TWikiTokenEvent;
 
269
    FVerbosity: TWikiPageVerbosity;
 
270
    FInPre: integer; // >0 means in a pre range
 
271
    procedure HandleAngleBracket; // tags
 
272
    procedure HandleCode; // <code>
 
273
    procedure HandleApostroph; // bold, italic
 
274
    procedure HandleCurlyBracketOpen; // special, start of table
 
275
    procedure HandlePipe; // new row, end of table
 
276
    procedure HandleExclamationMark;  // head cell
 
277
    procedure HandleEdgedBracketOpen; // links
 
278
    procedure HandleUnderScore; // __TOC__
 
279
    procedure HandleEqual;   // headers
 
280
    procedure HandleListChar; // lists '*', '#', ':', ';'
 
281
    procedure HandleSpace; // preserve space
 
282
    procedure EmitFlag(Typ: TWPTokenType; Range: TWPTokenRange; TagLen: integer);
 
283
    procedure EmitToggle(Typ: TWPTokenType; TagLen: integer);
 
284
    procedure EmitTag(Typ: TWPTokenType; Range: TWPTokenRange);
 
285
    procedure EmitLineBreak;
 
286
    procedure EmitTextToken;
 
287
    procedure ParseCell;
 
288
    procedure ParseAttributes(StartPos, EndPos: PChar);
 
289
    procedure ParseNoWiki;
 
290
    procedure CloseTableCell;
 
291
    procedure CloseRangeToken(Typ: TWPTokenType);
 
292
    procedure OpenRangeToken(Typ: TWPTokenType);
 
293
    function FindTagEnd(TagStart: PChar): PChar;
 
294
    procedure SetAutoFixUTF8(AValue: boolean);
 
295
    procedure SetSrc(AValue: string);
 
296
    function TokenIs(Tag: PChar): boolean;
 
297
    procedure ClearStack;
 
298
    procedure Push(Token: TWPTokenType; StartPos: PChar);
 
299
    function Pop(Token: TWPTokenType): boolean;
 
300
    procedure Pop(Index: integer);
 
301
    function TopToken: TWPTokenType;
 
302
    function FindGroupStackPos(Group: TWPTokenGroup; OrHigher: boolean): integer;
 
303
    function FindStackItem(Typ: TWPTokenType): integer;
 
304
    procedure DoToken(Token: TWPToken);
 
305
  public
 
306
    constructor Create;
 
307
    destructor Destroy; override;
 
308
    procedure LoadFromFile(Filename: string);
 
309
    procedure LoadFromDoc(doc: TDOMNode);
 
310
    procedure Parse(const OnToken: TWikiTokenEvent; Data: Pointer = nil);
 
311
    property ID: String read FID write FID; // mediawiki/siteinfo/page/id
 
312
    property Title: String read FTitle write FTitle; // mediawiki/siteinfo/page/title
 
313
    property Revision: String read FRevision write FRevision; // mediawiki/siteinfo/page/revision/id
 
314
    property TimeStamp: String read FTimeStamp write FTimeStamp; // mediawiki/siteinfo/page/timestamp
 
315
    property Filename: string read FFilename write FFilename; // mediawiki/siteinfo/page/id
 
316
    property BaseURL: string read FBaseURL write FBaseURL; // ExtractFilePath(mediawiki/siteinfo/base)
 
317
    property Verbosity: TWikiPageVerbosity read FVerbosity write FVerbosity;
 
318
    property AutoFixUTF8: boolean read FAutoFixUTF8 write SetAutoFixUTF8;
 
319
    procedure FixUTF8;
 
320
    property Src: string read FSrc write SetSrc;
 
321
    function StrPos(p: PChar): integer;
 
322
    function PosToStr(p: PChar; WithFilename: boolean = false): string;
 
323
    function PosToStr(p: integer; WithFilename: boolean = false): string;
 
324
    function AtLineStart(p: PChar): boolean;
 
325
    function TrimLink(const Link: string): string;
 
326
    function CurrentPos: integer;
 
327
    property LanguageTags: TKeyWordFunctionList read FLanguageTags write FLanguageTags;
 
328
    procedure Log(Msg: string);
 
329
    property OnLog: TWikiOnLog read FOnLog write FOnLog;
 
330
  end;
 
331
 
 
332
var
 
333
  IsWikiTagStartChar,
 
334
  IsWikiTagChar: array[char] of boolean;
 
335
 
 
336
// normalize link to get the page, e.g. convert spaces to underscores
 
337
function WikiInternalLinkToPage(Link: string): string;
 
338
function WikiIsExternalLink(Link: string): boolean;
 
339
 
 
340
function GetWikiPageID(doc: TDOMNode): string;
 
341
function GetWikiPageID(s: TStream): string;
 
342
function WikiPageToCaseID(Page: string): string; // create a bit vector for each letter
 
343
 
 
344
function dbgs(t: TWPTokenType): string; overload;
 
345
function dbgs(r: TWPTokenRange): string; overload;
 
346
 
 
347
implementation
 
348
 
 
349
{ TWPToken }
 
350
 
 
351
constructor TWPToken.Create(ThePage: TWikiPage; TheUserDate: Pointer);
 
352
begin
 
353
  Page:=ThePage;
 
354
  UserData:=TheUserDate;
 
355
end;
 
356
 
 
357
{ TWikiPage }
 
358
 
 
359
function TWikiPage.StrPos(p: PChar): integer;
 
360
begin
 
361
  Result:=p-PChar(FSrc)+1;
 
362
end;
 
363
 
 
364
function TWikiPage.AtLineStart(p: PChar): boolean;
 
365
begin
 
366
  Result:=(p=PChar(FSrc)) or (p[-1] in [#10,#13]);
 
367
end;
 
368
 
 
369
function TWikiPage.PosToStr(p: PChar; WithFilename: boolean): string;
 
370
begin
 
371
  if (p=nil) then
 
372
    Result:='(nil)'
 
373
  else if (Src='') then
 
374
    Result:='(outside)'
 
375
  else if p<PChar(FSrc) then
 
376
    Result:='(invalid pos <0)'
 
377
  else begin
 
378
    Result:=PosToStr(StrPos(p),WithFilename);
 
379
  end;
 
380
end;
 
381
 
 
382
function TWikiPage.PosToStr(p: integer; WithFilename: boolean): string;
 
383
var
 
384
  y: Integer;
 
385
  x: integer;
 
386
  s: String;
 
387
begin
 
388
  if SrcPosToLineCol(FSrc,p,y,x) then
 
389
    Result:='('+IntToStr(y)+','+IntToStr(x)+')'
 
390
  else
 
391
    Result:='(outside)';
 
392
  if WithFilename then begin
 
393
    s:='';
 
394
    if Filename<>'' then
 
395
      s:=ExtractFilename(Filename)
 
396
    else if Title<>'' then begin
 
397
      s:=Title;
 
398
      if length(s)>40 then
 
399
        s:=LeftStr(s,19)+'...'+RightStr(s,19);
 
400
    end;
 
401
    Result:=Result+' in "'+s+'"'
 
402
  end;
 
403
end;
 
404
 
 
405
procedure TWikiPage.SetAutoFixUTF8(AValue: boolean);
 
406
begin
 
407
  if FAutoFixUTF8=AValue then Exit;
 
408
  FAutoFixUTF8:=AValue;
 
409
  if FAutoFixUTF8 then
 
410
    FixUTF8;
 
411
end;
 
412
 
 
413
procedure TWikiPage.SetSrc(AValue: string);
 
414
begin
 
415
  if FSrc=AValue then Exit;
 
416
  FSrc:=AValue;
 
417
  if AutoFixUTF8 then FixUTF8;
 
418
end;
 
419
 
 
420
function TWikiPage.TokenIs(Tag: PChar): boolean;
 
421
var
 
422
  p2: PChar;
 
423
begin
 
424
  p2:=FCurP;
 
425
  while (p2^<>#0) and (UpChars[p2^]=UpChars[Tag^]) do begin
 
426
    inc(p2);
 
427
    inc(Tag);
 
428
  end;
 
429
  Result:=Tag^=#0;
 
430
end;
 
431
 
 
432
procedure TWikiPage.ClearStack;
 
433
begin
 
434
  ReAllocMem(FStack,0);
 
435
  FStackCapacity:=0;
 
436
  FStackPtr:=-1;
 
437
  FInPre:=0;
 
438
end;
 
439
 
 
440
procedure TWikiPage.Push(Token: TWPTokenType; StartPos: PChar);
 
441
var
 
442
  NewCapacity: Integer;
 
443
  Item: PStackItem;
 
444
begin
 
445
  inc(FStackPtr);
 
446
  {$IFDEF VerboseWikiStack}
 
447
  Log(['Push :',GetIndentStr(FStackPtr*2),dbgs(Token),' at ',PosToStr(FCurP)]);
 
448
  {$ENDIF}
 
449
  if FStackPtr>=FStackCapacity then begin
 
450
    NewCapacity:=FStackCapacity*2+8;
 
451
    ReAllocMem(FStack,SizeOf(TWPStackItem)*NewCapacity);
 
452
    FStackCapacity:=NewCapacity;
 
453
  end;
 
454
  Item:=@FStack[FStackPtr];
 
455
  Item^.Token:=Token;
 
456
  Item^.StartPos:=StartPos;
 
457
  if Token in [wptPre,wptPreTag] then
 
458
    inc(FInPre);
 
459
  OpenRangeToken(Token);
 
460
end;
 
461
 
 
462
function TWikiPage.Pop(Token: TWPTokenType): boolean;
 
463
 
 
464
  procedure LogMissingClose;
 
465
  var
 
466
    Item: PStackItem;
 
467
  begin
 
468
    Item:=@FStack[FStackPtr];
 
469
    Log('TWikiPage.Pop WARNING: missing closing for '+dbgs(Item^.Token)+' at '+PosToStr(FCurP,true));
 
470
  end;
 
471
 
 
472
  procedure LogNotOpen;
 
473
  begin
 
474
    Log('TWikiPage.Pop Hint: tag was not open: '+dbgs(Token)+' at '+PosToStr(FCurP,true));
 
475
  end;
 
476
 
 
477
var
 
478
  i: Integer;
 
479
  Group: TWPTokenGroup;
 
480
  Item: PStackItem;
 
481
begin
 
482
  Result:=false;
 
483
  i:=FStackPtr;
 
484
  Group:=WPTokenInfos[Token].Group;
 
485
  while (i>=0) and (ord(WPTokenInfos[FStack[i].Token].Group) <= ord(Group)) do
 
486
  begin
 
487
    if FStack[i].Token=Token then begin
 
488
      // found
 
489
      while FStackPtr>=i do begin
 
490
        Item:=@FStack[FStackPtr];
 
491
        if (Verbosity>=wpvWarning)
 
492
        and (FStackPtr>i) and (wpifWarnOnAutoClose in WPTokenInfos[Item^.Token].Flags)
 
493
        then
 
494
          LogMissingClose;
 
495
        {$IFDEF VerboseWikiStack}
 
496
        Log('Pop  :'+GetIndentStr(FStackPtr*2)+dbgs(Item^.Token)+' at '+PosToStr(FCurP));
 
497
        {$ENDIF}
 
498
        if Item^.Token in [wptPre,wptPreTag] then
 
499
          dec(FInPre);
 
500
        CloseRangeToken(Item^.Token);
 
501
        dec(FStackPtr);
 
502
      end;
 
503
      exit(true);
 
504
    end;
 
505
    dec(i);
 
506
  end;
 
507
  // not found
 
508
  if Verbosity>=wpvHint then
 
509
    LogNotOpen;
 
510
end;
 
511
 
 
512
procedure TWikiPage.Pop(Index: integer);
 
513
begin
 
514
  if Index<0 then Index:=0;
 
515
  while FStackPtr>=Index do
 
516
    Pop(TopToken);
 
517
end;
 
518
 
 
519
function TWikiPage.TopToken: TWPTokenType;
 
520
begin
 
521
  if FStackPtr>=0 then
 
522
    Result:=FStack[FStackPtr].Token
 
523
  else
 
524
    Result:=wptText;
 
525
end;
 
526
 
 
527
function TWikiPage.FindGroupStackPos(Group: TWPTokenGroup; OrHigher: boolean
 
528
  ): integer;
 
529
var
 
530
  CurGroup: TWPTokenGroup;
 
531
begin
 
532
  Result:=FStackPtr;
 
533
  while (Result>=0) do begin
 
534
    CurGroup:=WPTokenInfos[FStack[Result].Token].Group;
 
535
    if (ord(CurGroup)>=ord(Group)) then begin
 
536
      if (not OrHigher) and (CurGroup<>Group) then
 
537
        exit(-1);
 
538
      exit;
 
539
    end;
 
540
    dec(Result);
 
541
  end;
 
542
end;
 
543
 
 
544
function TWikiPage.FindStackItem(Typ: TWPTokenType): integer;
 
545
begin
 
546
  Result:=FStackPtr;
 
547
  while (Result>=0) and (FStack[Result].Token<>Typ) do dec(Result);
 
548
end;
 
549
 
 
550
procedure TWikiPage.DoToken(Token: TWPToken);
 
551
{$IFDEF VerboseWikiOnToken}
 
552
var
 
553
  i: Integer;
 
554
{$ENDIF}
 
555
begin
 
556
  Token.Token:=WPTokenInfos[Token.SubToken].BaseToken;
 
557
  {$IFDEF VerboseWikiOnToken}
 
558
  i:=FStackPtr;
 
559
  if i<0 then i:=0;
 
560
  Log('Token:'+GetIndentStr(i*2)+dbgs(Token.Token)+' at '+PosToStr(FCurP));
 
561
  {$ENDIF}
 
562
  FOnToken(Token);
 
563
end;
 
564
 
 
565
procedure TWikiPage.EmitTextToken;
 
566
begin
 
567
  if FStackPtr<0 then begin
 
568
    // highest level => skip space at start
 
569
    while (FLastEmitPos<FCurP) and (FLastEmitPos^ in [#1..#32]) do
 
570
      inc(FLastEmitPos);
 
571
  end;
 
572
  if FCurP<=FLastEmitPos then exit;
 
573
 
 
574
  if (FStackPtr<0) or (TopToken=wptSection) then begin
 
575
    // highest level => start a paragraph
 
576
    Push(wptSubSection,FCurP);
 
577
  end;
 
578
  // maybe: add an option and when enabled combine multiple spaces and replace line breaks with space
 
579
  FTextToken.SubToken:=wptText;
 
580
  FTextToken.Range:=wprNone;
 
581
  FTextToken.StartPos:=StrPos(FLastEmitPos);
 
582
  FTextToken.EndPos:=StrPos(FCurP);
 
583
  FLastEmitPos:=FCurP;
 
584
  DoToken(FTextToken);
 
585
end;
 
586
 
 
587
procedure TWikiPage.ParseAttributes(StartPos, EndPos: PChar);
 
588
var
 
589
  p: PChar;
 
590
begin
 
591
  //Log('TWikiPage.ParseAttributes '+PosToStr(StartPos)+' '+PosToStr(EndPos)+' <'+dbgstr(StartPos,EndPos-StartPos),'>');
 
592
  p:=StartPos;
 
593
  repeat
 
594
    // skip whitespace
 
595
    while p^ in [' ',#9,#10,#13] do inc(p);
 
596
    if p>=EndPos then break;
 
597
    // read name
 
598
    if not IsIdentStartChar[p^] then break;
 
599
    FNameValueToken.NameStartPos:=StrPos(p);
 
600
    while IsIdentChar[p^] do inc(p);
 
601
    FNameValueToken.NameEndPos:=StrPos(p);
 
602
    // whitespace
 
603
    while p^ in [' ',#9,#10,#13] do inc(p);
 
604
    if p>=EndPos then break;
 
605
    // =
 
606
    if p^<>'=' then break;
 
607
    inc(p);
 
608
    // whitespace
 
609
    while p^ in [' ',#9,#10,#13] do inc(p);
 
610
    if p>=EndPos then break;
 
611
    // value
 
612
    if p^<>'"' then break;
 
613
    inc(p);
 
614
    FNameValueToken.ValueStartPos:=StrPos(p);
 
615
    while not (p^ in ['"',#0]) do inc(p);
 
616
    if p^<>'"' then break;
 
617
    FNameValueToken.ValueEndPos:=StrPos(p);
 
618
    if p>=EndPos then break;
 
619
    FNameValueToken.SubToken:=wptAttribute;
 
620
    DoToken(FNameValueToken);
 
621
    inc(p);
 
622
  until p>=EndPos;
 
623
  //Log(['TWikiPage.ParseAttributes stopped at <'+dbgstr(StartPos,p-StartPos)+'>');
 
624
end;
 
625
 
 
626
procedure TWikiPage.ParseNoWiki;
 
627
begin
 
628
  // ignore all tags
 
629
  // this is not the same as pre (preformatted treats spaces and line breaks)
 
630
  EmitTextToken;
 
631
  FCurP:=FindTagEnd(FCurP);
 
632
  FLastEmitPos:=FCurP;
 
633
  repeat
 
634
    case FCurP^ of
 
635
    #0: break;
 
636
    '<':
 
637
      if TokenIs('</nowiki>') then
 
638
        break;
 
639
    end;
 
640
    inc(FCurP);
 
641
  until false;
 
642
  EmitTextToken;
 
643
  FCurP:=FindTagEnd(FCurP);
 
644
  FLastEmitPos:=FCurP;
 
645
end;
 
646
 
 
647
procedure TWikiPage.CloseTableCell;
 
648
var
 
649
  t: TWPTokenType;
 
650
begin
 
651
  while FStackPtr>=0 do begin
 
652
    t:=TopToken;
 
653
    if (t in [wptTableCell,wptTableHeadCell])
 
654
    or (WPTokenInfos[t].Group<wpgTable) then
 
655
      Pop(t)
 
656
    else
 
657
      exit;
 
658
  end;
 
659
end;
 
660
 
 
661
function TWikiPage.TrimLink(const Link: string): string;
 
662
begin
 
663
  Result:=UTF8Trim(Link);
 
664
end;
 
665
 
 
666
function TWikiPage.CurrentPos: integer;
 
667
begin
 
668
  Result:=StrPos(FCurP);
 
669
end;
 
670
 
 
671
procedure TWikiPage.Log(Msg: string);
 
672
begin
 
673
  if Assigned(OnLog) then
 
674
    OnLog(Msg)
 
675
  else
 
676
    debugln(Msg);
 
677
end;
 
678
 
 
679
procedure TWikiPage.CloseRangeToken(Typ: TWPTokenType);
 
680
begin
 
681
  FRangeToken.SubToken:=Typ;
 
682
  FRangeToken.Range:=wprClose;
 
683
  DoToken(FRangeToken);
 
684
end;
 
685
 
 
686
procedure TWikiPage.OpenRangeToken(Typ: TWPTokenType);
 
687
begin
 
688
  FRangeToken.SubToken:=Typ;
 
689
  FRangeToken.Range:=wprOpen;
 
690
  DoToken(FRangeToken);
 
691
end;
 
692
 
 
693
function TWikiPage.FindTagEnd(TagStart: PChar): PChar;
 
694
begin
 
695
  Result:=TagStart;
 
696
  if Result^='<' then inc(Result);
 
697
  if Result^='/' then inc(Result);
 
698
  while IsWikiTagChar[Result^] do inc(Result);
 
699
  while Result^<>#0 do begin
 
700
    case Result^ of
 
701
    #0,'<','>','/': break;
 
702
    '"':
 
703
      repeat
 
704
        inc(Result);
 
705
      until Result^ in ['"','>','<',#0];
 
706
    '''':
 
707
      repeat
 
708
        inc(Result);
 
709
      until Result^ in ['''','>','<',#0];
 
710
    else
 
711
      inc(Result);
 
712
    end;
 
713
  end;
 
714
  if Result^='/' then inc(Result);
 
715
  if Result^='>' then inc(Result);
 
716
end;
 
717
 
 
718
procedure TWikiPage.HandleUnderScore;
 
719
begin
 
720
  if (FCurP[1]='_') and (AtLineStart(FCurP)) and TokenIs('__TOC__') then begin
 
721
    EmitTextToken;
 
722
    inc(FCurP, length('__TOC__'));
 
723
    FLastEmitPos:=FCurP;
 
724
  end else
 
725
   inc(FCurP);
 
726
end;
 
727
 
 
728
procedure TWikiPage.HandleEqual;
 
729
var
 
730
  Depth: Integer;
 
731
  i: Integer;
 
732
  OldDepth: Integer;
 
733
  t: TWPTokenType;
 
734
begin
 
735
  if (FInPre>0) then begin
 
736
    inc(FCurP);
 
737
    exit;
 
738
  end;
 
739
  // header => close section(s), start new section
 
740
  Depth:=1;
 
741
  while (Depth<MaxHeaderDepth) and (FCurP[Depth]='=') do inc(Depth);
 
742
 
 
743
  i:=0;
 
744
  OldDepth:=0;
 
745
  while (i<=FStackPtr) do begin
 
746
    t:=FStack[i].Token;
 
747
    if t=wptSection then
 
748
      inc(OldDepth)
 
749
    else if t=wptHeader then begin
 
750
      // this is the end of the header
 
751
      EmitTextToken;
 
752
      Pop(t);
 
753
      inc(FCurP,Depth);
 
754
      FLastEmitPos:=FCurP;
 
755
      exit;
 
756
    end;
 
757
    inc(i);
 
758
  end;
 
759
  // maybe new header
 
760
  //Log(['HandleHeader START '+PosToStr(FCurP)+' '+AtLineStart(FCurP));
 
761
  if not AtLineStart(FCurP) then begin
 
762
    // normal =
 
763
    inc(FCurP);
 
764
    exit;
 
765
  end;
 
766
  EmitTextToken;
 
767
 
 
768
  // close section(s)
 
769
  while (FStackPtr>=0) and (OldDepth>=Depth) do begin
 
770
    if FStack[FStackPtr].Token=wptSection then
 
771
      dec(OldDepth);
 
772
    Pop(TopToken);
 
773
  end;
 
774
  // start new section(s) (it is allowed to start a subsubsection without a subsection)
 
775
  for i:=OldDepth+1 to Depth do
 
776
    Push(wptSection,FCurP);
 
777
  // start header
 
778
  Push(wptHeader,FCurP);
 
779
  inc(FCurP,Depth);
 
780
  FLastEmitPos:=FCurP;
 
781
end;
 
782
 
 
783
procedure TWikiPage.HandleListChar;
 
784
 
 
785
  function CharToListType(c: char): TWPTokenType;
 
786
  begin
 
787
    case c of
 
788
    '*': Result:=wptBulletList;
 
789
    '#': Result:=wptNumberedList;
 
790
    ':',';': Result:=wptDefinitionList;
 
791
    else Result:=wptText;
 
792
    end;
 
793
  end;
 
794
 
 
795
var
 
796
  NewDepth: Integer;
 
797
  i: Integer;
 
798
  CurDepth: Integer;
 
799
begin
 
800
  if (not AtLineStart(FCurP)) or (FInPre>0) then begin
 
801
    inc(FCurP);
 
802
    exit;
 
803
  end;
 
804
  EmitTextToken;
 
805
  NewDepth:=1;
 
806
  while FCurP[NewDepth] in ['*','#',':',';'] do inc(NewDepth);
 
807
 
 
808
  // a list closes all fonts and spans => skip all fonts and spans
 
809
  i:=FindGroupStackPos(wpgList,true);
 
810
  // check all lists with wiki syntax, keep lists with html syntax
 
811
  while (i>=0)
 
812
  and (FStack[i].Token in WPTWikiLists) do
 
813
    dec(i);
 
814
  inc(i);
 
815
  CurDepth:=0;
 
816
  while (CurDepth<NewDepth) do begin
 
817
    // compare old list hierarchy with new list hierarchy
 
818
    if (i>FStackPtr) or (FStack[i].Token<>CharToListType(FCurP[CurDepth])) then begin
 
819
      {dbgout(['TWikiPage.HandleListChar listtype does not fit: i=',i,' CurDepth=',CurDepth,' should=',dbgs(CharToListType(FCurP[CurDepth]))]);
 
820
      if i<=FStackPtr then dbgout(' is=',dbgs(FStack[i].Token));
 
821
      debugln;}
 
822
      // does not fit
 
823
      Pop(i);
 
824
      // start new list
 
825
      EmitFlag(CharToListType(FCurP[CurDepth]),wprOpen,0);
 
826
    end;
 
827
    inc(i);
 
828
    inc(CurDepth);
 
829
    if CurDepth=NewDepth then begin
 
830
      // close fonts, spans and previous list item
 
831
      //Log('TWikiPage.HandleListChar close fonts, spans, listitem');
 
832
      Pop(i);
 
833
    end;
 
834
    if (i>FStackPtr) then
 
835
      EmitFlag(wptListItem,wprOpen,0); // new list item
 
836
    if FStack[i].Token<>wptListItem then
 
837
      raise Exception.Create('broken list: should='+dbgs(wptListItem)+' is='+dbgs(FStack[i].Token));
 
838
    inc(i);
 
839
  end;
 
840
 
 
841
  inc(FCurP,NewDepth);
 
842
  FLastEmitPos:=FCurP;
 
843
end;
 
844
 
 
845
procedure TWikiPage.HandleSpace;
 
846
var
 
847
  NonSpace: PChar;
 
848
begin
 
849
  if (not AtLineStart(FCurP)) or (FInPre>0) then begin
 
850
    inc(FCurP);
 
851
    exit;
 
852
  end;
 
853
  NonSpace:=FCurP;
 
854
  while (NonSpace^ in [' ',#9]) do inc(NonSpace);
 
855
  if NonSpace^ in [#10,#13,#0] then begin
 
856
    // empty line
 
857
    inc(FCurP);
 
858
    exit;
 
859
  end;
 
860
  // preformatted text
 
861
  //Log('TWikiPage.HandleSpace start pre "'+dbgstr(GetLineInSrc(Src,StrPos(FCurP)))+'"');
 
862
  // ToDo: flags
 
863
  EmitFlag(wptPre,wprOpen,1);
 
864
  repeat
 
865
    while not (FCurP^ in [#10,#13,#0]) do inc(FCurP);
 
866
    EmitTextToken;
 
867
    if FCurP^=#0 then break;
 
868
    if (FCurP[1] in [#10,#13]) and (FCurP^<>FCurP[1]) then
 
869
      inc(FCurP,2)
 
870
    else
 
871
      inc(FCurP);
 
872
    if FCurP^<>' ' then break;
 
873
    // next line is also preformatted
 
874
    inc(FCurP);
 
875
    //Log('TWikiPage.HandleSpace line break');
 
876
    FLastEmitPos:=FCurP;
 
877
    EmitFlag(wptLineBreak,wprNone,0);
 
878
  until false;
 
879
  //Log('TWikiPage.HandleSpace end pre');
 
880
  FLastEmitPos:=FCurP;
 
881
  EmitFlag(wptPre,wprClose,0);
 
882
end;
 
883
 
 
884
procedure TWikiPage.HandleCurlyBracketOpen;
 
885
begin
 
886
  if (FCurP[1]='{') and (FInPre=0) then begin
 
887
    // {{special}} or {{name|special}}
 
888
    EmitTextToken;
 
889
    inc(FCurP,2);
 
890
    FNameValueToken.NameStartPos:=StrPos(FCurP);
 
891
    repeat
 
892
      case FCurP^ of
 
893
      #0..#31,'|': break;
 
894
      '}': if FCurP[1]='}' then break;
 
895
      end;
 
896
      inc(FCurP);
 
897
    until false;
 
898
    if FCurP^='|' then begin
 
899
      FNameValueToken.NameEndPos:=StrPos(FCurP);
 
900
      inc(FCurP);
 
901
      FNameValueToken.ValueStartPos:=StrPos(FCurP);
 
902
    end else begin
 
903
      FNameValueToken.NameEndPos:=FNameValueToken.NameStartPos;
 
904
      FNameValueToken.ValueStartPos:=FNameValueToken.NameStartPos;
 
905
    end;
 
906
    repeat
 
907
      case FCurP^ of
 
908
      #0..#31: break;
 
909
      '}': if FCurP[1]='}' then break;
 
910
      end;
 
911
      inc(FCurP);
 
912
    until false;
 
913
    FNameValueToken.ValueEndPos:=StrPos(FCurP);
 
914
    if FCurP^='}' then inc(FCurP,2);
 
915
    FLastEmitPos:=FCurP;
 
916
    FNameValueToken.SubToken:=wptSpecial;
 
917
    DoToken(FNameValueToken);
 
918
  end else if (FCurP[1]='|') and AtLineStart(FCurP) and (FInPre=0) then begin
 
919
    // {| table
 
920
    EmitTextToken;
 
921
    EmitFlag(wptTable,wprOpen,2);
 
922
    // rest of line are attributes
 
923
    while not (FCurP^ in [#0,#10,#13]) do inc(FCurP);
 
924
    ParseAttributes(FLastEmitPos,FCurP);
 
925
    while FCurP^ in [#10,#13] do inc(FCurP);
 
926
    if (FCurP^='|') and (FCurP[1]='+') then begin
 
927
      // table caption
 
928
      FLastEmitPos:=FCurP;
 
929
      EmitFlag(wptTableRow,wprOpen,2);
 
930
      EmitFlag(wptTableHeadCell,wprOpen,0);
 
931
    end;
 
932
    FLastEmitPos:=FCurP;
 
933
  end else
 
934
    inc(FCurP);
 
935
end;
 
936
 
 
937
procedure TWikiPage.HandlePipe;
 
938
var
 
939
  i: Integer;
 
940
begin
 
941
  i:=FindGroupStackPos(wpgTable,false);
 
942
  if i>=0 then begin
 
943
    // in a table
 
944
    if AtLineStart(FCurP) then begin
 
945
      if (FCurP[1]='-') then begin
 
946
        // new row
 
947
        CloseTableCell;
 
948
        if TopToken=wptTableRow then
 
949
          Pop(wptTableRow);
 
950
        EmitFlag(wptTableRow,wprOpen,2);
 
951
        while FCurP^='-' do inc(FCurP);
 
952
        FLastEmitPos:=FCurP;
 
953
        // attributes
 
954
        while not (FCurP^ in [#0,#10,#13]) do inc(FCurP);
 
955
        ParseAttributes(FLastEmitPos,FCurP);
 
956
        FLastEmitPos:=FCurP;
 
957
        exit;
 
958
      end else if FCurP[1]='}' then begin
 
959
        // |} end of table
 
960
        EmitFlag(wptTable,wprClose,2);
 
961
        exit;
 
962
      end;
 
963
    end;
 
964
    if AtLineStart(FCurP) or (FCurP[1]='|') then begin
 
965
      ParseCell;
 
966
      exit;
 
967
    end;
 
968
  end;
 
969
  inc(FCurP);
 
970
end;
 
971
 
 
972
procedure TWikiPage.HandleExclamationMark;
 
973
var
 
974
  i: Integer;
 
975
begin
 
976
  i:=FindGroupStackPos(wpgTable,false);
 
977
  if i>=0 then begin
 
978
    // in a table
 
979
    if AtLineStart(FCurP) then begin
 
980
      ParseCell;
 
981
      exit;
 
982
    end;
 
983
  end;
 
984
  inc(FCurP);
 
985
end;
 
986
 
 
987
procedure TWikiPage.HandleApostroph;
 
988
begin
 
989
  if FCurP[1]='''' then begin
 
990
    if FCurP[2]='''' then begin
 
991
      // bold
 
992
      EmitToggle(wptBold, 3);
 
993
    end else begin
 
994
      // italic
 
995
      EmitToggle(wptItalic, 2);
 
996
    end;
 
997
  end else begin
 
998
    // normal apostroph
 
999
    inc(FCurP);
 
1000
  end;
 
1001
end;
 
1002
 
 
1003
procedure TWikiPage.HandleEdgedBracketOpen;
 
1004
var
 
1005
  p: PChar;
 
1006
begin
 
1007
  if FCurP[1] in [#0..#31,' '] then begin
 
1008
    inc(FCurP);
 
1009
    exit;
 
1010
  end;
 
1011
  EmitTextToken;
 
1012
  inc(FCurP);
 
1013
  // link
 
1014
  if FCurP^='[' then begin
 
1015
    // internal link
 
1016
    // for example [[url|caption]]
 
1017
    inc(FCurP);
 
1018
    FLinkToken.SubToken:=wptInternLink;
 
1019
    FLinkToken.LinkStartPos:=StrPos(FCurP);
 
1020
    while not (FCurP^ in [#0..#31, '|', ']']) do inc(FCurP);
 
1021
    FLinkToken.LinkEndPos:=StrPos(FCurP);
 
1022
    FLinkToken.Link:=TrimLink(copy(Src,FLinkToken.LinkStartPos,FLinkToken.LinkEndPos-FLinkToken.LinkStartPos));
 
1023
    FLinkToken.CaptionStartPos:=FLinkToken.LinkStartPos;
 
1024
    FLinkToken.CaptionEndPos:=FLinkToken.LinkEndPos;
 
1025
  end else begin
 
1026
    // external link
 
1027
    // for example [url|caption] or [url caption]
 
1028
    p:=FCurP;
 
1029
    if not IsIdentStartChar[p^] then exit; // not a valid scheme
 
1030
    inc(p);
 
1031
    while IsIdentChar[p^] do inc(p);
 
1032
    if (p^<>':') or (p[1]<>'/') or (p[2]<>'/') then exit; // not a valid scheme
 
1033
    FLinkToken.SubToken:=wptExternLink;
 
1034
    FLinkToken.LinkStartPos:=StrPos(FCurP);
 
1035
    while not (FCurP^ in [#0..#31, ' ' , '|' , ']']) do inc(FCurP);
 
1036
    FLinkToken.LinkEndPos:=StrPos(FCurP);
 
1037
    FLinkToken.Link:=TrimLink(copy(Src,FLinkToken.LinkStartPos,FLinkToken.LinkEndPos-FLinkToken.LinkStartPos));
 
1038
    if FCurP^=' ' then begin
 
1039
      // separate caption
 
1040
      inc(FCurP);
 
1041
      FLinkToken.CaptionStartPos:=StrPos(FCurP);
 
1042
      while not (FCurP^ in [#0..#31, '|', ']']) do inc(FCurP);
 
1043
      FLinkToken.CaptionEndPos:=StrPos(FCurP);
 
1044
    end else begin
 
1045
      // caption = URL
 
1046
      FLinkToken.CaptionStartPos:=FLinkToken.LinkStartPos;
 
1047
      FLinkToken.CaptionEndPos:=FLinkToken.LinkEndPos;
 
1048
    end;
 
1049
  end;
 
1050
 
 
1051
  if (BaseURL<>'')
 
1052
  and (LeftStr(FLinkToken.Link,length(BaseURL))=BaseURL) then begin
 
1053
    // a link to a wiki page, but with full URL => shorten
 
1054
    FLinkToken.SubToken:=wptInternLink;
 
1055
    Delete(FLinkToken.Link,1,length(BaseURL));
 
1056
    while (FLinkToken.Link<>'') and (FLinkToken.Link[1]='/') do
 
1057
      Delete(FLinkToken.Link,1,1);
 
1058
  end;
 
1059
 
 
1060
  if FCurP^='|' then begin
 
1061
    // link with caption
 
1062
    inc(FCurP);
 
1063
    FLinkToken.CaptionStartPos:=StrPos(FCurP);
 
1064
    while not (FCurP^ in [#0..#31, ']']) do inc(FCurP);
 
1065
    FLinkToken.CaptionEndPos:=StrPos(FCurP);
 
1066
  end;
 
1067
  if FCurP^=']' then begin
 
1068
    inc(FCurP);
 
1069
    if (FLinkToken.SubToken=wptInternLink) and (FCurP^=']') then
 
1070
      inc(FCurP);
 
1071
 
 
1072
 
 
1073
    DoToken(FLinkToken);
 
1074
  end;
 
1075
  FLastEmitPos:=FCurP;
 
1076
 
 
1077
  // ToDo: implement postfix notation [[url]]caption and [[url]]''caption''
 
1078
 
 
1079
end;
 
1080
 
 
1081
procedure TWikiPage.ParseCell;
 
1082
var
 
1083
  NextBar: PChar;
 
1084
begin
 
1085
  // linestart | or linestart ! or ||
 
1086
  // => new cell
 
1087
  // => close previous cell
 
1088
  EmitTextToken;
 
1089
  CloseTableCell;
 
1090
  if TopToken=wptTable then
 
1091
    EmitFlag(wptTableRow, wprOpen, 0);
 
1092
  if AtLineStart(FCurP) then
 
1093
    EmitFlag(wptTableCell, wprOpen, 1) // linestart | or linestart !
 
1094
  else
 
1095
    EmitFlag(wptTableCell, wprOpen, 2); // ||
 
1096
  NextBar:=FCurP;
 
1097
  while not (NextBar^ in [#0, #10, #13, '|']) do begin
 
1098
    if NextBar^='[' then begin
 
1099
      // a link
 
1100
      break;
 
1101
    end else if (NextBar^='<') and IsIdentStartChar[NextBar[1]] then begin
 
1102
      // a tag
 
1103
      break;
 
1104
    end;
 
1105
    inc(NextBar);
 
1106
  end;
 
1107
  if (NextBar^='|') and (NextBar[1]<>'|') then begin
 
1108
    // the text in front of the first single | are attributes
 
1109
    ParseAttributes(FCurP, NextBar);
 
1110
    FCurP:=NextBar+1;
 
1111
  end;
 
1112
  FLastEmitPos:=FCurP;
 
1113
end;
 
1114
 
 
1115
procedure TWikiPage.HandleAngleBracket;
 
1116
 
 
1117
  procedure UnknownTag;
 
1118
  begin
 
1119
    // unknown tag
 
1120
    if Verbosity>=wpvWarning then begin
 
1121
      if IsWikiTagStartChar[FCurP[1]] then begin
 
1122
        {$IFDEF VerboseUnknownOpenTags}
 
1123
        Log('WARNING: TWikiPage.Parse unknown opening tag: <'+GetIdentifier(FCurP+1)+'> at '+PosToStr(FCurP,true));
 
1124
        {$ENDIF}
 
1125
      end else if (FCurP[1]='/') and IsWikiTagStartChar[FCurP[2]] then
 
1126
        Log('WARNING: TWikiPage.Parse unknown closing tag: </'+GetIdentifier(FCurP+2)+'> at '+PosToStr(FCurP,true))
 
1127
      else
 
1128
        Log('WARNING: TWikiPage.Parse broken close tag at '+PosToStr(FCurP,true));
 
1129
    end;
 
1130
    inc(FCurP);
 
1131
  end;
 
1132
 
 
1133
var
 
1134
  TagEndP: PChar;
 
1135
  Range: TWPTokenRange;
 
1136
  NameP: PChar;
 
1137
begin
 
1138
  NameP:=FCurP+1;
 
1139
  if NameP^='/' then begin
 
1140
    Range:=wprClose;
 
1141
    inc(NameP);
 
1142
  end else
 
1143
    Range:=wprOpen;
 
1144
  if IsWikiTagStartChar[NameP^] then begin
 
1145
    TagEndP:=FindTagEnd(FCurP);
 
1146
    if ((TagEndP-1)^='>') and ((TagEndP-2)^='/') then begin
 
1147
      // e.g. <br/>
 
1148
      if CompareIdentifiers(NameP,'br')=0 then EmitTag(wptLineBreak,
 
1149
        wprNone)
 
1150
      else if CompareIdentifiers(NameP,'p')=0 then EmitTag(wptPTag,
 
1151
        wprNone)
 
1152
      else UnknownTag;
 
1153
    end
 
1154
    else if CompareIdentifiers(NameP,'br')=0 then EmitTag(wptLineBreak, wprNone)
 
1155
    else if CompareIdentifiers(NameP,'b')=0 then EmitTag(wptBoldTag,Range)
 
1156
    else if CompareIdentifiers(NameP,'i')=0 then EmitTag(wptItalicTag,Range)
 
1157
    else if CompareIdentifiers(NameP,'u')=0 then EmitTag(wptUnderlineTag,Range)
 
1158
    else if CompareIdentifiers(NameP,'s')=0 then EmitTag(wptStrikeTagShort, Range)
 
1159
    else if CompareIdentifiers(NameP,'strike')=0 then EmitTag(wptStrikeTagLong, Range)
 
1160
    else if CompareIdentifiers(NameP,'tt')=0 then EmitTag(wptTT,Range)
 
1161
    else if CompareIdentifiers(NameP,'sup')=0 then EmitTag(wptSup,Range)
 
1162
    else if CompareIdentifiers(NameP,'sub')=0 then EmitTag(wptSub,Range)
 
1163
    else if CompareIdentifiers(NameP,'small')=0 then EmitTag(wptSmall,Range)
 
1164
    else if CompareIdentifiers(NameP,'em')=0 then EmitTag(wptEm,Range)
 
1165
    else if CompareIdentifiers(NameP,'string')=0 then EmitTag(wptString, Range)
 
1166
    else if CompareIdentifiers(NameP,'var')=0 then EmitTag(wptVar,Range)
 
1167
    else if CompareIdentifiers(NameP,'key')=0 then EmitTag(wptKey,Range)
 
1168
    else if CompareIdentifiers(NameP,'cmt')=0 then EmitTag(wptCmt,Range)
 
1169
    else if CompareIdentifiers(NameP,'span')=0 then EmitTag(wptSpan,Range)
 
1170
    else if CompareIdentifiers(NameP,'p')=0 then EmitTag(wptPTag,Range)
 
1171
    else if CompareIdentifiers(NameP,'div')=0 then EmitTag(wptDivTag,Range)
 
1172
    else if CompareIdentifiers(NameP,'pre')=0 then EmitTag(wptPreTag,Range)
 
1173
    else if CompareIdentifiers(NameP,'center')=0 then EmitTag(wptCenter,Range)
 
1174
    else if CompareIdentifiers(NameP,'ol')=0 then EmitTag(wptOrderedListTag,Range)
 
1175
    else if CompareIdentifiers(NameP,'ul')=0 then EmitTag(wptUnorderedListTag,Range)
 
1176
    else if (CompareIdentifiers(NameP,'li')=0) and (TopToken in [wptOrderedListTag,wptUnorderedListTag])
 
1177
    then EmitTag(wptUnorderedListTag, Range)
 
1178
    else if CompareIdentifiers(NameP,'table')=0 then EmitTag(wptTableTag,Range)
 
1179
    else if CompareIdentifiers(NameP,'tr')=0 then EmitTag(wptTableRowTag,Range)
 
1180
    else if CompareIdentifiers(NameP,'td')=0 then EmitTag(wptTableCellTag,Range)
 
1181
    else if CompareIdentifiers(NameP,'th')=0 then EmitTag(wptTableHeadCellTag,Range)
 
1182
    else if CompareIdentifiers(NameP,'h1')=0 then EmitTag(wptHeader1,Range)
 
1183
    else if CompareIdentifiers(NameP,'h2')=0 then EmitTag(wptHeader2,Range)
 
1184
    else if CompareIdentifiers(NameP,'h3')=0 then EmitTag(wptHeader3,Range)
 
1185
    else if (Range=wprOpen)
 
1186
        and (FLanguageTags<>nil)
 
1187
        and FLanguageTags.DoIdentifier(NameP)
 
1188
    then begin
 
1189
      // special parse for different language
 
1190
      //Log('TWikiPage.Parse code tag '+dbgs(Pointer(FCurP))+' tag='+GetIdentifier(NameP)+' '+FindTagEnd(FCurP)-FCurP);
 
1191
      HandleCode;
 
1192
    end else if TokenIs('<nowiki>') then begin
 
1193
      ParseNoWiki;
 
1194
    end else begin
 
1195
      UnknownTag;
 
1196
    end;
 
1197
  end else begin
 
1198
    // normal <
 
1199
    inc(FCurP);
 
1200
  end;
 
1201
end;
 
1202
 
 
1203
procedure TWikiPage.HandleCode;
 
1204
var
 
1205
  p: PChar;
 
1206
  NameP: PChar;
 
1207
begin
 
1208
  if (FCurP^<>'<') or (not IsIdentStartChar[FCurP[1]]) then begin
 
1209
    inc(FCurP);
 
1210
    exit;
 
1211
  end;
 
1212
  EmitTextToken;
 
1213
  p:=FCurP+1;
 
1214
  NameP:=p;
 
1215
  // by default the lange is the tag, e.g. "pascal" of <pascal>
 
1216
  FNameValueToken.NameStartPos:=StrPos(p);
 
1217
  while IsIdentChar[p^] do inc(p);
 
1218
  FNameValueToken.NameEndPos:=StrPos(p);
 
1219
  while p^ in [' ',#9,#10,#13] do inc(p);
 
1220
  if CompareIdentifiers(p,'lang')=0 then begin
 
1221
    // read language from lang attribute
 
1222
    // e.g. <code lang=pascal">
 
1223
    inc(p,4);
 
1224
    while p^ in [' ',#9,#10,#13] do inc(p);
 
1225
    if p^='=' then begin
 
1226
      inc(p);
 
1227
      while p^ in [' ',#9,#10,#13] do inc(p);
 
1228
      if p^='"' then begin
 
1229
        inc(p);
 
1230
        FNameValueToken.NameStartPos:=StrPos(p);
 
1231
        while not (p^ in ['"',#0,'<','>']) do inc(p);
 
1232
        FNameValueToken.NameEndPos:=StrPos(p);
 
1233
        inc(p);
 
1234
      end;
 
1235
    end;
 
1236
  end;
 
1237
  p:=FindTagEnd(FCurP);
 
1238
  FNameValueToken.ValueStartPos:=StrPos(p);
 
1239
  repeat
 
1240
    case p^ of
 
1241
    #0:
 
1242
      break;
 
1243
    '<':
 
1244
      if (p[1]='/') and (CompareIdentifiers(NameP, p+2)=0) then
 
1245
        break;
 
1246
    end;
 
1247
    inc(p);
 
1248
  until false;
 
1249
  FNameValueToken.ValueEndPos:=StrPos(p);
 
1250
  FCurP:=FindTagEnd(p);
 
1251
  FNameValueToken.SubToken:=wptCode;
 
1252
  //Log('TWikiPage.HandleCode name="'+copy(Src,FNameValueToken.NameStartPos,FNameValueToken.NameEndPos-FNameValueToken.NameStartPos)+'"');
 
1253
  DoToken(FNameValueToken);
 
1254
  FLastEmitPos:=FCurP;
 
1255
end;
 
1256
 
 
1257
procedure TWikiPage.EmitFlag(Typ: TWPTokenType; Range: TWPTokenRange;
 
1258
  TagLen: integer);
 
1259
begin
 
1260
  EmitTextToken;
 
1261
  if ord(WPTokenInfos[Typ].Group)>ord(wpgFont) then begin
 
1262
    // auto close paragraph
 
1263
    while TopToken=wptP do
 
1264
      Pop(wptP);
 
1265
  end else if (Range=wprOpen) and (WPTokenInfos[Typ].Group=wpgFont) then begin
 
1266
    // font changes
 
1267
    if (FStackPtr<0) or (TopToken=wptSection) then begin
 
1268
      // highest level => start a sub section
 
1269
      Push(wptSubSection,FCurP);
 
1270
    end;
 
1271
  end;
 
1272
  if Range=wprOpen then begin
 
1273
    Push(Typ,FCurP);
 
1274
  end
 
1275
  else if Range=wprClose then
 
1276
    Pop(Typ)
 
1277
  else begin
 
1278
    FRangeToken.SubToken:=Typ;
 
1279
    FRangeToken.Range:=Range;
 
1280
    DoToken(FRangeToken);
 
1281
  end;
 
1282
  inc(FCurP,TagLen);
 
1283
  FLastEmitPos:=FCurP;
 
1284
end;
 
1285
 
 
1286
procedure TWikiPage.EmitToggle(Typ: TWPTokenType; TagLen: integer);
 
1287
var
 
1288
  i: Integer;
 
1289
begin
 
1290
  EmitTextToken;
 
1291
  i:=FStackPtr;
 
1292
  while (i>=0) do begin
 
1293
    if FStack[i].Token=Typ then begin
 
1294
      // disable
 
1295
      Pop(Typ);
 
1296
      break;
 
1297
    end;
 
1298
    if (WPTokenInfos[FStack[i].Token].Group<>wpgFont) then begin
 
1299
      // toggles can only skip the font group
 
1300
      i:=-1;
 
1301
      break;
 
1302
    end;
 
1303
    dec(i);
 
1304
  end;
 
1305
  if i<0 then begin
 
1306
    // enable
 
1307
    Push(Typ,FCurP);
 
1308
  end;
 
1309
  inc(FCurP,TagLen);
 
1310
  FLastEmitPos:=FCurP;
 
1311
end;
 
1312
 
 
1313
procedure TWikiPage.EmitTag(Typ: TWPTokenType; Range: TWPTokenRange);
 
1314
 
 
1315
  function GetAttributesStart: PChar;
 
1316
  var
 
1317
    p: PChar;
 
1318
  begin
 
1319
    Result:=nil;
 
1320
    p:=FCurP;
 
1321
    if p^<>'<' then exit;
 
1322
    inc(p);
 
1323
    while IsWikiTagChar[p^] do inc(p);
 
1324
    while p^ in [' ',#9] do inc(p); // wiki does not allow multiline attributes
 
1325
    if not IsWikiTagChar[p^] then exit;
 
1326
    Result:=p;
 
1327
  end;
 
1328
 
 
1329
var
 
1330
  p: PChar;
 
1331
  StartPos: PChar;
 
1332
begin
 
1333
  if Range<>wprClose then begin
 
1334
    StartPos:=GetAttributesStart;
 
1335
    if StartPos<>nil then begin
 
1336
      // has attributes
 
1337
      p:=StartPos;
 
1338
      while not (p^ in [#0,#10,#13,'>']) do inc(p);
 
1339
      if p^='>' then
 
1340
        inc(p);
 
1341
      EmitFlag(Typ,wprOpen,p-FCurP);
 
1342
      ParseAttributes(StartPos,p);
 
1343
      if Range=wprNone then
 
1344
        Pop(Typ);
 
1345
      exit;
 
1346
    end;
 
1347
  end;
 
1348
  // has no attributes
 
1349
  EmitFlag(Typ,Range,FindTagEnd(FCurP)-FCurP);
 
1350
end;
 
1351
 
 
1352
procedure TWikiPage.EmitLineBreak;
 
1353
begin
 
1354
  if FCurP[1] in [#10,#13] then
 
1355
    EmitFlag(wptLineBreak,wprNone,2)
 
1356
  else
 
1357
    EmitFlag(wptLineBreak,wprNone,1);
 
1358
  inc(FLine);
 
1359
end;
 
1360
 
 
1361
constructor TWikiPage.Create;
 
1362
begin
 
1363
  FStackPtr:=-1;
 
1364
  Verbosity:=wpvHint;
 
1365
end;
 
1366
 
 
1367
destructor TWikiPage.Destroy;
 
1368
begin
 
1369
  ClearStack;
 
1370
  inherited Destroy;
 
1371
end;
 
1372
 
 
1373
procedure TWikiPage.LoadFromFile(Filename: string);
 
1374
var
 
1375
  doc: TXMLDocument;
 
1376
begin
 
1377
  doc:=nil;
 
1378
  try
 
1379
    ReadXMLFile(doc,Filename);
 
1380
    LoadFromDoc(doc);
 
1381
  finally
 
1382
    doc.Free;
 
1383
  end;
 
1384
end;
 
1385
 
 
1386
procedure TWikiPage.LoadFromDoc(doc: TDOMNode);
 
1387
var
 
1388
  Node: TDOMNode;
 
1389
  ParentName: DOMString;
 
1390
  GrandParentName: String;
 
1391
  Data: DOMString;
 
1392
  p: Integer;
 
1393
begin
 
1394
  for Node in doc.GetEnumeratorAllChildren do begin
 
1395
    ParentName:='';
 
1396
    GrandParentName:='';
 
1397
    if Node.ParentNode is TDOMElement then begin
 
1398
      ParentName:=TDOMElement(Node.ParentNode).TagName;
 
1399
      if Node.ParentNode.ParentNode is TDOMElement then
 
1400
        GrandParentName:=TDOMElement(Node.ParentNode.ParentNode).TagName;
 
1401
    end;
 
1402
    if Node is TDOMText then begin
 
1403
      Data:=TDOMText(Node).Data;
 
1404
      if (GrandParentName='page') then begin
 
1405
        if ParentName='id' then
 
1406
          ID:=Data
 
1407
        else if ParentName='title' then
 
1408
          Title:=Data;
 
1409
      end else if GrandParentName='revision' then begin
 
1410
        if ParentName='id' then
 
1411
          Revision:=Data
 
1412
        else if ParentName='timestamp' then
 
1413
          TimeStamp:=Data
 
1414
        else if ParentName='text' then
 
1415
          Src:=Data;
 
1416
      end else if (ParentName='base') and (GrandParentName='siteinfo') then begin
 
1417
        p:=length(Data);
 
1418
        while (p>=1) and (Data[p]<>'/') do dec(p);
 
1419
        BaseURL:=copy(Data,1,p-1);
 
1420
      end;
 
1421
    end;
 
1422
  end;
 
1423
end;
 
1424
 
 
1425
procedure TWikiPage.Parse(const OnToken: TWikiTokenEvent; Data: Pointer);
 
1426
begin
 
1427
  if FSrc='' then exit;
 
1428
  FOnToken:=OnToken;
 
1429
  FCurP:=PChar(FSrc);
 
1430
  FLine:=1;
 
1431
  FLastEmitPos:=FCurP;
 
1432
  ClearStack;
 
1433
  try
 
1434
    FTextToken:=TWPTextToken.Create(Self,Data);
 
1435
    FRangeToken:=TWPToken.Create(Self,Data);
 
1436
    FLinkToken:=TWPLinkToken.Create(Self,Data);
 
1437
    FNameValueToken:=TWPNameValueToken.Create(Self,Data);
 
1438
    while FCurP^<>#0 do begin
 
1439
      case FCurP^ of
 
1440
 
 
1441
      '\':
 
1442
        begin
 
1443
          // special character as normal character
 
1444
          EmitTextToken;
 
1445
          inc(FCurP);
 
1446
          FLastEmitPos:=FCurP;
 
1447
          if FCurP^<>#0 then inc(FCurP);
 
1448
        end;
 
1449
 
 
1450
      #10,#13:
 
1451
        begin
 
1452
          EmitTextToken;
 
1453
          if (FCurP[1] in [#10,#13]) and (FCurP^<>FCurP[1]) then
 
1454
            inc(FCurP,2)
 
1455
          else
 
1456
            inc(FCurP);
 
1457
          if FCurP^ in [#10,#13] then begin
 
1458
            // empty line(s) closes lists, paragraphs and subsections
 
1459
            while TopToken in ([wptP,wptSubSection]+WPTWikiLists) do
 
1460
              Pop(TopToken);
 
1461
            while FCurP^ in [#10,#13] do inc(FCurP);
 
1462
          end;
 
1463
          // line breaks closes head cells
 
1464
          if TopToken=wptTableHeadCell then
 
1465
            Pop(wptTableHeadCell);
 
1466
        end;
 
1467
 
 
1468
      '''': HandleApostroph;
 
1469
      '{':  HandleCurlyBracketOpen;
 
1470
      '|':  HandlePipe;
 
1471
      '!':  HandleExclamationMark;
 
1472
      '=':  HandleEqual;
 
1473
      '_':  HandleUnderScore;
 
1474
      '[':  HandleEdgedBracketOpen;
 
1475
      '<':  HandleAngleBracket;
 
1476
      '*','#',':',';':  HandleListChar;
 
1477
      ' ':  HandleSpace;
 
1478
 
 
1479
      '-':
 
1480
        if (FCurP[1]='-') and AtLineStart(FCurP) and TokenIs('----') then
 
1481
          EmitFlag(wptHorizontalRow,wprNone,4)
 
1482
        else
 
1483
          inc(FCurP);
 
1484
 
 
1485
      else
 
1486
        inc(FCurP);
 
1487
      end;
 
1488
    end;
 
1489
    EmitTextToken;
 
1490
    while FStackPtr>=0 do
 
1491
      Pop(TopToken);
 
1492
  finally
 
1493
    FreeAndNil(FRangeToken);
 
1494
    FreeAndNil(FTextToken);
 
1495
    FreeAndNil(FLinkToken);
 
1496
    FreeAndNil(FNameValueToken);
 
1497
    ClearStack;
 
1498
  end;
 
1499
end;
 
1500
 
 
1501
procedure TWikiPage.FixUTF8;
 
1502
begin
 
1503
  UTF8FixBroken(FSrc);
 
1504
end;
 
1505
 
 
1506
procedure Init;
 
1507
var
 
1508
  c: Char;
 
1509
begin
 
1510
  for c:=low(char) to high(char) do begin
 
1511
    IsWikiTagStartChar[c]:=c in ['a'..'z','A'..'Z','_',#192..#255];
 
1512
    IsWikiTagChar[c]:=c in ['a'..'z','A'..'Z','_','0'..'9',#128..#255];
 
1513
  end;
 
1514
end;
 
1515
 
 
1516
function WikiInternalLinkToPage(Link: string): string;
 
1517
var
 
1518
  i: Integer;
 
1519
  j: Integer;
 
1520
  c: Char;
 
1521
  Code: Integer;
 
1522
begin
 
1523
  Result:=Link;
 
1524
  i:=length(Result);
 
1525
  while i>0 do begin
 
1526
    case Result[i] of
 
1527
    ' ',#9:
 
1528
      Result[i]:='_';
 
1529
    #0..#8,#10..#31,'$','[',']','{','}','<','>':
 
1530
      Delete(Result,i,1);
 
1531
    '%':
 
1532
      begin
 
1533
        Code:=0;
 
1534
        j:=1;
 
1535
        while (i+j<=length(Result)) do begin
 
1536
          c:=Result[i+j];
 
1537
          case c of
 
1538
          '0'..'9': if Code<16 then Code:=Code*16+ord(c)-ord('0');
 
1539
          'a'..'z': if Code<16 then Code:=Code*16+ord(c)-ord('a')+10;
 
1540
          'A'..'Z': if Code<16 then Code:=Code*16+ord(c)-ord('A')+10;
 
1541
          else break;
 
1542
          end;
 
1543
          if j=2 then break;
 
1544
          inc(j);
 
1545
        end;
 
1546
        ReplaceSubstring(Result,i,j+1,chr(Code));
 
1547
        continue; // check the new character
 
1548
      end;
 
1549
    end;
 
1550
    dec(i);
 
1551
  end;
 
1552
end;
 
1553
 
 
1554
function WikiIsExternalLink(Link: string): boolean;
 
1555
// check if Link starts with a scheme http://
 
1556
var
 
1557
  p: PChar;
 
1558
begin
 
1559
  Result:=false;
 
1560
  if Link='' then exit;
 
1561
  p:=PChar(Link);
 
1562
  while p^ in ['a'..'z','A'..'Z'] do inc(p);
 
1563
  if p=PChar(Link) then exit;
 
1564
  if p^<>':' then exit;
 
1565
  inc(p);
 
1566
  if p^<>'/' then exit;
 
1567
  inc(p);
 
1568
  if p^<>'/' then exit;
 
1569
  inc(p);
 
1570
  Result:=true;
 
1571
end;
 
1572
 
 
1573
function GetWikiPageID(doc: TDOMNode): string;
 
1574
var
 
1575
  Node: TDOMNode;
 
1576
begin
 
1577
  Result:='';
 
1578
  for Node in doc.GetEnumeratorAllChildren do begin
 
1579
    if (Node is TDOMText)
 
1580
    and (Node.ParentNode is TDOMElement)
 
1581
    and (TDOMElement(Node.ParentNode).TagName='id')
 
1582
    and (Node.ParentNode.ParentNode is TDOMElement)
 
1583
    and (TDOMElement(Node.ParentNode.ParentNode).TagName='page') then begin
 
1584
      Result:=TDOMText(Node).Data;
 
1585
    end;
 
1586
  end;
 
1587
end;
 
1588
 
 
1589
function GetWikiPageID(s: TStream): string;
 
1590
var
 
1591
  doc: TXMLDocument;
 
1592
begin
 
1593
  doc:=nil;
 
1594
  try
 
1595
    Result:='';
 
1596
    try
 
1597
      ReadXMLFile(doc,s);
 
1598
      Result:=GetWikiPageID(doc);
 
1599
    except
 
1600
    end;
 
1601
  finally
 
1602
    doc.Free;
 
1603
  end;
 
1604
end;
 
1605
 
 
1606
function WikiPageToCaseID(Page: string): string;
 
1607
var
 
1608
  CaseFlags: String;
 
1609
  UpPage: String;
 
1610
  PageP: PChar;
 
1611
  PageUpP: PChar;
 
1612
  CharLen: Integer;
 
1613
  UpCharLen: Integer;
 
1614
  n: Integer;
 
1615
  i: Integer;
 
1616
begin
 
1617
  Result:='';
 
1618
  if Page='' then exit;
 
1619
 
 
1620
  // for each letter check if it is uppercased
 
1621
  CaseFlags:='';
 
1622
  UpPage:=UTF8UpperCase(Page);
 
1623
  PageP:=PChar(Page);
 
1624
  PageUpP:=PChar(UpPage);
 
1625
  while (PageP^<>#0) and (PageUpP^<>#0) do begin
 
1626
    if PageP^='%' then begin
 
1627
      // skip encoded characters, it does not matter if they are written lower or uppercase
 
1628
      inc(PageP);
 
1629
      inc(PageUpP);
 
1630
      for i:=1 to 2 do begin
 
1631
        if PageUpP^ in ['0'..'9','A'..'F'] then begin
 
1632
          inc(PageP);
 
1633
          inc(PageUpP);
 
1634
        end;
 
1635
      end;
 
1636
    end else begin
 
1637
      CharLen:=UTF8CharacterLength(PageP);
 
1638
      UpCharLen:=UTF8CharacterLength(PageUpP);
 
1639
      if (CharLen>1) or (PageP^ in ['a'..'z','A'..'Z']) then begin
 
1640
        if (CharLen=UpCharLen) and CompareMem(PageP,PageUpP,CharLen) then
 
1641
          CaseFlags:=CaseFlags+'u'
 
1642
        else
 
1643
          CaseFlags:=CaseFlags+'l';
 
1644
      end;
 
1645
      inc(PageP,CharLen);
 
1646
      inc(PageUpP,UpCharLen);
 
1647
    end;
 
1648
  end;
 
1649
 
 
1650
  // encode bit vector (one character per 5bit)
 
1651
  while CaseFlags<>'' do begin
 
1652
    n:=0;
 
1653
    for i:=1 to 5 do begin
 
1654
      if i>length(CaseFlags) then break;
 
1655
      n:=n*2;
 
1656
      if CaseFlags[i]='u' then n+=1;
 
1657
    end;
 
1658
    case n of
 
1659
    0..9: Result:=Result+chr(n+ord('0'));
 
1660
    10..31: Result:=Result+chr(n-10+ord('a'));
 
1661
    end;
 
1662
    system.Delete(CaseFlags,1,5);
 
1663
  end;
 
1664
end;
 
1665
 
 
1666
function dbgs(t: TWPTokenType): string;
 
1667
begin
 
1668
  Result:=WPTokenInfos[t].Caption;
 
1669
end;
 
1670
 
 
1671
function dbgs(r: TWPTokenRange): string;
 
1672
begin
 
1673
  Result:=WPTokenRangeNames[r];
 
1674
end;
 
1675
 
 
1676
initialization
 
1677
  Init;
 
1678
 
 
1679
end.
 
1680