vclclxcvt.pas

East make Tray Icon in delphi

begin
  Result := FIgnoreUnits.Find(AName, Index);
  if not Result then
  begin
    for i := FIncludeFiles.Count - 1 downto 0 do
    begin
      Result := FIgnoreUnits.Find(FIncludeFiles[i] + '::' + AName, Index);
      if Result then
        Break;
    end;
  end;
end;

function TVCLConverter.IsUsesUnit(const AName: string): Boolean;
var
  Index: Integer;
begin
  Result := FUsesUnits.Find(AName, Index);
  if Result then
    Result := FLockedUsesUnits.IndexOf(AName) < 0;
end;

procedure TVCLConverter.ReplaceUnitName(Token: PTokenInfo);
var
  UnitName: string;
begin
  UnitName := Token.Value;
  TranslateUnit(UnitName);
  if UnitName <> Token.Value then
  begin
    FStatistics.IncUnitReplacements;
    Token.Parser.ReplaceParseNext(Token, Token, UnitName);
  end;
end;

function TVCLConverter.CheckFullQualifiedUnitIdentifier(Token: PTokenInfo;
  var Context: TParseContext): Boolean;
var
  ParserIndex: Integer;
  Parser: TPascalParser;
  Tk: TTokenInfo;
begin
  Result := False;
  with Context do
  begin
    if (((Context.LastToken.Kind = tkSymbol) and (Context.LastToken.Value <> '.')) or
        (Context.LastToken.Kind <> tkSymbol)) and
       not IsProtectedByConditions and IsUsesUnit(Token.Value) then
    begin
      // "UnitName.xxx" but not ".Unitname.xxx"
      Tk := Token^;
      Parser := Token.Parser;
      ParserIndex := Parser.Index;
      if GetNextToken(Parser, Token, Context) and (Token.Kind = tkSymbol) and (Token.Value = '.') then
      begin
        if not IsUnitIgnored(Tk.Value) then
          ReplaceUnitName(@Tk);
        Result := True;
      end
      else
        Parser.Index := ParserIndex;
    end;
  end;
end;

function TVCLConverter.CaseParseContext(Token: PTokenInfo; var Context: TParseContext): Boolean;
var
  S: string;
begin
  Result := False;
  with Context do
  begin
    case Token.Kind of
      tkIdent:
        begin
          S := Token.Value;
          if InImplementation and
             (SameText(S, 'procedure') or
              SameText(S, 'function') or
              SameText(S, 'constructor') or
              SameText(S, 'destructor')) then
          begin
            CheckFunction(Token, Context);
            Result := True;
          end
          else
            Result := CheckFullQualifiedUnitIdentifier(Token, Context);
        end;
    end;
  end;
end;

procedure TVCLConverter.Parse(Parser: TPascalParser);
var
  Token: PTokenInfo;
  Context: TParseContext;
  S: string;
begin
  FConditionStack := nil;
  FDefines := nil;
  try
    FConditionStack := TConditionStack.Create;
    FDefines := TStringList.Create;
    FDefines.Sorted := True;
    FDefines.Duplicates := dupIgnore;

    with Context do
    begin
      FillChar(Context, SizeOf(Context), 0);
      InImplementation := False;
      InInterfaceSection := False;
      while GetNextToken(Parser, Token, Context) do
      begin
        case Token.Kind of
          tkIdent:
            begin
              if not CaseParseContext(Token, Context) then
              begin
                S := Token.Value;
                if SameText(S, 'uses') then
                  CheckUses(Token, Context)
                else
                if (not InInterfaceSection) and (not InImplementation) and
                   SameText(S, 'interface') then
                  InInterfaceSection := True
                else
                if (not InImplementation) and
                   (SameText(S, 'unit') or
                    SameText(S, 'program') or
                    SameText(S, 'package') or
                    SameText(S, 'library')) then
                begin
                  CheckFileHead(Token, Context);
                end
                else
                if SameText(S, 'implementation') then
                begin
                  InImplementation := True;
                  InInterfaceSection := False;
                end;
              end;
            end
        else
          CaseParseContext(Token, Context);
        end;
      end;
    end;
  finally
    FreeAndNil(FConditionStack);
  end;
