wmsqlsyn.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 1,397 行 · 第 1/3 页

begin
  case FLine[Run + 1] of
    '-' :
      begin
        inc(Run, 2);
        fTokenID := wmComment;
        while FLine[Run] <> #0 do
          begin
            case FLine[Run] of
              #10, #13 : break;
            end;
            inc(Run);
          end;
      end;
    else
      begin
        inc(Run);
        fTokenID := wmSymbol;
      end;
  end;
end;

procedure TwmSQLSyn.NullProc;
begin
  fTokenID := wmNull;
  fEol := True;
end;

procedure TwmSQLSyn.NumberProc;
begin
  if FLine[Run] = '.' then
  begin
    case FLine[Run + 1] of
      '.':
        begin
          inc(Run, 2);
          if FLine[Run] = '.' then     {sed range}
            inc(Run);

          fTokenID := wmSymbol;        {range}
        end;
      '=':
        begin
          inc(Run, 2);
          fTokenID := wmSymbol;        {concatenation assign}
        end;
      'a'..'z', 'A'..'Z', '_':
        begin
          fTokenID := wmSymbol;        {concatenation}
          inc(Run);
        end;
    end;
  end;
  inc(Run);
  fTokenID := wmNumber;
  while FLine[Run] in
      ['0'..'9', '-', '_', '.', 'A'..'F', 'a'..'f', 'x', 'X'] do
  begin
    case FLine[Run] of
      '.':
        if FLine[Run + 1] = '.' then break;
      '-':                             {check for e notation}
        if not ((FLine[Run + 1] = 'e') or (FLine[Run + 1] = 'E')) then break;
    end;
    inc(Run);
  end;
end;

procedure TwmSQLSyn.OrSymbolProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
end;

procedure TwmSQLSyn.PlusProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
end;

procedure TwmSQLSyn.QuestionProc;
begin
  fTokenID := wmSymbol;                {conditional op}
  inc(Run);
end;

procedure TwmSQLSyn.RoundCloseProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
  dec(FRoundCount);
end;

procedure TwmSQLSyn.RoundOpenProc;
begin
  inc(Run);
  FTokenID := wmSymbol;
  inc(FRoundCount);
end;

procedure TwmSQLSyn.SemiColonProc;
begin
  inc(Run);
  fTokenID := wmSymbol;                {semicolon}
end;

procedure TwmSQLSyn.SlashProc;
begin
  case FLine[Run + 1] of
    '/':                               {c++ style comments}
      begin
        inc(Run, 2);
        fTokenID := wmComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
    '*':                               {c style comments}
      begin
        fTokenID := wmComment;
        fRange := rsAnsiC;
        inc(Run);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = '/' then
              begin
                inc(Run, 2);
                fRange := rsUnKnown;
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
  else                                 {division}
    begin
      inc(Run);
      fTokenID := wmSymbol;
    end;
  end;
end;

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

procedure TwmSQLSyn.SquareCloseProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
  dec(FSquareCount);
end;

procedure TwmSQLSyn.SquareOpenProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
  inc(FSquareCount);
end;

procedure TwmSQLSyn.StarProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
end;

procedure TwmSQLSyn.StringInterpProc;
begin
  fTokenID := wmString;
  if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:
        { backslash quote not the ending one }
        if FLine[Run + 1] = #34 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = #34;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TwmSQLSyn.StringLiteralProc;
begin
  fTokenID := wmString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #39;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TwmSQLSyn.XOrSymbolProc;
begin
  inc(Run);
  fTokenID := wmSymbol;
end;

procedure TwmSQLSyn.UnknownProc;
begin
  inc(Run);
end;

procedure TwmSQLSyn.AnsiCProc;
begin
  fTokenID := wmComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '*':
        if fLine[Run + 1] = '/' then
        begin
          inc(Run, 2);
          fRange := rsUnKnown;
          break;
        end
        else inc(Run);
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TwmSQLSyn.Next;
begin
  fTokenPos := Run;
  Case fRange of
    rsAnsiC: AnsiCProc;
    else
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
  end;
end;

function TwmSQLSyn.GetEol: Boolean;
begin
  Result := fTokenId = wmNull;                                
end;

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

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

function TwmSQLSyn.GetTokenID: TwmTokenKind;
begin
  Result := fTokenId;
end;

function TwmSQLSyn.GetTokenAttribute: TmwHighLightAttributes;
begin
  case fTokenID of
    wmComment: Result := fCommentAttri;
    wmIdentifier: Result := fIdentifierAttri;
    wmKey: Result := fKeyAttri;
    wmNumber: Result := fNumberAttri;
    wmSymbol: Result := fSymbolAttri;
    wmString: Result := fStringAttri;
    wmUnknown: Result := fSymbolAttri;
    else Result := nil;
  end;
end;

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

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

procedure TwmSQLSyn.ReSetRange;
begin
  fRange:= rsUnknown;
end;

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

function TwmSQLSyn.GetLanguageName: string;
begin
  Result := MWS_LangSQL;
end;

