Bug 1848: Local file panel honors preferred drop action of source application

https://winscp.net/tracker/1848

Source commit: 0ec1a50bc9f5d96c0b2230f5f50d07debf023444

source/components/UnixDirView.cpp

@@ -814,14 +814,14 @@ bool __fastcall TUnixDirView::TargetHasDropHandler(TListItem * /* Item */, int /
   return false;
 }
 //---------------------------------------------------------------------------
-void __fastcall TUnixDirView::DDChooseEffect(int grfKeyState, int &dwEffect)
+void __fastcall TUnixDirView::DDChooseEffect(int grfKeyState, int &dwEffect, int PreferredEffect)
 {
   if ((grfKeyState & (MK_CONTROL | MK_SHIFT)) == 0)
   {
     dwEffect = DROPEFFECT_COPY;
   }
 
-  TCustomDirView::DDChooseEffect(grfKeyState, dwEffect);
+  TCustomDirView::DDChooseEffect(grfKeyState, dwEffect, PreferredEffect);
 }
 //---------------------------------------------------------------------------
 TDropEffectSet __fastcall TUnixDirView::GetDragSourceEffects()

source/components/UnixDirView.h

@@ -41,7 +41,7 @@ protected:
   virtual void __fastcall DDDragDetect(int grfKeyState, const TPoint &DetectStart,
     const TPoint &Point, TDragDetectStatus DragStatus);
   virtual void __fastcall DDMenuDone(TObject* Sender, HMENU AMenu);
-  virtual void __fastcall DDChooseEffect(int grfKeyState, int &dwEffect);
+  virtual void __fastcall DDChooseEffect(int grfKeyState, int &dwEffect, int PreferredEffect);
   virtual void __fastcall AddToDragFileList(TFileList* FileList, TListItem* Item);
   void __fastcall DoChangeDirectory(TObject * Sender);
   void __fastcall DoReadDirectory(TObject * Sender, bool ReloadOnly);

source/components/UnixDriveView.cpp

@@ -579,7 +579,7 @@ void __fastcall TCustomUnixDriveView::PerformDragDropFileOperation(
   }
 }
 //---------------------------------------------------------------------------
-void __fastcall TCustomUnixDriveView::DDChooseEffect(int KeyState, int & Effect)
+void __fastcall TCustomUnixDriveView::DDChooseEffect(int KeyState, int & Effect, int PreferredEffect)
 {
   // if any drop effect is allowed at all (e.g. no drop to self and drop to parent)
   if (Effect != DROPEFFECT_NONE)
@@ -597,7 +597,7 @@ void __fastcall TCustomUnixDriveView::DDChooseEffect(int KeyState, int & Effect)
     }
   }
 
-  TCustomDriveView::DDChooseEffect(KeyState, Effect);
+  TCustomDriveView::DDChooseEffect(KeyState, Effect, PreferredEffect);
 }
 //---------------------------------------------------------------------------
 void __fastcall TCustomUnixDriveView::UpdateDropTarget()

source/components/UnixDriveView.h

@@ -54,7 +54,7 @@ protected:
   void __fastcall SetDirView(TUnixDirView * Value);
 
   virtual void __fastcall PerformDragDropFileOperation(TTreeNode * Node, int Effect);
-  virtual void __fastcall DDChooseEffect(int KeyState, int & Effect);
+  virtual void __fastcall DDChooseEffect(int KeyState, int & Effect, int PreferredEffect);
   virtual bool __fastcall DragCompleteFileList();
   virtual TDropEffectSet __fastcall DDSourceEffects();
 

source/forms/CustomScpExplorer.cpp

@@ -9784,8 +9784,8 @@ void __fastcall TCustomScpExplorerForm::SessionsPageControlDragOver(
   }
 }
 //---------------------------------------------------------------------------
-void __fastcall TCustomScpExplorerForm::SessionsDDDragOver(int /*KeyState*/,
-  const TPoint & Point, int & Effect)
+void __fastcall TCustomScpExplorerForm::SessionsDDDragOver(
+  int DebugUsedArg(KeyState), const TPoint & Point, int & Effect, int DebugUsedArg(PreferredEffect))
 {
   int Index = SessionsPageControl->IndexOfTabAt(Point.X, Point.Y);
   if (Index < 0)

source/forms/CustomScpExplorer.h

@@ -304,7 +304,7 @@ private:
     const TGUICopyParamType & CopyParam, int Params);
   void __fastcall AddQueueItem(TTerminalQueue * Queue, TQueueItem * QueueItem, TManagedTerminal * Terminal);
   void __fastcall ClearTransferSourceSelection(TTransferDirection Direction);
