From 4287e94c3051edcf9dbbb194af03c34120a7a4e2 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 8 Nov 2021 05:44:10 +0100
Subject: [PATCH] Add a new debugging/exploration command `yank-media-types'

* lisp/yank-media.el (yank-media-types): New command.
(yank-media-types--format): Helper command.
---
 etc/NEWS           |  6 ++++
 lisp/yank-media.el | 84 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 89 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index 530634eabc0..fd9b3e7a82c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -598,12 +598,18 @@ Use 'exif-parse-file' and 'exif-field' instead.
 
 * Lisp Changes in Emacs 29.1
 
++++
 *** New command 'yank-media'.
 This command supports yanking non-plain-text media like images and
 HTML from other applications into Emacs.  It is only supported in
 modes that have registered support for it, and only on capable
 platforms.
 
+---
+*** New command 'yank-media-types'.
+This command lets you examine all data in the current selection and
+the clipboard, and insert it into the buffer.
+
 +++
 *** New text property 'inhibit-isearch'.
 If set, 'isearch' will skip these areas, which can be useful (for
diff --git a/lisp/yank-media.el b/lisp/yank-media.el
index 2c79a14e7d3..aa7d8abfd48 100644
--- a/lisp/yank-media.el
+++ b/lisp/yank-media.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'seq)
 
 (defvar yank-media--registered-handlers nil)
 
@@ -33,7 +34,10 @@
   "Yank media (images, HTML and the like) from the clipboard.
 This command depends on the current major mode having support for
 accepting the media type.  The mode has to register itself using
-the `yank-media-handler' mechanism."
+the `yank-media-handler' mechanism.
+
+Also see `yank-media-types' for a command that lets you explore
+all the different selection types."
   (interactive)
   (unless yank-media--registered-handlers
     (user-error "The `%s' mode hasn't registered any handlers" major-mode))
@@ -102,6 +106,84 @@ data (a string)."
     (setf (alist-get type yank-media--registered-handlers nil nil #'equal)
           handler)))
 
+(defun yank-media-types ()
+  "Yank any element present in the primary selection or the clipboard.
+This is primarily meant as a debugging tool -- many of the
+elements (like images) will be inserted as raw data into the
+current buffer.  See `yank-media' instead for a command that
+inserts images as images."
+  (interactive)
+  (let ((elements nil))
+    ;; First gather all the data.
+    (dolist (type '(PRIMARY CLIPBOARD))
+      (when-let ((data-types (gui-get-selection type 'TARGETS)))
+        (when (vectorp data-types)
+          (seq-do (lambda (data-type)
+                    (unless (memq data-type '( TARGETS MULTIPLE
+                                               DELETE SAVE_TARGETS))
+                      (when-let ((data (gui-get-selection type data-type)))
+                        ;; Remove duplicates -- the data in PRIMARY and
+                        ;; CLIPBOARD are sometimes (mostly) identical,
+                        ;; and sometimes not.
+                        (let ((old (assq data-type elements)))
+                          (when (or (not old)
+                                    (not (equal (nth 2 old) data)))
+                            (push (list data-type type data)
+                                  elements))))))
+                  data-types))))
+    ;; Then query the user.
+    (unless elements
+      (user-error "No elements in the primary selection or the clipboard"))
+    (let ((spec
+           (completing-read
+            "Yank type: "
+            (mapcar (lambda (e)
+                      (format "%s:%s" (downcase (symbol-name (cadr e)))
+                              (car e)))
+                    elements)
+            nil t)))
+      (dolist (elem elements)
+        (when (equal (format "%s:%s" (downcase (symbol-name (cadr elem)))
+                             (car elem))
+                     spec)
+          (insert (yank-media-types--format (car elem) (nth 2 elem))))))))
+
+(defun yank-media-types--format (data-type data)
+  (cond
+   ((not (stringp data))
+    (format "%s" data))
+   ((string-match-p "\\`text/" (symbol-name data-type))
+    ;; We may have utf-16, which Emacs won't detect automatically.
+    (let ((coding-system
+           (and (zerop (mod (length data) 2))
+                (let ((stats (vector 0 0)))
+                  (dotimes (i (length data))
+                    (when (zerop (elt data i))
+                      (setf (aref stats (mod i 2))
+                            (1+ (aref stats (mod i 2))))))
+                  ;; If we have more than 90% every-other nul, then it's
+                  ;; pretty likely to be utf-16.
+                  (cond
+                   ((> (if (zerop (elt stats 1))
+                           1
+                         (/ (float (elt stats 0))
+                            (float (elt stats 1))))
+                       0.9)
+                    ;; Big endian.
+                    'utf-16-be)
+                   ((> (if (zerop (elt stats 0))
+                           1
+                         (/ (float (elt stats 1))
+                            (float (elt stats 0))))
+                       0.9)
+                    ;; Little endian.
+                    'utf-16-le))))))
+      (if coding-system
+          (decode-coding-string data coding-system)
+        data)))
+   (t
+    data)))
+
 (provide 'yank-media)
 
 ;;; yank-media.el ends here
-- 
2.39.2