[elpa] externals/company fb21b70d97 11/24: Fix tests and indicated regressions

[ELPA Syncer]

branch: externals/company
commit fb21b70d976785147dc700fab8a9b8639c18c9ab
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>

    Fix tests and indicated regressions
    
    In particular, the one in test
    company-create-lines-with-multiple-width-and-keep-prefix, which also relied 
on
    the previously concatenative property of company--clean-string.  We 
semi-broke
    that feature in company--common-or-matches for wide characters anyway, 
though.
---
 company.el              | 82 +++++++++++++++++++++++++++----------------------
 test/frontends-tests.el | 24 ++++++++-------
 2 files changed, 58 insertions(+), 48 deletions(-)

diff --git a/company.el b/company.el
index 8c913cff67..ea46149888 100644
--- a/company.el
+++ b/company.el
@@ -1331,8 +1331,7 @@ can retrieve meta-data for them."
   ;; It's mory efficient to fix it only when they are displayed.
   ;; FIXME: Adopt the current text's capitalization instead?
   (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
-      (let ((prefix (company--clean-string company-prefix)))
-        (concat prefix (substring candidate (length prefix))))
+      (concat company-prefix (substring candidate (length company-prefix)))
     candidate))
 
 (defun company--should-complete ()
@@ -3176,10 +3175,13 @@ If SHOW-VERSION is non-nil, show the version in the 
echo area."
 
 (defun company-fill-propertize (value annotation width selected left right)
   (let* ((margin (length left))
-         (company-common (and company-common (company--clean-string 
company-common)))
          (common (company--common-or-matches value))
-         (_ (setq value (company-reformat (company--pre-render value))
-                  annotation (and annotation (company--pre-render annotation 
t))))
+         (_ (setq value
+                  (company--clean-string
+                   (company-reformat (company--pre-render value)))
+                  annotation (and annotation
+                                  (company--clean-string
+                                   (company--pre-render annotation t)))))
          (ann-ralign company-tooltip-align-annotations)
          (ann-padding (or company-tooltip-annotation-padding 0))
          (ann-truncate (< width
@@ -3276,33 +3278,41 @@ If SHOW-VERSION is non-nil, show the version in the 
echo area."
         str)))
 
 (defun company--clean-string (str)
-  (replace-regexp-in-string
-   "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]+"
-   (lambda (match)
-     (cond
-      ((match-beginning 1)
-       ;; FIXME: Better char for 'non-printable'?
-       ;; We shouldn't get any of these, but sometimes we might.
-       ;; The official "replacement character" is not supported by some fonts.
-       ;;"\ufffd"
-       "?"
-       )
-      ((match-beginning 2)
-       ;; Zero-width non-breakable space.
-       "")
-      ((let ((msw (company--string-width match)))
-         (when (> msw 1)
-           (concat
-            (propertize
-             (make-string (- msw (length match)) ?\ufeff)
-             'display
-             ;; !! Experimental stuff.
-             `(space . (:width (,(- (* (default-font-width)
-                                       msw)
-                                    (company--string-pixel-width match))))))
-            match))))
-      (t match)))
-   str))
+  (let* ((add-pixels 0)
+         (add-length 0)
+         (new-str
+          (replace-regexp-in-string
+           "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]+"
+           (lambda (match)
+             (cond
+              ((match-beginning 1)
+               ;; FIXME: Better char for 'non-printable'?
+               ;; We shouldn't get any of these, but sometimes we might.
+               ;; The official "replacement character" is not supported by 
some fonts.
+               ;;"\ufffd"
+               "?"
+               )
+              ((match-beginning 2)
+               ;; Zero-width non-breakable space.
+               "")
+              (t
+               ;; FIXME: Maybe move that counting later to a non-replacement 
loop.
+               (let ((msw (company--string-width match)))
+                 (cl-incf add-pixels
+                          (- (* (default-font-width)
+                                msw)
+                             (company--string-pixel-width match)))
+                 (cl-incf add-length (- msw (length match)))
+                 match
+                 ))
+              ))
+           str)))
+    (if (= 0 add-length)
+        new-str
+      (concat new-str
+              (propertize
+               (make-string add-length ?\ufeff)
+               'display `(space . (:width (,add-pixels))))))))
 
 ;;; replace
 
@@ -3503,18 +3513,16 @@ but adjust the expected values appropriately."
              (annotation (company-call-backend 'annotation value))
              (left (or (pop left-margins)
                        (company-space-string left-margin-size))))
-        (setq value (company--clean-string value))
         (when annotation
-          (setq annotation (company--clean-string annotation))
           (when company-tooltip-align-annotations
             ;; `lisp-completion-at-point' adds a space.
             (setq annotation (string-trim-left annotation))))
         (push (list value annotation left) items)
-        (setq width (max (+ (length value)
+        (setq width (max (+ (company--string-width value)
                             (if annotation
-                                (+ (length annotation)
+                                (+ (company--string-width annotation)
                                    company-tooltip-annotation-padding)
-                              (length annotation)))
+                              0))
                          width))))
 
     (setq width (min window-width
diff --git a/test/frontends-tests.el b/test/frontends-tests.el
index 3b36e232f3..ef877e5deb 100644
--- a/test/frontends-tests.el
+++ b/test/frontends-tests.el
@@ -285,8 +285,8 @@
                              "avatar"))
         (company-candidates-length 2)
         (company-backend 'ignore))
-    (should (equal '(" avalis?e "
-                     " avatar   ")
+    (should (equal '(" avalis?e    "
+                     " avatar      ")
                    (cdr (company--create-lines 0 999))))))
 
 (ert-deftest company-create-lines-handles-multiple-width ()
@@ -295,8 +295,8 @@
         (company-candidates '("蛙蛙蛙蛙" "蛙abc"))
         (company-candidates-length 2)
         (company-backend 'ignore))
-    (should (equal '(" 蛙蛙蛙蛙 "
-                     " 蛙abc    ")
+    (should (equal '(" 蛙蛙蛙蛙 "
+                     " 蛙abc   ")
                    (cdr (company--create-lines 0 999))))))
 
 (ert-deftest company-create-lines-handles-multiple-width-in-annotation ()
@@ -307,8 +307,8 @@
          (company-backend (lambda (c &optional a &rest _)
                             (when (eq c 'annotation)
                               (assoc-default a alist)))))
-    (should (equal '(" a ︸   "
-                     " b ︸︸ ")
+    (should (equal '(" a ︸   "
+                     " b ︸︸ ")
                    (cdr (company--create-lines 0 999))))))
 
 (ert-deftest company-create-lines-with-multiple-width-and-keep-prefix ()
@@ -321,8 +321,8 @@
          (company-backend (lambda (c &rest _)
                             (pcase c
                               (`ignore-case 'keep-prefix)))))
-    (should (equal '(" MIRAI発売1カ月 "
-                     " MIRAI発売2カ月 ")
+    (should (equal '(" MIRAI発売1カ月 "
+                     " MIRAI発売2カ月 ")
                    (cdr (company--create-lines 0 999))))))
 
 (ert-deftest company-create-lines-with-format-function ()
@@ -476,14 +476,16 @@
 (ert-deftest company-modify-line ()
   (let ((str "-*-foobar"))
     (should (equal-including-properties
-             (company-modify-line str "zz" 4)
+             (company-modify-line str "zz" (* 4 (frame-char-width)))
              "-*-fzzbar"))
     (should (equal-including-properties
              (company-modify-line str "xx" 0)
              "xx-foobar"))
     (should (equal-including-properties
-             (company-modify-line str "zz" 10)
-             "-*-foobar zz"))))
+             (company-modify-line str "zz" (* 10 (frame-char-width)))
+             (concat "-*-foobar"
+                     (propertize " " 'display `(space :width 
(,(frame-char-width))))
+                     "zz")))))
 
 (ert-deftest company-modify-line-with-invisible-prop ()
   (let ((str (copy-sequence "-*-foobar"))