Subject: Re: bug#3468: drag and drop text

From: Cecilio Pardo <[email-masked]>
Date: Mon, 30 Sep 2024 23:20:32 +0200

Here is the reworked version.

Now the processing of the drop data is delayed until we process the 
WM_EMACS_DROP message at w32_read_socket.

There is no malloc/strdup.

From c20e8e3e4880eb65257020ee88298f5697b1dfc3 Mon Sep 17 00:00:00 2001
From: Cecilio Pardo <[email-masked]>
Date: Fri, 27 Sep 2024 23:58:02 +0200
Subject: [PATCH] Implement drag-n-drop for w32 with support for files and text

Implement drag-n-drop with IDropTarget for MS-Windows. This
allows for dropping files or text.

* lisp/term/w32-win.el (w32-drag-n-drop): Changed to handle
files or strings.
* src/w32fns.c (process_dropfiles): New function to convert
DROPFILES struct to array of strings.
(w32_process_dnd_data): New function to process drop data.
(w32_try_get_data): Extract data from IDataObject.
(w32_createwindow): Assign an IDropTarget to each new frame.
(w32_name_of_message): Added new message.
(w32_msg_pump): Changed CoInitialize to OleInitialize, needed
by the drag-n-drop functions.
(w32_wnd_proc): New struct w32_drop_target, and
w32_drop_target_* functions to implement the IDropTarget
interface.
* src/w32term.c (w32_read_socket): Handle WM_EMACS_DROP and
remove WM_EMACS_DROPFILES.
* src/w32term.h (): Added new message WM_EMACS_DROP.

..
---
 etc/NEWS             |   5 ++
 lisp/term/w32-win.el |  25 ++++--
 src/w32fns.c         | 203 +++++++++++++++++++++++++++++++++++++++++--
 src/w32term.c        |  98 ++++-----------------
 src/w32term.h        |   4 +-
 5 files changed, 242 insertions(+), 93 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 37568ffdbea..7c9f6f559ec 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -584,6 +584,11 @@ In particular, it is now possible to show text with embedded newlines in
 a dialog popped by 'message-box'.  This is supported on Windows Vista
 and later versions.
 
