[elpa] externals/company d7e77b9673 01/30: #1106 #340 Complete inside symbols

[ELPA Syncer]

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

    #1106 #340 Complete inside symbols
    
    For now the main strategy is "replace suffix when it matches completion".
    
    Probably add an option later.
---
 NEWS.md                 |   2 +
 company-capf.el         |  17 +++--
 company-dabbrev-code.el |  10 +--
 company-ispell.el       |   4 +-
 company.el              | 179 ++++++++++++++++++++++++++++++++----------------
 5 files changed, 138 insertions(+), 74 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 7a5085ff2f..699d404ca3 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,8 @@
 
 # Next
 
+* Completion works inside symbols
+  (#[340](https://github.com/company-mode/company-mode/issues/340)).
 * `company-elisp` has been removed.  It's not needed since Emacs 24.4, with all
   of its features having been incorporated into the built-in Elisp completion.
 * `company-files` shows shorter completions.  Previously, the popup spanned
diff --git a/company-capf.el b/company-capf.el
index 0173a611cc..d72bb4fe56 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -108,7 +108,7 @@ so we can't just use the preceding variable instead.")
 
 (defvar-local company-capf--sorted nil)
 
-(defun company-capf (command &optional arg &rest _args)
+(defun company-capf (command &optional arg &rest rest)
   "`company-mode' backend using `completion-at-point-functions'."
   (interactive (list 'interactive))
   (pcase command
@@ -117,13 +117,11 @@ so we can't just use the preceding variable instead.")
      (let ((res (company--capf-data)))
        (when res
          (let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
-               (prefix (buffer-substring-no-properties (nth 1 res) (point))))
-           (cond
-            ((> (nth 2 res) (point)) 'stop)
-            (length (cons prefix length))
-            (t prefix))))))
+               (prefix (buffer-substring-no-properties (nth 1 res) (point)))
+               (suffix (buffer-substring-no-properties (point) (nth 2 res))))
+           (list prefix suffix length)))))
     (`candidates
-     (company-capf--candidates arg))
+     (company-capf--candidates arg (car rest)))
     (`sorted
      company-capf--sorted)
     (`match
@@ -179,7 +177,7 @@ so we can't just use the preceding variable instead.")
         nil
       annotation)))
 
-(defun company-capf--candidates (input)
+(defun company-capf--candidates (input suffix)
   (let* ((res (company--capf-data))
          (table (nth 3 res))
          (pred (plist-get (nthcdr 4 res) :predicate))
@@ -189,7 +187,8 @@ so we can't just use the preceding variable instead.")
                      table pred))))
     (company-capf--save-current-data res meta)
     (when res
-      (let* ((candidates (completion-all-completions input table pred
+      (let* ((candidates (completion-all-completions (concat input suffix)
+                                                     table pred
                                                      (length input)
                                                      meta))
              (sortfun (cdr (assq 'display-sort-function meta)))
diff --git a/company-dabbrev-code.el b/company-dabbrev-code.el
index 5d7bf66475..1060c844fa 100644
--- a/company-dabbrev-code.el
+++ b/company-dabbrev-code.el
@@ -94,7 +94,7 @@ also `company-dabbrev-code-time-limit'."
     (concat "\\_<" prefix-re "\\(\\sw\\|\\s_\\)*\\_>")))
 
 ;;;###autoload
