ttagbranchfrmunit.pas

CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise

(* $Id: TTagBranchFrmunit.pas,v 1.3 2002/12/27 16:22:43 turbo Exp $
 *
 * Form for creating a tag or a branch for a module (cvs tag)
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TTagBranchFrmunit;
{$I BORCVS.inc}
interface
//---------------------------------------------------------------------------
uses
  Classes,
  Controls,
  StdCtrls,
  Forms,
  TCvsBaseFrmunit,
  TRunCvsFrmunit,
  TFilesFrameunit,
  ComCtrls;
//---------------------------------------------------------------------------
type
  TTagBranchFrm = class(TCvsBaseFrm)
    PPageControl: TPageControl;
    POptionsTab: TTabSheet;
    PFilesTab: TTabSheet;
    PFilesFrame: TFilesFrame;
    PNameLbl: TLabel;
    PBranchCheck: TCheckBox;
    PUpdateCheck: TCheckBox;
    PSelFilesCheck: TCheckBox;
    PTagName: TComboBox;
    procedure PSelFilesCheckClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PBranchCheckClick(Sender: TObject);
    procedure POkBtnClick(Sender: TObject);
  private // Anwender-Deklarationen
  public // Anwender-Deklarationen
    constructor create(Owner: TComponent); override;
    procedure GetDirectories(Dirs: TStrings); override;
    procedure ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = ''); override;
    procedure Exec; override;
  end;
//---------------------------------------------------------------------------
var
  TagBranchFrm: TTagBranchFrm;
//---------------------------------------------------------------------------

implementation
uses
  windows,
  dialogs,
  sysutils,
  SettingsStorage,
  Utilityunit,
  TResultFrmunit;
//---------------------------------------------------------------------------
{$R *.dfm}
//---------------------------------------------------------------------------

constructor TTagBranchFrm.create(Owner: TComponent);
begin
  inherited create(owner);
end;
//---------------------------------------------------------------------------

procedure TTagBranchFrm.PSelFilesCheckClick(Sender: TObject);
begin
  PFilesTab.TabVisible := PSelFilesCheck.Checked;
  if (PFilesTab.TabVisible) then
    PPageControl.ActivePage := PFilesTab;
end;
//---------------------------------------------------------------------------

procedure TTagBranchFrm.PBranchCheckClick(Sender: TObject);
begin
  PUpdateCheck.Enabled := PBranchCheck.Checked;
  if PBranchCheck.Checked then
    PNameLbl.Caption := 'New branch name:'
  else
    PNameLbl.Caption := 'New tag name:';
end;
//---------------------------------------------------------------------------

procedure TTagBranchFrm.FormShow(Sender: TObject);
begin
  PPageControl.ActivePage := POptionsTab;
  ActiveControl := PTagName;
  // load settings
  try
    BEGIN_LOAD_SETTINGS('TagBranch');
    LOAD_STRINGS_SETTING('TagName', PTagName.Items, '');
    END_LOAD_SETTINGS;
  except
  end;

  PFilesFrame.LoadSettings;
  PFilesFrame.SetFilesFromProject(true);
  PBranchCheck.Checked := false;
  PBranchCheckClick(self);
  PSelFilesCheckClick(self);
end;
//---------------------------------------------------------------------------

procedure TTagBranchFrm.POkBtnClick(Sender: TObject);
begin
  if (PFilesTab.TabVisible and not PFilesFrame.IsValid(1)) then
  begin
    ShowMessage('You have to select at least one file!');
    PPageControl.ActivePage := PFilesTab;
    ActiveControl := PFilesFrame;
    exit;
  end;
  if (Trim(PTagName.Text) = '') then
  begin
    ShowMessage('You have to enter a tag/branch name!');
    PPageControl.ActivePage := POptionsTab;
    ActiveControl := PTagName;
    exit;
  end;
  // handle MRU lists
  ADD_COMBO_MRU_ENTRY_MAX(PTagName, DEFAULT_MRU_ENTRIES);
  // save settings
  BEGIN_SAVE_SETTINGS('TagBranch');
  SAVE_STRINGS_SETTING('TagName', PTagName.Items);
  END_SAVE_SETTINGS;
  PFilesFrame.SaveSettings;
  ModalResult := mrOk;
end;
//---------------------------------------------------------------------------

procedure TTagBranchFrm.ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = '');
begin
  runcvs.Command := CVSCMD_TAG;
  runcvs.Arguments.Add(GetOptQuotedString(PTagName.Text));
  runcvs.CommandOptions.Add('-c');
  if (PFilesTab.TabVisible) then
    PFilesFrame.ApplyParameters(runcvs,InDirectory);
  if (PBranchCheck.Checked) then
    runcvs.CommandOptions.Add('-b');
end;
//---------------------------------------------------------------------------
procedure TTagBranchFrm.GetDirectories(Dirs: TStrings);
begin
  PFilesFrame.GetDirectories(dirs);
end;

procedure TTagBranchFrm.Exec;
var
  ResultFrm: TResultFrm;
  exitcode: DWORD;
  runcvs: TRunCvsFrm;
begin
{ TODO 1 -oTurbo : Needs modification to work in multiple directories ! }
  try
    if (ShowModal = mrOk) then
    begin
      ResultFrm := TResultFrm.create(self);
      try
//        exitcode := $FFFF;
        ResultFrm.ShowProcessRunning;
        runcvs := TRunCvsFrm.create(self);
        try
          ApplyParameters(runcvs);
          if (not runcvs.Run(ResultFrm.PLogEdit)) then
            exit;
          exitcode := runcvs.ExitCode;
        finally
          runcvs.Free;
        end;
        try
          if (PBranchCheck.Checked and PUpdateCheck.Checked) then
          begin
            ResultFrm.PLogEdit.Lines.Add('');
            if (exitcode <> 0) then
            begin
              ResultFrm.PLogEdit.Lines.Add('BorCVS: tagging failed, giving up!');
              exit;
            end;
            runcvs := TRunCvsFrm.create(self);
            try
              runcvs.Command := CVSCMD_UPDATE;
              runcvs.CommandOptions.Add('-r ' +
                GetOptQuotedString(PTagName.Text));
              if (PFilesTab.TabVisible) then
                PFilesFrame.ApplyParameters(runcvs);
              runcvs.Run(ResultFrm.PLogEdit);
            finally
              runcvs.Free;
            end;
          end;
        finally
          ResultFrm.ShowFinished;
        end;
      finally
        ResultFrm.Free;
      end;
    end;
  except
    on e: EAbort do
    begin
    // do nothing...
    end;
  end;
end;
//---------------------------------------------------------------------------


end.