[elpa] externals/company 4e7c146115 1/4: Store capf boundaries as markers

[ELPA Syncer]

branch: externals/company
commit 4e7c1461159e4497014df813eadf540ab902c830
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: Dmitry Gutov <dmitry@gutov.dev>

    Store capf boundaries as markers
    
    To avoid having to manually update the prefix/suffix strings when rendering 
the
    updated UI in the middle of fetching completions.
---
 company-capf.el         | 11 ++++++----
 company-dabbrev-code.el |  8 ++++++--
 company-etags.el        |  8 ++++++--
 company.el              | 53 ++++++++++++++++++++++++++++---------------------
 4 files changed, 49 insertions(+), 31 deletions(-)

diff --git a/company-capf.el b/company-capf.el
index 7243b86f7f..08f2e6310f 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -162,7 +162,8 @@ so we can't just use the preceding variable instead.")
     (`post-completion
      (company--capf-post-completion arg))
     (`adjust-boundaries
-     company-capf--current-boundaries)
+     (company--capf-boundaries
+      company-capf--current-boundaries))
     (`expand-common
      (company-capf--expand-common arg (car rest)))
     ))
@@ -205,11 +206,13 @@ so we can't just use the preceding variable instead.")
                                                      (and non-essential
                                                           (eq interrupt t))))
              (sortfun (cdr (assq 'display-sort-function meta)))
-             (candidates (assoc-default :completions all-result))
-             (boundaries (assoc-default :boundaries all-result)))
+             (candidates (assoc-default :completions all-result)))
         (setq company-capf--sorted (functionp sortfun))
         (when candidates
-          (setq company-capf--current-boundaries boundaries))
+          (setq company-capf--current-boundaries
+                (company--capf-boundaries-markers
+                 (assoc-default :boundaries all-result)
+                 company-capf--current-boundaries)))
         (when sortfun
           (setq candidates (funcall sortfun candidates)))
         candidates))))
diff --git a/company-dabbrev-code.el b/company-dabbrev-code.el
index e9dec1d566..2851797ac6 100644
--- a/company-dabbrev-code.el
+++ b/company-dabbrev-code.el
@@ -113,7 +113,8 @@ comments or strings."
                  (company-grab-symbol-parts)))
     (candidates (company-dabbrev--candidates arg (car rest)))
     (adjust-boundaries (and company-dabbrev-code-completion-styles
-                            company-dabbrev--boundaries))
+                            (company--capf-boundaries
+                             company-dabbrev--boundaries)))
     (expand-common (company-dabbrev-code--expand-common arg (car rest)))
     (kind 'text)
     (no-cache t)
@@ -165,7 +166,10 @@ comments or strings."
       (setq res (company--capf-completions
                  prefix suffix
                  table))
-      (setq company-dabbrev--boundaries (assoc-default :boundaries res))
+      (setq company-dabbrev--boundaries
+            (company--capf-boundaries-markers
+             (assoc-default :boundaries res)
+             company-dabbrev--boundaries))
       (assoc-default :completions res))))
 
 (provide 'company-dabbrev-code)
diff --git a/company-etags.el b/company-etags.el
index 34c68b814d..8ff98345c9 100644
--- a/company-etags.el
+++ b/company-etags.el
@@ -90,7 +90,10 @@ Set it to t or to a list of major modes."
     (and table
          (if company-etags-completion-styles
              (let ((res (company--capf-completions prefix suffix table)))
-               (setq company-etags--boundaries (assoc-default :boundaries res))
+               (setq company-etags--boundaries
+                     (company--capf-boundaries-markers
+                      (assoc-default :boundaries res)
+                      company-etags--boundaries))
                (assoc-default :completions res))
            (all-completions prefix table)))))
 
@@ -125,7 +128,8 @@ Set it to t or to a list of major modes."
                  (company-grab-symbol-parts)))
     (candidates (company-etags--candidates arg (car rest)))
     (adjust-boundaries (and company-etags-completion-styles
-                            company-etags--boundaries))
+                            (company--capf-boundaries
+                             company-etags--boundaries)))
     (expand-common (company-etags--expand-common arg (car rest)))
     (no-cache company-etags-completion-styles)
     (location (let ((tags-table-list (company-etags-buffer-table)))
diff --git a/company.el b/company.el
index ccc57a68f7..f8f1ac09d0 100644
--- a/company.el
+++ b/company.el
@@ -1257,6 +1257,28 @@ MAX-LEN is how far back to try to match the 
IDLE-BEGIN-AFTER-RE regexp."
        (substring (car res) 0 (cdr res))
        (substring (car res) (cdr res)))))))
 
+;; We store boundaries as markers because when the `unhide' frontend action is
+;; called, the completions are still being fetched. So the capf boundaries info
+;; can't be relied to be fresh by other means.
+(defun company--capf-boundaries-markers (string-pair &optional markers)
+  "STRING-PAIR is (PREFIX . SUFFIX) and MARKERS is a pair to reuse."
+  (when (or (not markers)
+            (stringp (car markers)))
+    (setq markers (cons (make-marker)
+                        (make-marker))))
+  (move-marker (car markers) (- (point) (length (car string-pair))))
+  (move-marker (cdr markers) (+ (point) (length (cdr string-pair))))
+  markers)
+
+(defun company--capf-boundaries (markers)
+  (let* ((beg (car markers))
+         (end (cdr markers))
+         res)
+    (when (> (point) end) (setq end (point)))
+    (setq res (cons (buffer-substring beg (point))
+                    (buffer-substring (point) end)))
+    res))
+
 (defvar company--cache (make-hash-table :test #'equal :size 10))
 
 (cl-defun company-cache-fetch (key
@@ -1375,7 +1397,6 @@ be recomputed when this value changes."
              (cl-return value)))))
       (`prefix (company--multi-prefix backends))
       (`adjust-boundaries
-       (defvar company-point)
        (let ((arg (car args)))
          (when (> (length arg) 0)
            (let* ((backend (or (get-text-property 0 'company-backend arg)
@@ -1383,13 +1404,6 @@ be recomputed when this value changes."
                   (entity (company--force-sync backend '(prefix) backend))
                   (prefix (company--prefix-str entity))
                   (suffix (company--suffix-str entity)))
-             ;; XXX: Working around the stuff in
-             ;; company-preview--refresh-prefix.
-             (when (> (point) company-point)
-               (setq prefix (substring prefix
-                                       0
-                                       (- (length prefix)
-                                          (- (point) company-point)))))
              (setq args (list arg prefix suffix))
              (or
               (apply backend command args)
@@ -1841,7 +1855,12 @@ update if FORCE-UPDATE."
             res-was))))))
 
 (defun company--sneaky-refresh ()
-  (when company-candidates (company-call-frontends 'unhide))
+  (when company-candidates
+    (let* ((entity (company-call-backend 'prefix))
+           (company-prefix (company--prefix-str entity))
+           (company-suffix (company--suffix-str entity)))
+      (and company-prefix
+           (company-call-frontends 'unhide))))
   (let (inhibit-redisplay)
     (redisplay))
   (when company-candidates (company-call-frontends 'pre-command)))
@@ -4463,26 +4482,14 @@ Delay is determined by `company-tooltip-idle-delay'."
     (delete-overlay company-preview-overlay)
     (setq company-preview-overlay nil)))
 
-(defun company-preview--refresh-prefix (boundaries)
-  (let ((prefix (car boundaries)))
-    (when prefix
-      (if (> (point) company-point)
-          (concat prefix (buffer-substring company-point (point)))
-        (substring prefix 0 (- (length prefix)
-                               (- company-point (point))))))))
-
 (defun company-preview-frontend (command)
   "`company-mode' frontend showing the selection as if it had been inserted."
   (pcase command
     (`pre-command (company-preview-hide))
     (`unhide
      (when company-selection
-       (let* ((current (nth company-selection company-candidates))
-              (boundaries (company--boundaries)))
-         (company-preview-show-at-point (point) current
-                                        (cons
-                                         (company-preview--refresh-prefix 
boundaries)
-                                         (cdr boundaries))))))
+       (let* ((current (nth company-selection company-candidates)))
+         (company-preview-show-at-point (point) current))))
     (`post-command
      (when company-selection
        (company-preview-show-at-point (point)