-  void __fastcall SessionsDDDragOver(int KeyState, const TPoint & Point, int & Effect);
+  void __fastcall SessionsDDDragOver(int KeyState, const TPoint & Point, int & Effect, int PreferredEffect);
   void __fastcall SessionsDDProcessDropped(TObject * Sender, int KeyState, const TPoint & Point, int Effect);
   void __fastcall RemoteFileControlDragDropFileOperation(
     TObject * Sender, int Effect, UnicodeString TargetPath, bool ForceQueue, bool Paste);

source/packages/dragndrop/DragDrop.pas

@@ -79,7 +79,7 @@ type
   TOnDragEnter = procedure(DataObj: IDataObject; grfKeyState: LongInt; pt: TPoint;
      var dwEffect: LongInt; var Accept: Boolean) of object;
   TOnDragLeave = procedure of object;
-  TOnDragOver = procedure(grfKeyState: LongInt; pt: TPoint; var dwEffect: LongInt) of object;
+  TOnDragOver = procedure(grfKeyState: LongInt; pt: TPoint; var dwEffect: LongInt; PreferredEffect: LongInt) of object;
   TOnDrop = procedure(DataObj: IDataObject; grfKeyState: LongInt;  pt: TPoint; var dwEffect: LongInt) of object;
   TOnQueryContinueDrag = procedure(fEscapePressed: BOOL; grfKeyState: LongInt; var Result: HResult) of object;
   TOnGiveFeedback = procedure(dwEffect: LongInt; var Result: HResult) of object;
@@ -180,6 +180,7 @@ type
     VertScrollTimer: TTimer;
     FVScrollCode: Integer;
     FHScrollCode: Integer;
+    FPreferredEffect: LongInt;
     procedure InitScroll(VerticalScroll: Boolean; ScrollCode: Integer);
     procedure TermScroll(VerticalScroll: Boolean);
     procedure DetermineScrollDir(VertScrolling: Boolean; var ScrollCode: Integer);
@@ -387,6 +388,9 @@ resourcestring
 
 implementation
 
+uses
+  PIDL;
+
 const
   CmdAbort = 0;
   CmdMove = 1;
