jcluseswizard.pas

East make Tray Icon in delphi

    P, P1, P2: PChar;
    UnitName: string;
    LineNumber: Integer;
    Identifier: string;
  begin
    Result := False;
    Error := nil;
    P := PChar(Msg);

    // check opening bracket
    if P^ <> '[' then
      Exit;
    Inc(P);

    // check severity
    if StrLComp(P, PChar(SError), Length(SError)) <> 0 then
      Exit;
    Inc(P, Length(SError));

    // check closing bracket
    if P^ <> ']' then
      Exit;
    Inc(P);

    // check space
    if P^ <> ' ' then
      Exit;
    Inc(P);

    // read unit name
    UnitName := '';
    while P^ <> '(' do
    begin
      if P^ = #0 then
        Break;

      UnitName := UnitName + P^;

      Inc(P);
    end;
    if UnitName = '' then
      Exit;
    if P^ <> '(' then
      Exit;
    Inc(P);

    // read line number
    LineNumber := 0;
    while P^ <> ')' do
    begin
      if P^ = #0 then
        Break;

      LineNumber := LineNumber * 10 + Ord(P^) - Ord('0');

      Inc(P);
    end;
    if LineNumber = 0 then
      Exit;
    if P^ <> ')' then
      Exit;
    Inc(P);

    // check colon
    if P^ <> ':' then
      Exit;
    Inc(P);

    // check space
    if P^ <> ' ' then
      Exit;
    Inc(P);

    // check text
    Identifier := '';
    P1 := PChar(SUndeclaredIdent);

    // check text up to '%s'
    P2 := StrPos(P1, SIdentFormatSpec);
    if P2 = nil then
      Exit;
    if StrLComp(P, P1, P2 - P1) <> 0 then
      Exit;

    P1 := P + (P2 - P1);

    // check text after '%s'
    Inc(P2, Length(SIdentFormatSpec));
    P := StrEnd(P);
    Dec(P, StrLen(P2));

    if StrComp(P, P2) <> 0 then
      Exit;

    // copy identifier
    while P1 < P do
    begin
      Identifier := Identifier + P1^;
      Inc(P1);
    end;
    if Identifier = '' then
      Exit;

    // match
    Error := AllocMem(SizeOf(TErrorInfo));
    try
      StrLCopy(Error^.UnitName, PChar(UnitName), Length(Error^.UnitName));
      Error^.LineNumber := LineNumber;
      StrLCopy(Error^.Identifier, PChar(Identifier), Length(Error^.Identifier));

      Result := True;
    except
      FreeMem(Error);
      raise;
    end;
  end;

begin
  ClearErrors;
  if not Assigned(Messages) then
    Exit;

  LoadDcc32Strings;
  for I := 0 to Messages.Count - 1 do
    if ParseMessage(Messages[I], Error) then
      FErrors.Add(Error);

  for I := 0 to FErrors.Count - 1 do
    ResolveUsesName(FErrors[I]);

  for I := FErrors.Count - 1 downto 0 do
  begin
    Error := FErrors[I];
    if Error^.UsesName = '' then
    begin
      FreeMem(Error);
      FErrors.Delete(I);
    end;
  end;

  Application.ProcessMessages;

  FApplicationIdle := Application.OnIdle;
  Application.OnIdle := AppIdle;
end;

//----------------------------------------------------------------------------

procedure TJCLUsesWizard.ProcessUses;
var
  GoalSource: string;
  Goal: TCustomGoal;
  I: Integer;
  ChangeList: TStrings;
  IntfLength, ImplLength: Integer;
  Writer: IOTAEditWriter;
  Project: IOTAProject;
