tcontrollerunit.pas

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

(* $Id: TControllerunit.pas,v 1.13 2003/01/08 19:42:37 turbo Exp $
 *
 * Central controller object. Gets all notifications and menu command requests,
 * and executes them
 *
 * Copyright 2001 by Thomas Bleier
 * For license details see LICENSE.txt
 *)

unit TControllerunit;
{$I BORCVS.inc}

interface
uses
  classes,
  menus,
  toolsapi;
//---------------------------------------------------------------------------
type
  TController = class(TObject)
  private
    FMenuItemHandlers: array of TNotifyEvent;
    function AddMenuItemHandler(t: TNotifyEvent): integer;
    procedure StartAllForms;
    procedure StopAllForms;
  protected
    PMenuNewModule, PMenuCheckout,
      PMenuCommand, PMenuPreferences, PMenuAbout: TMenuItem;

    PProjectGroupMenu, PProjectMenu, PFileMenu: TMenuItem;

    PMenuAddProjGroup,PMenuUpdateProjGroup, PMenuCommitProjGroup,
      PMenuTagBranchProjGroup, PMenuStatusProjGroup: TMenuItem;

    PMenuAddProj,PMenuUpdateProj, PMenuCommitProj,
      PMenuTagBranchProj, PMenuStatusProj: TMenuItem;

    PMenuAddFile,PMenuUpdateFile, PMenuCommitFile,
      PMenuRemoveFile,PMenuDiffFile, PMenuLogFile: TMenuItem;

    procedure MenuNewModuleClick(Sender: TObject);
    procedure MenuCheckoutClick(Sender: TObject);
    procedure MenuCommandClick(Sender: TObject);
    procedure MenuPreferencesClick(Sender: TObject);
    procedure MenuAboutClick(Sender: TObject);

    procedure MenuAddProjClick(Sender: TObject);
    procedure MenuUpdateProjClick(Sender: TObject);
    procedure MenuCommitProjClick(Sender: TObject);
    procedure MenuTagBranchProjClick(Sender: TObject);
    procedure MenuStatusProjClick(Sender: TObject);

    procedure MenuAddProjGroupClick(Sender: TObject);
    procedure MenuUpdateProjGroupClick(Sender: TObject);
    procedure MenuCommitProjGroupClick(Sender: TObject);
    procedure MenuTagBranchProjGroupClick(Sender: TObject);
    procedure MenuStatusProjGroupClick(Sender: TObject);

    procedure MenuAddFileClick(Sender: TObject);
    procedure MenuRemoveFileClick(Sender: TObject);
    procedure MenuUpdateFileClick(Sender: TObject);
    procedure MenuCommitFileClick(Sender: TObject);
    procedure MenuDiffFileClick(Sender: TObject);
    procedure MenuLogFileClick(Sender: TObject);

    function IsProjectInCvs(projectfile: string): boolean;
    procedure SetMenuState;
    function NewMenuItem(parent: TMenuItem; caption: string;
      name: string; onclick: TNotifyEvent; enabled: boolean = false): TMenuItem;
    procedure MenuItemHandlerWrapper(Sender: TObject);
  public
    constructor create;
    destructor destroy; override;
    procedure CreateCvsMenu(parent: TMenuItem);
  published
    procedure MenuDropdown(Sender: TObject);
  end;
//---------------------------------------------------------------------------

implementation
//---------------------------------------------------------------------------
uses
  windows,
  dialogs,
  SysUtils,
  Forms,
  TToolsApiHelperUnit,
  TPreferencesFrmUnit,
  TCvsCmdFrmUnit,
  TCheckoutFrmUnit,
  TNewModuleFrmUnit,
  TUpdateFrmUnit,
  TCommitFrmUnit,
  TFilesFrameunit,
  TTagBranchFrmUnit,
  TStatusFrmUnit,
  TDiffFrmunit,
  TLogFrmunit,
  TAddFrmunit,
  TRemoveFrmunit,
  TAboutFrmunit,
  SettingsStorage,
  UtilityUnit,
  PELDebugit;

constructor TController.create;
begin

  setlength(FMenuItemHandlers, 0);
{$IFDEF CreateFormsAtLoad}
  StartAllForms;
{$ENDIF}
end;
//---------------------------------------------------------------------------

