Componentes.Terceros.jcl/official/2.1.1/experts/versioncontrol/JclVersionControlImpl.pas

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is VersionControlImpl.pas                                                      }
{                                                                                                  }
{ The Initial Developer of the Original Code is Elahn Ientile.                                     }
{ Portions created by Elahn Ientile are Copyright (C) of Elahn Ientile.                            }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Florent Ouchet (outchy)                                                                        }
{   Sandeep Chandra                                                                                }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date:: 2009-10-16 19:11:39 +0200 (ven., 16 oct. 2009)                          $ }
{ Revision:      $Rev:: 3044                                                                     $ }
{ Author:        $Author:: outchy                                                                $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclVersionControlImpl;

{$I jcl.inc}

interface

uses
  SysUtils, Classes, Graphics, Controls, Menus, ActnList, Dialogs,
  ToolsAPI,
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JclVersionControl,
  JclOtaUtils, JclVersionCtrlCommonOptions;

type
  TJclVersionControlStandardAction = class(TCustomAction)
  private
    FControlAction: TJclVersionControlActionType;
  public
    property ControlAction: TJclVersionControlActionType read FControlAction write FControlAction;
  end;

  TJclVersionControlDropDownAction = class(TDropDownAction)
  private
    FControlAction: TJclVersionControlActionType;
  public
    property ControlAction: TJclVersionControlActionType read FControlAction write FControlAction;
  end;

  TJclVersionControlExpert = class (TJclOTAExpert)
  private
    FVersionCtrlMenu: TMenuItem;
    FActions: array [TJclVersionControlActionType] of TCustomAction;
    FIconIndexes: array [TJclVersionControlActionType] of Integer;
    FHideActions: Boolean;
    FIconType: TIconType;
    FActOnTopSandbox: Boolean;
    FSaveConfirmation: Boolean;
    FDisableActions: Boolean;
    FOptionsFrame: TJclVersionCtrlOptionsFrame;
    FMenuOrganization: TStringList;
    procedure SetIconType(const Value: TIconType);

    procedure ActionUpdate(Sender: TObject);
    procedure ActionExecute(Sender: TObject);
    procedure IDEActionMenuClick(Sender: TObject);
    procedure SubItemClick(Sender: TObject);
    procedure DropDownMenuPopup(Sender: TObject);
    procedure IDEVersionCtrlMenuClick(Sender: TObject);
    procedure RefreshIcons;
    procedure RefreshMenu;
    function GetCurrentCache: TJclVersionControlCache;
    function GetCurrentPlugin: TJclVersionControlPlugin;
    function GetCurrentFileName: string;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure RegisterCommands; override;
    procedure UnregisterCommands; override;
    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
    function SaveModules(const FileName: string;
      const IncludeSubDirectories: Boolean): Boolean;

    property ActOnTopSandbox: Boolean read FActOnTopSandbox write FActOnTopSandbox;
    property DisableActions: Boolean read FDisableActions write FDisableActions;
    property HideActions: Boolean read FHideActions write FHideActions;
    property SaveConfirmation: Boolean read FSaveConfirmation write FSaveConfirmation;
    property IconType: TIconType read FIconType write SetIconType;
    property CurrentCache: TJclVersionControlCache read GetCurrentCache;
    property CurrentPlugin: TJclVersionControlPlugin read GetCurrentPlugin;
    property CurrentFileName: string read GetCurrentFileName;
  end;

// design package entry point
procedure Register;

// expert DLL entry point
function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
  RegisterProc: TWizardRegisterProc;
  var TerminateProc: TWizardTerminateProc): Boolean; stdcall;

function GetItemIndexA(const Item: string): Integer;
function GetItemIndexB(const Item: string): Integer;
function GetItemName(const Item: string): string;

function CharIsAmpersand(const C: Char): Boolean;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/experts/versioncontrol/JclVersionControlImpl.pas $';
    Revision: '$Revision: 3044 $';
    Date: '$Date: 2009-10-16 19:11:39 +0200 (ven., 16 oct. 2009) $';
    LogPath: 'JCL\experts\versioncontrol';
    Extra: '';
    Data: nil
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  Windows, Forms, TypInfo, ImgList,
  JclDebug, JclFileUtils, JclRegistry, JclShell, JclStrings,
  JclOtaConsts, JclOtaResources,
  JclVersionCtrlSVNImpl,
  JclVersionCtrlCVSImpl;

{$R JclVersionCtrlIcons.RES}

