jvhleditor.pas

数据表对拷程序。 做这个程序的本意是

  S := Lines[Line];
  if (FHighLighter = hlNone) and not UserReservedWords then
    C := Colors.PlainText
  else
  begin
    FLine := S;
    FLineNum := Line;
    Parser.pcProgram := PChar(S);
    Parser.pcPos := Parser.pcProgram;
    CheckInLong;
    LS := Length(S);
    if (FHighLighter in [hlCBuilder, hlNQC]) and (LS > 0) and
      (((GetTrimChar(S, 1) = '#') and (FLong = 0)) or (FLong = lgPreproc)) then
      C := FColors.FPreproc
    else
    if ((FHighLighter in [hlPython, hlPerl]) and (LS > 0) and
      (S[1] = '#') and (FLong = 0)) or
      ((FHighLighter = hlIni) and (LS > 0) and (S[1] in ['#', ';'])) then
      C := FColors.FComment
    else
      C := FColors.FPlainText;
    if (FLong <> 0) and (FHighLighter <> hlHtml) then
    begin
      Parser.pcPos := Parser.pcProgram + FindLongEnd + 1;
      if (FHighLighter in [hlCBuilder, hlPython, hlPerl, hlNQC]) then
        case FLong of
          lgString:
            C := FColors.FString;
          lgComment1, lgComment2:
            C := FColors.FComment;
          lgPreproc:
            C := FColors.Preproc;
        end
      else
        C := FColors.FComment;
    end;
  end;

  LineAttrs[1].FC := C.ForeColor;
  LineAttrs[1].Style := C.Style;
  LineAttrs[1].BC := C.BackColor;
  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;
    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) and (((GetTrimChar(S, 1) = '#') and
    (FHighLighter in [hlCBuilder, hlPython, hlPerl, hlNQC])) or
    ((GetTrimChar(S, 1) in ['#', ';']) and (FHighLighter = hlIni))) then
    Exit;

  if FHighLighter = hlIni then
    SetIniColors
  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(FColors.FReserved)
        else
          F := False;
      end
      else
        case FHighLighter of
          hlPascal:
            if IsDelphiKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
              F := False;
          hlCBuilder:
            if IsBuilderKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
              F := False;
          hlNQC:
            if IsNQCKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
              F := False;
          hlSql:
            if IsSQLKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
              F := False;
          hlPython:
            if IsPythonKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
            if Token = 'None' then
              SetColor(FColors.FNumber)
            else
            if (PrevToken = 'def') or (PrevToken = 'class') then
              SetColor(FColors.FDeclaration)
            else
            if (NextSymbol = '(') and IsIdentifier(Token) then
              SetColor(FColors.FFunctionCall)
            else
              F := False;
          hlJava:
            if IsJavaKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
            if PrevToken = 'function' then
              SetColor(FColors.FDeclaration)
            else
              F := False;
          hlVB:
            if IsVBKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
            if IsVBStatement(Token) then
              SetColor(FColors.FStatement)
            else
            if Cmp(PrevToken, 'function') or Cmp(PrevToken, 'sub') or
              Cmp(PrevToken, 'class') then
              SetColor(FColors.FDeclaration)
            else
              F := False;
          hlHtml:
            if not InTag then
            begin
              if Token = '<' then
              begin
                InTag := True;
                SetColor(FColors.FReserved)
              end;
              F := True;
            end
            else
            begin
              if Token = '>' then
              begin
                InTag := False;
                SetColor(FColors.FReserved)
              end
              else
              if (Token = '/') and (PrevToken = '<') then
                SetColor(FColors.FReserved)
              else
              if (NextSymbol = '=') and IsIdentifier(Token) then
                SetColor(FColors.FIdentifier)
              else
              if PrevToken = '=' then
                SetColor(FColors.FString)
              else
              if IsHtmlTag(Token) then
                SetColor(FColors.FReserved)
              else
              if (PrevToken = '<') or ((PrevToken = '/') and (PrevToken2 = '<')) then
                SetColor(FColors.FStatement)
              else
                F := False;
            end;
          hlPerl:
            if IsPerlKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
            if IsPerlStatement(Token) then
              SetColor(FColors.FStatement)
            else
            if Token[1] in ['$', '@', '%', '&'] then
              SetColor(FColors.FFunctionCall)
            else
              F := False;
          hlCocoR:
            if IsCocoKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
            if (Parser.PosBeg[0] = 0) and (Line > ProductionsLine) and
              IsIdentifier(Token) then
            begin
              NextToken := Parser.Token;
              Parser.RollBack(1);
              SetColor(FColors.FDeclaration)
            end
            else
              F := False;
          hlPhp:
            if IsPhpKeyWord(Token) then
              SetColor(FColors.FReserved)
            else
              F := False;
        else
          F := False;
        end;
      if F then
        {Ok}
      else
      if IsComment(Token) then
        SetColor(FColors.FComment)
      else
      if IsStringConstant(Token) then
        SetColor(FColors.FString)
      else
      if (Length(Token) = 1) and (Token[1] in Symbols) then
        SetColor(FColors.FSymbol)
      else
      if IsIntConstant(Token) or IsRealConstant(Token) then
        SetColor(FColors.FNumber)
      else
      if (FHighLighter in [hlCBuilder, hlJava, hlPython, hlPhp, hlNQC]) and
        (PrevToken = '0') and (Token[1] in ['x', 'X']) then
        SetColor(FColors.FNumber)
      else
      if FHighLighter = hlHtml then
        SetColor(FColors.FPlainText)
      else
        SetColor(FColors.FIdentifier);
      if FHighLighter = hlHtml then
        { found special chars starting with '&' and ending with ';' }
        TestHtmlSpecChars;
      PrevToken2 := PrevToken;
      PrevToken := Token;
      Token := Parser.Token;
    end;

    if Highlighter = hlCocoR then
      HighlightGrammarName;
  except
  end;
