tfilesframeunit.pas

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

(* $Id: TFilesFrameunit.pas,v 1.19 2003/01/06 16:35:00 turbo Exp $
 *
 * Frame for selecting the files on which to operate
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)
{
2002-12-19 Per-Eric Larsson

  FOnlyFileNameasParameter added as protected and set to
  false for compability - if set to true,
  only filenames will be sent to when calling  Applyparameters()

}
unit TFilesFrameunit;
{$I BORCVS.inc}
interface
//---------------------------------------------------------------------------
uses
  Classes,
  Controls,
  StdCtrls,
  Forms,
  CheckLst,
  Dialogs,
  SysUtils,
  TRunCvsFrmUnit,
  ActnList,
  ComCtrls,
  Menus,
  Buttons,
  ExtCtrls,
  TProjectStatusunit,
  ImgList;
//---------------------------------------------------------------------------
type
  TWhichFilesMode = (wfmCustom, wfmModule, wfmProject,wfmProjectGroup);

//---------------------------------------------------------------------------
type
  TFilesFrame = class(TFrame)
    POpenDlg: TOpenDialog;
    PActions: TActionList;
    PActMarkAll: TAction;
    PActMarkNone: TAction;
    PActAdd: TAction;
    PListView: TListView;
    PContextMenu: TPopupMenu;
    Selectall1: TMenuItem;
    Selectnone1: TMenuItem;
    N1: TMenuItem;
    Add1: TMenuItem;
    PActSelectionChanged: TAction;
    PActMarkAllModified: TAction;
    PActMarkAllConflict: TAction;
    Markallmodified1: TMenuItem;
    Markallconflict1: TMenuItem;
    PActMarkAllNotInCvs: TAction;
    MarkallNotinCVS1: TMenuItem;
    PToolbar: TPanel;
    PUpdateBtn: TSpeedButton;
    PCommitBtn: TSpeedButton;
    PLogBtn: TSpeedButton;
    PDiffBtn: TSpeedButton;
    PMarkBtn: TSpeedButton;
    PMarkMenu: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    PActCmdUpdate: TAction;
    PActCmdCommit: TAction;
    PActCmdLog: TAction;
    PActCmdDiff: TAction;
    N4: TMenuItem;
    Update1: TMenuItem;
    Commit1: TMenuItem;
    Log1: TMenuItem;
    Diff1: TMenuItem;
    procedure PActMarkAllExecute(Sender: TObject);
    procedure PActMarkNoneExecute(Sender: TObject);
    procedure PActAddExecute(Sender: TObject);
    procedure SelectionChanged(Sender: TObject; Item: TListItem;
      Selected: boolean);
    procedure PActMarkAllModifiedExecute(Sender: TObject);
    procedure PActMarkAllConflictExecute(Sender: TObject);
    procedure PActMarkAllNotInCvsExecute(Sender: TObject);
    procedure PListViewColumnClick(Sender: TObject; Column: TListColumn);
    procedure PListViewCompare(Sender: TObject; Item1: TListItem;
      Item2: TListItem; Data: integer; var Compare: integer);
    procedure PMarkBtnClick(Sender: TObject);
    procedure PActCmdUpdateExecute(Sender: TObject);
    procedure PActCmdCommitExecute(Sender: TObject);
    procedure PActCmdLogExecute(Sender: TObject);
    procedure PActCmdDiffExecute(Sender: TObject);
  private
    FCVSROOT: string;
    FOnlyFileNameasParameter: boolean;
    procedure SetCVSROOT(const Value: string);
  protected
    FFiles: TStringList;
    FSelectedFiles: TStringList;
    FStatus: TProjectStatus;
    FSortColumn: integer;
    FSortAsc: boolean;
    function GetFilePath(i: integer; InDirectory: string = ''): string;
    function GetSelectedFiles: TStrings;
    procedure SetFileStatus(filename: string; item: TListItem;
      projectstatus: TProjectStatus);
    procedure ShowFileStatus(projectstatus: TProjectStatus; fAllChecked: boolean
      = false);
    procedure RefreshFileStatus;
    function SetSelectedFilesToFrame(frame: TFilesFrame): integer; virtual;