const
  IconNames: array [TJclVersionControlActionType] of PChar =
    ( 'FILEADD',         // vcaAdd
      'SANDBOXADD',      // vcaAddSandbox
      'FILEBLAME',       // vcaBlame
      'FILEBRANCH',      // vcaBranch
      'SANDBOXBRANCH',   // vcaBranchSandbox
      'SANDBOXCHECKOUT', // vcaCheckOutSandbox
      'FILECOMMIT',      // vcaCommit
      'SANDBOXCOMMIT',   // vcaCommitSandbox
      'CONTEXTMENU',     // vcaContextMenu
      'FILEDIFF',        // vcaDiff
      'EXPLORE',         // vcaExplore
      'EXPLORE',         // vcaExploreSandbox
      'FILEGRAPH',       // vcaGraph
      'FILELOG',         // vcaLog
      'SANDBOXLOG',      // vcaLogSandbox
      'FILELOCK',        // vcaLock
      'SANDBOXLOCK',     // vcaLockSandbox
      'FILEMERGE',       // vcaMerge
      'SANDBOXMERGE',    // vcaMergeSandbox
      'PROPERTIES',      // vcaProperties
      'PROPERTIES',      // vcaPropertiesSandbox
      'FILERENAME',      // vcaRename
      'SANDBOXRENAME',   // vcaRenameSandbox
      'REPOBROWSER',     // vcaRepoBrowser
      'FILEREVERT',      // vcaRevert
      'SANDBOXREVERT',   // vcaRevertSandbox
      'STATUS',          // vcaStatus
      'STATUS',          // vcaStatusSandbox
      'FILETAG',         // vcaTag
      'SANDBOXTAG',      // vcaTagSandBox
      'FILEUPDATE',      // vcaUpdate
      'SANDBOXUPDATE',   // vcaUpdateSandbox
      'FILEUPDATE',      // vcaUpdateTo
      'SANDBOXUPDATE',   // vcaUpdateSandboxTo
      'FILEUNLOCK',      // vcaUnlock
      'SANDBOXUNLOCK');  // vcaUnlockSandbox


function CharIsAmpersand(const C: Char): Boolean;
begin
  Result := C = '&';
end;

procedure Register;
begin
  try
    RegisterPackageWizard(TJclVersionControlExpert.Create);
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

var
  JCLWizardIndex: Integer = -1;

procedure JclWizardTerminate;
begin
  try
    if JCLWizardIndex <> -1 then
      TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
    RegisterProc: TWizardRegisterProc;
    var TerminateProc: TWizardTerminateProc): Boolean stdcall;
begin
  try
    TerminateProc := JclWizardTerminate;

    JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclVersionControlExpert.Create);

    Result := True;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      Result := False;
    end;
  end;
end;

function GetItemIndexA(const Item: string): Integer;
var
  Index: Integer;
begin
  Result := 0;
  for Index := 1 to Length(Item) do
    if not CharIsDigit(Item[Index]) then
  begin
    Result := StrToInt(Copy(Item, 1, Index - 1));
    Exit;
  end;
  Abort;
end;

function GetItemIndexB(const Item: string): Integer;
var
  Index: Integer;
begin
  Result := -1;
  for Index := Length(Item) downto 1 do
    if not CharIsDigit(Item[Index]) then
  begin
    if Index < Length(Item) then
      Result := StrToInt(Copy(Item, Index + 1, Length(Item) - Index));
    Exit;
  end;
end;

function GetItemName(const Item: string): string;
var
  Index1, Index2: Integer;
begin
  for Index1 := 1 to Length(Item) do
    if not CharIsDigit(Item[Index1]) then
  begin
    if Index1 = 1 then
      Abort;
    Break;
  end;

  for Index2 := Length(Item) downto 1 do
    if not CharIsDigit(Item[Index2]) then
      Break;

  Result := Copy(Item, Index1, Index2 - Index1 + 1);
end;

function MenuOrganizationSort(List: TStringList; Index1, Index2: Integer): Integer;
var
  Item1, Item2: string;
  Index1A, Index1B, Index2A, Index2B: Integer;
begin
  Item1 := List.Strings[Index1];
  Item2 := List.Strings[Index2];
  Index1A := GetItemIndexA(Item1);
  Index1B := GetItemIndexB(Item1);
  Index2A := GetItemIndexA(Item2);
  Index2B := GetItemIndexB(Item2);

  if Index1A < Index2A then
    Result := -1
  else
  if Index1A > Index2A then
    Result := 1
  else
  if Index1B < Index2B then
    Result := -1
  else
  if Index1B > Index2B then
    Result := 1
  else
    Result := 0;
end;

