jvunicodehleditor.pas

East make Tray Icon in delphi

  function PosI(const S1, S2: WideString): Boolean;
  var
    F, P: PWideChar;
    Len: Integer;
  begin
    Len := Length(S1);
    Result := True;
    P := PWideChar(S2);
    while P[0] <> #0 do
    begin
      while P[0] = ' ' do
        Inc(P);
      F := P;
      while not (P[0] <= #32) do
        Inc(P);
      if (P - F) = Len then
        if StrLICompW2(PWideChar(S1), F, Len) = 0 then
          Exit;
    end;
    Result := False;
  end;

  function PosNI(const S1, S2: WideString): Boolean;
  var
    F, P: PWideChar;
    Len: Integer;
  begin
    Len := Length(S1);
    Result := True;
    P := PWideChar(S2);
    while P[0] <> #0 do
    begin
      while P[0] = ' ' do
        Inc(P);
      F := P;
      while not (P[0] <= #32) do
        Inc(P);
      if (P - F) = Len then
        if StrLCompW(PWideChar(S1), F, Len) = 0 then
          Exit;
    end;
    Result := False;
  end;

  function IsDelphiKeyWord(const St: WideString): Boolean;
  begin
    Result := PosI(St, DelphiKeyWords);
  end;

  function IsBuilderKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, BuilderKeyWords);
  end;

  function IsNQCKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, NQCKeyWords);
  end;

  function IsJavaKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, JavaKeyWords);
  end;

  function IsVBKeyWord(const St: WideString): Boolean;
  begin
    Result := PosI(St, VBKeyWords);
  end;

  function IsVBStatement(const St: WideString): Boolean;
  begin
    Result := PosI(St, VBStatements);
  end;

  function IsSQLKeyWord(const St: WideString): Boolean;
  begin
    Result := PosI(St, SQLKeyWords);
  end;

  function IsPythonKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, PythonKeyWords);
  end;

  function IsHtmlTag(const St: WideString): Boolean;
  begin
    Result := PosI(St, HTMLTags);
  end;

  function IsHtmlSpecChar(const St: WideString): Boolean;
  begin
    Result := PosI(St, HTMLSpecChars);
  end;

  function IsPerlKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, PerlKeyWords);
  end;

  function IsPerlStatement(const St: WideString): Boolean;
  begin
    Result := PosNI(St, PerlStatements);
  end;

  function IsCocoKeyWord(const St: WideString): Boolean;
  begin
    Result := PosI(St, CocoKeyWords);
  end;

  function IsPhpKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, PerlKeyWords);
  end;

  function IsCSharpKeyWord(const St: WideString): Boolean;
  begin
    Result := PosNI(St, CSharpKeyWords);
  end;

  function IsComment(const St: WideString): Boolean;
  var
    LS: Integer;
  begin
    LS := Length(St);
    case Highlighter of
      hlPascal:
        Result := ((LS > 0) and (St[1] = '{')) or
          ((LS > 1) and (((St[1] = '(') and (St[2] = '*')) or
          ((St[1] = '/') and (St[2] = '/'))));
      hlCBuilder, hlSql, hlJava, hlPhp, hlNQC:
        Result := (LS > 1) and (St[1] = '/') and
          ((St[2] = '*') or (St[2] = '/'));
      hlVB:
        Result := (LS > 0) and (St[1] = '''');
      hlPython, hlPerl:
        Result := (LS > 0) and (St[1] = '#');
      hlIni:
        Result := (LS > 0) and ((St[1] = '#') or (St[1] = ';'));
      hlCocoR:
        Result := (LS > 1) and (((St[1] = '/') and (St[2] = '/')) or
          ((St[1] = '(') and (St[2] = '*')) or
          ((St[1] = '/') and (St[2] = '*'))
          );
    else
      Result := False;
    end;
  end;

  function IsPreproc(const St: WideString): Boolean;
  var
    LS: Integer;
  begin
    LS := Length(St);
    case Highlighter of
      hlPascal:
        Result := ((LS > 0) and ((St[1] = '{') and (St[2] = '$'))) or
          ((LS > 1) and (((St[1] = '(') and (St[2] = '*') and (St[3] = '$'))));
      {hlCBuilder, hlSql, hlJava, hlPhp, hlNQC:
      hlVB:
      hlPython, hlPerl:
      hlIni:
      hlCocoR:}
    else
      Result := False;
    end;
  end;

  function IsStringConstant(const St: WideString): Boolean;
  var
    LS: Integer;
  begin
    LS := Length(St);
    case FHighlighter of
      hlPascal, hlCBuilder, hlSql, hlPython, hlJava, hlPerl, hlCocoR, hlPhp, hlNQC:
        Result := (LS > 0) and ((St[1] = '''') or (St[1] = '"'));
      hlVB:
        Result := (LS > 0) and (St[1] = '"');
      hlHtml:
        Result := False;
    else
      Result := False; { unknown Highlighter ? }
    end;
  end;

  procedure SetBlockColor(iBeg, iEnd: Integer; Color: TJvSymbolColor);
  var
    I: Integer;
  begin
    if iEnd > Max_X then
      iEnd := Max_X;
    for I := iBeg to iEnd do
      with LineAttrs[I] do
      begin
        FC := Color.ForeColor;
        BC := Color.BackColor;
        Style := Color.Style;
        Border := clNone;
      end;
  end;

  procedure SetColor(Color: TJvSymbolColor);
  begin
    SetBlockColor(Parser.PosBeg[0] + 1, Parser.PosEnd[0], Color);
  end;

  function NextSymbol: WideString;
  var
    I: Integer;
  begin
    I := 0;
    while (Parser.pcPos[I] <> #0) and CharInSetW(Parser.pcPos[I], [' ', Tab, Lf, Cr]) do
      Inc(I);
    Result := Parser.pcPos[I];
  end;

  procedure TestHtmlSpecChars(const Token: WideString);
  var
    I, J, iBeg, iEnd: Integer;
    S1: WideString;
    F1: Integer;
  begin
    I := 1;
    F1 := Parser.PosBeg[0];
    while I <= Length(Token) do
    begin
      if Token[I] = '&' then
      begin
        iBeg := I;
        iEnd := iBeg;
        Inc(I);
        while I <= Length(Token) do
        begin
          if Token[I] = ';' then
          begin
            iEnd := I;
            Break;
          end;
          Inc(I);
        end;
        if iEnd > iBeg + 1 then
        begin
          S1 := Copy(Token, iBeg + 1, iEnd - iBeg - 1);
          if IsHtmlSpecChar(S1) then
            for J := iBeg to iEnd do
              with LineAttrs[F1 + J] do
              begin
                FC := Colors.Preproc.ForeColor;
                BC := Colors.Preproc.BackColor;
                Style := Colors.Preproc.Style;
                Border := clNone;
              end;
        end;
      end;
      Inc(I);
    end;
  end;

  procedure SetIniColors(const S: WideString);
  var
    EquPos: Integer;
    LS: Integer;
  begin
    LS := Length(S);
    if (LS > 0) and (S[1] = '[') and (S[LS] = ']') then
      SetBlockColor(0, LS, Colors.Declaration)
    else
    begin
      EquPos := Pos('=', S);
      if EquPos > 0 then
      begin
        SetBlockColor(0, EquPos, Colors.Identifier);
        SetBlockColor(EquPos, EquPos, Colors.Symbol);
        SetBlockColor(EquPos + 1, LS, Colors.Strings);
      end;
    end;
  end;

  // for Coco/R

  procedure HighlightGrammarName(S: WideString);
  var
    P: Integer;
  begin
    P := Pos('-->Grammar<--', S);
    if P > 0 then
      SetBlockColor(P, P + Length('-->Grammar<--') - 1, Colors.Preproc);
  end;

// (rom) const, var, local function sequence not cleaned up yet
var
  F: Boolean;
  C: TJvSymbolColor;
  Reserved: Boolean;
  PrevToken: WideString;
  PrevToken2: WideString;
  NextToken: WideString;
  Ch: WideChar;
  InTag: Boolean;
  N: Integer;

var
  S: WideString;
  LS: Integer;
  Token: WideString;
  I: Integer;

begin
  if not FSyntaxHighlighting then
    Exit;
  S := Lines[Line];
  if (FHighlighter = hlNone) and not UserReservedWords then
    C := Colors.PlainText
  else
  begin
    FLine := S;
    FLineNum := Line;
    CheckInLong;

    if (FHighlighter = hlSyntaxHighlighter) and (FSyntaxHighlighter <> nil) then
    begin
     // user defined syntax highlighting
      FSyntaxHighlighter.GetAttr(Self, Lines, Line, ColBeg, ColEnd, FLong, LineAttrs);
      Exit;
    end;

    Parser.pcProgram := PWideChar(S);
    Parser.pcPos := Parser.pcProgram;

    LS := Length(S);
    Ch := GetTrimChar(S, 1);
    if (Highlighter in [hlCBuilder, hlNQC]) and (LS > 0) and
      (((Ch = '#') and (FLong = 0)) or (FLong = lgPreproc)) then
      C := Colors.Preproc
    else
    if ((FHighlighter in [hlPython, hlPerl]) and (LS > 0) and
      (Ch = '#') and (FLong = 0)) or
      ((Highlighter = hlIni) and (LS > 0) and ((Ch = '#') or (Ch = ';'))) then
      C := Colors.Comment
    else
      C := Colors.PlainText;
    if (FLong <> 0) and (FHighlighter <> hlHtml) then
    begin
      Parser.pcPos := Parser.pcProgram + FindLongEnd + 1;
      case Highlighter of
        hlCBuilder, hlPython, hlPerl, hlNQC, hlCSharp:
          case FLong of
            lgString:
              C := Colors.Strings;
            lgComment1, lgComment2:
              C := Colors.Comment;
            lgPreproc:
              C := Colors.Preproc;
          end;
        hlPascal:
          case FLong of
            lgComment1, lgComment2:
              C := Colors.Comment;
            lgPreproc1, lgPreproc2:
              C := Colors.Preproc;
          end;
      else
        C := Colors.Comment;
      end;
    end;
  end;

  LineAttrs[1].FC := C.ForeColor;
  LineAttrs[1].Style := C.Style;
  LineAttrs[1].BC := C.BackColor;
  LineAttrs[1].Border := clNone;
  N := Min(Max_X, Length(S));
  for I := 2 to N do
    Move(LineAttrs[1], LineAttrs[I], SizeOf(LineAttrs[1]));
  if Length(S) < Max_X then
  begin
    LineAttrs[N + 1].FC := Font.Color;
    LineAttrs[N + 1].Style := Font.Style;
    LineAttrs[N + 1].BC := Color;
    LineAttrs[N + 1].Border := clNone;
    for I := N + 1 + 1 to Max_X do
      Move(LineAttrs[N + 1], LineAttrs[I], SizeOf(LineAttrs[1]));
  end;

  if (FHighlighter = hlNone) and not UserReservedWords then
    Exit;
  if (Length(S) > 0) then
  begin
    Ch := GetTrimChar(S, 1);
    if ((Ch = '#') and (FHighlighter in [hlCBuilder, hlPython, hlPerl, hlNQC])) or
       (((Ch = '#') or (Ch = ';')) and (FHighlighter = hlIni)) then
      Exit;
  end;

  if FHighlighter = hlIni then
    SetIniColors(S)
  else
  try
    InTag := FLong = lgTag;
    PrevToken := '';
    PrevToken2 := '';
    Token := Parser.Token;
    while Token <> '' do
    begin
      F := True;
      if GetReservedWord(Token, Reserved) then
      begin
        if Reserved then
          SetColor(Colors.Reserved)
        else
          F := False;
      end
      else
        case FHighlighter of
          hlPascal:
            if IsDelphiKeyWord(Token) then
              SetColor(Colors.Reserved)
            else
              F := False;
          hlCBuilder:
            if IsBuilderKeyWord(Token) then
              SetColor(Colors.Reserved)
            else
              F := False;
          hlNQC:
            if IsNQCKeyWord(Token) then
              SetColor(Colors.Reserved)
            else
              F := False;
          hlSql:
            if IsSQLKeyWord(Token) then
              SetColor(Colors.Reserved)
            else
              F := False;
          hlPython:
            if IsPythonKeyWord(Token) then
              SetColor(Colors.Reserved)
            else
            if Token = 'None' then
              SetColor(Colors.Number)
            else
            if (PrevToken = 'def') or (PrevToken = 'class') then
              SetColor(Colors.Declaration)
            else
            if (NextSymbol = '(') and IsIdentifierW(Token) then
              SetColor(Colors.FunctionCall)
            else
              F := False;
          hlJava:
            if IsJavaKeyWord(Token) then