BUG+PATCH org-capture hangs under Cygwin/X

[Max Mikhanosha <max.mikhanosha@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1120 bytes --]

Due to various reasons I'm now using Cygwin/X Emacs, and for this emacs,
(gui-get-selection) method is kind of slow (about 0.2) seconds.

While this is not a big deal usually, (org-get-x-clipboard) calls
(gui-get-selection) 4 times with different formats (utf8, text,
compound-text and string).

On top of that, (org-capture-fill-template) calls (org-get-x-clipboard) 3
times with PRIMARY, CLIPBOARD and SECONDARY, and then calls it again to
make values for the ^%C expansion.

In addition it also calls (current-kill 0), which in itself calls
(gui-selection-value), which also may call (gui-get-selection up to 4
times), and has a side effect of clearing the clipboard if
select-use-clipboard is true.

All of the above calls are made even if template parameters don't have any
expansions that reference selection.

This results in org-capture having about 16 second hang for me on Cygwin/X
when clipboard and selection are completely empty.

Attached patch changes it so that we only call (org-get-x-clipboard) and
(current-kill 0) lazily. The logic had not changed, we just don't pre-cache
values that we don't need.

[-- Attachment #1.2: Type: text/html, Size: 1320 bytes --]

[-- Attachment #2: 0001-org-capture-fix-hang-under-Cygwin-X-emacs.patch --]
[-- Type: application/octet-stream, Size: 5215 bytes --]

From 4cc539e1b379381f0b6496ff901e351c85803611 Mon Sep 17 00:00:00 2001
From: Max Mikhanosha <max.mikhanosha@gmail.com>
Date: Tue, 12 Jul 2022 04:19:12 +0100
Subject: [PATCH]   org-capture: fix hang under Cygwin/X emacs.

  * org-capture.el (org-capture-fill-template): change it so that
  (current-kill 0) and (org-get-x-selection) are called only lazily on
  as needed basis, and their results are cached.

  This reduces worst case of calling (gui-get-selection) from 28 times
  to 12 (worst case being both clipboard and selection being empty)
  and in the best case of there being no %x %c or %^C template
  arguments there will be zero calls
---
 lisp/org-capture.el | 46 +++++++++++++++++++++++++++++----------------
 1 file changed, 30 insertions(+), 16 deletions(-)

diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 9ef160d16..d75191ed5 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1589,11 +1589,8 @@ (defun org-capture-fill-template (&optional template initial annotation)
 	 (v-T (format-time-string (org-time-stamp-format t) time))
 	 (v-u (format-time-string (org-time-stamp-format nil t) time))
 	 (v-U (format-time-string (org-time-stamp-format t t) time))
-	 (v-c (and kill-ring (current-kill 0)))
-	 (v-x (or (org-get-x-clipboard 'PRIMARY)
-		  (org-get-x-clipboard 'CLIPBOARD)
-		  (org-get-x-clipboard 'SECONDARY)
-		  ""))			;ensure it is a string
+         (obtained-v-c nil)
+         (v-c nil)
          ;; `initial' and `annotation' might have been passed.  But if
 	 ;; the property list has them, we prefer those values.
 	 (v-i (or (plist-get org-store-link-plist :initial)
@@ -1630,13 +1627,21 @@ (defun org-capture-fill-template (&optional template initial annotation)
 		""))
 	 (v-f (or (org-capture-get :original-file-nondirectory) ""))
 	 (v-F (or (org-capture-get :original-file) ""))
-	 (org-capture--clipboards
-	  (delq nil
-		(list v-i
-		      (org-get-x-clipboard 'PRIMARY)
-		      (org-get-x-clipboard 'CLIPBOARD)
-		      (org-get-x-clipboard 'SECONDARY)
-		      v-c))))
+         ;; On Cygwin/X org-get-x-clipboard is extremely slow
+         ;; therefore use lazy evaluation for calling x-org-get-clipboard
+         (x-clip-cache (list (list 'PRIMARY nil nil)
+                             (list 'CLIPBOARD nil nil)
+                             (list 'SECONDARY nil nil)))
+         org-capture--clipboards)
+    (cl-flet ((current-kill-cached ()
+                                   (if obtained-v-c v-c
+                                     (setq obtained-v-c t
+                                           v-c (and kill-ring (current-kill 0)))))
+              (x-clipboard-cached (selection)
+                                  (let ((cache (assoc selection x-clip-cache)))
+                                    (if (second cache) (third cache)
+                                      (setf (second cache) t)
+                                      (setf (third cache) (org-get-x-clipboard selection))))))
       (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
       (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
       (unless template
@@ -1701,7 +1706,7 @@ (defun org-capture-fill-template (&optional template initial annotation)
 			         (replace-regexp-in-string "\n" lead v-i nil t))))
 			    (?a v-a)
 			    (?A v-A)
-			  (?c v-c)
+			    (?c (current-kill-cached))
 			    (?f v-f)
 			    (?F v-F)
 			    (?k v-k)
@@ -1713,7 +1718,10 @@ (defun org-capture-fill-template (&optional template initial annotation)
 			    (?T v-T)
 			    (?u v-u)
 			    (?U v-U)
-			  (?x v-x))))
+			    (?x (or (x-clipboard-cached 'PRIMARY)
+                                    (x-clipboard-cached 'CLIPBOARD)
+                                    (x-clipboard-cached 'SECONDARY)
+                                    "")))))
                     (insert
 		     (if inside-sexp?
                          ;; Escape sensitive characters.
@@ -1769,7 +1777,13 @@ (defun org-capture-fill-template (&optional template initial annotation)
 		      ((or "C" "L")
 		       (let ((insert-fun (if (equal key "C") #'insert
 					   (lambda (s) (org-insert-link 0 s)))))
-		       (pcase org-capture--clipboards
+		         (pcase (setq org-capture--clipboards
+                                      (delq nil
+                                            (list v-i
+                                                  (x-clipboard-cached 'PRIMARY)
+                                                  (x-clipboard-cached 'CLIPBOARD)
+                                                  (x-clipboard-cached 'SECONDARY)
+                                                  (current-kill-cached))))
 			   (`nil nil)
 			   (`(,value) (funcall insert-fun value))
 			   (`(,first-value . ,_)
@@ -1860,7 +1874,7 @@ (defun org-capture-fill-template (&optional template initial annotation)
         (untabify (point-min) (point-max))
         (set-buffer-modified-p nil)
         (prog1 (buffer-substring-no-properties (point-min) (point-max))
-	(kill-buffer (current-buffer))))))
+	  (kill-buffer (current-buffer)))))))
 
 (defun org-capture-escaped-% ()
   "Non-nil if % was escaped.
-- 
2.37.0.windows.1