branch: externals/company
commit 4e7c1461159e4497014df813eadf540ab902c830
Author: Dmitry Gutov <dmi...@gutov.dev>
Commit: Dmitry Gutov <dmi...@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)