-(defun company-dabbrev-code (command &optional arg &rest _ignored)
+(defun company-dabbrev-code (command &optional arg &rest rest)
   "dabbrev-like `company-mode' backend for code.
 The backend looks for all symbols in the current buffer that aren't in
 comments or strings."
@@ -105,12 +105,12 @@ comments or strings."
                      (cl-some #'derived-mode-p company-dabbrev-code-modes))
                  (or company-dabbrev-code-everywhere
                      (not (company-in-string-or-comment)))
-                 (or (company-grab-symbol) 'stop)))
+                 (company-grab-symbol-parts)))
     (candidates
      (let* ((case-fold-search company-dabbrev-code-ignore-case)
             (regexp (company-dabbrev-code--make-regexp arg)))
        (company-dabbrev-code--filter
-        arg
+        arg (car rest)
         (company-cache-fetch
          'dabbrev-code-candidates
          (lambda ()
@@ -131,7 +131,7 @@ comments or strings."
              (company--match-from-capf-face arg)))
     (duplicates t)))
 
-(defun company-dabbrev-code--filter (prefix table)
+(defun company-dabbrev-code--filter (prefix suffix table)
   (let ((completion-ignore-case company-dabbrev-code-ignore-case)
         (completion-styles (if (listp company-dabbrev-code-completion-styles)
                                company-dabbrev-code-completion-styles
@@ -140,7 +140,7 @@ comments or strings."
     (if (not company-dabbrev-code-completion-styles)
         (all-completions prefix table)
       (setq res (completion-all-completions
-                 prefix
+                 (concat prefix suffix)
                  table
                  nil (length prefix)))
       (if (numberp (cdr (last res)))
diff --git a/company-ispell.el b/company-ispell.el
index 2699d30bed..6c5d8332dc 100644
--- a/company-ispell.el
+++ b/company-ispell.el
@@ -73,7 +73,9 @@ If nil, use `ispell-complete-word-dict' or 
`ispell-alternate-dictionary'."
   (cl-case command
     (interactive (company-begin-backend 'company-ispell))
     (prefix (when (company-ispell-available)
-              (company-grab-word)))
+              (list
+               (company-grab-word)
+               (company-grab-word-suffix))))
     (candidates
      (let* ((dict (company--ispell-dict))
             (all-words
diff --git a/company.el b/company.el
index 9b518347c3..b04ec86976 100644
--- a/company.el
+++ b/company.el
@@ -379,14 +379,18 @@ Each backend is a function that takes a variable number 
of arguments.
 The first argument is the command requested from the backend.  It is one
 of the following:
 
-`prefix': The backend should return the text to be completed.  It must be
-text immediately before point.  Returning nil from this command passes
-control to the next backend.  The function should return `stop' if it
-should complete but cannot (e.g. when in the middle of a symbol).
-Instead of a string, the backend may return a cons (PREFIX . LENGTH)
-where LENGTH is a number used in place of PREFIX's length when
-comparing against `company-minimum-prefix-length'.  LENGTH can also
-be just t, and in the latter case the test automatically succeeds.
+`prefix': The backend should return the text to be completed.  Returning
+nil from this command passes control to the next backend.
+
+The expected return value looks like (PREFIX SUFFIX &optional PREFIX-LEN).
+Where PREFIX is the text to be completed before point, SUFFIX - the
+remainder after point (when e.g. inside a symbol), and PREFIX-LEN, when
+non-nil, is the number to use in place of PREFIX's length when comparing
+against `company-minimum-prefix-length'.  PREFIX-LEN can also be just t,
+and in the latter case the test automatically succeeds.
+
+The return value can also be just PREFIX, in which case SUFFIX is taken to
+be an empty string.
 
 `candidates': The second argument is the prefix to be completed.  The
 return value should be a list of candidates that match the prefix.
@@ -1106,36 +1110,49 @@ Matching is limited to the current line."
     (company-grab regexp expression (line-beginning-position))))
 
 (defun company-grab-symbol ()
-  "If point is at the end of a symbol, return it.
-Otherwise, if point is not inside a symbol, return an empty string."
-  (if (looking-at-p "\\_>")
-      (buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
-                                                (point)))
-    (unless (and (char-after) (memq (char-syntax (char-after)) '(?w ?_)))
-      "")))
+  "Return buffer substring from the beginning of the symbol until point."
+  (buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
+                                            (point))))
+
+(defun company-grab-symbol-suffix ()
+  "Return buffer substring from point until the end of the symbol."
+  (buffer-substring (point) (save-excursion (skip-syntax-forward "w_")
+                                            (point))))
 
 (defun company-grab-word ()
-  "If point is at the end of a word, return it.
-Otherwise, if point is not inside a symbol, return an empty string."
-  (if (looking-at-p "\\>")
-      (buffer-substring (point) (save-excursion (skip-syntax-backward "w")
-                                                (point)))
-    (unless (and (char-after) (eq (char-syntax (char-after)) ?w))
-      "")))
-
-(defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
-  "Return a string SYMBOL or a cons (SYMBOL . t).
-SYMBOL is as returned by `company-grab-symbol'.  If the text before point
-matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
-  (let ((symbol (company-grab-symbol)))
-    (when symbol
+  "Return buffer substring from the beginning of the word until point."
+  (buffer-substring (point) (save-excursion (skip-syntax-backward "w")
+                                            (point))))
+
+(defun company-grab-word-suffix ()
+  "Return buffer substring from the beginning of the word until point."
+  (buffer-substring (point) (save-excursion (skip-syntax-forward "w")
+                                            (point))))
+
+(defun company-grab-symbol-parts (&optional idle-begin-after-re max-len)
+  "Return a list (PREFIX SUFFIX &optional OVERRIDE).
+
+IDLE-BEGIN-AFTER-RE, if non-nil, must be a regexp.
+
+Where OVERRIDE might be t is IDLE-BEGIN-AFTER-RE is non-nil and the text
+before prefix matches it.  PREFIX and SUFFIX are as returned by
+`company-grab-symbol' and `company-grab-symbol-suffix'.
+MAX-LEN is how far back to try to match the IDLE-BEGIN-AFTER-RE regexp."
+  (let ((prefix (company-grab-symbol))
+        suffix override)
+    (setq suffix (company-grab-symbol-suffix))
+    (when idle-begin-after-re
       (save-excursion
-        (forward-char (- (length symbol)))
-        (if (looking-back idle-begin-after-re (if max-len
-                                                  (- (point) max-len)
-                                                (line-beginning-position)))
-            (cons symbol t)
-          symbol)))))
+        (forward-char (- (length prefix)))
+        (when (looking-back idle-begin-after-re (if max-len
+                                                    (- (point) max-len)
+                                                  (line-beginning-position)))
+          (setq override t))))
+    (list prefix suffix override)))
+
+(define-obsolete-function-alias
+  'company-grab-symbol-cons
+  'company-grab-symbol-parts "1.0")
 
 (defun company-in-string-or-comment ()
   "Return non-nil if point is within a string or comment."
@@ -1261,6 +1278,7 @@ be recomputed when this value changes."
       (`candidates
        (company--multi-backend-adapter-candidates backends
                                                   (car args)
+                                                  (cadr args)
                                                   (or 
company--multi-min-prefix 0)
                                                   separate))
       (`set-min-prefix (setq company--multi-min-prefix (car args)))
@@ -1320,7 +1338,7 @@ be recomputed when this value changes."
         (cons str len)
       str)))
 
-(defun company--multi-backend-adapter-candidates (backends prefix min-length 
separate)
+(defun company--multi-backend-adapter-candidates (backends prefix suffix 
min-length separate)
   (let ((pairs (cl-loop for backend in backends
                         when (let ((bp (let ((company-backend backend))
                                          (company-call-backend 'prefix))))
@@ -1332,7 +1350,7 @@ be recomputed when this value changes."
                                     t
                                   (push backend 
company--multi-uncached-backends)
                                   nil)))
-                        collect (cons (funcall backend 'candidates prefix)
+                        collect (cons (funcall backend 'candidates prefix 
suffix)
                                       (company--multi-candidates-mapper
                                        backend
                                        separate
@@ -1381,19 +1399,40 @@ be recomputed when this value changes."
                     (this-finisher (lambda (res)
                                      (setq pending (delq val pending))
                                      (setcar cell (funcall mapper res))
-                                     (funcall finisher))))
+                                     (funcall-interactively finisher))))
                (if (not (eq :async (car-safe val)))
                    (funcall this-finisher val)
                  (let ((fetcher (cdr val)))
                    (funcall fetcher this-finisher)))))))))))
 
-(defun company--prefix-str (prefix)
-  (or (car-safe prefix) prefix))
+(defun company--prefix-str (entity)
+  (or (car-safe entity) entity))
+
+(defun company--prefix-len (entity)
+  (let ((cdr (cdr-safe entity))
+        override)
+    (cond
+     ((consp cdr)
+      (setq override (cadr cdr)))
+     ((or (numberp cdr) (eq t cdr))
+      (setq override cdr)))
+    (or override
+        (length
+         (if (stringp entity)
+             entity
+           (car entity))))))
+
+(defun company--suffix-str (entity)
+  (if (stringp (car-safe (cdr-safe entity)))
+      (car-safe (cdr-safe entity))
+    ""))
 
 ;;; completion mechanism 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar-local company-prefix nil)
 
+(defvar-local company-suffix nil)
+
 (defvar-local company-candidates nil)
 
 (defvar-local company-candidates-length nil)
@@ -1433,7 +1472,10 @@ be recomputed when this value changes."
         (insert (company-strip-prefix candidate))
       (unless (equal company-prefix candidate)
         (delete-region (- (point) (length company-prefix)) (point))
-        (insert candidate)))))
+        (insert candidate)))
+    ;; FIXME: Ideally delegate to backend (to know how much to replace).
+    (when (string-suffix-p company-suffix (company-strip-prefix candidate))
+      (delete-char (length company-suffix)))))
 
 (defmacro company-with-candidate-inserted (candidate &rest body)
   "Evaluate BODY with CANDIDATE temporarily inserted.
@@ -1558,7 +1600,7 @@ update if FORCE-UPDATE."
                   common))
             (car company-candidates)))))
 