function ActionToControlAction(AAction: TCustomAction): TJclVersionControlActionType;
begin
  if AAction is TJclVersionControlDropDownAction then
    Result := TJclVersionControlDropDownAction(AAction).ControlAction
  else
  if AAction is TJclVersionControlStandardAction then
    Result := TJclVersionControlStandardAction(AAction).ControlAction
  else
    raise EJclExpertException.CreateRes(@RsEInvalidAction);
end;

//=== { TJclVersionControlExpert } ===================================================

procedure TJclVersionControlExpert.ActionExecute(Sender: TObject);
var
  Index: Integer;
  AAction: TCustomAction;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  APlugin: TJclVersionControlPlugin;
  AFileName: string;
  AFileCache: TJclVersionControlCache;
  PluginList: TJclVersionControlPluginList;
begin
  try
    AAction := Sender as TCustomAction;
    ControlAction := ActionToControlAction(AAction);
    ControlActionInfo := VersionControlActionInfo(ControlAction);

    if ControlActionInfo.Sandbox then
    begin
      AFileCache := CurrentCache;
      if not Assigned(AFileCache) or ControlActionInfo.AllPlugins then
        Exit;
      if ActOnTopSandbox then
      begin
        for Index := AFileCache.SandboxCount - 1 downto 0 do
          if ControlAction in AFileCache.SandboxActions[Index] then
        begin
          if ControlActionInfo.SaveFile then
            SaveModules(AFileCache.SandBoxes[Index], True);
          AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
          Exit;
        end;
      end
      else
      begin
        for Index := 0 to AFileCache.SandboxCount - 1 do
          if ControlAction in AFileCache.SandboxActions[Index] then
        begin
          if ControlActionInfo.SaveFile then
            SaveModules(AFileCache.SandBoxes[Index], True);
          AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
          Exit;
        end;
      end;
    end
    else
    begin
      AFileName := CurrentFileName;
      if ControlActionInfo.SaveFile then
        SaveModules(AFileName, False);

      if ControlActionInfo.AllPlugins then
      begin
        PluginList := VersionControlPluginList;
        for Index := 0 to PluginList.Count - 1 do
        begin
          AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[Index]);

          if ControlAction in AFileCache.Actions then
          begin
            AFileCache.Plugin.ExecuteAction(AFileName, ControlAction);
            Exit;
          end;
        end;
      end
      else
      begin
        APlugin := CurrentPlugin;
        if Assigned(APlugin) then
          APlugin.ExecuteAction(AFileName, ControlAction);
      end;
    end;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

procedure TJclVersionControlExpert.ActionUpdate(Sender: TObject);
var
  IndexSandbox, IndexPlugin: Integer;
  AAction: TCustomAction;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  AFileCache: TJclVersionControlCache;
  AFileName: string;
  PluginList: TJclVersionControlPluginList;
begin
  try
    AAction := Sender as TCustomAction;
    ControlAction := ActionToControlAction(AAction);
    ControlActionInfo := VersionControlActionInfo(ControlAction);
    AFileCache := CurrentCache;

    if HideActions and not ControlActionInfo.AllPlugins then
      AAction.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
        and (ControlAction in AFileCache.Plugin.SupportedActionTypes)
    else
      AAction.Visible := True;

    if DisableActions then
    begin
      if ControlActionInfo.Sandbox then
      begin
        if ControlActionInfo.AllPlugins then
        begin
          PluginList := VersionControlPluginList;
          AFileName := CurrentFileName;
          for IndexPlugin := 0 to PluginList.Count - 1 do
          begin
            AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
            for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
              if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
            begin
              AAction.Enabled := True;
              Exit;
            end;
            AAction.Enabled := False;
            Exit;
          end;
        end
        else // work for all plugin
        begin
          if Assigned(AFileCache) then
          begin
            for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
              if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
            begin
              AAction.Enabled := True;
              Exit;
            end;
            AAction.Enabled := False;
            Exit;
          end
          else
            AAction.Enabled := False;
        end;
        Exit;
      end
      else // file
      begin
        if ControlActionInfo.AllPlugins then
        begin
          PluginList := VersionControlPluginList;
          AFileName := CurrentFileName;
          for IndexPlugin := 0 to PluginList.Count - 1 do
          begin
            AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
            if ControlAction in AFileCache.Actions then
            begin
              AAction.Enabled := True;
              Exit;
            end;
          end;
          AAction.Enabled := False;
          Exit;
        end
        else // only the current plugin
        begin
          AFileCache := CurrentCache;
          AAction.Enabled := Assigned(AFileCache) and (ControlAction in AFileCache.Actions);
        end;
      end;
    end
    else
      AAction.Enabled := True;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

procedure TJclVersionControlExpert.AddConfigurationPages(
  AddPageFunc: TJclOTAAddPageFunc);
