{**************************************************************************************************}
{                                                                                                  }
{ 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 JclVersionCtrlSVNImpl.pas                                                   }
{                                                                                                  }
{ The Initial Developer of the Original Code is Florent Ouchet.                                    }
{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet.                          }
{ Portions created by Elahn Ientile are Copyright (C) of Elahn Ientile.                            }
{                                                                                                  }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date:: 2009-11-05 17:06:40 +0100 (jeu., 05 nov. 2009)                          $ }
{ Revision:      $Rev:: 3068                                                                     $ }
{ Author:        $Author:: outchy                                                                $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclVersionCtrlSVNImpl;

{$I jcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes, Windows, Graphics,
  JclVersionControl;

type
  TJclVersionControlSVN = class (TJclVersionControlPlugin)
  private
    FTortoiseSVNProc: string;
  protected
    function GetSupportedActionTypes: TJclVersionControlActionTypes; override;
    function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; override;
    function GetSandboxActions(const SdBxName: TFileName): TJclVersionControlActionTypes; override;
    function GetEnabled: Boolean; override;
    function GetName: string; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; override;
    function ExecuteAction(const FileName: TFileName;
      const Action: TJclVersionControlActionType): Boolean; override;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/vcl/JclVersionCtrlSVNImpl.pas $';
    Revision: '$Revision: 3068 $';
    Date: '$Date: 2009-11-05 17:06:40 +0100 (jeu., 05 nov. 2009) $';
    LogPath: 'JCL\source\vcl';
    Extra: '';
    Data: nil
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  JclVclResources,
  JclFileUtils, JclSysInfo, JclSysUtils, JclRegistry, JclStrings;

const
  JclVersionCtrlRegKeyName = 'SOFTWARE\TortoiseSVN';
  JclVersionCtrlRegValueName = 'ProcPath';
  JclVersionCtrlSVNAddVerb = 'add';
  JclVersionCtrlSVNBlameVerb = 'blame';
  JclVersionCtrlSVNBranchVerb = 'copy';
  JclVersionCtrlSVNCheckOutVerb = 'checkout';
  JclVersionCtrlSVNCommitVerb = 'commit';
  JclVersionCtrlSVNDiffVerb = 'diff';
  JclVersionCtrlSVNGraphVerb = 'revisiongraph';
  JclVersionCtrlSVNLogVerb = 'log';
  JclVersionCtrlSVNLockVerb = 'lock';
  JclVersionCtrlSVNMergeVerb = 'merge';
  JclVersionCtrlSVNRenameVerb = 'rename';
  JclVersionCtrlSVNRepoBrowserVerb = 'repobrowser';
  JclVersionCtrlSVNRevertVerb = 'revert';
  JclVersionCtrlSVNStatusVerb = 'repostatus';
  JclVersionCtrlSVNTagVerb = 'copy';
  JclVersionCtrlSVNUpdateVerb = 'update';
  JclVersionCtrlSVNUpdateToParam = '/rev';
  JclVersionCtrlSVNUnlockVerb = 'unlock';
//  JclVersionCtrlSVNTortoiseDLL = 'TortoiseSVN.dll';
  JclVersionCtrlSVNDirectory1 = '.svn\';
  JclVersionCtrlSVNDirectory2 = '_svn\';
  JclVersionCtrlSVNEntryFile = 'entries';

  JclVersionCtrlSVNDirectories: array [0..1] of string =
   ( JclVersionCtrlSVNDirectory1, JclVersionCtrlSVNDirectory2 );

//=== TJclVersionControlSVN ==================================================

constructor TJclVersionControlSVN.Create;
var
  SaveAcc: TJclRegWOW64Access;
begin
  inherited Create;

  if IsWindows64 then
  begin
    // on 64 bit machines look in the 64bit section of registy for tortoise SVN (64bit) registry stuff
    SaveAcc := RegGetWOW64AccessMode;
    try
      RegSetWOW64AccessMode(ra64Key);
      FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, '');
    finally
      RegSetWOW64AccessMode(SaveAcc);
    end;
  end
  else
    FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, '');
end;

destructor TJclVersionControlSVN.Destroy;
begin
  inherited Destroy;
end;

function TJclVersionControlSVN.ExecuteAction(const FileName: TFileName;
  const Action: TJclVersionControlActionType): Boolean;

  function CallTortoiseSVNProc(const ActionName: string;
    const Param: string = ''): Boolean;
  var
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    CurrentDir, CommandLine: string;
  begin
    ResetMemory(StartupInfo, SizeOf(TStartupInfo));
    ResetMemory(ProcessInfo, SizeOf(TProcessInformation));
    startupInfo.cb := SizeOf(TStartupInfo);
    startupInfo.dwFlags := STARTF_USESHOWWINDOW;
    startupInfo.wShowWindow := SW_SHOW;

    if FileName = '' then
      raise Exception.Create(RsEEmptyFileName);
    if not Enabled then
      raise Exception.Create(RsENoTortoiseSVN);

    if FileName[Length(FileName)] = DirDelimiter then
      CurrentDir := FileName
    else
      CurrentDir := ExtractFilePath(FileName);
    CommandLine := Format('%s /command:%s /path:"%s" %s /notempfile', [FTortoiseSVNProc, ActionName, FileName, Param]);

    Result := CreateProcess(nil, PChar(CommandLine), nil,
      nil, False, 0, nil, PChar(CurrentDir), StartupInfo, ProcessInfo);

    if Result then
    begin
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  end;

