synhighlightersml.pas

SynEditStudio delphi 代码编辑器

end;

function TSynSMLSyn.Func92: TtkTokenKind;
begin
  if KeyComp('datatype') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func97: TtkTokenKind;
begin
  if KeyComp('functor') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func101: TtkTokenKind;
begin
  if KeyComp('struct') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func111: TtkTokenKind;
begin
  if KeyComp('exception') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func114: TtkTokenKind;
begin
  if KeyComp('signature') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func126: TtkTokenKind;
begin
  if KeyComp('withtype') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.Func145: TtkTokenKind;
begin
  if KeyComp('structure') then Result := tkKey else Result := tkIdentifier;
end;

function TSynSMLSyn.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TSynSMLSyn.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 146 then Result := fIdentFuncTable[HashKey] else Result := tkIdentifier;
end;

procedure TSynSMLSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      #13: fProcTable[I] := CRProc;
      '#': fProcTable[I] := PoundProc;
      ':': fProcTable[I] := ColonProc;
      'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      '"': fProcTable[I] := StringProc;
      '@', '^': fProcTable[I] := BasisOpProc;
      '(': fProcTable[I] := RoundBracketOpenProc;
      '+', '-', '~', '*', '/', '=', '<', '>':  fProcTable[i] := OperatorProc;
      ',', '.',  ';': fProcTable[I] := SymbolProc;
    else
      fProcTable[I] := UnknownProc;
    end;
end;

constructor TSynSMLSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCharacterAttri := TSynHighlighterAttributes.Create(SYNS_AttrCharacter);
  fCharacterAttri.Foreground := clBlue;
  AddAttribute(fCharacterAttri);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  fCommentAttri.Foreground := clNavy;
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  fKeyAttri.Foreground := clGreen;
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  fNumberAttri.Foreground := clRed;
  AddAttribute(fNumberAttri);
  fOperatorAttri := TSynHighlighterAttributes.Create(SYNS_AttrOperator);
  fOperatorAttri.Foreground := clMaroon;
  AddAttribute(fOperatorAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  fStringAttri.Foreground := clBlue;
  AddAttribute(fStringAttri);
  fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol);
  AddAttribute(fSymbolAttri);
  fSyntaxErrorAttri := TSynHighlighterAttributes.Create(SYNS_AttrSyntaxError);
  fSyntaxErrorAttri.Foreground := clRed;
  fSyntaxErrorAttri.Style := [fsBold];
  AddAttribute(fSyntaxErrorAttri);
  SetAttributesOnChange(DefHighlightChange);
  InitIdent;        
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterSML;
  Basis := True;
end;