begin
  inherited AddConfigurationPages(AddPageFunc);
  FOptionsFrame := TJclVersionCtrlOptionsFrame.Create(nil);
  FOptionsFrame.DisableActions := DisableActions;
  FOptionsFrame.HideActions := HideActions;
  FOptionsFrame.SaveConfirmation := SaveConfirmation;
  FOptionsFrame.ActOnTopSandbox := ActOnTopSandbox;
  FOptionsFrame.SetActions(FActions);
  // after SetActions
  FOptionsFrame.MenuTree := FMenuOrganization;
  FOptionsFrame.IconType := IconType;
  AddPageFunc(FOptionsFrame, LoadResString(@RsVersionControlSheet), Self);
end;

procedure TJclVersionControlExpert.ConfigurationClosed(AControl: TControl;
  SaveChanges: Boolean);
begin
  if (AControl = FOptionsFrame) and Assigned(FOptionsFrame) then
  begin
    if SaveChanges then
    begin
      DisableActions := FOptionsFrame.DisableActions;
      HideActions := FOptionsFrame.HideActions;
      SaveConfirmation := FOptionsFrame.SaveConfirmation;
      ActOnTopSandbox := FOptionsFrame.ActOnTopSandbox;
      FMenuOrganization.Assign(FOptionsFrame.MenuTree);
      IconType := FOptionsFrame.IconType;
      RefreshMenu;
    end;
    FreeAndNil(FOptionsFrame);
  end
  else
    inherited ConfigurationClosed(AControl, SaveChanges);
end;

constructor TJclVersionControlExpert.Create;
begin
  FMenuOrganization := TStringList.Create;

  inherited Create('JclVersionControlExpert');
end;

destructor TJclVersionControlExpert.Destroy;
begin
  inherited Destroy;
  FMenuOrganization.Free;
end;

procedure TJclVersionControlExpert.DropDownMenuPopup(Sender: TObject);
var
  APopupMenu: TPopupMenu;
  AMenuItem: TMenuItem;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  AFileCache: TJclVersionControlCache;
  IndexPlugin, IndexSandbox: Integer;
  AFileName: string;
  PluginList: TJclVersionControlPluginList;
begin
  try
    APopupMenu := Sender as TPopupMenu;
    ControlAction := TJclVersionControlActionType(APopupMenu.Tag);
    ControlActionInfo := VersionControlActionInfo(ControlAction);

    APopupMenu.Items.Clear;

    if ControlActionInfo.AllPlugins then
    begin
      PluginList := VersionControlPluginList;
      AFileName := CurrentFileName;
      for IndexPlugin := 0 to PluginList.Count - 1 do
      begin
        AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
        for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
          if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
        begin
          AMenuItem := TMenuItem.Create(APopupMenu.Items);
          AMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]);
          AMenuItem.Tag := APopupMenu.Tag;
          AMenuItem.OnClick := SubItemClick;
          case IconType of
            itNone:
              AMenuItem.ImageIndex := -1;
            itJCL:
              AMenuItem.ImageIndex := FIconIndexes[ControlAction];
          end;
          APopupMenu.Items.Add(AMenuItem);
        end;
      end;
    end
    else
    begin
      AFileCache := CurrentCache;
      if Assigned(AFileCache) then
        for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
          if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
      begin
        AMenuItem := TMenuItem.Create(APopupMenu.Items);
        AMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox];
        AMenuItem.Tag := APopupMenu.Tag;
        AMenuItem.OnClick := SubItemClick;
        case IconType of
          itNone:
            AMenuItem.ImageIndex := -1;
          itJCL:
            AMenuItem.ImageIndex := FIconIndexes[ControlAction];
        end;
        APopupMenu.Items.Add(AMenuItem);
      end;
    end;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

function TJclVersionControlExpert.GetCurrentCache: TJclVersionControlCache;
var
  Index: Integer;
  AFileName: string;
  PluginList: TJclVersionControlPluginList;
begin
  PluginList := VersionControlPluginList;
  AFileName := CurrentFileName;
  for Index := 0 to PluginList.Count - 1 do
  begin
    Result := PluginList.GetFileCache(AFileName, PluginList.Plugins[Index]);
    if Result.Supported then
      Exit;
  end;
  Result := nil;
end;

function TJclVersionControlExpert.GetCurrentFileName: string;
var
  AOTAModule: IOTAModule;
begin
  AOTAModule := GetOTAModuleServices.CurrentModule;
  //SC  20/03/2007
  if Assigned(AOTAModule) and Assigned(AOTAModule.CurrentEditor) then
  begin
    Result := AOTAModule.CurrentEditor.FileName;
    Exit;
  end
  //SC  20/03/2007
  else
  if Assigned(AOTAModule) and (AOTAModule.FileSystem = '') then
    Result := AOTAModule.FileName
  else
    Result := '';
