emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master e65aa3f 78/78: Merge commit '7cc0901489dff3d73ddc845ae060f


From: Dmitry Gutov
Subject: [elpa] master e65aa3f 78/78: Merge commit '7cc0901489dff3d73ddc845ae060f938ecb85615' from company
Date: Sun, 18 Feb 2018 07:40:31 -0500 (EST)

branch: master
commit e65aa3fadd761e358055c3992c68096b65ac48d2
Merge: 32f6323 7cc0901
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Merge commit '7cc0901489dff3d73ddc845ae060f938ecb85615' from company
---
 packages/company/.travis.yml             |  36 +++----
 packages/company/NEWS.md                 |  23 ++++-
 packages/company/company-capf.el         |   5 +-
 packages/company/company-clang.el        |  94 ++++++++++--------
 packages/company/company-dabbrev.el      |  21 +++-
 packages/company/company-elisp.el        |   3 +-
 packages/company/company-etags.el        |   1 +
 packages/company/company-keywords.el     |  24 +++++
 packages/company/company-nxml.el         |   2 +-
 packages/company/company-semantic.el     |   5 +-
 packages/company/company-tng.el          | 163 +++++++++++++++++++++++++++++++
 packages/company/company.el              | 134 ++++++++++++++-----------
 packages/company/test/async-tests.el     |  28 +++---
 packages/company/test/core-tests.el      |  21 ++++
 packages/company/test/frontends-tests.el |   8 ++
 15 files changed, 431 insertions(+), 137 deletions(-)

diff --git a/packages/company/.travis.yml b/packages/company/.travis.yml
index 6993df8..b8eb249 100644
--- a/packages/company/.travis.yml
+++ b/packages/company/.travis.yml
@@ -1,24 +1,26 @@
-# https://github.com/rolandwalker/emacs-travis
+sudo: false
 
 language: generic
 
-env:
-  matrix:
-    - EMACS=emacs24
-    - EMACS=emacs-snapshot
+matrix:
+  include:
+    - env: EMACS=emacs24
+      addons:
+        apt:
+          sources: [ { sourceline: 'ppa:cassou/emacs' } ]
+          packages: [ emacs24, emacs24-el ]
+    - env: EMACS=emacs25
+      addons:
+        apt:
+          sources: [ { sourceline: 'ppa:kelleyk/emacs' } ]
+          packages: [ emacs25 ]
+    - env: EMACS=emacs-snapshot
+      addons:
+        apt:
+          sources: [ { sourceline: 'ppa:ubuntu-elisp/ppa' } ]
+          packages: [ emacs-snapshot ]
 
-install:
-  - if [ "$EMACS" = "emacs24" ]; then
-        sudo add-apt-repository -y ppa:cassou/emacs &&
-        sudo apt-get update -qq &&
-        sudo apt-get install -qq emacs24 emacs24-el;
-    fi
-  - if [ "$EMACS" = "emacs-snapshot" ]; then
-        sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
-        sudo apt-get update -qq &&
-        sudo apt-get -qq -f install &&
-        sudo apt-get install -qq emacs-snapshot;
-    fi
+install: true
 
 script:
   make test-batch EMACS=${EMACS}
diff --git a/packages/company/NEWS.md b/packages/company/NEWS.md
index b219933..2db3dcf 100644
--- a/packages/company/NEWS.md
+++ b/packages/company/NEWS.md
@@ -1,5 +1,24 @@
 # History of user-visible changes
 