@@ -1172,10 +1176,12 @@ procedure TDropTarget.SuggestDropEffect(grfKeyState: LongInt; var dwEffect: Long
 begin
   if (not FOwner.FAcceptOwnDnD) and FOwner.FOwnerIsSource then dwEffect := DROPEFFECT_NONE
     else
-  if (grfKeyState and MK_CONTROL = 0) and (grfKeyState and MK_SHIFT <> 0) and
+  if (((grfKeyState and MK_CONTROL = 0) and (grfKeyState and MK_SHIFT <> 0)) or
+      (FPreferredEffect and DROPEFFECT_MOVE <> 0)) and
      (FOwner.FTargetEffects and DROPEFFECT_MOVE <> 0) then dwEffect := DROPEFFECT_MOVE
     else
-  if (grfKeyState and MK_CONTROL <> 0) and (grfKeyState and MK_SHIFT <> 0) and
+  if (((grfKeyState and MK_CONTROL <> 0) and (grfKeyState and MK_SHIFT <> 0)) or
+      (FPreferredEffect and DROPEFFECT_LINK <> 0)) and
      (FOwner.FTargetEffects and DROPEFFECT_LINK <> 0) then dwEffect := DROPEFFECT_LINK
     else
   if (deCopy in FOwner.FTargetEffectsSet) and (dwEffect and DROPEFFECT_COPY <> 0) then dwEffect := DROPEFFECT_COPY
@@ -1197,6 +1203,10 @@ function TDropTarget.DragEnter(
   const dataObj: IDataObject; grfKeyState: LongInt; pt: TPoint; var dwEffect: LongInt): HResult;
 // Is called if the d&d-mouse cursor moves ON (one call only) the TargeTWinControl. Here,
 // you influence if a drop can be accepted and the drop's effect if accepted.
+var
+  FormatEtc: TFormatEtc;
+  StgMedium: TStgMedium;
+  Ptr: Pointer;
 begin
   TDragDrop(FOwner).FInternalSource := GInternalSource;
   FOwner.FAvailableDropEffects := dwEffect;
@@ -1206,6 +1216,33 @@ begin
   begin
     RenderDropped(DataObj, grfKeyState, pt, dwEffect);
   end;
+
+  FPreferredEffect := 0;
+  with FormatEtc do
+  begin
+    cfFormat := CF_PREFERREDDROPEFFECT;
+    ptd := nil;
+    dwAspect := DVASPECT_CONTENT;
+    lindex := -1;
+    tymed := TYMED_HGLOBAL;
+  end;
+  if dataObj.GetData(FormatEtc, StgMedium) = S_OK then
+  begin
+    try
+      if GlobalSize(StgMedium.HGlobal) = SizeOf(FPreferredEffect) then
+      begin
+        Ptr := GlobalLock(StgMedium.HGlobal);
+        try
+          FPreferredEffect := PLongInt(Ptr)^;
+        finally
+          GlobalUnLock(StgMedium.HGlobal);
+        end;
+      end;
+    finally
+      ReleaseStgMedium(StgMedium);
+    end;
+  end;
+
   SuggestDropEffect(grfKeyState, dwEffect);
   AcceptDataObject(DataObj, FAccept);
   if Assigned(FOwner.OnDragEnter) then
@@ -1264,7 +1301,7 @@ begin
   SuggestDropEffect(grfKeyState, dwEffect);
   if Assigned(FOwner.OnDragOver) then
   begin
-    FOwner.OnDragOver(grfKeyState, FOwner.FDragDropControl.ScreenToClient(pt), dwEffect);
+    FOwner.OnDragOver(grfKeyState, FOwner.FDragDropControl.ScreenToClient(pt), dwEffect, FPreferredEffect);
   end;
   if ((not FOwner.FAcceptOwnDnD) and FOwner.FOwnerIsSource) or
      (not FAccept) then
@@ -1320,7 +1357,7 @@ begin
     else dwEffect := DROPEFFECT_NONE;
   if Assigned(FOwner.OnDragOver) then
   begin
-    FOwner.OnDragOver(KeyState, FOwner.FDragDropControl.ScreenToClient(pt), dwEffect);
+    FOwner.OnDragOver(KeyState, FOwner.FDragDropControl.ScreenToClient(pt), dwEffect, FPreferredEffect);
   end;
   if ((not FOwner.FAcceptOwnDnD) and FOwner.FOwnerIsSource) or (not FAccept) then dwEffect := DROPEFFECT_NONE;
   TermScroll(True);

source/packages/filemng/CustomDirView.pas

@@ -230,8 +230,8 @@ type
     procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint; DragStatus: TDragDetectStatus); virtual;
     procedure DDDragEnter(DataObj: IDataObject; grfKeyState: Longint; Point: TPoint; var dwEffect: longint; var Accept: Boolean);
     procedure DDDragLeave;
-    procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint);
-    procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); virtual;
+    procedure DDDragOver(grfKeyState: Longint; Point: TPoint; var dwEffect: Longint; PreferredEffect: LongInt);
+    procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer); virtual;
     procedure DDDrop(DataObj: IDataObject; grfKeyState: LongInt; Point: TPoint; var dwEffect: Longint);
     procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint; Point: TPoint; dwEffect: Longint); virtual;
     procedure DDGiveFeedback(dwEffect: Longint; var Result: HResult); virtual;
@@ -2190,7 +2190,7 @@ begin
 end;
 
 procedure TCustomDirView.DDDragOver(grfKeyState: Integer; Point: TPoint;
-  var dwEffect: Integer);
+  var dwEffect: Integer; PreferredEffect: Integer);
 var
   DropItem: TListItem;
   CanDrop: Boolean;
@@ -2235,7 +2235,7 @@ begin
   {Set dropeffect:}
   if (not HasDropHandler) and (not Loading) then
   begin
-    DDChooseEffect(grfKeyState, dwEffect);
+    DDChooseEffect(grfKeyState, dwEffect, PreferredEffect);
 
     if Assigned(FOnDDDragOver) then
       FOnDDDragOver(Self, grfKeyState, Point, dwEffect);