begin
  case Action of
    vcaAdd,
    vcaAddSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNAddVerb);
    vcaBlame :
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNBlameVerb);
    vcaBranch,
    vcaBranchSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNBranchVerb);
    vcaCheckOutSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNCheckOutVerb);
    vcaCommit,
    vcaCommitSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNCommitVerb);
    vcaDiff:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNDiffVerb);
    vcaGraph:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNGraphVerb);
    vcaLog,
    vcaLogSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNLogVerb);
    vcaLock,
    vcaLockSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNLockVerb);
    vcaMerge,
    vcaMergeSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNMergeVerb);
    vcaRename:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNRenameVerb);
    vcaRepoBrowser:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNRepoBrowserVerb);
    vcaRevert,
    vcaRevertSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNRevertVerb);
    vcaStatus,
    vcaStatusSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNStatusVerb);
    vcaTag,
    vcaTagSandBox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNTagVerb);
    vcaUpdate,
    vcaUpdateSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNUpdateVerb);
    vcaUpdateTo,
    vcaUpdateSandboxTo:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNUpdateVerb, JclVersionCtrlSVNUpdateToParam);
    vcaUnlock,
    vcaUnlockSandbox:
      Result := CallTortoiseSVNProc(JclVersionCtrlSVNUnlockVerb);
    else
      Result := inherited ExecuteAction(FileName, Action);
  end;
end;

function TJclVersionControlSVN.GetEnabled: Boolean;
begin
  Result := FTortoiseSVNProc <> '';
end;

function TJclVersionControlSVN.GetFileActions(
  const FileName: TFileName): TJclVersionControlActionTypes;
var
  EntryLine: string;
  EntryFileName, UpperCaseFileName, XmlFileNameValue: TFileName;
  Entries: TJclAnsiMappedTextReader;
  IndexDir: Integer;
begin
  Result := inherited GetFileActions(FileName);

  if Enabled then
  begin
    UpperCaseFileName := StrUpper(ExtractFileName(FileName));
    XmlFileNameValue := Format('NAME="%s"', [UpperCaseFileName]);

    for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
    begin
      EntryFileName := PathAddSeparator(ExtractFilePath(FileName))
        + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNEntryFile;

      if FileExists(EntryFileName) then
      begin
        Entries := TJclAnsiMappedTextReader.Create(EntryFileName);
        try
          while not Entries.Eof do
          begin
            EntryLine := string(Entries.ReadLn);
            // old SVN entries file (xml-like)
            if Pos(XmlFileNameValue, StrUpper(EntryLine)) > 0 then
            begin
              // TODO: check modifications
              Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
                vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser,
                vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock];
              FreeAndNil(Entries);
              Exit;
            end;
            // new SVN entries file (flat-style)
            if EntryLine = NativeFormFeed then
            begin
              EntryLine := string(Entries.ReadLn);
              if StrSame(UpperCaseFileName, StrUpper(EntryLine)) then
              begin
                // TODO: check modifications
                Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
                  vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser,
                  vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock];
                FreeAndNil(Entries);
                Exit;
              end;
            end;
          end;
        finally
          Entries.Free;
        end;
      end;
    end;
    Result := Result + [vcaAdd];
  end;
end;

function TJclVersionControlSVN.GetSupportedActionTypes: TJclVersionControlActionTypes;
begin
  Result := inherited GetSupportedActionTypes;
  if Enabled then
    Result := Result + [vcaAdd, vcaAddSandbox, vcaBlame, vcaBranch,
    vcaBranchSandbox, vcaCheckOutSandbox, vcaCommit, vcaCommitSandbox, vcaDiff,
    vcaGraph, vcaLog, vcaLogSandbox, vcaLock, vcaLockSandbox, vcaMerge,
    vcaMergeSandbox, vcaRename, vcaRepoBrowser, vcaRevert, vcaRevertSandbox,
    vcaStatus, vcaStatusSandbox, vcaTag, vcaTagSandBox, vcaUpdate,
    vcaUpdateSandbox, vcaUpdateTo, vcaUpdateSandboxTo, vcaUnlock, vcaUnlockSandbox];
end;

function TJclVersionControlSVN.GetName: string;
begin
  Result := LoadResString(@RsVersionCtrlSVNName);
end;

function TJclVersionControlSVN.GetSandboxActions(
  const SdBxName: TFileName): TJclVersionControlActionTypes;
var
  SvnDirectory: string;
  IndexDir: Integer;
begin
  Result := inherited GetSandboxActions(SdBxName);

  if Enabled then
  begin
    for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
    begin
      SvnDirectory := sdBxName + JclVersionCtrlSVNDirectories[IndexDir];

      if DirectoryExists(SvnDirectory) then
      begin
        Result := Result + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox,
          vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox,
          vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo,
          vcaUnlockSandbox];
        Exit;
      end;
    end;
    // not in a sandbox
    Result := Result + [vcaCheckOutSandbox];
  end;
end;

function TJclVersionControlSVN.GetSandboxNames(const FileName: TFileName;
  SdBxNames: TStrings): Boolean;
var
  DirectoryName: string;
  IndexDir, IndexFileName: Integer;
begin
  Result := True;

  SdBxNames.BeginUpdate;
  try
    SdBxNames.Clear;

    if Enabled then
      for IndexFileName := Length(FileName) downto 1 do
        if FileName[IndexFileName] = DirDelimiter then
    begin
      DirectoryName := Copy(FileName, 1, IndexFileName);
      for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
      begin
        if DirectoryExists(DirectoryName + JclVersionCtrlSVNDirectories[IndexDir]) then
          SdBxNames.Add(DirectoryName);
      end;
    end;
  finally
    SdBxNames.EndUpdate;
  end;

  if SdBxNames.Count = 0 then
    Result := inherited GetSandboxNames(FileName, SdBxNames);
end;

initialization

  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  RegisterVersionControlPluginClass(TJclVersionControlSVN);

finalization

  UnregisterVersionControlPluginClass(TJclVersionControlSVN);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.