destructor TController.destroy;
begin
  setlength(FMenuItemHandlers, 0);
{$IFDEF CreateFormsAtLoad}
  StopAllForms;
{$ENDIF}
end;
//---------------------------------------------------------------------------

procedure TController.StartAllForms;
var
  parent: tcomponent;
//  i: IOTAServices;
//  h: HWND;
begin
  parent := nil;
  PreferencesFrm := TPreferencesFrm.create(parent);
  CvsCmdFrm := TCvsCmdFrm.create(parent);
  CheckoutFrm := TCheckoutFrm.create(parent);
  NewModuleFrm := TNewModuleFrm.create(parent);
  UpdateFrm := TUpdateFrm.create(parent);
  CommitFrm := TCommitFrm.create(parent);
  TagBranchFrm := TTagBranchFrm.create(parent);
  StatusFrm := TStatusFrm.create(parent);
  DiffFrm := TDiffFrm.create(parent);
  LogFrm := TLogFrm.create(parent);
  AddFrm := TAddFrm.create(parent);
  RemoveFrm := TRemoveFrm.create(parent);
  if IsDLL then
  begin
  // set parent window of the forms (not owner) to IOTAServices.GetParentHandle
  // this must NOT be done if compiled to package !! / PEL 
(*
  i := BorlandIDEServices as IOTAServices;
  if assigned(i) then
  begin
    h := i.GetParentHandle;
    if h <> 0 then
    begin
      PreferencesFrm.ParentWindow := h;
      CvsCmdFrm.ParentWindow := h;
      CheckoutFrm.ParentWindow := h;
      NewModuleFrm.ParentWindow := h;
      UpdateFrm.ParentWindow := h;
      CommitFrm.ParentWindow := h;
      TagBranchFrm.ParentWindow := h;
      StatusFrm.ParentWindow := h;
      DiffFrm.ParentWindow := h;
      LogFrm.ParentWindow := h;
      AddFrm.ParentWindow := h;
      RemoveFrm.ParentWindow := h;
    end;
  end;
*)
  end;
end;

procedure TController.StopAllForms;
begin
  FreeAndNil(PreferencesFrm);
  FreeAndNil(CvsCmdFrm);
  FreeAndNil(CheckoutFrm);
  FreeAndNil(NewModuleFrm);
  FreeAndNil(UpdateFrm);
  FreeAndNil(CommitFrm);
  FreeAndNil(TagBranchFrm);
  FreeAndNil(StatusFrm);
  FreeAndNil(DiffFrm);
  FreeAndNil(LogFrm);
  FreeAndNil(AddFrm);
  FreeAndNil(RemoveFrm);
end;

procedure TController.MenuItemHandlerWrapper(Sender: TObject);
var
  item: TMenuItem;
  handler: TNotifyEvent;
begin
//   this wrapper ensures that exceptions, which the rest of this wizard
//   may throw, are catched before they reach the IDE, and that
//   a valid ToolsApiHelper object exists, which many other objects
//   (including this one) use
  try
//BUGS in D7  ->
//    item := Sender as TMenuItem;
//
    item := TMenuItem(Sender);
    if assigned(item) then
    begin
      assert(ToolsApiHelper = nil);
{$IFNDEF CreateFormsAtLoad}
      StartAllForms;
{$ENDIF}
      ToolsApiHelper := TToolsApiHelper.create;
      try
        handler := FMenuItemHandlers[item.Tag];
// added check /Per-Eric
        if assigned(handler) then
        begin
          handler(Sender);
        end;
      finally
{$IFNDEF CreateFormsAtLoad}
        StopAllForms;
{$ENDIF}
        ToolsApiHelper.Free;
        ToolsApiHelper := nil;
      end;
    end
    else
      ShowMessage('BorCVS Internal Error: no menu item?');
  except
    on e: EAbort do {}
      ;
    on e: Exception do
      Application.ShowException(e);
  else
    MessageDlg('BorCVS Internal Error: unknown Exception raised!', mtError,
      [mbOK], 0);
  end;
end;
//---------------------------------------------------------------------------

function TController.AddMenuItemHandler(t: TNotifyEvent): integer;
var
  i: integer;
