# https://github.com/rolandwalker/emacs-travis
- language: emacs-lisp
+ language: generic
env:
matrix:
- 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
package: *.el
@ver=`grep -o "Version: .*" company.el | cut -c 10-`; \
- tar cjvf company-$$ver.tar.bz2 --mode 644 `git ls-files '*.el' | xargs`
+ tar cjvf company-$$ver.tar.bz2 --mode 644 $$(find . -name \*.el)
elpa: *.el
@version=`grep -o "Version: .*" company.el | cut -c 10-`; \
dir=company-$$version; \
mkdir -p "$$dir"; \
- cp `git ls-files '*.el' | xargs` company-$$version; \
+ cp $$(find . -name \*.el) company-$$version; \
echo "(define-package \"company\" \"$$version\" \
\"Modular in-buffer completion framework\")" \
> "$$dir"/company-pkg.el; \
# History of user-visible changes
+ ## 2016-06-23 (0.9.0)
+
+ * Group of backends can now contain keyword `:separate`, which makes candidates
+ from different backends sorted separately in the combined list.
+ * New frontend `company-pseudo-tooltip-unless-just-one-frontend-with-delay`.
+ * New transformer `company-sort-prefer-same-case-prefix`.
+ * The value of `company-dabbrev-ignore-buffers` can also be a function.
+ * `company-files` has been moved to right after `company-capf` in
+ `company-backends`
+ ([#463](https://github.com/company-mode/company-mode/issues/463)).
+ * `company-semantic-insert-arguments`: New option. Like in `company-clang`.
+ * `company-semantic-begin-after-member-access`: New option. Similar to the one
+ in `company-clang`.
+ * `company-capf` accepts `:company-prefix-length` property value.
+ * New face `company-tooltip-annotation-selection`, used for the annotation in
+ the selected tooltip line.
+ * `company-clang-objc-templatify` has been renamed to
+ `company-template-objc-templatify`.
+ * New user option `company-etags-everywhere`.
+ * `company-yasnippet` supports `yas-key-syntaxes` better. But we use them in the
+ reverse order, preferring the longest key prefix that matches anything. And we
+ only consider trigger key prefixes that are at least as long as the symbol at
+ point, which effectively means skipping the `"w"` element
+ ([#422](https://github.com/company-mode/company-mode/issues/422)).
+ * New user option `company-search-regexp-function`.
+ * Completion is not started automatically when a keyboard macro is being
+ recorded ([#374](https://github.com/company-mode/company-mode/issues/374)).
+ * New command `company-indent-or-complete-common`.
+ * Backend command `doc-buffer` now can also return a cons of buffer and window
+ start position.
+ * Backend command `ignore-case` has been documented.
+ * `company-template-c-like-templatify` does not replace the default argument
+ values with `argN` anymore
+ ([#336](https://github.com/company-mode/company-mode/issues/336)). This
+ affects `company-clang` and all third-party backends that use this function.
+ * Likewise for `company-clang-objc-templatify`.
+ * `company-template-add-field` calling convention has changed.
+ * New user option `company-dabbrev-ignore-invisible`.
+ * `company-ropemacs` was removed. `ropemacs` supports completion via
+ `completion-at-point-functions` starting with version 0.8.
+ * `company-pysmell` was removed.
+ * `company-select-next`, `company-select-previous`,
+ `company-select-next-or-abort`, `company-select-previous-or-abort` and
+ `company-complete-common-or-cycle` accept a numeric argument.
+ * The documentation buffer window can be scrolled with the mouse wheel.
+ * New command `company-diag`. Use it in bug reports.
+
## 2015-02-02 (0.8.10)
* New variable `company-lighter-base`.
See the [homepage](http://company-mode.github.com/).
- [](http://githalytics.com/company-mode/company-mode)
[](https://travis-ci.org/company-mode/company-mode)
+ [](http://melpa.milkbox.net/#/company)
- ;;; company-abbrev.el --- company-mode completion back-end for abbrev
+ ;;; company-abbrev.el --- company-mode completion backend for abbrev
- ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
- "`company-mode' completion back-end for abbrev."
+ "`company-mode' completion backend for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
- (meta (abbrev-expansion arg))
- (require-match t)))
+ (meta (abbrev-expansion arg))))
(provide 'company-abbrev)
;;; company-abbrev.el ends here
- ;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode
+ ;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode
- ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
(declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
- "Completion back-end for BBDB."
+ "Completion backend for BBDB."
:group 'company)
(defcustom company-bbdb-modes '(message-mode)
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
- "`company-mode' completion back-end for BBDB."
+ "`company-mode' completion backend for BBDB."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (memq major-mode company-bbdb-modes)
(featurep 'bbdb-com)
- (looking-back "^\\(To\\|Cc\\|Bcc\\): *\\(.*\\)"
+ (looking-back "^\\(To\\|Cc\\|Bcc\\): *.*? *\\([^,;]*\\)"
(line-beginning-position))
(match-string-no-properties 2)))
(candidates (company-bbdb--candidates arg))
- ;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
+ ;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
- ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions)))
+ (completion-at-point-functions (company--capf-workaround))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
- (when (and (consp (cdr data)) (numberp (nth 1 data))) data)))
+ (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
+
+ (declare-function python-shell-get-process "python")
+
+ (defun company--capf-workaround ()
+ ;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
+ (if (or (not (listp completion-at-point-functions))
+ (not (memq 'python-completion-complete-at-point completion-at-point-functions))
+ (python-shell-get-process))
+ completion-at-point-functions
+ (remq 'python-completion-complete-at-point completion-at-point-functions)))
(defun company-capf (command &optional arg &rest _args)
- "`company-mode' back-end using `completion-at-point-functions'."
+ "`company-mode' backend using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
- (if (> (nth 2 res) (point))
- 'stop
- (buffer-substring-no-properties (nth 1 res) (point))))))
+ (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))))))
(`candidates
(let ((res (company--capf-data)))
(when res
(cdr (assq 'display-sort-function meta))))))
(`match
;; Can't just use 0 when base-size (see above) is non-zero.
- (let ((start (if (get-text-property 0 'font-lock-face arg)
+ (let ((start (if (get-text-property 0 'face arg)
0
- (next-single-property-change 0 'font-lock-face arg))))
+ (next-single-property-change 0 'face arg))))
(when start
;; completions-common-part comes first, but we can't just look for this
;; value because it can be in a list.
(or
- (let ((value (get-text-property start 'font-lock-face arg)))
+ (let ((value (get-text-property start 'face arg)))
(text-property-not-all start (length arg)
- 'font-lock-face value arg))
+ 'face value arg))
(length arg)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
- ;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*-
+ ;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*-
- ;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(require 'cl-lib)
(defgroup company-clang nil
- "Completion back-end for Clang."
+ "Completion backend for Clang."
:group 'company)
(defcustom company-clang-executable
(get-text-property 0 'meta candidate))
(defun company-clang--annotation (candidate)
+ (let ((ann (company-clang--annotation-1 candidate)))
+ (if (not (and ann (string-prefix-p "(*)" ann)))
+ ann
+ (with-temp-buffer
+ (insert ann)
+ (search-backward ")")
+ (let ((pt (1+ (point))))
+ (re-search-forward ".\\_>" nil t)
+ (delete-region pt (point)))
+ (buffer-string)))))
+
+ (defun company-clang--annotation-1 (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
(buf (get-buffer-create "*clang-output*"))
;; Looks unnecessary in Emacs 25.1 and later.
(process-adaptive-read-buffering nil))
- (with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf)
(funcall callback nil)
+ (with-current-buffer buf
+ (erase-buffer)
+ (setq buffer-undo-list t))
(let ((process (apply #'start-process "company-clang" buf
company-clang-executable args)))
(set-process-sentinel
ver))
0)))
- (defun company-clang-objc-templatify (selector)
- (let* ((end (point-marker))
- (beg (- (point) (length selector) 1))
- (templ (company-template-declare-template beg end))
- (cnt 0))
- (save-excursion
- (goto-char beg)
- (catch 'stop
- (while (search-forward ":" end t)
- (when (looking-at "([^)]*) ?")
- (delete-region (match-beginning 0) (match-end 0)))
- (company-template-add-field templ (point) (format "arg%d" cnt))
- (if (< (point) end)
- (insert " ")
- (throw 'stop t))
- (cl-incf cnt))))
- (company-template-move-to-first templ)))
-
(defun company-clang (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Clang.
+ "`company-mode' completion backend for Clang.
Clang is a parser for C and ObjC. Clang version 1.1 or newer is required.
Additional command line arguments can be specified in
(when (and company-clang-insert-arguments anno)
(insert anno)
(if (string-match "\\`:[^:]" anno)
- (company-clang-objc-templatify anno)
+ (company-template-objc-templatify anno)
(company-template-c-like-templatify
(concat arg anno))))))))
- ;;; company-cmake.el --- company-mode completion back-end for CMake
+ ;;; company-cmake.el --- company-mode completion backend for CMake
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
(require 'cl-lib)
(defgroup company-cmake nil
- "Completion back-end for CMake."
+ "Completion backend for CMake."
:group 'company)
(defcustom company-cmake-executable
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
- "`company-mode' completion back-end for CMake.
+ "`company-mode' completion backend for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
- ;;; company-css.el --- company-mode completion back-end for css-mode -*- lexical-binding: t -*-
+ ;;; company-css.el --- company-mode completion backend for css-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
(require 'company)
(require 'cl-lib)
+ (declare-function web-mode-language-at-pos "web-mode" (&optional pos))
+
(defconst company-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
;;;###autoload
(defun company-css (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `css-mode'."
+ "`company-mode' completion backend for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
- (prefix (and (derived-mode-p 'css-mode)
+ (prefix (and (or (derived-mode-p 'css-mode)
+ (and (derived-mode-p 'web-mode)
+ (string= (web-mode-language-at-pos) "css")))
(or (company-grab company-css-tag-regexp 1)
(company-grab company-css-pseudo-regexp 1)
(company-grab company-css-property-value-regexp 2)
- ;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end for code -*- lexical-binding: t -*-
+ ;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
(require 'cl-lib)
(defgroup company-dabbrev-code nil
- "dabbrev-like completion back-end for code."
+ "dabbrev-like completion backend for code."
:group 'company)
(defcustom company-dabbrev-code-modes
"Modes that use `company-dabbrev-code'.
In all these modes (and their derivatives) `company-dabbrev-code' will
complete only symbols, not text in comments or strings. In other modes
- `company-dabbrev-code' will pass control to other back-ends
+ `company-dabbrev-code' will pass control to other backends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
- :type '(choice (repeat (symbol :tag "Major mode"))
- (const tag "All modes" t)))
+ :type '(choice (repeat :tag "Some modes" (symbol :tag "Major mode"))
+ (const :tag "All modes" t)))
(defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers.
"Non-nil to ignore case when collecting completion candidates."
:type 'boolean)
- (defsubst company-dabbrev-code--make-regexp (prefix)
+ (defun company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
;;;###autoload
(defun company-dabbrev-code (command &optional arg &rest ignored)
- "dabbrev-like `company-mode' back-end for code.
- The back-end looks for all symbols in the current buffer that aren't in
+ "dabbrev-like `company-mode' backend for code.
+ The backend looks for all symbols in the current buffer that aren't in
comments or strings."
(interactive (list 'interactive))
(cl-case command
- ;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*- lexical-binding: t -*-
+ ;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
- ;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(require 'cl-lib)
(defgroup company-dabbrev nil
- "dabbrev-like completion back-end."
+ "dabbrev-like completion backend."
:group 'company)
(defcustom company-dabbrev-other-buffers 'all
(const :tag "All" all)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
- "Regexp matching the names of buffers to ignore."
- :type 'regexp)
+ "Regexp matching the names of buffers to ignore.
+ Or a function that returns non-nil for such buffers."
+ :type '(choice (regexp :tag "Regexp")
+ (function :tag "Predicate"))
+ :package-version '(company . "0.9.0"))
(defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches."
:type 'integer
:package-version '(company . "0.8.3"))
- (defmacro company-dabrev--time-limit-while (test start limit &rest body)
+ (defcustom company-dabbrev-ignore-invisible nil
+ "Non-nil to skip invisible text."
+ :type 'boolean
+ :package-version '(company . "0.9.0"))
+
+ (defmacro company-dabbrev--time-limit-while (test start limit freq &rest body)
(declare (indent 3) (debug t))
`(let ((company-time-limit-while-counter 0))
(catch 'done
(while ,test
,@body
(and ,limit
- (eq (cl-incf company-time-limit-while-counter) 25)
+ (= (cl-incf company-time-limit-while-counter) ,freq)
(setq company-time-limit-while-counter 0)
(> (float-time (time-since ,start)) ,limit)
(throw 'done 'company-time-out))))))
- (defsubst company-dabbrev--make-regexp (prefix)
- (concat "\\<" (if (equal prefix "")
- company-dabbrev-char-regexp
- (regexp-quote prefix))
- "\\(" company-dabbrev-char-regexp "\\)*\\>"))
+ (defun company-dabbrev--make-regexp ()
+ (concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
- (let (match)
+ (cl-labels ((maybe-collect-match
+ ()
+ (let ((match (match-string-no-properties 0)))
+ (when (and (>= (length match) company-dabbrev-minimum-length)
+ (not (and company-dabbrev-ignore-invisible
+ (invisible-p (match-beginning 0)))))
+ (push match symbols)))))
(goto-char (if pos (1- pos) (point-min)))
- ;; search before pos
- (company-dabrev--time-limit-while (re-search-backward regexp nil t)
- start limit
- (setq match (match-string-no-properties 0))
- (if (and ignore-comments (company-in-string-or-comment))
- (goto-char (nth 8 (syntax-ppss)))
- (when (>= (length match) company-dabbrev-minimum-length)
- (push match symbols))))
+ ;; Search before pos.
+ (let ((tmp-end (point)))
+ (company-dabbrev--time-limit-while (> tmp-end (point-min))
+ start limit 1
+ (ignore-errors
+ (forward-char -10000))
+ (forward-line 0)
+ (save-excursion
+ ;; 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)
+ (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-dabrev--time-limit-while (re-search-forward regexp nil t)
- start limit
- (setq match (match-string-no-properties 0))
- (if (and ignore-comments (company-in-string-or-comment))
+ ;; Search after pos.
+ (company-dabbrev--time-limit-while (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)
- (when (>= (length match) company-dabbrev-minimum-length)
- (push match symbols))))
+ (maybe-collect-match)))
symbols)))
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
ignore-comments)))
(when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
- (with-current-buffer buffer
- (when (if (eq other-buffer-modes 'all)
- (not (string-match-p company-dabbrev-ignore-buffers
- (buffer-name)))
- (apply #'derived-mode-p other-buffer-modes))
- (setq symbols
- (company-dabbrev--search-buffer regexp nil symbols start
- limit ignore-comments))))
+ (unless (if (stringp company-dabbrev-ignore-buffers)
+ (string-match-p company-dabbrev-ignore-buffers
+ (buffer-name buffer))
+ (funcall company-dabbrev-ignore-buffers buffer))
+ (with-current-buffer buffer
+ (when (or (eq other-buffer-modes 'all)
+ (apply #'derived-mode-p other-buffer-modes))
+ (setq symbols
+ (company-dabbrev--search-buffer regexp nil symbols start
+ limit ignore-comments)))))
(and limit
(> (float-time (time-since start)) limit)
(cl-return))))
symbols))
+ (defun company-dabbrev--prefix ()
+ ;; Not in the middle of a word.
+ (unless (looking-at company-dabbrev-char-regexp)
+ ;; Emacs can't do greedy backward-search.
+ (company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
+ company-dabbrev-char-regexp)
+ 1)))
+
+ (defun company-dabbrev--filter (prefix candidates)
+ (let ((completion-ignore-case company-dabbrev-ignore-case))
+ (all-completions prefix candidates)))
+
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
- "dabbrev-like `company-mode' completion back-end."
+ "dabbrev-like `company-mode' completion backend."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
- (prefix (company-grab-word))
+ (prefix (company-dabbrev--prefix))
(candidates
(let* ((case-fold-search company-dabbrev-ignore-case)
- (words (company-dabbrev--search (company-dabbrev--make-regexp arg)
+ (words (company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
+ (setq words (company-dabbrev--filter arg words))
(if downcase-p
(mapcar 'downcase words)
words)))
- ;;; company-eclim.el --- company-mode completion back-end for Eclim
+ ;;; company-eclim.el --- company-mode completion backend for Eclim
- ;; Copyright (C) 2009, 2011, 2013 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;;; Commentary:
;;
- ;; Using `emacs-eclim' together with (or instead of) this back-end is
+ ;; Using `emacs-eclim' together with (or instead of) this backend is
;; recommended, as it allows you to use other Eclim features.
;;
- ;; The alternative back-end provided by `emacs-eclim' uses `yasnippet'
+ ;; The alternative backend provided by `emacs-eclim' uses `yasnippet'
;; instead of `company-template' to expand function calls, and it supports
;; some languages other than Java.
(require 'cl-lib)
(defgroup company-eclim nil
- "Completion back-end for Eclim."
+ "Completion backend for Eclim."
:group 'company)
(defun company-eclim-executable-find ()
(cl-return file)))))
(defcustom company-eclim-executable
- (or (executable-find "eclim") (company-eclim-executable-find))
+ (or (bound-and-true-p eclim-executable)
+ (executable-find "eclim")
+ (company-eclim-executable-find))
"Location of eclim executable."
:type 'file)
(defun company-eclim--project-dir ()
(if (eq company-eclim--project-dir 'unknown)
- (setq company-eclim--project-dir
- (directory-file-name
- (expand-file-name
- (locate-dominating-file buffer-file-name ".project"))))
+ (let ((dir (locate-dominating-file buffer-file-name ".project")))
+ (when dir
+ (setq company-eclim--project-dir
+ (directory-file-name
+ (expand-file-name dir)))))
company-eclim--project-dir))
(defun company-eclim--project-name ()
prefix)))
(defun company-eclim (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Eclim.
+ "`company-mode' completion backend for Eclim.
Eclim provides access to Eclipse Java IDE features for other editors.
Eclim version 1.7.13 or newer (?) is required.
- ;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*- lexical-binding: t -*-
+ ;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
(require 'find-func)
(defgroup company-elisp nil
- "Completion back-end for Emacs Lisp."
+ "Completion backend for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Emacs Lisp."
+ "`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))
- ;;; company-etags.el --- company-mode completion back-end for etags
+ ;;; company-etags.el --- company-mode completion backend for etags
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
(require 'etags)
(defgroup company-etags nil
- "Completion back-end for etags."
+ "Completion backend for etags."
:group 'company)
(defcustom company-etags-use-main-table-list t
:type 'boolean
:package-version '(company . "0.7.3"))
+ (defcustom company-etags-everywhere nil
+ "Non-nil to offer completions in comments and strings.
+ Set it to t or to a list of major modes."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Any supported mode" t)
+ (repeat :tag "Some major modes"
+ (symbol :tag "Major mode")))
+ :package-version '(company . "0.9.0"))
+
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
jde-mode pascal-mode perl-mode python-mode))
(defvar-local company-etags-buffer-table 'unknown)
(defun company-etags-find-table ()
- (let ((file (locate-dominating-file (or buffer-file-name
- default-directory)
- "TAGS")))
+ (let ((file (expand-file-name
+ "TAGS"
+ (locate-dominating-file (or buffer-file-name
+ default-directory)
+ "TAGS"))))
(when (and file (file-regular-p file))
- (list (expand-file-name file)))))
+ (list file))))
(defun company-etags-buffer-table ()
(or (and company-etags-use-main-table-list tags-table-list)
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
- "`company-mode' completion back-end for etags."
+ "`company-mode' completion backend for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
- (prefix (and (apply 'derived-mode-p company-etags-modes)
- (not (company-in-string-or-comment))
+ (prefix (and (apply #'derived-mode-p company-etags-modes)
+ (or (eq t company-etags-everywhere)
+ (apply #'derived-mode-p company-etags-everywhere)
+ (not (company-in-string-or-comment)))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))
- ;;; company-files.el --- company-mode completion back-end for file paths
+ ;;; company-files.el --- company-mode completion backend for file paths
- ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(defun company-files--directory-files (dir prefix)
(ignore-errors
- (if (equal prefix "")
- (directory-files dir nil "\\`[^.]\\|\\`.[^.]")
- (file-name-all-completions prefix dir))))
+ ;; Don't use directory-files. It produces directories without trailing /.
+ (let ((comp (sort (file-name-all-completions prefix dir)
+ (lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
+ (if (equal prefix "")
+ (delete "../" (delete "./" comp))
+ comp))))
(defvar company-files--regexps
(let* ((root (if (eq system-type 'windows-nt)
(and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
+ (company-files--connected-p file)
(setq dir (file-name-directory file))
(not (string-match "//" dir))
(file-exists-p dir)
- (file-name-all-completions (file-name-nondirectory file) dir)
file)))
+ (defun company-files--connected-p (file)
+ (or (not (file-remote-p file))
+ (file-remote-p file nil t)))
+
+ (defun company-files--trailing-slash-p (file)
+ ;; `file-directory-p' is very expensive on remotes. We are relying on
+ ;; `file-name-all-completions' returning directories with trailing / instead.
+ (let ((len (length file)))
+ (and (> len 0) (eq (aref file (1- len)) ?/))))
+
(defvar company-files--completion-cache nil)
(defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
- (key (list (file-name-nondirectory prefix)
+ (file (file-name-nondirectory prefix))
+ (key (list file
(expand-file-name dir)
(nth 5 (file-attributes dir))))
- (file (file-name-nondirectory prefix))
- (completion-ignore-case read-file-name-completion-ignore-case)
- candidates directories)
+ (completion-ignore-case read-file-name-completion-ignore-case))
(unless (company-file--keys-match-p key (car company-files--completion-cache))
- (dolist (file (company-files--directory-files dir file))
- (setq file (concat dir file))
- (push file candidates)
- (when (file-directory-p file)
- (push file directories)))
- (dolist (directory (reverse directories))
- ;; Add one level of children.
- (dolist (child (company-files--directory-files directory ""))
- (push (concat directory
- (unless (eq (aref directory (1- (length directory))) ?/) "/")
- child) candidates)))
- (setq company-files--completion-cache (cons key (nreverse candidates))))
+ (let* ((candidates (mapcar (lambda (f) (concat dir f))
+ (company-files--directory-files dir file)))
+ (directories (unless (file-remote-p dir)
+ (cl-remove-if-not (lambda (f)
+ (and (company-files--trailing-slash-p f)
+ (not (file-remote-p f))
+ (company-files--connected-p f)))
+ candidates)))
+ (children (and directories
+ (cl-mapcan (lambda (d)
+ (mapcar (lambda (c) (concat d c))
+ (company-files--directory-files d "")))
+ directories))))
+ (setq company-files--completion-cache
+ (cons key (append candidates children)))))
(all-completions prefix
(cdr company-files--completion-cache))))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
- "`company-mode' completion back-end existing file names.
+ "`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
(candidates (company-files--complete arg))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
+ (post-completion (when (company-files--trailing-slash-p arg)
+ (delete-char -1)))
(sorted t)
(no-cache t)))
- ;;; company-gtags.el --- company-mode completion back-end for GNU Global
+ ;;; company-gtags.el --- company-mode completion backend for GNU Global
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;;; Code:
(require 'company)
+ (require 'company-template)
(require 'cl-lib)
(defgroup company-gtags nil
- "Completion back-end for GNU Global."
+ "Completion backend for GNU Global."
:group 'company)
(defcustom company-gtags-executable
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
- "`company-mode' completion back-end for GNU Global."
+ "`company-mode' completion backend for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
- ;;; company-ispell.el --- company-mode completion back-end using Ispell
+ ;;; company-ispell.el --- company-mode completion backend using Ispell
- ;; Copyright (C) 2009-2011, 2013-2015 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(require 'ispell)
(defgroup company-ispell nil
- "Completion back-end using Ispell."
+ "Completion backend using Ispell."
:group 'company)
(defcustom company-ispell-dictionary nil
(defvar company-ispell-available 'unknown)
+ (defalias 'company-ispell--lookup-words
+ (if (fboundp 'ispell-lookup-words)
+ 'ispell-lookup-words
+ 'lookup-words))
+
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
- (lookup-words "WHATEVER")
+ (company-ispell--lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company: ispell-look-command not found")
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
- "`company-mode' completion back-end using Ispell."
+ "`company-mode' completion backend using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates
- (let ((words (lookup-words arg (or company-ispell-dictionary
- ispell-complete-word-dict)))
+ (let ((words (company-ispell--lookup-words
+ arg
+ (or company-ispell-dictionary ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
;; Small optimization.
- ;;; company-keywords.el --- A company back-end for programming language keywords
+ ;;; company-keywords.el --- A company backend for programming language keywords
- ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(defvar company-keywords-alist
;; Please contribute corrections or additions.
`((c++-mode
- "asm" "auto" "bool" "break" "case" "catch" "char" "class" "const"
- "const_cast" "continue" "default" "delete" "do" "double" "dynamic_cast"
- "else" "enum" "explicit" "export" "extern" "false" "float" "for" "friend"
- "goto" "if" "inline" "int" "long" "mutable" "namespace" "new"
- "operator" "private" "protected" "public" "register" "reinterpret_cast"
- "return" "short" "signed" "sizeof" "static" "static_cast" "struct" "switch"
- "template" "this" "throw" "true" "try" "typedef" "typeid" "typename"
+ "alignas" "alignof" "asm" "auto" "bool" "break" "case" "catch" "char"
+ "char16_t" "char32_t" "class" "const" "const_cast" "constexpr" "continue"
+ "decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum"
+ "explicit" "export" "extern" "false" "final" "float" "for" "friend"
+ "goto" "if" "inline" "int" "long" "mutable" "namespace" "new" "noexcept"
+ "nullptr" "operator" "override"
+ "private" "protected" "public" "register" "reinterpret_cast"
+ "return" "short" "signed" "sizeof" "static" "static_assert"
+ "static_cast" "struct" "switch" "template" "this" "thread_local"
+ "throw" "true" "try" "typedef" "typeid" "typename"
"union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while")
(c-mode
"auto" "break" "case" "char" "const" "continue" "default" "do"
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
"next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super"
"then" "true" "undef" "unless" "until" "when" "while" "yield")
+ (scala-mode
+ "abstract" "case" "catch" "class" "def" "do" "else" "extends" "false"
+ "final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match"
+ "new" "null" "object" "override" "package" "private" "protected"
+ "return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
+ "var" "while" "with" "yield")
+ (julia-mode
+ "abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
+ "end" "eval" "export" "false" "finally" "for" "function" "global" "if"
+ "ifelse" "immutable" "import" "importall" "in" "let" "macro" "module"
+ "otherwise" "quote" "return" "switch" "throw" "true" "try" "type"
+ "typealias" "using" "while"
+ )
;; aliases
(js2-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(cperl-mode . perl-mode)
- (jde-mode . java-mode))
+ (jde-mode . java-mode)
+ (ess-julia-mode . julia-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
- "`company-mode' back-end for programming language keywords."
+ "`company-mode' backend for programming language keywords."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-keywords))
- ;;; company-nxml.el --- company-mode completion back-end for nxml-mode
+ ;;; company-nxml.el --- company-mode completion backend for nxml-mode
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `nxml-mode'."
+ "`company-mode' completion backend for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-nxml))
- ;;; company-oddmuse.el --- company-mode completion back-end for oddmuse-mode
+ ;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
(require 'company)
(require 'cl-lib)
- (eval-when-compile (require 'yaooddmuse nil t))
+ (eval-when-compile (require 'yaoddmuse nil t))
(eval-when-compile (require 'oddmuse nil t))
(defvar company-oddmuse-link-regexp
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `oddmuse-mode'."
+ "`company-mode' completion backend for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-oddmuse))
- ;;; company-semantic.el --- company-mode completion back-end using Semantic
+ ;;; company-semantic.el --- company-mode completion backend using Semantic
- ;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;;; Code:
(require 'company)
+ (require 'company-template)
(require 'cl-lib)
(defvar semantic-idle-summary-function)
(declare-function semantic-tag-start "semantic/tag")
(declare-function semantic-tag-buffer "semantic/tag")
(declare-function semantic-active-p "semantic")
+ (declare-function semantic-format-tag-prototype "semantic/format")
(defgroup company-semantic nil
- "Completion back-end using Semantic."
+ "Completion backend using Semantic."
:group 'company)
(defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc
"The function turning a semantic tag into doc information."
:type 'function)
+ (defcustom company-semantic-begin-after-member-access t
+ "When non-nil, automatic completion will start whenever the current
+ symbol is preceded by \".\", \"->\" or \"::\", ignoring
+ `company-minimum-prefix-length'.
+
+ If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
+ and `c-electric-colon', for automatic completion right after \">\" and
+ \":\".")
+
+ (defcustom company-semantic-insert-arguments t
+ "When non-nil, insert function arguments as a template after completion."
+ :type 'boolean
+ :package-version '(company . "0.9.0"))
+
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
(defvar-local company-semantic--current-tags nil
(let ((completion-ignore-case nil)
(context (semantic-analyze-current-context)))
(setq company-semantic--current-tags
- (semantic-analyze-possible-completions context))
+ (semantic-analyze-possible-completions context 'no-unique))
(all-completions prefix company-semantic--current-tags))))
(defun company-semantic-completions-raw (prefix)
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic-annotation (argument tags)
- (let* ((tag (assoc argument tags))
+ (let* ((tag (assq argument tags))
(kind (when tag (elt tag 1))))
(cl-case kind
(function (let* ((prototype (semantic-format-tag-prototype tag nil nil))
(par-pos (string-match "(" prototype)))
(when par-pos (substring prototype par-pos)))))))
- (defun company-semantic--pre-prefix-length (prefix-length)
- "Sum up the length of all chained symbols before POS.
- Symbols are chained by \".\" or \"->\"."
- (save-excursion
- (let ((pos (point)))
- (goto-char (- (point) prefix-length))
- (while (looking-back "->\\|\\.")
- (goto-char (match-beginning 0))
- (skip-syntax-backward "w_"))
- (- pos (point)))))
-
- (defun company-semantic--grab ()
- "Grab the semantic prefix, but return everything before -> or . as length."
- (let ((symbol (company-grab-symbol)))
- (when symbol
- (cons symbol (company-semantic--pre-prefix-length (length symbol))))))
+ (defun company-semantic--prefix ()
+ (if company-semantic-begin-after-member-access
+ (company-grab-symbol-cons "\\.\\|->\\|::" 2)
+ (company-grab-symbol)))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
- "`company-mode' completion back-end using CEDET Semantic."
+ "`company-mode' completion backend using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-semantic))
(semantic-active-p)
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
- (or (company-semantic--grab) 'stop)))
+ (or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
- (not (looking-back "->\\|\\.")))
+ (not (looking-back "->\\|\\." (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
+ (duplicates t)
(location (let ((tag (assoc arg company-semantic--current-tags)))
(when (buffer-live-p (semantic-tag-buffer tag))
(cons (semantic-tag-buffer tag)
- (semantic-tag-start tag)))))))
+ (semantic-tag-start tag)))))
+ (post-completion (let ((anno (company-semantic-annotation
+ arg company-semantic--current-tags)))
+ (when (and company-semantic-insert-arguments anno)
+ (insert anno)
+ (company-template-c-like-templatify (concat arg anno)))
+ ))))
(provide 'company-semantic)
;;; company-semantic.el ends here
- ;;; company-template.el
+ ;;; company-template.el --- utility library for template expansion
- ;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(delq templ company-template--buffer-templates))
(delete-overlay templ))
- (defun company-template-add-field (templ pos text &optional display)
- "Add new field to template TEMPL at POS, inserting TEXT.
+ (defun company-template-add-field (templ beg end &optional display)
+ "Add new field to template TEMPL spanning from BEG to END.
When DISPLAY is non-nil, set the respective property on the overlay.
Leave point at the end of the field."
(cl-assert templ)
- (goto-char pos)
- (insert text)
- (when (> (point) (overlay-end templ))
- (move-overlay templ (overlay-start templ) (point)))
- (let ((ov (make-overlay pos (+ pos (length text))))
+ (when (> end (overlay-end templ))
+ (move-overlay templ (overlay-start templ) end))
+ (let ((ov (make-overlay beg end))
(siblings (overlay-get templ 'company-template-fields)))
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'intangible t)
(defun company-template-c-like-templatify (call)
(let* ((end (point-marker))
(beg (- (point) (length call)))
- (cnt 0)
(templ (company-template-declare-template beg end))
paren-open paren-close)
(with-syntax-table (make-syntax-table (syntax-table))
(forward-char 1)
(backward-sexp)
(forward-char)
- (setq cnt (company-template--c-like-args templ angle-close
- cnt))))
+ (company-template--c-like-args templ angle-close)))
+ (when (looking-back "\\((\\*)\\)(" (line-beginning-position))
+ (delete-region (match-beginning 1) (match-end 1)))
(when paren-open
(goto-char paren-open)
- (company-template--c-like-args templ paren-close cnt)))
+ (company-template--c-like-args templ paren-close)))
(if (overlay-get templ 'company-template-fields)
(company-template-move-to-first templ)
(company-template-remove-template templ)
(goto-char end))))
- (defun company-template--c-like-args (templ end counter)
+ (defun company-template--c-like-args (templ end)
(let ((last-pos (point)))
(while (re-search-forward "\\([^,]+\\),?" end 'move)
(when (zerop (car (parse-partial-sexp last-pos (point))))
- (let ((sig (buffer-substring-no-properties last-pos (match-end 1))))
- (save-excursion
- (company-template-add-field templ last-pos
- (format "arg%d" counter) sig)
- (delete-region (point) (+ (point) (length sig))))
- (skip-chars-forward " ")
- (setq last-pos (point))
- (cl-incf counter)))))
- counter)
+ (company-template-add-field templ last-pos (match-end 1))
+ (skip-chars-forward " ")
+ (setq last-pos (point))))))
+
+ ;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (defun company-template-objc-templatify (selector)
+ (let* ((end (point-marker))
+ (beg (- (point) (length selector) 1))
+ (templ (company-template-declare-template beg end))
+ (cnt 0))
+ (save-excursion
+ (goto-char beg)
+ (catch 'stop
+ (while (search-forward ":" end t)
+ (if (looking-at "\\(([^)]*)\\) ?")
+ (company-template-add-field templ (point) (match-end 1))
+ ;; Not sure which conditions this case manifests under, but
+ ;; apparently it did before, when I wrote the first test for this
+ ;; function. FIXME: Revisit it.
+ (company-template-add-field templ (point)
+ (progn
+ (insert (format "arg%d" cnt))
+ (point)))
+ (when (< (point) end)
+ (insert " "))
+ (cl-incf cnt))
+ (when (>= (point) end)
+ (throw 'stop t)))))
+ (company-template-move-to-first templ)))
(provide 'company-template)
;;; company-template.el ends here
- ;;; company-tempo.el --- company-mode completion back-end for tempo
+ ;;; company-tempo.el --- company-mode completion backend for tempo
- ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(require 'cl-lib)
(require 'tempo)
+ (defgroup company-tempo nil
+ "Tempo completion backend."
+ :group 'company)
+
+ (defcustom company-tempo-expand nil
+ "Whether to expand a tempo tag after completion."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t)))
+
(defsubst company-tempo-lookup (match)
(cdr (assoc match (tempo-build-collection))))
;;;###autoload
(defun company-tempo (command &optional arg &rest ignored)
- "`company-mode' completion back-end for tempo."
+ "`company-mode' completion backend for tempo."
(interactive (list 'interactive))
(cl-case command
- (interactive (company-begin-backend 'company-tempo
- 'company-tempo-insert))
+ (interactive (company-begin-backend 'company-tempo))
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
(candidates (all-completions arg (tempo-build-collection)))
(meta (company-tempo-meta arg))
- (require-match t)
+ (post-completion (when company-tempo-expand (company-tempo-insert arg)))
(sorted t)))
(provide 'company-tempo)
- ;;; company-xcode.el --- company-mode completion back-end for Xcode projects
+ ;;; company-xcode.el --- company-mode completion backend for Xcode projects
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
(require 'cl-lib)
(defgroup company-xcode nil
- "Completion back-end for Xcode projects."
+ "Completion backend for Xcode projects."
:group 'company)
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
company-xcode-tags))))))
;;;###autoload
(defun company-xcode (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Xcode projects."
+ "`company-mode' completion backend for Xcode projects."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-xcode))
- ;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet
+ ;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
- ;; Copyright (C) 2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
(declare-function yas-expand-snippet "yasnippet")
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
+ (declare-function yas--warning "yasnippet")
+
+ (defun company-yasnippet--key-prefixes ()
+ ;; Mostly copied from `yas--templates-for-key-at-point'.
+ (defvar yas-key-syntaxes)
+ (save-excursion
+ (let ((original (point))
+ (methods yas-key-syntaxes)
+ prefixes
+ method)
+ (while methods
+ (unless (eq method (car methods))
+ (goto-char original))
+ (setq method (car methods))
+ (cond ((stringp method)
+ (skip-syntax-backward method)
+ (setq methods (cdr methods)))
+ ((functionp method)
+ (unless (eq (funcall method original)
+ 'again)
+ (setq methods (cdr methods))))
+ (t
+ (setq methods (cdr methods))
+ (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
+ (let ((prefix (buffer-substring-no-properties (point) original)))
+ (unless (equal prefix (car prefixes))
+ (push prefix prefixes))))
+ prefixes)))
(defun company-yasnippet--candidates (prefix)
+ ;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
+ ;; matches, so the longest prefix with any matches should be the most useful.
+ (cl-loop with tables = (yas--get-snippet-tables)
+ for key-prefix in (company-yasnippet--key-prefixes)
+ ;; Only consider keys at least as long as the symbol at point.
+ when (>= (length key-prefix) (length prefix))
+ thereis (company-yasnippet--completions-for-prefix prefix
+ key-prefix
+ tables)))
+
+ (defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
(cl-mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
(maphash
(lambda (key value)
(when (and (stringp key)
- (string-prefix-p prefix key))
+ (string-prefix-p key-prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
- 'yas-template template)
+ 'yas-template template
+ 'yas-prefix-offset (- (length key-prefix)
+ (length prefix)))
res))
value)))
keyhash))
res))
- (yas--get-snippet-tables)))
+ tables))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
- "`company-mode' back-end for `yasnippet'.
+ "`company-mode' backend for `yasnippet'.
- This back-end should be used with care, because as long as there are
- snippets defined for the current major mode, this back-end will always
- shadow back-ends that come after it. Recommended usages:
+ This backend should be used with care, because as long as there are
+ snippets defined for the current major mode, this backend will always
+ shadow backends that come after it. Recommended usages:
- * In a buffer-local value of `company-backends', grouped with a back-end or
+ * In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
- * After keyword `:with', grouped with other back-ends.
+ * After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
(unless company-tooltip-align-annotations " -> ")
(get-text-property 0 'yas-annotation arg)))
(candidates (company-yasnippet--candidates arg))
+ (no-cache t)
(post-completion
- (let ((template (get-text-property 0 'yas-template arg)))
+ (let ((template (get-text-property 0 'yas-template arg))
+ (prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
(yas-expand-snippet (yas--template-content template)
- (- (point) (length arg))
+ (- (point) (length arg) prefix-offset)
(point)
(yas--template-expand-env template))))))
;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
- ;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
- ;; Version: 0.8.12
+ ;; Version: 0.9.0
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;;; Commentary:
;;
- ;; Company is a modular completion mechanism. Modules for retrieving completion
- ;; candidates are called back-ends, modules for displaying them are front-ends.
+ ;; Company is a modular completion framework. Modules for retrieving completion
+ ;; candidates are called backends, modules for displaying them are frontends.
;;
- ;; Company comes with many back-ends, e.g. `company-elisp'. These are
+ ;; Company comes with many backends, e.g. `company-etags'. These are
;; distributed in separate files and can be used individually.
;;
- ;; Place company.el and the back-ends you want to use in a directory and add the
- ;; following to your .emacs:
- ;; (add-to-list 'load-path "/path/to/company")
- ;; (autoload 'company-mode "company" nil t)
+ ;; Enable `company-mode' in all buffers with M-x global-company-mode. For
+ ;; further information look at the documentation for `company-mode' (C-h f
+ ;; company-mode RET).
;;
- ;; Enable company-mode with M-x company-mode. For further information look at
- ;; the documentation for `company-mode' (C-h f company-mode RET)
- ;;
- ;; If you want to start a specific back-end, call it interactively or use
+ ;; If you want to start a specific backend, call it interactively or use
;; `company-begin-backend'. For example:
;; M-x company-abbrev will prompt for and insert an abbrev.
;;
- ;; To write your own back-end, look at the documentation for `company-backends'.
+ ;; To write your own backend, look at the documentation for `company-backends'.
;; Here is a simple example completing "foo":
;;
;; (defun company-my-backend (command &optional arg &rest ignored)
;; (pcase command
- ;; (`prefix (when (looking-back "foo\\>")
- ;; (match-string 0)))
+ ;; (`prefix (company-grab-symbol))
;; (`candidates (list "foobar" "foobaz" "foobarbaz"))
;; (`meta (format "This value is named %s" arg))))
;;
- ;; Sometimes it is a good idea to mix several back-ends together, for example to
- ;; enrich gtags with dabbrev-code results (to emulate local variables).
- ;; To do this, add a list with both back-ends as an element in company-backends.
+ ;; Sometimes it is a good idea to mix several backends together, for example to
+ ;; enrich gtags with dabbrev-code results (to emulate local variables). To do
+ ;; this, add a list with both backends as an element in `company-backends'.
;;
;;; Change Log:
;;
(require 'cl-lib)
(require 'newcomment)
+ (require 'pcase)
;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
(add-to-list 'debug-ignored-errors "^Company not ")
(add-to-list 'debug-ignored-errors "^No candidate number ")
(add-to-list 'debug-ignored-errors "^Cannot complete at point$")
- (add-to-list 'debug-ignored-errors "^No other back-end$")
+ (add-to-list 'debug-ignored-errors "^No other backend$")
;;; Compatibility
(eval-and-compile
"Face used for the tooltip.")
(defface company-tooltip-selection
- '((default :inherit company-tooltip)
- (((class color) (min-colors 88) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "light blue"))
(((class color) (min-colors 88) (background dark))
(:background "orange1"))
"Face used for the tooltip item under the mouse.")
(defface company-tooltip-common
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "darkred")
(((background dark))
:foreground "red"))
"Face used for the common completion in the tooltip.")
(defface company-tooltip-common-selection
- '((default :inherit company-tooltip-selection)
- (((background light))
- :foreground "darkred")
- (((background dark))
- :foreground "red"))
+ '((default :inherit company-tooltip-common))
"Face used for the selected common completion in the tooltip.")
(defface company-tooltip-annotation
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "firebrick4")
(((background dark))
:foreground "red4"))
- "Face used for the annotation in the tooltip.")
+ "Face used for the completion annotation in the tooltip.")
+
+ (defface company-tooltip-annotation-selection
+ '((default :inherit company-tooltip-annotation))
+ "Face used for the selected completion annotation in the tooltip.")
(defface company-scrollbar-fg
'((((background light))
"Face used for the tooltip scrollbar thumb.")
(defface company-scrollbar-bg
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:background "wheat")
(((background dark))
:background "gold"))
(defface company-preview
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit (company-tooltip-selection company-tooltip))
(((background dark))
:background "blue4"
:foreground "wheat"))
(defface company-preview-common
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit company-tooltip-common-selection)
(((background dark))
:inherit company-preview
:foreground "red"))
(defun company-frontends-set (variable value)
;; Uniquify.
(let ((value (delete-dups (copy-sequence value))))
- (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
- (memq 'company-pseudo-tooltip-frontend value)
- (error "Pseudo tooltip frontend cannot be used twice"))
+ (and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
+ (memq 'company-pseudo-tooltip-frontend value))
+ (and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
+ (memq 'company-pseudo-tooltip-frontend value))
+ (and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
+ (memq 'company-pseudo-tooltip-unless-just-one-frontend value)))
+ (error "Pseudo tooltip frontend cannot be used more than once"))
(and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-frontend value)
(error "Preview frontend cannot be used twice"))
(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
company-preview-if-just-one-frontend
company-echo-metadata-frontend)
- "The list of active front-ends (visualizations).
- Each front-end is a function that takes one argument. It is called with
+ "The list of active frontends (visualizations).
+ Each frontend is a function that takes one argument. It is called with
one of the following arguments:
`show': When the visualization should start.
company-pseudo-tooltip-frontend)
(const :tag "pseudo tooltip, multiple only"
company-pseudo-tooltip-unless-just-one-frontend)
+ (const :tag "pseudo tooltip, multiple only, delayed"
+ company-pseudo-tooltip-unless-just-one-frontend-with-delay)
(const :tag "preview" company-preview-frontend)
(const :tag "preview, unique only"
company-preview-if-just-one-frontend)
(company-keywords . "Programming language keywords")
(company-nxml . "nxml")
(company-oddmuse . "Oddmuse")
- (company-pysmell . "PySmell")
- (company-ropemacs . "ropemacs")
(company-semantic . "Semantic")
(company-tempo . "Tempo templates")
(company-xcode . "Xcode")))
(assq backend company-safe-backends))
(cl-return t))))))
- (defcustom company-backends `(,@(unless (version< "24.3.50" emacs-version)
+ (defcustom company-backends `(,@(unless (version< "24.3.51" emacs-version)
(list 'company-elisp))
company-bbdb
company-nxml company-css
company-eclim company-semantic company-clang
- company-xcode company-ropemacs company-cmake
+ company-xcode company-cmake
company-capf
+ company-files
(company-dabbrev-code company-gtags company-etags
company-keywords)
- company-oddmuse company-files company-dabbrev)
- "The list of active back-ends (completion engines).
+ company-oddmuse company-dabbrev)
+ "The list of active backends (completion engines).
- Only one back-end is used at a time. The choice depends on the order of
+ Only one backend is used at a time. The choice depends on the order of
the items in this list, and on the values they return in response to the
- `prefix' command (see below). But a back-end can also be a \"grouped\"
+ `prefix' command (see below). But a backend can also be a \"grouped\"
one (see below).
- `company-begin-backend' can be used to start a specific back-end,
- `company-other-backend' will skip to the next matching back-end in the list.
+ `company-begin-backend' can be used to start a specific backend,
+ `company-other-backend' will skip to the next matching backend in the list.
- Each back-end is a function that takes a variable number of arguments.
- The first argument is the command requested from the back-end. It is one
+ 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 back-end should return the text to be completed. It must be
+ `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 back-end. The function should return `stop' if it
+ control to the next backend. The function should return `stop' if it
should complete but cannot (e.g. if it is in the middle of a string).
- Instead of a string, the back-end may return a cons where car is the prefix
- and cdr is used in `company-minimum-prefix-length' test. It must be either
- number or t, and in the latter case the test automatically succeeds.
+ 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.
`candidates': The second argument is the prefix to be completed. The
return value should be a list of candidates that match the prefix.
feature must disable cache (return t to `no-cache') and might also want to
respond to `match'.
- Optional commands:
+ Optional commands
+ =================
`sorted': Return t here to indicate that the candidates are sorted and will
not need to be sorted again.
from the list.
`no-cache': Usually company doesn't ask for candidates again as completion
- progresses, unless the back-end returns t for this command. The second
+ progresses, unless the backend returns t for this command. The second
argument is the latest prefix.
+ `ignore-case': Return t here if the backend returns case-insensitive
+ matches. This value is used to determine the longest common prefix (as
+ used in `company-complete-common'), and to filter completions when fetching
+ them from cache.
+
`meta': The second argument is a completion candidate. Return a (short)
documentation string for it.
`doc-buffer': The second argument is a completion candidate. Return a
- buffer with documentation for it. Preferably use `company-doc-buffer',
+ buffer with documentation for it. Preferably use `company-doc-buffer'. If
+ not all buffer contents pertain to this candidate, return a cons of buffer
+ and window start position.
- `location': The second argument is a completion candidate. Return the cons
+ `location': The second argument is a completion candidate. Return a cons
of buffer and buffer location, or of file and line number where the
completion candidate was defined.
backends that provide non-prefix completion.
`require-match': If this returns t, the user is not allowed to enter
- anything not offered as a candidate. Use with care! The default value nil
- gives the user that choice with `company-require-match'. Return value
- `never' overrides that option the other way around.
+ anything not offered as a candidate. Please don't use that value in normal
+ backends. The default value nil gives the user that choice with
+ `company-require-match'. Return value `never' overrides that option the
+ other way around.
- `init': Called once for each buffer. The back-end can check for external
+ `init': Called once for each buffer. The backend can check for external
programs and files and load any required libraries. Raising an error here
- will show up in message log once, and the back-end will not be used for
+ will show up in message log once, and the backend will not be used for
completion.
`post-completion': Called after a completion candidate has been inserted
into the buffer. The second argument is the candidate. Can be used to
modify it, e.g. to expand a snippet.
- The back-end should return nil for all commands it does not support or
+ The backend should return nil for all commands it does not support or
does not know about. It should also be callable interactively and use
`company-begin-backend' to start itself in that case.
- Grouped back-ends:
+ Grouped backends
+ ================
- An element of `company-backends' can also itself be a list of back-ends,
- then it's considered to be a \"grouped\" back-end.
+ An element of `company-backends' can also be a list of backends. The
+ completions from backends in such groups are merged, but only from those
+ backends which return the same `prefix'.
- When possible, commands taking a candidate as an argument are dispatched to
- the back-end it came from. In other cases, the first non-nil value among
- all the back-ends is returned.
+ If a backend command takes a candidate as an argument (e.g. `meta'), the
+ call is dispatched to the backend the candidate came from. In other
+ cases (except for `duplicates' and `sorted'), the first non-nil value among
+ all the backends is returned.
- The latter is the case for the `prefix' command. But if the group contains
- the keyword `:with', the back-ends after it are ignored for this command.
+ The group can also contain keywords. Currently, `:with' and `:separate'
+ keywords are defined. If the group contains keyword `:with', the backends
+ listed after this keyword are ignored for the purpose of the `prefix'
+ command. If the group contains keyword `:separate', the candidates that
+ come from different backends are sorted separately in the combined list.
- The completions from back-ends in a group are merged (but only from those
- that return the same `prefix').
-
- Asynchronous back-ends:
+ Asynchronous backends
+ =====================
The return value of each command can also be a cons (:async . FETCHER)
where FETCHER is a function of one argument, CALLBACK. When the data
arrives, FETCHER must call CALLBACK and pass it the appropriate return
- value, as described above.
+ value, as described above. That call must happen in the same buffer as
+ where completion was initiated.
True asynchronous operation is only supported for command `candidates', and
only during idle completion. Other commands will block the user interface,
- even if the back-end uses the asynchronous calling convention."
+ even if the backend uses the asynchronous calling convention."
:type `(repeat
(choice
- :tag "Back-end"
+ :tag "backend"
,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b)))
company-safe-backends)
(symbol :tag "User defined")
- (repeat :tag "Merged Back-ends"
- (choice :tag "Back-end"
+ (repeat :tag "Merged backends"
+ (choice :tag "backend"
,@(mapcar (lambda (b)
`(const :tag ,(cdr b) ,(car b)))
company-safe-backends)
:type '(choice
(const :tag "None" nil)
(const :tag "Sort by occurrence" (company-sort-by-occurrence))
- (const :tag "Sort by back-end importance"
+ (const :tag "Sort by backend importance"
(company-sort-by-backend-importance))
+ (const :tag "Prefer case sensitive prefix"
+ (company-sort-prefer-same-case-prefix))
(repeat :tag "User defined" (function))))
(defcustom company-completion-started-hook nil
The hook is called with the selected candidate as an argument.
If you indend to use it to post-process candidates from a specific
- back-end, consider using the `post-completion' command instead."
+ backend, consider using the `post-completion' command instead."
:type 'hook)
(defcustom company-minimum-prefix-length 3
"If enabled, disallow non-matching input.
This can be a function do determine if a match is required.
- This can be overridden by the back-end, if it returns t or `never' to
+ This can be overridden by the backend, if it returns t or `never' to
`require-match'. `company-auto-complete' also takes precedence over this."
:type '(choice (const :tag "Off" nil)
(function :tag "Predicate function")
(const :tag "immediate (0)" 0)
(number :tag "seconds")))
+ (defcustom company-tooltip-idle-delay .5
+ "The idle delay in seconds until tooltip is shown when using
+ `company-pseudo-tooltip-unless-just-one-frontend-with-delay'."
+ :type '(choice (const :tag "never (nil)" nil)
+ (const :tag "immediate (0)" 0)
+ (number :tag "seconds")))
+
(defcustom company-begin-commands '(self-insert-command
org-self-insert-command
orgtbl-self-insert-command
(error
(put backend 'company-init 'failed)
(unless (memq backend company--disabled-backends)
- (message "Company back-end '%s' could not be initialized:\n%s"
+ (message "Company backend '%s' could not be initialized:\n%s"
backend (error-message-string err)))
(cl-pushnew backend company--disabled-backends)
nil)))
:package-version '(company . "0.8.10"))
(defvar company-lighter '(" "
- (company-backend
+ (company-candidates
(:eval
(if (consp company-backend)
(company--group-lighter (nth company-selection
inactive, as well.
The completion data is retrieved using `company-backends' and displayed
- using `company-frontends'. If you want to start a specific back-end, call
+ using `company-frontends'. If you want to start a specific backend, call
it interactively or use `company-begin-backend'.
+ By default, the completions list is sorted alphabetically, unless the
+ backend chooses otherwise, or `company-transformers' changes it later.
+
regular keymap (`company-mode-map'):
\\{company-mode-map}
(let ((col (car (posn-col-row posn)))
;; `posn-col-row' doesn't work well with lines of different height.
;; `posn-actual-col-row' doesn't handle multiple-width characters.
- (row (cdr (posn-actual-col-row posn))))
+ (row (cdr (or (posn-actual-col-row posn)
+ ;; When position is non-visible for some reason.
+ (posn-col-row posn)))))
(when (and header-line-format (version< emacs-version "24.3.93.3"))
;; http://debbugs.gnu.org/18384
(cl-decf row))
(or (match-string-no-properties (or expression 0)) "")))
(defun company-grab-line (regexp &optional expression)
- (company-grab regexp expression (point-at-bol)))
+ "Return a match string for REGEXP if it matches text before point.
+ If EXPRESSION is non-nil, return the match string for the respective
+ parenthesized expression in REGEXP.
+ Matching is limited to the current line."
+ (let ((inhibit-field-text-motion t))
+ (company-grab regexp expression (point-at-bol))))
(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 "\\_>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "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 "\\>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "w")
(point)))
"")))
(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
(save-excursion
symbol)))))
(defun company-in-string-or-comment ()
+ "Return non-nil if point is within a string or comment."
(let ((ppss (syntax-ppss)))
(or (car (setq ppss (nthcdr 3 ppss)))
(car (setq ppss (cdr ppss)))
(lambda (result) (setq res result)))
(while (eq res 'trash)
(if (> (- (time-to-seconds) start) company-async-timeout)
- (error "Company: Back-end %s async timeout with args %s"
+ (error "Company: backend %s async timeout with args %s"
backend args)
(sleep-for company-async-wait)))
res))))
(if (functionp company-backend)
(apply company-backend args)
(apply #'company--multi-backend-adapter company-backend args))
- (error (error "Company: Back-end %s error \"%s\" with args %s"
+ (error (error "Company: backend %s error \"%s\" with args %s"
company-backend (error-message-string err) args))))
(defun company--multi-backend-adapter (backends command &rest args)
(let ((backends (cl-loop for b in backends
when (not (and (symbolp b)
(eq 'failed (get b 'company-init))))
- collect b)))
- (setq backends
- (if (eq command 'prefix)
- (butlast backends (length (member :with backends)))
- (delq :with backends)))
+ collect b))
+ (separate (memq :separate backends)))
+
+ (when (eq command 'prefix)
+ (setq backends (butlast backends (length (member :with backends)))))
+
+ (setq backends (cl-delete-if #'keywordp backends))
+
(pcase command
(`candidates
- (company--multi-backend-adapter-candidates backends (car args)))
- (`sorted nil)
- (`duplicates t)
+ (company--multi-backend-adapter-candidates backends (car args) separate))
+ (`sorted separate)
+ (`duplicates (not separate))
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(cl-dolist (backend backends)
(car backends))))
(apply backend command args))))))))
- (defun company--multi-backend-adapter-candidates (backends prefix)
- (let ((pairs (cl-loop for backend in (cdr backends)
+ (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))
prefix)
collect (cons (funcall backend 'candidates prefix)
- (let ((b backend))
- (lambda (candidates)
- (mapcar
- (lambda (str)
- (propertize str 'company-backend b))
- candidates)))))))
- (when (equal (company--prefix-str (funcall (car backends) 'prefix)) prefix)
- ;; Small perf optimization: don't tag the candidates received
- ;; from the first backend in the group.
- (push (cons (funcall (car backends) 'candidates prefix)
- 'identity)
- pairs))
+ (company--multi-candidates-mapper
+ backend
+ separate
+ ;; Small perf optimization: don't tag the
+ ;; candidates received from the first
+ ;; backend in the group.
+ (not (eq backend (car backends))))))))
(company--merge-async pairs (lambda (values) (apply #'append values)))))
+ (defun company--multi-candidates-mapper (backend separate tag)
+ (lambda (candidates)
+ (when separate
+ (let ((company-backend backend))
+ (setq candidates
+ (company--preprocess-candidates candidates))))
+ (when tag
+ (setq candidates
+ (mapcar
+ (lambda (str)
+ (propertize str 'company-backend backend))
+ candidates)))
+ candidates))
+
(defun company--merge-async (pairs merger)
(let ((async (cl-loop for pair in pairs
thereis
(defvar-local company-point nil)
(defvar company-timer nil)
+ (defvar company-tooltip-timer nil)
(defsubst company-strip-prefix (str)
(substring str (length company-prefix)))
(defun company--insert-candidate (candidate)
- (setq candidate (substring-no-properties candidate))
- ;; XXX: Return value we check here is subject to change.
- (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
- (insert (company-strip-prefix candidate))
- (unless (equal company-prefix candidate)
- (delete-region (- (point) (length company-prefix)) (point))
- (insert candidate))))
+ (when (> (length candidate) 0)
+ (setq candidate (substring-no-properties candidate))
+ ;; XXX: Return value we check here is subject to change.
+ (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+ (insert (company-strip-prefix candidate))
+ (unless (equal company-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
+ This is a tool for backends that need candidates inserted before they
can retrieve meta-data for them."
(declare (indent 1))
`(let ((inhibit-modification-hooks t)
(dolist (frontend company-frontends)
(condition-case-unless-debug err
(funcall frontend command)
- (error (error "Company: Front-end %s error \"%s\" on command %s"
+ (error (error "Company: frontend %s error \"%s\" on command %s"
frontend (error-message-string err) command)))))
(defun company-set-selection (selection &optional force-update)
(defun company--group-lighter (candidate base)
(let ((backend (or (get-text-property 0 'company-backend candidate)
- (car company-backend))))
+ (cl-some (lambda (x) (and (not (keywordp x)) x))
+ company-backend))))
(when (and backend (symbolp backend))
(let ((name (replace-regexp-in-string "company-\\|-company" ""
(symbol-name backend))))
t))))
(defun company--fetch-candidates (prefix)
- (let ((c (if company--manual-action
- (company-call-backend 'candidates prefix)
- (company-call-backend-raw 'candidates prefix)))
- res)
+ (let* ((non-essential (not (company-explicit-action-p)))
+ (c (if company--manual-action
+ (company-call-backend 'candidates prefix)
+ (company-call-backend-raw 'candidates prefix)))
+ res)
(if (not (eq (car c) :async))
c
(let ((buf (current-buffer))
company-candidates-cache
(list (cons prefix
(company--preprocess-candidates candidates))))
- (company-idle-begin buf win tick pt)))))
+ (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.
(progn (setq res 'done) nil)))))
(defun company--preprocess-candidates (candidates)
+ (cl-assert (cl-every #'stringp candidates))
(unless (company-call-backend 'sorted)
(setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates)
(defun company-sort-by-backend-importance (candidates)
"Sort CANDIDATES as two priority groups.
If `company-backend' is a function, do nothing. If it's a list, move
- candidates from back-ends before keyword `:with' to the front. Candidates
- from the rest of the back-ends in the group, if any, will be left at the end."
+ candidates from backends before keyword `:with' to the front. Candidates
+ from the rest of the backends in the group, if any, will be left at the end."
(if (functionp company-backend)
candidates
(let ((low-priority (cdr (memq :with company-backend))))
(let ((b1 (get-text-property 0 'company-backend c1)))
(or (not b1) (not (memq b1 low-priority)))))))))))
+ (defun company-sort-prefer-same-case-prefix (candidates)
+ "Prefer CANDIDATES with the exact same prefix.
+ If a backend returns case insensitive matches, candidates with the an exact
+ prefix match (same case) will be prioritized."
+ (cl-loop for candidate in candidates
+ if (string-prefix-p company-prefix candidate)
+ collect candidate into same-case
+ else collect candidate into other-case
+ finally return (append same-case other-case)))
+
(defun company-idle-begin (buf win tick pos)
(and (eq buf (current-buffer))
(eq win (selected-window))
(company-cancel))
(quit (company-cancel))))))
+ ;;;###autoload
(defun company-manual-begin ()
(interactive)
(company-assert-enabled)
(when (ignore-errors (company-begin-backend backend))
(cl-return t))))
(unless company-candidates
- (error "No other back-end")))
+ (error "No other backend")))
(defun company-require-match-p ()
(let ((backend-value (company-call-backend 'require-match)))
(setq company-prefix (company--prefix-str prefix)
company-backend backend
c (company-calculate-candidates company-prefix))
- ;; t means complete/unique. We don't start, so no hooks.
(if (not (consp c))
- (when company--manual-action
- (message "No completion found"))
+ (progn
+ (when company--manual-action
+ (message "No completion found"))
+ (when (eq c t)
+ ;; t means complete/unique.
+ ;; Run the hooks anyway, to e.g. clear the cache.
+ (company-cancel 'unique)))
(when company--manual-action
(setq company--manual-prefix prefix))
(company-update-candidates c)
(company-call-frontends 'update)))
(defun company-cancel (&optional result)
- (unwind-protect
- (when company-prefix
- (if (stringp result)
- (progn
- (company-call-backend 'pre-completion result)
- (run-hook-with-args 'company-completion-finished-hook result)
- (company-call-backend 'post-completion result))
- (run-hook-with-args 'company-completion-cancelled-hook result)))
+ (let ((prefix company-prefix)
+ (backend company-backend))
(setq company-backend nil
company-prefix nil
company-candidates nil
company-point nil)
(when company-timer
(cancel-timer company-timer))
+ (company-echo-cancel t)
(company-search-mode 0)
(company-call-frontends 'hide)
- (company-enable-overriding-keymap nil))
+ (company-enable-overriding-keymap nil)
+ (when prefix
+ ;; FIXME: RESULT can also be e.g. `unique'. We should call
+ ;; `company-completion-finished-hook' in that case, with right argument.
+ (if (stringp result)
+ (let ((company-backend backend))
+ (company-call-backend 'pre-completion result)
+ (run-hook-with-args 'company-completion-finished-hook result)
+ (company-call-backend 'post-completion result))
+ (run-hook-with-args 'company-completion-cancelled-hook result))))
;; Make return value explicit.
nil)
(and (symbolp command) (get command 'company-keep)))
(defun company-pre-command ()
+ (company--electric-restore-window-configuration)
(unless (company-keep this-command)
(condition-case-unless-debug err
(when company-candidates
(when company-timer
(cancel-timer company-timer)
(setq company-timer nil))
+ (company-echo-cancel t)
(company-uninstall-map))
(defun company-post-command ()
- (when (null this-command)
+ (when (and company-candidates
+ (null this-command))
;; Happens when the user presses `C-g' while inside
;; `flyspell-post-command-hook', for example.
;; Or any other `post-command-hook' function that can call `sit-for',
(if company-candidates
(company-call-frontends 'post-command)
(and (numberp company-idle-delay)
+ (not defining-kbd-macro)
(company--should-begin)
(setq company-timer
(run-with-timer company-idle-delay nil
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ (defcustom company-search-regexp-function #'regexp-quote
+ "Function to construct the search regexp from input.
+ It's called with one argument, the current search input. It must return
+ either a regexp without groups, or one where groups don't intersect and
+ each one wraps a part of the input string."
+ :type '(choice
+ (const :tag "Exact match" regexp-quote)
+ (const :tag "Words separated with spaces" company-search-words-regexp)
+ (const :tag "Words separated with spaces, in any order"
+ company-search-words-in-any-order-regexp)
+ (const :tag "All characters in given order, with anything in between"
+ company-search-flex-regexp)))
+
(defvar-local company-search-string "")
(defvar company-search-lighter '(" "
(defvar-local company--search-old-changed nil)
+ (defun company-search-words-regexp (input)
+ (mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t) ".*"))
+
+ (defun company-search-words-in-any-order-regexp (input)
+ (let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t)))
+ (permutations (company--permutations words)))
+ (mapconcat (lambda (words)
+ (mapconcat #'identity words ".*"))
+ permutations
+ "\\|")))
+
+ (defun company-search-flex-regexp (input)
+ (if (zerop (length input))
+ ""
+ (concat (regexp-quote (string (aref input 0)))
+ (mapconcat (lambda (c)
+ (concat "[^" (string c) "]*"
+ (regexp-quote (string c))))
+ (substring input 1) ""))))
+
+ (defun company--permutations (lst)
+ (if (not lst)
+ '(nil)
+ (cl-mapcan
+ (lambda (e)
+ (mapcar (lambda (perm) (cons e perm))
+ (company--permutations (cl-remove e lst :count 1))))
+ lst)))
+
(defun company--search (text lines)
- (let ((quoted (regexp-quote text))
+ (let ((re (funcall company-search-regexp-function text))
(i 0))
(cl-dolist (line lines)
- (when (string-match quoted line (length company-prefix))
+ (when (string-match-p re line (length company-prefix))
(cl-return i))
(cl-incf i))))
(company--search-update-predicate ss))
(company--search-update-string ss)))
- (defun company--search-update-predicate (&optional ss)
- (let* ((company-candidates-predicate
- (and (not (string= ss ""))
+ (defun company--search-update-predicate (ss)
+ (let* ((re (funcall company-search-regexp-function ss))
+ (company-candidates-predicate
+ (and (not (string= re ""))
company-search-filtering
- (lambda (candidate) (string-match ss candidate))))
+ (lambda (candidate) (string-match re candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
Regular characters are appended to the search string.
+ Customize `company-search-regexp-function' to change how the input
+ is interpreted when searching.
+
The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
uses the search string to filter the completion candidates."
(interactive)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun company-select-next ()
- "Select the next candidate in the list."
- (interactive)
- (when (company-manual-begin)
- (company-set-selection (1+ company-selection))))
+ (defun company-select-next (&optional arg)
+ "Select the next candidate in the list.
- (defun company-select-previous ()
- "Select the previous candidate in the list."
- (interactive)
+ With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
- (company-set-selection (1- company-selection))))
+ (company-set-selection (+ (or arg 1) company-selection))))
+
+ (defun company-select-previous (&optional arg)
+ "Select the previous candidate in the list.
+
+ With ARG, move by that many elements."
+ (interactive "p")
+ (company-select-next (if arg (- arg) -1)))
- (defun company-select-next-or-abort ()
+ (defun company-select-next-or-abort (&optional arg)
"Select the next candidate if more than one, else abort
- and invoke the normal binding."
- (interactive)
+ and invoke the normal binding.
+
+ With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-next)
+ (company-select-next arg)
(company-abort)
(company--unread-last-input)))
- (defun company-select-previous-or-abort ()
+ (defun company-select-previous-or-abort (&optional arg)
"Select the previous candidate if more than one, else abort
- and invoke the normal binding."
- (interactive)
+ and invoke the normal binding.
+
+ With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-previous)
+ (company-select-previous arg)
(company-abort)
(company--unread-last-input)))
(if (and (not (cdr company-candidates))
(equal company-common (car company-candidates)))
(company-complete-selection)
- (when company-common
- (company--insert-candidate company-common)))))
+ (company--insert-candidate company-common))))
- (defun company-complete-common-or-cycle ()
- "Insert the common part of all candidates, or select the next one."
- (interactive)
+ (defun company-complete-common-or-cycle (&optional arg)
+ "Insert the common part of all candidates, or select the next one.
+
+ With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
(let ((tick (buffer-chars-modified-tick)))
(call-interactively 'company-complete-common)
(when (eq tick (buffer-chars-modified-tick))
- (let ((company-selection-wrap-around t))
+ (let ((company-selection-wrap-around t)
+ (current-prefix-arg arg))
(call-interactively 'company-select-next))))))
+ (defun company-indent-or-complete-common ()
+ "Indent the current line or region, or complete the common part."
+ (interactive)
+ (cond
+ ((use-region-p)
+ (indent-region (region-beginning) (region-end)))
+ ((let ((old-point (point))
+ (old-tick (buffer-chars-modified-tick))
+ (tab-always-indent t))
+ (call-interactively #'indent-for-tab-command)
+ (when (and (eq old-point (point))
+ (eq old-tick (buffer-chars-modified-tick)))
+ (company-complete-common))))))
+
+ (defun company-select-next-if-tooltip-visible-or-complete-selection ()
+ "Insert selection if appropriate, or select the next candidate.
+ Insert selection if only preview is showing or only one candidate,
+ otherwise select the next candidate."
+ (interactive)
+ (if (and (company-tooltip-visible-p) (> company-candidates-length 1))
+ (call-interactively 'company-select-next)
+ (call-interactively 'company-complete-selection)))
+
+ ;;;###autoload
(defun company-complete ()
"Insert the common part of all candidates or the current selection.
The first time this is called, the common part is inserted, the second
(defun company-complete-number (n)
"Insert the Nth candidate visible in the tooltip.
- To show the number next to the candidates in some back-ends, enable
+ To show the number next to the candidates in some backends, enable
`company-show-numbers'. When called interactively, uses the last typed
character, stripping the modifiers. That character must be a digit."
(interactive
(insert string)))
(current-buffer)))
+ (defvar company--electric-saved-window-configuration nil)
+
(defvar company--electric-commands
- '(scroll-other-window scroll-other-window-down)
+ '(scroll-other-window scroll-other-window-down mwheel-scroll)
"List of Commands that won't break out of electric commands.")
+ (defun company--electric-restore-window-configuration ()
+ "Restore window configuration (after electric commands)."
+ (when (and company--electric-saved-window-configuration
+ (not (memq this-command company--electric-commands)))
+ (set-window-configuration company--electric-saved-window-configuration)
+ (setq company--electric-saved-window-configuration nil)))
+
(defmacro company--electric-do (&rest body)
(declare (indent 0) (debug t))
`(when (company-manual-begin)
- (save-window-excursion
- (let ((height (window-height))
- (row (company--row))
- cmd)
- ,@body
- (and (< (window-height) height)
- (< (- (window-height) row 2) company-tooltip-limit)
- (recenter (- (window-height) row 2)))
- (while (memq (setq cmd (key-binding (vector (list (read-event)))))
- company--electric-commands)
- (call-interactively cmd))
- (company--unread-last-input)))))
+ (cl-assert (null company--electric-saved-window-configuration))
+ (setq company--electric-saved-window-configuration (current-window-configuration))
+ (let ((height (window-height))
+ (row (company--row)))
+ ,@body
+ (and (< (window-height) height)
+ (< (- (window-height) row 2) company-tooltip-limit)
+ (recenter (- (window-height) row 2))))))
(defun company--unread-last-input ()
(when last-input-event
(defun company-show-doc-buffer ()
"Temporarily show the documentation buffer for the selection."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (doc-buffer (or (company-call-backend 'doc-buffer selected)
- (error "No documentation available"))))
- (with-current-buffer doc-buffer
- (goto-char (point-min)))
- (display-buffer doc-buffer t))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (doc-buffer (or (company-call-backend 'doc-buffer selected)
+ (error "No documentation available")))
+ start)
+ (when (consp doc-buffer)
+ (setq start (cdr doc-buffer)
+ doc-buffer (car doc-buffer)))
+ (setq other-window-scroll-buffer (get-buffer doc-buffer))
+ (let ((win (display-buffer doc-buffer t)))
+ (set-window-start win (if start start (point-min))))))))
(put 'company-show-doc-buffer 'company-keep t)
(defun company-show-location ()
"Temporarily display a buffer showing the selected candidate in context."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (location (company-call-backend 'location selected))
- (pos (or (cdr location) (error "No location available")))
- (buffer (or (and (bufferp (car location)) (car location))
- (find-file-noselect (car location) t))))
- (with-selected-window (display-buffer buffer t)
- (save-restriction
- (widen)
- (if (bufferp (car location))
- (goto-char pos)
- (goto-char (point-min))
- (forward-line (1- pos))))
- (set-window-start nil (point))))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (location (company-call-backend 'location selected))
+ (pos (or (cdr location) (error "No location available")))
+ (buffer (or (and (bufferp (car location)) (car location))
+ (find-file-noselect (car location) t))))
+ (setq other-window-scroll-buffer (get-buffer buffer))
+ (with-selected-window (display-buffer buffer t)
+ (save-restriction
+ (widen)
+ (if (bufferp (car location))
+ (goto-char pos)
+ (goto-char (point-min))
+ (forward-line (1- pos))))
+ (set-window-start nil (point)))))))
(put 'company-show-location 'company-keep t)
;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-begin-backend (backend &optional callback)
"Start a completion at point using BACKEND."
- (interactive (let ((val (completing-read "Company back-end: "
+ (interactive (let ((val (completing-read "Company backend: "
obarray
'functionp nil "company-")))
(when val
require-match)))
callback)))
+ (declare-function find-library-name "find-func")
+ (declare-function lm-version "lisp-mnt")
+
(defun company-version (&optional show-version)
"Get the Company version as string.
If SHOW-VERSION is non-nil, show the version in the echo area."
(interactive (list t))
(with-temp-buffer
+ (require 'find-func)
(insert-file-contents (find-library-name "company"))
(require 'lisp-mnt)
(if show-version
(message "Company version: %s" (lm-version))
(lm-version))))
+ (defun company-diag ()
+ "Pop a buffer with information about completions at point."
+ (interactive)
+ (let* ((bb company-backends)
+ backend
+ (prefix (cl-loop for b in bb
+ thereis (let ((company-backend b))
+ (setq backend b)
+ (company-call-backend 'prefix))))
+ cc annotations)
+ (when (stringp prefix)
+ (let ((company-backend backend))
+ (setq cc (company-call-backend 'candidates prefix)
+ annotations
+ (mapcar
+ (lambda (c) (cons c (company-call-backend 'annotation c)))
+ cc))))
+ (pop-to-buffer (get-buffer-create "*company-diag*"))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert (format "Emacs %s (%s) of %s on %s"
+ emacs-version system-configuration
+ (format-time-string "%Y-%m-%d" emacs-build-time)
+ emacs-build-system))
+ (insert "\nCompany " (company-version) "\n\n")
+ (insert "company-backends: " (pp-to-string bb))
+ (insert "\n")
+ (insert "Used backend: " (pp-to-string backend))
+ (insert "\n")
+ (insert "Prefix: " (pp-to-string prefix))
+ (insert "\n")
+ (insert (message "Completions:"))
+ (unless cc (insert " none"))
+ (save-excursion
+ (dolist (c annotations)
+ (insert "\n " (prin1-to-string (car c)))
+ (when (cdr c)
+ (insert " " (prin1-to-string (cdr c))))))
+ (special-mode)))
+
;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-pseudo-tooltip-overlay nil)
(if company-common
(string-width company-common)
0)))
+ (_ (setq value (company--pre-render value)
+ annotation (and annotation (company--pre-render annotation t))))
(ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width
(+ (length value) (length annotation)
(setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
- (add-text-properties 0 width '(face company-tooltip
- mouse-face company-tooltip-mouse)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common
- mouse-face company-tooltip-mouse)
- line)
+ (font-lock-append-text-property 0 width 'mouse-face
+ 'company-tooltip-mouse
+ line)
(when (< ann-start ann-end)
- (add-text-properties ann-start ann-end
- '(face company-tooltip-annotation
- mouse-face company-tooltip-mouse)
- line))
+ (font-lock-append-text-property ann-start ann-end 'face
+ (if selected
+ 'company-tooltip-annotation-selection
+ 'company-tooltip-annotation)
+ line))
+ (font-lock-prepend-text-property margin common 'face
+ (if selected
+ 'company-tooltip-common-selection
+ 'company-tooltip-common)
+ line)
(when selected
- (if (and (not (string= company-search-string ""))
- (string-match (regexp-quote company-search-string) value
- (length company-prefix)))
- (let ((beg (+ margin (match-beginning 0)))
- (end (+ margin (match-end 0)))
- (width (- width (length right))))
- (when (< beg width)
- (add-text-properties beg (min end width)
- '(face company-tooltip-search)
- line)))
- (add-text-properties 0 width '(face company-tooltip-selection
- mouse-face company-tooltip-selection)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common-selection
- mouse-face company-tooltip-selection)
- line)))
+ (if (let ((re (funcall company-search-regexp-function
+ company-search-string)))
+ (and (not (string= re ""))
+ (string-match re value (length company-prefix))))
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (let ((beg (+ margin mbeg))
+ (end (+ margin mend))
+ (width (- width (length right))))
+ (when (< beg width)
+ (font-lock-prepend-text-property beg (min end width)
+ 'face 'company-tooltip-search
+ line))))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip-selection
+ line)))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip
+ line)
line))
+ (defun company--search-chunks ()
+ (let ((md (match-data t))
+ res)
+ (if (<= (length md) 2)
+ (push (cons (nth 0 md) (nth 1 md)) res)
+ (while (setq md (nthcdr 2 md))
+ (when (car md)
+ (push (cons (car md) (cadr md)) res))))
+ res))
+
+ (defun company--pre-render (str &optional annotation-p)
+ (or (company-call-backend 'pre-render str annotation-p)
+ (progn
+ (when (or (text-property-not-all 0 (length str) 'face nil str)
+ (text-property-not-all 0 (length str) 'mouse-face nil str))
+ (setq str (copy-sequence str))
+ (remove-text-properties 0 (length str)
+ '(face nil font-lock-face nil mouse-face nil)
+ str))
+ str)))
+
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
(while (and (not (eobp)) ; http://debbugs.gnu.org/19553
(> (setq lines-moved (vertical-motion 1)) 0)
(<= (point) end))
- (let ((bound (min end (1- (point)))))
+ (let ((bound (min end (point))))
;; A visual line can contain several physical lines (e.g. with outline's
;; folding overlay). Take only the first one.
(push (buffer-substring beg
(or (cdr margins) 0)))))
(when (and word-wrap
(version< emacs-version "24.4.51.5"))
- ;; http://debbugs.gnu.org/18384
+ ;; http://debbugs.gnu.org/19300
(cl-decf ww))
+ ;; whitespace-mode with newline-mark
+ (when (and buffer-display-table
+ (aref buffer-display-table ?\n))
+ (cl-decf ww (1- (length (aref buffer-display-table ?\n)))))
ww))
(defun company--replacement-string (lines old column nl &optional align-top)
(company--offset-line (pop lines) offset))
new))
- (let ((str (concat (when nl " ")
- "\n"
+ (let ((str (concat (when nl " \n")
(mapconcat 'identity (nreverse new) "\n")
"\n")))
(font-lock-append-text-property 0 (length str) 'face 'default str)
(end (save-excursion
(move-to-window-line (+ row (abs height)))
(point)))
- (ov (make-overlay (if nl beg (1- beg)) end nil t))
+ (ov (make-overlay beg end nil t))
(args (list (mapcar 'company-plainify
(company-buffer-lines beg end))
column nl above)))
(defun company-pseudo-tooltip-hide-temporarily ()
(when (overlayp company-pseudo-tooltip-overlay)
(overlay-put company-pseudo-tooltip-overlay 'invisible nil)
- (overlay-put company-pseudo-tooltip-overlay 'after-string nil)))
+ (overlay-put company-pseudo-tooltip-overlay 'line-prefix nil)
+ (overlay-put company-pseudo-tooltip-overlay 'after-string nil)
+ (overlay-put company-pseudo-tooltip-overlay 'display nil)))
(defun company-pseudo-tooltip-unhide ()
(when company-pseudo-tooltip-overlay
(disp (overlay-get ov 'company-display)))
;; Beat outline's folding overlays, at least.
(overlay-put ov 'priority 1)
- ;; `display' could be better (http://debbugs.gnu.org/18285), but it
- ;; doesn't work when the overlay is empty, which is what happens at eob.
- ;; It also seems to interact badly with `cursor'.
- ;; We deal with priorities by having the overlay start before the newline.
- (overlay-put ov 'after-string disp)
- (overlay-put ov 'invisible t)
+ ;; No (extra) prefix for the first line.
+ (overlay-put ov 'line-prefix "")
+ ;; `display' is better
+ ;; (http://debbugs.gnu.org/18285, http://debbugs.gnu.org/20847),
+ ;; but it doesn't work on 0-length overlays.
+ (if (< (overlay-start ov) (overlay-end ov))
+ (overlay-put ov 'display disp)
+ (overlay-put ov 'after-string disp)
+ (overlay-put ov 'invisible t))
(overlay-put ov 'window (selected-window)))))
(defun company-pseudo-tooltip-guard ()
(when (>= overhang 0) overhang))))))
(defun company-pseudo-tooltip-frontend (command)
- "`company-mode' front-end similar to a tooltip but based on overlays."
+ "`company-mode' frontend similar to a tooltip but based on overlays."
(cl-case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
(company--show-inline-p))
(company-pseudo-tooltip-frontend command)))
+ (defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command)
+ "`compandy-pseudo-tooltip-frontend', but shown after a delay.
+ Delay is determined by `company-tooltip-idle-delay'."
+ (cl-case command
+ (pre-command
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (when company-tooltip-timer
+ (cancel-timer company-tooltip-timer)
+ (setq company-tooltip-timer nil)))
+ (post-command
+ (if (or company-tooltip-timer
+ (overlayp company-pseudo-tooltip-overlay))
+ (if (not (memq 'company-preview-frontend company-frontends))
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (company-preview-frontend 'pre-command)
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (company-preview-frontend 'post-command))
+ (setq company-tooltip-timer
+ (run-with-timer company-tooltip-idle-delay nil
+ 'company-pseudo-tooltip-unless-just-one-frontend-with-delay
+ 'post-command))))
+ (t
+ (company-pseudo-tooltip-unless-just-one-frontend command))))
+
;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-preview-overlay nil)
(company-preview-hide)
(let ((completion (nth company-selection company-candidates)))
- (setq completion (propertize completion 'face 'company-preview))
- (add-text-properties 0 (length company-common)
- '(face company-preview-common) completion)
+ (setq completion (copy-sequence (company--pre-render completion)))
+ (font-lock-append-text-property 0 (length completion)
+ 'face 'company-preview
+ completion)
+ (font-lock-prepend-text-property 0 (length company-common)
+ 'face 'company-preview-common
+ completion)
;; Add search string
- (and company-search-string
- (string-match (regexp-quote company-search-string) completion)
- (add-text-properties (match-beginning 0)
- (match-end 0)
- '(face company-preview-search)
- completion))
+ (and (string-match (funcall company-search-regexp-function
+ company-search-string)
+ completion)
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (font-lock-prepend-text-property mbeg mend
+ 'face 'company-preview-search
+ completion)))
(setq completion (company-strip-prefix completion))
(setq company-preview-overlay nil)))
(defun company-preview-frontend (command)
- "`company-mode' front-end showing the selection as if it had been inserted."
+ "`company-mode' frontend showing the selection as if it had been inserted."
(pcase command
(`pre-command (company-preview-hide))
(`post-command (company-preview-show-at-point (point)))
(or (eq (company-call-backend 'ignore-case) 'keep-prefix)
(string-prefix-p company-prefix company-common))))
+ (defun company-tooltip-visible-p ()
+ "Returns whether the tooltip is visible."
+ (when (overlayp company-pseudo-tooltip-overlay)
+ (not (overlay-get company-pseudo-tooltip-overlay 'invisible))))
+
;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-echo-last-msg nil)
(message ""))))
(defun company-echo-show-soon (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+
+ (defun company-echo-cancel (&optional unset)
(when company-echo-timer
(cancel-timer company-echo-timer))
- (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+ (when unset
+ (setq company-echo-timer nil)))
- (defsubst company-echo-show-when-idle (&optional getter)
- (when (sit-for company-echo-delay)
- (company-echo-show getter)))
+ (defun company-echo-show-when-idle (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer
+ (run-with-idle-timer company-echo-delay nil 'company-echo-show getter)))
(defun company-echo-format ()
(company-echo-show)))
(defun company-echo-frontend (command)
- "`company-mode' front-end showing the candidates in the echo area."
+ "`company-mode' frontend showing the candidates in the echo area."
(pcase command
(`post-command (company-echo-show-soon 'company-echo-format))
(`hide (company-echo-hide))))
(defun company-echo-strip-common-frontend (command)
- "`company-mode' front-end showing the candidates in the echo area."
+ "`company-mode' frontend showing the candidates in the echo area."
(pcase command
(`post-command (company-echo-show-soon 'company-echo-strip-common-format))
(`hide (company-echo-hide))))
(defun company-echo-metadata-frontend (command)
- "`company-mode' front-end showing the documentation in the echo area."
+ "`company-mode' frontend showing the documentation in the echo area."
(pcase command
(`post-command (company-echo-show-when-idle 'company-fetch-metadata))
(`hide (company-echo-hide))))
(should (null company-candidates))
(insert "a")
(sleep-for 0.1)
- (should (null company-candidates)))))
+ (should (null company-candidates))
+ (should (null company-candidates-cache))
+ (should (null company-backend)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
--- /dev/null
+ ;;; bbdb-tests.el --- company-mode tests -*- lexical-binding: t -*-
+
+ ;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+ ;; Author: Dmitry Gutov
+
+ ;; 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/>.
+
+ (require 'company-tests)
+ (require 'company-bbdb)
+
+ (provide 'bbdb-com)
+
+ (ert-deftest company-bbdb-prefix-looks-in-header-value ()
+ (with-temp-buffer
+ (insert "To: J")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "J"))))
+
+ (ert-deftest company-bbdb-prefix-includes-space ()
+ (with-temp-buffer
+ (insert "To: John Sm")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "John Sm"))))
+
+ (ert-deftest company-bbdb-prefix-begins-after-comma-or-semi ()
+ (with-temp-buffer
+ (insert "To: John Smythe <jsm@y.the>, Jess C")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "Jess C"))))
(require 'company-tests)
(require 'company-clang)
- (ert-deftest company-clang-objc-templatify ()
- (with-temp-buffer
- (let ((text "createBookWithTitle:andAuthor:"))
- (insert text)
- (company-clang-objc-templatify text)
- (should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
- (should (looking-at "arg0"))
- (should (null (overlay-get (company-template-field-at) 'display))))))
-
(ert-deftest company-clang-simple-annotation ()
(let ((str (propertize
"foo" 'meta
"shared_ptr<_Tp> make_shared<typename _Tp>(_Args &&__args...)")))
(should (equal (company-clang 'annotation str)
"<typename _Tp>(_Args &&__args...)"))))
+
+ (ert-deftest company-clang-func-ptr-annotation ()
+ (let ((str (propertize "foo" 'meta "void (*)(int) foo")))
+ (should (equal (company-clang 'annotation str) "(*)(int)"))))
+
+ (ert-deftest company-clang-null-annotation ()
+ (let ((str "char"))
+ (should (null (company-clang 'annotation str)))))
;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
- ;; Copyright (C) 2015 Free Software Foundation, Inc.
+ ;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
+ (ert-deftest company-multi-backend-handles-keyword-separate ()
+ (let ((one (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("aa" "ca" "ba")))))
+ (two (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("bb" "ab")))))
+ (tri (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (sorted t)
+ (candidates '("cc" "bc" "ac"))))))
+ (let ((company-backend (list one two tri :separate)))
+ (should (company-call-backend 'sorted))
+ (should-not (company-call-backend 'duplicates))
+ (should (equal '("aa" "ba" "ca" "ab" "bb" "cc" "bc" "ac")
+ (company-call-backend 'candidates "a"))))))
+
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
(and (ert-equal-including-properties (car list1) (car list2))
(ct-equal-including-properties (cdr list1) (cdr list2)))))
+ (ert-deftest company-strips-duplicates-returns-nil ()
+ (should (null (company--preprocess-candidates nil))))
+
(ert-deftest company-strips-duplicates-within-groups ()
(let* ((kvs '(("a" . "b")
("a" . nil)
;;; frontends-tests.el --- company-mode tests -*- lexical-binding: t -*-
- ;; Copyright (C) 2015 Free Software Foundation, Inc.
+ ;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
- (list (lambda (c &optional _)
+ (list (lambda (c &rest _)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
- (should (eq 1 (overlay-start company-pseudo-tooltip-overlay)))))))
+ (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
(ert-deftest company-pseudo-tooltip-show ()
:tags '(interactive)
(should (eq (overlay-get ov 'company-height) company-tooltip-limit))
(should (eq (overlay-get ov 'company-column) col))
(should (string= (overlay-get ov 'company-display)
- "\n 123 \nc 45 c\nddd\n")))))))
+ " 123 \nc 45 c\nddd\n")))))))
(ert-deftest company-pseudo-tooltip-edit-updates-width ()
:tags '(interactive)
(set-window-buffer nil (current-buffer))
(save-excursion (insert "\n"))
(let ((company-candidates-length 1)
- (company-candidates '("123")))
+ (company-candidates '("123"))
+ (company-backend #'ignore))
(company-preview-show-at-point (point))
(let* ((ov company-preview-overlay)
(str (overlay-get ov 'after-string)))
;; With margins.
(should (eq (overlay-get ov 'company-width) 8))
(should (string= (overlay-get ov 'company-display)
- "\n 123(4) \n 45 \n")))))))
+ " 123(4) \n 45 \n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
:tags '(interactive)
;; With margins.
(should (eq (overlay-get ov 'company-width) 13))
(should (string= (overlay-get ov 'company-display)
- "\n 123 (4) \n 45 \n 67 (891011) \n")))))))
+ " 123 (4) \n 45 \n 67 (891011) \n")))))))
(ert-deftest company-create-lines-shows-numbers ()
(let ((company-show-numbers t)
(company-candidates (mapcar #'car data))
(company-candidates-length 4)
(company-tooltip-margin 1)
- (company-backend (lambda (cmd &optional arg)
+ (company-backend (lambda (cmd &optional arg &rest _)
(when (eq cmd 'annotation)
(cdr (assoc arg data)))))
company-tooltip-align-annotations)
(should (equal (list (format " %s " (make-string (- ww 2) ?1))
(format " %s " (make-string (- ww 2) ?1)))
res))
- (should (eq 'company-tooltip-common-selection
- (get-text-property (- ww 2) 'face
- (car res))))
- (should (eq 'company-tooltip-selection
- (get-text-property (1- ww) 'face
- (car res))))
+ (should (equal '(company-tooltip-common-selection
+ company-tooltip-selection
+ company-tooltip)
+ (get-text-property (- ww 2) 'face
+ (car res))))
+ (should (equal '(company-tooltip-selection
+ company-tooltip)
+ (get-text-property (1- ww) 'face
+ (car res))))
)))
(ert-deftest company-create-lines-clears-out-non-printables ()
(alist '(("a" . " ︸") ("b" . " ︸︸")))
(company-candidates (mapcar #'car alist))
(company-candidates-length 2)
- (company-backend (lambda (c &optional a)
+ (company-backend (lambda (c &optional a &rest _)
(when (eq c 'annotation)
(assoc-default a alist)))))
(should (equal '(" a ︸ "
"MIRAI発売2カ月"))
(company-candidates-length 2)
(company-prefix "MIRAI発")
- (company-backend (lambda (c &optional _arg)
+ (company-backend (lambda (c &rest _)
(pcase c
(`ignore-case 'keep-prefix)))))
(should (equal '(" MIRAI発売1カ月 "
(let ((company-search-string "foo")
(company-backend #'ignore)
(company-prefix ""))
- (should (equal-including-properties
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 6 t nil nil)
#("barfoo"
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 6 (face company-tooltip-search mouse-face company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 6 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 5 t "" " ")
#("barfo "
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 5 (face company-tooltip-search mouse-face company-tooltip-mouse)
- 5 6 (face company-tooltip mouse-face company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 5 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse))
+ 5 6 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 3 t " " " ")
#(" bar "
- 0 5 (face company-tooltip mouse-face company-tooltip-mouse))))))
+ 0 5 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))))
+
+ (ert-deftest company-fill-propertize-overrides-face-property ()
+ (let ((company-backend #'ignore)
+ (company-prefix "")
+ (str1 (propertize "str1" 'face 'foo))
+ (str2 (propertize "str2" 'face 'foo)))
+ (should (ert-equal-including-properties
+ (company-fill-propertize str1 str2 8 nil nil nil)
+ #("str1str2"
+ 0 4 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 4 8 (face (company-tooltip-annotation company-tooltip)
+ mouse-face (company-tooltip-mouse)))))))
+
+ (ert-deftest company-fill-propertize-delegates-to-pre-render ()
+ (let ((company-backend
+ (lambda (command &rest args)
+ (pcase command
+ (`pre-render
+ (propertize (car args)
+ 'face (if (cadr args)
+ 'annotation
+ 'value))))))
+ (company-prefix "")
+ (str1 (propertize "str1" 'foo 'bar))
+ (str2 (propertize "str2" 'foo 'bar)))
+ (let ((res (company-fill-propertize str1 str2 8 nil nil nil)))
+ ;; Could use `ert-equal-including-properties' as well.
+ (should (eq (get-text-property 0 'foo res) 'bar))
+ (should (eq (get-text-property 4 'foo res) 'bar))
+ (should (equal (get-text-property 0 'face res)
+ '(value company-tooltip)))
+ (should (equal (get-text-property 4 'face res)
+ '(annotation company-tooltip-annotation company-tooltip))))))
(ert-deftest company-column-with-composition ()
:tags '(interactive)
(insert (propertize "a" 'display "bbb\nccc\ndddd\n"))
(insert "eee\nfff\nggg")
(should (equal (company-buffer-lines (point-min) (point-max))
- '("" "" "" "eee" "fff" "ggg")))))
+ '("a" "" "" "eee" "fff" "ggg")))))
(ert-deftest company-buffer-lines-with-multiline-after-string-at-eob ()
:tags '(interactive)
(should (equal (company-buffer-lines (point-min) (point-max))
'("a" "b" "c")))))
+ (ert-deftest company-buffer-lines-with-line-wrapping ()
+ :tags '(interactive)
+ (with-temp-buffer
+ (let ((ww (company--window-width)))
+ (insert (make-string (* 3 ww) ?a))
+ (should (equal (company-buffer-lines (point-min) (point-max))
+ (list (make-string ww ?a)
+ (make-string ww ?a)
+ (make-string ww ?a)))))))
+
(ert-deftest company-modify-line ()
(let ((str "-*-foobar"))
(should (equal-including-properties
(require 'company-tests)
(require 'company-template)
+ (defun company-template-field-assert-text (str &optional pos)
+ (let ((field (company-template-field-at pos)))
+ (should (equal (buffer-substring-no-properties
+ (overlay-start field)
+ (overlay-end field))
+ str))))
+
(ert-deftest company-template-removed-after-the-last-jump ()
(with-temp-buffer
(insert "{ }")
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(dotimes (_ 2)
- (insert " ")
- (company-template-add-field tpl (point) "foo")))
+ (insert " foo")
+ (company-template-add-field tpl (- (point) 3) (point))))
(company-call 'template-forward-field)
(should (= 3 (point)))
(company-call 'template-forward-field)
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
- (insert " ")
- (company-template-add-field tpl (point) "bar"))
+ (insert " bar")
+ (company-template-add-field tpl (- (point) 3) (point)))
(company-call 'template-move-to-first tpl)
(should (= 3 (point)))
(dolist (c (string-to-list "tee"))
(let ((text "foo(int a, short b)"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo(arg0, arg1)" (buffer-string)))
- (should (looking-at "arg0"))
- (should (equal "int a"
- (overlay-get (company-template-field-at) 'display))))))
+ (should (equal "foo(int a, short b)" (buffer-string)))
+ (company-template-field-assert-text "int a"))))
(ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
(with-temp-buffer
(let ((text "foo(int a, short b)!@ #1334 a"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo(arg0, arg1)" (buffer-string)))
- (should (looking-at "arg0")))))
+ (should (equal "foo(int a, short b)" (buffer-string)))
+ (company-template-field-assert-text "int a"))))
(ert-deftest company-template-c-like-templatify-generics ()
(with-temp-buffer
(let ((text "foo<TKey, TValue>(int i, Dict<TKey, TValue>, long l)"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo<arg0, arg1>(arg2, arg3, arg4)" (buffer-string)))
- (should (looking-at "arg0"))
- (should (equal "TKey" (overlay-get (company-template-field-at) 'display)))
- (search-forward "arg3")
+ (should (equal (buffer-string) text))
+ (company-template-field-assert-text "TKey")
+ (search-forward "Dict")
(forward-char -1)
- (should (equal "Dict<TKey, TValue>"
- (overlay-get (company-template-field-at) 'display))))))
+ (company-template-field-assert-text "Dict<TKey, TValue>"))))
+
+ (ert-deftest company-template-c-like-func-ptr ()
+ (with-temp-buffer
+ (let ((text "foo(*)(int)"))
+ (insert text)
+ (company-template-c-like-templatify text)
+ (should (equal (buffer-string) "foo(int)"))
+ (company-template-field-assert-text "int"))))
+
+ (ert-deftest company-clang-objc-templatify-empty-args ()
+ (with-temp-buffer
+ (let ((text "createBookWithTitle:andAuthor:"))
+ (insert text)
+ (company-template-objc-templatify text)
+ (should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
+ (should (looking-at "arg0"))
+ (should (null (overlay-get (company-template-field-at) 'display))))))
+
+ (ert-deftest company-template-objc-templatify ()
+ (with-temp-buffer
+ (let ((text "createBookWithTitle:(NSString) andAuthor:(id)"))
+ (insert text)
+ (company-template-objc-templatify text)
+ (should (equal (buffer-string) text))
+ (company-template-field-assert-text "(NSString)"))))