379 lines
13 KiB
ObjectPascal
379 lines
13 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ 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 JclVersionCtrlCVSImpl.pas }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Florent Ouchet. }
|
|
{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. }
|
|
{ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Unit owner: Florent Ouchet }
|
|
{ Last modified: $Date: 2006/01/25 20:32:29 $ }
|
|
{ Revision: $Revision: 1.2 $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclVersionCtrlCVSImpl;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Windows, Classes, Graphics,
|
|
VersionControlImpl;
|
|
|
|
type
|
|
TJclVersionControlCVS = class (TJclVersionControlPlugin)
|
|
private
|
|
FTortoiseCVSAct: string;
|
|
protected
|
|
function GetSupportedActions: TJclVersionControlActions; override;
|
|
function GetFileActions(const FileName: string): TJclVersionControlActions; override;
|
|
function GetSandboxActions(const SdBxName: string): TJclVersionControlActions; override;
|
|
function GetIcon(const Action: TJclVersionControlAction): Integer; override;
|
|
function GetEnabled: Boolean; override;
|
|
function GetName: string; override;
|
|
public
|
|
constructor Create(const AExpert: TJclVersionControlExpert); override;
|
|
function GetSandboxNames(const FileName: string; SdBxNames: TStrings): Boolean; override;
|
|
function ExecuteAction(const FileName: string;
|
|
const Action: TJclVersionControlAction): Boolean; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclFileUtils, JclRegistry,
|
|
JclOtaUtils, JclOtaResources, JclOtaConsts;
|
|
|
|
const
|
|
JclVersionCtrlCVSTrtseShlDLL = 'TrtseShl.dll';
|
|
JclVersionCtrlCVSRegKeyName = 'SOFTWARE\TortoiseCVS';
|
|
JclVersionCtrlCVSRegValueName = 'RootDir';
|
|
JclVersionCtrlCVSTortoiseAct = 'TortoiseAct.exe';
|
|
JclVersionCtrlCVSDirectory = 'CVS\';
|
|
JclVersionCtrlCVSEntriesFile = 'Entries';
|
|
|
|
JclVersionControlCVSAddVerb = 'CVSAdd';
|
|
JclVersionControlCVSAddRecurseVerb = 'CVSAddRecursive';
|
|
JclVersionControlCVSAnnotateVerb = 'CVSAnnotate';
|
|
JclVersionControlCVSBranchVerb = 'CVSBranch';
|
|
JclVersionControlCVSCheckOutVerb = 'CVSCheckOut';
|
|
JclVersionControlCVSCommitVerb = 'CVSCommitDialog';
|
|
JclVersionControlCVSDiffVerb = 'CVSDiff';
|
|
JclVersionControlCVSGraphVerb = 'CVSRevisionGraph';
|
|
JclVersionControlCVSLogVerb = 'CVSLog';
|
|
JclVersionControlCVSEditVerb = 'CVSEdit';
|
|
JclVersionControlCVSListEditorsVerb = 'CVSListEditors';
|
|
JclVersionControlCVSTagVerb = 'CVSTag';
|
|
JclVersionControlCVSUpdateVerb = 'CVSUpdate';
|
|
JclVersionControlCVSUpdateDialogVerb = 'CVSUpdateDialog';
|
|
JclVersionControlCVSUnEditVerb = 'CVSUnedit';
|
|
|
|
resourcestring
|
|
RsVersionCtrlCVSName = 'cvs';
|
|
RsEEmptyFileName = 'Error: empty file name';
|
|
RSENoTortoiseCVS = 'TortoiseCVS is not detected on the system';
|
|
|
|
//=== TJclVersionControlCVS ==================================================
|
|
|
|
constructor TJclVersionControlCVS.Create(const AExpert: TJclVersionControlExpert);
|
|
begin
|
|
inherited Create(AExpert);
|
|
FTortoiseCVSAct := RegReadStringDef(HKLM, JclVersionCtrlCVSRegKeyName,
|
|
JclVersionCtrlCVSRegValueName, '');
|
|
|
|
if FTortoiseCVSAct <> '' then
|
|
FTortoiseCVSAct := PathAddSeparator(FTortoiseCVSAct) + JclVersionCtrlCVSTortoiseAct;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.ExecuteAction(const FileName: string;
|
|
const Action: TJclVersionControlAction): Boolean;
|
|
function CallTortoiseCVSAct(const ActionName: string): Boolean;
|
|
var
|
|
StartupInfo: TStartupInfo;
|
|
ProcessInfo: TProcessInformation;
|
|
CurrentDir, CommandLine: string;
|
|
begin
|
|
FillChar(StartupInfo,SizeOf(TStartupInfo),#0);
|
|
FillChar(ProcessInfo,SizeOf(TProcessInformation),#0);
|
|
startupInfo.cb := SizeOf(TStartupInfo);
|
|
startupInfo.dwFlags := STARTF_USESHOWWINDOW;
|
|
startupInfo.wShowWindow := SW_SHOW;
|
|
|
|
if FileName = '' then
|
|
raise EJclExpertException.CreateTrace(RsEEmptyFileName);
|
|
if not Enabled then
|
|
raise EJClExpertException.CreateTrace(RsENoTortoiseCVS);
|
|
|
|
if FileName[Length(FileName)] = PathSeparator then
|
|
CurrentDir := FileName
|
|
else
|
|
CurrentDir := ExtractFilePath(FileName);
|
|
|
|
CommandLine := Format('%s %s -l "%s"', [FTortoiseCVSAct, ActionName, PathRemoveSeparator(FileName)]);
|
|
|
|
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;
|
|
Result := False;
|
|
end;
|
|
begin
|
|
case Action of
|
|
vcaAdd:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSAddVerb);
|
|
vcaAddSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSAddRecurseVerb);
|
|
vcaBlame:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSAnnotateVerb);
|
|
vcaBranch,
|
|
vcaBranchSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSBranchVerb);
|
|
vcaCheckOutSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSCheckOutVerb);
|
|
vcaCommit,
|
|
vcaCommitSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSCommitVerb);
|
|
vcaDiff:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSDiffVerb);
|
|
vcaGraph:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSGraphVerb);
|
|
vcaLog,
|
|
vcaLogSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSLogVerb);
|
|
vcaLock,
|
|
vcaLockSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSEditVerb);
|
|
vcaStatus,
|
|
vcaStatusSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSListEditorsVerb);
|
|
vcaTag,
|
|
vcaTagSandBox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSTagVerb);
|
|
vcaUpdate,
|
|
vcaUpdateSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSUpdateVerb);
|
|
vcaUpdateTo,
|
|
vcaUpdateSandboxTo:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSUpdateDialogVerb);
|
|
vcaUnlock,
|
|
vcaUnlockSandbox:
|
|
Result := CallTortoiseCVSAct(JclVersionControlCVSUnEditVerb);
|
|
else
|
|
Result := inherited ExecuteAction(FileName, Action);
|
|
end;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetEnabled: Boolean;
|
|
begin
|
|
Result := FTortoiseCVSAct <> '';
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetFileActions(
|
|
const FileName: string): TJclVersionControlActions;
|
|
var
|
|
CvsDirectory, EntriesFileName: string;
|
|
Entries: TStrings;
|
|
Index: Integer;
|
|
FileNameLine: string;
|
|
Added: Boolean;
|
|
begin
|
|
Result := inherited GetFileActions(FileName);
|
|
|
|
CvsDirectory := PathAddSeparator(ExtractFilePath(FileName)) + JclVersionCtrlCVSDirectory;
|
|
FileNameLine := Format('/%s/', [ExtractFileName(AnsiUpperCaseFileName(FileName))]);
|
|
|
|
if DirectoryExists(CvsDirectory) and Enabled then
|
|
begin
|
|
Entries := TStringList.Create;
|
|
try
|
|
EntriesFileName := CvsDirectory + JclVersionCtrlCVSEntriesFile;
|
|
|
|
if FileExists(EntriesFileName) then
|
|
begin
|
|
Entries.LoadFromFile(EntriesFileName);
|
|
Added := False;
|
|
for Index := 0 to Entries.Count - 1 do
|
|
if Pos(FileNameLine, AnsiUpperCase(Entries.Strings[Index])) = 1 then
|
|
begin
|
|
Added := True;
|
|
Break;
|
|
end;
|
|
|
|
if Added then
|
|
// TODO: check modifications
|
|
Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
|
|
vcaLog, vcaLock, vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock]
|
|
else
|
|
Result := Result + [vcaAdd];
|
|
end;
|
|
finally
|
|
Entries.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetSupportedActions: TJclVersionControlActions;
|
|
begin
|
|
Result := inherited GetSupportedActions;
|
|
if Enabled then
|
|
Result := Result + [vcaAdd, vcaAddSandbox, vcaBlame, vcaBranch,
|
|
vcaBranchSandbox, vcaCheckOutSandbox, vcaCommit, vcaCommitSandbox,
|
|
vcaDiff, vcaGraph, vcaLog, vcaLogSandbox, vcaLock, vcaLockSandbox,
|
|
vcaStatus, vcaStatusSandbox, vcaTag, vcaTagSandBox, vcaUpdate,
|
|
vcaUpdateSandbox, vcaUpdateTo, vcaUpdateSandboxTo, vcaUnlock, vcaUnlockSandbox];
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetIcon(
|
|
const Action: TJclVersionControlAction): Integer;
|
|
var
|
|
LibraryName: string;
|
|
begin
|
|
LibraryName := PathAddSeparator(ExtractFilePath(FTortoiseCVSAct)) + JclVersionCtrlCVSTrtseShlDLL;
|
|
|
|
case Action of
|
|
vcaAdd,
|
|
vcaAddSandbox:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_ADD');
|
|
vcaGraph,
|
|
vcaLog,
|
|
vcaLogSandbox,
|
|
vcaBlame:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_LOG');
|
|
vcaBranch,
|
|
vcaBranchSandbox:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_BRANCH');
|
|
vcaCheckOutSandbox:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_CHECKOUT');
|
|
vcaCommit,
|
|
vcaCommitSandbox:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_COMMIT');
|
|
vcaDiff:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_COMPARE');
|
|
vcaLock,
|
|
vcaLockSandbox,
|
|
vcaStatus,
|
|
vcaStatusSandbox,
|
|
vcaTag,
|
|
vcaTagSandBox:
|
|
Result := -1;
|
|
vcaUpdate,
|
|
vcaUpdateSandbox,
|
|
vcaUpdateTo,
|
|
vcaUpdateSandboxTo:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_UPDATE');
|
|
vcaUnlock,
|
|
vcaUnlockSandbox:
|
|
Result := Expert.CacheResourceIcon(LibraryName, 'IDI_REVERT');
|
|
else
|
|
Result := inherited GetIcon(Action);
|
|
end;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetName: string;
|
|
begin
|
|
Result := RsVersionCtrlCVSName;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetSandboxActions(
|
|
const SdBxName: string): TJclVersionControlActions;
|
|
var
|
|
CvsDirectory: string;
|
|
begin
|
|
Result := inherited GetSandboxActions(SdBxName);
|
|
|
|
CvsDirectory := sdBxName + JclVersionCtrlCvsDirectory;
|
|
|
|
if Enabled then
|
|
begin
|
|
if DirectoryExists(CvsDirectory) then
|
|
Result := Result + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox,
|
|
vcaLogSandbox, vcaLockSandbox, vcaStatusSandbox, vcaTagSandBox,
|
|
vcaUpdateSandbox, vcaUpdateSandboxTo, vcaUnlockSandbox]
|
|
else
|
|
Result := Result + [vcaCheckOutSandbox];
|
|
end;
|
|
end;
|
|
|
|
function TJclVersionControlCVS.GetSandboxNames(const FileName: string;
|
|
SdBxNames: TStrings): Boolean;
|
|
var
|
|
DirectoryName: string;
|
|
Index: Integer;
|
|
begin
|
|
Result := True;
|
|
|
|
SdBxNames.BeginUpdate;
|
|
try
|
|
SdBxNames.Clear;
|
|
|
|
if Enabled then
|
|
for Index := Length(FileName) downto 1 do
|
|
if FileName[Index] = PathSeparator then
|
|
begin
|
|
DirectoryName := Copy(FileName, 1, Index);
|
|
if DirectoryExists(DirectoryName + JclVersionCtrlCVSDirectory) then
|
|
SdBxNames.Add(DirectoryName);
|
|
end;
|
|
|
|
if SdBxNames.Count = 0 then
|
|
Result := inherited GetSandboxNames(FileName, SdBxNames);
|
|
finally
|
|
SdBxNames.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
try
|
|
TJclVersionControlExpert.RegisterPluginClass(TJclVersionControlCVS);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
finalization
|
|
|
|
try
|
|
TJclVersionControlExpert.UnregisterPluginClass(TJclVersionControlCVS);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JclVersionCtrlCVSImpl.pas,v $
|
|
// Revision 1.2 2006/01/25 20:32:29 outchy
|
|
// Fixed issue with invalid cvs subdirectory
|
|
//
|
|
// Revision 1.1 2006/01/15 00:51:22 outchy
|
|
// cvs support in version control expert
|
|
// version control expert integration in the installer
|
|
//
|
|
|
|
end.
|