jvhleditor.pas

East make Tray Icon in delphi

    ' th thead title tr tt u ul var wbr xmp ';

  HTMLSpecChars =
    ' Aacute aacute acirc Acirc acute AElig aelig agrave Agrave alefsym ' +
    ' alpha Alpha AMP amp and ang Aring aring asymp atilde Atilde Auml ' +
    ' auml bdquo beta Beta brvbar bull cap Ccedil ccedil cedil cent chi ' +
    ' Chi circ clubs cong copy COPY crarr cup curren dagger Dagger dArr ' +
    ' darr deg Delta delta diams divide eacute Eacute ecirc Ecirc Egrave ' +
    ' egrave empty emsp ensp Epsilon epsilon equiv eta Eta ETH eth Euml ' +
    ' euml euro exist fnof forall frac12 frac14 frac34 frasl Gamma gamma ' +
    ' ge gt GT harr hArr hearts hellip iacute Iacute Icirc icirc iexcl Igrave ' +
    ' igrave image infin int Iota iota iquest isin Iuml iuml kappa Kappa Lambda ' +
    ' lambda lang laquo larr lArr lceil ldquo le lfloor lowast loz lrm lsaquo ' +
    ' lsquo lt LT macr mdash micro middot minus mu Mu nabla nbsp ndash ne ' +
    ' ni not notin nsub Ntilde ntilde Nu nu oacute Oacute ocirc Ocirc oelig ' +
    ' OElig ograve Ograve oline Omega omega omicron Omicron oplus or ordf ' +
    ' ordm Oslash oslash Otilde otilde otimes ouml Ouml para part permil ' +
    ' perp phi Phi Pi pi piv plusmn pound Prime prime prod prop psi Psi quot ' +
    ' QUOT radic rang raquo rArr rarr rceil rdquo real REG reg rfloor Rho ' +
    ' rho rlm rsaquo rsquo sbquo scaron Scaron sdot sect shy Sigma sigma ' +
    ' sigmaf sim spades sub sube sum sup sup1 sup2 sup3 supe szlig Tau ' +
    ' tau there4 Theta theta thetasym thinsp THORN thorn tilde times trade ' +
    ' Uacute uacute uArr uarr ucirc Ucirc ugrave Ugrave uml upsih upsilon ' +
    ' Upsilon uuml Uuml weierp xi Xi Yacute yacute yen yuml Yuml zeta Zeta ' +
    ' zwj zwnj ';

  PerlKeyWords =
    ' sub if else unless foreach next local ' +
    ' return defined until while do elsif eq ';

  PerlStatements =
    ' stat die open print push close defined chdir last read chop ' +
    ' keys sort bind unlink select length ';

  CocoKeyWords = DelphiKeyWords +
    ' compiler productions delphi end_delphi ignore case characters ' +
    ' tokens create destroy errors comments from nested chr any ' +
    ' description ';

  CSharpKeyWords =
    ' abstract as base bool break byte case catch char checked class ' +
    ' const continue decimal default delegate do double else enum event ' +
    ' explicit extern false finally fixed float for foreach goto if ' +
    ' implicit in int interface internal is lock long namespace new null ' +
    ' object operator out override params private protected public readonly ' +
    ' ref return sbyte sealed short sizeof stackalloc static string struct ' +
    ' switch this throw true try typeof uint ulong unchecked unsafe ushort ' +
    ' using virtual void volatile while ';

  function PosI(const S1, S2: string): Boolean;
  var
    F, P: PChar;
    Len: Integer;
  begin
    Len := Length(S1);
    Result := True;
    P := PChar(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 StrLIComp(PChar(S1), F, Len) = 0 then
          Exit;
    end;
    Result := False;
  end;

  function PosNI(const S1, S2: string): Boolean;
  var
    F, P: PChar;
    Len: Integer;
  begin
    Len := Length(S1);
    Result := True;
    P := PChar(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 StrLComp(PChar(S1), F, Len) = 0 then
          Exit;
    end;
    Result := False;
  end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  function IsComment(const St: string): 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, hlCSharp:
        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: string): 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: string): Boolean;
  var
    LS: Integer;
  begin
    LS := Length(St);
    case FHighlighter of
      hlPascal, hlCBuilder, hlSql, hlPython, hlJava, hlPerl, hlCocoR, hlPhp,
        hlNQC, hlCSharp:
        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: string;
  var
    I: Integer;
  begin
    I := 0;
    while (Parser.pcPos[I] <> #0) and (Parser.pcPos[I] in [' ', Tab, Cr, Lf]) do
      Inc(I);
    Result := Parser.pcPos[I];
  end;

  procedure TestHtmlSpecChars(const Token: string);
  var
    I, J, iBeg, iEnd: Integer;
    S1: string;
    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: string);
  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(const S: string);
  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: string;
  PrevToken2: string;
  NextToken: string;
  Ch: Char;
  InTag: Boolean;
  N: Integer;

var
  S: string;
  LS: Integer;
  Token: string;
  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 := PChar(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