tnewmodulefrmunit.pas

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

(* $Id: TNewModuleFrmunit.pas,v 1.5 2002/12/27 16:22:43 turbo Exp $
 *
 * Form for creating a new module in CVS (does cvs import and cvs checkout)
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TNewModuleFrmunit;
{$I BORCVS.inc}
interface
//---------------------------------------------------------------------------
uses
  Classes,
  Controls,
  StdCtrls,
  Forms,
  TCvsBaseFrmUnit,
  ComCtrls,
  TRunCvsFrmunit,
  TCvsrootFrameUnit;
//---------------------------------------------------------------------------
type
  TNewModuleFrm = class(TCvsBaseFrm)
    PPageControl: TPageControl;
    PModuleTab: TTabSheet;
    PIgnoreTab: TTabSheet;
    PWrappersTab: TTabSheet;
    PIgnore: TMemo;
    PWrappers: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    PCvsrootTab: TTabSheet;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    PCreateCvsignore: TCheckBox;
    Label14: TLabel;
    PLocalDirBtn: TButton;
    PLocalDir: TComboBox;
    PModule: TComboBox;
    PVendor: TComboBox;
    PRelease: TComboBox;
    PLogMsg: TComboBox;
    PCvsrootFrame: TCvsrootFrame;
    procedure POkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PLocalDirBtnClick(Sender: TObject);
  private // Anwender-Deklarationen
  protected
    procedure GetDirectories(Dirs: TStrings); override;
    procedure ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = ''); override;
    procedure CreateCvsignore(workdir: string);
  public // Anwender-Deklarationen
    constructor create(Owner: TComponent); override;
    procedure Exec; override;
  end;
//---------------------------------------------------------------------------
var
  NewModuleFrm: TNewModuleFrm;
//---------------------------------------------------------------------------
implementation
uses
  windows,
  SysUtils,
  Dialogs,
  FileCtrl,
  SettingsStorage,
  TToolsApiHelperUnit,
  UtilityUnit,
  TResultFrmUnit,
  TPreferencesFrmUnit;
//---------------------------------------------------------------------------
{$R *.dfm}
//---------------------------------------------------------------------------

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

procedure TNewModuleFrm.FormShow(Sender: TObject);
begin
  PPageControl.ActivePage := PModuleTab;
  ActiveControl := PModule;
  // load settings
  try
    BEGIN_LOAD_SETTINGS('NewModule');
    LOAD_STRINGS_SETTING('PLocalDir', PLocalDir.Items, '');
    LOAD_STRINGS_SETTING('PModule', PModule.Items, '');
    LOAD_COMBOLIST_SETTING('PVendor', PVendor, 'NoVendor');
    LOAD_COMBOLIST_SETTING('PRelease', PRelease, 'Start');
    LOAD_COMBOLIST_SETTING('PLogMsg', PLogMsg, '');
    LOAD_STRINGS_SETTING('Ignore', PIgnore.Lines,
      '*.~*\r\n*.dsk\r\n*.lib\r\n*.dll\r\n*.tds');
    PCreateCvsignore.Checked := LOAD_BOOL_SETTING('CreateCvsignore', true);
    LOAD_STRINGS_SETTING('Wrappers', PWrappers.Lines, '*.res -k *.bmp -k ');
    END_LOAD_SETTINGS;
  except
  end;
  PCvsrootFrame.LoadSettings;
end;
//---------------------------------------------------------------------------