end;

function TJclVersionControlExpert.GetCurrentPlugin: TJclVersionControlPlugin;
var
  Index: Integer;
  AFileCacheInfo: TJclVersionControlCache;
  AFileName: string;
  PluginList: TJclVersionControlPluginList;
begin
  PluginList := VersionControlPluginList;
  AFileName := CurrentFileName;
  for Index := 0 to PluginList.Count - 1 do
  begin
    Result := TJclVersionControlPlugin(PluginList.Plugins[Index]);
    AFileCacheInfo := PluginList.GetFileCache(AFileName, Result);
    if AFileCacheInfo.Supported then
      Exit;
  end;
  Result := nil;
end;

procedure TJclVersionControlExpert.IDEActionMenuClick(Sender: TObject);
var
  AMenuItem, SubMenuItem: TMenuItem;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  IndexSandbox, IndexPlugin, IndexItem: Integer;
  AFileCache: TJclVersionControlCache;
  AFileName: string;
  PluginList: TJclVersionControlPluginList;
begin
  try
    AMenuItem := Sender as TMenuItem;
    // do not delete the dummy subitem
    for IndexItem := AMenuItem.Count - 1 downto 1 do
      AMenuItem.Items[IndexItem].Free;
    ControlAction := TJclVersionControlActionType(AMenuItem.Tag);
    ControlActionInfo := VersionControlActionInfo(ControlAction);

    if ControlActionInfo.AllPlugins then
    begin
      PluginList := VersionControlPluginList;
      for IndexPlugin := 0 to PluginList.Count - 1 do
      begin
        AFileName := CurrentFileName;
        AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
        for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
          if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
        begin
          SubMenuItem := TMenuItem.Create(AMenuItem);
          SubMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]);
          SubMenuItem.Tag := Integer(ControlAction);
          SubMenuItem.OnClick := SubItemClick;
          case IconType of
            itNone:
              SubMenuItem.ImageIndex := -1;
            itJCL:
              SubMenuItem.ImageIndex := FIconIndexes[ControlAction];
          end;
          AMenuItem.Add(SubMenuItem);
        end;
      end;
    end
    else
    begin
      AFileCache := CurrentCache;

      if Assigned(AFileCache) then
        for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
          if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
      begin
        SubMenuItem := TMenuItem.Create(AMenuItem);
        SubMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox];
        SubMenuItem.Tag := Integer(ControlAction);
        SubMenuItem.OnClick := SubItemClick;
        case IconType of
          itNone:
            SubMenuItem.ImageIndex := -1;
          itJCL:
            SubMenuItem.ImageIndex := FIconIndexes[ControlAction];
        end;
        AMenuItem.Add(SubMenuItem);
      end;
    end;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

procedure TJclVersionControlExpert.IDEVersionCtrlMenuClick(Sender: TObject);
  procedure UpdateMenuItem(const AMenuItem: TMenuItem);
  var
    BMenuItem: TMenuItem;
    IndexMenu, IndexSandbox: Integer;
    ControlAction: TJclVersionControlActionType;
    ControlActionInfo: TJclVersionControlActionInfo;
    AFileCache: TJclVersionControlCache;
    AEnabled: Boolean;
    IndexPlugin: Integer;
    AFileName: string;
    PluginList: TJclVersionControlPluginList;
  begin
    for IndexMenu := 0 to AMenuItem.Count - 1 do
    begin
      BMenuItem := AMenuItem.Items[IndexMenu];
      if BMenuItem.Tag = -1 then
        UpdateMenuItem(BMenuItem)
      else
      if BMenuItem.Tag >= 0 then
      begin
        ControlAction := TJclVersionControlActionType(BMenuItem.Tag);
        ControlActionInfo := VersionControlActionInfo(ControlAction);
        if ControlActionInfo.Sandbox then
        begin
          AFileCache := CurrentCache;

          case IconType of
            itNone:
              BMenuItem.ImageIndex := -1;
            itJCL:
              BMenuItem.ImageIndex := FIconIndexes[ControlAction];
          end;

          if HideActions and not ControlActionInfo.AllPlugins then
            BMenuItem.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
              and (ControlAction in AFileCache.Plugin.SupportedActionTypes)
          else
            BMenuItem.Visible := True;

          if DisableActions then
          begin
            AEnabled := False;
            if ControlActionInfo.AllPlugins then
            begin
              PluginList := VersionControlPluginList;
              AFileName := CurrentFileName;
              for IndexPlugin := 0 to PluginList.Count - 1 do
              begin
                AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
                for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
                  if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
                begin
                  AEnabled := True;
                  Break;
                end;

                if AEnabled then
                  Break;
              end;
            end
            else
            if Assigned(AFileCache) then
            begin
              for IndexSandbox := 0 to AFileCache.SandboxCount - 1 do
                if ControlAction in AFileCache.SandboxActions[IndexSandbox] then
              begin
                AEnabled := True;
                Break;
              end;
            end;
            BMenuItem.Enabled := AEnabled;
          end
          else
            BMenuItem.Enabled := True;
        end;
      end;
    end;
  end;