begin
  GoalSource := '';
  with BorlandIDEServices as IOTAEditorServices do
    if Assigned(TopBuffer) then
      GoalSource := ReadEditorBuffer(TopBuffer)
    else
      Exit;

  Goal := CreateGoal(PChar(GoalSource));
  if not Assigned(Goal) then
    Exit;

  try
    if Goal is TProgramGoal then
      with TProgramGoal(Goal) do
      begin
        IntfLength := Length(UsesList.Text);
        ChangeList := TStringList.Create;
        try
          for I := 0 to FErrors.Count - 1 do
            with PErrorInfo(FErrors[I])^ do
              if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
                ChangeList.AddObject(UsesName, TObject(waAddToIntf));

          if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
          begin
            for I := ChangeList.Count - 1 downto 0 do
              case TWizardAction(ChangeList.Objects[I]) of
                waAddToImpl, waAddToIntf:
                  if UsesList.Count = 0 then
                    UsesList.Add(ChangeList[I])
                  else
                    UsesList.Insert(0, ChangeList[I]);
              end;

            with BorlandIDEServices as IOTAEditorServices do
              if Assigned(TopBuffer) then
              begin
                Writer := TopBuffer.CreateUndoableWriter;
                try
                  Writer.CopyTo(Length(TextBeforeUses));
                  Writer.DeleteTo(Length(TextBeforeUses) + IntfLength);
                  Writer.Insert(PChar(UsesList.Text));
                  Writer.CopyTo(Length(GoalSource));
                finally
                  Writer := nil;
                end;
              end;

            // attempt to recompile
            Project := GetActiveProject;
            if Assigned(Project) and Assigned(Project.ProjectBuilder) then
              Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
          end;
        finally
          ChangeList.Free;
        end;
      end
    else
    if Goal is TLibraryGoal then
      with TLibraryGoal(Goal) do
      begin
        IntfLength := Length(UsesList.Text);
        ChangeList := TStringList.Create;
        try
          for I := 0 to FErrors.Count - 1 do
            with PErrorInfo(FErrors[I])^ do
              if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
                ChangeList.AddObject(UsesName, TObject(waAddToIntf));

          if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
          begin
            for I := ChangeList.Count - 1 downto 0 do
              case TWizardAction(ChangeList.Objects[I]) of
                waAddToImpl, waAddToIntf:
                  if UsesList.Count = 0 then
                    UsesList.Add(ChangeList[I])
                  else
                    UsesList.Insert(0, ChangeList[I]);
              end;

            with BorlandIDEServices as IOTAEditorServices do
              if Assigned(TopBuffer) then
              begin
                Writer := TopBuffer.CreateUndoableWriter;
                try
                  Writer.CopyTo(Length(TextBeforeUses));
                  Writer.DeleteTo(Length(TextBeforeUses) + IntfLength);
                  Writer.Insert(PChar(UsesList.Text));
                  Writer.CopyTo(Length(GoalSource));
                finally
                  Writer := nil;
                end;
              end;

            // attempt to recompile
            Project := GetActiveProject;
            if Assigned(Project) and Assigned(Project.ProjectBuilder) then
              Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
          end;
        finally
          ChangeList.Free;
        end;
      end
    else
    if Goal is TUnitGoal then
      with TUnitGoal(Goal) do
      begin
        IntfLength := Length(UsesIntf.Text);
        ImplLength := Length(UsesImpl.Text);
        ChangeList := TStringList.Create;
        try
          for I := 0 to FErrors.Count - 1 do
            with PErrorInfo(FErrors[I])^ do
              if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
              begin
                if LineNumber < GetLineNumber(PChar(GoalSource), PChar(GoalSource) + Length(TextBeforeIntf) +
                  IntfLength + Length(TextAfterIntf)) then // error in interface section
                begin
                  if UsesImpl.IndexOf(UsesName) = -1 then
                    ChangeList.AddObject(UsesName, TObject(waAddToIntf))
                  else
                    ChangeList.AddObject(UsesName, TObject(waMoveToIntf));
                end
                else // error in implementation section
                  ChangeList.AddObject(UsesName, TObject(waAddToImpl));
              end;

          if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
          begin
            for I := ChangeList.Count - 1 downto 0 do
              case TWizardAction(ChangeList.Objects[I]) of
                waAddToImpl:
                  if UsesImpl.Count = 0 then
                    UsesImpl.Add(ChangeList[I])
                  else
                    UsesImpl.Insert(0, ChangeList[I]);
                waAddToIntf:
                  if UsesIntf.Count = 0 then
                    UsesIntf.Add(ChangeList[I])
                  else
                    UsesIntf.Insert(0, ChangeList[I]);
                waMoveToIntf:
                  begin
                    if UsesIntf.Count = 0 then
                      UsesIntf.Add(ChangeList[I])
                    else
                      UsesIntf.Insert(0, ChangeList[I]);
                    UsesImpl.Remove(UsesImpl.IndexOf(ChangeList[I]));
                  end;
                else
                  ChangeList.Delete(I);
              end;

            if ChangeList.Count = 0 then
              Exit;

            with BorlandIDEServices as IOTAEditorServices do
              if Assigned(TopBuffer) then
              begin
                Writer := TopBuffer.CreateUndoableWriter;
                try
                  Writer.CopyTo(Length(TextBeforeIntf));
                  Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength);
                  Writer.Insert(PChar(UsesIntf.Text));
                  Writer.CopyTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf));
                  Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf) + ImplLength);
                  Writer.Insert(PChar(UsesImpl.Text));
                  Writer.CopyTo(Length(GoalSource));
                finally
                  Writer := nil;
                end;
              end;

            // attempt to recompile
            Project := GetActiveProject;
            if Assigned(Project) and Assigned(Project.ProjectBuilder) then
              Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
          end;
        finally
          ChangeList.Free;
        end;
      end;
  finally
    Goal.Free;
  end;
