branch: externals/company
commit 28306f64c3b1358470326932c9d4275a14cef01e
Author: Dmitry Gutov <dmi...@gutov.dev>
Commit: Dmitry Gutov <dmi...@gutov.dev>
Fix adjust-boundaries fallback in company--multi-backend-adapter
Reported at
https://www.reddit.com/r/emacs/comments/1juk4ah/company_is_completing_and_replacing_text_instead/
---
company.el | 20 +++++++++++---------
test/core-tests.el | 34 +++++++++++++++++++++++++++++++++-
2 files changed, 44 insertions(+), 10 deletions(-)
diff --git a/company.el b/company.el
index 1646e1fcd2..1d9ca60075 100644
--- a/company.el
+++ b/company.el
@@ -1408,11 +1408,13 @@ be recomputed when this value changes."
(car backends)))
(entity (company--force-sync backend '(prefix) backend))
(prefix (company--prefix-str entity))
- (suffix (company--suffix-str entity)))
- (setq args (list arg prefix suffix))
+ (suffix (company--suffix-str entity))
+ (company-backend backend))
(or
- (apply backend command args)
- (cons prefix suffix))))))
+ (company-call-backend 'adjust-boundaries arg prefix suffix)
+ (if (company--proper-suffix-p arg prefix suffix)
+ (cons prefix suffix)
+ (cons prefix "")))))))
(`expand-common
(apply #'company--multi-expand-common
backends
@@ -2616,12 +2618,12 @@ For more details see `company-insertion-on-trigger' and
(defsubst company-keep (command)
(and (symbolp command) (get command 'company-keep)))
-(defun company--proper-suffix-p (candidate)
+(defun company--proper-suffix-p (candidate prefix suffix)
(and
(>= (length candidate)
- (+ (length company-prefix)
- (length company-suffix)))
- (string-suffix-p company-suffix candidate
+ (+ (length prefix)
+ (length suffix)))
+ (string-suffix-p suffix candidate
(company-call-backend 'ignore-case))))
(defun company--boundaries (&optional candidate)
@@ -2633,7 +2635,7 @@ For more details see `company-insertion-on-trigger' and
company-prefix company-suffix)
(and
;; Default to replacing the suffix only if the completion ends with it.
- (company--proper-suffix-p candidate)
+ (company--proper-suffix-p candidate company-prefix company-suffix)
(cons company-prefix company-suffix))
(cons company-prefix "")))
diff --git a/test/core-tests.el b/test/core-tests.el
index c33eb3b79c..e525a6770c 100644
--- a/test/core-tests.el
+++ b/test/core-tests.el
@@ -1,6 +1,6 @@
;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2018, 2020-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2025 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@@ -373,6 +373,38 @@
(car (member "a1b" candidates))
"aa" "bcd")))))
+(ert-deftest company-multi-backend-adjust-boundaries-default ()
+ (let* ((one (lambda (command &rest _args)
+ (cl-case command
+ (prefix '("a" "1"))
+ (candidates
+ '("ab1")))))
+ (tri (lambda (command &rest args)
+ (cl-case command
+ (prefix '("aa" "bcd"))
+ (candidates
+ '("aa3bb"
+ "aa3bcd")))))
+ (company-backend (list one tri))
+ (company-point (point))
+ (candidates (company-call-backend 'candidates "a" "")))
+ (should
+ (equal (cons "a" "1")
+ (company-call-backend 'adjust-boundaries
+ (car (member "ab1" candidates))
+ "aa" "bcd")))
+ (should
+ (equal (cons "aa" "")
+ (company-call-backend 'adjust-boundaries
+ (car (member "aa3bb" candidates))
+ "aa" "bcd")))
+ (should
+ (equal (cons "aa" "bcd")
+ (company-call-backend 'adjust-boundaries
+ (car (member "aa3bcd" candidates))
+ "aa" "bcd")))
+ ))
+
(ert-deftest company-multi-backend-combines-expand-common ()
(let* ((one (lambda (command &rest _args)
(cl-case command