procedure TNewModuleFrm.POkBtnClick(Sender: TObject);
begin
  PLocalDir.Text := Trim(PLocalDir.Text);
  if (not DirectoryExists(PLocalDir.Text)) then
  begin
    ShowMessage('Directory ' + PLocalDir.Text + ' not found!');
    PPageControl.ActivePage := PModuleTab;
    ActiveControl := PLocalDir;
    exit;
  end;
  if (Trim(PModule.Text) = '') then
  begin
    ShowMessage('You have to enter a module name!');
    PPageControl.ActivePage := PModuleTab;
    ActiveControl := PModule;
    exit;
  end;
  if (Trim(PVendor.Text) = '') then
  begin
    ShowMessage('You have to enter a vendor tag!');
    PPageControl.ActivePage := PModuleTab;
    ActiveControl := PVendor;
    exit;
  end;
  if (Trim(PRelease.Text) = '') then
  begin
    ShowMessage('You have to enter a release tag!');
    PPageControl.ActivePage := PModuleTab;
    ActiveControl := PRelease;
    exit;
  end;
  if (not PCvsrootFrame.IsValid) then
  begin
    ShowMessage('You have to enter the CVSROOT!');
    PPageControl.ActivePage := PCvsrootTab;
    ActiveControl := PCvsrootFrame;
    exit;
  end;
  // handle MRU lists
  ADD_COMBO_MRU_ENTRY_MAX(PLocalDir, DEFAULT_MRU_ENTRIES);
  ADD_COMBO_MRU_ENTRY_MAX(PModule, DEFAULT_MRU_ENTRIES);
  ADD_COMBO_MRU_ENTRY_MAX(PVendor, DEFAULT_MRU_ENTRIES);
  ADD_COMBO_MRU_ENTRY_MAX(PRelease, DEFAULT_MRU_ENTRIES);
  ADD_COMBO_MRU_ENTRY_MAX(PLogMsg, DEFAULT_MRU_ENTRIES);
  // save settings
  BEGIN_SAVE_SETTINGS('NewModule');
  SAVE_STRINGS_SETTING('PLocalDir', PLocalDir.Items);
  SAVE_STRINGS_SETTING('PModule', PModule.Items);
  SAVE_COMBOLIST_SETTING('PVendor', PVendor);
  SAVE_COMBOLIST_SETTING('PRelease', PRelease);
  SAVE_COMBOLIST_SETTING('PLogMsg', PLogMsg);
  SAVE_STRINGS_SETTING('Ignore', PIgnore.Lines);
  SAVE_BOOL_SETTING('CreateCvsignore', PCreateCvsignore.Checked);
  SAVE_STRINGS_SETTING('Wrappers', PWrappers.Lines);
  END_SAVE_SETTINGS;
  PCvsrootFrame.SaveSettings;
  ModalResult := mrOk;
end;
//---------------------------------------------------------------------------

procedure TNewModuleFrm.ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = '');
var
  i: integer;
  line: string;
begin
  runcvs.Command := CVSCMD_IMPORT;
  runcvs.Arguments.Add(PModule.Text);
  runcvs.Arguments.Add(PVendor.Text);
  runcvs.Arguments.Add(PRelease.Text);
  runcvs.WorkingDirectory := Trim(PLocalDir.Text);
  runcvs.CommandOptions.Add('-m ' + GetQuotedString(PLogMsg.Text));
  PCvsrootFrame.ApplyParameters(runcvs);
  for i := 0 to PIgnore.Lines.Count - 1 do
  begin
    line := PIgnore.Lines.Strings[i];
    if Trim(line) <> '' then
      runcvs.CommandOptions.Add('-I ' + GetOptQuotedString(line));
  end;
  for i := 0 to PWrappers.Lines.Count - 1 do
  begin
    line := PWrappers.Lines.Strings[i];
    if Trim(line) <> '' then
      runcvs.CommandOptions.Add('-W ' + GetOptQuotedString(line));
  end;
end;
//---------------------------------------------------------------------------
procedure TNewModuleFrm.GetDirectories(Dirs: TStrings);
begin

end;
//---------------------------------------------------------------------------

procedure TNewModuleFrm.CreateCvsignore(workdir: string);
var
  filename: string;
