1{-------------------------------------------------------------------------------
2The contents of this file may be used under the terms of the
3GNU General Public License Version 2 or later (the "GPL")
4
5Software distributed under the License is distributed on an "AS IS" basis,
6WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
7the specific language governing rights and limitations under the License.
8
9The Original Code is: SynHighlighterPo.pp, released 2011-12-17.
10Author: Bart Broersma
11All Rights Reserved.
12
13Contributors to the SynEdit and mwEdit projects are listed in the
14Contributors.txt file.
15
16
17$Id: SynHighlighterPo.pp,v 0.0.1 bbroersma Exp $
18
19
20Known Issues:
21-------------------------------------------------------------------------------}
22{
23@abstract(Provides a po-files highlighter for SynEdit)
24@author(Bart Broersma)
25@created(2011-12-17)
26@lastmod(2011-12-18)
27The SynHighlighterPo unit provides SynEdit with an po-files highlighter.
28}
29unit SynHighlighterPo;
30
31{$I SynEdit.inc}
32
33interface
34
35uses
36  Classes, SysUtils,
37  Graphics,
38  SynEditTypes, SynEditHighlighter, SynEditStrConst;
39
40type
41  TtkTokenKind = (tkComment, tkText, tkKey, tkNull, tkSpace, tkString,
42                  tkIdentifier, tkPrevValue, tkFlags, tkUnknown);
43
44  TProcTableProc = procedure of object;
45
46type
47
48  { TSynPoSyn }
49
50  TSynPoSyn = class(TSynCustomHighlighter)
51  private
52    fLine: PChar;
53    fLineNumber: Integer;
54    fProcTable: array[#0..#255] of TProcTableProc;
55    Run: LongInt;
56    fTokenPos: Integer;
57    FTokenID: TtkTokenKind;
58    fCommentAttri: TSynHighlighterAttributes;
59    fTextAttri: TSynHighlighterAttributes;
60    fKeyAttri: TSynHighlighterAttributes;
61    fSpaceAttri: TSynHighlighterAttributes;
62    fStringAttri: TSynHighlighterAttributes;
63    fIdentAttri: TSynHighlighterAttributes;
64    fPrevAttri: TSynHighlighterAttributes;
65    fFlagAttri: TSynHighlighterAttributes;
66    procedure IdentProc;
67    procedure KeyProc;
68    procedure CRProc;
69    procedure TextProc;
70    procedure LFProc;
71    procedure NullProc;
72    procedure HashProc;
73    procedure SpaceProc;
74    procedure StringProc;
75    procedure MakeMethodTables;
76  protected
77    {General Stuff}
78    function GetIdentChars: TSynIdentChars; override;
79    function GetSampleSource: String; override;
80  public
81    class function GetLanguageName: string; override;
82    function IsKeyword(const AKeyword: string): boolean; override;
83  public
84    constructor Create(AOwner: TComponent); override;
85    function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
86      override;
87    function GetEol: Boolean; override;
88    function GetTokenID: TtkTokenKind;
89    procedure SetLine(const NewValue: String; LineNumber:Integer); override;
90    function GetToken: String; override;
91    procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
92    function GetTokenAttribute: TSynHighlighterAttributes; override;
93    function GetTokenKind: integer; override;
94    function GetTokenPos: Integer; override;
95    procedure Next; override;
96  published
97    property CommentAttri: TSynHighlighterAttributes read fCommentAttri
98      write fCommentAttri;
99    property TextAttri   : TSynHighlighterAttributes read fTextAttri
100      write fTextAttri;
101    property KeyAttri    : TSynHighlighterAttributes read fKeyAttri
102      write fKeyAttri;
103    property SpaceAttri  : TSynHighlighterAttributes read fSpaceAttri
104      write fSpaceAttri;
105  end;
106
107implementation
108
109
110
111const
112  PoKeysCount = 3;
113  PoKeys: array[1..PoKeysCount] of string = (
114    'msgid', 'msgstr', 'msgctxt');
115
116
117procedure TSynPoSyn.MakeMethodTables;
118var
119  i: Char;
120begin
121  for i := #0 to #255 do
122    case i of
123      #0      : fProcTable[i] := @NullProc;
124      #10 {LF}: fProcTable[i] := @LFProc;
125      #13 {CR}: fProcTable[i] := @CRProc;
126      #34 {"} : fProcTable[i] := @StringProc;
127      'A'..'Z', 'a'..'z', '_': fProcTable[I] := @IdentProc;
128      '#' {#} : fProcTable[i] := @HashProc;
129      #1..#9, #11, #12, #14..#32: fProcTable[i] := @SpaceProc;
130    else
131      fProcTable[i] := @TextProc;
132    end;
133end;
134
135constructor TSynPoSyn.Create(AOwner: TComponent);
136begin
137  inherited Create(AOwner);
138  fCommentAttri            := TSynHighlighterAttributes.Create(@SYNS_AttrComment);
139  fCommentAttri.Style      := [fsItalic];
140  fCommentAttri.Foreground := clGreen;
141  AddAttribute(fCommentAttri);
142
143  fTextAttri               := TSynHighlighterAttributes.Create(@SYNS_AttrText);
144  AddAttribute(fTextAttri);
145
146  fKeyAttri                := TSynHighlighterAttributes.Create(@SYNS_AttrKey);
147  fKeyAttri.Foreground     := clBlue;
148  fKeyAttri.Style          := [fsBold];
149  AddAttribute(fKeyAttri);
150
151  fIdentAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
152  fIdentAttri.Foreground   := clGreen;
153  fIdentAttri.Style        := [fsBold];
154  AddAttribute(fIdentAttri);
155
156  fPrevAttri  := TSynHighlighterAttributes.Create(@SYNS_AttrPrevValue, SYNS_XML_AttrPrevValue);
157  fPrevAttri.Foreground    := clOlive;
158  fPrevAttri.Style         := [fsItalic];
159  AddAttribute(fPrevAttri);
160
161  fFlagAttri  := TSynHighlighterAttributes.Create(@SYNS_AttrFlags, SYNS_XML_AttrFlags);
162  fFlagAttri.Foreground    := clTeal;
163  AddAttribute(fFlagAttri);
164
165  fSpaceAttri              := TSynHighlighterAttributes.Create(@SYNS_AttrSpace, SYNS_XML_AttrSpace);
166  AddAttribute(fSpaceAttri);
167
168  fStringAttri             := TSynHighlighterAttributes.Create(@SYNS_AttrString, SYNS_XML_AttrString);
169  fStringAttri.Foreground  := clFuchsia;
170  AddAttribute(fStringAttri);
171
172  SetAttributesOnChange(@DefHighlightChange);
173
174  fDefaultFilter      := SYNS_FilterPo;
175  MakeMethodTables;
176end; { Create }
177
178procedure TSynPoSyn.SetLine(const NewValue: String; LineNumber:Integer);
179begin
180  inherited;
181  fLine := PChar(NewValue);
182  Run := 0;
183  fLineNumber := LineNumber;
184  Next;
185end;
186
187
188procedure TSynPoSyn.IdentProc;
189begin
190  while fLine[Run] in GetIdentChars {['A'..'Z','a'..'z']} do inc(Run);
191  if IsKeyWord(GetToken) then begin
192    fTokenId := tkKey;
193    Exit;
194  end
195  else fTokenId := tkUnknown;
196end;
197
198procedure TSynPoSyn.CRProc;
199begin
200  fTokenID := tkSpace;
201  Case FLine[Run + 1] of
202    #10: inc(Run, 2);
203  else inc(Run);
204  end;
205end;
206
207
208procedure TSynPoSyn.KeyProc;
209begin
210  fTokenID := tkKey;
211  inc(Run);
212  while FLine[Run] <> #0 do
213    case FLine[Run] of
214      #32: break;
215      #10: break;
216      #13: break;
217    else inc(Run);
218    end;
219end;
220
221procedure TSynPoSyn.TextProc;
222begin
223  if Run = 0 then
224    IdentProc
225  else begin
226    inc(Run);
227    while (fLine[Run] in [#128..#191]) OR // continued utf8 subcode
228     ((fLine[Run]<>#0) and (fProcTable[fLine[Run]] = @TextProc)) do inc(Run);
229    fTokenID := tkText;
230  end;
231end;
232
233procedure TSynPoSyn.LFProc;
234begin
235  fTokenID := tkSpace;
236  inc(Run);
237end;
238
239procedure TSynPoSyn.NullProc;
240begin
241  fTokenID := tkNull;
242end;
243
244
245
246procedure TSynPoSyn.SpaceProc;
247begin
248  inc(Run);
249  fTokenID := tkSpace;
250  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
251end;
252
253
254procedure TSynPoSyn.StringProc;
255var
256  FirstQuotePos, LastQuotePos: longint;
257begin
258  FirstQuotePos := Run;
259  LastQuotePos := FirstQuotePos;
260  fTokenID := tkString;
261  while FLine[Run] <> #0 do
262  begin
263    case FLine[Run] of
264      #10, #13: break;
265      #34: if (Run <= 0) or (FLine[Run - 1] <> '\') then LastQuotePos := Run;
266    end;
267    inc(Run);
268  end;
269  if FirstQuotePos <> LastQuotePos then
270    Run := LastQuotePos;
271  if FLine[Run] <> #0 then
272    inc(Run);
273end;
274
275
276procedure TSynPoSyn.HashProc;
277begin
278  // if it is not column 0 mark as tkText and get out of here
279  if Run > 0 then
280  begin
281    fTokenID := tkText;
282    inc(Run);
283    Exit;
284  end;
285
286  // this is column 0 --> ok
287  fTokenID := tkComment;
288
289  while FLine[Run] <> #0 do
290    case FLine[Run] of
291      #10: break;
292      #13: break;
293      ':': begin if (Run = 1) then fTokenId := tkIdentifier; Inc(Run) end;
294      ',': begin if (Run = 1) then  fTokenId := tkFlags;  Inc(Run) end;
295      '|': begin if (Run = 1) then  fTokenId := tkPrevValue; Inc(Run) end;
296    else inc(Run);
297    end;
298end;
299
300procedure TSynPoSyn.Next;
301begin
302  fTokenPos := Run;
303  fProcTable[fLine[Run]];
304end;
305
306function TSynPoSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
307begin
308  case Index of
309    SYN_ATTR_COMMENT: Result := fCommentAttri;
310    SYN_ATTR_KEYWORD: Result := fKeyAttri;
311    SYN_ATTR_STRING: Result := fStringAttri;
312    SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
313  else
314    Result := nil;
315  end;
316end;
317
318function TSynPoSyn.GetEol: Boolean;
319begin
320  Result := fTokenId = tkNull;
321end;
322
323function TSynPoSyn.GetToken: String;
324var
325  Len: LongInt;
326begin
327  Len := Run - fTokenPos;
328  SetString(Result, (FLine + fTokenPos), Len);
329end;
330
331procedure TSynPoSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
332begin
333  TokenLength := Run - fTokenPos;
334  TokenStart := FLine + fTokenPos;
335end;
336
337function TSynPoSyn.GetTokenID: TtkTokenKind;
338begin
339  Result := fTokenId;
340end;
341
342function TSynPoSyn.GetTokenAttribute: TSynHighlighterAttributes;
343begin
344  case fTokenID of
345    tkComment: Result := fCommentAttri;
346    tkText   : Result := fTextAttri;
347    tkKey    : Result := fKeyAttri;
348    tkSpace  : Result := fSpaceAttri;
349    tkString : Result := fStringAttri;
350    tkIdentifier: Result := fIdentAttri;
351    tkFlags:       Result := fFlagAttri;
352    tkPrevValue:  Result := fPrevAttri;
353    tkUnknown: Result := fTextAttri;
354    else Result := nil;
355  end;
356end;
357
358function TSynPoSyn.GetTokenKind: integer;
359begin
360  Result := Ord(fTokenId);
361end;
362
363function TSynPoSyn.GetTokenPos: Integer;
364begin
365 Result := fTokenPos;
366end;
367
368function TSynPoSyn.GetIdentChars: TSynIdentChars;
369begin
370  Result := [#33..#255];
371end;
372
373class function TSynPoSyn.GetLanguageName: string;
374begin
375  Result := SYNS_LangPo;
376end;
377
378function TSynPoSyn.GetSampleSource: String;
379begin
380  Result := '"Project-Id-Version: \n"' + LineEnding +
381            '"POT-Creation-Date: \n"' + LineEnding +
382            '"MIME-Version: 1.0\n"' + LineEnding +
383            '"Content-Type: text/plain; charset=UTF-8\n"' + LineEnding +
384            '"Content-Transfer-Encoding: 8bit\n"' + LineEnding +
385            LineEnding +
386            '#: lazarusidestrconsts.dlgcochecks' + LineEnding +
387            '#, fuzzy' + LineEnding +
388            '#| msgid "Checks:"' + LineEnding +
389            'msgid "Checks"' + LineEnding +
390            'msgstr "Controleert:"' + LineEnding +
391            LineEnding +
392            '#: lazarusidestrconsts.listemplateeditparamcellhelp' + LineEnding +
393            'msgid ""' + LineEnding +
394            '"Inserts an editable Cell, with a default value\n"' + LineEnding +
395            '"\"\",Sync=n (,S=n), to Sync with a previous cell (n=1 to highest prev cell\n"' + LineEnding +
396            '"\"default\",Sync, to Sync with a previous cell of equal default\n"' + LineEnding +
397            'msgstr ""';
398
399end;
400
401function TSynPoSyn.IsKeyword(const AKeyword: string): boolean;
402var
403  i: Integer;
404begin
405  //There are only 3 keywords, so no need to make a hashtable
406  for i := 1 to PoKeysCount do
407    if CompareText(PoKeys[i], AKeyWord) = 0 then
408      Exit(True);
409  Result := False;
410end;
411
412initialization
413  RegisterPlaceableHighlighter(TSynPoSyn);
414
415end.
416