end;

procedure TVCLConverter.CheckOption(Token: PTokenInfo);
  // handles the compiler directives
var
  Condition, S: string;
  IncFilename, OrgIncFilename: string;
  ResourceName, OrgResource: string;
  Index: Integer;
begin
  S := RemoveCommentChars(Token.Value);
  if AnsiStartsText('$I ', S) or AnsiStartsText('$INCLUDE ', S) then
  begin
    if AnsiStartsText('$I ', S) then
      IncFilename := TrimCopy(S, 4, MaxInt)
    else
      IncFilename := TrimCopy(S, 9, MaxInt);
    FIncludeFiles.Add(IncFilename);
    OrgIncFilename := IncFilename;
    TranslateInc(IncFilename);
    if IncFilename <> OrgIncFilename then
    begin
      S := StringReplace(Token.Value, OrgIncFilename, IncFilename, []);
      Token.Parser.ReplaceParseNext(Token, Token, S);
    end;
  end
  else
  begin
    if AnsiStartsText('$DEFINE ', S) then
      FDefines.Add(TrimCopy(S, 9, MaxInt))
    else
    if AnsiStartsText('$UNDEF ', S) then
    begin
      if FDefines.Find(TrimCopy(S, 8, MaxInt), Index) then
        FDefines.Delete(Index);
    end
    else
    if AnsiStartsText('$IFDEF ', S) then
    begin
      Condition := TrimCopy(S, 8, MaxInt);
      FConditionStack.Enter(Condition, Token.StartIndex, Token.EndIndex, Token.StartLine);
    end
    else
    if AnsiStartsText('$IFNDEF ', S) then
    begin
      Condition := TrimCopy(S, 9, MaxInt);
      FConditionStack.EnterNot(Condition, Token.StartIndex, Token.EndIndex, Token.StartLine);
    end
    else
    if AnsiStartsText('$ELSE', S) then // $ELSEIF ???
    begin
      FConditionStack.GoElse(Token.StartIndex, Token.EndIndex, Token.StartLine);
    end
    else
    if AnsiStartsText('$ENDIF', S) then
    begin
      CheckCondition(Token.Parser, Token); // accesses FConditionStack.Current
      FConditionStack.Leave;
    end
    else
    if AnsiStartsText('$R ', S) or AnsiStartsText('$RESOURCE ', S) then
    begin
      if ((FConditionStack.IsIn('LINUX') = 0) and
         (FConditionStack.IsIn('MSWINDOWS') = 0))
         or
         (SameText(S, '$R *.DFM')) then
      begin
        if SameText(S, '$R *.DFM') then
        begin
          if IsProtectedByConditions then
            Exit; // forced by condition block
        end;

        if AnsiStartsText('$R ', S) then
          ResourceName := TrimCopy(S, 4, MaxInt)
        else
          ResourceName := TrimCopy(S, 11, MaxInt);
        OrgResource := ResourceName;
        TranslateResource(ResourceName);
        if ResourceName <> OrgResource then
        begin
          S := StringReplace(Token.Value, OrgResource, ResourceName, []);
          Token.Parser.ReplaceParseNext(Token, Token, S);
        end;
      end;
    end;
  end;
end;