//    procedure SetSelectedFilesToFrame(frame: TFilesFrame);
    procedure SetSortCaption(fClear: boolean);
    procedure DebugInfo(const s: string); virtual;
  public
    constructor create(Owner: TComponent); override;
    destructor destroy; override;
    procedure ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = '');
    procedure GetDirectories(Dirs: TStrings);
    function IsValid(minselected: integer): boolean;
    procedure Clear;
    procedure SetFilesFromProject(fAllChecked: boolean = false);
    procedure SetFilesFromProjectGroup(fAllChecked: boolean = false);
    procedure SetFilesFromCurrentModule(fAllChecked: boolean = false);
    procedure SetFilesInProjectGroupButNotCvs(fAllChecked: boolean);
    procedure SetFilesInProjectButNotCvs(fAllChecked: boolean = false);
    procedure SetFilesInCvsButNotProject(fAllChecked: boolean = false);
    function GetCurrentFile: string;
    procedure SetCommandsEnabled(fUpdate, fCommit: boolean);
    procedure LoadSettings; virtual;
    procedure SaveSettings; virtual;
//    procedure RefreshFileStatus;
  // remove property SelectedFiles (and FSelectedFiles) if not needed
    property SelectedFiles: TStrings read GetSelectedFiles;
    property CVSROOT: string read FCVSROOT write SetCVSROOT;
    property OnlyFileNameasParameter: boolean read FOnlyFileNameasParameter write
      FOnlyFileNameasParameter;
  end;
var
  FilesFrame: TFilesFrame;

implementation

uses
{$IFDEF D6UP}
  Types,
{$ENDIF}
  Windows,
  SettingsStorage,
  TToolsApiHelperunit,
  TCommitFrmunit,
  TDiffFrmunit,
  TLogFrmunit,
  TUpdateFrmunit,
  UtilityUnit,
  PELDebugit;
// implement button that executes CVS STATUS (refreshing the entries file)
// add an option to not just show project files, but all files in the working dir
// maybe use a better listbox, with color highlighting, etc, like WinCVS
//---------------------------------------------------------------------------

{$R *.dfm}
//---------------------------------------------------------------------------
resourcestring
  FS_NORMAL = '';
resourcestring
  FS_CONFLICT = 'Conflict';
resourcestring
  FS_MODIFIED = 'Modified';
resourcestring
  FS_NOTINCVS = 'Not in CVS';
resourcestring
  FS_MANUAL = '-';
//---------------------------------------------------------------------------
// for update and commit: if no file marked, use current file selected

constructor TFilesFrame.create(Owner: TComponent);
begin
  inherited create(owner);
  FSelectedFiles := TStringList.Create;
  FFiles := TStringList.Create;
  FStatus := TProjectStatus.create;
  FSortColumn := -1;
  FSortAsc := false;
  Clear;
  OnlyFileNameasParameter := false;
end;
//---------------------------------------------------------------------------

destructor TFilesFrame.destroy;
begin
  FStatus.Free;
  FSelectedFiles.Free;
  FFiles.Free;
  inherited Destroy;
end;
//---------------------------------------------------------------------------

function TFilesFrame.GetFilePath(i: integer; InDirectory: string = ''): string;
var
  item: TListItem;
begin
  item := PListView.Items.Item[i];
  if assigned(item) then
  begin
    if (item.SubItems.Count >= 7) then
    begin
      if (InDirectory = '') or (item.SubItems[6] = InDirectory) then
      begin
        if OnlyFileNameasParameter then
        begin
          result := item.Caption;
          exit;
        end
        else
        begin
          result := item.SubItems.Strings[6] + item.Caption;
          exit;
        end;
      end
      else
      begin
        result := '';
        exit;
      end;
    end
    else
      raise Exception.Create('BorCVS internal error: no path for file ' +
        item.Caption);
  end;
end;

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

function TFilesFrame.GetCurrentFile: string;
var
  item: TListItem;
  afile: string;
begin
  item := PListView.Selected;
  if assigned(item) and (item.SubItems.Count >= 7) then
  begin
    afile := item.SubItems.Strings[6] + item.Caption;
    if (FileExists(afile)) then
    begin
      result := afile;
    end
    else
    begin
      ShowMessage('BorCVS Error: file ' + afile + ' not found!');
    end;
  end;
end;

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

procedure TFilesFrame.Clear;
begin
  PListView.Items.Clear;
  PListView.SortType := stNone;
  FFiles.Clear;
  FSelectedFiles.Clear;
  SelectionChanged(nil, nil, false);
end;
//---------------------------------------------------------------------------

function TFilesFrame.GetSelectedFiles: TStrings;
var
  count, i: integer;