end;

//----------------------------------------------------------------------------

procedure TJCLUsesWizard.ResolveUsesName(Error: PErrorInfo);
var
  I: Integer;
  Identifiers: TStrings;
  IdentifierIndex: Integer;
begin
  if FIdentifierLists.Count = 0 then
    InitializeIdentifierLists;

  Identifiers := TStringList.Create;
  try
    with FIdentifierLists do
      for I := 0 to Count - 1 do
      begin
        Identifiers.CommaText := Values[Names[I]];
        with Error^ do
        begin
          IdentifierIndex := Identifiers.IndexOf(Identifier);
          if IdentifierIndex <> -1 then
          begin
            StrLCopy(UsesName, PChar(Names[I]), Length(UsesName));
            Break;
          end;
        end;
      end;
  finally
    Identifiers.Free;
  end;
end;

//----------------------------------------------------------------------------

procedure TJCLUsesWizard.SetActive(Value: Boolean);
begin
  if Value <> FActive then
  begin
    if Value then
    begin
      with BorlandIDEServices as IOTAServices do
        FNotifierIndex := AddNotifier(TJCLUsesWizardNotifier.Create);

      FActive := FNotifierIndex <> -1;
    end
    else
    begin
      if FNotifierIndex <> -1 then
        with BorlandIDEServices as IOTAServices do
          RemoveNotifier(FNotifierIndex);

      FNotifierIndex := -1;
      FActive := False;
    end;
  end;
end;

//----------------------------------------------------------------------------

procedure TJCLUsesWizard.SetConfirmChanges(Value: Boolean);
begin
  if Value <> FConfirmChanges then
  begin
    FConfirmChanges := Value;
  end;
end;

//----------------------------------------------------------------------------
{ TJCLUsesWizard private: IOTAWizard }
//----------------------------------------------------------------------------

procedure TJCLUsesWizard.Execute;
begin
  // do nothing
end;

//----------------------------------------------------------------------------

function TJCLUsesWizard.GetIDString: string;
begin
  Result := SJCLUsesWizardID;
end;

//----------------------------------------------------------------------------

function TJCLUsesWizard.GetName: string;
begin
  Result := SJCLUsesWizardName;
end;

//----------------------------------------------------------------------------

function TJCLUsesWizard.GetState: TWizardState;
begin
  Result := [wsEnabled];
end;

//----------------------------------------------------------------------------
{ TJCLUsesWizard public }
//----------------------------------------------------------------------------

constructor TJCLUsesWizard.Create;
begin
  inherited Create;
  FIdentifierLists := TStringList.Create;
  FErrors := TList.Create;
  FActive := False;
  FConfirmChanges := False;
  FNotifierIndex := -1;

  Application.HookMainWindow(AppWindowHook);
  LoadFromRegistry;
end;

//----------------------------------------------------------------------------

destructor TJCLUsesWizard.Destroy;
begin
  Application.UnhookMainWindow(AppWindowHook);
  SetActive(False);
  Wizard := nil;
  ClearErrors;
  FErrors.Free;
  FIdentifierLists.Free;
  inherited Destroy;
end;

//----------------------------------------------------------------------------

function TJCLUsesWizard.LoadFromRegistry: Boolean;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    with BorlandIDEServices as IOTAServices do
    begin
      Result := Registry.OpenKey(GetBaseRegistryKey + '\' + SJCLRegSubkey, False);
      if not Result then
      begin
        Registry.RootKey := HKEY_LOCAL_MACHINE;
        Result := Registry.OpenKey(GetBaseRegistryKey + '\' + SJCLRegSubkey, False);
      end;
    end;

    if Result then
    begin
      SetActive(Registry.ValueExists(SRegWizardActive) and Registry.ReadBool(SRegWizardActive));
      FConfirmChanges := not Registry.ValueExists(SRegWizardCofirm) or Registry.ReadBool(SRegWizardCofirm);
      FIniFile := Registry.ReadString(SRegWizardIniFile);
    end;
  finally
    Registry.Free;
  end;
end;

//----------------------------------------------------------------------------
// create and register wizard instance

procedure Register;
begin
  Wizard := TJCLUsesWizard.Create;
  RegisterPackageWizard(Wizard);
end;

//----------------------------------------------------------------------------

procedure SettingsChanged;
begin
  if Assigned(Wizard) then
    Wizard.LoadFromRegistry;
end;

end.