Add a new debugging/exploration command `yank-media-types'

* lisp/yank-media.el (yank-media-types): New command.
(yank-media-types--format): Helper command.

diff --git a/etc/NEWS b/etc/NEWS
index 530634eabc0c267aa25818fbbade5c5a2892fc8e..fd9b3e7a82ceacfa5560f3066907b938c5d9174e 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -598,12 +598,18 @@ Use 'exif-parse-file' and 'exif-field' instead.
 \f
 * 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 2c79a14e7d320b4c92c192bcf086867d868b8661..aa7d8abfd4844cd30ffaf2c5e62fb410c9982dc8 100644 (file)
--- 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