;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
-;; Version: 0.6.14
+;; Version: 0.7.3
;; Keywords: abbrev, convenience, matching
;; URL: http://company-mode.github.io/
-;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
+;; Compatibility: GNU Emacs 23.x, GNU Emacs 24.x
;; This file is part of GNU Emacs.
;;; Code:
(eval-when-compile (require 'cl))
+(require 'newcomment)
;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
:type '(choice (const :tag "Scrollbar" scrollbar)
(const :tag "Two lines" lines)))
+(defcustom company-tooltip-align-annotations nil
+ "When non-nil, align annotations to the right tooltip border."
+ :type 'boolean)
+
(defvar company-safe-backends
'((company-abbrev . "Abbrev")
+ (company-bbdb . "BBDB")
(company-capf . "completion-at-point-functions")
(company-clang . "Clang")
(company-cmake . "CMake")
(defcustom company-backends `(,@(unless company--include-capf
(list 'company-elisp))
+ company-bbdb
company-nxml company-css
company-eclim company-semantic company-clang
company-xcode company-ropemacs company-cmake
,@(when company--include-capf
(list 'company-capf))
- (company-gtags company-etags company-dabbrev-code
+ (company-dabbrev-code company-gtags company-etags
company-keywords)
company-oddmuse company-files company-dabbrev)
"The list of active back-ends (completion engines).
-Each list elements can itself be a list of back-ends. In that case their
-completions are merged. Otherwise only the first matching back-end returns
-results.
`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.
back-end. 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's either number or t, in which
-case the test automatically succeeds.
+`company-minimum-prefix-length' test. It must be either number or 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 start with the prefix.
+return value should be a list of candidates that match the prefix.
+
+Non-prefix matches are also supported (candidates that don't start with the
+prefix, but match it in some backend-defined way). Backends that use this
+feature must disable cache (return t to `no-cache') and should also respond
+to `match'.
Optional commands:
of buffer and buffer location, or of file and line number where the
completion candidate was defined.
-`annotation': The second argument is a completion candidate. Returns a
+`annotation': The second argument is a completion candidate. Return a
string to be displayed inline with the candidate in the popup. If
duplicates are removed by company, candidates with equal string values will
be kept if they have different annotations. For that to work properly,
-backends should store the related information with candidates using text
+backends should store the related information on candidates using text
properties.
+`match': The second argument is a completion candidate. Backends that
+provide non-prefix completions should return the position of the end of
+text in the candidate that matches `prefix'. It will be used when
+rendering the popup.
+
`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
The back-end 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."
+`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.
+
+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.
+
+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 completions from back-ends in a group are merged (but only from those
+that return the same `prefix')."
:type `(repeat
(choice
:tag "Back-end"
,@(mapcar (lambda (b)
`(const :tag ,(cdr b) ,(car b)))
company-safe-backends)
+ (const :tag "With" :with)
(symbol :tag "User defined"))))))
(put 'company-backends 'safe-local-variable 'company-safe-backends-p)
"The minimum prefix length for idle completion."
:type '(integer :tag "prefix length"))
+(defcustom company-abort-manual-when-too-short nil
+ "If enabled, cancel a manually started completion when the prefix gets
+shorter than both `company-minimum-prefix-length' and the length of the
+prefix it was started from."
+ :type 'boolean)
+
(defcustom company-require-match 'company-explicit-action-p
"If enabled, disallow non-matching input.
This can be a function do determine if a match is required.
(const :tag "Self insert command" '(self-insert-command))
(repeat :tag "Commands" function)))
-(defcustom company-continue-commands t
+(defcustom company-continue-commands '(not save-buffer save-some-buffers
+ save-buffers-kill-terminal
+ save-buffers-kill-emacs)
"A list of commands that are allowed during completion.
If this is t, or if `company-begin-commands' is t, any command is allowed.
Otherwise, the value must be a list of symbols. If it starts with `not',
commands except those in that list, or in `company-begin-commands', or
commands in the `company-' namespace, abort completion."
:type '(choice (const :tag "Any command" t)
+ (cons :tag "Any except"
+ (const not)
+ (repeat :tag "Commands" function))
(repeat :tag "Commands" function)))
(defcustom company-show-numbers nil
(and (symbolp backend)
(not (fboundp backend))
(ignore-errors (require backend nil t)))
-
- (if (or (symbolp backend)
- (functionp backend))
- (condition-case err
- (progn
- (funcall backend 'init)
- (put backend 'company-init t))
- (error
- (put backend 'company-init 'failed)
- (unless (memq backend company--disabled-backends)
- (message "Company back-end '%s' could not be initialized:\n%s"
- backend (error-message-string err)))
- (pushnew backend company--disabled-backends)
- nil))
- (mapc 'company-init-backend backend)))
+ (cond
+ ((symbolp backend)
+ (condition-case err
+ (progn
+ (funcall backend 'init)
+ (put backend 'company-init t))
+ (error
+ (put backend 'company-init 'failed)
+ (unless (memq backend company--disabled-backends)
+ (message "Company back-end '%s' could not be initialized:\n%s"
+ backend (error-message-string err)))
+ (pushnew backend company--disabled-backends)
+ nil)))
+ ;; No initialization for lambdas.
+ ((functionp backend) t)
+ (t ;; Must be a list.
+ (dolist (b backend)
+ (unless (keywordp b)
+ (company-init-backend b))))))
(defvar company-default-lighter " company")
dir (file-name-directory (directory-file-name dir))))))))
(defun company-call-backend (&rest args)
- (if (functionp company-backend)
- (apply company-backend args)
- (apply 'company--multi-backend-adapter company-backend args)))
+ (condition-case err
+ (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"
+ company-backend (error-message-string err) args))))
(defun company--multi-backend-adapter (backends command &rest args)
(let ((backends (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)))
(case command
(candidates
- (loop for backend in backends
- when (equal (funcall backend 'prefix)
- (car args))
- append (apply backend 'candidates args)))
+ ;; Small perf optimization: don't tag the candidates received
+ ;; from the first backend in the group.
+ (append (apply (car backends) 'candidates args)
+ (loop for backend in (cdr backends)
+ when (equal (funcall backend 'prefix)
+ (car args))
+ append (mapcar
+ (lambda (str)
+ (propertize str 'company-backend backend))
+ (apply backend 'candidates args)))))
(sorted nil)
(duplicates t)
- (otherwise
+ ((prefix ignore-case no-cache require-match)
(let (value)
(dolist (backend backends)
(when (setq value (apply backend command args))
- (return value))))))))
+ (return value)))))
+ (otherwise
+ (let ((arg (car args)))
+ (when (> (length arg) 0)
+ (let ((backend (or (get-text-property 0 'company-backend arg)
+ (car backends))))
+ (apply backend command args))))))))
;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-selection-changed nil)
(make-variable-buffer-local 'company-selection-changed)
-(defvar company--explicit-action nil
- "Non-nil, if explicit completion took place.")
-(make-variable-buffer-local 'company--explicit-action)
+(defvar company--manual-action nil
+ "Non-nil, if manual completion took place.")
+(make-variable-buffer-local 'company--manual-action)
+
+(defvar company--manual-prefix nil)
+(make-variable-buffer-local 'company--manual-prefix)
(defvar company--auto-completion nil
"Non-nil when current candidate is being inserted automatically.
(defun company-explicit-action-p ()
"Return whether explicit completion action was taken by the user."
- (or company--explicit-action
+ (or company--manual-action
company-selection-changed))
(defun company-reformat (candidate)
t))))
candidates)))
(nconc
- (mapcar #'car (sort occurs (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
+ (mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
noccurs)))
(defun company-idle-begin (buf win tick pos)
- (and company-mode
- (eq buf (current-buffer))
+ (and (eq buf (current-buffer))
(eq win (selected-window))
(eq tick (buffer-chars-modified-tick))
(eq pos (point))
- (not company-candidates)
(not (equal (point) company-point))
- (let ((company-idle-delay t)
- (company-begin-commands t))
- (company-begin)
- (when company-candidates
- (when (version< emacs-version "24.3.50")
- (company-input-noop))
- (company-post-command)))))
+ (when (company-auto-begin)
+ (when (version< emacs-version "24.3.50")
+ (company-input-noop))
+ (company-post-command))))
(defun company-auto-begin ()
- (company-assert-enabled)
(and company-mode
(not company-candidates)
(let ((company-idle-delay t)
- (company-minimum-prefix-length 0)
(company-begin-commands t))
- (company-begin)))
+ (condition-case-no-debug err
+ (company-begin)
+ (error (message "Company: An error occurred in auto-begin")
+ (message "%s" (error-message-string err))
+ (company-cancel))
+ (quit (company-cancel)))))
+ (unless company-candidates
+ (setq company-backend nil))
;; Return non-nil if active.
company-candidates)
(defun company-manual-begin ()
(interactive)
- (setq company--explicit-action t)
+ (company-assert-enabled)
+ (setq company--manual-action t)
(unwind-protect
- (company-auto-begin)
+ (let ((company-minimum-prefix-length 0))
+ (company-auto-begin))
(unless company-candidates
- (setq company--explicit-action nil))))
+ (setq company--manual-action nil))))
(defun company-other-backend (&optional backward)
(interactive (list current-prefix-arg))
(t (company-cancel)))))
(defun company--good-prefix-p (prefix)
- (and (or (company-explicit-action-p)
- (unless (eq prefix 'stop)
- (or (eq (cdr-safe prefix) t)
- (>= (or (cdr-safe prefix) (length prefix))
- company-minimum-prefix-length))))
- (stringp (or (car-safe prefix) prefix))))
+ (and (stringp (or (car-safe prefix) prefix)) ;excludes 'stop
+ (or (eq (cdr-safe prefix) t)
+ (let ((len (or (cdr-safe prefix) (length prefix))))
+ (if company--manual-prefix
+ (or (not company-abort-manual-when-too-short)
+ ;; Must not be less than minimum or initial length.
+ (>= len (min company-minimum-prefix-length
+ (length company--manual-prefix))))
+ (>= len company-minimum-prefix-length))))))
(defun company--continue ()
(when (company-call-backend 'no-cache company-prefix)
(setq new-prefix (or (car-safe new-prefix) new-prefix))
(= (- (point) (length new-prefix))
(- company-point (length company-prefix))))
- (setq new-prefix (or (car-safe new-prefix) new-prefix))
(company-calculate-candidates new-prefix))))
(cond
((eq c t)
c (company-calculate-candidates prefix))
;; t means complete/unique. We don't start, so no hooks.
(if (not (consp c))
- (when company--explicit-action
+ (when company--manual-action
(message "No completion found"))
(setq company-prefix prefix)
+ (when company--manual-action
+ (setq company--manual-prefix prefix))
(when (symbolp backend)
(setq company-lighter (concat " " (symbol-name backend))))
(company-update-candidates c)
company-common nil
company-selection 0
company-selection-changed nil
- company--explicit-action nil
+ company--manual-action nil
+ company--manual-prefix nil
company-lighter company-default-lighter
company--point-max nil
company-point nil)
(setq company-backend backend)
;; Return non-nil if active.
(or (company-manual-begin)
- (progn
- (setq company-backend nil)
- (error "Cannot complete at point"))))
+ (error "Cannot complete at point")))
(defun company-begin-with (candidates
&optional prefix-length require-match callback)
,require-match)))
callback))
+(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
+ (insert-file-contents (find-library-name "company"))
+ (require 'lisp-mnt)
+ (if show-version
+ (message "Company version: %s" (lm-version))
+ (lm-version))))
+
;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-pseudo-tooltip-overlay nil)
(defun company-fill-propertize (value annotation width selected left right)
(let* ((margin (length left))
- (common (+ (or (company-call-backend 'common-part value)
+ (common (+ (or (company-call-backend 'match value)
(length company-common)) margin))
- (ann-start (+ margin (length value)))
+ (ann-ralign company-tooltip-align-annotations)
+ (ann-truncate (< width
+ (+ (length value) (length annotation)
+ (if ann-ralign 1 0))))
+ (ann-start (+ margin
+ (if ann-ralign
+ (if ann-truncate
+ (1+ (length value))
+ (- width (length annotation)))
+ (length value))))
+ (ann-end (min (+ ann-start (length annotation)) (+ margin width)))
(line (concat left
- (company-safe-substring (concat value annotation)
- 0 width)
+ (if (or ann-truncate (not ann-ralign))
+ (company-safe-substring
+ (concat value
+ (when (and annotation ann-ralign) " ")
+ annotation)
+ 0 width)
+ (concat
+ (company-safe-substring value 0
+ (- width (length annotation)))
+ annotation))
right)))
(setq width (+ width margin (length right)))
'(face company-tooltip-common
mouse-face company-tooltip-mouse)
line)
- (add-text-properties ann-start (+ ann-start (length annotation))
- '(face company-tooltip-annotation
- 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))
(when selected
(if (and company-search-string
(string-match (regexp-quote company-search-string) value
scrollbar-bounds)
;; Maybe clear old offset.
- (when (<= len (+ company-tooltip-offset limit))
+ (when (< len (+ company-tooltip-offset limit))
(setq company-tooltip-offset 0))
;; Scroll to offset.
(dotimes (_ len)
(let* ((value (pop lines-copy))
(annotation (company-call-backend 'annotation value)))
+ (when (and annotation company-tooltip-align-annotations)
+ ;; `lisp-completion-at-point' adds a space.
+ (setq annotation (comment-string-strip annotation t nil)))
(push (cons value annotation) items)
- (setq width (max (+ (length value) (length annotation)) width))))
+ (setq width (max (+ (length value)
+ (if (and annotation company-tooltip-align-annotations)
+ (1+ (length annotation))
+ (length annotation)))
+ width))))
(setq width (min window-width
(if (and company-show-numbers