-;;; company.el --- Modular in-buffer completion framework -*- lexical-binding: t -*-
+;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
-;; Version: 0.6.14
-;; Keywords: abbrev, convenience, matching
;; URL: http://company-mode.github.io/
-;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
+;; Version: 0.8.0-snapshot
+;; Keywords: abbrev, convenience, matching
+;; Package-Requires: ((emacs "24.1"))
;; This file is part of GNU Emacs.
;; Here is a simple example completing "foo":
;;
;; (defun company-my-backend (command &optional arg &rest ignored)
-;; (case command
-;; (prefix (when (looking-back "foo\\>")
+;; (pcase command
+;; (`prefix (when (looking-back "foo\\>")
;; (match-string 0)))
-;; (candidates (list "foobar" "foobaz" "foobarbaz"))
-;; (meta (format "This value is named %s" arg))))
+;; (`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).
;;; 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').
+
+Asynchronous back-ends:
+
+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.
+
+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."
: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 '(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',
+the cdr is the list of commands that abort completion. Otherwise, all
+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
"If enabled, show quick-access numbers for the first ten candidates."
:type '(choice (const :tag "off" nil)
"Work around a visualization bug when completing at the end of the buffer.
The work-around consists of adding a newline.")
+(defvar company-async-wait 0.03
+ "Pause between checks to see if the value's been set when turning an
+asynchronous call into synchronous.")
+
+(defvar company-async-timeout 2
+ "Maximum wait time for a value to be set during asynchronous call.")
+
;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-mode-map (make-sparse-keymap)
(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")
(unless (and (char-after) (eq (char-syntax (char-after)) ?w))
"")))
+(defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
+ (let ((symbol (company-grab-symbol)))
+ (when symbol
+ (save-excursion
+ (forward-char (- (length symbol)))
+ (if (looking-back idle-begin-after-re (if max-len
+ (- (point) max-len)
+ (line-beginning-position)))
+ (cons symbol t)
+ symbol)))))
+
(defun company-in-string-or-comment ()
(let ((ppss (syntax-ppss)))
(or (car (setq ppss (nthcdr 3 ppss)))
(car (setq ppss (cdr ppss)))
(nth 3 ppss))))
-(if (fboundp 'locate-dominating-file)
- (defalias 'company-locate-dominating-file 'locate-dominating-file)
- (defun company-locate-dominating-file (file name)
- (catch 'root
- (let ((dir (file-name-directory file))
- (prev-dir nil))
- (while (not (equal dir prev-dir))
- (when (file-exists-p (expand-file-name name dir))
- (throw 'root dir))
- (setq prev-dir dir
- 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)))
+ (company--force-sync #'company-call-backend-raw args company-backend))
+
+(defun company--force-sync (fun args backend)
+ (let ((value (apply fun args)))
+ (if (not (eq (car-safe value) :async))
+ value
+ (let ((res 'trash)
+ (start (time-to-seconds)))
+ (funcall (cdr value)
+ (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"
+ backend args)
+ (sleep-for company-async-wait)))
+ res))))
+
+(defun company-call-backend-raw (&rest 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)))
- (case command
- (candidates
- (loop for backend in backends
- when (equal (funcall backend 'prefix)
- (car args))
- append (apply backend 'candidates args)))
- (sorted nil)
- (duplicates t)
- (otherwise
+ (setq backends
+ (if (eq command 'prefix)
+ (butlast backends (length (member :with backends)))
+ (delq :with backends)))
+ (pcase command
+ (`candidates
+ (company--multi-backend-adapter-candidates backends (car args)))
+ (`sorted nil)
+ (`duplicates t)
+ ((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(dolist (backend backends)
- (when (setq value (apply backend command args))
- (return value))))))))
+ (when (setq value (company--force-sync
+ backend (cons command args) backend))
+ (return value)))))
+ (_
+ (let ((arg (car args)))
+ (when (> (length arg) 0)
+ (let ((backend (or (get-text-property 0 'company-backend arg)
+ (car backends))))
+ (apply backend command args))))))))
+
+(defun company--multi-backend-adapter-candidates (backends prefix)
+ (let ((pairs (loop for backend in (cdr backends)
+ when (equal (funcall backend 'prefix)
+ prefix)
+ collect (cons (funcall backend 'candidates prefix)
+ (lambda (candidates)
+ (mapcar
+ (lambda (str)
+ (propertize str 'company-backend
+ backend))
+ candidates))))))
+ (when (equal (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--merge-async pairs (lambda (values) (apply #'append values)))))
+
+(defun company--merge-async (pairs merger)
+ (let ((async (loop for pair in pairs
+ thereis
+ (eq :async (car-safe (car pair))))))
+ (if (not async)
+ (funcall merger (loop for (val . mapper) in pairs
+ collect (funcall mapper val)))
+ (cons
+ :async
+ (lambda (callback)
+ (let* (lst pending
+ (finisher (lambda ()
+ (unless pending
+ (funcall callback
+ (funcall merger
+ (nreverse lst)))))))
+ (dolist (pair pairs)
+ (let ((val (car pair))
+ (mapper (cdr pair)))
+ (if (not (eq :async (car-safe val)))
+ (push (funcall mapper val) lst)
+ (push nil lst)
+ (let ((cell lst)
+ (fetcher (cdr val)))
+ (push fetcher pending)
+ (funcall fetcher
+ (lambda (res)
+ (setq pending (delq fetcher pending))
+ (setcar cell (funcall mapper res))
+ (funcall finisher)))))))))))))
;;; 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)
(and (symbolp this-command) (get this-command 'company-begin)))
(not (and transient-mark-mode mark-active))))
+(defun company--should-continue ()
+ (or (eq t company-begin-commands)
+ (eq t company-continue-commands)
+ (if (eq 'not (car company-continue-commands))
+ (not (memq this-command (cdr company-continue-commands)))
+ (or (memq this-command company-begin-commands)
+ (memq this-command company-continue-commands)
+ (string-match-p "\\`company-" (symbol-name this-command))))))
+
(defun company-call-frontends (command)
(dolist (frontend company-frontends)
(condition-case err
;; `company-complete-common'.
(setq company-common
(if (cdr company-candidates)
- (company--safe-candidate
- (let ((common (try-completion company-prefix company-candidates)))
- (if (eq common t)
- ;; Mulple equal strings, probably with different
- ;; annotations.
- company-prefix
- common)))
+ (let ((common (try-completion company-prefix company-candidates)))
+ (if (eq common t)
+ ;; Mulple equal strings, probably with different
+ ;; annotations.
+ company-prefix
+ common))
(car company-candidates)))))
-(defun company--safe-candidate (str)
- ;; XXX: This feature is deprecated.
- (or (company-call-backend 'crop str)
- str))
-
(defun company-calculate-candidates (prefix)
(let ((candidates (cdr (assoc prefix company-candidates-cache)))
(ignore-case (company-call-backend 'ignore-case)))
(setq candidates (all-completions prefix prev))
(return t)))))
;; no cache match, call back-end
- (progn
- (setq candidates (company-call-backend 'candidates prefix))
- (when company-candidates-predicate
- (setq candidates
- (company-apply-predicate candidates
- company-candidates-predicate)))
- (unless (company-call-backend 'sorted)
- (setq candidates (sort candidates 'string<)))
- (when (company-call-backend 'duplicates)
- (company--strip-duplicates candidates))))
+ (setq candidates
+ (company--process-candidates
+ (company--fetch-candidates prefix))))
(setq candidates (company--transform-candidates candidates))
(when candidates
(if (or (cdr candidates)
;; Already completed and unique; don't start.
t))))
+(defun company--fetch-candidates (prefix)
+ (let ((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))
+ (win (selected-window))
+ (tick (buffer-chars-modified-tick))
+ (pt (point))
+ (backend company-backend))
+ (funcall
+ (cdr c)
+ (lambda (candidates)
+ (if (not (and candidates (eq res 'done)))
+ ;; Fetcher called us right back.
+ (setq res candidates)
+ (setq company-backend backend
+ company-candidates-cache
+ (list (cons prefix
+ (company--process-candidates
+ candidates))))
+ (company-idle-begin buf win tick pt)))))
+ ;; FIXME: Relying on the fact that the callers
+ ;; will interpret nil as "do nothing" is shaky.
+ ;; A throw-catch would be one possible improvement.
+ (or res
+ (progn (setq res 'done) nil)))))
+
+(defun company--process-candidates (candidates)
+ (when company-candidates-predicate
+ (setq candidates
+ (company-apply-predicate candidates
+ company-candidates-predicate)))
+ (unless (company-call-backend 'sorted)
+ (setq candidates (sort candidates 'string<)))
+ (when (company-call-backend 'duplicates)
+ (company--strip-duplicates candidates))
+ candidates)
+
(defun company--strip-duplicates (candidates)
(let ((c2 candidates))
(while c2
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-unless-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))
company-prefix)))
(defun company--continue-failed ()
- (when (company--incremental-p)
- (let ((input (buffer-substring-no-properties (point) company-point)))
- (cond
- ((company-auto-complete-p input)
- ;; auto-complete
- (save-excursion
- (goto-char company-point)
- (let ((company--auto-completion t))
- (company-complete-selection))
- nil))
- ((company-require-match-p)
- ;; wrong incremental input, but required match
- (delete-char (- (length input)))
- (ding)
- (message "Matching input is required")
- company-candidates)
- ((equal company-prefix (car company-candidates))
- ;; last input was actually success
- (company-cancel company-prefix)
- nil)))))
+ (let ((input (buffer-substring-no-properties (point) company-point)))
+ (cond
+ ((company-auto-complete-p input)
+ ;; auto-complete
+ (save-excursion
+ (goto-char company-point)
+ (let ((company--auto-completion t))
+ (company-complete-selection))
+ nil))
+ ((company-require-match-p)
+ ;; wrong incremental input, but required match
+ (delete-char (- (length input)))
+ (ding)
+ (message "Matching input is required")
+ company-candidates)
+ ((equal company-prefix (car company-candidates))
+ ;; last input was actually success
+ (company-cancel company-prefix))
+ (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))))
- (or (cond
- ((eq c t)
- ;; t means complete/unique.
- (company-cancel new-prefix)
- nil)
- ((consp c)
- ;; incremental match
- (setq company-prefix new-prefix)
- (company-update-candidates c)
- c)
- (t (company--continue-failed)))
- (company-cancel))))
+ (cond
+ ((eq c t)
+ ;; t means complete/unique.
+ (company-cancel new-prefix))
+ ((consp c)
+ ;; incremental match
+ (setq company-prefix new-prefix)
+ (company-update-candidates c)
+ c)
+ ((not (company--incremental-p))
+ (company-cancel))
+ (t (company--continue-failed)))))
(defun company--begin-new ()
(let (prefix c)
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)
(or (and company-candidates (company--continue))
(and (company--should-complete) (company--begin-new)))
(when company-candidates
- (when (and company-end-of-buffer-workaround (eobp))
- (save-excursion (insert "\n"))
- (setq company-added-newline (buffer-chars-modified-tick)))
+ (let ((modified (buffer-modified-p)))
+ (when (and company-end-of-buffer-workaround (eobp))
+ (save-excursion (insert "\n"))
+ (setq company-added-newline
+ (or modified (buffer-chars-modified-tick)))))
(setq company-point (point)
company--point-max (point-max))
(company-ensure-emulation-alist)
(let ((tick (buffer-chars-modified-tick)))
(delete-region (1- (point-max)) (point-max))
(equal tick company-added-newline))
- ;; Only set unmodified when tick remained the same since insert.
+ ;; Only set unmodified when tick remained the same since insert,
+ ;; and the buffer wasn't modified before.
(set-buffer-modified-p nil))
(when company-prefix
(if (stringp result)
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)
(cancel-timer company-timer))
(company-search-mode 0)
(company-call-frontends 'hide)
- (company-enable-overriding-keymap nil))
+ (company-enable-overriding-keymap nil)
+ ;; Make return value explicit.
+ nil)
(defun company-abort ()
(interactive)
(unless (company-keep this-command)
(condition-case err
(when company-candidates
- (company-call-frontends 'pre-command))
+ (company-call-frontends 'pre-command)
+ (unless (company--should-continue)
+ (company-abort)))
(error (message "Company: An error occurred in pre-command")
(message "%s" (error-message-string err))
(company-cancel))))
(and (numberp company-idle-delay)
(or (eq t company-begin-commands)
(memq this-command company-begin-commands))
+ (not (equal (point) company-point))
(setq company-timer
(run-with-timer company-idle-delay nil
'company-idle-begin
(interactive)
(when (company-manual-begin)
(let ((result (nth company-selection company-candidates)))
- (when company--auto-completion
- (setq result (company--safe-candidate result)))
(company-finish result))))
(defun company-complete-common ()
(defvar company-callback nil)
(make-variable-buffer-local 'company-callback)
-(defvar company-begin-with-marker nil)
-(make-variable-buffer-local 'company-begin-with-marker)
-
(defun company-remove-callback (&optional ignored)
(remove-hook 'company-completion-finished-hook company-callback t)
(remove-hook 'company-completion-cancelled-hook 'company-remove-callback t)
- (remove-hook 'company-completion-finished-hook 'company-remove-callback t)
- (when company-begin-with-marker
- (set-marker company-begin-with-marker nil)))
+ (remove-hook 'company-completion-finished-hook 'company-remove-callback t))
(defun company-begin-backend (backend &optional callback)
"Start a completion at point using BACKEND."
(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)
successfully completes the input.
Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
- ;; FIXME: When Emacs 23 is no longer a concern, replace
- ;; `company-begin-with-marker' with a lexical variable; use a lexical closure.
- (setq company-begin-with-marker (copy-marker (point) t))
- (company-begin-backend
- `(lambda (command &optional arg &rest ignored)
- (cond
- ((eq command 'prefix)
- (when (equal (point) (marker-position company-begin-with-marker))
- (buffer-substring ,(- (point) (or prefix-length 0)) (point))))
- ((eq command 'candidates)
- (all-completions arg ',candidates))
- ((eq command 'require-match)
- ,require-match)))
- callback))
+ (let ((begin-marker (copy-marker (point) t)))
+ (company-begin-backend
+ (lambda (command &optional arg &rest ignored)
+ (pcase command
+ (`prefix
+ (when (equal (point) (marker-position begin-marker))
+ (buffer-substring (- (point) (or prefix-length 0)) (point))))
+ (`candidates
+ (all-completions arg candidates))
+ (`require-match
+ 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
(defun company-preview-frontend (command)
"`company-mode' front-end showing the selection as if it had been inserted."
- (case command
- (pre-command (company-preview-hide))
- (post-command (company-preview-show-at-point (point)))
- (hide (company-preview-hide))))
+ (pcase command
+ (`pre-command (company-preview-hide))
+ (`post-command (company-preview-show-at-point (point)))
+ (`hide (company-preview-hide))))
(defun company-preview-if-just-one-frontend (command)
"`company-preview-frontend', but only shown for single candidates."
(defun company-echo-frontend (command)
"`company-mode' front-end showing the candidates in the echo area."
- (case command
- (post-command (company-echo-show-soon 'company-echo-format))
- (hide (company-echo-hide))))
+ (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."
- (case command
- (post-command (company-echo-show-soon 'company-echo-strip-common-format))
- (hide (company-echo-hide))))
+ (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."
- (case command
- (post-command (company-echo-show-when-idle 'company-fetch-metadata))
- (hide (company-echo-hide))))
+ (pcase command
+ (`post-command (company-echo-show-when-idle 'company-fetch-metadata))
+ (`hide (company-echo-hide))))
(provide 'company)
;;; company.el ends here