+---
+** Emacs on MS-Windows now supports drag-n-drop of text into a buffer.
+This is in addition to drag-n-drop of files, that was already supported.
+
+
 
 ----------------------------------------------------------------------
 This file is part of GNU Emacs.
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index b57b3dd3bef..541fef2ced3 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -131,8 +131,15 @@ w32-dropped-file-to-url
    file-name))
 
 (defun w32-drag-n-drop (event &optional new-frame)
-  "Edit the files listed in the drag-n-drop EVENT.
-Switch to a buffer editing the last file dropped."
+  "Perform drag-n-drop action according to data in EVENT.
+If EVENT is for one or more files, visit those files in corresponding
+buffers, and switch to the buffer that visits the last dropped file.
+If EVENT is for text, insert that text at point into the buffer
+shown in the window that is the target of the drop; if that buffer is
+read-only, add the dropped text to kill-ring.
+If the optional argument NEW-FRAME is non-nil, perform the
+drag-n-drop action in a newly-created frame using its selected-window
+and that window's buffer."
   (interactive "e")
   (save-excursion
     ;; Make sure the drop target has positive co-ords
@@ -140,6 +147,7 @@ w32-drag-n-drop
     ;; won't work.  <[email-masked]>
     (let* ((window (posn-window (event-start event)))
 	   (coords (posn-x-y (event-start event)))
+           (arg (car (cdr (cdr event))))
 	   (x (car coords))
 	   (y (cdr coords)))
       (if (and (> x 0) (> y 0))
@@ -150,11 +158,14 @@ w32-drag-n-drop
       (raise-frame)
       (setq window (selected-window))
 
-      (dnd-handle-multiple-urls
-       window
-       (mapcar #'w32-dropped-file-to-url
-               (car (cdr (cdr event))))
-       'private))))
+      ;; arg (the payload of the event) is a string when the drop is
+      ;; text, and a list of strings when the drop is one or more files.
+      (if (stringp arg)
+          (dnd-insert-text window 'copy arg)
+        (dnd-handle-multiple-urls
+         window
+         (mapcar #'w32-dropped-file-to-url arg)
+         'private)))))
 
 (defun w32-drag-n-drop-other-frame (event)
   "Edit the files listed in the drag-n-drop EVENT, in other frames.
diff --git a/src/w32fns.c b/src/w32fns.c
index 0a3f5c38a58..dc69a398019 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -34,6 +34,12 @@ #define _WIN32_WINNT 0x0600
 
 #include <c-ctype.h>
 
+#define COBJMACROS /* Ask for C definitions for COM.  */
+#include <shlobj.h>
+#include <oleidl.h>
+#include <objidl.h>
+#include <ole2.h>
+
 #include "lisp.h"
 #include "w32term.h"
 #include "frame.h"
@@ -359,6 +365,9 @@ #define WS_EX_NOACTIVATE 0x08000000L
 
 static struct w32_display_info *w32_display_info_for_name (Lisp_Object);
 
+static void my_post_msg (W32Msg*, HWND, UINT, WPARAM, LPARAM);
+static unsigned int w32_get_modifiers (void);
+
 /* Let the user specify a display with a frame.
    nil stands for the selected frame--or, if that is not a w32 frame,
    the first display on the list.  */
@@ -2464,6 +2473,174 @@ w32_createhscrollbar (struct frame *f, struct scroll_bar * bar)
   return hwnd;
 }
 
+/* From the DROPFILES struct, extract the filenames and return as a list
+   of strings.  */
+static Lisp_Object
+process_dropfiles (DROPFILES *files)
+{
+  char *start_of_files = (char *) files + files->pFiles;
+  char filename[MAX_UTF8_PATH];
+  Lisp_Object lisp_files = Qnil;
+
+  if (files->fWide)
+    {
+      WCHAR *p = (WCHAR *) start_of_files;
+      for (; *p; p += wcslen (p) + 1)
+	{
+	  filename_from_utf16(p, filename);
+	  lisp_files = Fcons (DECODE_FILE (build_string (filename)),
+			      lisp_files );
+	}
+    }
+  else
+    {
+      char *p = start_of_files;
+      for (; *p; p += strlen(p) + 1)
+	{
+	  filename_from_ansi (p, filename);
+	  lisp_files = Fcons (DECODE_FILE (build_string (filename)),
+			      lisp_files );
+	}
+    }
+  return lisp_files;
+}
+
+Lisp_Object
+w32_process_dnd_data (int format, void *hGlobal)
+{
+  Lisp_Object result = Qnil;
+  HGLOBAL hg = (HGLOBAL) hGlobal;
+
+  switch (format)
+    {
+    case CF_HDROP:
+      {
+	DROPFILES *files = (DROPFILES *) GlobalLock (hg);
+	if (files)
+	  result = process_dropfiles (files);
+	GlobalUnlock (hg);
+	break;
+      }
+    case CF_UNICODETEXT:
+      {
+	WCHAR *text = (WCHAR *) GlobalLock (hg);
+	result = from_unicode_buffer (text);
+	GlobalUnlock (hg);
+	break;
+      }
+    case CF_TEXT:
+      {
+	char *text = (char *) GlobalLock (hg);
+	result = DECODE_SYSTEM (build_unibyte_string (text));
+	GlobalUnlock (hg);
+	break;
+      }
+    }
+
+  GlobalFree (hg);
+
+  return result;
+}
+
+struct w32_drop_target {
+  /* i_drop_target must be the first member.  */
+  IDropTarget i_drop_target;
+  HWND hwnd;
+};
+
+static HRESULT STDMETHODCALLTYPE
+w32_drop_target_QueryInterface (IDropTarget *t, REFIID ri, void **r)
+{
+  return E_NOINTERFACE;
+}
+
+static ULONG STDMETHODCALLTYPE
+w32_drop_target_AddRef (IDropTarget *This)
+{
+  return 1;
+}
+
+static ULONG STDMETHODCALLTYPE
+w32_drop_target_Release (IDropTarget *This)
+{
+  struct w32_drop_target *target = (struct w32_drop_target * ) This;
+  free (target->i_drop_target.lpVtbl);
+  free (target);
+  return 0;
+}
+
+static HRESULT STDMETHODCALLTYPE
+w32_drop_target_DragEnter (IDropTarget *This, IDataObject *pDataObj,
+			   DWORD grfKeyState, POINTL pt, DWORD *pdwEffect)
+{
+  *pdwEffect = DROPEFFECT_COPY;
+  return S_OK;
+}
+
+static HRESULT STDMETHODCALLTYPE
+w32_drop_target_DragOver (IDropTarget *This, DWORD grfKeyState, POINTL pt,
+			  DWORD *pdwEffect)
+{
+  *pdwEffect = DROPEFFECT_COPY;
+  return S_OK;
+}
+
+static HRESULT STDMETHODCALLTYPE
+w32_drop_target_DragLeave (IDropTarget *This)
+{
+  return S_OK;
+}
+
+static HGLOBAL w32_try_get_data (IDataObject *pDataObj, int format)
+{
+  FORMATETC formatetc = { format, NULL, DVASPECT_CONTENT, -1,
+			  TYMED_HGLOBAL };
+  STGMEDIUM stgmedium;
+  HRESULT r = IDataObject_GetData (pDataObj, &formatetc, &stgmedium);
+  if (SUCCEEDED (r))
+    {
+      if (stgmedium.tymed == TYMED_HGLOBAL)
+	return stgmedium.hGlobal;
+      ReleaseStgMedium (&stgmedium);
+    }
+  return NULL;
+}
+
+static HRESULT STDMETHODCALLTYPE
+w32_drop_target_Drop (IDropTarget *This, IDataObject *pDataObj,
+		      DWORD grfKeyState, POINTL pt, DWORD *pdwEffect)
+{
+  struct w32_drop_target *target = (struct w32_drop_target *)This;
+  *pdwEffect = DROPEFFECT_COPY;
+
+  W32Msg msg = {0};
+  msg.dwModifiers = w32_get_modifiers();
+  msg.msg.time = GetMessageTime ();
+  msg.msg.pt.x = pt.x;
+  msg.msg.pt.y = pt.y;
+
+  int format = CF_HDROP;
+  HGLOBAL hGlobal = w32_try_get_data (pDataObj, format);
+
+  if (!hGlobal)
+    {
+      format = CF_UNICODETEXT;
+      hGlobal = w32_try_get_data (pDataObj, format);
+    }
+
+  if (!hGlobal)
+    {
+      format = CF_TEXT;
+      hGlobal = w32_try_get_data (pDataObj, format);
+    }
+
+  if (hGlobal)
+      my_post_msg (&msg, target->hwnd, WM_EMACS_DROP, format,
+		   (LPARAM) hGlobal);
+
+  return S_OK;
+}
+
 static void
 w32_createwindow (struct frame *f, int *coords)
 {
@@ -2548,7 +2725,20 @@ w32_createwindow (struct frame *f, int *coords)
       SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
 
       /* Enable drag-n-drop.  */
-      DragAcceptFiles (hwnd, TRUE);
+      struct w32_drop_target *drop_target =
+	malloc (sizeof (struct w32_drop_target));
+      drop_target->hwnd = hwnd;
+
+      IDropTargetVtbl *vtbl = malloc (sizeof (IDropTargetVtbl));
+      drop_target->i_drop_target.lpVtbl = vtbl;
+      vtbl->QueryInterface = w32_drop_target_QueryInterface;
+      vtbl->AddRef = w32_drop_target_AddRef;
+      vtbl->Release = w32_drop_target_Release;
+      vtbl->DragEnter = w32_drop_target_DragEnter;
+      vtbl->DragOver = w32_drop_target_DragOver;
+      vtbl->DragLeave = w32_drop_target_DragLeave;
+      vtbl->Drop = w32_drop_target_Drop;
+      RegisterDragDrop (hwnd, &drop_target->i_drop_target);
 
       /* Enable system light/dark theme.  */
       w32_applytheme (hwnd);
@@ -3399,6 +3589,7 @@ #define M(msg) { msg, # msg }
       M (WM_EMACS_PAINT),
       M (WM_EMACS_IME_STATUS),
       M (WM_CHAR),
+      M (WM_EMACS_DROP),
 #undef M
       { 0, 0 }
   };
@@ -3465,13 +3656,14 @@ w32_msg_pump (deferred_msg * msg_buf)
 	      /* Produced by complete_deferred_msg; just ignore.  */
 	      break;
 	    case WM_EMACS_CREATEWINDOW:
-	      /* Initialize COM for this window. Even though we don't use it,
-		 some third party shell extensions can cause it to be used in
+	      /* Initialize COM for this window.  Needed for RegisterDragDrop.
+		 Some third party shell extensions can cause it to be used in
 		 system dialogs, which causes a crash if it is not initialized.
 		 This is a known bug in Windows, which was fixed long ago, but
 		 the patch for XP is not publicly available until XP SP3,
 		 and older versions will never be patched.  */
-	      CoInitialize (NULL);
+	      OleInitialize (NULL);
+
 	      w32_createwindow ((struct frame *) msg.wParam,
 				(int *) msg.lParam);
 	      if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
@@ -5106,7 +5298,6 @@ #define MOUSEEVENTF_FROMTOUCH 0xFF515700
       return 0;
 
     case WM_MOUSEWHEEL:
-    case WM_DROPFILES:
       wmsg.dwModifiers = w32_get_modifiers ();
       my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
       signal_user_input ();
@@ -5597,7 +5788,7 @@ #define WM_TOUCH 576
       }
 
     case WM_EMACS_DESTROYWINDOW:
-      DragAcceptFiles ((HWND) wParam, FALSE);
+      RevokeDragDrop ((HWND) wParam);
       return DestroyWindow ((HWND) wParam);
 
     case WM_EMACS_HIDE_CARET:
diff --git a/src/w32term.c b/src/w32term.c
index 62037e3b2cd..3a627308137 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -3576,81 +3576,6 @@ w32_construct_mouse_wheel (struct input_event *result, W32Msg *msg,
   return Qnil;
 }
 
-static Lisp_Object
-w32_construct_drag_n_drop (struct input_event *result, W32Msg *msg,
-                           struct frame *f)
-{
-  Lisp_Object files;
-  Lisp_Object frame;
-  HDROP hdrop;
-  POINT p;
-  WORD num_files;
-  wchar_t name_w[MAX_PATH];
-#ifdef NTGUI_UNICODE
-  const int use_unicode = 1;
-#else
-  int use_unicode = w32_unicode_filenames;
-  char name_a[MAX_PATH];
-  char file[MAX_UTF8_PATH];
-#endif
-  int i;
-
-  result->kind = DRAG_N_DROP_EVENT;
-  result->code = 0;
-  result->timestamp = msg->msg.time;
-  result->modifiers = msg->dwModifiers;
-
-  hdrop = (HDROP) msg->msg.wParam;
-  DragQueryPoint (hdrop, &p);
-
-#if 0
-  p.x = LOWORD (msg->msg.lParam);
-  p.y = HIWORD (msg->msg.lParam);
-  ScreenToClient (msg->msg.hwnd, &p);
-#endif
-
-  XSETINT (result->x, p.x);
-  XSETINT (result->y, p.y);
-
-  num_files = DragQueryFile (hdrop, 0xFFFFFFFF, NULL, 0);
-  files = Qnil;
-
-  for (i = 0; i < num_files; i++)
-    {
-      if (use_unicode)
-	{
-	  eassert (DragQueryFileW (hdrop, i, NULL, 0) < MAX_PATH);
-	  /* If DragQueryFile returns zero, it failed to fetch a file
-	     name.  */
-	  if (DragQueryFileW (hdrop, i, name_w, MAX_PATH) == 0)
-	    continue;
-#ifdef NTGUI_UNICODE
-	  files = Fcons (from_unicode_buffer (name_w), files);
-#else
-	  filename_from_utf16 (name_w, file);
-	  files = Fcons (DECODE_FILE (build_unibyte_string (file)), files);
-#endif /* NTGUI_UNICODE */
-	}
-#ifndef NTGUI_UNICODE
-      else
-	{
-	  eassert (DragQueryFileA (hdrop, i, NULL, 0) < MAX_PATH);
-	  if (DragQueryFileA (hdrop, i, name_a, MAX_PATH) == 0)
-	    continue;
-	  filename_from_ansi (name_a, file);
-	  files = Fcons (DECODE_FILE (build_unibyte_string (file)), files);
-	}
-#endif
-    }
-
-  DragFinish (hdrop);
-
-  XSETFRAME (frame, f);
-  result->frame_or_window = frame;
-  result->arg = files;
-  return Qnil;
-}
-
 
 #if HAVE_W32NOTIFY
 
@@ -5682,11 +5607,26 @@ w32_read_socket (struct terminal *terminal,
 	  }
 	  break;
 
-	case WM_DROPFILES:
-	  f = w32_window_to_frame (dpyinfo, msg.msg.hwnd);
+	case WM_EMACS_DROP:
+	  {
+	    int format = msg.msg.wParam;
+	    Lisp_Object drop_object =
+	      w32_process_dnd_data (format, (void *) msg.msg.lParam);
 
-	  if (f)
-	    w32_construct_drag_n_drop (&inev, &msg, f);
+	    f = w32_window_to_frame (dpyinfo, msg.msg.hwnd);
+	    if (!f || NILP (drop_object))
+	      break;
+
+	    XSETFRAME (inev.frame_or_window, f);
+	    inev.kind = DRAG_N_DROP_EVENT;
+	    inev.code = 0;
+	    inev.timestamp = msg.msg.time;
+	    inev.modifiers = msg.dwModifiers;
+	    ScreenToClient (msg.msg.hwnd, &msg.msg.pt);
+	    XSETINT (inev.x, msg.msg.pt.x);
+	    XSETINT (inev.y, msg.msg.pt.y);
+	    inev.arg = drop_object;
+	  }
 	  break;
 
 	case WM_HSCROLL:
diff --git a/src/w32term.h b/src/w32term.h
index 47be542f570..39e2262e2a8 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -272,6 +272,7 @@ #define CP_DEFAULT 1004
 
 /* w32fns.c */
 extern void w32_default_font_parameter (struct frame* f, Lisp_Object parms);
+extern Lisp_Object w32_process_dnd_data (int format, void *pDataObj);
 
 
 #define PIX_TYPE COLORREF
@@ -710,7 +711,8 @@ #define WM_EMACS_BRINGTOTOP            (WM_EMACS_START + 23)
 #define WM_EMACS_INPUT_READY           (WM_EMACS_START + 24)
 #define WM_EMACS_FILENOTIFY            (WM_EMACS_START + 25)
 #define WM_EMACS_IME_STATUS            (WM_EMACS_START + 26)
-#define WM_EMACS_END                   (WM_EMACS_START + 27)
+#define WM_EMACS_DROP                  (WM_EMACS_START + 27)
+#define WM_EMACS_END                   (WM_EMACS_START + 28)
 
 #define WND_FONTWIDTH_INDEX    (0)
 #define WND_LINEHEIGHT_INDEX   (4)
-- 
2.35.1.windows.2