-(defun company-calculate-candidates (prefix ignore-case)
+(defun company-calculate-candidates (prefix ignore-case suffix)
   (let ((candidates (cdr (assoc prefix company-candidates-cache))))
     (or candidates
         (when company-candidates-cache
@@ -1574,7 +1616,7 @@ update if FORCE-UPDATE."
         (let ((refresh-timer (run-with-timer company-async-redisplay-delay
                                              nil #'company--sneaky-refresh)))
           (setq candidates (company--preprocess-candidates
-                            (company--fetch-candidates prefix)))
+                            (company--fetch-candidates prefix suffix)))
           ;; If the backend is synchronous, no chance for the timer to run.
           (cancel-timer refresh-timer)
           ;; Save in cache.
@@ -1590,15 +1632,15 @@ update if FORCE-UPDATE."
        (not (eq (company-call-backend 'kind (car candidates))
                 'snippet))))
 
-(defun company--fetch-candidates (prefix)
+(defun company--fetch-candidates (prefix suffix)
   (let* ((non-essential (not (company-explicit-action-p)))
          (inhibit-redisplay t)
          (c (if (or company-selection-changed
                     ;; FIXME: This is not ideal, but we have not managed to 
deal
                     ;; with these situations in a better way yet.
                     (company-require-match-p))
-                (company-call-backend 'candidates prefix)
-              (company-call-backend-raw 'candidates prefix))))
+                (company-call-backend 'candidates prefix suffix)
+              (company-call-backend-raw 'candidates prefix suffix))))
     (if (not (eq (car c) :async))
         c
       (let ((res 'none))
@@ -2178,8 +2220,8 @@ For more details see `company-insertion-on-trigger' and
 
 (defun company--good-prefix-p (prefix min-length)
   (and (stringp (company--prefix-str prefix)) ;excludes 'stop
-       (or (eq (cdr-safe prefix) t)
-           (>= (or (cdr-safe prefix) (length prefix))
+       (or (eq (company--prefix-len prefix) t)
+           (>= (company--prefix-len prefix)
                min-length))))
 
 (defun company--prefix-min-length ()
@@ -2200,13 +2242,14 @@ For more details see `company-insertion-on-trigger' and
     ;; Don't complete existing candidates, fetch new ones.
     (setq company-candidates-cache nil))
   (let* ((new-prefix (company-call-backend 'prefix))
+         (new-suffix (company--suffix-str new-prefix))
          (ignore-case (company-call-backend 'ignore-case))
          (c (when (and (company--good-prefix-p new-prefix
                                                (company--prefix-min-length))
                        (setq new-prefix (company--prefix-str new-prefix))
                        (= (- (point) (length new-prefix))
                           (- company-point (length company-prefix))))
-              (company-calculate-candidates new-prefix ignore-case))))
+              (company-calculate-candidates new-prefix ignore-case 
new-suffix))))
     (cond
      ((and company-abort-on-unique-match
            (company--unique-match-p c new-prefix ignore-case))
@@ -2216,7 +2259,8 @@ For more details see `company-insertion-on-trigger' and
       (company-cancel 'unique))
      ((consp c)
       ;; incremental match
-      (setq company-prefix new-prefix)
+      (setq company-prefix new-prefix
+            company-suffix new-suffix)
       (company-update-candidates c)
       c)
      ((and (characterp last-command-event)
@@ -2232,26 +2276,28 @@ For more details see `company-insertion-on-trigger' and
 
 (defun company--begin-new ()
   (let ((min-prefix (company--prefix-min-length))
-        prefix c)
+        entity c)
     (cl-dolist (backend (if company-backend
                             ;; prefer manual override
                             (list company-backend)
                           company-backends))
-      (setq prefix
+      (setq entity
             (if (or (symbolp backend)
                     (functionp backend))
                 (when (company--maybe-init-backend backend)
                   (let ((company-backend backend))
                     (company-call-backend 'prefix)))
               (company--multi-backend-adapter backend 'prefix)))
-      (when prefix
-        (when (company--good-prefix-p prefix min-prefix)
+      (when entity
+        (when (company--good-prefix-p entity min-prefix)
           (let ((ignore-case (company-call-backend 'ignore-case)))
             ;; Keep this undocumented, esp. while only 1 backend needs it.
             (company-call-backend 'set-min-prefix min-prefix)
-            (setq company-prefix (company--prefix-str prefix)
+            (setq company-prefix (company--prefix-str entity)
+                  company-suffix (company--suffix-str entity)
                   company-backend backend
-                  c (company-calculate-candidates company-prefix ignore-case))
+                  c (company-calculate-candidates company-prefix ignore-case
+                                                  company-suffix))
             (cond
              ((and company-abort-on-unique-match
                    (company--unique-match-p c company-prefix ignore-case)
@@ -2267,7 +2313,7 @@ For more details see `company-insertion-on-trigger' and
                 (message "No completion found")))
              (t ;; We got completions!
               (when company--manual-action
-                (setq company--manual-prefix prefix))
+                (setq company--manual-prefix entity))
               (company-update-candidates c)
               (run-hook-with-args 'company-completion-started-hook
                                   (company-explicit-action-p))
@@ -2510,7 +2556,8 @@ each one wraps a part of the input string."
                company-search-filtering
                (lambda (candidate) (string-match-p re candidate))))
          (cc (company-calculate-candidates company-prefix
-                                           (company-call-backend 
'ignore-case))))
+                                           (company-call-backend 'ignore-case)
+                                           company-suffix)))
     (unless cc (user-error "No match"))
     (company-update-candidates cc)))
 
@@ -2798,7 +2845,20 @@ For use in the `select-mouse' frontend action.  
`let'-bound.")
     (if (and (not (cdr company-candidates))
              (equal company-common (car company-candidates)))
         (company-complete-selection)
-      (company--insert-candidate company-common))))
+      ;; FIXME: Poor man's completion-try-completion.
+      (let* ((max-len (when (and company-common
+                                 (cl-every (lambda (s) (string-suffix-p 
company-suffix s))
+                                           company-candidates))
+                        (apply #'min
+                               (mapcar
+                                (lambda (s) (- (length s) (length 
company-suffix)))
+                                company-candidates))))
+             (company-common (if max-len
+                                 (substring company-common 0
+                                            (min max-len (length 
company-common)))
+                               company-common))
+             (company-suffix ""))
+        (company--insert-candidate company-common)))))
 
 (defun company-complete-common-or-cycle (&optional arg)
   "Insert the common part of all candidates, or select the next one.
@@ -4167,6 +4227,7 @@ Delay is determined by `company-tooltip-idle-delay'."
 
 (defun company--show-inline-p ()
   (and (not (cdr company-candidates))
+       (string-empty-p company-suffix)
        company-common
        (not (eq t (compare-strings company-prefix nil nil
                                    (car company-candidates) nil nil