1 {-------------------------------------------------------------------------------
2 The contents of this file are subject to the Mozilla Public License
3 Version 1.1 (the "License"); you may not use this file except in compliance
4 with the License. You may obtain a copy of the License at
5 http://www.mozilla.org/MPL/
6 
7 Software distributed under the License is distributed on an "AS IS" basis,
8 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9 the specific language governing rights and limitations under the License.
10 
11 The Original Code is: SynHighlighterDfm.pas, released 2000-04-14.
12 The Original Code is based on the dmDfmSyn.pas file from the
13 mwEdit component suite by Martin Waldenburg and other developers, the Initial
14 Author of this file is David H. Muir.
15 All Rights Reserved.
16 
17 Contributors to the SynEdit and mwEdit projects are listed in the
18 Contributors.txt file.
19 
20 Alternatively, the contents of this file may be used under the terms of the
21 GNU General Public License Version 2 or later (the "GPL"), in which case
22 the provisions of the GPL are applicable instead of those above.
23 If you wish to allow use of your version of this file only under the terms
24 of the GPL and not to allow others to use your version of this file
25 under the MPL, indicate your decision by deleting the provisions above and
26 replace them with the notice and other provisions required by the GPL.
27 If you do not delete the provisions above, a recipient may use your version
28 of this file under either the MPL or the GPL.
29 
30 $Id: synhighlighterlfm.pas 52180 2016-04-12 23:01:29Z martin $
31 
32 You may retrieve the latest version of this file at the SynEdit home page,
33 located at http://SynEdit.SourceForge.net
34 
35 Known Issues:
36 -------------------------------------------------------------------------------}
37 {
38 @abstract(Provides a Delphi Form Source highlighter for SynEdit)
39 @author(David Muir <david@loanhead45.freeserve.co.uk>)
40 @created(April 13, 2000)
41 @lastmod(2000-06-23)
42 The SynHighlighterLFM unit provides SynEdit with a Delphi Form Source (.LFM) highlighter.
43 The highlighter formats form source code similar to when forms are viewed as text in the Delphi editor.
44 }
45 unit SynHighlighterLFM;
46 
47 {$I SynEdit.inc}
48 
49 interface
50 
51 uses
52   SysUtils, Classes, FileUtil, LazUTF8Classes, Graphics,
53   SynEditTypes, SynEditHighlighter, SynEditHighlighterFoldBase;
54 
55 type
56   TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber, tkSpace,
57     tkString, tkSymbol, tkUnknown);
58 
59   TRangeState = (rsANil, rsComment, rsUnKnown);
60 
61   TLfmCodeFoldBlockType = (
62     cfbtLfmObject,      // object, inherited, inline
63     cfbtLfmList,        // <>
64     cfbtLfmItem,         // Item
65     // internal type / no config
66     cfbtLfmNone
67     );
68   TLfmCodeFoldBlockTypes = set of TLfmCodeFoldBlockType;
69 
70   TProcTableProc = procedure of object;
71 
72 const
73   CountLfmCodeFoldBlockOffset: Pointer =
74     Pointer(PtrInt(Integer(high(TLfmCodeFoldBlockType))+1));
75 
76 type
77 
78   { TSynLFMSyn }
79 
80   TSynLFMSyn = class(TSynCustomFoldHighlighter)
81   private
82     fRange: TRangeState;
83     fLine: PChar;
84     fLineNumber: Integer;
85     fProcTable: array[#0..#255] of TProcTableProc;
86     Run: integer;
87     fTokenPos: Integer;
88     FTokenID: TtkTokenKind;
89     fCommentAttri: TSynHighlighterAttributes;
90     fIdentifierAttri: TSynHighlighterAttributes;
91     fKeyAttri: TSynHighlighterAttributes;
92     fNumberAttri: TSynHighlighterAttributes;
93     fSpaceAttri: TSynHighlighterAttributes;
94     fStringAttri: TSynHighlighterAttributes;
95     fSymbolAttri: TSynHighlighterAttributes;
96     procedure AltProc;
97     procedure AsciiCharProc;
98     procedure BraceCloseProc;
99     procedure BraceOpenProc;
100     procedure CommentProc;
101     procedure CRProc;
102     procedure EndProc;
103     procedure IntegerProc;
104     procedure LFProc;
105     procedure NullProc;
106     procedure NumberProc;
107     procedure ObjectProc;
108     procedure InheritedInlineProc;
109     procedure SpaceProc;
110     procedure StringProc;
111     procedure SymbolProc;
112     procedure UnknownProc;
113     procedure MakeMethodTables;
114   protected
GetIdentCharsnull115     function GetIdentChars: TSynIdentChars; override;
GetSampleSourcenull116     function GetSampleSource: string; override;
117   protected
118     // folding
119     procedure CreateRootCodeFoldBlock; override;
120 
StartLfmCodeFoldBlocknull121     function StartLfmCodeFoldBlock
122              (ABlockType: TLfmCodeFoldBlockType): TSynCustomCodeFoldBlock;
123     procedure EndLfmCodeFoldBlock;
TopLfmCodeFoldBlockTypenull124     function TopLfmCodeFoldBlockType(DownIndex: Integer = 0): TLfmCodeFoldBlockType;
125   protected
GetFoldConfigInstancenull126     function GetFoldConfigInstance(Index: Integer): TSynCustomFoldConfig; override;
GetFoldConfigCountnull127     function GetFoldConfigCount: Integer; override;
GetFoldConfigInternalCountnull128     function GetFoldConfigInternalCount: Integer; override;
129   public
GetLanguageNamenull130     class function GetLanguageName: string; override;
131   public
132     constructor Create(AOwner: TComponent); override;
133     destructor Destroy; override;
GetDefaultAttributenull134     function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
135       override;
GetEolnull136     function GetEol: Boolean; override;
GetRangenull137     function GetRange: Pointer; override;
GetTokenIDnull138     function GetTokenID: TtkTokenKind;
139     procedure SetLine(const NewValue: String;
140       LineNumber: Integer); override;
GetTokennull141     function GetToken: String; override;
142     procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
GetTokenAttributenull143     function GetTokenAttribute: TSynHighlighterAttributes; override;
GetTokenKindnull144     function GetTokenKind: integer; override;
GetTokenPosnull145     function GetTokenPos: Integer; override;
146     procedure Next; override;
147     procedure SetRange(Value: Pointer); override;
148     procedure ResetRange; override;
149     property IdentChars;
150   published
151     property CommentAttri: TSynHighlighterAttributes read fCommentAttri
152       write fCommentAttri;
153     property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri
154       write fIdentifierAttri;
155     property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
156     property NumberAttri: TSynHighlighterAttributes read fNumberAttri
157       write fNumberAttri;
158     property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri
159       write fSpaceAttri;
160     property StringAttri: TSynHighlighterAttributes read fStringAttri
161       write fStringAttri;
162   end;
163 
LoadLFMFile2Stringsnull164 function LoadLFMFile2Strings(const AFile: string; AStrings: TStrings;
165   var WasText: boolean): integer;
SaveStrings2LFMFilenull166 function SaveStrings2LFMFile(AStrings: TStrings; const AFile: string): integer;
167 
168 implementation
169 
170 uses
171   SynEditStrConst;
172 
173 { A couple of useful Lazarus Form functions }
174 
LoadLFMFile2Stringsnull175 function LoadLFMFile2Strings(const AFile: string; AStrings: TStrings;
176   var WasText: boolean): integer;
177 var
178   Src, Dest: TStream;
179 begin
180   Result := 0;
181   WasText := FALSE;
182   AStrings.Clear;
183   try
184     Src := TFileStreamUTF8.Create(AFile, fmOpenRead or fmShareDenyWrite);
185     try
186       Dest := TMemoryStream.Create;
187       try
188         ObjectResourceToText(Src, Dest);
189         Dest.Seek(0, soFromBeginning);
190         AStrings.LoadFromStream(Dest);
191       finally
192         Dest.Free;
193       end;
194     finally
195       Src.Free;
196     end;
197   except
198     on E: EInOutError do Result := -E.ErrorCode;
199     else Result := -1;
200   end;
201 end;
202 
SaveStrings2LFMFilenull203 function SaveStrings2LFMFile(AStrings: TStrings; const AFile: string): integer;
204 var
205   Src, Dest: TStream;
206 begin
207   Result := 0;
208   try
209     Src := TMemoryStream.Create;
210     try
211       AStrings.SaveToStream(Src);
212       Src.Seek(0, soFromBeginning);
213       Dest := TFileStreamUTF8.Create(AFile, fmCreate);
214       try
215         ObjectTextToResource(Src, Dest);
216       finally
217         Dest.Free;
218       end;
219     finally
220       Src.Free;
221     end;
222   except
223     on E: EInOutError do Result := -E.ErrorCode;
224     else Result := -1;
225   end;
226 end;
227 
228 { TSynLFMSyn }
229 
230 procedure TSynLFMSyn.MakeMethodTables;
231 var
232   I: Char;
233 begin
234   for I := #0 to #255 do
235     case I of
236       '#': fProcTable[I] := @AsciiCharProc;
237       '}': fProcTable[I] := @BraceCloseProc;
238       '{': fProcTable[I] := @BraceOpenProc;
239       #13: fProcTable[I] := @CRProc;
240       'A'..'Z', 'a'..'z', '_':
241         if I in ['e', 'E'] then
242           fProcTable[I] := @EndProc
243         else if I in ['o', 'O'] then
244           fProcTable[I] := @ObjectProc
245         else if I in ['i', 'I'] then
246           fProcTable[I] := @InheritedInlineProc
247         else
248           fProcTable[I] := @AltProc;
249       '$': fProcTable[I] := @IntegerProc;
250       #10: fProcTable[I] := @LFProc;
251       #0: fProcTable[I] := @NullProc;
252       '0'..'9': fProcTable[I] := @NumberProc;
253       '(', ')', '/', '=', '<', '>', '.', ',', '[', ']', ':':
254         fProcTable[I] := @SymbolProc;
255       #1..#9, #11, #12, #14..#32: fProcTable[I] := @SpaceProc;
256       #39: fProcTable[I] := @StringProc;
257     else fProcTable[I] := @UnknownProc;
258     end;
259 end;
260 
GetFoldConfigInstancenull261 function TSynLFMSyn.GetFoldConfigInstance(Index: Integer): TSynCustomFoldConfig;
262 begin
263   Result := inherited GetFoldConfigInstance(Index);
264   Result.Enabled := True;
265   if TLfmCodeFoldBlockType(Index) in [cfbtLfmObject, cfbtLfmList, cfbtLfmItem] then begin
266     Result.SupportedModes := Result.SupportedModes + [fmMarkup];
267     Result.Modes := Result.Modes + [fmMarkup];
268   end;
269 end;
270 
271 constructor TSynLFMSyn.Create(AOwner: TComponent);
272 begin
273   inherited Create(AOwner);
274   fCommentAttri := TSynHighlighterAttributes.Create(@SYNS_AttrComment, SYNS_XML_AttrComment);
275   fCommentAttri.Style := [fsItalic];
276   AddAttribute(fCommentAttri);
277   fIdentifierAttri := TSynHighlighterAttributes.Create(@SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier);
278   AddAttribute(fIdentifierAttri);
279   fKeyAttri := TSynHighlighterAttributes.Create(@SYNS_AttrKey, SYNS_XML_AttrKey);
280   fKeyAttri.Style := [fsBold];
281   AddAttribute(fKeyAttri);
282   fNumberAttri := TSynHighlighterAttributes.Create(@SYNS_AttrNumber, SYNS_XML_AttrNumber);
283   AddAttribute(fNumberAttri);
284   fSpaceAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSpace, SYNS_XML_AttrSpace);
285   AddAttribute(fSpaceAttri);
286   fStringAttri := TSynHighlighterAttributes.Create(@SYNS_AttrString, SYNS_XML_AttrString);
287   AddAttribute(fStringAttri);
288   fSymbolAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSymbol, SYNS_XML_AttrSymbol);
289   AddAttribute(fSymbolAttri);
290   SetAttributesOnChange(@DefHighlightChange);
291   MakeMethodTables;
292   fDefaultFilter := SYNS_FilterLFM;
293   fRange := rsUnknown;
294 end;
295 
296 destructor TSynLFMSyn.Destroy;
297 begin
298   inherited Destroy;
299 end;
300 
301 procedure TSynLFMSyn.SetLine(const NewValue: String;
302   LineNumber: Integer);
303 begin
304   inherited;
305   fLine := PChar(NewValue);
306   Run := 0;
307   fLineNumber := LineNumber;
308   Next;
309 end;
310 
311 procedure TSynLFMSyn.AltProc;
312 begin
313   fTokenID := tkIdentifier;
314   repeat
315     Inc(Run);
316   until not (fLine[Run] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']);
317 end;
318 
319 procedure TSynLFMSyn.AsciiCharProc;
320 begin
321   fTokenID := tkString;
322   repeat
323     Inc(Run);
324   until not (fLine[Run] in ['0'..'9']);
325 end;
326 
327 procedure TSynLFMSyn.BraceCloseProc;
328 begin
329   inc(Run);
330   fRange := rsUnknown;
331   fTokenId := tkIdentifier;
332 end;
333 
334 procedure TSynLFMSyn.BraceOpenProc;
335 begin
336   fRange := rsComment;
337   CommentProc;
338 end;
339 
340 procedure TSynLFMSyn.CommentProc;
341 begin
342   fTokenID := tkComment;
343   repeat
344     inc(Run);
345     if fLine[Run] = '}' then begin
346       Inc(Run);
347       fRange := rsUnknown;
348       break;
349     end;
350   until fLine[Run] in [#0, #10, #13];
351 end;
352 
353 procedure TSynLFMSyn.CRProc;
354 begin
355   fTokenID := tkSpace;
356   Inc(Run);
357   if (fLine[Run] = #10) then Inc(Run);
358 end;
359 
360 procedure TSynLFMSyn.EndProc;
361 begin
362   if (fLine[Run + 1] in ['n', 'N']) and
363      (fLine[Run + 2] in ['d', 'D']) and
364      not (fLine[Run + 3] in ['_', '0'..'9', 'a'..'z', 'A'..'Z'])
365   then begin
366     fTokenID := tkKey;
367     Inc(Run, 3);
368     if (TopLfmCodeFoldBlockType in [cfbtLfmObject, cfbtLfmItem]) then
369       EndLfmCodeFoldBlock;
370   end else
371     AltProc;
372 end;
373 
374 procedure TSynLFMSyn.IntegerProc;
375 begin
376   fTokenID := tkNumber;
377   repeat
378     inc(Run);
379   until not (fLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f']);
380 end;
381 
382 procedure TSynLFMSyn.LFProc;
383 begin
384   fTokenID := tkSpace;
385   inc(Run);
386 end;
387 
388 procedure TSynLFMSyn.NullProc;
389 begin
390   fTokenID := tkNull;
391 end;
392 
393 procedure TSynLFMSyn.NumberProc;
394 begin
395   fTokenID := tkNumber;
396   repeat
397     Inc(Run);
398     if fLine[Run] = '.' then begin
399       if fLine[Run + 1] <> '.' then Inc(Run);
400       break;
401     end;
402   until not (fLine[Run] in ['0'..'9', 'e', 'E']);
403 end;
404 
405 procedure TSynLFMSyn.ObjectProc;
406 begin
407   if (fLine[Run + 1] in ['b', 'B']) and
408      (fLine[Run + 2] in ['j', 'J']) and
409      (fLine[Run + 3] in ['e', 'E']) and
410      (fLine[Run + 4] in ['c', 'C']) and
411      (fLine[Run + 5] in ['t', 'T']) and
412      not (fLine[Run + 6] in ['_', '0'..'9', 'a'..'z', 'A'..'Z'])
413   then
414   begin
415     fTokenID := tkKey;
416     Inc(Run, 6);
417     StartLfmCodeFoldBlock(cfbtLfmObject);
418   end
419   else
420     AltProc;
421 end;
422 
423 procedure TSynLFMSyn.InheritedInlineProc;
424 begin
425   if ((fLine[Run + 1] in ['n', 'N']) and
426      (fLine[Run + 2] in ['h', 'H']) and
427      (fLine[Run + 3] in ['e', 'E']) and
428      (fLine[Run + 4] in ['r', 'R']) and
429      (fLine[Run + 5] in ['i', 'I']) and
430      (fLine[Run + 6] in ['t', 'T']) and
431      (fLine[Run + 7] in ['e', 'E']) and
432      (fLine[Run + 8] in ['d', 'D']) and
433      not (fLine[Run + 9] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']))
434   then
435   begin
436     fTokenID := tkKey;
437     Inc(Run, 9);
438     StartLfmCodeFoldBlock(cfbtLfmObject);
439   end
440   else if ((fLine[Run + 1] in ['n', 'N']) and
441            (fLine[Run + 2] in ['l', 'L']) and
442            (fLine[Run + 3] in ['i', 'I']) and
443            (fLine[Run + 4] in ['n', 'N']) and
444            (fLine[Run + 5] in ['e', 'E']) and
445            not (fLine[Run + 6] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']))
446   then
447   begin
448     fTokenID := tkKey;
449     Inc(Run, 6);
450     StartLfmCodeFoldBlock(cfbtLfmObject);
451   end
452   else if ((fLine[Run + 1] in ['t', 'T']) and
453            (fLine[Run + 2] in ['e', 'E']) and
454            (fLine[Run + 3] in ['m', 'M']) and
455            not (fLine[Run + 4] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']))
456   then
457   begin
458     fTokenID := tkIdentifier;
459     Inc(Run, 4);
460     StartLfmCodeFoldBlock(cfbtLfmItem);
461   end
462   else
463     AltProc;
464 end;
465 
466 procedure TSynLFMSyn.SpaceProc;
467 begin
468   fTokenID := tkSpace;
469   repeat
470     Inc(Run);
471   until (fLine[Run] > #32) or (fLine[Run] in [#0, #10, #13]);
472 end;
473 
474 procedure TSynLFMSyn.StringProc;
475 begin
476   fTokenID := tkString;
477   repeat
478     Inc(Run);
479     if fLine[Run] = '''' then begin
480       Inc(Run);
481       if fLine[Run] <> '''' then break
482     end;
483   until fLine[Run] in [#0, #10, #13];
484 end;
485 
486 procedure TSynLFMSyn.SymbolProc;
487 begin
488 
489   inc(Run);
490   fTokenID := tkSymbol;
491   if fLine[Run-1] = '<' then
492   begin
493     StartLfmCodeFoldBlock(cfbtLfmList)
494   end
495   else
496   if (fLine[Run-1] = '>') and (TopLfmCodeFoldBlockType = cfbtLfmList) then
497     EndLfmCodeFoldBlock;
498 end;
499 
500 procedure TSynLFMSyn.UnknownProc;
501 begin
502 {$IFDEF SYN_MBCSSUPPORT}
503   if FLine[Run] in LeadBytes then
504     Inc(Run,2)
505   else
506 {$ENDIF}
507   inc(Run);
508   while (fLine[Run] in [#128..#191]) OR // continued utf8 subcode
509    ((fLine[Run]<>#0) and (fProcTable[fLine[Run]] = @UnknownProc)) do inc(Run);
510   fTokenID := tkUnknown;
511 end;
512 
513 procedure TSynLFMSyn.Next;
514 begin
515   fTokenPos := Run;
516   if fRange = rsComment then begin
517     if fLine[Run] = #0 then NullProc
518                        else CommentProc;
519   end else
520     fProcTable[fLine[Run]]();
521 end;
522 
GetDefaultAttributenull523 function TSynLFMSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
524 begin
525   case Index of
526     SYN_ATTR_COMMENT: Result := fCommentAttri;
527     SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri;
528     SYN_ATTR_KEYWORD: Result := fKeyAttri;
529     SYN_ATTR_STRING: Result := fStringAttri;
530     SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
531     SYN_ATTR_SYMBOL: Result := fSymbolAttri;
532     SYN_ATTR_NUMBER: Result := fNumberAttri;
533   else
534     Result := nil;
535   end;
536 end;
537 
TSynLFMSyn.GetEolnull538 function TSynLFMSyn.GetEol: Boolean;
539 begin
540   Result := fTokenId = tkNull;
541 end;
542 
TSynLFMSyn.GetRangenull543 function TSynLFMSyn.GetRange: Pointer;
544 begin
545   CodeFoldRange.RangeType:=Pointer(PtrUInt(Integer(fRange)));
546   Result := inherited;
547 end;
548 
GetTokenIDnull549 function TSynLFMSyn.GetTokenID: TtkTokenKind;
550 begin
551   Result := fTokenId;
552 end;
553 
GetTokennull554 function TSynLFMSyn.GetToken: String;
555 var
556   Len: LongInt;
557 begin
558   Result := '';
559   Len := Run - fTokenPos;
560   SetString(Result, (FLine + fTokenPos), Len);
561 end;
562 
563 procedure TSynLFMSyn.GetTokenEx(out TokenStart: PChar;
564   out TokenLength: integer);
565 begin
566   TokenLength:=Run-fTokenPos;
567   TokenStart:=FLine + fTokenPos;
568 end;
569 
GetTokenAttributenull570 function TSynLFMSyn.GetTokenAttribute: TSynHighlighterAttributes;
571 begin
572   case fTokenID of
573     tkComment: Result := fCommentAttri;
574     tkIdentifier: Result := fIdentifierAttri;
575     tkKey: Result := fKeyAttri;
576     tkNumber: Result := fNumberAttri;
577     tkSpace: Result := fSpaceAttri;
578     tkString: Result := fStringAttri;
579     tkSymbol: Result := fSymbolAttri;
580     tkUnknown: Result := fIdentifierAttri;
581     else Result := nil;
582   end;
583 end;
584 
GetTokenKindnull585 function TSynLFMSyn.GetTokenKind: integer;
586 begin
587   Result := Ord(fTokenID);
588 end;
589 
GetTokenPosnull590 function TSynLFMSyn.GetTokenPos: Integer;
591 begin
592   Result := fTokenPos;
593 end;
594 
595 procedure TSynLFMSyn.ResetRange;
596 begin
597   inherited;
598   fRange := rsUnknown;
599 end;
600 
601 procedure TSynLFMSyn.SetRange(Value: Pointer);
602 begin
603   inherited;
604   fRange := TRangeState(Integer(PtrUInt(CodeFoldRange.RangeType)));
605 end;
606 
GetIdentCharsnull607 function TSynLFMSyn.GetIdentChars: TSynIdentChars;
608 begin
609   Result := TSynValidStringChars;
610 end;
611 
TSynLFMSyn.GetLanguageNamenull612 class function TSynLFMSyn.GetLanguageName: string;
613 begin
614   Result := SYNS_LangLFM;
615 end;
616 
TSynLFMSyn.GetSampleSourcenull617 function TSynLFMSyn.GetSampleSource: string;
618 begin
619   Result := '{ Delphi/C++ Builder Form Definitions }'#13#10 +
620             'object TestForm: TTestForm'#13#10 +
621             '  Left = 273'#13#10 +
622             '  Top = 103'#13#10 +
623             '  Caption = ''SynEdit sample source'''#13#10 +
624             'end';
625 end; { GetSampleSource }
626 
627 procedure TSynLFMSyn.CreateRootCodeFoldBlock;
628 begin
629   inherited CreateRootCodeFoldBlock;
630   RootCodeFoldBlock.InitRootBlockType(Pointer(PtrInt(cfbtLfmNone)));
631 end;
632 
TSynLFMSyn.StartLfmCodeFoldBlocknull633 function TSynLFMSyn.StartLfmCodeFoldBlock(ABlockType: TLfmCodeFoldBlockType): TSynCustomCodeFoldBlock;
634 var
635   FoldBlock: Boolean;
636   p: PtrInt;
637 begin
638   FoldBlock :=  FFoldConfig[ord(ABlockType)].Enabled;
639   p := 0;
640   if not FoldBlock then
641     p := PtrInt(CountLfmCodeFoldBlockOffset);
642   Result := StartCodeFoldBlock(p + Pointer(PtrInt(ABlockType)), FoldBlock);
643 end;
644 
645 procedure TSynLFMSyn.EndLfmCodeFoldBlock;
646 var
647   DecreaseLevel: Boolean;
648 begin
649   DecreaseLevel := TopCodeFoldBlockType < CountLfmCodeFoldBlockOffset;
650   EndCodeFoldBlock(DecreaseLevel);
651 end;
652 
TSynLFMSyn.TopLfmCodeFoldBlockTypenull653 function TSynLFMSyn.TopLfmCodeFoldBlockType(DownIndex: Integer): TLfmCodeFoldBlockType;
654 var
655   p: Pointer;
656 begin
657   p := TopCodeFoldBlockType(DownIndex);
658   if p >= CountLfmCodeFoldBlockOffset then
659     p := p - PtrUInt(CountLfmCodeFoldBlockOffset);
660   Result := TLfmCodeFoldBlockType(PtrUInt(p));
661 end;
662 
TSynLFMSyn.GetFoldConfigCountnull663 function TSynLFMSyn.GetFoldConfigCount: Integer;
664 begin
665   // excluded cfbtLfmNone
666   Result := ord(high(TLfmCodeFoldBlockType)) - ord(low(TLfmCodeFoldBlockType));
667 end;
668 
TSynLFMSyn.GetFoldConfigInternalCountnull669 function TSynLFMSyn.GetFoldConfigInternalCount: Integer;
670 begin
671   // include cfbtLfmNone
672   Result := ord(high(TLfmCodeFoldBlockType)) - ord(low(TLfmCodeFoldBlockType)) + 1;
673 end;
674 
675 initialization
676   RegisterPlaceableHighlighter(TSynLFMSyn);
677 
678 end.
679