begin
  try
    UpdateMenuItem(FVersionCtrlMenu);
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

procedure TJclVersionControlExpert.RefreshIcons;
var
  ControlAction: TJclVersionControlActionType;
begin
  for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
    if Assigned(FActions[ControlAction]) then
  begin
    case IconType of
      // No icon
      itNone :
        FActions[ControlAction].ImageIndex := -1;
      // JCL icons
      itJCL :
        FActions[ControlAction].ImageIndex := FIconIndexes[ControlAction];
    end;
  end;
end;

procedure TJclVersionControlExpert.RefreshMenu;
  procedure LoadDefaultMenu;
  var
    Action: TJclVersionControlActionType;
  begin
    FMenuOrganization.Clear;
    for Action := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
      FMenuOrganization.Add(Format('%d%s', [Integer(Action), GetEnumName(TypeInfo(TJclVersionControlActionType), Integer(Action))]));
  end;
var
  Index, IndexA, IndexB, ActionIndex: Integer;
  SubMenuItem, ActionMenuItem, DummyMenuItem: TMenuItem;
  Item, ItemName: string;
  AAction: TCustomAction;
begin
  FVersionCtrlMenu.Clear;

  if FMenuOrganization.Count > 0 then
  try
    FMenuOrganization.CustomSort(MenuOrganizationSort);
  except
    LoadDefaultMenu;
  end
  else
    LoadDefaultMenu;

  SubMenuItem := nil;
  for Index := 0 to FMenuOrganization.Count - 1 do
  begin
    Item := FMenuOrganization.Strings[Index];
    IndexA := GetItemIndexA(Item);
    IndexB := GetItemIndexB(Item);
    ItemName := GetItemName(Item);
    ActionIndex := GetEnumValue(TypeInfo(TJclVersionControlActionType), ItemName);

    if IndexB = -1 then
    begin
      if FVersionCtrlMenu.Count <> IndexA then
        Abort;

      if (ActionIndex = -1) or (ItemName = '-') then
      begin
        SubMenuItem := TMenuItem.Create(FVersionCtrlMenu);
        SubMenuItem.Caption := ItemName;
        SubMenuItem.Tag := -1;
        FVersionCtrlMenu.Add(SubMenuItem);
      end
      else
      begin
        ActionMenuItem := TMenuItem.Create(FVersionCtrlMenu);
        AAction := FActions[TJclVersionControlActionType(ActionIndex)];
        if VersionControlActionInfo(TJclVersionControlActionType(ActionIndex)).Sandbox then
        begin
          ActionMenuItem.Caption := AAction.Caption;
          ActionMenuItem.ShortCut := AAction.ShortCut;
          ActionMenuItem.ImageIndex := AAction.ImageIndex;
          ActionMenuItem.Tag := ActionIndex;
          ActionMenuItem.OnClick := IDEActionMenuClick;

          // to always have the arrow in the parent menu item
          DummyMenuItem := TMenuItem.Create(ActionMenuItem);
          DummyMenuItem.Visible := False;
          DummyMenuItem.Tag := -2;
          ActionMenuItem.Add(DummyMenuItem);
        end
        else
          ActionMenuItem.Action := AAction;
        FVersionCtrlMenu.Add(ActionMenuItem);
        SubMenuItem := nil;
      end;
    end
    else
    begin
      if (not Assigned(SubMenuItem)) or (SubMenuItem.Count <> IndexB) then
        Abort;
      if (ActionIndex = -1) or (ItemName = '-') then
      begin
        ActionMenuItem := TMenuItem.Create(FVersionCtrlMenu);
        ActionMenuItem.Caption := ItemName;
      end
      else
      begin
        ActionMenuItem := TMenuItem.Create(FVersionCtrlMenu);
        AAction := FActions[TJclVersionControlActionType(ActionIndex)];
        if VersionControlActionInfo(TJclVersionControlActionType(ActionIndex)).Sandbox then
        begin
          ActionMenuItem.Caption := AAction.Caption;
          ActionMenuItem.ShortCut := AAction.ShortCut;
          ActionMenuItem.ImageIndex := AAction.ImageIndex;
          ActionMenuItem.Tag := ActionIndex;
          ActionMenuItem.OnClick := IDEActionMenuClick;

          // to always have the arrow in the parent menu item
          DummyMenuItem := TMenuItem.Create(ActionMenuItem);
          DummyMenuItem.Visible := False;
          DummyMenuItem.Tag := -2;
          ActionMenuItem.Add(DummyMenuItem);
        end
        else
          ActionMenuItem.Action := AAction;
      end;
      SubMenuItem.Add(ActionMenuItem);
    end;
  end;