+## 2018-02-18 (0.9.5)
+
+* The most common case of tooltip flickering with asynchronous backends (and
+  disabled built-in cache) is fixed
+  ([#510](https://github.com/company-mode/company-mode/issues/510),
+  [#654](https://github.com/company-mode/company-mode/issues/654)).
+* `company-keywords` added entries for `go-mode`, `swift-mode` and
+  `kotlin-mode`.
+* Native line numbers compatibility fixes.
+* `company-dabbrev` and `company-dabbrev-code` are more responsive when user
+  input is pending
+  ([#720](https://github.com/company-mode/company-mode/pull/720)).
+* New feature `company-tng`. It contains a frontend and some helper code.
+  The frontend triggers insertion of the candidate as soon as it's selected, so
+  you only need to press TAB. Add `(company-tng-configure-default)` to your
+  init script to give it a try
+  ([#706](https://github.com/company-mode/company-mode/issues/706)).
+* New user option `company-tooltip-maximum-width`.
+
 ## 2017-07-15 (0.9.4)
 
 * Compatibility with native line numbers display in Emacs 26.
@@ -9,7 +28,7 @@
 
 ## 2017-03-29 (0.9.3)
 
-* New variable `company-echo-truncate-lines`.
+* New user option `company-echo-truncate-lines`.
 * `company-auto-complete` improved compatibility with `electric-pair-mode`.
 * Use of `overriding-terminal-local-map` does not disable completion.
 * `company-clang` and `company-gtags` can work over Tramp.
@@ -26,7 +45,7 @@
 * `company-indent-or-complete-common` skips trying to indent if
   `indent-line-function` is `indent-relative` or `indent-relative-maybe`.
 * Better visualization of search matches. New face 
`company-tooltip-search-selection`.
-* New variable `company-files-exclusions`.
+* New user option `company-files-exclusions`.
 * `company-next-page` and `company-previous-page` adhere to
   `company-selection-wrap-around` docstring more closely and only wrap around
   when the selection is at the start of the end of the list.
diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el
index 866fd62..06384c7 100644
--- a/packages/company/company-capf.el
+++ b/packages/company/company-capf.el
@@ -1,6 +1,6 @@
 ;;; company-capf.el --- company-mode completion-at-point-functions backend -*- 
lexical-binding: t -*-
 
-;; Copyright (C) 2013-2016  Free Software Foundation, Inc.
+;; Copyright (C) 2013-2017  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <address@hidden>
 
@@ -22,6 +22,9 @@
 
 ;;; Commentary:
 ;;
+;; The CAPF back-end provides a bridge to the standard
+;; completion-at-point-functions facility, and thus can support any major mode
+;; that defines a proper completion function, including emacs-lisp-mode.
 
 ;;; Code:
 
diff --git a/packages/company/company-clang.el 
b/packages/company/company-clang.el
index 599491d..90a372e 100644
--- a/packages/company/company-clang.el
+++ b/packages/company/company-clang.el
@@ -1,6 +1,6 @@
 ;;; company-clang.el --- company-mode completion backend for Clang  -*- 
lexical-binding: t -*-
 
-;; Copyright (C) 2009, 2011, 2013-2016  Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2013-2017  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 
@@ -45,7 +45,8 @@ symbol is preceded by \".\", \"->\" or \"::\", ignoring
 
 If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
 and `c-electric-colon', for automatic completion right after \">\" and
-\":\".")
+\":\"."
+  :type 'boolean)
 
 (defcustom company-clang-arguments nil
   "Additional arguments to pass to clang when completing.
@@ -200,34 +201,35 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
         (goto-char (point-min))))))
 
 (defun company-clang--start-process (prefix callback &rest args)
-  (let ((objc (derived-mode-p 'objc-mode))
-        (buf (get-buffer-create "*clang-output*"))
-        ;; Looks unnecessary in Emacs 25.1 and later.
-        (process-adaptive-read-buffering nil))
-    (if (get-buffer-process buf)
-        (funcall callback nil)
-      (with-current-buffer buf
-        (erase-buffer)
-        (setq buffer-undo-list t))
-      (let* ((process-connection-type nil)
-             (process (apply #'start-file-process "company-clang" buf
-                             company-clang-executable args)))
-        (set-process-sentinel
-         process
-         (lambda (proc status)
-           (unless (string-match-p "hangup" status)
-             (funcall
-              callback
-              (let ((res (process-exit-status proc)))
-                (with-current-buffer buf
-                  (unless (eq 0 res)
-                    (company-clang--handle-error res args))
-                  ;; Still try to get any useful input.
-                  (company-clang--parse-output prefix objc)))))))
-        (unless (company-clang--auto-save-p)
-          (send-region process (point-min) (point-max))
-          (send-string process "\n")
-          (process-send-eof process))))))
+  (let* ((objc (derived-mode-p 'objc-mode))
+         (buf (get-buffer-create "*clang-output*"))
+         ;; Looks unnecessary in Emacs 25.1 and later.
+         (process-adaptive-read-buffering nil)
+         (existing-process (get-buffer-process buf)))
+    (when existing-process
+      (kill-process existing-process))
+    (with-current-buffer buf
+      (erase-buffer)
+      (setq buffer-undo-list t))
+    (let* ((process-connection-type nil)
+           (process (apply #'start-file-process "company-clang" buf
+                           company-clang-executable args)))
+      (set-process-sentinel
+       process
+       (lambda (proc status)
+         (unless (string-match-p "hangup\\|killed" status)
+           (funcall
+            callback
+            (let ((res (process-exit-status proc)))
+              (with-current-buffer buf
+                (unless (eq 0 res)
+                  (company-clang--handle-error res args))
+                ;; Still try to get any useful input.
+                (company-clang--parse-output prefix objc)))))))
+      (unless (company-clang--auto-save-p)
+        (send-region process (point-min) (point-max))
+        (send-string process "\n")
+        (process-send-eof process)))))
 
 (defsubst company-clang--build-location (pos)
   (save-excursion
@@ -263,7 +265,10 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
   (apply 'company-clang--start-process
          prefix
          callback
-         (company-clang--build-complete-args (- (point) (length prefix)))))
+         (company-clang--build-complete-args
+          (if (company-clang--check-version 4.0 9.0)
+              (point)
+            (- (point) (length prefix))))))
 
 (defun company-clang--prefix ()
   (if company-clang-begin-after-member-access
@@ -277,18 +282,26 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
 (defvar company-clang--version nil)
 
 (defun company-clang--auto-save-p ()
-  (< company-clang--version 2.9))
+  (not
+   (company-clang--check-version 2.9 3.1)))
+
+(defun company-clang--check-version (min apple-min)
+  (pcase company-clang--version
+    (`(apple . ,ver) (>= ver apple-min))
+    (`(normal . ,ver) (>= ver min))
+    (_ (error "pcase-exhaustive is not in Emacs 24.3!"))))
 
 (defsubst company-clang-version ()
   "Return the version of `company-clang-executable'."
   (with-temp-buffer
     (call-process company-clang-executable nil t nil "--version")
     (goto-char (point-min))
-    (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t)
-        (let ((ver (string-to-number (match-string-no-properties 1))))
-          (if (> ver 100)
-              (/ ver 100)
-            ver))
+    (if (re-search-forward "\\(clang\\|Apple LLVM\\) version \\([0-9.]+\\)" 
nil t)
+        (cons
+         (if (equal (match-string-no-properties 1) "Apple LLVM")
+             'apple
+           'normal)
+         (string-to-number (match-string-no-properties 2)))
       0)))
 
 (defun company-clang (command &optional arg &rest ignored)
@@ -310,8 +323,11 @@ passed via standard input."
             (unless company-clang-executable
               (error "Company found no clang executable"))
             (setq company-clang--version (company-clang-version))
-            (when (< company-clang--version company-clang-required-version)
-              (error "Company requires clang version 1.1"))))
+            (unless (company-clang--check-version
+                     company-clang-required-version
+                     company-clang-required-version)
+              (error "Company requires clang version %s"
+                     company-clang-required-version))))
     (prefix (and (memq major-mode company-clang-modes)
                  buffer-file-name
                  company-clang-executable
diff --git a/packages/company/company-dabbrev.el 
b/packages/company/company-dabbrev.el
index b1a9def..5d2f318 100644
--- a/packages/company/company-dabbrev.el
+++ b/packages/company/company-dabbrev.el
@@ -59,7 +59,11 @@ Or a function that returns non-nil for such buffers."
 (defcustom company-dabbrev-ignore-case 'keep-prefix
   "Non-nil to ignore case when collecting completion candidates.
 When it's `keep-prefix', the text before point will remain unchanged after
-candidate is inserted, even some of its characters have different case.")
+candidate is inserted, even some of its characters have different case."
+  :type '(choice
+          (const :tag "Don't ignore case" nil)
+          (const :tag "Ignore case" t)
+          (const :tag "Keep case before point" keep-prefix)))
 
 (defcustom company-dabbrev-downcase 'case-replace
   "Whether to downcase the returned candidates.
@@ -69,7 +73,11 @@ The value of nil means keep them as-is.
 Any other value means downcase.
 
 If you set this value to nil, you may also want to set
-`company-dabbrev-ignore-case' to any value other than `keep-prefix'.")
+`company-dabbrev-ignore-case' to any value other than `keep-prefix'."
+  :type '(choice
+          (const :tag "Keep as-is" nil)
+          (const :tag "Downcase" t)
+          (const :tag "Use case-replace" case-replace)))
 
 (defcustom company-dabbrev-minimum-length 4
   "The minimum length for the completion candidate to be included.
@@ -110,7 +118,8 @@ This variable affects both `company-dabbrev' and 
`company-dabbrev-code'."
       (goto-char (if pos (1- pos) (point-min)))
       ;; Search before pos.
       (let ((tmp-end (point)))
-        (company-dabbrev--time-limit-while (> tmp-end (point-min))
+        (company-dabbrev--time-limit-while (and (not (input-pending-p))
+                                                (> tmp-end (point-min)))
             start limit 1
           (ignore-errors
             (forward-char -10000))
@@ -119,14 +128,16 @@ This variable affects both `company-dabbrev' and 
`company-dabbrev-code'."
             ;; Before, we used backward search, but it matches non-greedily, 
and
             ;; that forced us to use the "beginning/end of word" anchors in
             ;; `company-dabbrev--make-regexp'.  It's also about 2x slower.
-            (while (re-search-forward regexp tmp-end t)
+            (while (and (not (input-pending-p))
+                        (re-search-forward regexp tmp-end t))
               (if (and ignore-comments (save-match-data 
(company-in-string-or-comment)))
                   (re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
                 (maybe-collect-match))))
           (setq tmp-end (point))))
       (goto-char (or pos (point-min)))
       ;; Search after pos.
-      (company-dabbrev--time-limit-while (re-search-forward regexp nil t)
+      (company-dabbrev--time-limit-while (and (not (input-pending-p))
+                                              (re-search-forward regexp nil t))
           start limit 25
         (if (and ignore-comments (save-match-data 
(company-in-string-or-comment)))
             (re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
diff --git a/packages/company/company-elisp.el 
b/packages/company/company-elisp.el
index 40354d5..f95d41a 100644
--- a/packages/company/company-elisp.el
+++ b/packages/company/company-elisp.el
@@ -1,6 +1,6 @@
 ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- 
lexical-binding: t -*-
 
-;; Copyright (C) 2009, 2011-2013  Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011-2013, 2017  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 
@@ -22,6 +22,7 @@
 
 ;;; Commentary:
 ;;
+;; In newer versions of Emacs, company-capf is used instead.
 
 ;;; Code:
 
diff --git a/packages/company/company-etags.el 
b/packages/company/company-etags.el
index ef53213..d0c27c9 100644
--- a/packages/company/company-etags.el
+++ b/packages/company/company-etags.el
@@ -76,6 +76,7 @@ Set it to t or to a list of major modes."
 
 (defun company-etags--candidates (prefix)
   (let ((tags-table-list (company-etags-buffer-table))
+        (tags-file-name tags-file-name)
         (completion-ignore-case company-etags-ignore-case))
     (and (or tags-file-name tags-table-list)
          (fboundp 'tags-completion-table)
diff --git a/packages/company/company-keywords.el 
b/packages/company/company-keywords.el
index bceb7f8..414c7b0 100644
--- a/packages/company/company-keywords.el
+++ b/packages/company/company-keywords.el
@@ -152,6 +152,13 @@
      "break" "catch" "const" "continue" "delete" "do" "else" "export" "for"
      "function" "if" "import" "in" "instanceOf" "label" "let" "new" "return"
      "switch" "this" "throw" "try" "typeof" "var" "void" "while" "with" 
"yield")
+    (kotlin-mode
+     "abstract" "annotation" "as" "break" "by" "catch" "class" "companion"
+     "const" "constructor" "continue" "data" "do" "else" "enum" "false" "final"
+     "finally" "for" "fun" "if" "import" "in" "init" "inner" "interface"
+     "internal" "is" "lateinit" "nested" "null" "object" "open" "out" 
"override"
+     "package" "private" "protected" "public" "return" "super" "this" "throw"
+     "trait" "true" "try" "typealias" "val" "var" "when" "while")
     (objc-mode
      "@catch" "@class" "@encode" "@end" "@finally" "@implementation"
      "@interface" "@private" "@protected" "@protocol" "@public"
@@ -212,6 +219,10 @@
      "then" "true" "undef" "unless" "until" "when" "while" "yield")
     ;; From https://doc.rust-lang.org/grammar.html#keywords
     ;; but excluding unused reserved words: 
https://www.reddit.com/r/rust/comments/34fq0k/is_there_a_good_list_of_rusts_keywords/cqucvnj
+    (go-mode
+     "break" "case" "chan" "const" "continue" "default" "defer" "else" 
"fallthrough"
+     "for" "func" "go" "goto" "if" "import" "interface" "map" "package" "range"
+     "return" "select" "struct" "switch" "type" "var")
     (rust-mode
      "Self"
      "as" "box" "break" "const" "continue" "crate" "else" "enum" "extern"
@@ -224,6 +235,19 @@
      "new" "null" "object" "override" "package" "private" "protected"
      "return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
      "var" "while" "with" "yield")
+    (swift-mode
+     "Protocol" "Self" "Type" "and" "as" "assignment" "associatedtype"
+     "associativity" "available" "break" "case" "catch" "class" "column" 
"continue"
+     "convenience" "default" "defer" "deinit" "didSet" "do" "dynamic" 
"dynamicType"
+     "else" "elseif" "endif" "enum" "extension" "fallthrough" "false" "file"
+     "fileprivate" "final" "for" "func" "function" "get" "guard" "higherThan" 
"if"
+     "import" "in" "indirect" "infix" "init" "inout" "internal" "is" "lazy" 
"left"
+     "let" "line" "lowerThan" "mutating" "nil" "none" "nonmutating" "open"
+     "operator" "optional" "override" "postfix" "precedence" "precedencegroup"
+     "prefix" "private" "protocol" "public" "repeat" "required" "rethrows" 
"return"
+     "right" "selector" "self" "set" "static" "struct" "subscript" "super" 
"switch"
+     "throw" "throws" "true" "try" "typealias" "unowned" "var" "weak" "where"
+     "while" "willSet")
     (julia-mode
      "abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
      "end" "eval" "export" "false" "finally" "for" "function" "global" "if"
diff --git a/packages/company/company-nxml.el b/packages/company/company-nxml.el
index 9c180e9..5afa00e 100644
--- a/packages/company/company-nxml.el
+++ b/packages/company/company-nxml.el
@@ -103,7 +103,7 @@
     (prefix (and (derived-mode-p 'nxml-mode)
                  rng-validate-mode
                  (and (memq (char-after) '(?' ?\" ?\  ?\t ?\n)) ;; outside word
-                      (looking-back company-nxml-in-attribute-value-regexp)
+                      (looking-back company-nxml-in-attribute-value-regexp nil)
                       (or (match-string-no-properties 4)
                           (match-string-no-properties 5)
                           ""))))
diff --git a/packages/company/company-semantic.el 
b/packages/company/company-semantic.el
index 8b13b72..2f6fe2a 100644
--- a/packages/company/company-semantic.el
+++ b/packages/company/company-semantic.el
@@ -56,7 +56,8 @@ symbol is preceded by \".\", \"->\" or \"::\", ignoring
 
 If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
 and `c-electric-colon', for automatic completion right after \">\" and
-\":\".")
+\":\"."
+  :type 'boolean)
 
 (defcustom company-semantic-insert-arguments t
   "When non-nil, insert function arguments as a template after completion."
@@ -140,7 +141,7 @@ and `c-electric-colon', for automatic completion right 
after \">\" and
                  (not (company-in-string-or-comment))
                  (or (company-semantic--prefix) 'stop)))
     (candidates (if (and (equal arg "")
-                         (not (looking-back "->\\|\\." (- (point) 2))))
+                         (not (looking-back "->\\|\\.\\|::" (- (point) 2))))
                     (company-semantic-completions-raw arg)
                   (company-semantic-completions arg)))
     (meta (funcall company-semantic-metadata-function
diff --git a/packages/company/company-tng.el b/packages/company/company-tng.el
new file mode 100644
index 0000000..46592da
--- /dev/null
+++ b/packages/company/company-tng.el
@@ -0,0 +1,163 @@
+;;; company-tng.el --- company-mode configuration for single-button interaction
+
+;; Copyright (C) 2017  Free Software Foundation, Inc.
+
+;; Author: Nikita Leshenko
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;;
+;; company-tng (Tab and Go) allows you to perform completion using just TAB.
+;; Pressing it will both select the next completion candidate in the list and
+;; insert it into the buffer (or make it look like it's inserted, in fact).
+;;
+;; It cycles the candidates like `yank-pop' or `dabbrev-expand' or Vim:
+;; Pressing TAB selects the first item in the completion menu and inserts it in
+;; the buffer. Pressing TAB again selects the second item and replaces the
+;; "inserted" item with the second one. This can continue as long as the user
+;; wishes to cycle through the menu. You can also press S-TAB to select the
+;; previous candidate, of course.
+;;
+;; The benefits are that you only have to use one shortcut key and there is no
+;; need to confirm the entry.
+;;
+;; Usage:
+;;
+;; To apply the default configuration for company-tng call
+;; `company-tng-configure-default' from your init script.
+;;
+;; You can also configure company-tng manually:
+;;
+;; Add `company-tng-frontend' to `company-frontends':
+;;
+;;   (add-to-list 'company-frontends 'company-tng-frontend)
+;;
+;; We recommend to bind TAB to `company-select-next', S-TAB to
+;; `company-select-previous', and unbind RET and other now-unnecessary
+;; keys from `company-active-map':
+;;
+;;   (define-key company-active-map (kbd "TAB") 'company-select-next)
+;;   (define-key company-active-map (kbd "<backtab>") 'company-select-previous)
+;;   (define-key company-active-map (kbd "RET") nil)
+;;
+;; Note that it's not necessary to rebind keys to use this frontend,
+;; you can use the arrow keys or M-n/M-p to select and insert
+;; candidates. You also need to decide which keys to unbind, depending
+;; on whether you want them to do the Company action or the default
+;; Emacs action (for example C-s or C-w).
+;;
+;; We recommend to disable `company-require-match' to allow free typing at any
+;; point.
+
+;;; Code:
+
+(require 'company)
+(require 'cl-lib)
+
+(defvar-local company-tng--overlay nil)
+
+;;;###autoload
+(defun company-tng-frontend (command)
+  "When the user changes the selection at least once, this
+frontend will display the candidate in the buffer as if it's
+already there and any key outside of `company-active-map' will
+confirm the selection and finish the completion."
+  (cl-case command
+    (show
+     (let ((ov (make-overlay (point) (point))))
+       (setq company-tng--overlay ov)
+       (overlay-put ov 'priority 2))
+     (advice-add 'company-select-next :before-until 
'company-tng--allow-unselected)
+     (advice-add 'company-fill-propertize :filter-args 
'company-tng--adjust-tooltip-highlight))
+    (update
+     (let ((ov company-tng--overlay)
+           (selected (nth company-selection company-candidates))
+           (prefix (length company-prefix)))
+       (move-overlay ov (- (point) prefix) (point))
+       (overlay-put ov
+                    (if (= prefix 0) 'after-string 'display)
+                    (and company-selection-changed selected))))
+    (hide
+     (when company-tng--overlay
+       (delete-overlay company-tng--overlay)
+       (kill-local-variable 'company-tng--overlay))
+     (advice-remove 'company-select-next 'company-tng--allow-unselected)
+     (advice-remove 'company-fill-propertize 
'company-tng--adjust-tooltip-highlight))
+    (pre-command
+     (when (and company-selection-changed
+                (not (company--company-command-p (this-command-keys))))
+       (company--unread-this-command-keys)
+       (setq this-command 'company-complete-selection)))))
+
+;;;###autoload
+(defun company-tng-configure-default ()
+  "Applies the default configuration to enable company-tng."
+  (setq company-require-match nil)
+  (setq company-frontends '(company-tng-frontend
+                            company-pseudo-tooltip-frontend
+                            company-echo-metadata-frontend))
+  (let ((keymap company-active-map))
+    (define-key keymap [return] nil)
+    (define-key keymap (kbd "RET") nil)
+    (define-key keymap [tab] 'company-select-next)
+    (define-key keymap (kbd "TAB") 'company-select-next)
+    (define-key keymap [backtab] 'company-select-previous)
+    (define-key keymap (kbd "S-TAB") 'company-select-previous)))
+
+(defun company-tng--allow-unselected (&optional arg)
+  "Advice `company-select-next' to allow for an 'unselected'
+state. Unselected means that no user interaction took place on the
+completion candidates and it's marked by setting
+`company-selection-changed' to nil. This advice will call the underlying
+`company-select-next' unless we need to transition to or from an unselected
+state.
+
+Possible state transitions:
+- (arg > 0) unselected -> first candidate selected
+- (arg < 0) first candidate selected -> unselected
+- (arg < 0 wrap-round) unselected -> last candidate selected
+- (arg < 0 no wrap-round) unselected -> unselected
+
+There is no need to advice `company-select-previous' because it calls
+`company-select-next' internally."
+  (cond
+   ;; Selecting next
+   ((or (not arg) (> arg 0))
+    (unless company-selection-changed
+      (company-set-selection (1- (or arg 1)) 'force-update)
+      t))
+   ;; Selecting previous
+   ((< arg 0)
+    (when (and company-selection-changed
+               (< (+ company-selection arg) 0))
+      (company-set-selection 0)
+      (setq company-selection-changed nil)
+      (company-call-frontends 'update)
+      t)
+    )))
+
+(defun company-tng--adjust-tooltip-highlight (args)
+  "Prevent the tooltip from highlighting the current selection if it wasn't
+made explicitly (i.e. `company-selection-changed' is true)"
+  (unless company-selection-changed
+    ;; The 4th arg of `company-fill-propertize' is selected
+    (setf (nth 3 args) nil))
+  args)
+
+(provide 'company-tng)
+;;; company-tng.el ends here
diff --git a/packages/company/company.el b/packages/company/company.el
index 4551bb6..8ea1db0 100644
--- a/packages/company/company.el
+++ b/packages/company/company.el
@@ -1,11 +1,11 @@
 ;;; company.el --- Modular text completion framework  -*- lexical-binding: t 
-*-
 
-;; Copyright (C) 2009-2017  Free Software Foundation, Inc.
+;; Copyright (C) 2009-2018  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <address@hidden>
 ;; URL: http://company-mode.github.io/
-;; Version: 0.9.4
+;; Version: 0.9.5
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.3"))
 
@@ -261,6 +261,12 @@ This doesn't include the margins and the scroll bar."
   :type 'integer
   :package-version '(company . "0.8.0"))
 
+(defcustom company-tooltip-maximum-width most-positive-fixnum
+  "The maximum width of the tooltip's inner area.
+This doesn't include the margins and the scroll bar."
+  :type 'integer
+  :package-version '(company . "0.9.5"))
+
 (defcustom company-tooltip-margin 1
   "Width of margin columns to show around the toolip."
   :type 'integer)
@@ -809,6 +815,11 @@ means that `company-mode' is always turned on except in 
`message-mode' buffers."
 (defun company-uninstall-map ()
   (setf (cdar company-emulation-alist) nil))
 
+(defun company--company-command-p (keys)
+  "Checks if the keys are part of company's overriding keymap"
+  (or (equal [company-dummy-event] keys)
+      (lookup-key company-my-keymap keys)))
+
 ;; Hack:
 ;; Emacs calculates the active keymaps before reading the event.  That means we
 ;; cannot change the keymap from a timer.  So we send a bogus command.
@@ -822,6 +833,9 @@ means that `company-mode' is always turned on except in 
`message-mode' buffers."
 (defun company-input-noop ()
   (push 'company-dummy-event unread-command-events))
 
+;; To avoid warnings in Emacs < 26.
+(declare-function line-number-display-width "indent.c")
+
 (defun company--posn-col-row (posn)
   (let ((col (car (posn-col-row posn)))
         ;; `posn-col-row' doesn't work well with lines of different height.
@@ -832,11 +846,12 @@ means that `company-mode' is always turned on except in 
`message-mode' buffers."
     (when (and header-line-format (version< emacs-version "24.3.93.3"))
       ;; http://debbugs.gnu.org/18384
       (cl-decf row))
+    (when (bound-and-true-p display-line-numbers)
+      (cl-decf col (+ 2 (line-number-display-width))))
     (cons (+ col (window-hscroll)) row)))
 
 (defun company--col-row (&optional pos)
-  (let (display-line-numbers)
-    (company--posn-col-row (posn-at-point pos))))
+  (company--posn-col-row (posn-at-point pos)))
 
 (defun company--row (&optional pos)
   (cdr (company--col-row pos)))
@@ -911,6 +926,12 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
           (if (> (- (time-to-seconds) start) company-async-timeout)
               (error "Company: backend %s async timeout with args %s"
                      backend args)
+            ;; XXX: Reusing the trick from company--fetch-candidates here
+            ;; doesn't work well: sit-for isn't a good fit when we want to
+            ;; ignore pending input (results in too many calls).
+            ;; FIXME: We should deal with this by standardizing on a kind of
+            ;; Future object that knows how to sync itself. In most cases (but
+            ;; not all), by calling accept-process-output, probably.
             (sleep-for company-async-wait)))
         res))))
 
@@ -958,7 +979,8 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
 (defun company--multi-backend-adapter-candidates (backends prefix separate)
   (let ((pairs (cl-loop for backend in backends
                         when (equal (company--prefix-str
-                                     (funcall backend 'prefix))
+                                     (let ((company-backend backend))
+                                       (company-call-backend 'prefix)))
                                     prefix)
                         collect (cons (funcall backend 'candidates prefix)
                                       (company--multi-candidates-mapper
@@ -1202,38 +1224,30 @@ can retrieve meta-data for them."
 
 (defun company--fetch-candidates (prefix)
   (let* ((non-essential (not (company-explicit-action-p)))
-         (c (if company--manual-action
+         (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)))
-         res)
+              (company-call-backend-raw 'candidates prefix))))
     (if (not (eq (car c) :async))
         c
-      (let ((buf (current-buffer))
-            (win (selected-window))
-            (tick (buffer-chars-modified-tick))
-            (pt (point))
-            (backend company-backend))
+      (let ((res 'none)
+            (inhibit-redisplay t))
         (funcall
          (cdr c)
          (lambda (candidates)
-           (if (not (and candidates (eq res 'done)))
-               ;; There's no completions to display,
-               ;; or the fetcher called us back right away.
-               (setq res candidates)
-             (setq company-backend backend
-                   company-candidates-cache
-                   (list (cons prefix
-                               (company--preprocess-candidates candidates))))
-             (unwind-protect
-                 (company-idle-begin buf win tick pt)
-               (unless company-candidates
-                 (setq company-backend nil
-                       company-candidates-cache nil)))))))
-      ;; FIXME: Relying on the fact that the callers
-      ;; will interpret nil as "do nothing" is shaky.
-      ;; A throw-catch would be one possible improvement.
-      (or res
-          (progn (setq res 'done) nil)))))
+           (when (eq res 'none)
+             (push 'company-foo unread-command-events))
+           (setq res candidates)))
+        (while (and (eq res 'none)
+                    (sit-for 0.5 t)))
+        (while (member (car unread-command-events)
+                       '(company-foo (t . company-foo)))
+          (pop unread-command-events))
+        (prog1
+            (and (consp res) res)
+          (setq res 'exited))))))
 
 (defun company--preprocess-candidates (candidates)
   (cl-assert (cl-every #'stringp candidates))
@@ -1533,7 +1547,8 @@ prefix match (same case) will be prioritized."
             (if (or (symbolp backend)
                     (functionp backend))
                 (when (company--maybe-init-backend backend)
-                  (funcall backend 'prefix))
+                  (let ((company-backend backend))
+                    (company-call-backend 'prefix)))
               (company--multi-backend-adapter backend 'prefix)))
       (when prefix
         (when (company--good-prefix-p prefix)
@@ -1831,7 +1846,7 @@ each one wraps a part of the input string."
   (interactive)
   (company--search-assert-enabled)
   (company-search-mode 0)
-  (company--unread-last-input))
+  (company--unread-this-command-keys))
 
 (defun company-search-delete-char ()
   (interactive)
@@ -1975,7 +1990,7 @@ With ARG, move by that many elements."
   (if (> company-candidates-length 1)
       (company-select-next arg)
     (company-abort)
-    (company--unread-last-input)))
+    (company--unread-this-command-keys)))
 
 (defun company-select-previous-or-abort (&optional arg)
   "Select the previous candidate if more than one, else abort
@@ -1986,7 +2001,7 @@ With ARG, move by that many elements."
   (if (> company-candidates-length 1)
       (company-select-previous arg)
     (company-abort)
-    (company--unread-last-input)))
+    (company--unread-this-command-keys)))
 
 (defun company-next-page ()
   "Select the candidate one page further."
@@ -2054,7 +2069,7 @@ With ARG, move by that many elements."
                                       0)))
           t)
       (company-abort)
-      (company--unread-last-input)
+      (company--unread-this-command-keys)
       nil)))
 
 (defun company-complete-mouse (event)
@@ -2170,20 +2185,22 @@ character, stripping the modifiers.  That character 
must be a digit."
     (make-string len ?\ )))
 
 (defun company-safe-substring (str from &optional to)
-  (if (> from (string-width str))
-      ""
-    (with-temp-buffer
-      (insert str)
-      (move-to-column from)
-      (let ((beg (point)))
-        (if to
-            (progn
-              (move-to-column to)
-              (concat (buffer-substring beg (point))
-                      (let ((padding (- to (current-column))))
-                        (when (> padding 0)
-                          (company-space-string padding)))))
-          (buffer-substring beg (point-max)))))))
+  (let ((bis buffer-invisibility-spec))
+    (if (> from (string-width str))
+        ""
+      (with-temp-buffer
+        (setq buffer-invisibility-spec bis)
+        (insert str)
+        (move-to-column from)
+        (let ((beg (point)))
+          (if to
+              (progn
+                (move-to-column to)
+                (concat (buffer-substring beg (point))
+                        (let ((padding (- to (current-column))))
+                          (when (> padding 0)
+                            (company-space-string padding)))))
+            (buffer-substring beg (point-max))))))))
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -2229,10 +2246,12 @@ character, stripping the modifiers.  That character 
must be a digit."
             (< (- (window-height) row 2) company-tooltip-limit)
             (recenter (- (window-height) row 2))))))
 
-(defun company--unread-last-input ()
-  (when last-input-event
-    (clear-this-command-keys t)
-    (setq unread-command-events (list last-input-event))))
+(defun company--unread-this-command-keys ()
+  (when (> (length (this-command-keys)) 0)
+    (setq unread-command-events (nconc
+                                 (listify-key-sequence (this-command-keys))
+                                 unread-command-events))
+    (clear-this-command-keys t)))
 
 (defun company-show-doc-buffer ()
   "Temporarily show the documentation buffer for the selection."
@@ -2583,6 +2602,8 @@ If SHOW-VERSION is non-nil, show the version in the echo 
area."
     ;; Account for the line continuation column.
     (when (zerop (cadr (window-fringes)))
       (cl-decf ww))
+    (when (bound-and-true-p display-line-numbers)
+      (cl-decf ww (+ 2 (line-number-display-width))))
     (unless (or (display-graphic-p)
                 (version< "24.3.1" emacs-version))
       ;; Emacs 24.3 and earlier included margins
@@ -2690,10 +2711,10 @@ If SHOW-VERSION is non-nil, show the version in the 
echo area."
              (annotation (company-call-backend 'annotation value)))
         (setq value (company--clean-string (company-reformat value)))
         (when annotation
+          (setq annotation (company--clean-string annotation))
           (when company-tooltip-align-annotations
             ;; `lisp-completion-at-point' adds a space.
-            (setq annotation (comment-string-strip annotation t nil)))
-          (setq annotation (company--clean-string annotation)))
+            (setq annotation (comment-string-strip annotation t nil))))
         (push (cons value annotation) items)
         (setq width (max (+ (length value)
                             (if (and annotation 
company-tooltip-align-annotations)
@@ -2702,6 +2723,7 @@ If SHOW-VERSION is non-nil, show the version in the echo 
area."
                          width))))
 
     (setq width (min window-width
+                     company-tooltip-maximum-width
                      (max company-tooltip-minimum-width
                           (if company-show-numbers
                               (+ 2 width)
diff --git a/packages/company/test/async-tests.el 
b/packages/company/test/async-tests.el
index 48ebdfb..033b716 100644
--- a/packages/company/test/async-tests.el
+++ b/packages/company/test/async-tests.el
@@ -1,6 +1,6 @@
 ;;; async-tests.el --- company-mode tests  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2015  Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016, 2018  Free Software Foundation, Inc.
 
 ;; Author: Dmitry Gutov
 
@@ -65,27 +65,28 @@
     (company-mode)
     (let (company-frontends
           company-transformers
-          (company-backends (list 'company-async-backend)))
+          (company-backends (list 'company-async-backend))
+          unread-command-events
+          noninteractive
+          (start-time (current-time)))
       (company-idle-begin (current-buffer) (selected-window)
                           (buffer-chars-modified-tick) (point))
-      (should (null company-candidates))
-      (sleep-for 0.1)
+      (should (< (time-to-seconds
+                  (time-subtract (current-time) start-time))
+                 0.1))
       (should (equal "foo" company-prefix))
       (should (equal '("abc" "abd") company-candidates)))))
 
-(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
+(ert-deftest company-idle-begin-with-async-aborts-on-user-input ()
   (with-temp-buffer
     (company-mode)
     (let (company-frontends
-          (company-backends (list 'company-async-backend)))
+          (company-backends (list 'company-async-backend))
+          noninteractive
+          (unread-command-events (list 'company-dummy-event)))
       (company-idle-begin (current-buffer) (selected-window)
                           (buffer-chars-modified-tick) (point))
-      (should (null company-candidates))
-      (insert "a")
-      (sleep-for 0.1)
-      (should (null company-candidates))
-      (should (null company-candidates-cache))
-      (should (null company-backend)))))
+      (should (null company-candidates)))))
 
 (ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
   (with-temp-buffer
@@ -100,7 +101,8 @@
                         (cons :async
                               (lambda (cb) (funcall cb c)))))
                      (`no-cache t)))))
-          (company-minimum-prefix-length 0))
+          (company-minimum-prefix-length 0)
+          (unread-command-events (list 'company-dummy-event)))
       (company-idle-begin (current-buffer) (selected-window)
                           (buffer-chars-modified-tick) (point))
       (should (equal '("abc" "def") company-candidates))
diff --git a/packages/company/test/core-tests.el 
b/packages/company/test/core-tests.el
index 6c846d2..2e0c77f 100644
--- a/packages/company/test/core-tests.el
+++ b/packages/company/test/core-tests.el
@@ -544,3 +544,24 @@
       (should (= (company--row) 0))
       (setq header-line-format "aaaaaaa")
       (should (= (company--row) 0)))))
+
+(ert-deftest company-column-with-line-numbers-display ()
+  :tags '(interactive)
+  (skip-unless (fboundp 'display-line-numbers-mode))
+  (with-temp-buffer
+    (display-line-numbers-mode)
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (should (= (company--column) 0)))))
+
+(ert-deftest company-row-and-column-with-line-numbers-display ()
+  :tags '(interactive)
+  (skip-unless (fboundp 'display-line-numbers-mode))
+  (with-temp-buffer
+    (display-line-numbers-mode)
+    (insert (make-string (+ (company--window-width) 
(line-number-display-width)) ?a))
+    (insert ?\n)
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (should (= (company--column) 0))
+      (should (= (company--row) 2)))))
diff --git a/packages/company/test/frontends-tests.el 
b/packages/company/test/frontends-tests.el
index 0f7c19e..7212c3f 100644
--- a/packages/company/test/frontends-tests.el
+++ b/packages/company/test/frontends-tests.el
@@ -367,6 +367,14 @@
              (company-modify-line str "zz" 10)
              "-*-foobar zz"))))
 
+(ert-deftest company-modify-line-with-invisible-prop ()
+  (let ((str "-*-foobar")
+        (buffer-invisibility-spec '((outline . t) t)))
+    (put-text-property 1 2 'invisible 'foo str)
+    (should (equal
+             (company-modify-line str "zz" 4)
+             "-*-fzzbar"))))
+
 (ert-deftest company-scrollbar-bounds ()
   (should (equal nil (company--scrollbar-bounds 0 3 3)))
   (should (equal nil (company--scrollbar-bounds 0 4 3)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]