procedure TSynSMLSyn.SetLine(NewValue: String; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;

procedure TSynSMLSyn.CRProc;
begin
  fTokenID := tkSpace;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

procedure TSynSMLSyn.ColonProc;
begin
  inc(Run);
  if Basis and (fLine[Run] = ':') then begin
    fTokenID := tkOperator;
    inc(Run);
  end
  else fTokenID := tkSymbol;
end;

procedure TSynSMLSyn.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while fLine[Run] in Identifiers do inc(Run);
end;

procedure TSynSMLSyn.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TSynSMLSyn.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TSynSMLSyn.NumberProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in
      ['0'..'9', '.', 'u', 'U', 'l', 'L', 'x', 'X', 'e', 'E', 'f', 'F'] do
  begin
    case FLine[Run] of
      '.':  if FLine[Run + 1] = '.' then break;
    end;
    inc(Run);
  end;
end;

procedure TSynSMLSyn.OperatorProc;
begin
  inc(Run);
  fTokenID := tkOperator;
end;

procedure TSynSMLSyn.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TSynSMLSyn.StringProc;
begin
  fTokenID := tkString;
  repeat
    if fLine[Run] = '\' then begin
      case fLine[Run + 1] of
        '"', '\':
          Inc(Run);
        #00:
          begin
            Inc(Run);
            fRange := rsMultilineString;
            Exit;
          end;
      end;
    end;
    inc(Run);
  until fLine[Run] in [#0, #10, #13, '"'];
  if FLine[Run] = '"' then
    inc(Run);
end;

procedure TSynSMLSyn.StringEndProc;
begin
  fTokenID := tkString;

  case FLine[Run] of
    #0:
      begin
        NullProc;
        Exit;
      end;
    #10:
      begin
        LFProc;
        Exit;
      end;
    #13:
      begin
        CRProc;
        Exit;
      end;
  end;

  fRange := rsUnknown;

  repeat
    case FLine[Run] of
      #0, #10, #13: Break;
      '\':
        begin
          case fLine[Run + 1] of
            '"', '\':
              Inc(Run);
            #00:
              begin
                Inc(Run);
                fRange := rsMultilineString;
                Exit;
              end;
          end;
        end;
      '"': Break;
    end;
    inc(Run);
  until fLine[Run] in [#0, #10, #13, '"'];
  if FLine[Run] = '"' then
    inc(Run);
end;

procedure TSynSMLSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynSMLSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
  if FLine[Run] in LeadBytes then
    Inc(Run, 2)
  else
{$ENDIF}
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TSynSMLSyn.BasisOpProc;
begin
  inc(Run);
  if Basis then fTokenID := tkOperator else fTokenID := tkIdentifier;
end;

procedure TSynSMLSyn.PoundProc;
begin
  Inc(Run);
  if (fLine[Run] = '"') then
    CharacterProc
  else
    fTokenID := tkIdentifier;
end;

procedure TSynSMLSyn.CharacterProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    begin
      repeat
        Inc(Run);
      until fLine[Run] in [#0, #10, #13, '"'];

      if IsValidMLCharacter then
        fTokenID := tkCharacter
      else
      begin
        if fLine[Run] = '"' then Inc(Run);
        fTokenID := tkSyntaxError;
      end;
    end
  end
end;

procedure TSynSMLSyn.RoundBracketOpenProc;
begin
  Inc(Run);
  if (fLine[Run] = '*') then
  begin
    fRange := rsComment;
    CommentProc;
    fTokenID := tkComment;
  end
  else
    fTokenID := tkIdentifier;
end;

procedure TSynSMLSyn.CommentProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    begin
      fTokenID := tkComment;
      repeat
        if (fLine[Run] = '*') and
           (fLine[Run + 1] = ')') then
        begin
          Inc(Run, 2);
          fRange := rsUnknown;
          Break;
        end;
        if not (fLine[Run] in [#0, #10, #13]) then
          Inc(Run);
      until fLine[Run] in [#0, #10, #13];
    end;
  end;
end;

procedure TSynSMLSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsComment: CommentProc;
    rsMultilineString: StringEndProc; 
  else
    begin
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
    end;
  end;
end;

function TSynSMLSyn.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 TSynSMLSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TSynSMLSyn.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TSynSMLSyn.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TSynSMLSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case GetTokenID of
    tkCharacter: Result := fCharacterAttri;
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkOperator: Result := fOperatorAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkSyntaxError: Result := fSyntaxErrorAttri;
    tkUnknown: Result := fIdentifierAttri;
    else Result := nil;
  end;
end;

function TSynSMLSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TSynSMLSyn.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

function TSynSMLSyn.GetIdentChars: TSynIdentChars;
begin
  Result := TSynValidStringChars;
end;

function TSynSMLSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterSML;
end;

class function TSynSMLSyn.GetLanguageName: string;
begin
  Result := SYNS_LangSML;
end;

function TSynSMLSyn.GetSampleSource: string;
begin
  Result := '(* Syntax highlighting *)'#13#10 +
            'load "Real";'#13#10 +
            'fun PrintNumber(x: int) ='#13#10 +
            '  let'#13#10 +
            '    val Number = real(x) / 10.0;'#13#10 +
            '    val Text = "The Number is " ^ Real.toString(~Number) ^ "\n";'#13#10 +
            '  in'#13#10 +
            '    print Text;'#13#10 +
            '    if x = 0 then () else PrintNumber(x-1)'#13#10+
            '  end;' 
end;

procedure TSynSMLSyn.ResetRange;
begin
  fRange := rsUnknown;
end;

procedure TSynSMLSyn.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

function TSynSMLSyn.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

initialization
  MakeIdentTable;
{$IFNDEF SYN_CPPB_1}
  RegisterPlaceableHighlighter(TSynSMLSyn);
{$ENDIF}
end.