;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.9.0-cvs
+;; Version: 0.9.0
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
(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"))
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)
cases (except for `duplicates' and `sorted'), the first non-nil value among
all the backends is returned.
-The group can also contain keywords. Currently, `:with' and `:sorted'
+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 `:sorted', the final list of
-candidates is not sorted after concatenation.
+command. If the group contains keyword `:separate', the candidates that
+come from different backends are sorted separately in the combined list.
Asynchronous backends
=====================
(const :tag "Sort by occurrence" (company-sort-by-occurrence))
(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
(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
If EXPRESSION is non-nil, return the match string for the respective
parenthesized expression in REGEXP.
Matching is limited to the current line."
- (company-grab regexp expression (point-at-bol)))
+ (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.
(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 poit
+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
(let ((backends (cl-loop for b in backends
when (not (and (symbolp b)
(eq 'failed (get b 'company-init))))
- collect b)))
+ collect b))
+ (separate (memq :separate backends)))
(when (eq command 'prefix)
(setq backends (butlast backends (length (member :with backends)))))
- (unless (memq command '(sorted))
- (setq backends (cl-delete-if #'keywordp backends)))
+ (setq backends (cl-delete-if #'keywordp backends))
(pcase command
(`candidates
- (company--multi-backend-adapter-candidates backends (car args)))
- (`sorted (memq :sorted backends))
- (`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--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))
(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)
- (setq candidates (company--strip-duplicates candidates)))
+ (company--strip-duplicates candidates))
candidates)
(defun company--postprocess-candidates (candidates)
(company--transform-candidates candidates))
(defun company--strip-duplicates (candidates)
- (let* ((annos 'unk)
- (str (car candidates))
- (ref (cdr candidates))
- res str2 anno2)
- (while ref
- (setq str2 (pop ref))
- (if (not (equal str str2))
- (progn
- (push str res)
- (setq str str2)
- (setq annos 'unk))
- (setq anno2 (company-call-backend
- 'annotation str2))
- (cond
- ((null anno2)) ; Skip it.
- ((when (eq annos 'unk)
- (let ((ann1 (company-call-backend 'annotation str)))
- (if (null ann1)
- ;; No annotation on the earlier element, drop it.
- t
- (setq annos (list ann1))
- nil)))
- (setq annos (list anno2))
- (setq str str2))
- ((member anno2 annos)) ; Also skip.
- (t
- (push anno2 annos)
- (push str res) ; Maintain ordering.
- (setq str str2)))))
- (when str (push str res))
- (nreverse res)))
+ (let ((c2 candidates)
+ (annos 'unk))
+ (while c2
+ (setcdr c2
+ (let ((str (pop c2)))
+ (while (let ((str2 (car c2)))
+ (if (not (equal str str2))
+ (progn
+ (setq annos 'unk)
+ nil)
+ (when (eq annos 'unk)
+ (setq annos (list (company-call-backend
+ 'annotation str))))
+ (let ((anno2 (company-call-backend
+ 'annotation str2)))
+ (if (member anno2 annos)
+ t
+ (push anno2 annos)
+ nil))))
+ (pop c2))
+ c2)))))
(defun company--transform-candidates (candidates)
(let ((c candidates))
(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)
(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',
(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
(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)
(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)