{------------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: SynHighlighterPas.pas, released 2000-04-17. The Original Code is based on the mwPasSyn.pas file from the mwEdit component suite by Martin Waldenburg and other developers, the Initial Author of this file is Martin Waldenburg. Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg. All Rights Reserved. Contributors to the SynEdit and mwEdit projects are listed in the Contributors.txt file. Alternatively, the contents of this file may be used under the terms of the GNU General Public License Version 2 or later (the "GPL"), in which case the provisions of the GPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL. $Id$ You may retrieve the latest version of this file at the SynEdit home page, located at http://SynEdit.SourceForge.net Known Issues: -------------------------------------------------------------------------------} { @abstract(Provides a Pascal/Delphi syntax highlighter for SynEdit) @author(Martin Waldenburg) @created(1998, converted to SynEdit 2000-04-07) @lastmod(2000-06-23) The SynHighlighterPas unit provides SynEdit with a Object Pascal syntax highlighter. An extra boolean property "D4Syntax" is included to enable the recognition of the advanced features found in Object Pascal in Delphi 4. } unit SynHighlighterPas; {$I synedit.inc} interface uses SysUtils, {$IFDEF SYN_LAZARUS} LCLProc, {$ELSE} Windows, Messages, {$ENDIF} Classes, Registry, Graphics, SynEditHighlighterFoldBase, SynEditMiscProcs, SynEditTypes, SynEditHighlighter, SynEditTextBase, SynEditTextBuffer, SynEditStrConst; type TtkTokenKind = (tkAsm, tkComment, tkIdentifier, tkKey, tkNull, tkNumber, tkSpace, tkString, tkSymbol, {$IFDEF SYN_LAZARUS}tkDirective, {$ENDIF} tkUnknown); TRangeState = ( // rsAnsi, rsBor, rsDirective are exclusive to each other rsAnsi, // *) comment rsBor, // { comment {$IFDEF SYN_LAZARUS} rsDirective, {$ENDIF} rsAsm, // assembler block rsProperty, rsInterface, rsImplementation, // Program or Implementation // we need to detect if procedure is a "type x = procedure" rsAtEqual, // "=" either in compare or in type/const assign rsAfterEqual, // Detect if class/object is ended by ";" or "end;" rsAtClass, rsAfterClass, rsAtClosingBracket, // ')' rsAtCaseLabel ); TRangeStates = set of TRangeState; type {$IFDEF SYN_LAZARUS} TPascalCodeFoldBlockType = ( cfbtBeginEnd, // Nested cfbtTopBeginEnd, // Begin of Procedure cfbtNestedComment, cfbtProcedure, cfbtUses, cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtUnitSection, cfbtProgram, cfbtUnit, cfbtRecord, cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtIfDef, // {$IfDef} directive, ths is not counted in the Range-Node cfbtRegion, // {%Region} user folds, not counted in the Range-Node // Internal type / not configurable cfbtNone ); TPascalCodeFoldBlockTypes = set of TPascalCodeFoldBlockType; const CountPascalCodeFoldBlockOffset: Pointer = Pointer(PtrInt(Integer(high(TPascalCodeFoldBlockType))+1)); cfbtAll: TPascalCodeFoldBlockTypes = [low(TPascalCodeFoldBlockType)..high(TPascalCodeFoldBlockType)]; PascalWordTrippletRanges: TPascalCodeFoldBlockTypes = [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord, cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase ]; // restrict cdecl etc to places where they can be. // this needs a better parser ProcModifierAllowed: TPascalCodeFoldBlockTypes = [cfbtNone, cfbtProcedure, cfbtProgram, cfbtClass, cfbtClassSection, cfbtUnitSection, // unitsection, actually interface only cfbtVarType, cfbtLocalVarType]; type TPascalCompilerMode = ( pcmObjFPC, pcmDelphi, pcmFPC, pcmTP, pcmGPC, pcmMacPas ); TSynPasDividerDrawLocation = ( pddlUnitSection, pddlUses, pddlVarGlobal, // Var, Type, Const in global scope pddlVarLocal, // Var, Type, Const in local (procedure) scope pddlStructGlobal, // Class, Object, Record in global type block pddlStructLocal, // Class, Object, Record in local (procedure) type block pddlProcedure, pddlBeginEnd, // Includes Repeat pddlTry ); const PasDividerDrawLocationDefaults: Array [TSynPasDividerDrawLocation] of Integer = (1, 0, // unit, uses 1, 0, // var 1, 0, // struct 2, 0, // proc, begin 0); type TSynPasRangeInfo = record EndLevelIfDef: Smallint; MinLevelIfDef: Smallint; EndLevelRegion: Smallint; MinLevelRegion: Smallint; end; { TSynHighlighterPasRangeList } TSynHighlighterPasRangeList = class(TSynHighlighterRangeList) private function GetTSynPasRangeInfo(Index: Integer): TSynPasRangeInfo; procedure SetTSynPasRangeInfo(Index: Integer; const AValue: TSynPasRangeInfo); protected function ItemSize: Integer; override; public property PasRangeInfo[Index: Integer]: TSynPasRangeInfo read GetTSynPasRangeInfo write SetTSynPasRangeInfo; end; { TSynPasSynRange } TSynPasSynRange = class(TSynCustomHighlighterRange) private FMode: TPascalCompilerMode; FBracketNestLevel : Integer; FLastLineCodeFoldLevelFix: integer; FPasFoldEndLevel: Smallint; FPasFoldFixLevel: Smallint; FPasFoldMinLevel: Smallint; public procedure Clear; override; function Compare(Range: TSynCustomHighlighterRange): integer; override; procedure Assign(Src: TSynCustomHighlighterRange); override; function Add(ABlockType: Pointer = nil; IncreaseLevel: Boolean = True): TSynCustomCodeFoldBlock; override; procedure Pop(DecreaseLevel: Boolean = True); override; function MaxFoldLevel: Integer; override; procedure IncBracketNestLevel; procedure DecBracketNestLevel; procedure DecLastLineCodeFoldLevelFix; procedure DecLastLinePasFoldFix; property Mode: TPascalCompilerMode read FMode write FMode; property BracketNestLevel: integer read FBracketNestLevel write FBracketNestLevel; property LastLineCodeFoldLevelFix: integer read FLastLineCodeFoldLevelFix write FLastLineCodeFoldLevelFix; property PasFoldEndLevel: Smallint read FPasFoldEndLevel write FPasFoldEndLevel; property PasFoldFixLevel: Smallint read FPasFoldFixLevel write FPasFoldFixLevel; property PasFoldMinLevel: Smallint read FPasFoldMinLevel write FPasFoldMinLevel; end; {$ENDIF} TProcTableProc = procedure of object; PIdentFuncTableFunc = ^TIdentFuncTableFunc; TIdentFuncTableFunc = function: TtkTokenKind of object; { TSynPasSyn } TSynPasSyn = class(TSynCustomFoldHighlighter) private fAsmStart: Boolean; FNestedComments: boolean; FStartCodeFoldBlockLevel: integer; FPasStartLevel: Smallint; fRange: TRangeStates; FSynPasRangeInfo: TSynPasRangeInfo; FAtLineStart: Boolean; // Line had only spaces or comments sofar {$IFDEF SYN_LAZARUS} fLineStr: string; fLine: PChar; fLineLen: integer; {$ELSE} fLine: PChar; {$ENDIF} fLineNumber: Integer; fProcTable: array[#0..#255] of TProcTableProc; Run: LongInt;// current parser postion in fLine fStringLen: Integer;// current length of hash {$IFDEF SYN_LAZARUS} fToIdent: integer;// start of current identifier in fLine {$ELSE} fToIdent: PChar; {$ENDIF} fIdentFuncTable: array[0..191] of TIdentFuncTableFunc; fTokenPos: Integer;// start of current token in fLine FTokenID: TtkTokenKind; FTokenIsCaseLabel: Boolean; fStringAttri: TSynHighlighterAttributes; fNumberAttri: TSynHighlighterAttributes; fKeyAttri: TSynHighlighterAttributes; fSymbolAttri: TSynHighlighterAttributes; fAsmAttri: TSynHighlighterAttributes; fCommentAttri: TSynHighlighterAttributes; fIdentifierAttri: TSynHighlighterAttributes; fSpaceAttri: TSynHighlighterAttributes; FCaseLabelAttri: TSynHighlighterAttributes; FCurCaseLabelAttri: TSynHighlighterAttributes; {$IFDEF SYN_LAZARUS} fDirectiveAttri: TSynHighlighterAttributes; FCompilerMode: TPascalCompilerMode; {$ENDIF} fD4syntax: boolean; {$IFDEF SYN_LAZARUS} FCatchNodeInfo: Boolean; FNodeInfoLine, FNodeInfoCount: Integer; FNodeInfoList: Array of TSynFoldNodeInfo; FDividerDrawConfig: Array [TSynPasDividerDrawLocation] of TSynDividerDrawConfig; procedure GrowNodeInfoList; function GetPasCodeFoldRange: TSynPasSynRange; procedure SetCompilerMode(const AValue: TPascalCompilerMode); function TextComp(aText: PChar): Boolean; function KeyHash: Integer; {$ELSE} function KeyHash(ToHash: PChar): Integer; {$ENDIF} function KeyComp(const aKey: string): Boolean; function Func15: TtkTokenKind; function Func19: TtkTokenKind; function Func20: TtkTokenKind; function Func21: TtkTokenKind; function Func23: TtkTokenKind; function Func25: TtkTokenKind; function Func27: TtkTokenKind; function Func28: TtkTokenKind; function Func29: TtkTokenKind; // "on" function Func32: TtkTokenKind; function Func33: TtkTokenKind; function Func35: TtkTokenKind; function Func37: TtkTokenKind; function Func38: TtkTokenKind; function Func39: TtkTokenKind; function Func40: TtkTokenKind; function Func41: TtkTokenKind; function Func42: TtkTokenKind; // "alias", "final" function Func44: TtkTokenKind; function Func45: TtkTokenKind; function Func46: TtkTokenKind; // "sealed" function Func47: TtkTokenKind; function Func49: TtkTokenKind; function Func52: TtkTokenKind; function Func54: TtkTokenKind; function Func55: TtkTokenKind; function Func56: TtkTokenKind; function Func57: TtkTokenKind; function Func59: TtkTokenKind; function Func60: TtkTokenKind; function Func61: TtkTokenKind; function Func63: TtkTokenKind; function Func64: TtkTokenKind; function Func65: TtkTokenKind; function Func66: TtkTokenKind; function Func69: TtkTokenKind; function Func71: TtkTokenKind; function Func72: TtkTokenKind; function Func73: TtkTokenKind; function Func75: TtkTokenKind; function Func76: TtkTokenKind; function Func79: TtkTokenKind; function Func81: TtkTokenKind; function Func84: TtkTokenKind; function Func85: TtkTokenKind; function Func86: TtkTokenKind; function Func87: TtkTokenKind; function Func88: TtkTokenKind; function Func89: TtkTokenKind; function Func91: TtkTokenKind; function Func92: TtkTokenKind; function Func94: TtkTokenKind; function Func95: TtkTokenKind; function Func96: TtkTokenKind; function Func97: TtkTokenKind; function Func98: TtkTokenKind; function Func99: TtkTokenKind; function Func100: TtkTokenKind; function Func101: TtkTokenKind; function Func102: TtkTokenKind; function Func103: TtkTokenKind; function Func105: TtkTokenKind; function Func106: TtkTokenKind; function Func108: TtkTokenKind; // "operator" function Func112: TtkTokenKind; // "requires" function Func117: TtkTokenKind; function Func122: TtkTokenKind; // "otherwise" function Func126: TtkTokenKind; function Func128: TtkTokenKind; function Func129: TtkTokenKind; function Func130: TtkTokenKind; function Func132: TtkTokenKind; function Func133: TtkTokenKind; function Func136: TtkTokenKind; function Func139: TtkTokenKind; function Func141: TtkTokenKind; function Func142: TtkTokenKind; // "experimental" function Func143: TtkTokenKind; function Func144: TtkTokenKind; function Func151: TtkTokenKind; // "unimplemented" function Func166: TtkTokenKind; function Func167: TtkTokenKind; function Func168: TtkTokenKind; function Func191: TtkTokenKind; function AltFunc: TtkTokenKind; procedure InitIdent; {$IFDEF SYN_LAZARUS} function IdentKind(p: integer): TtkTokenKind; {$ELSE} function IdentKind(MayBe: PChar): TtkTokenKind; {$ENDIF} procedure MakeMethodTables; procedure AddressOpProc; procedure AsciiCharProc; procedure AnsiProc; procedure BorProc; procedure BraceOpenProc; procedure ColonOrGreaterProc; procedure CRProc; {$IFDEF SYN_LAZARUS} procedure DirectiveProc; {$ENDIF} procedure IdentProc; procedure HexProc; procedure BinaryProc; procedure OctalProc; procedure LFProc; procedure LowerProc; procedure NullProc; procedure NumberProc; procedure PointProc; procedure RoundOpenProc; procedure RoundCloseProc; procedure SquareOpenProc; procedure SquareCloseProc; procedure EqualSignProc; procedure SemicolonProc; //mh 2000-10-08 procedure SlashProc; procedure SpaceProc; procedure StringProc; procedure SymbolProc; procedure UnknownProc; procedure SetD4syntax(const Value: boolean); procedure InitNode(var Node: TSynFoldNodeInfo; EndOffs: Integer; ABlockType: TPascalCodeFoldBlockType; aActions: TSynFoldActions); procedure CreateDividerDrawConfig; procedure DestroyDividerDrawConfig; protected function GetIdentChars: TSynIdentChars; override; function IsFilterStored: boolean; override; //mh 2000-10-08 protected function GetRangeClass: TSynCustomHighlighterRangeClass; override; procedure CreateRootCodeFoldBlock; override; function CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; override; function UpdateRangeInfoAtLine(Index: Integer): Boolean; override; // Returns true if range changed function StartPascalCodeFoldBlock (ABlockType: TPascalCodeFoldBlockType): TSynCustomCodeFoldBlock; procedure EndPascalCodeFoldBlock(NoMarkup: Boolean = False); procedure CloseBeginEndBlocksBeforeProc; procedure SmartCloseBeginEndBlocks(SearchFor: TPascalCodeFoldBlockType); procedure EndPascalCodeFoldBlockLastLine; procedure StartCustomCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType); procedure EndCustomCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType); function GetFoldNodeInfo(Line, Index: Integer; Filter: TSynFoldActions): TSynFoldNodeInfo; override; function GetFoldNodeInfoCount(Line: Integer; Filter: TSynFoldActions): Integer; override; property PasCodeFoldRange: TSynPasSynRange read GetPasCodeFoldRange; function TopPascalCodeFoldBlockType (DownIndex: Integer = 0): TPascalCodeFoldBlockType; function MinimumPasFoldLevel(Index: Integer; AType: Integer = 1): integer; function EndPasFoldLevel(Index: Integer; AType: Integer = 1): integer; function LastLinePasFoldLevelFix(Index: Integer; AType: Integer = 1): integer; function LastLineFoldLevelFix(Index: Integer): integer; function GetDrawDivider(Index: integer): TSynDividerDrawConfigSetting; override; function GetDividerDrawConfig(Index: Integer): TSynDividerDrawConfig; override; function GetDividerDrawConfigCount: Integer; override; function GetFoldConfigInstance(Index: Integer): TSynCustomFoldConfig; override; function GetFoldConfigCount: Integer; override; function GetFoldConfigInternalCount: Integer; override; public {$IFNDEF SYN_CPPB_1} class {$ENDIF} function GetCapabilities: TSynHighlighterCapabilities; override; {$IFNDEF SYN_CPPB_1} class {$ENDIF} function GetLanguageName: string; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override; function GetEol: Boolean; override; function GetRange: Pointer; override; function GetToken: string; override; {$IFDEF SYN_LAZARUS} procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; {$ENDIF} function GetTokenAttribute: TSynHighlighterAttributes; override; function GetTokenID: TtkTokenKind; function GetTokenKind: integer; override; function GetTokenPos: Integer; override; function IsKeyword(const AKeyword: string): boolean; override; procedure Next; override; procedure ResetRange; override; procedure SetLine({$IFDEF FPC}const {$ENDIF}NewValue: string; LineNumber: Integer); override; procedure SetRange(Value: Pointer); override; procedure StartAtLineIndex(LineNumber:Integer); override; // 0 based function UseUserSettings(settingIndex: integer): boolean; override; procedure EnumUserSettings(settings: TStrings); override; // fold-nodes that can be collapsed function FoldOpenCount(ALineIndex: Integer; AType: Integer = 0): integer; override; function FoldCloseCount(ALineIndex: Integer; AType: Integer = 0): integer; override; function FoldNestCount(ALineIndex: Integer; AType: Integer = 0): integer; override; function FoldTypeCount: integer; override; function FoldTypeAtNodeIndex(ALineIndex, FoldIndex: Integer; UseCloseNodes: boolean = false): integer; override; function FoldLineLength(ALineIndex, FoldIndex: Integer): integer; override; // Pascal coe only // TODO: make private function MinimumFoldLevel(Index: Integer): integer; override; function EndFoldLevel(Index: Integer): integer; override; published property AsmAttri: TSynHighlighterAttributes read fAsmAttri write fAsmAttri; property CommentAttri: TSynHighlighterAttributes read fCommentAttri write fCommentAttri; property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri write fIdentifierAttri; property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri; property NumberAttri: TSynHighlighterAttributes read fNumberAttri write fNumberAttri; property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri; property StringAttri: TSynHighlighterAttributes read fStringAttri write fStringAttri; property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri write fSymbolAttri; property CaseLabelAttri: TSynHighlighterAttributes read FCaseLabelAttri write FCaseLabelAttri; {$IFDEF SYN_LAZARUS} property DirectiveAttri: TSynHighlighterAttributes read fDirectiveAttri write fDirectiveAttri; property CompilerMode: TPascalCompilerMode read FCompilerMode write SetCompilerMode; property NestedComments: boolean read FNestedComments write FNestedComments; {$ENDIF} property D4syntax: boolean read FD4syntax write SetD4syntax default true; end; { TSynFreePascalSyn } TSynFreePascalSyn = class(TSynPasSyn) public constructor Create(AOwner: TComponent); override; procedure ResetRange; override; end; implementation const RESERVED_WORDS_TP: array [1..54] of String = ( 'absolute', 'and', 'array', 'asm', 'begin', 'case', 'const', 'constructor', 'destructor', 'div', 'do', 'downto', 'else', 'end', 'file', 'for', 'function', 'goto', 'if', 'implementation', 'in', 'inherited', 'inline', 'interface', 'label', 'mod', 'nil', 'not', 'object', 'of', 'on', 'operator', 'or', 'packed', 'procedure', 'program', 'record', 'reintroduce', 'repeat', 'self', 'set', 'shl', 'shr', 'string', 'then', 'to', 'type', 'unit', 'until', 'uses', 'var', 'while', 'with', 'xor' ); RESERVED_WORDS_DELPHI: array [1..15] of String = ( 'as', 'class', 'except', 'exports', 'finalization', 'finally', 'initialization', 'is', 'library', 'on', 'out', 'property', 'raise', 'threadvar', 'try' ); RESERVED_WORDS_FPC: array [1..5] of String = ( 'dispose', 'exit', 'false', 'new', 'true' ); var Identifiers: array[#0..#255] of ByteBool; mHashTable: array[#0..#255] of Integer; KeywordsList: TStringList; IsIntegerChar: array[char] of Boolean; IsNumberChar: array[char] of Boolean; IsSpaceChar: array[char] of Boolean; IsUnderScoreOrNumberChar: array[char] of Boolean; IsLetterChar: array[char] of Boolean; procedure MakeIdentTable; var I, J: Char; begin for I := #0 to #255 do begin Case I of '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True; else Identifiers[I] := False; end; J := UpCase(I); Case I of 'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64; else mHashTable[Char(I)] := 0; end; IsIntegerChar[I]:=(I in ['0'..'9', 'A'..'F', 'a'..'f']); IsNumberChar[I]:=(I in ['0'..'9', '.', 'e', 'E']); IsSpaceChar[I]:=(I in [#1..#9, #11, #12, #14..#32]); IsUnderScoreOrNumberChar[I]:=(I in ['_','0'..'9']); IsLetterChar[I]:=(I in ['a'..'z','A'..'Z']); end; end; procedure TSynPasSyn.InitIdent; var I: Integer; pF: PIdentFuncTableFunc; begin pF := PIdentFuncTableFunc(@fIdentFuncTable); for I := Low(fIdentFuncTable) to High(fIdentFuncTable) do begin {$IFDEF FPC} pF^ := @AltFunc; {$ELSE} pF^ := AltFunc; {$ENDIF} Inc(pF); end; {$IFDEF FPC} fIdentFuncTable[15] := @Func15; fIdentFuncTable[19] := @Func19; fIdentFuncTable[20] := @Func20; fIdentFuncTable[21] := @Func21; fIdentFuncTable[23] := @Func23; fIdentFuncTable[25] := @Func25; fIdentFuncTable[27] := @Func27; fIdentFuncTable[28] := @Func28; fIdentFuncTable[29] := @Func29; // "on" fIdentFuncTable[32] := @Func32; fIdentFuncTable[33] := @Func33; fIdentFuncTable[35] := @Func35; fIdentFuncTable[37] := @Func37; fIdentFuncTable[38] := @Func38; fIdentFuncTable[39] := @Func39; fIdentFuncTable[40] := @Func40; fIdentFuncTable[41] := @Func41; fIdentFuncTable[42] := @Func42; fIdentFuncTable[44] := @Func44; fIdentFuncTable[45] := @Func45; fIdentFuncTable[46] := @Func46; fIdentFuncTable[47] := @Func47; fIdentFuncTable[49] := @Func49; fIdentFuncTable[52] := @Func52; fIdentFuncTable[54] := @Func54; fIdentFuncTable[55] := @Func55; fIdentFuncTable[56] := @Func56; fIdentFuncTable[57] := @Func57; fIdentFuncTable[59] := @Func59; fIdentFuncTable[60] := @Func60; fIdentFuncTable[61] := @Func61; fIdentFuncTable[63] := @Func63; fIdentFuncTable[64] := @Func64; fIdentFuncTable[65] := @Func65; fIdentFuncTable[66] := @Func66; fIdentFuncTable[69] := @Func69; fIdentFuncTable[71] := @Func71; fIdentFuncTable[72] := @Func72; fIdentFuncTable[73] := @Func73; fIdentFuncTable[75] := @Func75; fIdentFuncTable[76] := @Func76; fIdentFuncTable[79] := @Func79; fIdentFuncTable[81] := @Func81; fIdentFuncTable[84] := @Func84; fIdentFuncTable[85] := @Func85; fIdentFuncTable[86] := @Func86; fIdentFuncTable[87] := @Func87; fIdentFuncTable[88] := @Func88; fIdentFuncTable[89] := @Func89; fIdentFuncTable[91] := @Func91; fIdentFuncTable[92] := @Func92; fIdentFuncTable[94] := @Func94; fIdentFuncTable[95] := @Func95; fIdentFuncTable[96] := @Func96; fIdentFuncTable[97] := @Func97; fIdentFuncTable[98] := @Func98; fIdentFuncTable[99] := @Func99; fIdentFuncTable[100] := @Func100; fIdentFuncTable[101] := @Func101; fIdentFuncTable[102] := @Func102; fIdentFuncTable[103] := @Func103; fIdentFuncTable[105] := @Func105; fIdentFuncTable[106] := @Func106; fIdentFuncTable[108] := @Func108; // "operator" fIdentFuncTable[112] := @Func112; // "requires" fIdentFuncTable[117] := @Func117; fIdentFuncTable[122] := @Func122; fIdentFuncTable[126] := @Func126; fIdentFuncTable[128] := @Func128; fIdentFuncTable[129] := @Func129; fIdentFuncTable[130] := @Func130; fIdentFuncTable[132] := @Func132; fIdentFuncTable[133] := @Func133; fIdentFuncTable[136] := @Func136; fIdentFuncTable[139] := @Func139; fIdentFuncTable[141] := @Func141; fIdentFuncTable[142] := @Func142; fIdentFuncTable[143] := @Func143; fIdentFuncTable[144] := @Func144; fIdentFuncTable[151] := @Func151; fIdentFuncTable[166] := @Func166; fIdentFuncTable[167] := @Func167; fIdentFuncTable[168] := @Func168; fIdentFuncTable[191] := @Func191; {$ELSE} fIdentFuncTable[15] := Func15; fIdentFuncTable[19] := Func19; fIdentFuncTable[20] := Func20; fIdentFuncTable[21] := Func21; fIdentFuncTable[23] := Func23; fIdentFuncTable[25] := Func25; fIdentFuncTable[27] := Func27; fIdentFuncTable[28] := Func28; fIdentFuncTable[32] := Func32; fIdentFuncTable[33] := Func33; fIdentFuncTable[35] := Func35; fIdentFuncTable[37] := Func37; fIdentFuncTable[38] := Func38; fIdentFuncTable[39] := Func39; fIdentFuncTable[40] := Func40; fIdentFuncTable[41] := Func41; fIdentFuncTable[44] := Func44; fIdentFuncTable[45] := Func45; fIdentFuncTable[47] := Func47; fIdentFuncTable[49] := Func49; fIdentFuncTable[52] := Func52; fIdentFuncTable[54] := Func54; fIdentFuncTable[55] := Func55; fIdentFuncTable[56] := Func56; fIdentFuncTable[57] := Func57; fIdentFuncTable[59] := Func59; fIdentFuncTable[60] := Func60; fIdentFuncTable[61] := Func61; fIdentFuncTable[63] := Func63; fIdentFuncTable[64] := Func64; fIdentFuncTable[65] := Func65; fIdentFuncTable[66] := Func66; fIdentFuncTable[69] := Func69; fIdentFuncTable[71] := Func71; fIdentFuncTable[72] := Func72; fIdentFuncTable[73] := Func73; fIdentFuncTable[75] := Func75; fIdentFuncTable[76] := Func76; fIdentFuncTable[79] := Func79; fIdentFuncTable[81] := Func81; fIdentFuncTable[84] := Func84; fIdentFuncTable[85] := Func85; fIdentFuncTable[86] := Func86; fIdentFuncTable[87] := Func87; fIdentFuncTable[88] := Func88; fIdentFuncTable[91] := Func91; fIdentFuncTable[92] := Func92; fIdentFuncTable[94] := Func94; fIdentFuncTable[95] := Func95; fIdentFuncTable[96] := Func96; fIdentFuncTable[97] := Func97; fIdentFuncTable[98] := Func98; fIdentFuncTable[99] := Func99; fIdentFuncTable[100] := Func100; fIdentFuncTable[101] := Func101; fIdentFuncTable[102] := Func102; fIdentFuncTable[103] := Func103; fIdentFuncTable[105] := Func105; fIdentFuncTable[106] := Func106; fIdentFuncTable[117] := Func117; fIdentFuncTable[126] := Func126; fIdentFuncTable[129] := Func129; fIdentFuncTable[132] := Func132; fIdentFuncTable[133] := Func133; fIdentFuncTable[136] := Func136; fIdentFuncTable[141] := Func141; fIdentFuncTable[143] := Func143; fIdentFuncTable[166] := Func166; fIdentFuncTable[168] := Func168; fIdentFuncTable[191] := Func191; {$ENDIF} end; {$IFDEF SYN_LAZARUS} function TSynPasSyn.KeyHash: Integer; var Start, ToHash: PChar; begin Result := 0; if (fToIdent mHashTable[aKey[i]] then begin Result := False; break; end; inc(Temp); end; end else Result := False; end; { KeyComp } {$IFDEF SYN_LAZARUS} function TSynPasSyn.TextComp(aText: PChar): Boolean; var CurPos: PChar; begin CurPos:=@fLine[Run]; while (aText^<>#0) do begin if mHashTable[aText^]<>mHashTable[CurPos^] then exit(false); inc(aText); inc(CurPos); end; Result:=true; end; procedure TSynPasSyn.SetCompilerMode(const AValue: TPascalCompilerMode); begin if FCompilerMode=AValue then exit; FCompilerMode:=AValue; FNestedComments:=FCompilerMode in [pcmFPC,pcmObjFPC]; PasCodeFoldRange.Mode:=FCompilerMode; //DebugLn(['TSynPasSyn.SetCompilerMode FCompilerMode=',ord(FCompilerMode),' FNestedComments=',FNestedComments]); end; procedure TSynPasSyn.GrowNodeInfoList; begin if FNodeInfoCount < length(FNodeInfoList) then exit; SetLength(FNodeInfoList, FNodeInfoCount + Max(10, FNodeInfoCount div 4)); end; function TSynPasSyn.GetPasCodeFoldRange: TSynPasSynRange; begin Result := TSynPasSynRange(CodeFoldRange); end; {$ENDIF} function TSynPasSyn.Func15: TtkTokenKind; begin if KeyComp('If') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func19: TtkTokenKind; begin if KeyComp('Do') then Result := tkKey else if KeyComp('And') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func20: TtkTokenKind; begin if KeyComp('As') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func21: TtkTokenKind; begin if KeyComp('Of') then begin Result := tkKey; if (rsAfterClass in fRange) and (TopPascalCodeFoldBlockType = cfbtClass) then begin // Accidental start of block // End at next semicolon (usually same line) CodeFoldRange.Pop(false); // avoid minlevel CodeFoldRange.Add(Pointer(PtrInt(cfbtUses)), false); end else if (TopPascalCodeFoldBlockType = cfbtCase) then fRange := fRange + [rsAtCaseLabel]; end else Result := tkIdentifier; end; function TSynPasSyn.Func23: TtkTokenKind; var tfb: TPascalCodeFoldBlockType; begin if KeyComp('End') then begin if ((fToIdent<2) or (fLine[fToIdent-1]<>'@')) then begin Result := tkKey; fRange := fRange - [rsAsm]; PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code {$IFDEF SYN_LAZARUS} // there may be more than on block ending here tfb := TopPascalCodeFoldBlockType; if tfb = cfbtRecord then begin EndPascalCodeFoldBlock; end else if tfb = cfbtUnit then begin EndPascalCodeFoldBlock; end else if tfb = cfbtExcept then begin EndPascalCodeFoldBlock; if TopPascalCodeFoldBlockType = cfbtTry then EndPascalCodeFoldBlock; end else if tfb = cfbtTry then begin EndPascalCodeFoldBlock; end else if tfb in [cfbtTopBeginEnd, cfbtAsm] then begin EndPascalCodeFoldBlock; if TopPascalCodeFoldBlockType in [cfbtProcedure] then EndPascalCodeFoldBlock; if TopPascalCodeFoldBlockType = cfbtProgram then EndPascalCodeFoldBlock; end else if tfb in [cfbtCase] then begin EndPascalCodeFoldBlock; fRange := fRange - [rsAtCaseLabel]; end else if tfb in [cfbtBeginEnd] then begin EndPascalCodeFoldBlock; end else if tfb = cfbtUnitSection then begin EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType = cfbtUnit then // "Unit".."end." EndPascalCodeFoldBlock; end else begin if tfb = cfbtClassSection then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType = cfbtClass then EndPascalCodeFoldBlock; end; {$ENDIF} end else begin Result := tkKey; // @@end or @end label end; end else if KeyComp('In') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func25: TtkTokenKind; begin if KeyComp('Far') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func27: TtkTokenKind; begin if KeyComp('Cdecl') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func28: TtkTokenKind; begin if KeyComp('Is') then Result := tkKey else if KeyComp('Read') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else if KeyComp('Case') then begin if TopPascalCodeFoldBlockType in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat] then StartPascalCodeFoldBlock(cfbtCase); Result := tkKey; end else Result := tkIdentifier; end; {$IFDEF SYN_LAZARUS} function TSynPasSyn.Func29: TtkTokenKind; begin if KeyComp('On') then Result := tkKey else Result := tkIdentifier; end; {$ENDIF} function TSynPasSyn.Func32: TtkTokenKind; begin if KeyComp('Label') then Result := tkKey else if KeyComp('Mod') then Result := tkKey else if KeyComp('File') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func33: TtkTokenKind; begin if KeyComp('Or') then Result := tkKey else if KeyComp('Asm') then begin Result := tkKey; fRange := fRange + [rsAsm]; fAsmStart := True; {$IFDEF SYN_LAZARUS} StartPascalCodeFoldBlock(cfbtAsm); //debugln('TSynPasSyn.Func37 BEGIN ',dbgs(ord(TopPascalCodeFoldBlockType)),' LineNumber=',dbgs(fLineNumber),' ',dbgs(MinimumCodeFoldBlockLevel),' ',dbgs(CurrentCodeFoldBlockLevel)); {$ENDIF} end else Result := tkIdentifier; end; function TSynPasSyn.Func35: TtkTokenKind; begin if KeyComp('Nil') then Result := tkKey else if KeyComp('To') then Result := tkKey else if KeyComp('Div') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func37: TtkTokenKind; begin if KeyComp('Begin') then begin // if we are in an include file, we may not know the state if (fRange * [rsImplementation, rsInterface] = []) then Include(fRange, rsImplementation); PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; Result := tkKey; if TopPascalCodeFoldBlockType in [cfbtProcedure] then StartPascalCodeFoldBlock(cfbtTopBeginEnd) else StartPascalCodeFoldBlock(cfbtBeginEnd); //debugln('TSynPasSyn.Func37 BEGIN ',dbgs(ord(TopPascalCodeFoldBlockType)),' LineNumber=',dbgs(fLineNumber),' ',dbgs(MinimumCodeFoldBlockLevel),' ',dbgs(CurrentCodeFoldBlockLevel)); end else Result := tkIdentifier; end; function TSynPasSyn.Func38: TtkTokenKind; begin if KeyComp('Near') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func39: TtkTokenKind; begin if KeyComp('For') then Result := tkKey else if KeyComp('Shl') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func40: TtkTokenKind; begin if KeyComp('Packed') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func41: TtkTokenKind; begin if KeyComp('Else') then Result := tkKey else if KeyComp('Var') then begin if (PasCodeFoldRange.BracketNestLevel = 0) and (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtNone, cfbtProcedure, cfbtProgram, cfbtUnit, cfbtUnitSection]) then begin if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType in [cfbtProcedure] then StartPascalCodeFoldBlock(cfbtLocalVarType) else StartPascalCodeFoldBlock(cfbtVarType); end; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func42: TtkTokenKind; begin if KeyComp('Alias') then Result := tkKey else if KeyComp('Final') and (TopPascalCodeFoldBlockType in [cfbtClassSection]) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func44: TtkTokenKind; begin if KeyComp('Set') then Result := tkKey else if KeyComp('Package') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func45: TtkTokenKind; begin if KeyComp('Shr') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func46: TtkTokenKind; begin if KeyComp('Sealed') and (TopPascalCodeFoldBlockType in [cfbtClass]) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func47: TtkTokenKind; begin if KeyComp('Then') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func49: TtkTokenKind; begin if KeyComp('Not') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func52: TtkTokenKind; begin if KeyComp('Pascal') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else if KeyComp('Raise') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func54: TtkTokenKind; begin if KeyComp('Class') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func55: TtkTokenKind; begin if KeyComp('Object') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func56: TtkTokenKind; begin if KeyComp('Index') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else if KeyComp('Out') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func57: TtkTokenKind; begin if KeyComp('Goto') then Result := tkKey else if KeyComp('While') then Result := tkKey else if KeyComp('Xor') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func59: TtkTokenKind; begin if KeyComp('Safecall') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func60: TtkTokenKind; begin if KeyComp('With') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func61: TtkTokenKind; begin if KeyComp('Dispid') {$IFDEF SYN_LAZARUS}or KeyComp('Generic'){$ENDIF}then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func63: TtkTokenKind; begin if KeyComp('Public') then begin Result := tkKey; if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then begin if (TopPascalCodeFoldBlockType=cfbtClassSection) then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtClassSection); end; end else if KeyComp('Record') then begin StartPascalCodeFoldBlock(cfbtRecord); Result := tkKey; end else if KeyComp('Array') then Result := tkKey else if KeyComp('Try') then begin if TopPascalCodeFoldBlockType in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat] then StartPascalCodeFoldBlock(cfbtTry); Result := tkKey; end else if KeyComp('Inline') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func64: TtkTokenKind; begin if KeyComp('Unit') then begin if TopPascalCodeFoldBlockType=cfbtNone then StartPascalCodeFoldBlock(cfbtUnit); Result := tkKey; end else if KeyComp('Uses') then begin if (TopPascalCodeFoldBlockType in [cfbtNone, cfbtProgram, cfbtUnit, cfbtUnitSection]) then begin StartPascalCodeFoldBlock(cfbtUses); end; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func65: TtkTokenKind; begin if KeyComp('Repeat') then begin Result := tkKey; SmartCloseBeginEndBlocks(cfbtRepeat); StartPascalCodeFoldBlock(cfbtRepeat); end else Result := tkIdentifier; end; function TSynPasSyn.Func66: TtkTokenKind; begin if KeyComp('Type') then begin if (PasCodeFoldRange.BracketNestLevel = 0) and (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtNone, cfbtProcedure, cfbtProgram, cfbtUnit, cfbtUnitSection]) and not(rsAfterEqual in fRange) then begin if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType in [cfbtProcedure] then StartPascalCodeFoldBlock(cfbtLocalVarType) else StartPascalCodeFoldBlock(cfbtVarType); end; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func69: TtkTokenKind; begin if KeyComp('Default') then begin if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then Result := tkKey else Result := tkIdentifier; end else if KeyComp('Dynamic') then Result := tkKey else if KeyComp('Message') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func71: TtkTokenKind; begin if KeyComp('Stdcall') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else if KeyComp('Const') then begin if (PasCodeFoldRange.BracketNestLevel = 0) and (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtNone, cfbtProcedure, cfbtProgram, cfbtUnit, cfbtUnitSection]) then begin if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType in [cfbtProcedure] then StartPascalCodeFoldBlock(cfbtLocalVarType) else StartPascalCodeFoldBlock(cfbtVarType); end; Result := tkKey; end {$IFDEF SYN_LAZARUS} else if KeyComp('Bitpacked') then Result := tkKey {$ENDIF} else Result := tkIdentifier; end; function TSynPasSyn.Func72: TtkTokenKind; begin if KeyComp('Static') and (TopPascalCodeFoldBlockType in [cfbtClassSection]) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func73: TtkTokenKind; begin if KeyComp('Except') then begin Result := tkKey; SmartCloseBeginEndBlocks(cfbtTry); if TopPascalCodeFoldBlockType = cfbtTry then StartPascalCodeFoldBlock(cfbtExcept); end else Result := tkIdentifier; end; function TSynPasSyn.Func75: TtkTokenKind; begin if KeyComp('Write') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else Result := tkIdentifier; end; function TSynPasSyn.Func76: TtkTokenKind; begin if KeyComp('Until') then begin Result := tkKey; if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock; end else Result := tkIdentifier; end; function TSynPasSyn.Func79: TtkTokenKind; begin if KeyComp('Finally') then begin Result := tkKey; SmartCloseBeginEndBlocks(cfbtTry); if TopPascalCodeFoldBlockType = cfbtTry then StartPascalCodeFoldBlock(cfbtExcept); end else Result := tkIdentifier; end; function TSynPasSyn.Func81: TtkTokenKind; begin if KeyComp('Stored') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else if KeyComp('Interface') then begin if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end else if not(rsAfterEqual in fRange) and (fRange * [rsInterface, rsImplementation] = []) then begin CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType=cfbtUnitSection then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtUnitSection); fRange := fRange + [rsInterface]; // Interface has no ";", implicit end of statement end; Result := tkKey end else if KeyComp('Deprecated') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func84: TtkTokenKind; begin if KeyComp('Abstract') and (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then Result := tkKey else if KeyComp('ObjcClass') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func85: TtkTokenKind; begin if KeyComp('Forward') then begin Result := tkKey; if TopPascalCodeFoldBlockType = cfbtProcedure then begin EndPascalCodeFoldBlock(True); end; end else if KeyComp('Library') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func86: TtkTokenKind; begin if KeyComp('VarArgs') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func87: TtkTokenKind; begin if KeyComp('String') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func88: TtkTokenKind; begin if KeyComp('Program') then begin fRange := fRange - [rsInterface] + [rsImplementation]; if TopPascalCodeFoldBlockType=cfbtNone then StartPascalCodeFoldBlock(cfbtProgram); Result := tkKey; end else if KeyComp('Mwpascal') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func89: TtkTokenKind; function ScanForClassSection: Boolean; var Txt: String; NestBrace1, NestBrace2: Integer; i, l, Idx: Integer; begin Result := False; Txt := copy(fLine, Run + 7, length(fLine)); Idx := LineIndex; NestBrace1 := 0; NestBrace2 := 0; while true do begin i := 1; l := length(Txt); while i <= l do begin case Txt[i] of '{' : if (NestBrace2 = 0) and (NestedComments or (NestBrace1 = 0)) then inc(NestBrace1); '}' : if (NestBrace2 = 0) then if NestBrace1 > 0 then dec(NestBrace1) else exit; '(' : if (NestBrace1 = 0) then if (i+1 > l) or (Txt[i+1] <> '*') then exit else if NestedComments or (NestBrace2 = 0) then begin inc(NestBrace2); inc(i); end; '*' : if (NestBrace1 = 0) then if (i+1 <= l) and (Txt[i+1] = ')') and (NestBrace2 > 0) then begin dec(NestBrace2); inc(i); end else if NestBrace2 = 0 then exit; '/' : If (NestBrace1 = 0) and (NestBrace2 = 0) then begin if (i+1 <= l) and (Txt[i+1] = '/') then i := l else exit; end; #1..#32: {do nothing}; 'p', 'P' : If (NestBrace1 = 0) and (NestBrace2 = 0) then begin if ( (i+6 <= l) and ((i+6 = l) or (Txt[i+7] in [#1..#32])) and (AnsiStrComp(PChar(copy(Txt, i+1, 6)), PChar('rivate')) = 0) ) or ( (i+8 <= l) and ((i+8 = l) or (Txt[i+9] in [#1..#32])) and (AnsiStrComp(PChar(copy(Txt, i+1, 8)), PChar('rotected')) = 0) ) then exit(True) else exit; end; else If (NestBrace1 = 0) and (NestBrace2 = 0) then exit; end; inc(i); end; inc(Idx); if Idx < CurrentLines.Count then Txt := CurrentLines[Idx] else break; end; end; begin if KeyComp('CppClass') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; // Structural Scan / Quick if FIsInNextToEOL and not FCatchNodeInfo then exit; // Scanning for display / Look ahead if KeyComp('strict') then begin if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then if ScanForClassSection then Result := tkKey; end; end; function TSynPasSyn.Func91: TtkTokenKind; begin if KeyComp('Downto') then Result := tkKey else if KeyComp('Private') then begin Result := tkKey; if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then begin if (TopPascalCodeFoldBlockType=cfbtClassSection) then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtClassSection); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func92: TtkTokenKind; begin if D4syntax and KeyComp('overload') then Result := tkKey else if KeyComp('Inherited') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func94: TtkTokenKind; begin if KeyComp('Assembler') then Result := tkKey else if KeyComp('Readonly') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else Result := tkIdentifier; end; function TSynPasSyn.Func95: TtkTokenKind; begin if KeyComp('Absolute') then Result := tkKey else if KeyComp('Contains') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func96: TtkTokenKind; begin if KeyComp('Published') then begin Result := tkKey; if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then begin if (TopPascalCodeFoldBlockType=cfbtClassSection) then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtClassSection); end; end else if KeyComp('Override') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func97: TtkTokenKind; begin if KeyComp('Threadvar') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func98: TtkTokenKind; begin if KeyComp('Export') then Result := tkKey else if KeyComp('Nodefault') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else Result := tkIdentifier; end; function TSynPasSyn.Func99: TtkTokenKind; begin if KeyComp('External') then begin Result := tkKey; if TopPascalCodeFoldBlockType = cfbtProcedure then begin EndPascalCodeFoldBlock(True); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func100: TtkTokenKind; begin if KeyComp('Automated') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func101: TtkTokenKind; begin if KeyComp('Register') and (TopPascalCodeFoldBlockType in ProcModifierAllowed) then Result := tkKey else if KeyComp('Platform') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func102: TtkTokenKind; begin if KeyComp('Function') then begin if not(rsAfterEqual in fRange) then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if ((rsImplementation in fRange) and not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection])) then StartPascalCodeFoldBlock(cfbtProcedure); end; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func103: TtkTokenKind; begin if KeyComp('Virtual') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func105: TtkTokenKind; begin if KeyComp('Procedure') then begin if not(rsAfterEqual in fRange) then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if ((rsImplementation in fRange) and not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection])) then StartPascalCodeFoldBlock(cfbtProcedure); end; Result := tkKey; end {$IFDEF SYN_LAZARUS} else if KeyComp('specialize') then Result := tkKey {$ENDIF} else Result := tkIdentifier; end; function TSynPasSyn.Func106: TtkTokenKind; begin if KeyComp('Protected') then begin Result := tkKey; if (TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]) then begin if (TopPascalCodeFoldBlockType=cfbtClassSection) then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtClassSection); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func108: TtkTokenKind; begin if KeyComp('Operator') then begin if not(rsAfterEqual in fRange) then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if ((rsImplementation in fRange) and not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection])) then StartPascalCodeFoldBlock(cfbtProcedure); end; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func112: TtkTokenKind; begin if KeyComp('Requires') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func117: TtkTokenKind; begin if KeyComp('Exports') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func122: TtkTokenKind; begin if KeyComp('Otherwise') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func126: TtkTokenKind; begin if D4syntax and KeyComp('Implements') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else if KeyComp('NoStackFrame') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func128: TtkTokenKind; begin if KeyComp('Widestring') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func129: TtkTokenKind; begin if KeyComp('Dispinterface') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func130: TtkTokenKind; begin if KeyComp('Ansistring') then Result := tkKey else if KeyComp('Enumerator') and (TopPascalCodeFoldBlockType in [cfbtClassSection]) then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func132: TtkTokenKind; begin if D4syntax and KeyComp('Reintroduce') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func133: TtkTokenKind; begin if KeyComp('Property') then begin Result := tkKey; fRange := fRange + [rsProperty]; end else Result := tkIdentifier; end; function TSynPasSyn.Func136: TtkTokenKind; begin if KeyComp('Finalization') then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType=cfbtUnitSection then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtUnitSection); fRange := fRange - [rsInterface] + [rsImplementation]; Result := tkKey end else Result := tkIdentifier; end; function TSynPasSyn.Func139: TtkTokenKind; begin if KeyComp('WeakExternal') then begin Result := tkKey; if TopPascalCodeFoldBlockType = cfbtProcedure then EndPascalCodeFoldBlock(True); end else Result := tkIdentifier; end; function TSynPasSyn.Func141: TtkTokenKind; begin if KeyComp('Writeonly') then begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else Result := tkIdentifier; end; function TSynPasSyn.Func142: TtkTokenKind; begin if KeyComp('Experimental') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func143: TtkTokenKind; begin if KeyComp('Destructor') then begin if not(rsAfterEqual in fRange) then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if ((rsImplementation in fRange) and not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection])) then StartPascalCodeFoldBlock(cfbtProcedure); end; Result := tkKey; end else if KeyComp('compilerproc') then // fpc modifier Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func144: TtkTokenKind; begin if KeyComp('ObjcProtocol') then begin Result := tkKey; if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin fRange := fRange + [rsAtClass]; StartPascalCodeFoldBlock(cfbtClass); end; end else Result := tkIdentifier; end; function TSynPasSyn.Func151: TtkTokenKind; begin if KeyComp('Unimplemented') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func166: TtkTokenKind; begin if KeyComp('Constructor') then begin if not(rsAfterEqual in fRange) then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if ((rsImplementation in fRange) and not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection])) then StartPascalCodeFoldBlock(cfbtProcedure); end; Result := tkKey; end else if KeyComp('Implementation') then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType=cfbtUnitSection then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtUnitSection); fRange := fRange - [rsInterface] + [rsImplementation]; // implicit end of statement Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func167: TtkTokenKind; begin if KeyComp('Shortstring') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.Func168: TtkTokenKind; begin if KeyComp('Initialization') then begin PasCodeFoldRange.BracketNestLevel := 0; // Reset in case of partial code CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType=cfbtUnitSection then EndPascalCodeFoldBlockLastLine; StartPascalCodeFoldBlock(cfbtUnitSection); fRange := fRange - [rsInterface] + [rsImplementation]; Result := tkKey; end else Result := tkIdentifier; end; function TSynPasSyn.Func191: TtkTokenKind; begin if KeyComp('Resourcestring') then Result := tkKey else if KeyComp('Stringresource') then Result := tkKey else Result := tkIdentifier; end; function TSynPasSyn.AltFunc: TtkTokenKind; begin Result := tkIdentifier end; {$IFDEF SYN_LAZARUS} function TSynPasSyn.IdentKind(p: integer): TtkTokenKind; var HashKey: Integer; begin fToIdent := p; HashKey := KeyHash; if HashKey < 192 then Result := fIdentFuncTable[HashKey]{$IFDEF FPC}(){$ENDIF} else Result := tkIdentifier; end; {$ELSE} function TSynPasSyn.IdentKind(MayBe: PChar): TtkTokenKind; var HashKey: Integer; begin fToIdent := MayBe; HashKey := KeyHash(MayBe); if HashKey < 192 then Result := fIdentFuncTable[HashKey]{$IFDEF FPC}(){$ENDIF} else Result := tkIdentifier; end; {$ENDIF} procedure TSynPasSyn.MakeMethodTables; var I: Char; begin for I := #0 to #255 do {$IFDEF FPC} case I of #0: fProcTable[I] := @NullProc; #10: fProcTable[I] := @LFProc; #13: fProcTable[I] := @CRProc; #1..#9, #11, #12, #14..#32: fProcTable[I] := @SpaceProc; '#': fProcTable[I] := @AsciiCharProc; '$': fProcTable[I] := @HexProc; '%': fProcTable[I] := @BinaryProc; '&': fProcTable[I] := @OctalProc; #39: fProcTable[I] := @StringProc; '0'..'9': fProcTable[I] := @NumberProc; 'A'..'Z', 'a'..'z', '_': fProcTable[I] := @IdentProc; '{': fProcTable[I] := @BraceOpenProc; '}', '!', '"', '('..'/', ':'..'@', '['..'^', '`', '~': begin case I of '(': fProcTable[I] := @RoundOpenProc; ')': fProcTable[I] := @RoundCloseProc; '[': fProcTable[I] := @SquareOpenProc; ']': fProcTable[I] := @SquareCloseProc; '=': fProcTable[I] := @EqualSignProc; '.': fProcTable[I] := @PointProc; ';': fProcTable[I] := @SemicolonProc; //mh 2000-10-08 '/': fProcTable[I] := @SlashProc; ':', '>': fProcTable[I] := @ColonOrGreaterProc; '<': fProcTable[I] := @LowerProc; '@': fProcTable[I] := @AddressOpProc; else fProcTable[I] := @SymbolProc; end; end; else fProcTable[I] := @UnknownProc; end; {$ELSE} case I of #0: fProcTable[I] := NullProc; #10: fProcTable[I] := LFProc; #13: fProcTable[I] := CRProc; #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc; '#': fProcTable[I] := AsciiCharProc; '$': fProcTable[I] := HexProc; #39: fProcTable[I] := StringProc; '0'..'9': fProcTable[I] := NumberProc; 'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc; '{': fProcTable[I] := BraceOpenProc; '}', '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~': begin case I of '(': fProcTable[I] := RoundOpenProc; ')': fProcTable[I] := RoundCloseProc; '[': fProcTable[I] := SquareOpenProc; ']': fProcTable[I] := SquareCloseProc; '=': fProcTable[I] := EqualSignProc; '.': fProcTable[I] := PointProc; ';': fProcTable[I] := SemicolonProc; //mh 2000-10-08 '/': fProcTable[I] := SlashProc; ':', '>': fProcTable[I] := ColonOrGreaterProc; '<': fProcTable[I] := LowerProc; '@': fProcTable[I] := AddressOpProc; else fProcTable[I] := SymbolProc; end; end; else fProcTable[I] := UnknownProc; end; {$ENDIF} end; constructor TSynPasSyn.Create(AOwner: TComponent); begin inherited Create(AOwner); CreateDividerDrawConfig; fD4syntax := true; fAsmAttri := TSynHighlighterAttributes.Create(SYNS_AttrAssembler, SYNS_XML_AttrAssembler); AddAttribute(fAsmAttri); fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment, SYNS_XML_AttrComment); fCommentAttri.Style:= [fsItalic]; AddAttribute(fCommentAttri); fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier, SYNS_XML_AttrIdentifier); AddAttribute(fIdentifierAttri); fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord, SYNS_XML_AttrReservedWord); fKeyAttri.Style:= [fsBold]; AddAttribute(fKeyAttri); fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber, SYNS_XML_AttrNumber); AddAttribute(fNumberAttri); fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace, SYNS_XML_AttrSpace); AddAttribute(fSpaceAttri); fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString, SYNS_XML_AttrString); AddAttribute(fStringAttri); fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol, SYNS_XML_AttrSymbol); AddAttribute(fSymbolAttri); FCaseLabelAttri := TSynHighlighterAttributes.Create(SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel); FCaseLabelAttri.Features := FCaseLabelAttri.Features + [hafStyleMask]; AddAttribute(FCaseLabelAttri); FCurCaseLabelAttri := TSynHighlighterAttributes.Create(SYNS_AttrCaseLabel, SYNS_XML_AttrCaseLabel); {$IFDEF SYN_LAZARUS} fDirectiveAttri := TSynHighlighterAttributes.Create(SYNS_AttrDirective, SYNS_XML_AttrDirective); fDirectiveAttri.Style:= [fsItalic]; AddAttribute(fDirectiveAttri); CompilerMode:=pcmDelphi; {$ENDIF} SetAttributesOnChange({$IFDEF FPC}@{$ENDIF}DefHighlightChange); InitIdent; MakeMethodTables; fRange := []; fAsmStart := False; fDefaultFilter := SYNS_FilterPascal; FNodeInfoLine := -1; end; { Create } destructor TSynPasSyn.Destroy; begin DestroyDividerDrawConfig; FreeAndNil(FCurCaseLabelAttri); inherited Destroy; end; procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer); begin //DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']); fLineStr := NewValue; fLineLen:=length(fLineStr); fLine:=PChar(Pointer(fLineStr)); Run := 0; Inherited SetLine(NewValue,LineNumber); FStartCodeFoldBlockLevel := MinimumCodeFoldBlockLevel; PasCodeFoldRange.LastLineCodeFoldLevelFix := 0; PasCodeFoldRange.PasFoldFixLevel := 0; PasCodeFoldRange.PasFoldMinLevel := PasCodeFoldRange.PasFoldEndLevel; FPasStartLevel := PasCodeFoldRange.PasFoldMinLevel; FSynPasRangeInfo.MinLevelIfDef := FSynPasRangeInfo.EndLevelIfDef; FSynPasRangeInfo.MinLevelRegion := FSynPasRangeInfo.EndLevelRegion; FNodeInfoLine := -1; fLineNumber := LineNumber; FAtLineStart := True; if not FCatchNodeInfo then Next; end; { SetLine } procedure TSynPasSyn.AddressOpProc; begin fTokenID := tkSymbol; inc(Run); if fLine[Run] = '@' then inc(Run); end; procedure TSynPasSyn.AsciiCharProc; begin fTokenID := tkString; inc(Run); case FLine[Run] of '%': begin inc(Run); if (FLine[Run] in ['0'..'1']) then while (FLine[Run] in ['0'..'1']) do inc(Run) else fTokenID := tkSymbol; end; '&': begin inc(Run); if (FLine[Run] in ['0'..'7']) then while (FLine[Run] in ['0'..'7']) do inc(Run) else fTokenID := tkSymbol; end; '$': begin inc(Run); if (IsIntegerChar[FLine[Run]]) then while (IsIntegerChar[FLine[Run]]) do inc(Run) else fTokenID := tkSymbol; end; '0'..'9': while (FLine[Run] in ['0'..'9']) do inc(Run); else fTokenID := tkSymbol; end; end; procedure TSynPasSyn.BorProc; begin {$IFDEF SYN_LAZARUS} fTokenID := tkComment; repeat case fLine[Run] of #0: break; '}': if TopPascalCodeFoldBlockType=cfbtNestedComment then EndPascalCodeFoldBlock else begin fRange := fRange - [rsBor]; Inc(Run); break; end; '{': if NestedComments then begin fStringLen := 1; StartPascalCodeFoldBlock(cfbtNestedComment); end; end; Inc(Run); until (Run>=fLineLen) or (fLine[Run] in [#0, #10, #13]); {$ELSE} case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else begin fTokenID := tkComment; repeat if fLine[Run] = '}' then begin Inc(Run); fRange := fRange - [rsBor]; break; end; Inc(Run); until (fLine[Run] in [#0, #10, #13]); end; end; {$ENDIF} end; {$IFDEF SYN_LAZARUS} procedure TSynPasSyn.DirectiveProc; begin fTokenID := tkDirective; if TextComp('mode') then begin // $mode directive inc(Run,4); // skip space while (fLine[Run] in [' ',#9,#10,#13]) do inc(Run); if TextComp('objfpc') then CompilerMode:=pcmObjFPC else if TextComp('delphi') then CompilerMode:=pcmDelphi else if TextComp('fpc') then CompilerMode:=pcmFPC else if TextComp('gpc') then CompilerMode:=pcmGPC else if TextComp('tp') then CompilerMode:=pcmTP else if TextComp('macpas') then CompilerMode:=pcmMacPas; end; repeat case fLine[Run] of #0,#10,#13: break; '}': if TopPascalCodeFoldBlockType=cfbtNestedComment then EndPascalCodeFoldBlock else begin fRange := fRange - [rsDirective]; Inc(Run); break; end; '{': if NestedComments then begin fStringLen := 1; StartPascalCodeFoldBlock(cfbtNestedComment); end; end; Inc(Run); until (Run>=fLineLen); //DebugLn(['TSynPasSyn.DirectiveProc Run=',Run,' fTokenPos=',fTokenPos,' fLineStr=',fLineStr,' Token=',GetToken]); end; {$ENDIF} procedure TSynPasSyn.BraceOpenProc; function ScanRegion: Boolean; var Txt: String; Idx, NestBrace, i, l: Integer; InString: Boolean; begin Result := False; Txt := copy(fLine, Run, length(fLine)); Idx := LineIndex; InString := False; NestBrace := 0; while true do begin i := 1; l := length(Txt); while i <= l do begin case Txt[i] of '{' : inc(NestBrace); '}' : if NestBrace = 0 then exit else dec(NestBrace); '''' : if (i+1 <= l) and (Txt[i+1] = '''') then inc(i) else InString := not InString; '-', '/' : If (not InString) and (i+4 <= l) and ((i=1) or (Txt[i-1] in [' ', #9, #10, #13])) and (AnsiStrComp(PChar(copy(Txt, i+1, 4)), PChar('fold')) = 0) and ((i+4 = l) or (Txt[i+5] in [' ', #9, #10, #13, '}'])) then exit(True); end; inc(i); end; inc(Idx); if Idx < CurrentLines.Count then Txt := CurrentLines[Idx] else break; end; end; begin if (Run < fLineLen-1) and (fLine[Run+1] = '$') then begin // compiler directive fRange := fRange + [rsDirective]; inc(Run,2); fToIdent := Run; KeyHash; if KeyComp('ifdef') or KeyComp('ifndef') then StartCustomCodeFoldBlock(cfbtIfDef) else if KeyComp('endif') then EndCustomCodeFoldBlock(cfbtIfDef) else if KeyComp('else') then begin EndCustomCodeFoldBlock(cfbtIfDef); StartCustomCodeFoldBlock(cfbtIfDef); end else if KeyComp('region') then begin StartCustomCodeFoldBlock(cfbtRegion); if FCatchNodeInfo then // Scan ahead if ScanRegion and (FNodeInfoCount > 0) then FNodeInfoList[FNodeInfoCount-1].FoldAction := FNodeInfoList[FNodeInfoCount-1].FoldAction + [sfaDefaultCollapsed]; end else if KeyComp('endregion') then EndCustomCodeFoldBlock(cfbtRegion); DirectiveProc; end else begin // curly bracket open -> borland comment inc(Run); fRange := fRange + [rsBor]; if (Run < fLineLen) and (fLine[Run] = '%') then begin inc(Run); fToIdent := Run; KeyHash; if KeyComp('region') then begin StartCustomCodeFoldBlock(cfbtRegion); if FCatchNodeInfo then // Scan ahead if ScanRegion and (FNodeInfoCount > 0) then FNodeInfoList[FNodeInfoCount-1].FoldAction := FNodeInfoList[FNodeInfoCount-1].FoldAction + [sfaDefaultCollapsed]; end else if KeyComp('endregion') then EndCustomCodeFoldBlock(cfbtRegion); end; BorProc; end; end; procedure TSynPasSyn.ColonOrGreaterProc; begin fTokenID := tkSymbol; inc(Run); if fLine[Run] = '=' then inc(Run); fRange := fRange - [rsAtCaseLabel]; end; procedure TSynPasSyn.CRProc; begin fTokenID := tkSpace; inc(Run); if fLine[Run] = #10 then inc(Run); end; procedure TSynPasSyn.IdentProc; begin fTokenID := IdentKind(Run); inc(Run, fStringLen); while Identifiers[fLine[Run]] do inc(Run); end; procedure TSynPasSyn.HexProc; begin inc(Run); if (IsIntegerChar[FLine[Run]]) then begin fTokenID := tkNumber; while (IsIntegerChar[FLine[Run]]) do inc(Run); end else fTokenID := tkSymbol; end; procedure TSynPasSyn.BinaryProc; begin inc(Run); if FLine[Run] in ['0'..'1'] then begin fTokenID := tkNumber; while FLine[Run] in ['0'..'1'] do inc(Run); end else fTokenID := tkSymbol; end; procedure TSynPasSyn.OctalProc; begin inc(Run); if FLine[Run] in ['0'..'7'] then begin fTokenID := tkNumber; while FLine[Run] in ['0'..'7'] do inc(Run); end else fTokenID := tkSymbol; end; procedure TSynPasSyn.LFProc; begin fTokenID := tkSpace; inc(Run); end; procedure TSynPasSyn.LowerProc; begin fTokenID := tkSymbol; inc(Run); if fLine[Run] in ['=', '>'] then inc(Run); end; procedure TSynPasSyn.NullProc; begin fTokenID := tkNull; {$IFDEF SYN_LAZARUS} if Run=fLineLen) or (fLine[Run] in [#0, #10, #13]); {$ELSE} case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else fTokenID := tkComment; repeat if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then begin Inc(Run, 2); fRange := fRange - [rsAnsi]; break; end; Inc(Run); until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]); end; {$ENDIF} end; procedure TSynPasSyn.RoundOpenProc; begin Inc(Run); {$IFDEF SYN_LAZARUS} if Run>=fLineLen then begin fTokenID:=tkSymbol; PasCodeFoldRange.IncBracketNestLevel; exit; end; {$ENDIF} case fLine[Run] of '*': begin Inc(Run); // We would not be here, if we were in a comment or directive already fRange := fRange + [rsAnsi]; fTokenID := tkComment; if not (fLine[Run] in [#0, #10, #13]) then begin AnsiProc; end; end; '.': begin inc(Run); fTokenID := tkSymbol; PasCodeFoldRange.IncBracketNestLevel; end; else fTokenID := tkSymbol; PasCodeFoldRange.IncBracketNestLevel; end; end; procedure TSynPasSyn.RoundCloseProc; begin inc(Run); fTokenID := tkSymbol; PasCodeFoldRange.DecBracketNestLevel; fRange := fRange + [rsAtClosingBracket]; end; procedure TSynPasSyn.SquareOpenProc; begin inc(Run); fTokenID := tkSymbol; PasCodeFoldRange.IncBracketNestLevel; end; procedure TSynPasSyn.SquareCloseProc; begin inc(Run); fTokenID := tkSymbol; PasCodeFoldRange.DecBracketNestLevel; end; procedure TSynPasSyn.EqualSignProc; begin inc(Run); fTokenID := tkSymbol; fRange := fRange + [rsAtEqual]; end; procedure TSynPasSyn.SemicolonProc; var tfb: TPascalCodeFoldBlockType; begin Inc(Run); fTokenID := tkSymbol; tfb := TopPascalCodeFoldBlockType; if tfb = cfbtUses then EndPascalCodeFoldBlock; if (tfb = cfbtClass) and (rsAfterClass in fRange) then EndPascalCodeFoldBlock(True); if (tfb = cfbtCase) then fRange := fRange + [rsAtCaseLabel]; if (rsProperty in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then fRange := fRange - [rsProperty]; end; procedure TSynPasSyn.SlashProc; begin Inc(Run); if fLine[Run] = '/' then begin fTokenID := tkComment; repeat Inc(Run); until fLine[Run] in [#0, #10, #13]; end else fTokenID := tkSymbol; end; procedure TSynPasSyn.SpaceProc; begin inc(Run); fTokenID := tkSpace; {$IFDEF SYN_LAZARUS} while IsSpaceChar[FLine[Run]] do inc(Run); {$ELSE} while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run); {$ENDIF} end; procedure TSynPasSyn.StringProc; begin fTokenID := tkString; Inc(Run); {$IFDEF SYN_LAZARUS} while (not (fLine[Run] in [#0, #10, #13])) do begin if fLine[Run] = '''' then begin Inc(Run); if (fLine[Run] <> '''') then break; end; Inc(Run); end; {$ELSE} while not (fLine[Run] in [#0, #10, #13]) do begin if fLine[Run] = #39 then begin Inc(Run); if fLine[Run] <> #39 then break; end; Inc(Run); end; {$ENDIF} end; procedure TSynPasSyn.SymbolProc; begin inc(Run); fTokenID := tkSymbol; end; procedure TSynPasSyn.UnknownProc; begin inc(Run); {$IFDEF SYN_LAZARUS} while (fLine[Run] in [#128..#191]) OR // continued utf8 subcode ((fLine[Run]<>#0) and (fProcTable[fLine[Run]] = @UnknownProc)) do inc(Run); {$ENDIF} fTokenID := tkUnknown; end; procedure TSynPasSyn.Next; var IsAtCaseLabel: Boolean; begin fAsmStart := False; fTokenPos := Run; FTokenIsCaseLabel := False; {$IFDEF SYN_LAZARUS} if Run>=fLineLen then begin fTokenID := tkNull; exit; end; case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else {$ENDIF} if rsAnsi in fRange then AnsiProc else if rsBor in fRange then BorProc {$IFDEF SYN_LAZARUS} else if rsDirective in fRange then DirectiveProc {$ENDIF} else begin if rsAtEqual in fRange then fRange := fRange + [rsAfterEqual] - [rsAtEqual] else if rsAtClass in fRange then fRange := fRange + [rsAfterClass] - [rsAtClass]; IsAtCaseLabel := rsAtCaseLabel in fRange; fProcTable[fLine[Run]]; if (IsAtCaseLabel) and (rsAtCaseLabel in fRange) then begin FTokenIsCaseLabel := True; if (FTokenID = tkKey) then fRange := fRange - [rsAtCaseLabel]; end; if not (FTokenID in [tkSpace, tkComment, tkDirective]) then begin if (PasCodeFoldRange.BracketNestLevel = 0) and not(rsAtClosingBracket in fRange) then fRange := fRange - [rsAfterClass]; fRange := fRange - [rsAfterEqual, rsAtClosingBracket]; end else fRange := fRange - [rsAtClosingBracket]; end {$IFDEF SYN_LAZARUS} end; {$ENDIF} if not(FTokenID in [tkSpace, tkComment]) then FAtLineStart := False; //DebugLn(['TSynPasSyn.Next Run=',Run,' fTokenPos=',fTokenPos,' fLineStr=',fLineStr,' Token=',GetToken]); end; function TSynPasSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; begin case Index of SYN_ATTR_COMMENT: Result := fCommentAttri; SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri; SYN_ATTR_KEYWORD: Result := fKeyAttri; SYN_ATTR_STRING: Result := fStringAttri; SYN_ATTR_WHITESPACE: Result := fSpaceAttri; else Result := nil; end; end; function TSynPasSyn.GetEol: Boolean; begin Result := (fTokenID = tkNull) {$IFDEF SYN_LAZARUS}and (Run >= fLineLen){$ENDIF}; end; function TSynPasSyn.GetToken: string; var Len: LongInt; begin Len := Run - fTokenPos; {$IFDEF SYN_LAZARUS} SetLength(Result,Len); if Len>0 then System.Move(fLine[fTokenPos],Result[1],Len); {$ELSE} SetString(Result, (FLine + fTokenPos), Len); {$ENDIF} end; {$IFDEF SYN_LAZARUS} procedure TSynPasSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer); begin TokenLength:=Run-fTokenPos; if TokenLength>0 then begin TokenStart:=@fLine[fTokenPos]; end else begin TokenStart:=nil; end; end; {$ENDIF} function TSynPasSyn.GetTokenID: TtkTokenKind; begin if not fAsmStart and (fRange * [rsAnsi, rsBor, rsDirective, rsAsm] = [rsAsm]) and not (fTokenId in [tkNull, tkComment, tkSpace, tkDirective]) then Result := tkAsm else Result := fTokenId; end; function TSynPasSyn.GetTokenAttribute: TSynHighlighterAttributes; var sMask: TFontStyles; begin case GetTokenID of tkAsm: Result := fAsmAttri; tkComment: Result := fCommentAttri; tkIdentifier: Result := fIdentifierAttri; tkKey: Result := fKeyAttri; tkNumber: Result := fNumberAttri; tkSpace: Result := fSpaceAttri; tkString: Result := fStringAttri; tkSymbol: Result := fSymbolAttri; {$IFDEF SYN_LAZARUS} tkDirective: Result := fDirectiveAttri; {$ENDIF} tkUnknown: Result := fSymbolAttri; else Result := nil; end; if FTokenIsCaseLabel and (GetTokenID in [tkIdentifier, tkKey, tkNumber, tkString]) then begin FCurCaseLabelAttri.Assign(Result); Result := FCurCaseLabelAttri; if FCaseLabelAttri.Background <> clNone then Result.Background := FCaseLabelAttri.Background; if FCaseLabelAttri.Foreground <> clNone then Result.Foreground := FCaseLabelAttri.Foreground; if FCaseLabelAttri.FrameColor <> clNone then Result.FrameColor := FCaseLabelAttri.FrameColor; sMask := FCaseLabelAttri.StyleMask + (fsNot(FCaseLabelAttri.StyleMask) * FCaseLabelAttri.Style); // Styles to be taken from FCaseLabelAttri Result.Style:= (Result.Style * fsNot(sMask)) + (FCaseLabelAttri.Style * sMask); Result.StyleMask:= (Result.StyleMask * fsNot(sMask)) + (FCaseLabelAttri.StyleMask * sMask); end; end; function TSynPasSyn.GetTokenKind: integer; begin Result := Ord(GetTokenID); end; function TSynPasSyn.GetTokenPos: Integer; begin Result := fTokenPos; end; function TSynPasSyn.GetRange: Pointer; begin // For speed reasons, we work with fRange instead of CodeFoldRange.RangeType // -> update now CodeFoldRange.RangeType:=Pointer(PtrUInt(Integer(fRange))); // return a fixed copy of the current CodeFoldRange instance Result := inherited GetRange; end; procedure TSynPasSyn.SetRange(Value: Pointer); begin //DebugLn(['TSynPasSyn.SetRange START']); inherited SetRange(Value); CompilerMode := PasCodeFoldRange.Mode; fRange := TRangeStates(Integer(PtrUInt(CodeFoldRange.RangeType))); FNodeInfoLine := -1; FSynPasRangeInfo := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[LineIndex-1]; end; procedure TSynPasSyn.StartAtLineIndex(LineNumber: Integer); begin inherited StartAtLineIndex(LineNumber); end; procedure TSynPasSyn.ResetRange; begin fRange := []; FStartCodeFoldBlockLevel:=0; FPasStartLevel := 0; with FSynPasRangeInfo do begin EndLevelIfDef := 0; MinLevelIfDef := 0; EndLevelRegion := 0; MinLevelRegion := 0; end; Inherited ResetRange; CompilerMode:=pcmDelphi; end; procedure TSynPasSyn.EnumUserSettings(settings: TStrings); begin { returns the user settings that exist in the registry } with TBetterRegistry.Create do begin try RootKey := HKEY_LOCAL_MACHINE; {$IFNDEF SYN_LAZARUS} // ToDo Registry if OpenKeyReadOnly('\SOFTWARE\Borland\Delphi') then begin try GetKeyNames(settings); finally CloseKey; end; end; {$ENDIF} finally Free; end; end; end; function TSynPasSyn.TopPascalCodeFoldBlockType(DownIndex: Integer = 0): TPascalCodeFoldBlockType; var p: Pointer; begin p := TopCodeFoldBlockType(DownIndex); if p >= CountPascalCodeFoldBlockOffset then p := p - PtrUInt(CountPascalCodeFoldBlockOffset); Result := TPascalCodeFoldBlockType(PtrUInt(p)); end; function TSynPasSyn.FoldOpenCount(ALineIndex: Integer; AType: Integer = 0): integer; var inf: TSynPasRangeInfo; begin Result := 0; if (AType <> 1) then inf := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[ALineIndex]; if (AType = 0) or (AType = 1) then Result := EndPasFoldLevel(ALineIndex) - MinimumPasFoldLevel(ALineIndex); if (AType = 0) or (AType = 2) then Result := Result + inf.EndLevelRegion - inf.MinLevelRegion; if (AType = 0) or (AType = 3) then Result := Result + inf.EndLevelIfDef - inf.MinLevelIfDef; end; function TSynPasSyn.FoldCloseCount(ALineIndex: Integer; AType: Integer = 0): integer; var inf, inf2: TSynPasRangeInfo; begin Result := 0; if (AType <> 1) then begin inf := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[ALineIndex]; inf2 := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[ALineIndex - 1]; end; if (AType = 0) or (AType = 1) then Result := EndPasFoldLevel(ALineIndex - 1) - min(MinimumPasFoldLevel(ALineIndex), EndPasFoldLevel(ALineIndex)); if (AType = 0) or (AType = 2) then Result := Result + inf2.EndLevelRegion - inf.MinLevelRegion; if (AType = 0) or (AType = 3) then Result := Result + inf2.EndLevelIfDef - inf.MinLevelIfDef; end; function TSynPasSyn.FoldNestCount(ALineIndex: Integer; AType: Integer = 0): integer; var inf: TSynPasRangeInfo; begin Result := 0; if (AType <> 1) then inf := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[ALineIndex]; if (AType = 0) or (AType = 1) then Result := EndPasFoldLevel(ALineIndex); if (AType = 0) or (AType = 2) then Result := Result + inf.EndLevelRegion; if (AType = 0) or (AType = 3) then Result := Result + inf.EndLevelIfDef; end; function TSynPasSyn.FoldTypeCount: integer; begin Result := 3; end; function TSynPasSyn.FoldTypeAtNodeIndex(ALineIndex, FoldIndex: Integer; UseCloseNodes: boolean): integer; var act: TSynFoldActions; begin act := [sfaOpen, sfaFold]; if UseCloseNodes then act := [sfaClose, sfaFold]; case TPascalCodeFoldBlockType(PtrUInt(GetFoldNodeInfo(ALineIndex, FoldIndex, act).FoldType)) of cfbtRegion: Result := 2; cfbtIfDef: Result := 3; else Result := 1; end; end; function TSynPasSyn.FoldLineLength(ALineIndex, FoldIndex: Integer): integer; var i, lvl, cnt, atype : Integer; e, m: Integer; begin atype := FoldTypeAtNodeIndex(ALineIndex, FoldIndex); cnt := CurrentLines.Count; e := EndPasFoldLevel(ALineIndex, atype); m := MinimumPasFoldLevel(ALineIndex, atype); lvl := Min(m+1+FoldIndex, e); i := ALineIndex + 1; while (i < cnt) and (MinimumPasFoldLevel(i, atype) >= lvl) do inc(i); // check if fold last line of block (not mixed "end begin") // and not lastlinefix if (i = cnt) or (EndPasFoldLevel(i, atype) > MinimumPasFoldLevel(i, atype)) then dec(i); // Amount of lines, that will become invisible (excludes the cfCollapsed line) Result := i - ALineIndex; end; function TSynPasSyn.MinimumPasFoldLevel(Index: Integer; AType: Integer = 1): integer; var r: TSynPasSynRange; begin case AType of 2: Result := TSynHighlighterPasRangeList(CurrentRanges). PasRangeInfo[Index].MinLevelRegion; 3: Result := TSynHighlighterPasRangeList(CurrentRanges). PasRangeInfo[Index].MinLevelIfDef; else begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := Min(r.PasFoldEndLevel + LastLinePasFoldLevelFix(Index + 1), r.PasFoldMinLevel) else Result := 0; end; end; end; function TSynPasSyn.EndPasFoldLevel(Index: Integer; AType: Integer = 1): integer; var r: TSynPasSynRange; begin case AType of 2: Result := TSynHighlighterPasRangeList(CurrentRanges). PasRangeInfo[Index].EndLevelRegion; 3: Result := TSynHighlighterPasRangeList(CurrentRanges). PasRangeInfo[Index].EndLevelIfDef; else begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := r.PasFoldEndLevel + LastLinePasFoldLevelFix(Index + 1) else Result := 0; end; end; end; function TSynPasSyn.LastLinePasFoldLevelFix(Index: Integer; AType: Integer = 1): integer; var r: TSynPasSynRange; begin case AType of 2: Result := 0; 3: Result := 0; else begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := r.PasFoldFixLevel else Result := 0; end; end; end; function TSynPasSyn.MinimumFoldLevel(Index: Integer): integer; var r: TSynPasSynRange; begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := Min(r.CodeFoldStackSize + LastLineFoldLevelFix(Index + 1), r.MinimumCodeFoldBlockLevel) else Result := 0; end; function TSynPasSyn.EndFoldLevel(Index: Integer): integer; var r: TSynPasSynRange; begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := r.CodeFoldStackSize + LastLineFoldLevelFix(Index + 1) else Result := 0; end; function TSynPasSyn.LastLineFoldLevelFix(Index: Integer): integer; var r: TSynPasSynRange; begin if (Index < 0) or (Index >= CurrentLines.Count) then exit(0); r := TSynPasSynRange(CurrentRanges[Index]); if (r <> nil) and (Pointer(r) <> NullRange) then Result := r.LastLineCodeFoldLevelFix else Result := 0; end; procedure TSynPasSyn.InitNode(var Node: TSynFoldNodeInfo; EndOffs: Integer; ABlockType: TPascalCodeFoldBlockType; aActions: TSynFoldActions); var OneLine: Boolean; i: Integer; begin Node.LineIndex := LineIndex; Node.LogXStart := Run; Node.LogXEnd := Run + fStringLen; Node.FoldType := Pointer(PtrInt(ABlockType)); Node.FoldAction := aActions; case ABlockType of cfbtRegion: begin node.FoldGroup := 2; Node.FoldLvlStart := FSynPasRangeInfo.EndLevelRegion; OneLine := (EndOffs < 0) and (Node.FoldLvlStart > FSynPasRangeInfo.MinLevelRegion); end; cfbtIfDef: begin node.FoldGroup := 3; Node.FoldLvlStart := FSynPasRangeInfo.EndLevelIfDef; OneLine := (EndOffs < 0) and (Node.FoldLvlStart > FSynPasRangeInfo.MinLevelIfDef); end; else begin node.FoldGroup := 1; Node.FoldLvlStart := CurrentCodeFoldBlockLevel; OneLine := (EndOffs < 0) and (Node.FoldLvlStart > MinimumCodeFoldBlockLevel); end; end; Node.FoldLvlEnd := Node.FoldLvlStart + EndOffs; if OneLine then begin // find opening node i := FNodeInfoCount - 1; while (i >= 0) and ( (FNodeInfoList[i].FoldType <> node.FoldType) or (FNodeInfoList[i].FoldGroup <> node.FoldGroup) or (not (sfaOpen in FNodeInfoList[i].FoldAction)) or (FNodeInfoList[i].FoldLvlEnd <> Node.FoldLvlStart) ) do dec(i); if i >= 0 then begin FNodeInfoList[i].FoldAction := FNodeInfoList[i].FoldAction - [sfaOpen, sfaFold] + [sfaOneLineOpen]; Node.FoldAction := Node.FoldAction + [sfaOneLineClose] - [sfaClose, sfaFold]; end; end; if ABlockType in PascalWordTrippletRanges then Include(Node.FoldAction, sfaMarkup); end; procedure TSynPasSyn.StartCustomCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType); begin if not FFoldConfig[ord(ABlockType)].Enabled then exit; if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet GrowNodeInfoList; InitNode(FNodeInfoList[FNodeInfoCount], +1, ABlockType, [sfaOpen, sfaFold]); inc(FNodeInfoCount); end; case ABlockType of cfbtIfDef: inc(FSynPasRangeInfo.EndLevelIfDef); cfbtRegion: inc(FSynPasRangeInfo.EndLevelRegion); end; end; procedure TSynPasSyn.EndCustomCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType); begin if not FFoldConfig[ord(ABlockType)].Enabled then exit; if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet GrowNodeInfoList; InitNode(FNodeInfoList[FNodeInfoCount], -1, ABlockType, [sfaClose, sfaFold]); inc(FNodeInfoCount); end; case ABlockType of cfbtIfDef: begin if FSynPasRangeInfo.EndLevelIfDef > 0 then dec(FSynPasRangeInfo.EndLevelIfDef); if FSynPasRangeInfo.EndLevelIfDef < FSynPasRangeInfo.MinLevelIfDef then FSynPasRangeInfo.MinLevelIfDef := FSynPasRangeInfo.EndLevelIfDef; end; cfbtRegion: begin if FSynPasRangeInfo.EndLevelRegion > 0 then dec(FSynPasRangeInfo.EndLevelRegion); if FSynPasRangeInfo.EndLevelRegion < FSynPasRangeInfo.MinLevelRegion then FSynPasRangeInfo.MinLevelRegion := FSynPasRangeInfo.EndLevelRegion; end; end; end; function TSynPasSyn.StartPascalCodeFoldBlock( ABlockType: TPascalCodeFoldBlockType): TSynCustomCodeFoldBlock; var p: PtrInt; FoldBlock: Boolean; act: TSynFoldActions; begin FoldBlock := FFoldConfig[ord(ABlockType)].Enabled; p := 0; if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet GrowNodeInfoList; act := [sfaOpen]; if FoldBlock then include(act, sfaFold); InitNode(FNodeInfoList[FNodeInfoCount], +1, ABlockType, act); inc(FNodeInfoCount); end; if not FoldBlock then p := PtrInt(CountPascalCodeFoldBlockOffset); Result:=TSynCustomCodeFoldBlock( inherited StartCodeFoldBlock(p+Pointer(PtrInt(ABlockType)), FoldBlock)); end; procedure TSynPasSyn.EndPascalCodeFoldBlock(NoMarkup: Boolean = False); var DecreaseLevel: Boolean; act: TSynFoldActions; begin DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset; if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet GrowNodeInfoList; act := [sfaClose]; if DecreaseLevel then include(act, sfaFold); InitNode(FNodeInfoList[FNodeInfoCount], -1, TopPascalCodeFoldBlockType, act); if NoMarkup then exclude(FNodeInfoList[FNodeInfoCount].FoldAction, sfaMarkup); inc(FNodeInfoCount); end; EndCodeFoldBlock(DecreaseLevel); end; procedure TSynPasSyn.CloseBeginEndBlocksBeforeProc; begin if not(TopPascalCodeFoldBlockType in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtAsm, cfbtExcept, cfbtTry, cfbtRepeat]) then exit; while TopPascalCodeFoldBlockType in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtAsm, cfbtExcept, cfbtTry, cfbtRepeat] do EndPascalCodeFoldBlockLastLine; if TopPascalCodeFoldBlockType = cfbtProcedure then EndPascalCodeFoldBlockLastLine; // This procedure did have a begin/end block, so it must end too end; procedure TSynPasSyn.SmartCloseBeginEndBlocks(SearchFor: TPascalCodeFoldBlockType); var i, nc: Integer; t: TPascalCodeFoldBlockType; begin // Close unfinished blocks, IF the expected type is found // Only check a limited deep. Otherwhise assume, that the "SearchFor"-End node may be misplaced i := 0; while (i <= 2) do begin t := TopPascalCodeFoldBlockType(i); if not (t in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtAsm, cfbtExcept, cfbtTry, cfbtRepeat, SearchFor]) then exit; if (t = SearchFor) then break; inc(i); end; if i > 2 then exit; while i > 0 do begin EndPascalCodeFoldBlockLastLine; nc := FNodeInfoCount; if FCatchNodeInfo and (FNodeInfoCount > nc) then exclude(FNodeInfoList[FNodeInfoCount-1].FoldAction, sfaMarkup); dec(i); end; end; procedure TSynPasSyn.EndPascalCodeFoldBlockLastLine; var i: Integer; begin i := FNodeInfoCount; EndPascalCodeFoldBlock; if FAtLineStart then begin // If we are not at linestart, new folds could have been opened => handle as normal close if (CurrentCodeFoldBlockLevel < FStartCodeFoldBlockLevel) and (FStartCodeFoldBlockLevel > 0) then begin PasCodeFoldRange.DecLastLineCodeFoldLevelFix; dec(FStartCodeFoldBlockLevel); if FCatchNodeInfo then dec(FNodeInfoCount); end; if (PasCodeFoldRange.PasFoldEndLevel < FPasStartLevel) and (FPasStartLevel > 0) then begin PasCodeFoldRange.DecLastLinePasFoldFix; dec(FPasStartLevel); end; end else if FNodeInfoCount > i then begin exclude(FNodeInfoList[FNodeInfoCount - 1].FoldAction, sfaMarkup); // not markup able FNodeInfoList[FNodeInfoCount - 1].LogXEnd := 0; end; end; function TSynPasSyn.GetDrawDivider(Index: integer): TSynDividerDrawConfigSetting; function CheckFoldNestLevel(MaxDepth, StartLvl: Integer; CountTypes, SkipTypes: TPascalCodeFoldBlockTypes; out ResultLvl: Integer): Boolean; var i, j, m: Integer; t: TPascalCodeFoldBlockType; begin i := 0; j := StartLvl; m := CurrentCodeFoldBlockLevel; t := TopPascalCodeFoldBlockType(j); while (i <= MaxDepth) and (j < m) and ((t in CountTypes) or (t in SkipTypes)) do begin inc(j); if t in CountTypes then inc(i); t := TopPascalCodeFoldBlockType(j) end; ResultLvl := i; Result := i <= MaxDepth; end; var cur: TPascalCodeFoldBlockType; CloseCnt, ClosedByNextLine, ClosedInLastLine: Integer; i, top, c: Integer; t: TSynPasDividerDrawLocation; begin Result := inherited; if (index = 0) then exit; CloseCnt := EndFoldLevel(Index - 1) - MinimumFoldLevel(Index); if (CloseCnt = 0) or (MinimumFoldLevel(Index) <> EndFoldLevel(Index)) then // not a mixed line exit; // SetRange[Index] has the folds at the start of this line // ClosedByNextLine: Folds closed by the next lines LastLineFix // must be taken from SetRange[Index+1] (end of this line) ClosedByNextLine := -LastLineFoldLevelFix(Index + 1); // ClosedInLastLine: Folds Closed by this lines LastLineFix // must be ignored. (They are part of SetRange[Index] / this line) ClosedInLastLine := -LastLineFoldLevelFix(Index); // Get the highest close-offset i := ClosedByNextLine - 1; if i >= 0 then begin SetRange(CurrentRanges[Index]); // Checking ClosedByNextLine top := 0; end else begin SetRange(CurrentRanges[Index - 1]); // Checking Closed in this Line i := CloseCnt - ClosedByNextLine + ClosedInLastLine - 1; top := ClosedInLastLine; end; cur := TopPascalCodeFoldBlockType(i + 1); while (i >= top) do begin //nxt := cur; // The "next higher" close node compared to current cur := TopPascalCodeFoldBlockType(i); Result := FDividerDrawConfig[pddlUses].TopSetting; //// xxxx case cur of cfbtUnitSection: if FDividerDrawConfig[pddlUnitSection].MaxDrawDepth > 0 then exit(FDividerDrawConfig[pddlUnitSection].TopSetting); cfbtUses: if FDividerDrawConfig[pddlUses].MaxDrawDepth > 0 then exit(FDividerDrawConfig[pddlUses].TopSetting); cfbtLocalVarType: if CheckFoldNestLevel(FDividerDrawConfig[pddlVarLocal].MaxDrawDepth - 1, i + 2, [cfbtProcedure], cfbtAll, c) then begin if c = 0 then exit(FDividerDrawConfig[pddlVarLocal].TopSetting) else exit(FDividerDrawConfig[pddlVarLocal].NestSetting); end; cfbtVarType: if FDividerDrawConfig[pddlVarGlobal].MaxDrawDepth > 0 then exit(FDividerDrawConfig[pddlVarGlobal].TopSetting); cfbtClass, cfbtRecord: begin if CheckFoldNestLevel(0, i + 1, [cfbtProcedure], cfbtAll - [cfbtVarType, cfbtLocalVarType], c) then t := pddlStructGlobal else t := pddlStructLocal; if CheckFoldNestLevel(FDividerDrawConfig[t].MaxDrawDepth - 1, i + 1, [cfbtClass, cfbtRecord], cfbtAll - [cfbtVarType, cfbtLocalVarType], c) then begin if c = 0 then exit(FDividerDrawConfig[t].TopSetting) else exit(FDividerDrawConfig[t].NestSetting); end; end; cfbtProcedure: if CheckFoldNestLevel(FDividerDrawConfig[pddlProcedure].MaxDrawDepth - 1, i + 1, [cfbtProcedure], cfbtAll, c) then begin if c = 0 then exit(FDividerDrawConfig[pddlProcedure].TopSetting) else exit(FDividerDrawConfig[pddlProcedure].NestSetting); end; cfbtTopBeginEnd: if FDividerDrawConfig[pddlBeginEnd].MaxDrawDepth > 0 then exit(FDividerDrawConfig[pddlBeginEnd].TopSetting); cfbtBeginEnd, cfbtRepeat, cfbtCase, cfbtAsm: if CheckFoldNestLevel(FDividerDrawConfig[pddlBeginEnd].MaxDrawDepth - 2, i + 1, [cfbtBeginEnd, cfbtRepeat, cfbtCase, cfbtAsm], cfbtAll - [cfbtProcedure, cfbtTopBeginEnd], c) then exit(FDividerDrawConfig[pddlBeginEnd].NestSetting); cfbtTry: if CheckFoldNestLevel(FDividerDrawConfig[pddlTry].MaxDrawDepth - 1, i + 1, [cfbtTry], cfbtAll - [cfbtProcedure], c) then begin if c = 0 then exit(FDividerDrawConfig[pddlTry].TopSetting) else exit(FDividerDrawConfig[pddlTry].NestSetting); end; end; dec(i); if (i < top) and (ClosedByNextLine > 0) then begin // Switch to blocks closed in this line SetRange(CurrentRanges[Index - 1]); i := CloseCnt - ClosedByNextLine + ClosedInLastLine - 1; ClosedByNextLine := 0; top := ClosedInLastLine; cur := TopPascalCodeFoldBlockType(i + 1); end; end; Result := inherited; end; procedure TSynPasSyn.CreateDividerDrawConfig; var i: TSynPasDividerDrawLocation; begin for i := low(TSynPasDividerDrawLocation) to high(TSynPasDividerDrawLocation) do begin FDividerDrawConfig[i] := TSynDividerDrawConfig.Create; FDividerDrawConfig[i].OnChange := {$IFDEF FPC}@{$ENDIF}DefHighlightChange; FDividerDrawConfig[i].MaxDrawDepth := PasDividerDrawLocationDefaults[i]; end; end; procedure TSynPasSyn.DestroyDividerDrawConfig; var i: TSynPasDividerDrawLocation; begin for i := low(TSynPasDividerDrawLocation) to high(TSynPasDividerDrawLocation) do FreeAndNil(FDividerDrawConfig[i]); end; function TSynPasSyn.GetFoldConfigInstance(Index: Integer): TSynCustomFoldConfig; begin Result := inherited GetFoldConfigInstance(Index); Result.Enabled := TPascalCodeFoldBlockType(Index) in [cfbtBeginEnd, cfbtTopBeginEnd, cfbtNestedComment, cfbtProcedure, cfbtUses, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord, cfbtRepeat, cfbtCase, cfbtAsm, cfbtRegion]; end; function TSynPasSyn.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; begin Result := TSynHighlighterPasRangeList.Create; end; function TSynPasSyn.UpdateRangeInfoAtLine(Index: Integer): Boolean; var r: TSynPasRangeInfo; begin Result := inherited; r := TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[Index]; Result := Result or (FSynPasRangeInfo.EndLevelIfDef <> r.EndLevelIfDef) or (FSynPasRangeInfo.MinLevelIfDef <> r.MinLevelIfDef) or (FSynPasRangeInfo.EndLevelRegion <> r.EndLevelRegion) or (FSynPasRangeInfo.MinLevelRegion <> r.MinLevelRegion); TSynHighlighterPasRangeList(CurrentRanges).PasRangeInfo[Index] := FSynPasRangeInfo; end; function TSynPasSyn.GetFoldConfigCount: Integer; begin // excluded cfbtNone; Result := ord(high(TPascalCodeFoldBlockType)) - ord(low(TPascalCodeFoldBlockType)); end; function TSynPasSyn.GetFoldConfigInternalCount: Integer; begin // include cfbtNone; Result := ord(high(TPascalCodeFoldBlockType)) - ord(low(TPascalCodeFoldBlockType)) + 1; end; function TSynPasSyn.GetDividerDrawConfig(Index: Integer): TSynDividerDrawConfig; begin Result := FDividerDrawConfig[TSynPasDividerDrawLocation(Index)]; end; function TSynPasSyn.GetDividerDrawConfigCount: Integer; begin Result := ord(high(TSynPasDividerDrawLocation)) - ord(low(TSynPasDividerDrawLocation)) + 1; end; function TSynPasSyn.GetFoldNodeInfo(Line, Index: Integer; Filter: TSynFoldActions): TSynFoldNodeInfo; var i, j: LongInt; begin if FNodeInfoLine <> Line then begin FCatchNodeInfo := True; FNodeInfoCount := 0; StartAtLineIndex(Line); fStringLen := 0; NextToEol; i := LastLineFoldLevelFix(Line+1); while i < 0 do begin EndPascalCodeFoldBlock; inc(i); end; FCatchNodeInfo := False; FNodeInfoLine := Line; end; if (index < 0) or (index >= FNodeInfoCount) then Result := inherited GetFoldNodeInfo(Line, Index, []) else if Filter = [] then Result := FNodeInfoList[Index] else begin j := Index; for i := 0 to FNodeInfoCount - 1 do if FNodeInfoList[i].FoldAction * Filter = Filter then begin Result := FNodeInfoList[i]; if j = 0 then break; dec(j); end; end; Result.NodeIndex := Index; // only set copy on result end; function TSynPasSyn.GetFoldNodeInfoCount(Line: Integer; Filter: TSynFoldActions): Integer; var i: Integer; begin if FNodeInfoLine <> Line then GetFoldNodeInfo(Line, 0, []); Result := FNodeInfoCount; if Filter <> [] then for i := 0 to FNodeInfoCount - 1 do if FNodeInfoList[i].FoldAction * Filter <> Filter then dec(Result); end; function TSynPasSyn.GetRangeClass: TSynCustomHighlighterRangeClass; begin Result:=TSynPasSynRange; end; function TSynPasSyn.UseUserSettings(settingIndex: integer): boolean; // Possible parameter values: // index into TStrings returned by EnumUserSettings // Possible return values: // true : settings were read and used // false: problem reading settings or invalid version specified - old settings // were preserved function ReadDelphiSettings(settingIndex: integer): boolean; function ReadDelphiSetting(settingTag: string; attri: TSynHighlighterAttributes; key: string): boolean; function ReadDelphi2Or3(settingTag: string; attri: TSynHighlighterAttributes; name: string): boolean; var i: integer; begin for i := 1 to Length(name) do if name[i] = ' ' then name[i] := '_'; Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER, '\Software\Borland\Delphi\'+settingTag+'\Highlight',name,true); end; { ReadDelphi2Or3 } function ReadDelphi4OrMore(settingTag: string; attri: TSynHighlighterAttributes; key: string): boolean; begin Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER, '\Software\Borland\Delphi\'+settingTag+'\Editor\Highlight', key,false); end; { ReadDelphi4OrMore } begin { ReadDelphiSetting } try if (settingTag[1] = '2') or (settingTag[1] = '3') then Result := ReadDelphi2Or3(settingTag,attri,key) else Result := ReadDelphi4OrMore(settingTag,attri,key); except Result := false; end; end; { ReadDelphiSetting } var tmpStringAttri : TSynHighlighterAttributes; tmpNumberAttri : TSynHighlighterAttributes; tmpKeyAttri : TSynHighlighterAttributes; tmpSymbolAttri : TSynHighlighterAttributes; tmpAsmAttri : TSynHighlighterAttributes; tmpCommentAttri : TSynHighlighterAttributes; {$IFDEF SYN_LAZARUS} tmpDirectiveAttri : TSynHighlighterAttributes; {$ENDIF} tmpIdentifierAttri: TSynHighlighterAttributes; tmpSpaceAttri : TSynHighlighterAttributes; s : TStringList; begin { ReadDelphiSettings } s := TStringList.Create; try EnumUserSettings(s); if (settingIndex < 0) or (settingIndex >= s.Count) then Result := false else begin tmpStringAttri := TSynHighlighterAttributes.Create(''); tmpNumberAttri := TSynHighlighterAttributes.Create(''); tmpKeyAttri := TSynHighlighterAttributes.Create(''); tmpSymbolAttri := TSynHighlighterAttributes.Create(''); tmpAsmAttri := TSynHighlighterAttributes.Create(''); tmpCommentAttri := TSynHighlighterAttributes.Create(''); {$IFDEF SYN_LAZARUS} tmpDirectiveAttri := TSynHighlighterAttributes.Create(''); {$ENDIF} tmpIdentifierAttri:= TSynHighlighterAttributes.Create(''); tmpSpaceAttri := TSynHighlighterAttributes.Create(''); tmpStringAttri .Assign(fStringAttri); tmpNumberAttri .Assign(fNumberAttri); tmpKeyAttri .Assign(fKeyAttri); tmpSymbolAttri .Assign(fSymbolAttri); tmpAsmAttri .Assign(fAsmAttri); tmpCommentAttri .Assign(fCommentAttri); {$IFDEF SYN_LAZARUS} tmpDirectiveAttri .Assign(fDirectiveAttri); {$ENDIF} tmpIdentifierAttri.Assign(fIdentifierAttri); tmpSpaceAttri .Assign(fSpaceAttri); Result := ReadDelphiSetting(s[settingIndex],fAsmAttri,'Assembler') and ReadDelphiSetting(s[settingIndex],fCommentAttri,'Comment') {$IFDEF SYN_LAZARUS} and ReadDelphiSetting(s[settingIndex],fDirectiveAttri,'Directive') {$ENDIF} and ReadDelphiSetting(s[settingIndex],fIdentifierAttri,'Identifier') and ReadDelphiSetting(s[settingIndex],fKeyAttri,'Reserved word') and ReadDelphiSetting(s[settingIndex],fNumberAttri,'Number') and ReadDelphiSetting(s[settingIndex],fSpaceAttri,'Whitespace') and ReadDelphiSetting(s[settingIndex],fStringAttri,'string') and ReadDelphiSetting(s[settingIndex],fSymbolAttri,'Symbol'); if not Result then begin fStringAttri .Assign(tmpStringAttri); fNumberAttri .Assign(tmpNumberAttri); fKeyAttri .Assign(tmpKeyAttri); fSymbolAttri .Assign(tmpSymbolAttri); fAsmAttri .Assign(tmpAsmAttri); fCommentAttri .Assign(tmpCommentAttri); {$IFDEF SYN_LAZARUS} fDirectiveAttri .Assign(tmpDirectiveAttri); {$ENDIF} fIdentifierAttri.Assign(tmpIdentifierAttri); fSpaceAttri .Assign(tmpSpaceAttri); end; tmpStringAttri .Free; tmpNumberAttri .Free; tmpKeyAttri .Free; tmpSymbolAttri .Free; tmpAsmAttri .Free; tmpCommentAttri .Free; {$IFDEF SYN_LAZARUS} tmpDirectiveAttri .Free; {$ENDIF} tmpIdentifierAttri.Free; tmpSpaceAttri .Free; end; finally s.Free; end; end; { ReadDelphiSettings } begin Result := ReadDelphiSettings(settingIndex); end; { TSynPasSyn.UseUserSettings } function TSynPasSyn.GetIdentChars: TSynIdentChars; begin Result := ['_', '0'..'9', 'a'..'z', 'A'..'Z']; end; {$IFNDEF SYN_CPPB_1} class {$ENDIF} function TSynPasSyn.GetLanguageName: string; begin Result := SYNS_LangPascal; end; {$IFNDEF SYN_CPPB_1} class {$ENDIF} function TSynPasSyn.GetCapabilities: TSynHighlighterCapabilities; begin Result := inherited GetCapabilities + [hcUserSettings]; end; {begin} //mh 2000-10-08 function TSynPasSyn.IsFilterStored: boolean; begin Result := fDefaultFilter <> SYNS_FilterPascal; end; procedure TSynPasSyn.CreateRootCodeFoldBlock; begin inherited; RootCodeFoldBlock.InitRootBlockType(Pointer(PtrInt(cfbtNone))); end; function TSynPasSyn.IsKeyword(const AKeyword: string): boolean; // returns true for some common keywords // Note: this words are not always keywords (e.g. end), and some keywords are // not listed here at all (e.g. static) var i: integer; m: TPascalCompilerMode; begin if KeywordsList = nil then begin KeywordsList := TStringList.Create; for i := 1 to High(RESERVED_WORDS_TP) do KeywordsList.AddObject(RESERVED_WORDS_TP[i], TObject(pcmTP)); for i := 1 to High(RESERVED_WORDS_DELPHI) do KeywordsList.AddObject(RESERVED_WORDS_DELPHI[i], TObject(pcmDelphi)); for i := 1 to High(RESERVED_WORDS_FPC) do KeywordsList.AddObject(RESERVED_WORDS_FPC[i], TObject(pcmFPC)); KeywordsList.Sorted := true; end; Result := KeywordsList.Find(LowerCase(AKeyword), i); if not Result then exit; m := TPascalCompilerMode(PtrUInt(KeywordsList.Objects[i])); case FCompilerMode of pcmFPC, pcmObjFPC: ; pcmDelphi: Result := m in [pcmTP, pcmDelphi]; else Result := m = pcmTP; end; end; {end} //mh 2000-10-08 procedure TSynPasSyn.SetD4syntax(const Value: boolean); begin FD4syntax := Value; end; { TSynFreePascalSyn } constructor TSynFreePascalSyn.Create(AOwner: TComponent); begin inherited Create(AOwner); CompilerMode:=pcmObjFPC; end; procedure TSynFreePascalSyn.ResetRange; begin inherited ResetRange; CompilerMode:=pcmObjFPC; end; { TSynPasSynRange } procedure TSynPasSynRange.Clear; begin inherited Clear; FBracketNestLevel := 0; FLastLineCodeFoldLevelFix := 0; FPasFoldEndLevel := 0; FPasFoldFixLevel := 0; FPasFoldMinLevel := 0; end; function TSynPasSynRange.Compare(Range: TSynCustomHighlighterRange): integer; begin Result:=inherited Compare(Range); if Result<>0 then exit; Result:=ord(FMode)-ord(TSynPasSynRange(Range).FMode); if Result<>0 then exit; Result := FBracketNestLevel - TSynPasSynRange(Range).FBracketNestLevel; if Result<>0 then exit; Result := FLastLineCodeFoldLevelFix - TSynPasSynRange(Range).FLastLineCodeFoldLevelFix; if Result<>0 then exit; Result := FPasFoldEndLevel - TSynPasSynRange(Range).FPasFoldEndLevel; if Result<>0 then exit; Result := FPasFoldMinLevel - TSynPasSynRange(Range).FPasFoldMinLevel; if Result<>0 then exit; Result := FPasFoldFixLevel - TSynPasSynRange(Range).FPasFoldFixLevel; end; procedure TSynPasSynRange.Assign(Src: TSynCustomHighlighterRange); begin if (Src<>nil) and (Src<>TSynCustomHighlighterRange(NullRange)) then begin inherited Assign(Src); FMode:=TSynPasSynRange(Src).FMode; FBracketNestLevel:=TSynPasSynRange(Src).FBracketNestLevel; FLastLineCodeFoldLevelFix := TSynPasSynRange(Src).FLastLineCodeFoldLevelFix; FPasFoldEndLevel := TSynPasSynRange(Src).FPasFoldEndLevel; FPasFoldMinLevel := TSynPasSynRange(Src).FPasFoldMinLevel; FPasFoldFixLevel := TSynPasSynRange(Src).FPasFoldFixLevel; end; end; function TSynPasSynRange.Add(ABlockType: Pointer; IncreaseLevel: Boolean): TSynCustomCodeFoldBlock; begin Result := inherited Add(ABlockType, True); if IncreaseLevel and assigned(result) then inc(FPasFoldEndLevel); end; procedure TSynPasSynRange.Pop(DecreaseLevel: Boolean); begin if assigned(Top.Parent) then begin if DecreaseLevel then dec(FPasFoldEndLevel); if FPasFoldMinLevel > FPasFoldEndLevel then FPasFoldMinLevel := FPasFoldEndLevel; end; inherited Pop(True); end; function TSynPasSynRange.MaxFoldLevel: Integer; begin // Protect from overly mem consumption, by too many nested folds Result := 100; end; procedure TSynPasSynRange.IncBracketNestLevel; begin inc(FBracketNestLevel); end; procedure TSynPasSynRange.DecBracketNestLevel; begin dec(FBracketNestLevel); end; procedure TSynPasSynRange.DecLastLineCodeFoldLevelFix; begin dec(FLastLineCodeFoldLevelFix) end; procedure TSynPasSynRange.DecLastLinePasFoldFix; begin dec(FPasFoldFixLevel); end; { TSynHighlighterPasRangeList } function TSynHighlighterPasRangeList.GetTSynPasRangeInfo(Index: Integer): TSynPasRangeInfo; begin if (Index < 0) or (Index >= Count) then begin Result.MinLevelRegion := 0; Result.EndLevelRegion := 0; Result.MinLevelIfDef := 0; Result.EndLevelIfDef := 0; exit; end; Result := TSynPasRangeInfo((ItemPointer[Index] + inherited ItemSize)^); end; procedure TSynHighlighterPasRangeList.SetTSynPasRangeInfo(Index: Integer; const AValue: TSynPasRangeInfo); begin TSynPasRangeInfo((ItemPointer[Index] + inherited ItemSize)^) := AValue; end; function TSynHighlighterPasRangeList.ItemSize: Integer; begin Result := inherited ItemSize + SizeOf(TSynPasRangeInfo); end; initialization MakeIdentTable; {$IFNDEF SYN_CPPB_1} RegisterPlaceableHighlighter(TSynPasSyn); {$ENDIF} finalization FreeAndNil(KeywordsList); end.