begin
  i := High(FMenuItemHandlers);
  result := i + 1;
  SetLength(FMenuItemHandlers, result + 1);
  FMenuItemHandlers[result] := t;
end;
//---------------------------------------------------------------------------

function TController.NewMenuItem(parent: TMenuItem; caption: string;
  name: string; onclick: TNotifyEvent; enabled: boolean = false): TMenuItem;
begin
  result := TMenuItem.Create(parent);
  result.Caption := caption;
  result.Name := name;
  result.OnClick := MenuItemHandlerWrapper;
  result.Tag := AddMenuItemHandler(OnClick);
  result.Enabled := enabled;
  parent.Add(result);
end;
//---------------------------------------------------------------------------

procedure TController.CreateCvsMenu(parent: TMenuItem);
begin
  // set parent handler, via wrapper
  parent.OnClick := MenuItemHandlerWrapper;
  parent.Tag := AddMenuItemHandler(MenuDropdown);

  // create menu items
  PMenuNewModule := NewMenuItem(parent, 'New module...', 'CvsNewModule',
    MenuNewModuleClick);
  PMenuCheckout := NewMenuItem(parent, 'Checkout...', 'CvsCheckout',
    MenuCheckoutClick, true);
  NewMenuItem(parent, '-', 'CVSSep1', nil);
  PMenuCommand := NewMenuItem(parent, 'CVS command...', 'CvsCommand',
    MenuCommandClick, true);
  PMenuPreferences := NewMenuItem(parent, 'Preferences...', 'CvsPreferences',
    MenuPreferencesClick, true);
  PMenuAbout := NewMenuItem(parent, 'About...', 'CvsAbout',
    MenuAboutClick, true);
  NewMenuItem(parent, '-', 'CVSSep2', nil);

  PProjectGroupMenu := NewMenuItem(parent, 'Project Group ...', 'CvsProjGroupMenu',
    nil, false);
  PMenuAddProjGroup := NewMenuItem(PProjectGroupMenu, 'Add...', 'CvsAddProjGroup',
    MenuAddProjGroupClick, true);
  PMenuUpdateProjGroup := NewMenuItem(PProjectGroupMenu, 'Update project Group...', 'CvsUpdateProjGroup',
    MenuUpdateProjGroupClick, true);
  PMenuCommitProjGroup := NewMenuItem(PProjectGroupMenu, 'Commit project Group...', 'CvsCommitProjGroup',
    MenuCommitProjGroupClick, true);
  PMenuTagBranchProjGroup := NewMenuItem(PProjectGroupMenu, 'Tag/Branch Group...', 'CvsTagBranchProjGroup',
    MenuTagBranchProjGroupClick, true);
  PMenuStatusProjGroup := NewMenuItem(PProjectGroupMenu, 'Status Group...', 'CvsStatusProjGroup',
    MenuStatusProjGroupClick, true);

  PProjectMenu := NewMenuItem(parent, 'Project ...', 'CvsProjMenu',
    nil, false);

  PMenuAddProj := NewMenuItem(PProjectMenu, 'Add...', 'CvsAddProj',
    MenuAddProjClick, true);
  PMenuUpdateProj := NewMenuItem(PProjectMenu, 'Update project...', 'CvsUpdateProj',
    MenuUpdateProjClick, true);
  PMenuCommitProj := NewMenuItem(PProjectMenu, 'Commit project...', 'CvsCommitProj',
    MenuCommitProjClick, true);
  PMenuTagBranchProj := NewMenuItem(PProjectMenu, 'Tag/Branch...', 'CvsTagBranchProj',
    MenuTagBranchProjClick, true);
  PMenuStatusProj := NewMenuItem(PProjectMenu, 'Status...', 'CvsStatusProj',
    MenuStatusProjClick, true);

  PFileMenu := NewMenuItem(parent, 'File...', 'CvsFileMenu',
    nil, false);
  PMenuAddFile := NewMenuItem(PFileMenu, 'Add...', 'CvsAddFile',
    MenuAddFileClick, true);
  PMenuRemoveFile := NewMenuItem(PFileMenu, 'Remove...', 'CvsRemoveFile',
    MenuRemoveFileClick, true);
  PMenuUpdateFile := NewMenuItem(PFileMenu, 'Update...', 'CvsUpdateFile',
    MenuUpdateFileClick, true);