end;

procedure TJclVersionControlExpert.RegisterCommands;
var
  IDEMainMenu: TMainMenu;
  IDEToolsItem: TMenuItem;
  IDEImageList: TCustomImageList;
  IDEActionList: TCustomActionList;
  I: Integer;
  AStandardAction: TJclVersionControlStandardAction;
  ADropDownAction: TJclVersionControlDropDownAction;
  AAction: TCustomAction;
  IconTypeStr: string;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  NTAServices: INTAServices;
  AIcon: TIcon;
begin
  inherited RegisterCommands;
  NTAServices := GetNTAServices;

  Settings.LoadStrings(JclVersionCtrlMenuOrganizationName, FMenuOrganization);
  SaveConfirmation := Settings.LoadBool(JclVersionCtrlSaveConfirmationName, True);
  DisableActions := Settings.LoadBool(JclVersionCtrlDisableActionsName, True);
  HideActions := Settings.LoadBool(JclVersionCtrlHideActionsName, False);
  IconTypeStr := Settings.LoadString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeAutoValue);
  ActOnTopSandbox := Settings.LoadBool(JclVersionCtrlActOnTopSandboxName, False);

  FIconType := itJCL;
  if IconTypeStr = JclVersionCtrlIconTypeNoIconValue then
    FIconType := itNone
  else
  if IconTypeStr = JclVersionCtrlIconTypeJclIconValue then
    FIconType := itJCL;

  IDEImageList := NTAServices.ImageList;
  AIcon := TIcon.Create;
  try
    for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
    begin
      AIcon.Handle := LoadIcon(HInstance, IconNames[ControlAction]);
      FIconIndexes[ControlAction] := IDEImageList.AddIcon(AIcon);
    end;
  finally
    AIcon.Free;
  end;

  IDEMainMenu := NTAServices.MainMenu;
  IDEToolsItem := nil;
  for I := 0 to IDEMainMenu.Items.Count - 1 do
    if IDEMainMenu.Items[I].Name = 'ToolsMenu' then
  begin
    IDEToolsItem := IDEMainMenu.Items[I];
    Break;
  end;
  if not Assigned(IDEToolsItem) then
    raise EJclExpertException.CreateRes(@RsENoToolsMenuItem);

  IDEActionList := NTAServices.ActionList;

  FVersionCtrlMenu := TMenuItem.Create(nil);
  FVersionCtrlMenu.Caption := LoadResString(@RsVersionCtrlMenuCaption);
  FVersionCtrlMenu.Name := JclVersionCtrlMenuName;
  FVersionCtrlMenu.OnClick := IDEVersionCtrlMenuClick;
  IDEMainMenu.Items.Insert(IDEToolsItem.MenuIndex + 1, FVersionCtrlMenu);
  if not Assigned(FVersionCtrlMenu.Parent) then
    raise EJclExpertException.CreateResFmt(@RsSvnMenuItemNotInserted, [FVersionCtrlMenu.Caption]);

  for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
  begin
    ControlActionInfo := VersionControlActionInfo(ControlAction);

    if ControlActionInfo.Sandbox then
    begin
      ADropDownAction := TJclVersionControlDropDownAction.Create(nil);
      ADropDownAction.ControlAction := ControlAction;
      ADropDownAction.DropdownMenu := TPopupMenu.Create(nil);
      ADropDownAction.DropdownMenu.AutoPopup := True;
      ADropDownAction.DropdownMenu.AutoHotkeys := maManual;
      ADropDownAction.DropdownMenu.Tag := Integer(ControlAction);
      ADropDownAction.DropdownMenu.OnPopup := DropDownMenuPopup;
      AAction := ADropDownAction;
    end
    else
    begin
      AStandardAction := TJclVersionControlStandardAction.Create(nil);
      AStandardAction.ControlAction := ControlAction;
      AAction := AStandardAction;
    end;

    AAction.Caption := LoadResString(ControlActionInfo.Caption);
    AAction.Name := ControlActionInfo.ActionName;
    AAction.Visible := True;
    AAction.ActionList := IDEActionList;
    AAction.OnExecute := ActionExecute;
    AAction.OnUpdate := ActionUpdate;
    AAction.Category := LoadResString(@RsActionCategory);
    RegisterAction(AAction);
    FActions[ControlAction] := AAction;
  end;

  RefreshIcons;

  RefreshMenu;
