[ELPA-diffs] [elpa] 12/14: Close #45

[emacs-devel]

This is an automated email from the git hooks/post-receive script.

root pushed a commit to branch master
in repository elpa.

commit bd82c7e096ecf4c6f0a0545f442be4296c741db5
Author: Dmitry Gutov <address@hidden>
Date:   Tue Jan 14 09:41:34 2014 +0200

    Close #45
    
    * Replace prefix with candidate unless backend says to keep it.
    * Add non-prefix completions support.
---
 NEWS.md            |    1 +
 company-capf.el    |    5 +++-
 company-dabbrev.el |    2 +-
 company-ispell.el  |    2 +-
 company-tests.el   |   67 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 company.el         |   44 ++++++++++++++++++++++++---------
 6 files changed, 106 insertions(+), 15 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index fe9ddf7..beb2cfb 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,7 @@
 
 ## Next
 
+* Experimental support for non-prefix completion.
 * Starting with Emacs version 24.4, `company-capf` is included in
   `company-backends` and replaces `company-elisp`.
 * `company-capf` supports completion tables that return non-default boundaries.
diff --git a/company-capf.el b/company-capf.el
index 0d68562..21b9214 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -58,7 +58,10 @@ Requires Emacs 24.1 or newer."
                       table pred))
                 (sortfun (cdr (assq 'display-sort-function meta)))
                 (boundaries (completion-boundaries arg table pred ""))
-                (candidates (all-completions arg table pred)))
+                (candidates (completion-all-completions arg table pred (length 
arg)))
+                (last (last candidates 1)))
+           (when (numberp (cdr last))
+             (setcdr last nil))
            (when sortfun
              (setq candidates (funcall sortfun candidates)))
            (if (not (zerop (car boundaries)))
diff --git a/company-dabbrev.el b/company-dabbrev.el
index 1be9792..4b1a9d8 100644
--- a/company-dabbrev.el
+++ b/company-dabbrev.el
@@ -120,7 +120,7 @@ See also `company-dabbrev-time-limit'."
              (company-dabbrev--search (company-dabbrev--make-regexp arg)
                                       company-dabbrev-time-limit
                                       company-dabbrev-other-buffers)))
-    (ignore-case t)
+    (ignore-case 'keep-prefix)
     (duplicates t)))
 
 (provide 'company-dabbrev)
diff --git a/company-ispell.el b/company-ispell.el
index 9647f85..3e599f0 100644
--- a/company-ispell.el
+++ b/company-ispell.el
@@ -63,7 +63,7 @@ If nil, use `ispell-complete-word-dict'."
     (candidates (lookup-words arg (or company-ispell-dictionary
                                       ispell-complete-word-dict)))
     (sorted t)
-    (ignore-case t)))
+    (ignore-case 'keep-prefix)))
 
 (provide 'company-ispell)
 ;;; company-ispell.el ends here
diff --git a/company-tests.el b/company-tests.el
index 016e439..b111822 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -162,6 +162,73 @@
       (should (null company-candidates))
       (should (null (company-explicit-action-p))))))
 