begin
  FSelectedFiles.Clear;
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    if (PListView.Items.Item[i].Checked) then
    begin
      FSelectedFiles.Add(GetFilePath(i));
    end;
  end;
  result := FSelectedFiles;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.ApplyParameters(runcvs: TRunCvsFrm; InDirectory: string = '');
var
  count, i: integer;
  s: string;
begin
  DebugInfo(format('ApplyParameters for %s', [InDirectory]));

  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    if (PListView.Items.Item[i].Checked) then
    begin
      s := GetFilePath(i, InDirectory);
      if s <> '' then
      begin
        DebugInfo(format('Added %s to ', [s]));
        runcvs.Arguments.Add(s);
      end;
    end;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.GetDirectories(Dirs: TStrings);
var
  count, i, j: integer;
  s: string;
begin
  DebugInfo('GetDirectories');
  count := PListView.Items.Count;
  for i := 0 to count - 1 do
  begin
    if (PListView.Items.Item[i].Checked) then
    begin
      if PListView.Items[i].SubItems.Count >= 7 then
      begin
        s := PListView.Items[i].SubItems[6];
        if s <> '' then
        begin
          J := Dirs.IndexOf(s);
          if j = -1 then
          begin
            Dirs.Add(s);
          end;
        end;
      end;
    end;
  end;
end;

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

function TFilesFrame.IsValid(minselected: integer): boolean;
var
  count, i, max_: integer;
  items: TListItems;
begin
  count := 0;
  items := PListView.Items;
  max_ := PListView.Items.Count;
  for i := 0 to max_ - 1 do
  begin
    if (items.Item[i].Checked) then
      inc(count);
  end;
  result := (count >= minselected);
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetFilesFromProject(fAllChecked: boolean);
begin
  Debuginfo('SetFilesFromProject');
  Screen.Cursor := crHourGlass;
  try
    Clear;
    ToolsApiHelper.GetCurrentProjectFiles(FFiles);
    FStatus.ReadStatus(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally
    Screen.Cursor := crDefault;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetFilesFromProjectGroup(fAllChecked: boolean);
begin
  Debuginfo('SetFilesFromProject');
  Screen.Cursor := crHourGlass;
  try
    Clear;
    ToolsApiHelper.GetCurrentProjectGroupFiles(FFiles);
    FStatus.ReadStatus(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally
    Screen.Cursor := crDefault;
  end;
end;
//---------------------------------------------------------------------------


procedure TFilesFrame.SetFilesFromCurrentModule(fAllChecked: boolean);
begin
  Screen.Cursor := crHourGlass;
  try
    Clear;
    ToolsApiHelper.GetCurrentModuleFiles(FFiles);
    FStatus.ReadStatus(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally
    Screen.Cursor := crDefault;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetFilesInProjectGroupButNotCvs(fAllChecked: boolean);
begin
  DebugInfo('SetFilesInProjectGroupButNotCvs');
  Screen.Cursor := crHourGlass;
  try
    Clear;
    if ToolsApiHelper.HasProjectGroup then
    begin
      ToolsApiHelper.GetCurrentProjectGroupFiles(FFiles);
    end
    else
    begin
      ToolsApiHelper.GetCurrentProjectFiles(FFiles);
    end;
    FStatus.ReadStatus(FFiles, false);
    FStatus.GetFilesNotInCvs(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TFilesFrame.SetFilesInProjectButNotCvs(fAllChecked: boolean);
begin
  Screen.Cursor := crHourGlass;
  try
    Clear;
    ToolsApiHelper.GetCurrentProjectFiles(FFiles);
    FStatus.ReadStatus(FFiles, false);
    FStatus.GetFilesNotInCvs(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally
    Screen.Cursor := crDefault;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetFilesInCvsButNotProject(fAllChecked: boolean);
begin
  Screen.Cursor := crHourGlass;
  try
    Clear;
    ToolsApiHelper.GetCurrentProjectFiles(FFiles);
    FStatus.ReadStatus(FFiles);
    FStatus.GetFilesOnlyInCvs(FFiles);
    ShowFileStatus(FStatus, fAllChecked);
  finally

    Screen.Cursor := crDefault;
  end;
end;
//---------------------------------------------------------------------------

procedure TFilesFrame.SetFileStatus(filename: string; item: TListItem;
  projectstatus: TProjectStatus);
var
  filestatus: TCvsFileStatus;
  statstring: string;
begin