procedure TVCLConverter.CheckCondition(Parser: TPascalParser; EndifToken: PTokenInfo);
var
  Cond: TConditionStackItem;

  function LineClean(Index: Integer): Integer; // after LineClean the tokens are invalidt
  var
    StartIndex: Integer;
  begin
    Result := 0;
    StartIndex := Index;
    while Index > 0 do
    begin
      case Parser.Text[Index] of
        #0..#9: ;
        #10: // we read backward
          begin
            if Parser.Text[Index - 1] = #13 then
              Dec(Index);
            Break;
          end;
        #11, #12: ;
        #13:
            Break;
        #14..#32: ;
      else
        Exit;
      end;
      Dec(Index);
    end;
    Result := StartIndex - Index;
    Parser.Delete(Index, Result);
    Parser.Index := Index;
  end;

  procedure Remove(RemoveContent: Boolean);
  var
    S: string;
    ParserIndex: Integer;
  begin
    ParserIndex := Parser.Index;
    if not Cond.HasElse then
    begin
      if not RemoveContent then
      begin
        // remove $ENDIF before $IFDEF
        Dec(ParserIndex, EndifToken.EndIndex - EndifToken.StartIndex + 1);
        Parser.Replace(EndifToken, EndifToken, '');
        if not KeepLines then
          Dec(ParserIndex, LineClean(EndifToken.StartIndex - 1));
        Dec(ParserIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1);
        Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1, '');
      end
      else
      begin
        if KeepLines then
          S := RepeatStr(GetLineBreak, EndifToken.EndLine - Cond.OpenLine)
        else
          S := '';
        Dec(ParserIndex, EndifToken.EndIndex - Cond.OpenStartIndex + 1);
        Parser.ReplaceParseNext(Cond.OpenStartIndex, EndifToken.EndIndex - Cond.OpenStartIndex + 1, S);
        Inc(ParserIndex, Length(S));
      end;
    end
    else
    begin
      if not RemoveContent then
      begin
        // remove $ENDIF before $IFDEF
        if KeepLines then
          S := RepeatStr(GetLineBreak, EndifToken.EndLine - Cond.ElseLine)
        else
          S := '';
        Dec(ParserIndex, EndifToken.EndIndex - Cond.ElseStartIndex + 1);
        Parser.ReplaceParseNext(Cond.ElseStartIndex, EndifToken.EndIndex - Cond.ElseStartIndex + 1, S);
        Inc(ParserIndex, Length(S));
        if not KeepLines then
          Dec(ParserIndex, LineClean(Cond.ElseStartIndex - 1));

        Dec(ParserIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1);
        Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.OpenEndIndex - Cond.OpenStartIndex + 1, '');
      end
      else
      begin
        // remove $ENDIF before $IFDEF
        if KeepLines then
          S := RepeatStr(GetLineBreak, Cond.ElseLine - Cond.OpenLine)
        else
          S := '';
        Dec(ParserIndex, EndifToken.EndIndex - EndifToken.StartIndex + 1);
        Parser.Replace(EndifToken, EndifToken, '');
        if not KeepLines then
          Dec(ParserIndex, LineClean(EndifToken.StartIndex - 1));

        Dec(ParserIndex, Cond.ElseEndIndex - Cond.OpenStartIndex + 1);
        Parser.ReplaceParseNext(Cond.OpenStartIndex, Cond.ElseEndIndex - Cond.OpenStartIndex + 1, S);
        Inc(ParserIndex, Length(S));
      end;
    end;

    if not KeepLines then
      Dec(ParserIndex, LineClean(Parser.Index - 1));

    // restore next token start index  
    Parser.Index := ParserIndex;
  end;

var
  Index: Integer;
begin
  if not ReduceConditions then
    Exit; // do nothing here

  Cond := FConditionStack.Current;
  if Cond = nil then
  begin
    FStatistics.AddError('No IFDEF/IFNDEF open.');
    Exit;
  end;

  if FRemoveConditions.Find(Cond.Condition, Index) then  // "Condition"
    Remove(not Cond.Negative)
  else
  if FRemoveConditions.Find('!' + Cond.Condition, Index) then // "!Condition"
    Remove(Cond.Negative);
end;

procedure TVCLConverter.CheckUses(Token: PTokenInfo; var Context: TParseContext);
var
  Parser: TPascalParser;
  StartConditionStackCount: Integer;
//  InsertTypesUnitStartIndex: Integer;
  i: Integer;
  Changed: Boolean;
begin
//  InsertTypesUnitStartIndex := -1;
  StartConditionStackCount := FConditionStack.OpenCount;
  Parser := Token.Parser;
  while GetNextToken(Parser, Token, Context) do
  begin
    case Token.Kind of
      tkSymbol:
        if (Token.Value = ';') and (StartConditionStackCount <= FConditionStack.OpenCount) then
          Break; // finished
      tkIdent:
        begin
          if SameText(Token.Value, 'in') and UnixPathDelim then // uses unitname in 'filename.pas';
          begin