end;

procedure TJvHLEditor.CheckInLong;
begin
  if not FLongTokens then
  begin
    FLong := lgNone;
    Exit;
  end;
  if FLineNum < Length(FLongDesc) then
  begin
    FLong := FLongDesc[FLineNum];
    if FLong = lgUndefined then
    begin
      RescanLong(FLineNum); // scan the line
      FLong := FLongDesc[FLineNum];
    end;
  end
  else
    { oh my god!, it's very big text }
    FLong := lgNone;
end;

function TJvHLEditor.RescanLong(iLine: Integer): Boolean;
const
  MaxScanLinesAtOnce = 5000;
var
  P, F: PChar;
  MaxLine, MaxScanLine: Integer;
  S: string;
  i, i1, L1: Integer;
begin
  FLong := lgNone;
  Result := False; // no Invalidate

  if (not FSyntaxHighlighting) or
     (not FLongTokens or (FHighLighter in [hlNone, hlIni])) or
     (Lines.Count = 0) then
    Exit;

  ProductionsLine := High(Integer);
  MaxLine := Lines.Count - 1;
  if MaxLine > High(FLongDesc) then
    MaxLine := High(FLongDesc);
  if iLine > MaxLine then Exit;;

  MaxScanLine := MaxLine;
  FLong := lgNone;
  if iLine < 0 then
  begin
    FillChar(FLongDesc[0], SizeOf(FLongDesc[0]) * (1 + MaxLine), lgUndefined);
    FLongDesc[0] := lgNone;
    iLine := 0;
  end
  else
  begin
    FLong := FLongDesc[iLine];
    if FLong = lgUndefined then
    begin
      if (iLine > 0) and (FLongDesc[iLine - 1] = lgUndefined) then
      begin
        iLine := 0; // scan all
        FLong := lgNone;
      end
      else
      begin
        Dec(iLine);
        FLong := FLongDesc[iLine];
        MaxScanLine := Min(iLine + MaxScanLinesAtOnce, MaxLine);
      end;
    end
    else
      MaxScanLine := Min(iLine + MaxScanLinesAtOnce, MaxLine);
  end;

  while iLine < MaxScanLine do
  begin
    { only real programmer can write loop on 5 pages }
    // (rom) real programmers do not add comments to end ;-)
    S := Lines[iLine];
    P := Pointer(S);
    F := P;
    L1 := Length(S);
    if (L1 = 0) and (FLong in [lgPreproc, lgString]) then FLong := lgNone;
    i := 1;
    while i <= L1 do
    begin
      case FHighLighter of
        hlPascal:
          case FLong of
            lgNone: //  not in comment
              case S[i] of
                '{':
                  begin
                    P := StrScan(F + i, '}');
                    if P = nil then
                    begin
                      FLong := lgComment1;
                      Break;
                    end
                    else
                      i := P - F + 1;
                  end;
                '(':
                  if {S[i + 1]} F[i] = '*' then
                  begin
                    FLong := lgComment2;
                    P := StrScan(F + i + 2, ')');
                    if P = nil then
                      Break
                    else
                    begin
                      if P[-1] = '*' then
                        FLong := lgNone;
                      i := P - F + 1;
                    end;
                  end;
                '''':
                  begin
                    P := StrScan(F + i + 1, '''');
                    if P <> nil then
                    begin
                      i1 := P - F;
                      if P[1] <> '''' then
                        i := i1
                      else
                        { ?? }
                    end
                    else
                      i := L1 + 1;
                  end;
              end;
            lgComment1:
              begin //  {
                P := StrScan(F + i - 1, '}');
                if P <> nil then
                begin
                  FLong := lgNone;
                  i := P - F + 1;
                end
                else
                  i := L1 + 1;
              end;
            lgComment2:
              begin //  (*
                P := StrScan(F + i, ')');
                if P = nil then
                  Break
                else
                begin
                  if P[-1] = '*' then
                    FLong := lgNone;
                  i := P - F + 1;
                end;
              end;
          end;
        hlCBuilder, hlSql, hlJava, hlPhp, hlNQC:
          case FLong of
            lgNone: //  not in comment
              case S[i] of
                '/':
                  if {S[i + 1]} F[i] = '*' then
                  begin
                    FLong := lgComment2;
                    P := StrScan(F + i + 2, '/');
                    if P = nil then
                      Break
                    else
                    begin
                      if P[-1] = '*' then
                        FLong := lgNone;
                      i := P - F + 1;
                    end;
                  end;
                '"':
                  begin
                    P := StrScan(F + i + 1, '"');
                    if P <> nil then
                    begin
                      i1 := P - F;
                      if P[1] <> '"' then
                        i := i1
                      else
                        { ?? }
                    end
                    else
                    if FHighlighter in [hlCBuilder, hlJava, hlNQC] then
                    begin
                      if (LastNoSpaceChar(S) = '\') and (HasStringOpenEnd(Lines, iLine)) then
                        FLong := lgString;
                      i := L1 + 1;
                    end
                    else
                      i := L1 + 1;
                  end;
                '#':
                  begin
                    if (GetTrimChar(S, 1) = '#') and (LastNoSpaceChar(S) = '\') then
                    begin
                      FLong := lgPreproc;
                      Break;
                    end;
                  end;
              end;