begin
  filename := IncludeTrailingPathDelimiter(workdir) + '.cvsignore';
  if (not FileExists(filename)) or
    (MessageDlg('The file ' + filename + ' does already exist!'#13'Overwrite?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    PIgnore.Lines.SaveToFile(filename);
  // don't just save to current dir, but to all subdirs, but not to ignored ones...
  // so we have to parse probably existing .cvsignores, the .cvsignore in the
  // home directory, and the original ignored files, see WinCVS source...
  // then, don't just save it, but merge the contents...
end;
//---------------------------------------------------------------------------

procedure TNewModuleFrm.Exec;
var
  projectfile: string;
  projectgroupfile: string;
  workdir: string;
  exitcode: DWORD;
  ResultFrm: TResultFrm;
  runcvs: TRunCvsFrm;
  parentdir: string;
  oldworkdir: string;
begin
  try
    projectfile := ToolsApiHelper.GetCurrentProjectFile;
    projectgroupfile := ToolsApiHelper.GetCurrentProjectGroupFile;
    if (projectgroupfile <> '') and (FileExists(projectgroupfile)) then
    begin
      workdir := ExtractFilePath(projectgroupfile);
      workdir := copy(workdir, 1, Length(workdir) - 1);
    end
    else
      if (projectfile <> '') and (FileExists(projectfile)) then
    begin
      workdir := ExtractFilePath(projectfile);
      workdir := copy(workdir, 1, Length(workdir) - 1);
    end
    else
    begin
      if (not SelectDirectory('Select directory to import', '', workdir)) then
      begin
        exit;
      end;
    end;
    PLocalDir.Text := workdir;
    PModule.Text := ExtractFileName(workdir);
    if (ShowModal = mrOk) then
    begin
      workdir := Trim(PLocalDir.Text);
      ResultFrm := TResultFrm.create(self);
      try
//        exitcode := $FFFF;
        ResultFrm.ShowProcessRunning;
        runcvs := TRunCvsFrm.create(self);
        try
          runcvs.Command := CVSCMD_CHECKOUT;
          runcvs.WorkingDirectory := workdir;
          runcvs.CommandOptions.Add('-lp');
          runcvs.Arguments.Add(GetOptQuotedString(PModule.Text));
          PCvsrootFrame.ApplyParameters(runcvs);
          if (runcvs.Run(nil)) then
          begin
            if (runcvs.ExitCode = 0) then
            begin
              ShowMessage('The module does already exist on the server!');
              exit;
            end;
          end
          else
            exit;
        finally
          runcvs.free;
        end;
        if (PCreateCvsignore.Checked and not PreferencesFrm.DemoMode) then
        begin
          ResultFrm.PLogEdit.Lines.Add('Creating .cvsignore file...');
          CreateCvsignore(workdir);
          ResultFrm.PLogEdit.Lines.Add('');
        end;
        runcvs := TRunCvsFrm.create(self);
        try
          ApplyParameters(runcvs);
          if (not runcvs.Run(ResultFrm.PLogEdit)) then
            exit;
          exitcode := runcvs.ExitCode;
        finally
          runcvs.Free;
        end;
        try
          ResultFrm.PLogEdit.Lines.Add('');
          if (exitcode <> 0) then
          begin
            ResultFrm.PLogEdit.Lines.Add('BorCVS: Project import failed, giving up!');
            exit;
          end;
          if (not PreferencesFrm.DemoMode) then
          begin
            parentdir := ExtractFilePath(workdir);
            if (not ToolsApiHelper.CloseAll) then
            begin
              ResultFrm.PLogEdit.Lines.Add('');
              ResultFrm.PLogEdit.Lines.Add('Error closing project files!');
            end;
            SetCurrentDir(parentdir);
            oldworkdir := workdir + '.precvs';
            ResultFrm.PLogEdit.Lines.Add('Renaming ' + workdir + ' to ' + oldworkdir + '...');
            if (RenameFile(workdir, oldworkdir)) then
            begin
              ResultFrm.PLogEdit.Lines.Add('');
              runcvs := TRunCvsFrm.create(self);
              try
                runcvs.Command := CVSCMD_CHECKOUT;
                runcvs.WorkingDirectory := parentdir;
                runcvs.Arguments.Add(GetOptQuotedString(PModule.Text));
                runcvs.CommandOptions.Add('-d ' +
                  GetOptQuotedString(ExtractFileName(workdir)));
                PCvsrootFrame.ApplyParameters(runcvs);
                if (runcvs.Run(ResultFrm.PLogEdit)) then
                begin
                  if (FileExists(projectgroupfile)) then
                  begin
                    ToolsApiHelper.OpenFile(projectgroupfile);
                  end
                  else
                    if (FileExists(projectfile)) then
                  begin
                    ToolsApiHelper.OpenProject(projectfile);
                  end;
                end;
              finally
                runcvs.free;
              end;
            end
            else
            begin
              ResultFrm.PLogEdit.Lines.Add('');
              ResultFrm.PLogEdit.Lines.Add('Error renaming directory ' + workdir + '!');
            end
          end
          else
          begin
            ResultFrm.PLogEdit.Lines.Add('');
            ResultFrm.PLogEdit.Lines.Add('CVS is in demo mode, and so the rest of this command is skipped!');
          end
        finally
          ResultFrm.ShowFinished;
        end
      finally
        ResultFrm.Free;
      end
    end;
  except
    on e: EAbort do
    begin
    // do nothing...
    end;
  end;
end;
//---------------------------------------------------------------------------

procedure TNewModuleFrm.PLocalDirBtnClick(Sender: TObject);
var
  workdir: string;
begin
  workdir := PLocalDir.Text;
  if (SelectDirectory('Select directory to import', '', workdir)) then
  begin
    PLocalDir.Text := workdir;
    PModule.Text := ExtractFileName(workdir);
  end;
end;
//---------------------------------------------------------------------------


end.