;;; 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>
;;; 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"))
(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-eclim company-semantic company-clang
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 instead of the actual prefix length in the comparison
-against `company-minimum-prefix-length'. 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.
`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:
-
-An element of `company-backends' can also itself be a list of back-ends,
-then it's considered to be a \"grouped\" back-end.
+Grouped backends
+================
-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.
+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'.
-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.
+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 completions from back-ends in a group are merged (but only from those
-that return the same `prefix').
+The group can also contain keywords. Currently, `:with' and `:sorted'
+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 `:sorted', the final list of
+candidates is not sorted after concatenation.
-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")
(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)))
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)
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)))
+
+ (when (eq command 'prefix)
+ (setq backends (butlast backends (length (member :with backends)))))
+
+ (unless (memq command '(sorted))
+ (setq backends (cl-delete-if #'keywordp backends)))
+
(pcase command
(`candidates
(company--multi-backend-adapter-candidates backends (car args)))
- (`sorted nil)
+ (`sorted (memq :sorted backends))
(`duplicates t)
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(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 same case sensitive prefix.
+If a backend returns case insensitive matches, candidates with the an exact
+prefix match will be prioritized even if this changes the lexical order."
+ (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-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
(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)
(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))))))
+
+;;;###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 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 (read-key-sequence-vector nil)))
- company--electric-commands)
- (condition-case err
- (call-interactively cmd)
- ((beginning-of-buffer end-of-buffer)
- (message (error-message-string err)))))
- (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
(company--electric-do
(let* ((selected (nth company-selection company-candidates))
(doc-buffer (or (company-call-backend 'doc-buffer selected)
- (error "No documentation available"))))
+ (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))
- (with-current-buffer doc-buffer
- (goto-char (point-min)))
- (display-buffer doc-buffer t)))))
+ (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 ()
(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 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-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)))
(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))))