From 4cc539e1b379381f0b6496ff901e351c85803611 Mon Sep 17 00:00:00 2001 From: Max Mikhanosha 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