end;

function TJclVersionControlExpert.SaveModules(const FileName: string;
  const IncludeSubDirectories: Boolean): Boolean;
var
  Module: IOTAModule;
  Index: Integer;
  Save: Boolean;
  OTAModuleServices: IOTAModuleServices;
begin
  Result := True;
  OTAModuleServices := GetOTAModuleServices;

  for Index := 0 to OTAModuleServices.ModuleCount - 1 do
  begin
    Module := OTAModuleServices.Modules[Index];

    if Module.FileSystem <> '' then
    begin
      if IncludeSubDirectories then
        Save := PathIsChild(Module.FileName, FileName)
      else
        Save := Module.FileName = FileName;

      if Save then
        Module.Save(False, True);
    end;
  end;
end;

procedure TJclVersionControlExpert.SetIconType(const Value: TIconType);
begin
  if Value <> FIconType then
  begin
    FIconType := Value;
    RefreshIcons;
  end;
end;

procedure TJclVersionControlExpert.SubItemClick(Sender: TObject);
var
  APlugin: TJclVersionControlPlugin;
  AMenuItem: TMenuItem;
  AAction: TCustomAction;
  Directory, PluginName: string;
  PosSeparator, IndexPlugin: Integer;
  ControlAction: TJclVersionControlActionType;
  ControlActionInfo: TJclVersionControlActionInfo;
  PluginList: TJclVersionControlPluginList;
begin
  try
    APlugin := CurrentPlugin;
    if Sender is TCustomAction then
    begin
      AAction := TCustomAction(Sender);
      ControlAction := TJclVersionControlActionType(AAction.Tag);
      Directory := AAction.Caption;
    end
    else
    if Sender is TMenuItem then
    begin
      AMenuItem := TMenuItem(Sender);
      ControlAction := TJclVersionControlActionType(AMenuItem.Tag);
      Directory := AMenuItem.Caption;
    end
    else
      Exit;

    ControlActionInfo := VersionControlActionInfo(ControlAction);
    Directory := StrRemoveChars(Directory, CharIsAmpersand);

    if ControlActionInfo.AllPlugins then
    begin
      PluginList := VersionControlPluginList;
      PosSeparator := Pos('|', Directory);
      PluginName := StrLeft(Directory, PosSeparator - 2);
      Directory := StrRight(Directory, Length(Directory) - PosSeparator - 1);
      for IndexPlugin := 0 to PluginList.Count - 1 do
      begin
        APlugin := TJclVersionControlPlugin(PluginList.Plugins[IndexPlugin]);
        if SameText(APlugin.Name, PluginName) then
          Break;
        APlugin := nil;
      end;

      if not Assigned(APlugin) then
        Exit;
    end;

    if ControlActionInfo.SaveFile then
      SaveModules(Directory, True);
    if Assigned(APlugin) then
      APlugin.ExecuteAction(Directory , ControlAction);
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
    end;
  end;
end;

procedure TJclVersionControlExpert.UnregisterCommands;
var
  ControlAction: TJclVersionControlActionType;
  ADropDownAction: TDropDownAction;
begin
  inherited UnregisterCommands;

  Settings.SaveStrings(JclVersionCtrlMenuOrganizationName, FMenuOrganization);
  Settings.SaveBool(JclVersionCtrlSaveConfirmationName, SaveConfirmation);
  Settings.SaveBool(JclVersionCtrlDisableActionsName, DisableActions);
  Settings.SaveBool(JclVersionCtrlHideActionsName, HideActions);
  Settings.SaveBool(JclVersionCtrlActOnTopSandboxName, ActOnTopSandbox);
  case FIconType of
    itNone:
      Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeNoIconValue);
    itJCL:
      Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeJclIconValue);
  end;

  for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
  begin
    UnregisterAction(FActions[ControlAction]);
    if FActions[ControlAction] is TDropDownAction then
    begin
      ADropDownAction := TDropDownAction(FActions[ControlAction]);
      if Assigned(ADropDownAction.DropDownMenu) then
      begin
        ADropDownAction.DropDownMenu.Items.Clear;
        ADropDownAction.DropDownMenu.Free;
        ADropDownAction.DropDownMenu := nil;
      end;
    end;
    FreeAndNil(FActions[ControlAction]);
  end;
  FVersionCtrlMenu.Clear;
  FreeAndNil(FVersionCtrlMenu);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.