@@ -2442,7 +2442,7 @@ begin
   DropTarget := nil;
 end;
 
-procedure TCustomDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer);
+procedure TCustomDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
 begin
   if Assigned(FOnDDChooseEffect) then
     FOnDDChooseEffect(Self, grfKeyState, dwEffect);

source/packages/filemng/CustomDriveView.pas

@@ -109,7 +109,7 @@ type
     procedure DDDragEnter(DataObj: IDataObject; KeyState: Longint;
       Point: TPoint; var Effect: Longint; var Accept: Boolean);
     procedure DDDragLeave;
-    procedure DDDragOver(KeyState: Longint; Point: TPoint; var Effect: Longint);
+    procedure DDDragOver(KeyState: Longint; Point: TPoint; var Effect: Longint; PreferredEffect: LongInt);
     procedure DDDrop(DataObj: IDataObject; KeyState: Longint; Point: TPoint;
       var Effect: Longint);
     procedure DDQueryContinueDrag(EscapePressed: BOOL; KeyState: Longint;
@@ -126,7 +126,7 @@ type
       DragStatus: TDragDetectStatus); virtual;
     procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); virtual; abstract;
 
-    procedure DDChooseEffect(KeyState: Integer; var Effect: Integer); virtual;
+    procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); virtual;
     function DragCompleteFileList: Boolean; virtual; abstract;
     function DDExecute: TDragResult; virtual;
     function DDSourceEffects: TDropEffectSet; virtual; abstract;
@@ -469,7 +469,7 @@ begin
     FOnDDDragLeave(Self);
 end; {DragLeave}
 
-procedure TCustomDriveView.DDDragOver(KeyState: Longint; Point: TPoint; var Effect: Longint);
+procedure TCustomDriveView.DDDragOver(KeyState: Longint; Point: TPoint; var Effect: Longint; PreferredEffect: Longint);
 var
   Node: TTreeNode;
   Rect1: TRect;
@@ -530,7 +530,7 @@ begin
     end;
   end;
 
-  DDChooseEffect(KeyState, Effect);
+  DDChooseEffect(KeyState, Effect, PreferredEffect);
 
   if Assigned(FOnDDDragOver) then
     FOnDDDragOver(Self, KeyState, Point, Effect);
@@ -608,7 +608,7 @@ begin
   DropTarget := nil;
 end;
 
-procedure TCustomDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
+procedure TCustomDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
 begin
   if Assigned(FOnDDChooseEffect) then
     FOnDDChooseEffect(Self, KeyState, Effect);

source/packages/filemng/DirView.pas

@@ -197,7 +197,7 @@ type
     procedure DDMenuDone(Sender: TObject; AMenu: HMenu); override;
     procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
       Point: TPoint; dwEffect: Longint); override;
-    procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer); override;
+    procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer); override;
 
     function GetPathName: string; override;
     procedure SetChangeInterval(Value: Cardinal); virtual;
@@ -3103,8 +3103,7 @@ begin
   end;
 end; {DDDragDetect}
 
-procedure TDirView.DDChooseEffect(grfKeyState: Integer;
-  var dwEffect: Integer);
+procedure TDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
 begin
   if DragDropFilesEx.OwnerIsSource and
      (dwEffect = DROPEFFECT_COPY) and (not Assigned(DropTarget)) then
@@ -3112,7 +3111,7 @@ begin
     dwEffect := DROPEFFECT_NONE
   end
     else
-  if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
+  if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
   begin
     if FDragDrive <> '' then
     begin

source/packages/filemng/DriveView.pas

@@ -211,7 +211,7 @@ type
     function CreateNode: TTreeNode; override;
 
     function DDSourceEffects: TDropEffectSet; override;
-    procedure DDChooseEffect(KeyState: Integer; var Effect: Integer); override;
+    procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); override;
     function DragCompleteFileList: Boolean; override;
     function DDExecute: TDragResult; override;
 
@@ -2448,11 +2448,11 @@ begin
     Result := [deLink, deCopy, deMove];
 end;
 
-procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
+procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
 begin
   if DropTarget = nil then Effect := DROPEFFECT_NONE
     else
-  if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) then
+  if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
   begin
     if FDragDrive <> '' then
     begin