function TwmSQLSyn.UseUserSettings(settingIndex: integer): boolean;
// Possible parameter values:
//   index into TStrings returned by EnumUserSettings
// Possible return values:
//   true : settings were read and used
//   false: problem reading settings or invalid version specified - old settings
//          were preserved

  function ReadSQLSettings(settingIndex: integer): boolean;

    function ReadSQLSetting(settingTag: string; attri: TmwHighLightAttributes; key: string): boolean;
    var
      Reg : TBetterRegistry;
    begin { ReadSQLSetting }
      Result := false;
      Reg := TBetterRegistry.Create;
      try
        Reg.RootKey := HKEY_CURRENT_USER;
        try
          Reg.OpenKeyReadOnly( '\Software\mwEdit team\Highlighters\SQL\'+settingTag );
          attri.LoadFromRegistry(Reg);
          Result := true;
        except
        end;
      finally
        Reg.Free;
      end;
    end; { ReadSQLSetting }

  var
    tmpStringAttri    : TmwHighLightAttributes;
    tmpNumberAttri    : TmwHighLightAttributes;
    tmpKeyAttri       : TmwHighLightAttributes;
    tmpSymbolAttri    : TmwHighLightAttributes;
    tmpCommentAttri   : TmwHighLightAttributes;
    tmpIdentifierAttri: TmwHighLightAttributes;
    s                 : TStringList;

  begin { ReadSQLSettings }
    s := TStringList.Create;
    try
      EnumUserSettings(s);
      if settingIndex >= s.Count then
        Result := false
      else begin
        tmpStringAttri    := TmwHighLightAttributes.Create('');
        tmpNumberAttri    := TmwHighLightAttributes.Create('');
        tmpKeyAttri       := TmwHighLightAttributes.Create('');
        tmpSymbolAttri    := TmwHighLightAttributes.Create('');
        tmpCommentAttri   := TmwHighLightAttributes.Create('');
        tmpIdentifierAttri:= TmwHighLightAttributes.Create('');
        tmpStringAttri    .Assign(fStringAttri);
        tmpNumberAttri    .Assign(fNumberAttri);
        tmpKeyAttri       .Assign(fKeyAttri);
        tmpSymbolAttri    .Assign(fSymbolAttri);
        tmpCommentAttri   .Assign(fCommentAttri);
        tmpIdentifierAttri.Assign(fIdentifierAttri);
        Result := ReadSQLSetting(s[settingIndex],fCommentAttri,'Comment')       and
                  ReadSQLSetting(s[settingIndex],fIdentifierAttri,'Identifier') and
                  ReadSQLSetting(s[settingIndex],fKeyAttri,'Reserved word')     and
                  ReadSQLSetting(s[settingIndex],fNumberAttri,'Number')         and
                  ReadSQLSetting(s[settingIndex],fStringAttri,'String')         and
                  ReadSQLSetting(s[settingIndex],fSymbolAttri,'Symbol');
        if not Result then begin
          fStringAttri    .Assign(tmpStringAttri);
          fNumberAttri    .Assign(tmpNumberAttri);
          fKeyAttri       .Assign(tmpKeyAttri);
          fSymbolAttri    .Assign(tmpSymbolAttri);
          fCommentAttri   .Assign(tmpCommentAttri);
          fIdentifierAttri.Assign(tmpIdentifierAttri);
        end;
        tmpStringAttri    .Free;
        tmpNumberAttri    .Free;
        tmpKeyAttri       .Free;
        tmpSymbolAttri    .Free;
        tmpCommentAttri   .Free;
        tmpIdentifierAttri.Free;
      end;
    finally s.Free; end;
  end; { ReadSQLSettings }

begin
  Result := ReadSQLSettings(settingIndex);
end;

procedure TwmSQLSyn.EnumUserSettings(settings: TStrings);
begin
  { returns the user settings that exist in the registry }
  with TBetterRegistry.Create do begin
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKeyReadOnly('\Software\mwEdit team\Highlighters\SQL\') then begin
        try
          GetKeyNames(settings);
        finally
          CloseKey;
        end;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TwmSQLSyn.SetLineForExport(NewValue: String);
begin
  fLine := PChar(NewValue);
  Run := 0;
  ExportNext;
end; { SetLineForExport }

procedure TwmSQLSyn.ExportNext;
begin
  fTokenPos := Run;
  Case fRange of
    rsAnsiC: AnsiCProc;
  else
    fRange := rsUnknown;
    fProcTable[fLine[Run]];
  end;
  if Assigned(Exporter) then
    with TmwCustomExport(Exporter) do begin
      Case GetTokenID of
        wmComment:FormatToken(GetToken, fCommentAttri, True,False);
        wmIdentifier:FormatToken(GetToken, fIdentifierAttri, False,False);
        wmKey:FormatToken(GetToken, fKeyAttri, False,False);
        wmNumber:FormatToken(GetToken, fNumberAttri, False,False);
        {Needed to catch Line breaks}
        wmNull:FormatToken('', nil, False,False);
        wmString:FormatToken(GetToken, fStringAttri, True,False);
        wmSymbol:FormatToken(GetToken, fSymbolAttri,True,False);
        wmUnknown:FormatToken(GetToken, fSymbolAttri, True,False);
      end;
    end; //with
end;

Initialization
  MakeIdentTable;
end.