From 8e59857521315ac41d292ecb83e9ecc62ae0bd4a Mon Sep 17 00:00:00 2001 From: Martin Date: Mon, 24 Mar 2025 00:45:01 +0100 Subject: [PATCH] IDE, SynEdit: PascalHighlighter, CustomWords (Tokens, must be identifier) for comment and string. Custom color for comment by type // vs (* . Includes Issue #40881 --- components/synedit/synhighlighterpas.pp | 479 +++++++++++++++++++----- ide/lazarusidestrconsts.pas | 5 + ide/main.pp | 4 +- ide/sourcesyneditor.pas | 8 +- ide/syncolorattribeditor.pas | 15 + 5 files changed, 419 insertions(+), 92 deletions(-) diff --git a/components/synedit/synhighlighterpas.pp b/components/synedit/synhighlighterpas.pp index 9419ec6aca..71c38de9ed 100644 --- a/components/synedit/synhighlighterpas.pp +++ b/components/synedit/synhighlighterpas.pp @@ -61,9 +61,16 @@ type TSynPasMultilineStringMode = (spmsmDoubleQuote); TSynPasMultilineStringModes = set of TSynPasMultilineStringMode; - TtkTokenKind = (tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber, + TtkTokenKindEx = ( + tkAsm, tkComment, tkIdentifier, tkKey, tkModifier, tkNull, tkNumber, tkSpace, tkString, tkSymbol, tkDirective, tkIDEDirective, - tkUnknown); + tkUnknown, + // for custom token only + tkSlashComment, tkAnsiComment, tkBorComment + ); + TtkTokenKindExs= set of TtkTokenKindEx; + + TtkTokenKind = tkAsm..tkUnknown; TtkTokenKinds= set of TtkTokenKind; TRangeState = ( @@ -498,16 +505,16 @@ type procedure DoTokensChanged(Sender: TObject); private FMarkup: TSynHighlighterAttributesModifier; - FMatchTokenKinds: TtkTokenKinds; + FMatchTokenKinds: TtkTokenKindExs; FTokens: TStrings; - procedure SetMatchTokenKinds(AValue: TtkTokenKinds); + procedure SetMatchTokenKinds(AValue: TtkTokenKindExs); property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnMarkupChange: TNotifyEvent read FOnMarkupChange write FOnMarkupChange; public constructor Create; destructor Destroy; override; - property MatchTokenKinds: TtkTokenKinds read FMatchTokenKinds write SetMatchTokenKinds; + property MatchTokenKinds: TtkTokenKindExs read FMatchTokenKinds write SetMatchTokenKinds; property Tokens: TStrings read FTokens; property Markup: TSynHighlighterAttributesModifier read FMarkup; end; @@ -582,7 +589,7 @@ type TSynPasSyn = class(TSynCustomFoldHighlighter) private type TSynPasSynCustomTokenInfoListEx = record - TokenKind: TtkTokenKind; + TokenKind: TtkTokenKindEx; List: TStringList; end; PSynPasSynCustomTokenInfoListEx = ^TSynPasSynCustomTokenInfoListEx; @@ -594,11 +601,12 @@ type FSynCustomTokens: array of TSynPasSynCustomToken; FNeedCustomTokenBuild: boolean; FCustomTokenInfo: array [byte] of record - MatchTokenKinds: TtkTokenKinds; + MatchTokenKinds: TtkTokenKindExs; Lists: array of TSynPasSynCustomTokenInfoListEx; end; - FCustomTokenMarkup: TSynHighlighterAttributesModifier; - FCustomTokenMergedMarkup: TSynSelectedColorMergeResult; + FCustomTokenMarkup, FCustomCommentTokenMarkup: TSynHighlighterAttributesModifier; + FCustomTokenMarkupSlash, FCustomTokenMarkupAnsi, FCustomTokenMarkupBor: TSynHighlighterAttributesModifier; + FCustomTokenMergedMarkup, FCustomCommentTokenMergedMarkup: TSynSelectedColorMergeResult; FCurIDEDirectiveAttri: TSynSelectedColorMergeResult; FCurCaseLabelAttri: TSynSelectedColorMergeResult; @@ -637,7 +645,7 @@ type FStringKeywordMode: TSynPasStringMode; FStringMultilineMode: TSynPasMultilineStringModes; FSynPasRangeInfo: TSynPasRangeInfo; - FAtLineStart: Boolean; // Line had only spaces or comments sofar + FAtLineStart, FInString: Boolean; // Line had only spaces or comments sofar fLineStr: string; fLine: PChar; fLineLen: integer; @@ -824,6 +832,7 @@ type procedure SemicolonProc; //mh 2000-10-08 procedure SlashProc; procedure SlashContinueProc; + procedure SlashCommentProc; procedure SpaceProc; procedure StringProc; procedure DoubleQuoteProc; @@ -833,6 +842,16 @@ type procedure SetD4syntax(const Value: boolean); function CanApplyExtendedDeclarationAttribute(AMode: TSynPasTypeAttributeMode): boolean; inline; + function GetCustomSymbolToken(ATokenID: TtkTokenKindEx; ALen: integer; + out ACustomMarkup: TSynHighlighterAttributesModifier; + APeekOnly: boolean = False + ): boolean; inline; + function GetCustomTokenAndNext(ATokenID: TtkTokenKindEx; out ACustomMarkup: TSynHighlighterAttributesModifier; + APeekOnly: boolean = False + ): boolean; inline; + function GetCustomToken(ATokenID: TtkTokenKindEx; AnHash: byte; ATokenStart: PChar; ATokenLen: integer; + out ACustomMarkup: TSynHighlighterAttributesModifier + ): boolean; inline; procedure CheckForAdditionalAttributes; // Divider @@ -1548,7 +1567,7 @@ begin end; procedure TSynPasSyn.RebuildCustomTokenInfo; - function FindList(AnHash: Byte; ATokenKind: TtkTokenKind): PSynPasSynCustomTokenInfoListEx; + function FindList(AnHash: Byte; ATokenKind: TtkTokenKindEx): PSynPasSynCustomTokenInfoListEx; var x: Integer; begin @@ -1570,11 +1589,16 @@ procedure TSynPasSyn.RebuildCustomTokenInfo; var i, j, h: Integer; t: String; - tk: TtkTokenKind; + mtk: TtkTokenKindExs; + tk: TtkTokenKindEx; Lst: PSynPasSynCustomTokenInfoListEx; begin FNeedCustomTokenBuild := False; FCustomTokenMarkup := nil; + FCustomCommentTokenMarkup := nil; + FCustomTokenMarkupSlash := nil; + FCustomTokenMarkupAnsi := nil; + FCustomTokenMarkupBor := nil; for i := 0 to 255 do begin for j := 0 to length(FCustomTokenInfo[i].Lists) - 1 do FreeAndNil(FCustomTokenInfo[i].Lists[j].List); @@ -1583,8 +1607,11 @@ begin end; for i := 0 to Length(FSynCustomTokens) - 1 do begin - if FSynCustomTokens[i].MatchTokenKinds = [] then + mtk := FSynCustomTokens[i].MatchTokenKinds; + if mtk = [] then continue; + if tkComment in mtk then + mtk := mtk - [tkComment] + [tkSlashComment, tkAnsiComment, tkBorComment]; for j := 0 to FSynCustomTokens[i].FTokens.Count - 1 do begin t := FSynCustomTokens[i].FTokens[j]; @@ -1596,8 +1623,25 @@ begin fToIdent := 0; h := KeyHash and 255; - FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + FSynCustomTokens[i].MatchTokenKinds; - for tk in FSynCustomTokens[i].MatchTokenKinds do begin + FCustomTokenInfo[h].MatchTokenKinds := FCustomTokenInfo[h].MatchTokenKinds + mtk; + for tk in mtk do begin + case tk of + tkSlashComment: + if t = '*' then begin + FCustomTokenMarkupSlash := FSynCustomTokens[i].Markup; + continue; + end; + tkAnsiComment: + if t = '*' then begin + FCustomTokenMarkupAnsi := FSynCustomTokens[i].Markup; + continue; + end; + tkBorComment: + if t = '*' then begin + FCustomTokenMarkupBor := FSynCustomTokens[i].Markup; + continue; + end; + end; Lst := FindList(h, tk); Lst^.List.AddObject(UpperCase(t), FSynCustomTokens[i]); end; @@ -3980,6 +4024,7 @@ begin FPasDocWordList := TStringList.Create; FCustomTokenMergedMarkup := TSynSelectedColorMergeResult.Create; + FCustomCommentTokenMergedMarkup := TSynSelectedColorMergeResult.Create; FNestedBracketAttribs := TSynHighlighterAttributesModifierCollection.Create(Self); FNestedBracketAttribs.OnAttributeChange := @DefHighlightChange; @@ -4010,6 +4055,7 @@ begin FreeAndNil(FCurStructMemberExtraAttri); FreeAndNil(FCurPasDocAttri); FreeAndNil(FCustomTokenMergedMarkup); + FreeAndNil(FCustomCommentTokenMergedMarkup); FreeAndNil(FPasDocWordList); CustomTokenCount := 0; for i := 0 to 255 do @@ -4041,6 +4087,8 @@ begin FSynPasRangeInfo.MinLevelRegion := FSynPasRangeInfo.EndLevelRegion; fLineNumber := LineNumber; FAtLineStart := True; + FInString := False; + FCustomCommentTokenMarkup := nil; if not IsCollectingNodeInfo then Next; end; { SetLine } @@ -4132,39 +4180,73 @@ end; procedure TSynPasSyn.BorProc; var p: LongInt; + IsInWord, WasInWord, ct: Boolean; begin - p:=Run; + FCustomCommentTokenMarkup := FCustomTokenMarkupBor; fTokenID := tkComment; if rsIDEDirective in fRange then fTokenID := tkIDEDirective; - if FUsePasDoc and not(rsIDEDirective in fRange) and (fLine[Run] = '@') then begin - if CheckPasDoc then - exit; + if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin + if FUsePasDoc and (fLine[Run] = '@') then begin + if CheckPasDoc then + exit; + end; + if (IsLetterChar[fline[Run]]) and + ( (Run = 0) or + not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]])) + ) + then begin + if GetCustomTokenAndNext(tkBorComment, FCustomTokenMarkup) then + exit; + end; end; + IsInWord := False; + WasInWord := (FIsInNextToEOL or IsScanning) or (rsIDEDirective in fRange); // don't run checks + p:=Run; repeat case fLine[p] of #0,#10,#13: break; - '}': - if TopPascalCodeFoldBlockType=cfbtNestedComment then - begin - Run:=p; - EndPascalCodeFoldBlock; - p:=Run; - end else begin - fRange := fRange - [rsBor, rsIDEDirective]; - Inc(p); - if TopPascalCodeFoldBlockType=cfbtBorCommand then + '}': begin + if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin + Run := p; + ct := GetCustomSymbolToken(tkAnsiComment, 1, FCustomTokenMarkup, Run <> fTokenPos); + if ct and (Run <> fTokenPos) then + exit; + end; + if TopPascalCodeFoldBlockType=cfbtNestedComment then + begin + Run:=p; EndPascalCodeFoldBlock; - break; + p:=Run; + if FCustomTokenMarkup <> nil then begin + inc(Run); + exit; + end; + end else begin + fRange := fRange - [rsBor, rsIDEDirective]; + Inc(p); + if TopPascalCodeFoldBlockType=cfbtBorCommand then + EndPascalCodeFoldBlock; + break; + end; end; '{': if NestedComments then begin + Run := p; + if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin + ct := GetCustomSymbolToken(tkAnsiComment, 1, FCustomTokenMarkup, Run <> fTokenPos); + if ct and (Run <> fTokenPos) then + exit; + end; fStringLen := 1; - Run:=p; StartPascalCodeFoldBlock(cfbtNestedComment); p:=Run; + if FCustomTokenMarkup <> nil then begin + inc(Run); + exit; + end; end; '@': begin if fLine[p+1] = '@' then @@ -4177,8 +4259,20 @@ begin inc(p) end; end; + otherwise begin + if (not WasInWord) and IsLetterChar[fline[p]] then begin + Run := p; + if GetCustomTokenAndNext(tkBorComment, FCustomTokenMarkup, True) then + exit; + end + end; end; Inc(p); + + if (not (FIsInNextToEOL or IsScanning)) and not(rsIDEDirective in fRange) then begin + WasInWord := IsInWord; + IsInWord := (IsLetterChar[fline[p]] or IsUnderScoreOrNumberChar[fline[p]]); + end; until (p>=fLineLen); Run:=p; end; @@ -4401,10 +4495,18 @@ begin end; end else begin + fTokenID := tkComment; fRange := fRange + [rsBor]; dec(Run); StartPascalCodeFoldBlock(cfbtBorCommand); + + FCustomCommentTokenMarkup := FCustomTokenMarkupBor; + if not (FIsInNextToEOL or IsScanning) then + GetCustomSymbolToken(tkBorComment, 1, FCustomTokenMarkup); + inc(Run); + if FCustomTokenMarkup <> nil then + exit; end; if FUsePasDoc and (fLine[Run] = '@') and CheckPasDoc(True) then exit; @@ -4631,21 +4733,45 @@ begin end; procedure TSynPasSyn.AnsiProc; +var + IsInWord, WasInWord, ct: Boolean; begin fTokenID := tkComment; - if FUsePasDoc and (fLine[Run] = '@') then begin - if CheckPasDoc then - exit; + FCustomCommentTokenMarkup := FCustomTokenMarkupAnsi; + + if (not (FIsInNextToEOL or IsScanning)) then begin + if FUsePasDoc and (fLine[Run] = '@') then begin + if CheckPasDoc then + exit; + end; + if (IsLetterChar[fline[Run]]) and + ( (Run = 0) or + not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]])) + ) + then begin + if GetCustomTokenAndNext(tkAnsiComment, FCustomTokenMarkup) then + exit; + end; end; + + IsInWord := False; + WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks repeat if fLine[Run]=#0 then break else if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then begin + if not (FIsInNextToEOL or IsScanning) then begin + ct := GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup, Run <> fTokenPos); + if ct and (Run <> fTokenPos) then + exit; + end; Inc(Run, 2); if TopPascalCodeFoldBlockType=cfbtNestedComment then begin EndPascalCodeFoldBlock; + if FCustomTokenMarkup <> nil then + exit; end else begin fRange := fRange - [rsAnsi]; if TopPascalCodeFoldBlockType=cfbtAnsiComment then @@ -4657,9 +4783,16 @@ begin if (pcsNestedComments in ModeSwitches) and (fLine[Run] = '(') and (fLine[Run + 1] = '*') then begin + if not (FIsInNextToEOL or IsScanning) then begin + ct := GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup, Run <> fTokenPos); + if ct and (Run <> fTokenPos) then + exit; + end; fStringLen := 2; StartPascalCodeFoldBlock(cfbtNestedComment); Inc(Run,2); + if FCustomTokenMarkup <> nil then + exit; end else if FUsePasDoc and (fLine[Run] = '@') then begin if fLine[Run+1] = '@' then @@ -4669,8 +4802,18 @@ begin exit; Inc(Run); end + else + if (not WasInWord) and IsLetterChar[fline[Run]] then begin + if GetCustomTokenAndNext(tkAnsiComment, FCustomTokenMarkup, True) then + exit; + end else Inc(Run); + + if not (FIsInNextToEOL or IsScanning) then begin + WasInWord := IsInWord; + IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]); + end; until (Run>=fLineLen) or (fLine[Run] in [#0, #10, #13]); end; @@ -4719,7 +4862,14 @@ begin fStringLen := 2; // length of "(*" Dec(Run); StartPascalCodeFoldBlock(cfbtAnsiComment); + + FCustomCommentTokenMarkup := FCustomTokenMarkupAnsi; + if not (FIsInNextToEOL or IsScanning) then + GetCustomSymbolToken(tkAnsiComment, 2, FCustomTokenMarkup); + Inc(Run, 2); + if FCustomTokenMarkup <> nil then + exit; if not (fLine[Run] in [#0, #10, #13]) then begin if FUsePasDoc and (fLine[Run] = '@') and CheckPasDoc(True) then exit; @@ -4830,8 +4980,6 @@ begin end; procedure TSynPasSyn.EqualSignProc; -var - tfb: TPascalCodeFoldBlockType; begin inc(Run); fTokenID := tkSymbol; @@ -4913,6 +5061,9 @@ end; procedure TSynPasSyn.SlashProc; begin if fLine[Run+1] = '/' then begin + FCustomCommentTokenMarkup := FCustomTokenMarkupSlash; + FIsInSlash := True; + fTokenID := tkComment; if FAtLineStart then begin fRange := fRange + [rsSlash]; @@ -4920,19 +5071,16 @@ begin if not(TopPascalCodeFoldBlockType = cfbtSlashComment) then StartPascalCodeFoldBlock(cfbtSlashComment); end; + + if (not (FIsInNextToEOL or IsScanning)) and + GetCustomSymbolToken(tkSlashComment, 2, FCustomTokenMarkup) + then begin + inc(Run, 2); + exit; + end; inc(Run, 2); - FIsInSlash := True; - while not(fLine[Run] in [#0, #10, #13]) do - if FUsePasDoc and (fLine[Run] = '@') then begin - if fLine[Run+1] = '@' then - inc(Run, 2) - else - if CheckPasDoc(True) then - exit; - Inc(Run); - end - else - Inc(Run); + + SlashCommentProc; end else begin Inc(Run); fTokenID := tkSymbol; @@ -4941,27 +5089,41 @@ begin end; procedure TSynPasSyn.SlashContinueProc; +var + AtSlashOpen: Boolean; begin - if FIsInSlash and (fLine[Run] = '@') then begin - if CheckPasDoc then - exit; + if FIsInSlash and (not (FIsInNextToEOL or IsScanning)) then begin + FCustomCommentTokenMarkup := FCustomTokenMarkupSlash; + fTokenID := tkComment; + + if (fLine[Run] = '@') then begin + if CheckPasDoc then + exit; + end; + if (IsLetterChar[fline[Run]]) and + ( (Run = 0) or + not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]])) + ) + then begin + if GetCustomTokenAndNext(tkSlashComment, FCustomTokenMarkup) then + exit; + end; end; - if FIsInSlash or ((fLine[Run] = '/') and (fLine[Run + 1] = '/')) then begin + AtSlashOpen := (fLine[Run] = '/') and (fLine[Run + 1] = '/') and not FIsInSlash; + if FIsInSlash or AtSlashOpen then begin FIsInSlash := True; // Continue fold block fTokenID := tkComment; - while not(fLine[Run] in [#0, #10, #13]) do - if FUsePasDoc and (fLine[Run] = '@') then begin - if fLine[Run+1] = '@' then - inc(Run, 2) - else - if CheckPasDoc(True) then - exit; - Inc(Run); - end - else - Inc(Run); + + if (not (FIsInNextToEOL or IsScanning)) and AtSlashOpen and + GetCustomSymbolToken(tkSlashComment, 2, FCustomTokenMarkup) + then begin + inc(Run, 2); + exit; + end; + + SlashCommentProc; exit; end; @@ -4982,6 +5144,37 @@ begin Next; end; +procedure TSynPasSyn.SlashCommentProc; +var + IsInWord, WasInWord: Boolean; +begin + IsInWord := False; + WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks + + while not(fLine[Run] in [#0, #10, #13]) do begin + if FUsePasDoc and (fLine[Run] = '@') then begin + if fLine[Run+1] = '@' then + inc(Run, 2) + else + if CheckPasDoc(True) then + exit; + Inc(Run); + end + else + if (not WasInWord) and IsLetterChar[fline[Run]] then begin + if GetCustomTokenAndNext(tkSlashComment, FCustomTokenMarkup, True) then + exit; + end + else + Inc(Run); + + if not (FIsInNextToEOL or IsScanning) then begin + WasInWord := IsInWord; + IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]); + end; + end; +end; + procedure TSynPasSyn.SpaceProc; begin inc(Run); @@ -5002,18 +5195,82 @@ begin end; procedure TSynPasSyn.StringProc; +var + IsInWord, WasInWord, ct: Boolean; begin fTokenID := tkString; - Inc(Run); - while (not (fLine[Run] in [#0, #10, #13])) do begin - if fLine[Run] = '''' then begin + + if FInString then begin + if not (FIsInNextToEOL or IsScanning) then begin + if (fLine[Run] = '''') and (fLine[Run+1] = '''') and + GetCustomSymbolToken(tkString, 2, FCustomTokenMarkup) + then begin + inc(Run, 2); + exit; + end; + + if (IsLetterChar[fline[Run]]) and + ( (Run = 0) or + not((IsLetterChar[fline[Run-1]] or IsUnderScoreOrNumberChar[fline[Run-1]])) + ) + then begin + if GetCustomTokenAndNext(tkString, FCustomTokenMarkup) then + exit; + end; + end; + end + else begin + FInString := True; + if not (FIsInNextToEOL or IsScanning) and + GetCustomSymbolToken(tkString, 1, FCustomTokenMarkup) + then begin Inc(Run); - if (fLine[Run] <> '''') then - break; + exit; end; Inc(Run); end; + IsInWord := False; + WasInWord := (FIsInNextToEOL or IsScanning); // don't run checks + while (not (fLine[Run] in [#0, #10, #13])) do begin + if fLine[Run] = '''' then begin + if (fLine[Run+1] = '''') then begin + // escaped + if (not (FIsInNextToEOL or IsScanning)) and + GetCustomSymbolToken(tkString, 2, FCustomTokenMarkup, Run <> fTokenPos) + then begin + if (Run = fTokenPos) then + inc(Run, 2); + exit + end; + Inc(Run); + end + else begin + // string end + if not (FIsInNextToEOL or IsScanning) then begin + ct := GetCustomSymbolToken(tkString, 1, FCustomTokenMarkup, Run <> fTokenPos); + if ct and (Run <> fTokenPos) then + exit; + end; + Inc(Run); + break; + end; + end + else + if (not WasInWord) and IsLetterChar[fline[Run]] then begin + if GetCustomTokenAndNext(tkString, FCustomTokenMarkup, True) then + exit; + end; + + Inc(Run); + + if not (FIsInNextToEOL or IsScanning) then begin + WasInWord := IsInWord; + IsInWord := (IsLetterChar[fline[Run]] or IsUnderScoreOrNumberChar[fline[Run]]); + end; + end; + FInString := False; + // modifiers like "alias" take a string as argument if (PasCodeFoldRange.BracketNestLevel = 0) then begin if (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader] = [rsInProcHeader]) and @@ -5085,26 +5342,67 @@ begin ; end; -procedure TSynPasSyn.CheckForAdditionalAttributes; +function TSynPasSyn.GetCustomSymbolToken(ATokenID: TtkTokenKindEx; ALen: integer; out + ACustomMarkup: TSynHighlighterAttributesModifier; APeekOnly: boolean): boolean; var - i, h: integer; - CustTkList: TStringList; - tfb: TPascalCodeFoldBlockType; + TempMarkup: TSynHighlighterAttributesModifier; begin - h := FTokenHashKey and 255; - if FTokenID in FCustomTokenInfo[h].MatchTokenKinds then begin - CustTkList := nil; - for i := 0 to Length(FCustomTokenInfo[h].Lists) - 1 do - if FCustomTokenInfo[h].Lists[i].TokenKind = FTokenID then begin - CustTkList := FCustomTokenInfo[h].Lists[i].List; + ACustomMarkup := nil; + Result := GetCustomToken(ATokenID, 0, @fLine[Run], ALen, TempMarkup); + if Result and (not APeekOnly) then + ACustomMarkup := TempMarkup; +end; + +function TSynPasSyn.GetCustomTokenAndNext(ATokenID: TtkTokenKindEx; out + ACustomMarkup: TSynHighlighterAttributesModifier; APeekOnly: boolean): boolean; +var + h: Integer; + TempTokenMarkup: TSynHighlighterAttributesModifier; +begin + ACustomMarkup := nil; + fToIdent := Run; + h := KeyHash; + Result := fStringLen > 0; + if not Result then + exit; + Result := GetCustomToken(ATokenID, byte(h and 255), @fLine[Run], fStringLen, TempTokenMarkup); + if Result and (not APeekOnly) then begin + ACustomMarkup := TempTokenMarkup; + Run := Run + fStringLen; + end; +end; + +function TSynPasSyn.GetCustomToken(ATokenID: TtkTokenKindEx; AnHash: byte; ATokenStart: PChar; + ATokenLen: integer; out ACustomMarkup: TSynHighlighterAttributesModifier): boolean; +var + CustTkList: TStringList; + i, j: integer; + s: string; +begin + Result := False; + ACustomMarkup := nil; + if ATokenID in FCustomTokenInfo[AnHash].MatchTokenKinds then begin + for i := 0 to Length(FCustomTokenInfo[AnHash].Lists) - 1 do + if FCustomTokenInfo[AnHash].Lists[i].TokenKind = ATokenID then begin + CustTkList := FCustomTokenInfo[AnHash].Lists[i].List; + if CustTkList <> nil then begin + SetString(s, ATokenStart, ATokenLen); + j := CustTkList.IndexOf(UpperCase(s)); + Result := j >= 0; + if Result then + ACustomMarkup := TSynPasSynCustomToken(CustTkList.Objects[j]).Markup; + end; break; end; - if CustTkList <> nil then begin - i := CustTkList.IndexOf(UpperCase(GetToken)); - if i >= 0 then - FCustomTokenMarkup := TSynPasSynCustomToken(CustTkList.Objects[i]).Markup; - end; end; +end; + +procedure TSynPasSyn.CheckForAdditionalAttributes; +var + tfb: TPascalCodeFoldBlockType; +begin + if not (FTokenID in [tkString, tkComment]) then + GetCustomToken(FTokenID, byte(FTokenHashKey and 255), @fLine[fTokenPos], Run - fTokenPos, FCustomTokenMarkup); case FTokenState of tsAtProcName: begin @@ -5280,13 +5578,16 @@ begin BorProc else if rsDirective in fRange then DirectiveProc - else if rsSlash in fRange then + else if (rsSlash in fRange) or FIsInSlash then SlashContinueProc + else if FInString then + StringProc else begin FNextTokenState := tsNone; OldNestLevel := PasCodeFoldRange.BracketNestLevel; if (PasCodeFoldRange.BracketNestLevel = 1) then // procedure foo; [attr...] FOldRange := FOldRange - [rsWasInProcHeader]; + FCustomCommentTokenMarkup := nil; FTokenExtraAttribs := []; FTokenTypeDeclExtraAttrib := eaNone; //if rsAtEqual in fRange then @@ -5549,6 +5850,11 @@ begin FCustomTokenMergedMarkup.Merge(FCustomTokenMarkup); Result := FCustomTokenMergedMarkup; end; + if FCustomCommentTokenMarkup <> nil then begin + FCustomCommentTokenMergedMarkup.Assign(Result); + FCustomCommentTokenMergedMarkup.Merge(FCustomCommentTokenMarkup); + Result := FCustomCommentTokenMergedMarkup; + end; if (FTokenID = tkSymbol) and (Run - fTokenPos = 1) and (fLine[fTokenPos] in ['(', ')']) then begin @@ -5605,7 +5911,8 @@ end; function TSynPasSyn.GetTokenIsCommentEnd: Boolean; begin Result := (FTokenID = tkComment) and - (FRange * [rsAnsi, rsBor, rsSlash] = []); // rsIDEDirective + (FRange * [rsAnsi, rsBor, rsSlash] = []) and // rsIDEDirective + (not (FIsInSlash and (Run < fLineLen))); end; function TSynPasSyn.GetRange: Pointer; @@ -7244,7 +7551,7 @@ begin FOnChange(Self); end; -procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKinds); +procedure TSynPasSynCustomToken.SetMatchTokenKinds(AValue: TtkTokenKindExs); begin if FMatchTokenKinds = AValue then Exit; FMatchTokenKinds := AValue; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index f986d2762d..94243b26f5 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -3622,6 +3622,11 @@ resourcestring lisCodeToolsOptsNewLine = 'Newline'; lisCodeToolsOptsSpace = 'Space'; lisCodeToolsOptsSymbol = 'Symbol'; + lisCodeToolsOptsString = 'String'; + lisCodeToolsOptsComment= 'Comment'; + lisCodeToolsOptsCommentSlash= 'Slash Comment: //'; + lisCodeToolsOptsCommentAnsi = 'Ansi Comment: (*'; + lisCodeToolsOptsCommentBor = 'Curly Comment: {'; lisCodeToolsOptsBracket = 'Bracket'; lisCodeToolsOptsCaret = 'Caret (^)'; diff --git a/ide/main.pp b/ide/main.pp index 5a13c28640..f5052983e9 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -4042,7 +4042,7 @@ begin TokenTxt, TokenType, Start, Attri); inc(xy.x); if Start + Length(TokenTxt) = xy.X then begin - IdentFound := TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]; + IdentFound := (TokenType >= 0) and (TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]); StringFound := TtkTokenKind(TokenType) = tkString; end; cont := True; @@ -4050,7 +4050,7 @@ begin if not (IdentFound or StringFound) then begin ASrcEdit.EditorComponent.GetHighlighterAttriAtRowColEx(xy, TokenTxt, TokenType, Start, Attri, cont); - IdentFound := TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]; + IdentFound := (TokenType >= 0) and (TtkTokenKind(TokenType) in [tkAsm, tkComment, tkIdentifier, tkString]); StringFound := TtkTokenKind(TokenType) = tkString; end; end; diff --git a/ide/sourcesyneditor.pas b/ide/sourcesyneditor.pas index 0b29a88a2e..1ada0e4c9f 100644 --- a/ide/sourcesyneditor.pas +++ b/ide/sourcesyneditor.pas @@ -379,9 +379,9 @@ type TSynHighlighterLazCustomPasAttribute = class(TSynHighlighterAttributesModifier) private FCustomWords: TStrings; - FCustomWordTokenKind: TtkTokenKind; + FCustomWordTokenKind: TtkTokenKindEx; procedure DoWordsChanged(Sender: TObject); - procedure SetCustomWordTokenKind(AValue: TtkTokenKind); + procedure SetCustomWordTokenKind(AValue: TtkTokenKindEx); protected procedure AssignFrom(Src: TLazSynCustomTextAttributes); override; procedure DoClear; override; @@ -390,7 +390,7 @@ type destructor Destroy; override; property CustomWords: TStrings read FCustomWords; published - property CustomWordTokenKind: TtkTokenKind read FCustomWordTokenKind write SetCustomWordTokenKind; + property CustomWordTokenKind: TtkTokenKindEx read FCustomWordTokenKind write SetCustomWordTokenKind; end; { TIDESynPasSyn } @@ -2155,7 +2155,7 @@ end; { TSynHighlighterLazCustomPasAttribute } -procedure TSynHighlighterLazCustomPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKind); +procedure TSynHighlighterLazCustomPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKindEx); begin if FCustomWordTokenKind = AValue then Exit; FCustomWordTokenKind := AValue; diff --git a/ide/syncolorattribeditor.pas b/ide/syncolorattribeditor.pas index f78f569bc2..b4c29ef31c 100644 --- a/ide/syncolorattribeditor.pas +++ b/ide/syncolorattribeditor.pas @@ -258,6 +258,11 @@ begin 2: FCurHighlightElement.CustomWordTokenKind := tkModifier; 3: FCurHighlightElement.CustomWordTokenKind := tkNumber; 4: FCurHighlightElement.CustomWordTokenKind := tkSymbol; + 5: FCurHighlightElement.CustomWordTokenKind := tkString; + 6: FCurHighlightElement.CustomWordTokenKind := tkComment; + 7: FCurHighlightElement.CustomWordTokenKind := tkSlashComment; + 8: FCurHighlightElement.CustomWordTokenKind := tkAnsiComment; + 9: FCurHighlightElement.CustomWordTokenKind := tkBorComment; end; end; @@ -790,6 +795,11 @@ begin tkModifier: dropCustomWordKind.ItemIndex := 2; tkNumber: dropCustomWordKind.ItemIndex := 3; tkSymbol: dropCustomWordKind.ItemIndex := 4; + tkString: dropCustomWordKind.ItemIndex := 5; + tkComment: dropCustomWordKind.ItemIndex := 6; + tkSlashComment: dropCustomWordKind.ItemIndex := 7; + tkAnsiComment: dropCustomWordKind.ItemIndex := 8; + tkBorComment: dropCustomWordKind.ItemIndex := 9; end; UpdatingColor := False; @@ -870,6 +880,11 @@ begin dropCustomWordKind.Items.Add(dlgModifier); dropCustomWordKind.Items.Add(lisCodeToolsOptsNumber); dropCustomWordKind.Items.Add(lisCodeToolsOptsSymbol); + dropCustomWordKind.Items.Add(lisCodeToolsOptsString); + dropCustomWordKind.Items.Add(lisCodeToolsOptsComment); + dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentSlash); + dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentAnsi); + dropCustomWordKind.Items.Add(lisCodeToolsOptsCommentBor); dropCustomWordKind.ItemIndex := 0; //Constraints.MinHeight := max(Constraints.MinHeight,