lazarus/components/synedit/syntextmatesyn.pas
2024-03-05 15:38:14 +01:00

456 lines
14 KiB
ObjectPascal

unit SynTextMateSyn;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fgl,
jsonparser, jsonscanner, fpjson,
// LazUtils
LazFileUtils,
Laz2_XMLRead, Laz2_DOM, LazStringUtils,
// LazEdit
TextMateGrammar,
// SynEdit
SynEditHighlighter, SynEditHighlighterFoldBase, SynEditTypes, SynEditTextBase;
type
TNameAttributesMap = specialize TFPGMapObject<string, TSynHighlighterAttributes>;
TGrammarLoadEvent = procedure(AGrammarFile, AGrammarPath: String; out AGrammarDef: String);
TSynTextMateRangeInfo = record
FoldLevel: Smallint;
end;
{ TSynHighlighterTextMateRangeList }
TSynHighlighterTextMateRangeList = class(TSynHighlighterRangeList)
private
FItemOffset: integer;
function GetRangeInfo(Index: Integer): TSynTextMateRangeInfo;
procedure SetRangeInfo(Index: Integer; AValue: TSynTextMateRangeInfo);
public
constructor Create;
property RangeInfo[Index: Integer]: TSynTextMateRangeInfo read GetRangeInfo write SetRangeInfo;
end;
{ TSynTextMateSyn }
TSynTextMateSyn = class(TSynCustomFoldHighlighter)
private
FGrammarPath: String;
FOnLoadGrammarFile: TGrammarLoadEvent;
FTextMateGrammar: TTextMateGrammar;
private
FAttriMap: TNameAttributesMap;
function LoadFile(AGrammarFile: String): String;
procedure SetGrammarPath(AValue: String);
function GetOrCreateAttribIdxForName(AName: String): integer;
procedure DoPopulateAttributeInfo(Sender: TTextMateGrammar; APattern: TTextMatePattern;
AContextName: String; var AnAttribInfo: TSynAttributeInfo);
procedure DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
private
FCurrentRange: Integer;
FRangeInfo: TSynTextMateRangeInfo;
FCurrentTokenPos, FCurrentTokenLen: Integer;
FCurrentTokenKind: integer;
FCurrentAttrib: TSynHighlighterAttributes;
function GetParserError: String;
protected
function GetInstanceLanguageName: string; override;
function CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList; override;
function UpdateRangeInfoAtLine(Index: Integer): Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadGrammar(AGrammarDef: String);
procedure LoadGrammar(AGrammarFile, AGrammarPath: String);
procedure SetLine(const NewValue: String; LineNumber: Integer); override;
procedure Next; override;
function GetEol: Boolean; override;
function DebugAttrAtXPos(AXPos: Integer): String; // requires StartAtLineIndex before
function GetToken: String; override;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
function GetTokenPos: Integer; override;
function GetTokenKind: integer; override;
function GetTokenAttribute: TSynHighlighterAttributes; override;
//
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
function GetRange: Pointer; override;
function FoldBlockEndLevel(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
function FoldBlockMinLevel(ALineIndex: TLineIdx; const AFilter: TSynFoldBlockFilter): integer; override; overload;
property OnLoadGrammarFile: TGrammarLoadEvent read FOnLoadGrammarFile write FOnLoadGrammarFile;
property GrammarPath: String read FGrammarPath write SetGrammarPath;
property ParserError: String read GetParserError;
property TextMateGrammar: TTextMateGrammar read FTextMateGrammar;
end;
implementation
{ TSynHighlighterTextMateRangeList }
function TSynHighlighterTextMateRangeList.GetRangeInfo(Index: Integer
): TSynTextMateRangeInfo;
begin
if (Index < 0) or (Index >= Count) then
Result := Default(TSynTextMateRangeInfo)
else
Result := TSynTextMateRangeInfo((ItemPointer[Index] + FItemOffset)^);
end;
procedure TSynHighlighterTextMateRangeList.SetRangeInfo(Index: Integer;
AValue: TSynTextMateRangeInfo);
begin
TSynTextMateRangeInfo((ItemPointer[Index] + FItemOffset)^) := AValue;
end;
constructor TSynHighlighterTextMateRangeList.Create;
begin
inherited;
FItemOffset := ItemSize;
ItemSize := FItemOffset + SizeOf(TSynTextMateRangeInfo);
end;
{ TSynTextMateSyn }
function TSynTextMateSyn.LoadFile(AGrammarFile: String): String;
var
s: TStringStream;
begin
if Assigned(FOnLoadGrammarFile) then begin
OnLoadGrammarFile(AGrammarFile, FGrammarPath, Result);
end
else begin
s := TStringStream.Create('');
try
s.LoadFromFile(FGrammarPath + AGrammarFile);
Result := s.DataString;
finally
s.Free;
end;
end;
end;
procedure TSynTextMateSyn.SetGrammarPath(AValue: String);
begin
if FGrammarPath = AValue then Exit;
if AValue <> '' then
AppendPathDelim(AValue);
FGrammarPath := AValue;
end;
function TSynTextMateSyn.GetOrCreateAttribIdxForName(AName: String): integer;
var
attr: TSynHighlighterAttributes;
begin
if AName = '' then
exit(-1);
Result := FAttriMap.IndexOf(AName);
if Result >= 0 then
exit;
attr := TSynHighlighterAttributes.Create(AName, AName);
AddAttribute(attr);
Result := FAttriMap.Add(AName, attr);
end;
function TSynTextMateSyn.GetInstanceLanguageName: string;
begin
Result := FTextMateGrammar.LanguageName;
end;
function TSynTextMateSyn.CreateRangeList(ALines: TSynEditStringsBase
): TSynHighlighterRangeList;
begin
Result := TSynHighlighterTextMateRangeList.Create;
end;
function TSynTextMateSyn.UpdateRangeInfoAtLine(Index: Integer): Boolean;
var
r: TSynTextMateRangeInfo;
i: Integer;
begin
GetRange;
i := {%H-}Integer(TSynHighlighterTextMateRangeList(CurrentRanges).Range[Index]);
if i <> FCurrentRange then
FTextMateGrammar.MainPatternList[i].DecRefCount;
Result := inherited;
r := TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[Index];
Result := Result
or (FRangeInfo.FoldLevel <> r.FoldLevel);
TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[Index] := FRangeInfo;
if i <> FCurrentRange then
FTextMateGrammar.MainPatternList[Integer(i)].IncRefCount;
end;
procedure TSynTextMateSyn.DoPopulateAttributeInfo(
Sender: TTextMateGrammar; APattern: TTextMatePattern;
AContextName: String; var AnAttribInfo: TSynAttributeInfo);
begin
AnAttribInfo.TokId := GetOrCreateAttribIdxForName(AContextName);
if AnAttribInfo.TokId < 0 then
AnAttribInfo.TokObject := nil
else
AnAttribInfo.TokObject := FAttriMap.Data[AnAttribInfo.TokId];
end;
procedure TSynTextMateSyn.DoCheckAttributeInfo(Sender: TTextMatePattern;
const AnAttribInfo: TSynAttributeInfo; out AnUseId, AnUseObject: Boolean);
begin
AnUseId := AnAttribInfo.TokId >= 0;
AnUseObject := (AnAttribInfo.TokObject <> nil) and
(TSynHighlighterAttributes(AnAttribInfo.TokObject).IsEnabled);
end;
function TSynTextMateSyn.GetParserError: String;
begin
Result := FTextMateGrammar.ParserError;
end;
constructor TSynTextMateSyn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAttriMap := TNameAttributesMap.Create(False);
FTextMateGrammar := TTextMateGrammar.Create;
FTextMateGrammar.OnPopulateAttributeInfo := @DoPopulateAttributeInfo;
FTextMateGrammar.OnCheckAttributeInfo := @DoCheckAttributeInfo;
end;
destructor TSynTextMateSyn.Destroy;
begin
FTextMateGrammar.ClearGrammar;
FTextMateGrammar.Free;
FreeHighlighterAttributes;
FAttriMap.Clear;
FAttriMap.Free;
inherited Destroy;
end;
procedure TSynTextMateSyn.LoadGrammar(AGrammarDef: String);
begin
FTextMateGrammar.ParseGrammar(AGrammarDef);
end;
procedure TSynTextMateSyn.LoadGrammar(AGrammarFile, AGrammarPath: String);
begin
GrammarPath := AGrammarPath;
FTextMateGrammar.ParseGrammar(LoadFile(AGrammarFile));
if FTextMateGrammar.LanguageName = '' then
FTextMateGrammar.LanguageName := AGrammarFile;
end;
procedure TSynTextMateSyn.SetLine(const NewValue: String;
LineNumber: Integer);
var
nd: TSynFoldNodeInfo;
begin
inherited SetLine(NewValue, LineNumber);
if FCurrentRange = -2 then
FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
// TODO setline - keep range?
FTextMateGrammar.SetLine(CurrentLineText, FCurrentRange);
FCurrentRange := -2;
if FTextMateGrammar.IsFoldBegin then begin
if not FTextMateGrammar.IsFoldEnd then begin
inc(FRangeInfo.FoldLevel);
if IsCollectingNodeInfo then begin
nd := Default(TSynFoldNodeInfo);
nd.LineIndex := LineIndex;
nd.FoldGroup := 1;
nd.FoldLvlStart := FRangeInfo.FoldLevel - 1;
nd.FoldLvlEnd := FRangeInfo.FoldLevel;
nd.NestLvlStart := FRangeInfo.FoldLevel - 1;
nd.NestLvlEnd := FRangeInfo.FoldLevel;
nd.FoldAction := [sfaFold, sfaFoldFold, sfaOpen, sfaOpenFold];
CollectingNodeInfoList.Add(nd);
end;
end;
end
else
if FTextMateGrammar.IsFoldEnd and (FRangeInfo.FoldLevel > 0) then begin
dec(FRangeInfo.FoldLevel);
if IsCollectingNodeInfo then begin
nd := Default(TSynFoldNodeInfo);
nd.LineIndex := LineIndex;
nd.FoldGroup := 1;
nd.FoldLvlStart := FRangeInfo.FoldLevel + 1;
nd.FoldLvlEnd := FRangeInfo.FoldLevel;
nd.NestLvlStart := FRangeInfo.FoldLevel + 1;
nd.NestLvlEnd := FRangeInfo.FoldLevel;
nd.FoldAction := [sfaFold, sfaFoldFold, sfaClose, sfaCloseFold];
CollectingNodeInfoList.Add(nd);
end;
end;
if IsScanning then begin
FTextMateGrammar.NextToEol;
end
else begin
FTextMateGrammar.First;
FCurrentTokenKind := FTextMateGrammar.CurrentTokenKind;
FCurrentAttrib := TSynHighlighterAttributes(FTextMateGrammar.CurrentAttrib);
FCurrentTokenPos := FTextMateGrammar.CurrentTokenPos;
FCurrentTokenLen := FTextMateGrammar.CurrentTokenLen;
end;
//FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
end;
procedure TSynTextMateSyn.Next;
begin
FTextMateGrammar.Next;
FCurrentTokenKind := FTextMateGrammar.CurrentTokenKind;
FCurrentAttrib := TSynHighlighterAttributes(FTextMateGrammar.CurrentAttrib);
FCurrentTokenPos := FTextMateGrammar.CurrentTokenPos;
FCurrentTokenLen := FTextMateGrammar.CurrentTokenLen;
//FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
end;
function TSynTextMateSyn.DebugAttrAtXPos(AXPos: Integer): String;
var
st: TTextMatePatternState;
i: Integer;
begin
Result := '';
st := FTextMateGrammar.CurrentState;
SetLength(st.StateList, Length(st.StateList)) ;
while (FCurrentTokenPos + FCurrentTokenLen < AXPos) do begin
if GetEol then begin
result := format('EOL At %d Len %d %s', [FCurrentTokenPos, FCurrentTokenLen, LineEnding]);
exit;
end;
st := FTextMateGrammar.CurrentState;
SetLength(st.StateList, Length(st.StateList)) ;
Next;
end;
result := format('At %d Len %d %s', [FCurrentTokenPos, FCurrentTokenLen, LineEnding]);
for i := st.StateIdx downto 0 do begin
if st.StateList[i].Pattern <> nil then begin
if (st.StateList[i].Pattern is TTextMatePatternBaseNested) and
(st.StateList[i].Pattern.ForwardTarget <> nil)
then
Result := Result + Format('%2d: %4d: %s / %s >// %s %s%s', [
i,
st.StateList[i].Pattern.ForwardTarget.Index,
st.StateList[i].Pattern.ForwardTarget.Name,
st.StateList[i].Pattern.ForwardTarget.Comment,
StripLN(st.StateList[i].Pattern.DebugDump(0,false,'')),
st.StateList[i].Pattern.ForwardTarget.ClassName,
LineEnding
])
else
Result := Result + Format('%2d: %4d: %s / %s // %s%s%s', [
i,
st.StateList[i].Pattern.Index,
st.StateList[i].Pattern.Name,
st.StateList[i].Pattern.Comment,
StripLN(st.StateList[i].Pattern.DebugDump(0,false,'')),
st.StateList[i].Pattern.ClassName,
LineEnding
]);
end
else
Result := Result + '???';
end;
end;
function TSynTextMateSyn.GetEol: Boolean;
begin
Result := FTextMateGrammar.IsAtEol;
end;
function TSynTextMateSyn.GetToken: String;
begin
Result := Copy(CurrentLineText, FCurrentTokenPos, FCurrentTokenLen);
end;
procedure TSynTextMateSyn.GetTokenEx(out TokenStart: PChar; out
TokenLength: integer);
begin
TokenStart := @CurrentLineText[FCurrentTokenPos];
TokenLength := FCurrentTokenLen;
end;
function TSynTextMateSyn.GetTokenPos: Integer;
begin
Result := FCurrentTokenPos - 1;
end;
function TSynTextMateSyn.GetTokenKind: integer;
begin
Result := FCurrentTokenKind;
end;
function TSynTextMateSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
Result := FCurrentAttrib;
end;
function TSynTextMateSyn.GetDefaultAttribute(Index: integer
): TSynHighlighterAttributes;
begin
Result := FAttriMap.Data[FTextMateGrammar.RootPattern.AttribInfo.TokId];
end;
procedure TSynTextMateSyn.SetRange(Value: Pointer);
begin
FCurrentRange := PtrUInt(Value);
FRangeInfo := TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[LineIndex-1];
end;
procedure TSynTextMateSyn.ResetRange;
begin
FCurrentRange := -1;
FRangeInfo := Default(TSynTextMateRangeInfo);
end;
function TSynTextMateSyn.GetRange: Pointer;
begin
FCurrentRange := FTextMateGrammar.CurrentPatternIndex;
Result := Pointer(PtrUInt(FCurrentRange));
end;
function TSynTextMateSyn.FoldBlockEndLevel(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
var
RangeInfo: TSynTextMateRangeInfo;
begin
RangeInfo := TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[ALineIndex];
Result := RangeInfo.FoldLevel;
end;
function TSynTextMateSyn.FoldBlockMinLevel(ALineIndex: TLineIdx;
const AFilter: TSynFoldBlockFilter): integer;
var
RangeInfo: TSynTextMateRangeInfo;
begin
RangeInfo := TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[ALineIndex-1];
Result := RangeInfo.FoldLevel;
RangeInfo := TSynHighlighterTextMateRangeList(CurrentRanges).RangeInfo[ALineIndex];
if Result > RangeInfo.FoldLevel then
Result := RangeInfo.FoldLevel;
end;
end.