View Issue Details
| ID | Project | Category | View Status | Date Submitted | Last Update |
|---|---|---|---|---|---|
| 0001536 | Double Commander | Graphical user interface | public | 2016-09-19 02:22 | 2021-09-05 15:10 |
| Reporter | cordylus | Assigned To | Alexx2000 | ||
| Priority | normal | Severity | feature | Reproducibility | always |
| Status | closed | Resolution | fixed | ||
| Projection | none | ETA | none | ||
| Product Version | 0.7.5 | ||||
| Target Version | 0.9.0 | Fixed in Version | 0.9.0 | ||
| Summary | 0001536: Добавить "Сравнить" в диалог "Заменить ... файлом ...?" | ||||
| Description | Диалог, который открывается при попытке скопировать или переместить файл, когда в месте назначения уже есть файл с таким именем. | ||||
| Tags | No tags attached. | ||||
| Attached Files | bug1536-preview1.patch (50,831 bytes)
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -75,7 +73,13 @@
procedure TfrmMsg.ButtonClick(Sender: TObject);
begin
iSelected:= (Sender as TComponent).Tag;
- Close;
+ if (iSelected < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(iSelected);
+ end
+ else
+ Close;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +88,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview2.patch (51,687 bytes)
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -75,7 +73,13 @@
procedure TfrmMsg.ButtonClick(Sender: TObject);
begin
iSelected:= (Sender as TComponent).Tag;
- Close;
+ if (iSelected < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(iSelected);
+ end
+ else
+ Close;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +88,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview3.patch (52,019 bytes)
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,12 +17,11 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
+ procedure HandleAction(aTag: PtrInt);
procedure ButtonClick(Sender:TObject);
procedure ButtonOtherClick(Sender:TObject);
procedure MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -44,7 +43,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -72,10 +71,23 @@
end;
end;
+procedure TfrmMsg.HandleAction(aTag: PtrInt);
+begin
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
+end;
+
procedure TfrmMsg.ButtonClick(Sender: TObject);
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ HandleAction((Sender as TComponent).Tag);
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +96,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ HandleAction((Sender as TButton).Tag);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview4.patch (52,018 bytes)
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +683,7 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ OperationsManager.AddOperationModal(Operation);
Exit(pdrInCallback);
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview5.patch (52,919 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -269,7 +269,7 @@
FWaitData := WaitData;
edtFileNameLeft.Text:= FileNameLeft;
edtFileNameRight.Text:= FileNameRight;
- FShowIdentical:= actAutoCompare.Checked;
+ FShowIdentical:= False;//actAutoCompare.Checked;
actBinaryCompare.Checked:= not (FileIsText(FileNameLeft) and FileIsText(FileNameRight));
if actBinaryCompare.Checked then
actBinaryCompareExecute(actBinaryCompare)
@@ -278,7 +278,8 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ //if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ ShowModal;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +683,7 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ OperationsManager.AddOperationModal(Operation);
Exit(pdrInCallback);
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview6.patch (56,556 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -269,7 +269,7 @@
FWaitData := WaitData;
edtFileNameLeft.Text:= FileNameLeft;
edtFileNameRight.Text:= FileNameRight;
- FShowIdentical:= actAutoCompare.Checked;
+ FShowIdentical:= False;//actAutoCompare.Checked;
actBinaryCompare.Checked:= not (FileIsText(FileNameLeft) and FileIsText(FileNameRight));
if actBinaryCompare.Checked then
actBinaryCompareExecute(actBinaryCompare)
@@ -278,7 +278,8 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ //if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ ShowModal;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -39,7 +39,7 @@
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
class function CreateFile(const APath: String): TFile; override;
- class function CreateFile(const APath: String; AFolder: PGFile; AFileInfo: PGFileInfo): TFile;
+ class function CreateFile(const APath: String; AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
procedure Reload(const PathsToReload: TPathsArray); override;
function GetParentDir(sPath : String): String; override;
@@ -103,13 +103,14 @@
end;
end;
-class function TGioFileSource.CreateFile(const APath: String; AFolder: PGFile;
- AFileInfo: PGFileInfo): TFile;
+class function TGioFileSource.CreateFile(const APath: String;
+ AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
var
AFile: PGFile;
ATarget: Pgchar;
AFileType: TGFileType;
ASymlinkInfo: PGFileInfo;
+ OwnFolder: Boolean = False;
begin
Result:= CreateFile(APath);
Result.Name:= g_file_info_get_name(AFileInfo);
@@ -127,6 +128,12 @@
end
else if AFileType = G_FILE_TYPE_SYMBOLIC_LINK then
begin
+ if not Assigned(AFolder) then
+ begin
+ AFolder:= g_file_new_for_commandline_arg(Pgchar(APath));
+ OwnFolder:= True;
+ end;
+
ATarget:= g_file_info_get_symlink_target(AFileInfo);
AFile:= g_file_get_child(AFolder, ATarget);
@@ -143,6 +150,8 @@
g_object_unref(ASymlinkInfo);
end;
g_object_unref(PGObject(AFile));
+ if OwnFolder then
+ g_object_unref(PGObject(AFolder));
end
else if AFileType in [G_FILE_TYPE_SHORTCUT, G_FILE_TYPE_MOUNTABLE] then
begin
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetInfo: PGFileInfo;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +73,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +88,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +112,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -142,7 +149,7 @@
if (aFileName <> '.') and (aFileName <> '..') then
begin
- aFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ aFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
NewFiles.Add(aFile);
if aFile.IsLink then
@@ -270,7 +277,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
g_object_unref(AInfo);
AddItem(aFile, CurrentNode);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
@@ -677,13 +684,29 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ TargetFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ TargetFile := TGioFileSource.CreateFile(ExtractFilePath(FCurrentTargetFilePath), FCurrentTargetInfo);
+ try
+ ShowCompareFilesUIByFileObject(FCurrentFile, TargetFile);
+ finally
+ TargetFile.Free;
+ end;
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +741,12 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetInfo := aTargetInfo;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +857,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +867,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiolistoperation.pas
===================================================================
--- src/filesources/gio/ugiolistoperation.pas (revision 7965)
+++ src/filesources/gio/ugiolistoperation.pas (working copy)
@@ -72,7 +72,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(Path, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(Path, AInfo, AFolder);
g_object_unref(AInfo);
FFiles.Add(AFile);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -669,6 +669,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +683,7 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ OperationsManager.AddOperationModal(Operation);
Exit(pdrInCallback);
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview7.patch (58,133 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -269,7 +269,7 @@
FWaitData := WaitData;
edtFileNameLeft.Text:= FileNameLeft;
edtFileNameRight.Text:= FileNameRight;
- FShowIdentical:= actAutoCompare.Checked;
+ FShowIdentical:= False;//actAutoCompare.Checked;
actBinaryCompare.Checked:= not (FileIsText(FileNameLeft) and FileIsText(FileNameRight));
if actBinaryCompare.Checked then
actBinaryCompareExecute(actBinaryCompare)
@@ -278,7 +278,8 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ //if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ ShowModal;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -39,7 +39,7 @@
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
class function CreateFile(const APath: String): TFile; override;
- class function CreateFile(const APath: String; AFolder: PGFile; AFileInfo: PGFileInfo): TFile;
+ class function CreateFile(const APath: String; AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
procedure Reload(const PathsToReload: TPathsArray); override;
function GetParentDir(sPath : String): String; override;
@@ -103,13 +103,14 @@
end;
end;
-class function TGioFileSource.CreateFile(const APath: String; AFolder: PGFile;
- AFileInfo: PGFileInfo): TFile;
+class function TGioFileSource.CreateFile(const APath: String;
+ AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
var
AFile: PGFile;
ATarget: Pgchar;
AFileType: TGFileType;
ASymlinkInfo: PGFileInfo;
+ OwnFolder: Boolean = False;
begin
Result:= CreateFile(APath);
Result.Name:= g_file_info_get_name(AFileInfo);
@@ -127,6 +128,12 @@
end
else if AFileType = G_FILE_TYPE_SYMBOLIC_LINK then
begin
+ if not Assigned(AFolder) then
+ begin
+ AFolder:= g_file_new_for_commandline_arg(Pgchar(APath));
+ OwnFolder:= True;
+ end;
+
ATarget:= g_file_info_get_symlink_target(AFileInfo);
AFile:= g_file_get_child(AFolder, ATarget);
@@ -143,6 +150,8 @@
g_object_unref(ASymlinkInfo);
end;
g_object_unref(PGObject(AFile));
+ if OwnFolder then
+ g_object_unref(PGObject(AFolder));
end
else if AFileType in [G_FILE_TYPE_SHORTCUT, G_FILE_TYPE_MOUNTABLE] then
begin
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetInfo: PGFileInfo;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +73,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +88,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +112,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -142,7 +149,7 @@
if (aFileName <> '.') and (aFileName <> '..') then
begin
- aFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ aFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
NewFiles.Add(aFile);
if aFile.IsLink then
@@ -270,7 +277,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
g_object_unref(AInfo);
AddItem(aFile, CurrentNode);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
@@ -677,13 +684,42 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ TargetFileSource: IFileSource;
+ TargetFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ if FOperation is TFileSourceCopyOperation then
+ TargetFileSource := TFileSourceCopyOperation(FOperation).TargetFileSource
+ else
+ TargetFileSource := (FOperation as TFileSourceMoveOperation).TargetFileSource;
+
+ if TargetFileSource is TGioFileSource then
+ TargetFile := TGioFileSource.CreateFile(ExtractFilePath(FCurrentTargetFilePath), FCurrentTargetInfo)
+ else
+ begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(FCurrentTargetFilePath));
+ TargetFile.Name := ExtractFileName(FCurrentTargetFilePath);
+ end;
+
+ try
+ ShowCompareFilesUIByFileObject(FCurrentFile, TargetFile);
+ finally
+ TargetFile.Free;
+ end;
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +754,12 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetInfo := aTargetInfo;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +870,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +880,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiolistoperation.pas
===================================================================
--- src/filesources/gio/ugiolistoperation.pas (revision 7965)
+++ src/filesources/gio/ugiolistoperation.pas (working copy)
@@ -72,7 +72,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(Path, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(Path, AInfo, AFolder);
g_object_unref(AInfo);
FFiles.Add(AFile);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -267,6 +267,10 @@
procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
begin
+ writeln('--------------- differ: --------------------');
+ writeln(CompareList[0]);
+ writeln(CompareList[1]);
+ writeln('--------------- /differ --------------------');
if gExternalTools[etDiffer].Enabled then
begin
if Assigned(WaitData) then
@@ -669,6 +673,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +687,7 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ OperationsManager.AddOperationModal(Operation);
Exit(pdrInCallback);
end;
@@ -792,6 +798,19 @@
var
I: Integer;
begin
+ writeln('----------- prepare files: ----------------');
+ writeln('--------------- file 1 --------------------');
+ writeln(FileSource1.ClassName);
+ writeln(SelectedFiles1[0].FullPath);
+ writeln(SelectedFiles1[0].Path);
+ writeln(SelectedFiles1[0].Name);
+ writeln('--------------- file 2 --------------------');
+ writeln(FileSource2.ClassName);
+ writeln(SelectedFiles2[0].FullPath);
+ writeln(SelectedFiles2[0].Path);
+ writeln(SelectedFiles2[0].Name);
+ writeln('--------------- /files --------------------');
+
case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
pdrSynchronous:
begin
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview8.patch (58,159 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -269,7 +269,7 @@
FWaitData := WaitData;
edtFileNameLeft.Text:= FileNameLeft;
edtFileNameRight.Text:= FileNameRight;
- FShowIdentical:= actAutoCompare.Checked;
+ FShowIdentical:= False;//actAutoCompare.Checked;
actBinaryCompare.Checked:= not (FileIsText(FileNameLeft) and FileIsText(FileNameRight));
if actBinaryCompare.Checked then
actBinaryCompareExecute(actBinaryCompare)
@@ -278,7 +278,8 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ //if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ ShowModal;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -39,7 +39,7 @@
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
class function CreateFile(const APath: String): TFile; override;
- class function CreateFile(const APath: String; AFolder: PGFile; AFileInfo: PGFileInfo): TFile;
+ class function CreateFile(const APath: String; AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
procedure Reload(const PathsToReload: TPathsArray); override;
function GetParentDir(sPath : String): String; override;
@@ -103,13 +103,14 @@
end;
end;
-class function TGioFileSource.CreateFile(const APath: String; AFolder: PGFile;
- AFileInfo: PGFileInfo): TFile;
+class function TGioFileSource.CreateFile(const APath: String;
+ AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
var
AFile: PGFile;
ATarget: Pgchar;
AFileType: TGFileType;
ASymlinkInfo: PGFileInfo;
+ OwnFolder: Boolean = False;
begin
Result:= CreateFile(APath);
Result.Name:= g_file_info_get_name(AFileInfo);
@@ -127,6 +128,12 @@
end
else if AFileType = G_FILE_TYPE_SYMBOLIC_LINK then
begin
+ if not Assigned(AFolder) then
+ begin
+ AFolder:= g_file_new_for_commandline_arg(Pgchar(APath));
+ OwnFolder:= True;
+ end;
+
ATarget:= g_file_info_get_symlink_target(AFileInfo);
AFile:= g_file_get_child(AFolder, ATarget);
@@ -143,6 +150,8 @@
g_object_unref(ASymlinkInfo);
end;
g_object_unref(PGObject(AFile));
+ if OwnFolder then
+ g_object_unref(PGObject(AFolder));
end
else if AFileType in [G_FILE_TYPE_SHORTCUT, G_FILE_TYPE_MOUNTABLE] then
begin
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetInfo: PGFileInfo;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +73,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +88,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +112,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceMoveOperation,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -142,7 +149,7 @@
if (aFileName <> '.') and (aFileName <> '..') then
begin
- aFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ aFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
NewFiles.Add(aFile);
if aFile.IsLink then
@@ -270,7 +277,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
g_object_unref(AInfo);
AddItem(aFile, CurrentNode);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
@@ -677,13 +684,42 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ TargetFileSource: IFileSource;
+ TargetFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ if FOperation is TFileSourceCopyOperation then
+ TargetFileSource := TFileSourceCopyOperation(FOperation).TargetFileSource
+ else
+ TargetFileSource := (FOperation as TFileSourceMoveOperation).TargetFileSource;
+
+ if TargetFileSource is TGioFileSource then
+ TargetFile := TGioFileSource.CreateFile(ExtractFilePath(FCurrentTargetFilePath), FCurrentTargetInfo)
+ else
+ begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(FCurrentTargetFilePath));
+ TargetFile.Name := ExtractFileName(FCurrentTargetFilePath);
+ end;
+
+ try
+ ShowCompareFilesUIByFileObject(FCurrentFile, TargetFile);
+ finally
+ TargetFile.Free;
+ end;
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +754,12 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetInfo := aTargetInfo;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +870,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +880,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiolistoperation.pas
===================================================================
--- src/filesources/gio/ugiolistoperation.pas (revision 7965)
+++ src/filesources/gio/ugiolistoperation.pas (working copy)
@@ -72,7 +72,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(Path, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(Path, AInfo, AFolder);
g_object_unref(AInfo);
FFiles.Add(AFile);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -163,6 +166,23 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var TargetFile: TFile;
+begin
+ TargetFile := TFile.Create('');
+ TargetFile.FullPath := TargetFilePath;
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -94,7 +94,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -267,6 +267,10 @@
procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
begin
+ writeln('--------------- differ: --------------------');
+ writeln(CompareList[0]);
+ writeln(CompareList[1]);
+ writeln('--------------- /differ --------------------');
if gExternalTools[etDiffer].Enabled then
begin
if Assigned(WaitData) then
@@ -669,6 +673,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +687,7 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ OperationsManager.AddOperationModal(Operation);
Exit(pdrInCallback);
end;
@@ -792,6 +798,19 @@
var
I: Integer;
begin
+ writeln('----------- prepare files: ----------------');
+ writeln('--------------- file 1 --------------------');
+ writeln(FileSource1.ClassName);
+ writeln(SelectedFiles1[0].FullPath);
+ writeln(SelectedFiles1[0].Path);
+ writeln(SelectedFiles1[0].Name);
+ writeln('--------------- file 2 --------------------');
+ writeln(FileSource2.ClassName);
+ writeln(SelectedFiles2[0].FullPath);
+ writeln(SelectedFiles2[0].Path);
+ writeln(SelectedFiles2[0].Name);
+ writeln('--------------- /files --------------------');
+
case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
pdrSynchronous:
begin
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview9.patch (64,161 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -39,7 +39,7 @@
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
class function CreateFile(const APath: String): TFile; override;
- class function CreateFile(const APath: String; AFolder: PGFile; AFileInfo: PGFileInfo): TFile;
+ class function CreateFile(const APath: String; AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
procedure Reload(const PathsToReload: TPathsArray); override;
function GetParentDir(sPath : String): String; override;
@@ -103,13 +103,14 @@
end;
end;
-class function TGioFileSource.CreateFile(const APath: String; AFolder: PGFile;
- AFileInfo: PGFileInfo): TFile;
+class function TGioFileSource.CreateFile(const APath: String;
+ AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
var
AFile: PGFile;
ATarget: Pgchar;
AFileType: TGFileType;
ASymlinkInfo: PGFileInfo;
+ OwnFolder: Boolean = False;
begin
Result:= CreateFile(APath);
Result.Name:= g_file_info_get_name(AFileInfo);
@@ -127,6 +128,12 @@
end
else if AFileType = G_FILE_TYPE_SYMBOLIC_LINK then
begin
+ if not Assigned(AFolder) then
+ begin
+ AFolder:= g_file_new_for_commandline_arg(Pgchar(APath));
+ OwnFolder:= True;
+ end;
+
ATarget:= g_file_info_get_symlink_target(AFileInfo);
AFile:= g_file_get_child(AFolder, ATarget);
@@ -143,6 +150,8 @@
g_object_unref(ASymlinkInfo);
end;
g_object_unref(PGObject(AFile));
+ if OwnFolder then
+ g_object_unref(PGObject(AFolder));
end
else if AFileType in [G_FILE_TYPE_SHORTCUT, G_FILE_TYPE_MOUNTABLE] then
begin
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetInfo: PGFileInfo;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +73,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +88,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +112,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceMoveOperation,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -142,7 +149,7 @@
if (aFileName <> '.') and (aFileName <> '..') then
begin
- aFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ aFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
NewFiles.Add(aFile);
if aFile.IsLink then
@@ -270,7 +277,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
g_object_unref(AInfo);
AddItem(aFile, CurrentNode);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
@@ -677,13 +684,42 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ TargetFileSource: IFileSource;
+ TargetFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ if FOperation is TFileSourceCopyOperation then
+ TargetFileSource := TFileSourceCopyOperation(FOperation).TargetFileSource
+ else
+ TargetFileSource := (FOperation as TFileSourceMoveOperation).TargetFileSource;
+
+ if TargetFileSource is TGioFileSource then
+ TargetFile := TGioFileSource.CreateFile(ExtractFilePath(FCurrentTargetFilePath), FCurrentTargetInfo)
+ else
+ begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(FCurrentTargetFilePath));
+ TargetFile.Name := ExtractFileName(FCurrentTargetFilePath);
+ end;
+
+ try
+ ShowCompareFilesUIByFileObject(FCurrentFile, TargetFile);
+ finally
+ TargetFile.Free;
+ end;
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +754,12 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetInfo := aTargetInfo;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +870,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +880,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiolistoperation.pas
===================================================================
--- src/filesources/gio/ugiolistoperation.pas (revision 7965)
+++ src/filesources/gio/ugiolistoperation.pas (working copy)
@@ -72,7 +72,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(Path, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(Path, AInfo, AFolder);
g_object_unref(AInfo);
FFiles.Add(AFile);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +178,24 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,35 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +606,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -56,7 +56,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +63,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +75,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +84,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +96,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,8 +267,12 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
+ writeln('--------------- differ: --------------------');
+ writeln(CompareList[0]);
+ writeln(CompareList[1]);
+ writeln('--------------- /differ --------------------');
if gExternalTools[etDiffer].Enabled then
begin
if Assigned(WaitData) then
@@ -275,7 +281,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -635,7 +641,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +676,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +690,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +774,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +790,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +802,27 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ writeln('----------- prepare files: ----------------');
+ writeln('--------------- file 1 --------------------');
+ writeln(FileSource1.ClassName);
+ writeln(SelectedFiles1[0].FullPath);
+ writeln(SelectedFiles1[0].Path);
+ writeln(SelectedFiles1[0].Name);
+ writeln('--------------- file 2 --------------------');
+ writeln(FileSource2.ClassName);
+ writeln(SelectedFiles2[0].FullPath);
+ writeln(SelectedFiles2[0].Path);
+ writeln(SelectedFiles2[0].Name);
+ writeln('--------------- /files --------------------');
+
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +834,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +842,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -886,7 +916,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +927,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,7 +966,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
Files1 := TFiles.Create(File1.Path);
@@ -946,7 +977,7 @@
try
Files2.Add(File2.Clone);
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview10.patch (64,027 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -39,7 +39,7 @@
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
class function CreateFile(const APath: String): TFile; override;
- class function CreateFile(const APath: String; AFolder: PGFile; AFileInfo: PGFileInfo): TFile;
+ class function CreateFile(const APath: String; AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
procedure Reload(const PathsToReload: TPathsArray); override;
function GetParentDir(sPath : String): String; override;
@@ -103,13 +103,14 @@
end;
end;
-class function TGioFileSource.CreateFile(const APath: String; AFolder: PGFile;
- AFileInfo: PGFileInfo): TFile;
+class function TGioFileSource.CreateFile(const APath: String;
+ AFileInfo: PGFileInfo; AFolder: PGFile = nil): TFile;
var
AFile: PGFile;
ATarget: Pgchar;
AFileType: TGFileType;
ASymlinkInfo: PGFileInfo;
+ OwnFolder: Boolean = False;
begin
Result:= CreateFile(APath);
Result.Name:= g_file_info_get_name(AFileInfo);
@@ -127,6 +128,12 @@
end
else if AFileType = G_FILE_TYPE_SYMBOLIC_LINK then
begin
+ if not Assigned(AFolder) then
+ begin
+ AFolder:= g_file_new_for_commandline_arg(Pgchar(APath));
+ OwnFolder:= True;
+ end;
+
ATarget:= g_file_info_get_symlink_target(AFileInfo);
AFile:= g_file_get_child(AFolder, ATarget);
@@ -143,6 +150,8 @@
g_object_unref(ASymlinkInfo);
end;
g_object_unref(PGObject(AFile));
+ if OwnFolder then
+ g_object_unref(PGObject(AFolder));
end
else if AFileType in [G_FILE_TYPE_SHORTCUT, G_FILE_TYPE_MOUNTABLE] then
begin
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetInfo: PGFileInfo;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +73,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +88,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +112,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -142,7 +149,7 @@
if (aFileName <> '.') and (aFileName <> '..') then
begin
- aFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ aFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
NewFiles.Add(aFile);
if aFile.IsLink then
@@ -270,7 +277,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(srcPath, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(srcPath, AInfo, AFolder);
g_object_unref(AInfo);
AddItem(aFile, CurrentNode);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
@@ -677,13 +684,37 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ TargetFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ if (FOperation is TFileSourceCopyOperation) and
+ not (TFileSourceCopyOperation(FOperation).TargetFileSource is TGioFileSource) then // CopyOut detection
+ begin
+ TargetFile := TFileSourceCopyOperation(FOperation).TargetFileSource.CreateFileObject(ExtractFilePath(FCurrentTargetFilePath));
+ TargetFile.Name := ExtractFileName(FCurrentTargetFilePath);
+ end
+ else
+ TargetFile := TGioFileSource.CreateFile(ExtractFilePath(FCurrentTargetFilePath), FCurrentTargetInfo);
+
+ try
+ ShowCompareFilesUIByFileObject(FCurrentFile, TargetFile);
+ finally
+ TargetFile.Free;
+ end;
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +749,12 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetInfo := aTargetInfo;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +865,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +875,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiolistoperation.pas
===================================================================
--- src/filesources/gio/ugiolistoperation.pas (revision 7965)
+++ src/filesources/gio/ugiolistoperation.pas (working copy)
@@ -72,7 +72,7 @@
while Assigned(AInfo) do
begin
CheckOperationState;
- AFile:= TGioFileSource.CreateFile(Path, AFolder, AInfo);
+ AFile:= TGioFileSource.CreateFile(Path, AInfo, AFolder);
g_object_unref(AInfo);
FFiles.Add(AFile);
AInfo:= g_file_enumerator_next_file(AFileEnum, nil, @AError);
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUIByFileObject,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +178,24 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,36 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +607,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -56,7 +56,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +63,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +75,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +84,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +96,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,8 +267,12 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
+ writeln('--------------- differ: --------------------');
+ writeln(CompareList[0]);
+ writeln(CompareList[1]);
+ writeln('--------------- /differ --------------------');
if gExternalTools[etDiffer].Enabled then
begin
if Assigned(WaitData) then
@@ -275,7 +281,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -635,7 +641,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +676,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +690,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +774,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +790,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +802,27 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ writeln('----------- prepare files: ----------------');
+ writeln('--------------- file 1 --------------------');
+ writeln(FileSource1.ClassName);
+ writeln(SelectedFiles1[0].FullPath);
+ writeln(SelectedFiles1[0].Path);
+ writeln(SelectedFiles1[0].Name);
+ writeln('--------------- file 2 --------------------');
+ writeln(FileSource2.ClassName);
+ writeln(SelectedFiles2[0].FullPath);
+ writeln(SelectedFiles2[0].Path);
+ writeln(SelectedFiles2[0].Name);
+ writeln('--------------- /files --------------------');
+
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +834,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +842,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -886,7 +916,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +927,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,7 +966,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
Files1 := TFiles.Create(File1.Path);
@@ -946,7 +977,7 @@
try
Files2.Add(File2.Clone);
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview11.patch (59,375 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +178,24 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,36 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +607,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -56,7 +56,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +63,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +75,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +84,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +96,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,7 +267,7 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
if gExternalTools[etDiffer].Enabled then
begin
@@ -275,7 +277,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -635,7 +637,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +672,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +686,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +770,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +786,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +798,14 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +817,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +825,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -886,7 +899,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +910,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,17 +949,20 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
Files1 := TFiles.Create(File1.Path);
try
Files1.Add(File1.Clone);
+ Files1.Path := File1.Path;
Files2 := TFiles.Create(File2.Path);
try
Files2.Add(File2.Clone);
+ Files2.Path := File2.Path;
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview12.patch (59,859 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -427,7 +427,7 @@
SourceFileSource: IFileSource;
begin
SourceFileSource := Self;
- SourceFiles.Path:= FCurrentAddress + SourceFiles.Path;
+ if not StrBegins(SourceFiles.Path, FCurrentAddress) then SourceFiles.Path:= FCurrentAddress + SourceFiles.Path;
Result := TGioCopyOutOperation.Create(SourceFileSource, TargetFileSource, SourceFiles, TargetPath);
end;
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +178,24 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,36 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +607,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -56,7 +56,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +63,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +75,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +84,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +96,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,7 +267,7 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
if gExternalTools[etDiffer].Enabled then
begin
@@ -275,7 +277,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -635,7 +637,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +672,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +686,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +770,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +786,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +798,14 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +817,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +825,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -886,7 +899,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +910,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,7 +949,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
Files1 := TFiles.Create(File1.Path);
@@ -946,7 +960,7 @@
try
Files2.Add(File2.Clone);
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview13.patch (61,266 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationTypes,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,29 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ SourceFilesPath: String = '';
+ TargetFilesPath: String = '';
+begin
+ if Action = fsouaCompare then
+ begin
+ if FOperation.ID <> fsoCopyIn then
+ SourceFilesPath := Copy(ExtractFilePath(FCurrentFile.FullPath), Length(FGioFileSource.CurrentAddress)+1, MaxInt);
+ if FOperation.ID <> fsoCopyOut then
+ TargetFilesPath := Copy(ExtractFilePath(FCurrentTargetFilePath), Length(FGioFileSource.CurrentAddress)+1, MaxInt);
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath, SourceFilesPath, TargetFilesPath);
+ end;
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +740,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +855,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +865,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,10 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String;
+ SourceFilesPath: String = ''; TargetFilesPath: String = '');
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +139,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +276,26 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, '', '', True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String;
+ SourceFilesPath: String = ''; TargetFilesPath: String = '');
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList,
+ SourceFilesPath, TargetFilesPath, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,10 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String;
+ SourceFilesPath: String = ''; TargetFilesPath: String = '');
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +82,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +179,26 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, '', '', True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String;
+ SourceFilesPath: String = ''; TargetFilesPath: String = '');
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList,
+ SourceFilesPath, TargetFilesPath, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,15 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String;
+ SourceFilesPath: String = ''; TargetFilesPath: String = '') of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +176,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +323,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1180,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1212,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1290,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,36 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +607,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -56,7 +56,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +63,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +75,10 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Files1Path: String = '';
+ Files2Path: String = '';
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +86,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +98,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,7 +269,7 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
if gExternalTools[etDiffer].Enabled then
begin
@@ -275,7 +279,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -389,7 +393,10 @@
function TEditorWaitData.GetFromPath: string;
begin
- Result := TargetFileSource.CurrentAddress + TargetPath;
+ if StrBegins(TargetPath, TargetFileSource.CurrentAddress) then
+ Result := TargetPath // Workaround for TGioFileSource
+ else
+ Result := TargetFileSource.CurrentAddress + TargetPath;
end;
procedure TEditorWaitData.ShowWaitForm;
@@ -635,7 +642,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +677,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +691,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +775,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +791,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +803,14 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +822,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +830,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -886,7 +904,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +915,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,17 +954,26 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Files1Path: String = '';
+ Files2Path: String = '';
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
- Files1 := TFiles.Create(File1.Path);
+ if Files1Path <> '' then
+ Files1 := TFiles.Create(Files1Path)
+ else
+ Files1 := TFiles.Create(File1.Path);
try
Files1.Add(File1.Clone);
- Files2 := TFiles.Create(File2.Path);
+ if Files2Path <> '' then
+ Files2 := TFiles.Create(Files2Path)
+ else
+ Files2 := TFiles.Create(File2.Path);
try
Files2.Add(File2.Clone);
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
bug1536-preview14.patch (63,902 bytes)
Index: src/fdiffer.pas
===================================================================
--- src/fdiffer.pas (revision 7965)
+++ src/fdiffer.pas (working copy)
@@ -249,7 +249,7 @@
procedure cm_SaveRight(const Params: array of string);
end;
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
implementation
@@ -262,7 +262,7 @@
const
HotkeysCategory = 'Differ';
-procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil);
+procedure ShowDiffer(const FileNameLeft, FileNameRight: String; WaitData: TWaitData = nil; Modal: Boolean = False);
begin
with TfrmDiffer.Create(Application) do
begin
@@ -278,7 +278,13 @@
OpenFileRight(FileNameRight);
if actAutoCompare.Checked then actStartCompare.Execute;
end;
- if actBinaryCompare.Checked or (FShowIdentical = False) then ShowOnTop;
+ if actBinaryCompare.Checked or (FShowIdentical = False) then
+ begin
+ if Modal then
+ ShowModal
+ else
+ ShowOnTop;
+ end;
end;
end;
Index: src/ffileexecuteyourself.pas
===================================================================
--- src/ffileexecuteyourself.pas (revision 7965)
+++ src/ffileexecuteyourself.pas (working copy)
@@ -52,7 +52,7 @@
destructor Destroy; override;
end;
- procedure ShowFileEditExternal(const FileName, FromPath: string; aWaitData: TWaitData);
+ procedure ShowFileEditExternal(const FileName, FromPath: string; aWaitData: TWaitData; Modal: Boolean = False);
function ShowFileExecuteYourSelf(aFileView: TFileView; aFile: TFile; bWithAll: Boolean): Boolean;
implementation
@@ -62,7 +62,7 @@
uses
DCOSUtils, DCStrUtils, uTempFileSystemFileSource, uFileSourceOperation, uShellExecute;
-procedure ShowFileEditExternal(const FileName, FromPath: string; aWaitData: TWaitData);
+procedure ShowFileEditExternal(const FileName, FromPath: string; aWaitData: TWaitData; Modal: Boolean = False);
begin
// Create wait window
with TfrmFileExecuteYourSelf.Create(Application, nil, FileName, FromPath) do
@@ -69,7 +69,10 @@
begin
FWaitData:= aWaitData;
// Show wait window
- Visible := True;
+ if Modal then
+ ShowModal
+ else
+ Visible := True;
end;
end;
Index: src/filesources/filesystem/ufilesystemcopyoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemcopyoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemcopyoperation.pas (working copy)
@@ -172,6 +172,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmCopy,
TargetPath,
Index: src/filesources/filesystem/ufilesystemmoveoperation.pas
===================================================================
--- src/filesources/filesystem/ufilesystemmoveoperation.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemmoveoperation.pas (working copy)
@@ -137,6 +137,7 @@
@AppProcessMessages,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
Thread,
fsohmMove,
TargetPath,
Index: src/filesources/filesystem/ufilesystemutil.pas
===================================================================
--- src/filesources/filesystem/ufilesystemutil.pas (revision 7965)
+++ src/filesources/filesystem/ufilesystemutil.pas (working copy)
@@ -83,11 +83,15 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
AppProcessMessages: TAppProcessMessagesFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
MoveOrCopy: TFileSystemOperationHelperMoveOrCopy;
procedure ShowError(sMessage: String);
@@ -109,6 +113,7 @@
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean;
AllowDelete: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
var AbsoluteTargetFileName: String;
AllowAppend: Boolean): TFileSourceOperationOptionFileExists;
@@ -121,6 +126,8 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+
OperationThread: TThread;
Mode: TFileSystemOperationHelperMode;
TargetPath: String;
@@ -315,6 +322,7 @@
AppProcessMessagesFunction: TAppProcessMessagesFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
OperationThread: TThread; Mode: TFileSystemOperationHelperMode;
TargetPath: String; StartingStatistics: TFileSourceCopyOperationStatistics);
begin
@@ -323,6 +331,7 @@
AppProcessMessages := AppProcessMessagesFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FOperationThread := OperationThread;
FMode := Mode;
@@ -1355,18 +1364,26 @@
Result := FDirExistsOption;
end;
+procedure TFileSystemOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TFileSystemOperationHelper.FileExists(aFile: TFile;
var AbsoluteTargetFileName: String; AllowAppend: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..11] of TFileSourceOperationUIResponse
+ Responses: array[0..12] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
- fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel, fsourAppend,
- fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource);
- ResponsesNoAppend: array[0..9] of TFileSourceOperationUIResponse
+ fsourSkipAll, fsourResume, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourAppend, fsourOverwriteSmaller, fsourOverwriteLarger,
+ fsourAutoRenameSource);
+ ResponsesNoAppend: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
- fsourOverwriteLarger, fsourAutoRenameSource);
+ fsouaCompare, fsourOverwriteLarger, fsourAutoRenameSource);
var
Answer: Boolean;
Message: String;
@@ -1407,8 +1424,11 @@
end;
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/gio/ugiocopyoperation.pas
===================================================================
--- src/filesources/gio/ugiocopyoperation.pas (revision 7965)
+++ src/filesources/gio/ugiocopyoperation.pas (working copy)
@@ -116,6 +116,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_copy,
TargetPath);
Index: src/filesources/gio/ugiofilesource.pas
===================================================================
--- src/filesources/gio/ugiofilesource.pas (revision 7965)
+++ src/filesources/gio/ugiofilesource.pas (working copy)
@@ -427,7 +427,7 @@
SourceFileSource: IFileSource;
begin
SourceFileSource := Self;
- SourceFiles.Path:= FCurrentAddress + SourceFiles.Path;
+ if not StrBegins(SourceFiles.Path, FCurrentAddress) then SourceFiles.Path:= FCurrentAddress + SourceFiles.Path;
Result := TGioCopyOutOperation.Create(SourceFileSource, TargetFileSource, SourceFiles, TargetPath);
end;
Index: src/filesources/gio/ugiofilesourceutil.pas
===================================================================
--- src/filesources/gio/ugiofilesourceutil.pas (revision 7965)
+++ src/filesources/gio/ugiofilesourceutil.pas (working copy)
@@ -7,9 +7,9 @@
uses
Classes, SysUtils, DCStrUtils, uFile, uFileSource, uFileSourceOperation,
uFileSourceCopyOperation, uFileSystemUtil, uFileSourceOperationOptions,
- uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs;
+ uFileSourceTreeBuilder, uGioFileSource, uGLib2, uGio2, uLog, uGlobs,
+ uFileSourceOperationUI;
-
const
CONST_DEFAULT_QUERY_INFO_ATTRIBUTES = FILE_ATTRIBUTE_STANDARD_TYPE + ',' + FILE_ATTRIBUTE_STANDARD_NAME + ',' +
FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME + ',' + FILE_ATTRIBUTE_STANDARD_SIZE + ',' +
@@ -51,10 +51,14 @@
FFileExistsOption: TFileSourceOperationOptionFileExists;
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
procedure ShowError(const Message: String; AError: PGError);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -68,6 +72,7 @@
function DirExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowCopyInto: Boolean): TFileSourceOperationOptionDirectoryExists;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
@@ -82,6 +87,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction;
TargetPath: String
);
@@ -105,7 +111,7 @@
implementation
uses
- Forms, StrUtils, DCDateTimeUtils, uFileProperty, uFileSourceOperationUI,
+ Forms, StrUtils, DCDateTimeUtils, uFileProperty,
uShowMsg, uLng, uGObject2, DCFileAttributes;
procedure ShowError(AError: PGError);
@@ -677,13 +683,20 @@
end;
end;
+procedure TGioOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+end;
+
function TGioOperationHelper.FileExists(aFile: TFile; aTargetInfo: PGFileInfo;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..8] of TFileSourceOperationUIResponse
+ Responses: array[0..9] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourRenameSource, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteOlder,fsourOverwriteSmaller,
- fsourOverwriteLarger, fsourCancel);
+ fsourCancel, fsouaCompare, fsourOverwriteLarger);
var
Answer: Boolean;
Message: String;
@@ -718,8 +731,11 @@
repeat
Answer := True;
Message:= FileExistsMessage(aFile, aTargetInfo, AbsoluteTargetFileName);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- Responses, fsourOverwrite, fsourSkip) of
+ Responses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -830,6 +846,7 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
CopyMoveFileFunction: TCopyMoveFileFunction; TargetPath: String);
begin
FGioFileSource:= FileSource as IGioFileSource;
@@ -839,6 +856,7 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
FCopyMoveFile := CopyMoveFileFunction;
FFileExistsOption := fsoofeNone;
Index: src/filesources/gio/ugiomoveoperation.pas
===================================================================
--- src/filesources/gio/ugiomoveoperation.pas (revision 7965)
+++ src/filesources/gio/ugiomoveoperation.pas (working copy)
@@ -80,6 +80,7 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
g_file_move,
TargetPath);
Index: src/filesources/multiarchive/umultiarchivecopyoutoperation.pas
===================================================================
--- src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/multiarchive/umultiarchivecopyoutoperation.pas (working copy)
@@ -8,6 +8,7 @@
LazFileUtils,LazUtf8,Classes, SysUtils, StringHashList, uLog, uGlobs, un_process,
uFileSourceOperation,
uFileSourceCopyOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFileSource,
@@ -60,6 +61,11 @@
procedure CheckForErrors(const SourceName, TargetName: String; ExitStatus: LongInt);
protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
+ protected
FExProcess: TExProcess;
FTempFile: String;
FFileMask: String;
@@ -91,7 +97,7 @@
implementation
uses
- LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc, uFileSourceOperationUI,
+ LCLProc, FileUtil, uOSUtils, DCOSUtils, DCStrUtils, uMultiArc,
fMultiArchiveCopyOperationOptions, uMultiArchiveUtil, uFileProcs, uLng, DCDateTimeUtils,
DCBasicTypes, uShowMsg, uFileSystemUtil;
@@ -445,12 +451,29 @@
end;
end;
+procedure TMultiArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := FCurrentFile.Clone;
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(aFile.FullPath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TMultiArchiveCopyOutOperation.DoFileExists(aFile: TFile;
const AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
- fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel);
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsouaCompare,
+ fsourCancel);
var
Message: String;
@@ -486,8 +509,11 @@
begin
Message:= FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath,
aFile.Size, aFile.ModificationTime);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/ufilesourcecopyoperation.pas
===================================================================
--- src/filesources/ufilesourcecopyoperation.pas (revision 7965)
+++ src/filesources/ufilesourcecopyoperation.pas (working copy)
@@ -58,6 +58,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property TargetPath: String read FTargetPath;
public
@@ -135,7 +138,7 @@
implementation
uses
- uDCUtils, uLng, uGlobs;
+ uDCUtils, uLng, uGlobs, uShowForm;
// -- TFileSourceCopyOperation ------------------------------------------------
@@ -272,6 +275,24 @@
end;
end;
+procedure TFileSourceCopyOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceCopyOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := TargetFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(SourceFileSource, SourceFile, TargetFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
Index: src/filesources/ufilesourcemoveoperation.pas
===================================================================
--- src/filesources/ufilesourcemoveoperation.pas (revision 7965)
+++ src/filesources/ufilesourcemoveoperation.pas (working copy)
@@ -46,6 +46,9 @@
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
+ procedure ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+ procedure ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+
property FileSource: IFileSource read FFileSource;
property SourceFiles: TFiles read FSourceFiles;
property TargetPath: String read FTargetPath;
@@ -78,7 +81,7 @@
implementation
uses
- uDCUtils, uLng;
+ uDCUtils, uLng, uShowForm;
// -- TFileSourceMoveOperation ------------------------------------------------
@@ -175,6 +178,24 @@
end;
end;
+procedure TFileSourceMoveOperation.ShowCompareFilesUIByFileObject(SourceFile: TFile; TargetFile: TFile);
+begin
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+end;
+
+procedure TFileSourceMoveOperation.ShowCompareFilesUI(SourceFile: TFile; const TargetFilePath: String);
+var
+ TargetFile: TFile = nil;
+begin
+ TargetFile := FFileSource.CreateFileObject(ExtractFilePath(TargetFilePath));
+ TargetFile.Name := ExtractFileName(TargetFilePath);
+ try
+ PrepareToolData(FFileSource, SourceFile, FFileSource, TargetFile, @ShowDifferByGlobList, True);
+ finally
+ TargetFile.Free;
+ end;
+end;
+
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
begin
Result := fsoMove;
Index: src/filesources/ufilesourceoperation.pas
===================================================================
--- src/filesources/ufilesourceoperation.pas (revision 7965)
+++ src/filesources/ufilesourceoperation.pas (working copy)
@@ -25,7 +25,8 @@
Classes, SysUtils, syncobjs, uLng,
uFileSourceOperationOptionsUI,
uFileSourceOperationTypes,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uFile;
type
@@ -75,11 +76,14 @@
function(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse of object;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer of object;
TAbortOperationFunction = procedure of object;
TCheckOperationStateFunction = procedure of object;
TAppProcessMessagesFunction = function(CheckState: Boolean = False): Boolean of object;
+ TShowCompareFilesUIFunction = procedure(SourceFile: TFile; const TargetFilePath: String) of object;
+ TShowCompareFilesUIByFileObjectFunction = procedure(SourceFile: TFile; TargetFile: TFile) of object;
TFileSourceOperationClass = class of TFileSourceOperation;
{en
@@ -171,8 +175,9 @@
FUIQuestion: String;
FUIPossibleResponses: array of TFileSourceOperationUIResponse;
FUIDefaultOKResponse: TFileSourceOperationUIResponse;
- FUIDefaultCancelResponse: TFileSourceOperationUIResponse;
- FUIResponse: TFileSourceOperationUIResponse;
+ FUIDefaultCancelResponse: TFileSourceOperationUIAnswer;
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ FUIResponse: TFileSourceOperationUIAnswer;
FTryAskQuestionResult: Boolean;
{en
@@ -317,8 +322,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
{en
Remember statistics at start time (used for estimating remaining time).
@@ -1173,7 +1179,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse): TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
i: Integer;
bStateChanged: Boolean = False;
@@ -1203,6 +1211,7 @@
FUIPossibleResponses[i] := PossibleResponses[i];
FUIDefaultOKResponse := DefaultOKResponse;
FUIDefaultCancelResponse := DefaultCancelResponse;
+ FUIActionHandler := ActionHandler;
if GetCurrentThreadID <> MainThreadID then
begin
@@ -1280,7 +1289,8 @@
FUIQuestion,
FUIPossibleResponses,
FUIDefaultOKResponse,
- FUIDefaultCancelResponse);
+ FUIDefaultCancelResponse,
+ FUIActionHandler);
FTryAskQuestionResult := True; // We do have an answer now.
end;
Index: src/filesources/ufilesourceoperationmessageboxesui.pas
===================================================================
--- src/filesources/ufilesourceoperationmessageboxesui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmessageboxesui.pas (working copy)
@@ -6,7 +6,8 @@
uses
Classes, SysUtils,
- uFileSourceOperationUI;
+ uFileSourceOperationUI,
+ uShowMsg;
type
@@ -13,7 +14,14 @@
{en
We assume here the UI is used only from the GUI thread.
}
+
+ { TFileSourceOperationMessageBoxesUI }
+
TFileSourceOperationMessageBoxesUI = class(TFileSourceOperationUI)
+ private
+ FUIActionHandler: TFileSourceOperationUIActionHandler;
+ protected
+ procedure QuestionActionHandler(Button: TMyMsgActionButton);
public
constructor Create; override;
destructor Destroy; override;
@@ -21,21 +29,21 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; override;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; override;
end;
implementation
-uses
- uShowMsg;
-
const
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbResume,
msmbCopyInto, msmbCopyIntoAll, msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions:
+ msmbCompare);
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourResume,
@@ -43,6 +51,9 @@
fsourOverwriteSmaller, fsourOverwriteLarger, fsourAutoRenameSource, fsourRenameSource,
fsourSkip, fsourSkipAll, fsourIgnore, fsourIgnoreAll, fsourAll, fsourRetry, fsourAbort, fsourRetryAdmin);
+ ButtonToUIAction: array[TMyMsgActionButton] of TFileSourceOperationUIAction =
+ (fsouaCompare);
+
constructor TFileSourceOperationMessageBoxesUI.Create;
begin
inherited;
@@ -57,8 +68,9 @@
Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer;
var
Buttons: array of TMyMsgButton;
i: Integer;
@@ -65,6 +77,8 @@
MsgResult: TMyMsgResult;
TextMessage: String;
begin
+ FUIActionHandler := ActionHandler;
+
SetLength(Buttons, Length(PossibleResponses));
for i := 0 to Length(PossibleResponses) - 1 do
Buttons[i] := ResponseToButton[PossibleResponses[i]];
@@ -77,10 +91,18 @@
MsgResult := MsgBox(TextMessage,
Buttons,
ResponseToButton[DefaultOKResponse],
- ResponseToButton[DefaultCancelResponse]);
+ ResponseToButton[DefaultCancelResponse],
+ @QuestionActionHandler);
Result := ResultToResponse[MsgResult];
end;
+procedure TFileSourceOperationMessageBoxesUI.QuestionActionHandler(
+ Button: TMyMsgActionButton);
+begin
+ if Assigned(FUIActionHandler) then
+ FUIActionHandler(ButtonToUIAction[Button]);
+end;
+
end.
Index: src/filesources/ufilesourceoperationmisc.pas
===================================================================
--- src/filesources/ufilesourceoperationmisc.pas (revision 7965)
+++ src/filesources/ufilesourceoperationmisc.pas (working copy)
@@ -69,7 +69,8 @@
procedure ShowOperationModal(OpManItem: TOperationsManagerItem);
begin
- with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+// with TfrmFileOp.Create(OpManItem.Queue.Identifier) do
+ with TfrmFileOp.Create(OpManItem.Handle) do
try
ShowModal;
finally
Index: src/filesources/ufilesourceoperationui.pas
===================================================================
--- src/filesources/ufilesourceoperationui.pas (revision 7965)
+++ src/filesources/ufilesourceoperationui.pas (working copy)
@@ -34,8 +34,16 @@
fsourAll,
fsourRetry,
fsourAbort,
- fsourRetryAdmin);
+ fsourRetryAdmin,
+ // Actions will never be returned since they do not close the window, handle them in ActionHandler.
+ fsouaCompare); // The first action, hardcoded. Add new actions after this and new answers before this line.
+ TFileSourceOperationUIAnswer = Low(TFileSourceOperationUIResponse)..Pred(fsouaCompare);
+
+ TFileSourceOperationUIAction = fsouaCompare..High(TFileSourceOperationUIResponse);
+
+ TFileSourceOperationUIActionHandler = procedure(Action: TFileSourceOperationUIAction) of object;
+
{en
General interface for communication: operation <-> user.
}
@@ -47,8 +55,9 @@
function AskQuestion(Msg: String; Question: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
DefaultOKResponse: TFileSourceOperationUIResponse;
- DefaultCancelResponse: TFileSourceOperationUIResponse
- ) : TFileSourceOperationUIResponse; virtual abstract;
+ DefaultCancelResponse: TFileSourceOperationUIAnswer;
+ ActionHandler: TFileSourceOperationUIActionHandler = nil
+ ) : TFileSourceOperationUIAnswer; virtual abstract;
// Add possibility to display files properties (for example: to compare older - newer)
// Add general option "remember this choice for all files of this type" (checkbox)
end;
Index: src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyinoperation.pas (working copy)
@@ -13,6 +13,7 @@
uFile,
uWcxModule,
uWcxArchiveFileSource,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI;
@@ -44,6 +45,10 @@
function Tar: Boolean;
procedure SetProcessDataProc(hArcData: TArcHandle);
+ protected
+ FCurrentFile: TFile;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
function FileExists(aSourceFile: TFile; aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
@@ -71,7 +76,7 @@
uses
LazUTF8, FileUtil, StrUtils, DCStrUtils, uLng, uShowMsg, fWcxArchiveCopyOperationOptions,
- uFileSystemFileSource, uFileSourceOperationUI, uFileSystemUtil, DCOSUtils, uTarWriter,
+ uFileSystemFileSource, DCOSUtils, uTarWriter,
DCConvertEncoding, DCDateTimeUtils, uArchiveFileSourceUtil;
// ----------------------------------------------------------------------------
@@ -409,6 +414,13 @@
end;
end;
+procedure TWcxArchiveCopyInOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ ShowCompareFilesUI(FCurrentFile, IncludeFrontPathDelimiter(FCurrentTargetFilePath));
+end;
+
function TWcxArchiveCopyInOperation.FileExistsMessage(aSourceFile: TFile; aTargetHeader: TWcxHeader): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + aTargetHeader.FileName + LineEnding;
@@ -423,10 +435,10 @@
function TWcxArchiveCopyInOperation.FileExists(aSourceFile: TFile;
aTargetHeader: TWcxHeader): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..7] of TFileSourceOperationUIResponse
+ PossibleResponses: array[0..8] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger,
fsourOverwriteAll, fsourSkipAll, fsourOverwriteSmaller,
- fsourOverwriteOlder, fsourCancel);
+ fsourOverwriteOlder, fsouaCompare, fsourCancel);
function OverwriteOlder: TFileSourceOperationOptionFileExists;
begin
@@ -456,8 +468,11 @@
case FFileExistsOption of
fsoofeNone:
begin
+ FCurrentFile := aSourceFile;
+ FCurrentTargetFilePath := aTargetHeader.FileName;
case AskQuestion(FileExistsMessage(aSourceFile, aTargetHeader), '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas
===================================================================
--- src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (revision 7965)
+++ src/filesources/wcxarchive/uwcxarchivecopyoutoperation.pas (working copy)
@@ -10,6 +10,7 @@
uFileSourceCopyOperation,
uFileSource,
uFileSourceOperation,
+ uFileSourceOperationUI,
uFileSourceOperationOptions,
uFileSourceOperationOptionsUI,
uFile,
@@ -65,6 +66,10 @@
procedure LogMessage(const sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
protected
+ FCurrentFilePath: String;
+ FCurrentTargetFilePath: String;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
+
procedure SetProcessDataProc(hArcData: TArcHandle);
public
@@ -91,7 +96,7 @@
uses
Forms, LazUTF8, uMasks, FileUtil, contnrs, DCOSUtils, DCStrUtils, uDCUtils,
- uFileSourceOperationUI, fWcxArchiveCopyOperationOptions, uFileSystemUtil,
+ fWcxArchiveCopyOperationOptions, uFileSystemUtil,
uFileProcs, uLng, DCDateTimeUtils, DCBasicTypes, uShowMsg, DCConvertEncoding;
// ----------------------------------------------------------------------------
@@ -538,14 +543,36 @@
end;
end;
+procedure TWcxArchiveCopyOutOperation.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+var
+ aFile: TFile;
+begin
+ if Action = fsouaCompare then
+ begin
+ aFile := TFile.Create('');
+ try
+ aFile.FullPath := IncludeFrontPathDelimiter(FCurrentFilePath);
+ ShowCompareFilesUI(aFile, FCurrentTargetFilePath);
+ finally
+ aFile.Free;
+ end;
+ end;
+end;
+
function TWcxArchiveCopyOutOperation.DoFileExists(Header: TWcxHeader;
var AbsoluteTargetFileName: String): TFileSourceOperationOptionFileExists;
const
- PossibleResponses: array[0..9] of TFileSourceOperationUIResponse
+ Responses: array[0..10] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
+ fsouaCompare, fsourRenameSource, fsourAutoRenameSource);
+ ResponsesNoCompare: array[0..9] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteLarger, fsourOverwriteAll,
+ fsourSkipAll, fsourOverwriteSmaller, fsourOverwriteOlder, fsourCancel,
fsourRenameSource, fsourAutoRenameSource);
var
+ PossibleResponses: array of TFileSourceOperationUIResponse;
Answer: Boolean;
Message: String;
@@ -580,10 +607,19 @@
fsoofeNone:
repeat
Answer := True;
+ // Can't asynchoronously extract file for comparison when multiple operations are not supported
+ // TODO: implement synchronous CopyOut to temp directory or close the connection until the question is answered
+ case FNeedsConnection of
+ True : PossibleResponses := ResponsesNoCompare;
+ False: PossibleResponses := Responses;
+ end;
Message:= FileExistsMessage(AbsoluteTargetFileName, Header.FileName,
Header.UnpSize, WcxFileTimeToDateTime(Header.FileTime));
+ FCurrentFilePath := Header.FileName;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
Index: src/filesources/wfxplugin/uwfxplugincopyinoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyinoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyIn,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoperation.pas (working copy)
@@ -130,6 +130,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopy,
TargetPath);
Index: src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxplugincopyoutoperation.pas (working copy)
@@ -142,6 +142,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmCopyOut,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginmoveoperation.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (revision 7965)
+++ src/filesources/wfxplugin/uwfxpluginmoveoperation.pas (working copy)
@@ -128,6 +128,8 @@
@RaiseAbortOperation,
@CheckOperationState,
@UpdateStatistics,
+ @ShowCompareFilesUI,
+ @ShowCompareFilesUIByFileObject,
Thread,
wpohmMove,
TargetPath);
Index: src/filesources/wfxplugin/uwfxpluginutil.pas
===================================================================
--- src/filesources/wfxplugin/uwfxpluginutil.pas (revision 7968)
+++ src/filesources/wfxplugin/uwfxpluginutil.pas (working copy)
@@ -39,10 +39,16 @@
FCopyAttributesOptions: TCopyAttributesOptions;
FFileExistsOption: TFileSourceOperationOptionFileExists;
+ FCurrentFile: TFile;
+ FCurrentTargetFile: TFile;
+ FCurrentTargetFilePath: String;
+
AskQuestion: TAskQuestionFunction;
AbortOperation: TAbortOperationFunction;
CheckOperationState: TCheckOperationStateFunction;
UpdateStatistics: TUpdateStatisticsFunction;
+ ShowCompareFilesUI: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject: TShowCompareFilesUIByFileObjectFunction;
procedure ShowError(sMessage: String);
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
@@ -50,6 +56,7 @@
function ProcessDirectory(aFile: TFile; AbsoluteTargetFileName: String): LongInt;
function ProcessFile(aFile: TFile; AbsoluteTargetFileName: String; var Statistics: TFileSourceCopyOperationStatistics): LongInt;
+ procedure QuestionActionHandler(Action: TFileSourceOperationUIAction);
function FileExists(aFile: TFile;
AbsoluteTargetFileName: String;
AllowResume: Boolean): TFileSourceOperationOptionFileExists;
@@ -62,6 +69,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -233,6 +242,18 @@
end;
end;
+procedure TWfxPluginOperationHelper.QuestionActionHandler(
+ Action: TFileSourceOperationUIAction);
+begin
+ if Action = fsouaCompare then
+ begin
+ if Assigned(FCurrentTargetFile) then
+ ShowCompareFilesUIByFileObject(FCurrentFile, FCurrentTargetFile)
+ else
+ ShowCompareFilesUI(FCurrentFile, FCurrentTargetFilePath);
+ end;
+end;
+
function FileExistsMessage(TargetFile: TFile; SourceFile: TFile): String;
begin
Result:= rsMsgFileExistsOverwrite + LineEnding + TargetFile.FullPath + LineEnding +
@@ -245,19 +266,20 @@
AbsoluteTargetFileName: String; AllowResume: Boolean
): TFileSourceOperationOptionFileExists;
const
- Responses: array[0..5] of TFileSourceOperationUIResponse
+ Responses: array[0..6] of TFileSourceOperationUIResponse
= (fsourOverwrite, fsourSkip, fsourResume, fsourOverwriteAll, fsourSkipAll,
+ fsouaCompare, fsourCancel);
+ ResponsesNoResume: array[0..5] of TFileSourceOperationUIResponse
+ = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsouaCompare,
fsourCancel);
- ResponsesNoResume: array[0..4] of TFileSourceOperationUIResponse
- = (fsourOverwrite, fsourSkip, fsourOverwriteAll, fsourSkipAll, fsourCancel);
var
Message: String;
PossibleResponses: array of TFileSourceOperationUIResponse;
- TargetFile: TFile;
begin
case FFileExistsOption of
fsoofeNone:
- begin
+ try
+ FCurrentTargetFile := nil;
case AllowResume of
True : PossibleResponses := Responses;
False: PossibleResponses := ResponsesNoResume;
@@ -264,15 +286,15 @@
end;
if FMode = wpohmCopyOut then
Message := uFileSystemUtil.FileExistsMessage(AbsoluteTargetFileName, aFile.FullPath, aFile.Size, aFile.ModificationTime)
- else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, TargetFile) then
- begin
- Message := FileExistsMessage(TargetFile, aFile);
- TargetFile.Free;
- end
+ else if FWfxPluginFileSource.FillSingleFile(AbsoluteTargetFileName, FCurrentTargetFile) then
+ Message := FileExistsMessage(FCurrentTargetFile, aFile)
else
Message := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
+ FCurrentFile := aFile;
+ FCurrentTargetFilePath := AbsoluteTargetFileName;
case AskQuestion(Message, '',
- PossibleResponses, fsourOverwrite, fsourSkip) of
+ PossibleResponses, fsourOverwrite, fsourSkip,
+ @QuestionActionHandler) of
fsourOverwrite:
Result := fsoofeOverwrite;
fsourSkip:
@@ -296,6 +318,8 @@
fsourCancel:
AbortOperation;
end;
+ finally
+ FreeAndNil(FCurrentTargetFile);
end;
else
@@ -324,6 +348,8 @@
AbortOperationFunction: TAbortOperationFunction;
CheckOperationStateFunction: TCheckOperationStateFunction;
UpdateStatisticsFunction: TUpdateStatisticsFunction;
+ ShowCompareFilesUIFunction: TShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObjectFunction: TShowCompareFilesUIByFileObjectFunction;
OperationThread: TThread;
Mode: TWfxPluginOperationHelperMode;
TargetPath: String
@@ -334,6 +360,8 @@
AbortOperation := AbortOperationFunction;
CheckOperationState := CheckOperationStateFunction;
UpdateStatistics := UpdateStatisticsFunction;
+ ShowCompareFilesUI := ShowCompareFilesUIFunction;
+ ShowCompareFilesUIByFileObject := ShowCompareFilesUIByFileObjectFunction;
FOperationThread:= OperationThread;
FMode := Mode;
FInternal:= (FMode in [wpohmCopy, wpohmMove]);
Index: src/fMsg.pas
===================================================================
--- src/fMsg.pas (revision 7965)
+++ src/fMsg.pas (working copy)
@@ -17,10 +17,8 @@
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: Char);
- private
- { Private declarations }
public
- { Public declarations }
+ ActionHandler: procedure(Tag: PtrInt) of object;
Escape: Integer;
iSelected: Integer;
procedure ButtonClick(Sender:TObject);
@@ -44,7 +42,7 @@
procedure TfrmMsg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
- if (iSelected < 0) and (Escape >= 0) then iSelected:= Escape;
+ if (iSelected = -1) and (Escape >= 0) then iSelected:= Escape;
end;
procedure TfrmMsg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -73,9 +71,20 @@
end;
procedure TfrmMsg.ButtonClick(Sender: TObject);
+var
+ aTag: PtrInt;
begin
- iSelected:= (Sender as TComponent).Tag;
- Close;
+ aTag:= (Sender as TComponent).Tag;
+ if (aTag < -1) then
+ begin
+ if Assigned(ActionHandler) then
+ ActionHandler(aTag);
+ end
+ else
+ begin
+ iSelected:= aTag;
+ Close;
+ end;
end;
procedure TfrmMsg.MouseUpEvent(Sender: TObject; Button: TMouseButton;
@@ -84,8 +93,7 @@
{$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
if (Button = mbLeft) and (Sender = FindLCLControl(Mouse.CursorPos)) then
begin
- iSelected:= (Sender as TButton).Tag;
- Close;
+ ButtonClick(Sender);
end;
{$ENDIF}
end;
Index: src/platform/uosforms.pas
===================================================================
--- src/platform/uosforms.pas (revision 7965)
+++ src/platform/uosforms.pas (working copy)
@@ -319,9 +319,9 @@
end;
// If parent window is normal window then call inherited method
- if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
- Result:= inherited ShowModal
- else
+// if GetWindowLong(ActiveWindow, GWL_HWNDPARENT) <> 0 then
+// Result:= inherited ShowModal
+// else
begin
Include(FFormState, fsModal);
FParentWindow := ActiveWindow;
Index: src/ulng.pas
===================================================================
--- src/ulng.pas (revision 7965)
+++ src/ulng.pas (working copy)
@@ -329,6 +329,7 @@
rsDlgButtonAbort = 'Ab&ort';
rsDlgButtonOther = 'Ot&her';
rsDlgButtonRetryAdmin = 'As Ad&ministrator';
+ rsDlgButtonCompare = 'Compare &by content';
rsDlgButtonContinue = '&Continue';
rsDlgButtonExitProgram = 'E&xit program';
Index: src/ushowform.pas
===================================================================
--- src/ushowform.pas (revision 7966)
+++ src/ushowform.pas (working copy)
@@ -43,11 +43,12 @@
TargetPath: String;
SourceFileSource: IFileSource;
TargetFileSource: IFileSource;
+ FModal: Boolean;
function GetRelativeFileName(const FullPath: string): string;
function GetRelativeFileNames: string;
function GetFromPath: string;
public
- constructor Create(aCopyOutOperation: TFileSourceCopyOperation);
+ constructor Create(aCopyOutOperation: TFileSourceCopyOperation; Modal: Boolean = False);
destructor Destroy; override;
procedure ShowWaitForm; override;
procedure Done; override;
@@ -56,7 +57,7 @@
State: TFileSourceOperationState);
end;
- TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData);
+ TToolDataPreparedProc = procedure(const FileList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
// Callback may be called either asynchoronously or synchronously (for modal operations)
// pdrInCallback is returned when FunctionToCall either will be called or was already called
@@ -63,7 +64,8 @@
TPrepareDataResult = (pdrFailed, pdrSynchronous, pdrInCallback);
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
procedure PrepareToolData(FileSource: IFileSource; var SelectedFiles: TFiles;
FunctionToCall: TToolDataPreparedProc); overload;
@@ -74,7 +76,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc); overload;
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False); overload;
procedure RunExtDiffer(CompareList: TStringList);
@@ -82,7 +85,7 @@
procedure ShowEditorByGlob(WaitData: TEditorWaitData); overload;
procedure ShowDifferByGlob(const LeftName, RightName: String);
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
procedure ShowViewerByGlob(const sFileName: String);
procedure ShowViewerByGlobList(const FilesToView: TStringList;
@@ -94,7 +97,7 @@
SysUtils, Process, DCProcessUtf8, Dialogs, LCLIntf,
uShellExecute, uGlobs, uOSUtils, fEditor, fViewer, uDCUtils,
uTempFileSystemFileSource, uLng, fDiffer, uDebug, DCOSUtils, uShowMsg,
- DCStrUtils, uFileSourceProperty,
+ DCStrUtils, uFileSourceProperty, uWfxPluginCopyOutOperation,
uFileSourceOperationOptions, uOperationsManager, uFileSourceOperationTypes,
uMultiArchiveFileSource, fFileExecuteYourSelf;
@@ -265,7 +268,7 @@
ShowDiffer(LeftName, RightName);
end;
-procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData);
+procedure ShowDifferByGlobList(const CompareList: TStringList; WaitData: TWaitData; Modal: Boolean = False);
begin
if gExternalTools[etDiffer].Enabled then
begin
@@ -275,7 +278,7 @@
RunExtDiffer(CompareList);
end
else
- ShowDiffer(CompareList[0], CompareList[1], WaitData);
+ ShowDiffer(CompareList[0], CompareList[1], WaitData, Modal);
end;
procedure ShowViewerByGlobList(const FilesToView : TStringList;
@@ -349,7 +352,7 @@
{ TEditorWaitData }
-constructor TEditorWaitData.Create(aCopyOutOperation: TFileSourceCopyOperation);
+constructor TEditorWaitData.Create(aCopyOutOperation: TFileSourceCopyOperation; Modal: Boolean = False);
var
I: Integer;
aFileSource: ITempFileSystemFileSource;
@@ -363,6 +366,7 @@
FileTimes[I] := mbFileAge(Files[I].FullPath);
SourceFileSource := aFileSource;
TargetFileSource := aCopyOutOperation.FileSource as IFileSource;
+ FModal := Modal;
end;
destructor TEditorWaitData.Destroy;
@@ -389,12 +393,15 @@
function TEditorWaitData.GetFromPath: string;
begin
- Result := TargetFileSource.CurrentAddress + TargetPath;
+ if StrBegins(TargetPath, TargetFileSource.CurrentAddress) then
+ Result := TargetPath // Workaround for TGioFileSource
+ else
+ Result := TargetFileSource.CurrentAddress + TargetPath;
end;
procedure TEditorWaitData.ShowWaitForm;
begin
- ShowFileEditExternal(GetRelativeFileNames, GetFromPath, Self);
+ ShowFileEditExternal(GetRelativeFileNames, GetFromPath, Self, FModal);
end;
procedure TEditorWaitData.Done;
@@ -422,7 +429,10 @@
begin
Operation.AddStateChangedListener([fsosStopped], @OnCopyInStateChanged);
Operation.FileExistsOption:= fsoofeOverwrite;
- OperationsManager.AddOperation(Operation);
+ if FModal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
DoNotFreeYet:= True; // Will be free in operation
end;
end
@@ -635,7 +645,8 @@
{ PrepareData }
function PrepareData(FileSource: IFileSource; var SelectedFiles: TFiles;
- FunctionToCall: TFileSourceOperationStateChangedNotify): TPrepareDataResult;
+ FunctionToCall: TFileSourceOperationStateChangedNotify;
+ Modal: Boolean = False): TPrepareDataResult;
var
aFile: TFile;
I: Integer;
@@ -669,6 +680,8 @@
TempFileSource,
TempFiles,
TempFileSource.FileSystemRoot);
+ if Operation is TWfxPluginCopyOutOperation then
+ (Operation as TWfxPluginCopyOutOperation).NeedsConnection := False; // use separate connection
finally
TempFiles.Free;
end;
@@ -681,7 +694,10 @@
Operation.AddStateChangedListener([fsosStopped], FunctionToCall);
- OperationsManager.AddOperation(Operation);
+ if Modal then
+ OperationsManager.AddOperationModal(Operation)
+ else
+ OperationsManager.AddOperation(Operation);
Exit(pdrInCallback);
end;
@@ -762,6 +778,7 @@
protected
FFunc: TToolDataPreparedProc;
FCallOnFail: Boolean;
+ FModal: Boolean;
FFailed: Boolean;
FFileList1: TStringList;
FFileList2: TStringList;
@@ -777,7 +794,8 @@
public
constructor Create(FunctionToCall: TToolDataPreparedProc; CallOnFail: Boolean = False);
procedure Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
destructor Destroy; override;
end;
@@ -788,11 +806,14 @@
end;
procedure TToolDataPreparator2.Prepare(FileSource1: IFileSource; var SelectedFiles1: TFiles;
- FileSource2: IFileSource; var SelectedFiles2: TFiles);
+ FileSource2: IFileSource; var SelectedFiles2: TFiles;
+ Modal: Boolean = False);
var
I: Integer;
begin
- case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1) of
+ FModal := Modal;
+
+ case PrepareData(FileSource1, SelectedFiles1, @OnCopyOutStateChanged1, Modal) of
pdrSynchronous:
begin
FFileList1 := TStringList.Create;
@@ -804,7 +825,7 @@
begin
try
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
finally
Free;
end;
@@ -812,7 +833,7 @@
end;
end;
- case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2) of
+ case PrepareData(FileSource2, SelectedFiles2, @OnCopyOutStateChanged2, Modal) of
pdrSynchronous:
begin
FFileList2 := TStringList.Create;
@@ -840,7 +861,7 @@
begin
if Operation.Result = fsorFinished then
begin
- FWaitData1 := TEditorWaitData.Create(Operation as TFileSourceCopyOperation);
+ FWaitData1 := TEditorWaitData.Create(Operation as TFileSourceCopyOperation, FModal);
FFileList1 := FWaitData1.GetFileList;
end
else
@@ -863,7 +884,7 @@
begin
if Operation.Result = fsorFinished then
begin
- FWaitData2 := TEditorWaitData.Create(Operation as TFileSourceCopyOperation);
+ FWaitData2 := TEditorWaitData.Create(Operation as TFileSourceCopyOperation, FModal);
FFileList2 := FWaitData2.GetFileList;
end
else
@@ -886,7 +907,7 @@
if FFailed then
begin
if FCallOnFail then
- FFunc(nil, nil);
+ FFunc(nil, nil, FModal);
Exit;
end;
if Assigned(FFileList2) then
@@ -897,10 +918,10 @@
WaitData := TWaitDataDouble.Create(FWaitData1, FWaitData2);
FWaitData1 := nil;
FWaitData2 := nil;
- FFunc(FFileList1, WaitData);
+ FFunc(FFileList1, WaitData, FModal);
end
else
- FFunc(FFileList1, nil);
+ FFunc(FFileList1, nil, FModal);
finally
Free;
end;
@@ -936,7 +957,8 @@
procedure PrepareToolData(FileSource1: IFileSource; File1: TFile;
FileSource2: IFileSource; File2: TFile;
- FunctionToCall: TToolDataPreparedProc);
+ FunctionToCall: TToolDataPreparedProc;
+ Modal: Boolean = False);
var Files1, Files2: TFiles;
begin
Files1 := TFiles.Create(File1.Path);
@@ -946,7 +968,7 @@
try
Files2.Add(File2.Clone);
with TToolDataPreparator2.Create(FunctionToCall) do
- Prepare(FileSource1, Files1, FileSource2, Files2);
+ Prepare(FileSource1, Files1, FileSource2, Files2, Modal);
finally
Files2.Free;
end;
Index: src/uShowMsg.pas
===================================================================
--- src/uShowMsg.pas (revision 7965)
+++ src/uShowMsg.pas (working copy)
@@ -54,9 +54,14 @@
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbRenameSource,
- msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin);
+ msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
+ // Actions, they do not close the form and therefore have no corresponding result value:
+ msmbCompare);
+ TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
+ TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
+
{ TDialogMainThread }
TDialogMainThread = class
@@ -103,7 +108,7 @@
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
@@ -283,7 +288,10 @@
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
@@ -308,9 +316,13 @@
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
- begin
- with frmMsg.Components[iIndex] as TButton do TabOrder:=(tag+(iCount+1)-iIndexDefault) mod (iCount+1); //Tricky but it does it, no "if", no negative after to check, etc.
- end;
+ with frmMsg.Components[iIndex] as TButton do
+ begin
+ if Tag >= 0 then
+ TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
+ else
+ TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
+ end;
end;
end;
@@ -332,7 +344,10 @@
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
- Tag:= iIndex;
+ if Buttons[iIndex] >= Low(TMyMsgActionButton) then
+ Tag:= -2-iIndex
+ else
+ Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
@@ -341,14 +356,33 @@
end;
end;
-function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
+type TMsgBoxHelper = class
+ Buttons: array of TMyMsgButton;
+ ActionHandler: TMyMsgActionHandler;
+ procedure MsgBoxActionHandler(Tag: PtrInt);
+end;
+
+procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
+begin
+ ActionHandler(Buttons[-Tag-2]);
+end;
+
+function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
+ MsgBoxHelper: TMsgBoxHelper = nil;
+ I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
+ MsgBoxHelper := TMsgBoxHelper.Create();
+ SetLength(MsgBoxHelper.Buttons, Length(Buttons));
+ for I := Low(Buttons) to High(Buttons) do
+ MsgBoxHelper.Buttons[I] := Buttons[I];
+ MsgBoxHelper.ActionHandler := ActionHandler;
+ frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
- SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
+ SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
@@ -359,6 +393,7 @@
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
+ MsgBoxHelper.Free;
end;
end;
@@ -769,6 +804,7 @@
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
+ cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
| ||||
| Fixed in Revision | 8197 | ||||
| Operating system | |||||
| Widgetset | |||||
| Architecture | |||||
|
|
Загрузил предварительный патч. Для всех операций, кроме CopyOut из WCX, когда плагин не поддерживает фоновые операции. GIO не тестировалось. Изменения в следующих файлах под вопросом, они потребовались для запуска модальной операции в процессе другой модальной операций (WFX FTP): src/filesources/ufilesourceoperationmisc.pas src/platform/uosforms.pas |
|
|
Новые версии патчей в соответствии с обсуждением здесь: https://doublecmd.sourceforge.io/forum/viewtopic.php?p=22589#p22589 2 - фикс сборки под линукс 3 - фикс закрытия по крестику после нажатия кнопки "сравнить" 4 - модальная операция распаковки 5 - модальный диффер 6 - фикс для gio |
|
|
Изменения "src/filesources/ufilesourceoperationmisc.pas" теоретически не должны иметь негативных последствий. Изменения "src/platform/uosforms.pas" - время покажет. >>>5 - модальный диффер Полагаю это временный вариант? Все таки модальным диффер должен быть только в этом конкретном случае. |
|
|
Да, модальность в таком виде только для проверки добавлена. Надеялся, что обойдется вообще без нее - под win почему-то и без нее работает. В конечной версии сделаю только для вызовов из этого окна. А в перспективе есть идея само окно подтверждения file exists сделать немодальным, что скажете? Открыть его немодально и заблокировать поток операции на mutex, который освободить при закрытии окна. По идее, так для самого потока AskQuestion останется "модальным", но всё остальное приложение блокироваться не будет. |
|
|
7 - добавлен отладочный вывод 8 - фикс сборки под линукс 9 - модальные операции и диффер только из окна операции 10 - фикс сборки под линукс |
|
|
Можно как-то сделать опциональную поддержку GIO под Windows, как с SVG сделали? У GIMP в папке libgio dll тоже есть. file:// в таком случае я же смогу открывать? |
|
|
На постоянно его включать мне кажется излишним. А вот чисто для теста можно включить, надо лишь поправить имена библиотек, и добавить регистрацию GioFileSource. Полагаю file:// будет работать. Хотя как по мне проще поставить Линукс в VirtualBox и тестировать в реальном окружении. У меня к примеру десяток виртуальных машин для этого. |
|
|
11 - откачены изменения в gio до начальной версии, попытка исправить в другом файле 12 - наконец, рабочий фикс gio, причина оказалась в том, что File.FullPath содержит протокол (CurrentAddress), а от Files.Path при копировании ожидалось, что не будет его содержать 13 - альтернативный фикс, отрезание CurrentAddress вместо дополнительной проверки в CopyOut. Плюс workaround для отображения правильного пути обратного копирования. 14 - модальное окно ожидания внешнего редактора и операция обратного копирования (при запуске из окна замены). Основан на версии 12 + фикс пути из версии 13. |
|
|
Применил последнюю версию патча. |
| Date Modified | Username | Field | Change |
|---|---|---|---|
| 2016-09-19 02:22 | cordylus | New Issue | |
| 2018-01-08 08:21 | cordylus | File Added: bug1536-preview1.patch | |
| 2018-01-08 08:21 | cordylus | Note Added: 0002497 | |
| 2018-01-08 16:51 | cordylus | File Added: bug1536-preview2.patch | |
| 2018-01-08 17:03 | cordylus | Note Edited: 0002497 | |
| 2018-01-08 18:22 | cordylus | File Added: bug1536-preview3.patch | |
| 2018-01-08 18:28 | cordylus | Note Added: 0002501 | |
| 2018-01-08 22:56 | cordylus | File Added: bug1536-preview4.patch | |
| 2018-01-09 01:10 | cordylus | File Added: bug1536-preview5.patch | |
| 2018-01-09 02:58 | cordylus | File Added: bug1536-preview6.patch | |
| 2018-01-09 03:06 | cordylus | Note Edited: 0002501 | |
| 2018-01-09 08:11 | Alexx2000 | Note Added: 0002502 | |
| 2018-01-10 01:09 | cordylus | File Added: bug1536-preview7.patch | |
| 2018-01-10 01:34 | cordylus | Note Added: 0002503 | |
| 2018-01-10 01:39 | cordylus | File Added: bug1536-preview8.patch | |
| 2018-01-10 05:53 | cordylus | File Added: bug1536-preview9.patch | |
| 2018-01-10 05:55 | cordylus | Note Added: 0002504 | |
| 2018-01-10 19:18 | cordylus | File Added: bug1536-preview10.patch | |
| 2018-01-10 23:04 | cordylus | Note Edited: 0002504 | |
| 2018-01-10 23:11 | cordylus | Note Added: 0002505 | |
| 2018-01-13 21:47 | cordylus | File Added: bug1536-preview11.patch | |
| 2018-01-14 00:57 | Alexx2000 | Note Added: 0002507 | |
| 2018-01-17 09:44 | cordylus | File Added: bug1536-preview12.patch | |
| 2018-01-19 10:12 | cordylus | File Added: bug1536-preview13.patch | |
| 2018-01-19 10:30 | cordylus | Note Added: 0002508 | |
| 2018-01-19 10:34 | cordylus | Note Edited: 0002508 | |
| 2018-01-20 00:58 | cordylus | File Added: bug1536-preview14.patch | |
| 2018-01-20 01:00 | cordylus | Note Edited: 0002508 | |
| 2018-07-08 14:35 | Alexx2000 | Note Added: 0002671 | |
| 2018-07-08 14:35 | Alexx2000 | Status | new => feedback |
| 2018-07-08 14:36 | Alexx2000 | Fixed in Revision | => 8197 |
| 2018-07-08 14:36 | Alexx2000 | Target Version | => 0.9.0 |
| 2018-12-10 09:00 | Alexx2000 | Status | feedback => resolved |
| 2018-12-10 09:00 | Alexx2000 | Fixed in Version | => 0.9.0 |
| 2018-12-10 09:00 | Alexx2000 | Resolution | open => fixed |
| 2018-12-10 09:00 | Alexx2000 | Assigned To | => Alexx2000 |
| 2021-09-05 15:10 | Alexx2000 | Status | resolved => closed |