+(ert-deftest company-ignore-case-replaces-prefix ()
+  (with-temp-buffer
+    (company-mode)
+    (let (company-frontends
+          (company-backends
+           (list (lambda (command &optional arg)
+                   (case command
+                     (prefix (buffer-substring (point-min) (point)))
+                     (candidates '("abcd" "abef"))
+                     (ignore-case t))))))
+      (insert "A")
+      (let (this-command)
+        (company-complete))
+      (should (string= "ab" (buffer-string)))
+      (delete-char -2)
+      (insert "AB") ; hack, to keep it in one test
+      (company-complete-selection)
+      (should (string= "abcd" (buffer-string))))))
+
+(ert-deftest company-ignore-case-with-keep-prefix ()
+  (with-temp-buffer
+    (insert "AB")
+    (company-mode)
+    (let (company-frontends
+          (company-backends
+           (list (lambda (command &optional arg)
+                   (case command
+                     (prefix (buffer-substring (point-min) (point)))
+                     (candidates '("abcd" "abef"))
+                     (ignore-case 'keep-prefix))))))
+      (let (this-command)
+        (company-complete))
+      (company-complete-selection)
+      (should (string= "ABcd" (buffer-string))))))
+
+(ert-deftest company-non-prefix-completion ()
+  (with-temp-buffer
+    (insert "tc")
+    (company-mode)
+    (let (company-frontends
+          company-end-of-buffer-workaround
+          (company-backends
+           (list (lambda (command &optional arg)
+                   (case command
+                     (prefix (buffer-substring (point-min) (point)))
+                     (candidates '("tea-cup" "teal-color")))))))
+      (let (this-command)
+        (company-complete))
+      (should (string= "tc" (buffer-string))))))
+
+(ert-deftest company-non-prefix-completion ()
+  (with-temp-buffer
+    (insert "tc")
+    (company-mode)
+    (let (company-frontends
+          company-end-of-buffer-workaround
+          (company-backends
+           (list (lambda (command &optional arg)
+                   (case command
+                     (prefix (buffer-substring (point-min) (point)))
+                     (candidates '("tea-cup" "teal-color")))))))
+      (let (this-command)
+        (company-complete))
+      (should (string= "tc" (buffer-string)))
+      (company-complete-selection)
+      (should (string= "tea-cup" (buffer-string))))))
+
 (ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
   :tags '(interactive)
   (with-temp-buffer
diff --git a/company.el b/company.el
index 5f9d6e1..1015415 100644
--- a/company.el
+++ b/company.el
@@ -739,6 +739,14 @@ Controlled by `company-auto-complete'.")
 (defsubst company-strip-prefix (str)
   (substring str (length company-prefix)))
 
+(defun company--insert-candidate (candidate)
+  ;; XXX: Return value we check here is subject to change.
+  (set-text-properties 0 (length candidate) nil candidate)
+  (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+      (insert (company-strip-prefix candidate))
+    (delete-region (- (point) (length company-prefix)) (point))
+    (insert candidate)))
+
 (defmacro company-with-candidate-inserted (candidate &rest body)
   "Evaluate BODY with CANDIDATE temporarily inserted.
 This is a tool for back-ends that need candidates inserted before they
@@ -747,7 +755,7 @@ can retrieve meta-data for them."
   `(let ((inhibit-modification-hooks t)
          (inhibit-point-motion-hooks t)
          (modified-p (buffer-modified-p)))
-     (insert (company-strip-prefix ,candidate))
+     (company--insert-candidate ,candidate)
      (unwind-protect
          (progn ,@body)
        (delete-region company-point (point)))))
@@ -760,7 +768,10 @@ can retrieve meta-data for them."
 (defun company-reformat (candidate)
   ;; company-ispell needs this, because the results are always lower-case
   ;; It's mory efficient to fix it only when they are displayed.
-  (concat company-prefix (substring candidate (length company-prefix))))
+  ;; FIXME: Adopt the current text's capitalization instead?
+  (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+      (concat company-prefix (substring candidate (length company-prefix)))
+    candidate))
 
 (defun company--should-complete ()
   (and (not (or buffer-read-only overriding-terminal-local-map
@@ -817,11 +828,13 @@ can retrieve meta-data for them."
   ;; Save in cache:
   (push (cons company-prefix company-candidates) company-candidates-cache)
   ;; Calculate common.
-  (let ((completion-ignore-case (company-call-backend 'ignore-case)))
-    (setq company-common (company--safe-candidate
-                          (try-completion company-prefix company-candidates))))
-  (when (eq company-common t)
-    (setq company-candidates nil)))
+  (let ((completion-ignore-case (company-call-backend 'ignore-case))
+        ;; We want to support non-prefix completion, so filtering is the
+        ;; responsibility of each respective backend, not ours.
+        ;; On the other hand, we don't want to replace non-prefix input in
+        ;; `company-complete-common'.
+        (common (try-completion company-prefix company-candidates)))
+    (setq company-common (company--safe-candidate common))))
 
 (defun company--safe-candidate (str)
   (or (company-call-backend 'crop str)
@@ -1089,7 +1102,7 @@ can retrieve meta-data for them."
   (setq company-point (point)))
 
 (defun company-finish (result)
-  (insert (company-strip-prefix result))
+  (company--insert-candidate result)
   (company-cancel result)
   ;; Don't start again, unless started manually.
   (setq company-point (point)))
@@ -1425,7 +1438,8 @@ and invoke the normal binding."
     (if (and (not (cdr company-candidates))
              (equal company-common (car company-candidates)))
         (company-complete-selection)
-      (insert (company-strip-prefix company-common)))))
+      (when company-common
+        (company--insert-candidate company-common)))))
 
 (defun company-complete ()
   "Complete the common part of all candidates or the current selection.
@@ -1929,7 +1943,7 @@ Returns a negative number if the tooltip should be 
displayed above point."
 (defun company-pseudo-tooltip-unless-just-one-frontend (command)
   "`company-pseudo-tooltip-frontend', but not shown for single candidates."
   (unless (and (eq command 'post-command)
-               (not (cdr company-candidates)))
+               (company--show-inline-p))
     (company-pseudo-tooltip-frontend command)))
 
 ;;; overlay 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1978,10 +1992,16 @@ Returns a negative number if the tooltip should be 
displayed above point."
 
 (defun company-preview-if-just-one-frontend (command)
   "`company-preview-frontend', but only shown for single candidates."
-  (unless (and (eq command 'post-command)
-               (cdr company-candidates))
+  (when (or (not (eq command 'post-command))
+            (company--show-inline-p))
     (company-preview-frontend command)))
 
+(defun company--show-inline-p ()
+  (and (not (cdr company-candidates))
+       company-common
+       (string-prefix-p company-prefix company-common
+                        (company-call-backend 'ignore-case))))
+
 ;;; echo 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar company-echo-last-msg nil)

-- 
To stop receiving notification emails like this one, please contact
the administrator of this repository.