{------------------------------------------------------------------------------- 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: SynHighlighterGeneral.pas, released 2000-04-07. The Original Code is based on the mwGeneralSyn.pas file from the mwEdit component suite by Martin Waldenburg and other developers, the Initial Author of this file is Martin Waldenburg. Portions written by Martin Waldenburg are copyright 1999 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: SynHighlighterGeneral.pas,v 1.16 2005/01/28 16:53:22 maelh Exp $ 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 customizable highlighter for SynEdit) @author(Martin Waldenburg, converted to SynEdit by Michael Hieke) @created(1999) @lastmod(2000-06-23) The SynHighlighterGeneral unit provides a customizable highlighter for SynEdit. } {$IFNDEF QSYNHIGHLIGHTERGENERAL} unit SynHighlighterGeneral; {$ENDIF} // extrasyn.inc is the synedit.inc from laz 1.2.0 synedit package source, // If it has changed in newer version you might need to copy it again. // Remember to redclare the syn_lazarus define. {$I extrasyn.inc} interface uses Graphics, SynEditTypes, SynEditHighlighter, SysUtils, Classes; type TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber, tkPreprocessor, tkSpace, tkString, tkSymbol, tkUnknown); TCommentStyle = (csAnsiStyle, csPasStyle, csCStyle, csAsmStyle, csBasStyle, csCPPStyle); TCommentStyles = set of TCommentStyle; TRangeState = (rsANil, rsAnsi, rsPasStyle, rsCStyle, rsUnKnown); TStringDelim = (sdSingleQuote, sdDoubleQuote); TProcTableProc = procedure of object; type TSynGeneralSyn = class(TSynCustomHighlighter) private fRange: TRangeState; fLine: PChar; fProcTable: array[#0..#255] of TProcTableProc; Run: LongInt; fTokenPos: Integer; fTokenID: TtkTokenKind; fLineNumber : Integer; fCommentAttri: TSynHighlighterAttributes; fIdentifierAttri: TSynHighlighterAttributes; fKeyAttri: TSynHighlighterAttributes; fNumberAttri: TSynHighlighterAttributes; fPreprocessorAttri: TSynHighlighterAttributes; fSpaceAttri: TSynHighlighterAttributes; fStringAttri: TSynHighlighterAttributes; fSymbolAttri: TSynHighlighterAttributes; fKeyWords: TStrings; fComments: TCommentStyles; fStringDelimCh: char; fIdentChars: TSynIdentChars; fDetectPreprocessor: boolean; procedure AsciiCharProc; procedure BraceOpenProc; procedure PointCommaProc; procedure CRProc; procedure IdentProc; procedure IntegerProc; procedure LFProc; procedure NullProc; procedure NumberProc; procedure RoundOpenProc; procedure SlashProc; procedure SpaceProc; procedure StringProc; procedure UnknownProc; procedure MakeMethodTables; procedure AnsiProc; procedure PasStyleProc; procedure CStyleProc; procedure SetKeyWords(const Value: TStrings); procedure SetComments(Value: TCommentStyles); function GetStringDelim: TStringDelim; procedure SetStringDelim(const Value: TStringDelim); function GetIdentifierChars: string; procedure SetIdentifierChars(const Value: string); procedure SetDetectPreprocessor(Value: boolean); protected function GetIdentChars: TSynIdentChars; override; public class 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 GetTokenID: TtkTokenKind; function GetToken: String; override; function GetTokenAttribute: TSynHighlighterAttributes; override; function GetTokenKind: integer; override; function GetTokenPos: Integer; override; function IsKeyword(const AKeyword: string): boolean; override; procedure Next; override; procedure ResetRange; override; procedure SetRange(Value: Pointer); override; {$IFDEF SYN_LAZARUS} procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; {$ENDIF} // procedure SetLine(NewValue: String; LineNumber: Integer); override; procedure SetLine(const NewValue: String; LineNumber: Integer); override; {$IFNDEF SYN_LAZARUS} function SaveToRegistry(RootKey: HKEY; Key: string): boolean; override; function LoadFromRegistry(RootKey: HKEY; Key: string): boolean; override; {$ENDIF} published property CommentAttri: TSynHighlighterAttributes read fCommentAttri write fCommentAttri; property Comments: TCommentStyles read fComments write SetComments; property DetectPreprocessor: boolean read fDetectPreprocessor write SetDetectPreprocessor; property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri write fIdentifierAttri; property IdentifierChars: string read GetIdentifierChars write SetIdentifierChars; property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri; property KeyWords: TStrings read fKeyWords write SetKeyWords; property NumberAttri: TSynHighlighterAttributes read fNumberAttri write fNumberAttri; property PreprocessorAttri: TSynHighlighterAttributes read fPreprocessorAttri write fPreprocessorAttri; property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri; property StringAttri: TSynHighlighterAttributes read fStringAttri write fStringAttri; property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri write fSymbolAttri; property StringDelim: TStringDelim read GetStringDelim write SetStringDelim default sdSingleQuote; end; implementation uses {$IFDEF SYN_CLX} QSynEditStrConst; {$ELSE} SynEditStrConst; {$ENDIF} var Identifiers: array[#0..#255] of ByteBool; mHashTable: array[#0..#255] of Integer; 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 in ['_', 'a'..'z', 'A'..'Z'] of True: mHashTable[I] := Ord(J) - 64 else mHashTable[I] := 0; end; end; end; function TSynGeneralSyn.IsKeyword(const AKeyword: string): boolean; var First, Last, I, Compare: Integer; Token: String; begin First := 0; Last := fKeywords.Count - 1; Result := False; Token := UpperCase(AKeyword); while First <= Last do begin I := (First + Last) shr 1; Compare := AnsiCompareText(fKeywords[i], Token); if Compare = 0 then begin Result := True; break; end else if Compare < 0 then First := I + 1 else Last := I - 1; end; end; { IsKeyWord } procedure TSynGeneralSyn.MakeMethodTables; var I: Char; begin for I := #0 to #255 do case I of '#': fProcTable[I] := {$ifdef FPC} @ {$endif}AsciiCharProc; '{': fProcTable[I] := {$ifdef FPC} @ {$endif}BraceOpenProc; ';': fProcTable[I] := {$ifdef FPC} @ {$endif}PointCommaProc; #13: fProcTable[I] := {$ifdef FPC} @ {$endif}CRProc; 'A'..'Z', 'a'..'z', '_': fProcTable[I] := {$ifdef FPC} @ {$endif}IdentProc; '$': fProcTable[I] := {$ifdef FPC} @ {$endif}IntegerProc; #10: fProcTable[I] := {$ifdef FPC} @ {$endif}LFProc; #0: fProcTable[I] := {$ifdef FPC} @ {$endif}NullProc; '0'..'9': fProcTable[I] := {$ifdef FPC} @ {$endif}NumberProc; '(': fProcTable[I] := {$ifdef FPC} @ {$endif}RoundOpenProc; '/': fProcTable[I] := {$ifdef FPC} @ {$endif}SlashProc; #1..#9, #11, #12, #14..#32: fProcTable[I] := {$ifdef FPC} @ {$endif}SpaceProc; else fProcTable[I] := {$ifdef FPC} @ {$endif}UnknownProc; end; fProcTable[fStringDelimCh] := {$ifdef FPC} @ {$endif}StringProc; end; constructor TSynGeneralSyn.Create(AOwner: TComponent); begin inherited Create(AOwner); fKeyWords := TStringList.Create; TStringList(fKeyWords).Sorted := True; TStringList(fKeyWords).Duplicates := dupIgnore; fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment); fCommentAttri.Style := [fsItalic]; AddAttribute(fCommentAttri); fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier); AddAttribute(fIdentifierAttri); fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord); fKeyAttri.Style := [fsBold]; AddAttribute(fKeyAttri); fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber); AddAttribute(fNumberAttri); fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace); AddAttribute(fSpaceAttri); fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString); AddAttribute(fStringAttri); fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol); AddAttribute(fSymbolAttri); fPreprocessorAttri := TSynHighlighterAttributes.Create(SYNS_AttrPreprocessor); AddAttribute(fPreprocessorAttri); SetAttributesOnChange({$ifdef FPC} @ {$endif}DefHighlightChange); fStringDelimCh := ''''; fIdentChars := inherited GetIdentChars; MakeMethodTables; fRange := rsUnknown; end; { Create } destructor TSynGeneralSyn.Destroy; begin fKeyWords.Free; inherited Destroy; end; { Destroy } {$IFDEF SYN_LAZARUS} procedure TSynGeneralSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer); begin TokenLength := Run - fTokenPos; TokenStart := FLine + fTokenPos; end; {$ENDIF} procedure TSynGeneralSyn.SetLine(const NewValue: String; LineNumber:Integer); begin fLine := PChar(NewValue); Run := 0; fLineNumber := LineNumber; Next; end; { SetLine } procedure TSynGeneralSyn.AnsiProc; begin case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else fTokenID := tkComment; repeat if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then begin fRange := rsUnKnown; Inc(Run, 2); break; end; Inc(Run); until fLine[Run] in [#0, #10, #13]; end; end; procedure TSynGeneralSyn.PasStyleProc; begin case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else fTokenID := tkComment; repeat if fLine[Run] = '}' then begin fRange := rsUnKnown; Inc(Run); break; end; Inc(Run); until fLine[Run] in [#0, #10, #13]; end; end; procedure TSynGeneralSyn.CStyleProc; begin case fLine[Run] of #0: NullProc; #10: LFProc; #13: CRProc; else fTokenID := tkComment; repeat if (fLine[Run] = '*') and (fLine[Run + 1] = '/') then begin fRange := rsUnKnown; Inc(Run, 2); break; end; Inc(Run); until fLine[Run] in [#0, #10, #13]; end; end; procedure TSynGeneralSyn.AsciiCharProc; begin if fDetectPreprocessor then begin fTokenID := tkPreprocessor; repeat inc(Run); until fLine[Run] in [#0, #10, #13]; end else begin fTokenID := tkString; repeat inc(Run); until not (fLine[Run] in ['0'..'9']); end; end; procedure TSynGeneralSyn.BraceOpenProc; begin if csPasStyle in fComments then begin fTokenID := tkComment; fRange := rsPasStyle; inc(Run); while FLine[Run] <> #0 do case FLine[Run] of '}': begin fRange := rsUnKnown; inc(Run); break; end; #10: break; #13: break; else inc(Run); end; end else begin inc(Run); fTokenID := tkSymbol; end; end; procedure TSynGeneralSyn.PointCommaProc; begin if (csASmStyle in fComments) or (csBasStyle in fComments) then begin fTokenID := tkComment; fRange := rsUnknown; inc(Run); while FLine[Run] <> #0 do begin fTokenID := tkComment; inc(Run); end; end else begin inc(Run); fTokenID := tkSymbol; end; end; procedure TSynGeneralSyn.CRProc; begin fTokenID := tkSpace; Inc(Run); if fLine[Run] = #10 then Inc(Run); end; procedure TSynGeneralSyn.IdentProc; begin while Identifiers[fLine[Run]] do inc(Run); if IsKeyWord(GetToken) then fTokenId := tkKey else fTokenId := tkIdentifier; end; procedure TSynGeneralSyn.IntegerProc; begin inc(Run); fTokenID := tkNumber; while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run); end; procedure TSynGeneralSyn.LFProc; begin fTokenID := tkSpace; inc(Run); end; procedure TSynGeneralSyn.NullProc; begin fTokenID := tkNull; end; procedure TSynGeneralSyn.NumberProc; begin inc(Run); fTokenID := tkNumber; while FLine[Run] in ['0'..'9', '.', 'e', 'E', 'x'] do begin case FLine[Run] of 'x': begin // handle C style hex numbers IntegerProc; break; end; '.': if FLine[Run + 1] = '.' then break; end; inc(Run); end; end; procedure TSynGeneralSyn.RoundOpenProc; begin inc(Run); if csAnsiStyle in fComments then begin case fLine[Run] of '*': begin fTokenID := tkComment; fRange := rsAnsi; inc(Run); while fLine[Run] <> #0 do case fLine[Run] of '*': if fLine[Run + 1] = ')' then begin fRange := rsUnKnown; inc(Run, 2); break; end else inc(Run); #10: break; #13: break; else inc(Run); end; end; '.': begin inc(Run); fTokenID := tkSymbol; end; else begin FTokenID := tkSymbol; end; end; end else fTokenId := tkSymbol; end; procedure TSynGeneralSyn.SlashProc; begin Inc(Run); case FLine[Run] of '/': begin if csCPPStyle in fComments then begin fTokenID := tkComment; Inc(Run); while FLine[Run] <> #0 do begin case FLine[Run] of #10, #13: break; end; inc(Run); end; end else fTokenId := tkSymbol; end; '*': begin if csCStyle in fComments then begin fTokenID := tkComment; fRange := rsCStyle; Inc(Run); while fLine[Run] <> #0 do case fLine[Run] of '*': if fLine[Run + 1] = '/' then begin fRange := rsUnKnown; inc(Run, 2); break; end else inc(Run); #10, #13: break; else Inc(Run); end; end else fTokenId := tkSymbol; end; else fTokenID := tkSymbol; end; end; procedure TSynGeneralSyn.SpaceProc; begin inc(Run); fTokenID := tkSpace; while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run); end; procedure TSynGeneralSyn.StringProc; begin fTokenID := tkString; if (fLine[Run + 1] = fStringDelimCh) and (fLine[Run + 2] = fStringDelimCh) then Inc(Run, 2); repeat case FLine[Run] of #0, #10, #13: break; end; inc(Run); until FLine[Run] = fStringDelimCh; if FLine[Run] <> #0 then inc(Run); end; procedure TSynGeneralSyn.UnknownProc; begin {$IFDEF SYN_MBCSSUPPORT} if FLine[Run] in LeadBytes then Inc(Run, 2) else {$ENDIF} inc(Run); fTokenID := tkUnknown; end; procedure TSynGeneralSyn.Next; begin fTokenPos := Run; case fRange of rsAnsi: AnsiProc; rsPasStyle: PasStyleProc; rsCStyle: CStyleProc; else fProcTable[fLine[Run]]; end; end; function TSynGeneralSyn.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; SYN_ATTR_SYMBOL: Result := fSymbolAttri; else Result := nil; end; end; function TSynGeneralSyn.GetEol: Boolean; begin Result := fTokenId = tkNull; end; function TSynGeneralSyn.GetRange: Pointer; begin Result := Pointer(PtrInt(fRange)); end; function TSynGeneralSyn.GetToken: String; var Len: LongInt; begin Len := Run - fTokenPos; SetString(Result, (FLine + fTokenPos), Len); end; function TSynGeneralSyn.GetTokenID: TtkTokenKind; begin Result := fTokenId; end; function TSynGeneralSyn.GetTokenAttribute: TSynHighlighterAttributes; begin case fTokenID of tkComment: Result := fCommentAttri; tkIdentifier: Result := fIdentifierAttri; tkKey: Result := fKeyAttri; tkNumber: Result := fNumberAttri; tkPreprocessor: Result := fPreprocessorAttri; tkSpace: Result := fSpaceAttri; tkString: Result := fStringAttri; tkSymbol: Result := fSymbolAttri; tkUnknown: Result := fSymbolAttri; else Result := nil; end; end; function TSynGeneralSyn.GetTokenKind: integer; begin Result := Ord(fTokenId); end; function TSynGeneralSyn.GetTokenPos: Integer; begin Result := fTokenPos; end; procedure TSynGeneralSyn.ResetRange; begin fRange := rsUnknown; end; procedure TSynGeneralSyn.SetRange(Value: Pointer); begin fRange := TRangeState(PtrUInt(Value)); end; procedure TSynGeneralSyn.SetKeyWords(const Value: TStrings); var i: Integer; begin if Value <> nil then begin Value.BeginUpdate; for i := 0 to Value.Count - 1 do Value[i] := UpperCase(Value[i]); Value.EndUpdate; end; fKeyWords.Assign(Value); DefHighLightChange(nil); end; procedure TSynGeneralSyn.SetComments(Value: TCommentStyles); begin if fComments <> Value then begin fComments := Value; DefHighLightChange(Self); end; end; class function TSynGeneralSyn.GetLanguageName: string; begin Result := SYNS_LangGeneral; end; {$IFNDEF SYN_LAZARUS} function TSynGeneralSyn.LoadFromRegistry(RootKey: HKEY; Key: string): boolean; var r: TBetterRegistry; begin r:= TBetterRegistry.Create; try r.RootKey := RootKey; if r.OpenKeyReadOnly(Key) then begin if r.ValueExists('KeyWords') then KeyWords.Text:= r.ReadString('KeyWords'); Result := inherited LoadFromRegistry(RootKey, Key); end else Result := false; finally r.Free; end; end; function TSynGeneralSyn.SaveToRegistry(RootKey: HKEY; Key: string): boolean; var r: TBetterRegistry; begin r:= TBetterRegistry.Create; try r.RootKey := RootKey; if r.OpenKey(Key,true) then begin Result := true; r.WriteString('KeyWords', KeyWords.Text); Result := inherited SaveToRegistry(RootKey, Key); end else Result := false; finally r.Free; end; end; {$ENDIF} function TSynGeneralSyn.GetStringDelim: TStringDelim; begin if fStringDelimCh = '''' then Result := sdSingleQuote else Result := sdDoubleQuote; end; procedure TSynGeneralSyn.SetStringDelim(const Value: TStringDelim); var newCh: char; begin case Value of sdSingleQuote: newCh := ''''; else newCh := '"'; end; //case if newCh <> fStringDelimCh then begin fStringDelimCh := newCh; MakeMethodTables; end; end; function TSynGeneralSyn.GetIdentifierChars: string; var ch: char; s: shortstring; begin s := ''; for ch := #0 to #255 do if ch in fIdentChars then s := s + ch; Result := s; end; procedure TSynGeneralSyn.SetIdentifierChars(const Value: string); var i: integer; begin fIdentChars := []; for i := 1 to Length(Value) do begin fIdentChars := fIdentChars + [Value[i]]; end; //for WordBreakChars := WordBreakChars - fIdentChars; end; function TSynGeneralSyn.GetIdentChars: TSynIdentChars; begin Result := fIdentChars; end; procedure TSynGeneralSyn.SetDetectPreprocessor(Value: boolean); begin if Value <> fDetectPreprocessor then begin fDetectPreprocessor := Value; DefHighlightChange(Self); end; end; initialization MakeIdentTable; {$IFNDEF SYN_CPPB_1} RegisterPlaceableHighlighter(TSynGeneralSyn); {$ENDIF} end.