master 4287e94: Add a new debugging/exploration command `yank-media-types'

[Lars Ingebrigtsen]

branch: master
commit 4287e94c3051edcf9dbbb194af03c34120a7a4e2
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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 530634e..fd9b3e7 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 2c79a14..aa7d8ab 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