;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.8.9-cvs
+;; Version: 0.9.0-cvs
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
(company-keywords . "Programming language keywords")
(company-nxml . "nxml")
(company-oddmuse . "Oddmuse")
- (company-pysmell . "PySmell")
- (company-ropemacs . "ropemacs")
(company-semantic . "Semantic")
(company-tempo . "Tempo templates")
(company-xcode . "Xcode")))
(assq backend company-safe-backends))
(cl-return t))))))
-(defcustom company-backends `(,@(unless (version< "24.3.50" emacs-version)
+(defcustom company-backends `(,@(unless (version< "24.3.51" emacs-version)
(list 'company-elisp))
company-bbdb
company-nxml company-css
company-eclim company-semantic company-clang
- company-xcode company-ropemacs company-cmake
+ company-xcode company-cmake
company-capf
(company-dabbrev-code company-gtags company-etags
company-keywords)
control to the next 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 must be either
-number or t, and in the latter case the test automatically succeeds.
+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.
`candidates': The second argument is the prefix to be completed. The
return value should be a list of candidates that match the prefix.
progresses, unless the back-end returns t for this command. The second
argument is the latest prefix.
+`ignore-case': Return t here if the backend returns case-insensitive
+matches. This value is used to determine the longest common prefix (as
+used in `company-complete-common'), and to filter completions when fetching
+them from cache.
+
`meta': The second argument is a completion candidate. Return a (short)
documentation string for it.
`doc-buffer': The second argument is a completion candidate. Return a
-buffer with documentation for it. Preferably use `company-doc-buffer',
+buffer with documentation for it. Preferably use `company-doc-buffer'. If
+not all buffer contents pertain to this candidate, return a cons of buffer
+and window start position.
-`location': The second argument is a completion candidate. Return the cons
+`location': The second argument is a completion candidate. Return a cons
of buffer and buffer location, or of file and line number where the
completion candidate was defined.
backends that provide non-prefix completion.
`require-match': If this returns t, the user is not allowed to enter
-anything not offered as a candidate. Use with care! The default value nil
-gives the user that choice with `company-require-match'. Return value
-`never' overrides that option the other way around.
+anything not offered as a candidate. Please don't use that value in normal
+backends. The default value nil gives the user that choice with
+`company-require-match'. Return value `never' overrides that option the
+other way around.
`init': Called once for each buffer. The back-end can check for external
programs and files and load any required libraries. Raising an error here
(unless (keywordp b)
(company-init-backend b))))))
-(defvar company-default-lighter " company")
+(defcustom company-lighter-base "company"
+ "Base string to use for the `company-mode' lighter."
+ :type 'string
+ :package-version '(company . "0.8.10"))
+
+(defvar company-lighter '(" "
+ (company-candidates
+ (:eval
+ (if (consp company-backend)
+ (company--group-lighter (nth company-selection
+ company-candidates)
+ company-lighter-base)
+ (symbol-name company-backend)))
+ company-lighter-base))
+ "Mode line lighter for Company.
-(defvar-local company-lighter company-default-lighter)
+The value of this variable is a mode line template as in
+`mode-line-format'.")
+
+(put 'company-lighter 'risky-local-variable t)
;;;###autoload
(define-minor-mode company-mode
using `company-frontends'. If you want to start a specific back-end, 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}
(cons
:async
(lambda (callback)
- (let* (lst pending
+ (let* (lst
+ (pending (mapcar #'car pairs))
(finisher (lambda ()
(unless pending
(funcall callback
(funcall merger
(nreverse lst)))))))
(dolist (pair pairs)
- (let ((val (car pair))
- (mapper (cdr pair)))
+ (push nil lst)
+ (let* ((cell lst)
+ (val (car pair))
+ (mapper (cdr pair))
+ (this-finisher (lambda (res)
+ (setq pending (delq val pending))
+ (setcar cell (funcall mapper res))
+ (funcall finisher))))
(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)))))))))))))
+ (funcall this-finisher val)
+ (let ((fetcher (cdr val)))
+ (funcall fetcher this-finisher)))))))))))
(defun company--prefix-str (prefix)
(or (car-safe prefix) prefix))
(substring str (length company-prefix)))
(defun company--insert-candidate (candidate)
- (setq candidate (substring-no-properties candidate))
- ;; XXX: Return value we check here is subject to change.
- (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
- (insert (company-strip-prefix candidate))
- (unless (equal company-prefix candidate)
- (delete-region (- (point) (length company-prefix)) (point))
- (insert candidate))))
+ (when (> (length candidate) 0)
+ (setq candidate (substring-no-properties candidate))
+ ;; XXX: Return value we check here is subject to change.
+ (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+ (insert (company-strip-prefix candidate))
+ (unless (equal company-prefix candidate)
+ (delete-region (- (point) (length company-prefix)) (point))
+ (insert candidate)))))
(defmacro company-with-candidate-inserted (candidate &rest body)
"Evaluate BODY with CANDIDATE temporarily inserted.
(mod selection company-candidates-length)
(max 0 (min (1- company-candidates-length) selection))))
(when (or force-update (not (equal selection company-selection)))
- (company--update-group-lighter (nth selection company-candidates))
(setq company-selection selection
company-selection-changed t)
(company-call-frontends 'update)))
-(defun company--update-group-lighter (candidate)
- (when (listp company-backend)
- (let ((backend (or (get-text-property 0 'company-backend candidate)
- (car company-backend))))
- (when (and backend (symbolp backend))
- (let ((name (replace-regexp-in-string "company-\\|-company" ""
- (symbol-name backend))))
- (setq company-lighter (format " company-<%s>" name)))))))
+(defun company--group-lighter (candidate base)
+ (let ((backend (or (get-text-property 0 'company-backend candidate)
+ (car company-backend))))
+ (when (and backend (symbolp backend))
+ (let ((name (replace-regexp-in-string "company-\\|-company" ""
+ (symbol-name backend))))
+ (format "%s-<%s>" base name)))))
(defun company-update-candidates (candidates)
(setq company-candidates-length (length candidates))
- (if (> company-selection 0)
+ (if company-selection-changed
;; Try to restore the selection
(let ((selected (nth company-selection company-candidates)))
(setq company-selection 0
company-candidates candidates)
(when selected
- (while (and candidates (string< (pop candidates) selected))
- (cl-incf company-selection))
- (unless candidates
- ;; Make sure selection isn't out of bounds.
- (setq company-selection (min (1- company-candidates-length)
- company-selection)))))
+ (catch 'found
+ (while candidates
+ (let ((candidate (pop candidates)))
+ (when (and (string= candidate selected)
+ (equal (company-call-backend 'annotation candidate)
+ (company-call-backend 'annotation selected)))
+ (throw 'found t)))
+ (cl-incf company-selection))
+ (setq company-selection 0
+ company-selection-changed nil))))
(setq company-selection 0
company-candidates candidates))
;; Calculate common.
(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))
- (if (symbolp backend)
- (setq company-lighter (concat " " (symbol-name backend)))
- (company--update-group-lighter (car c)))
(company-update-candidates c)
(run-hook-with-args 'company-completion-started-hook
(company-explicit-action-p))
company-selection-changed nil
company--manual-action nil
company--manual-prefix nil
- company-lighter company-default-lighter
company--point-max nil
company-point nil)
(when company-timer
(cancel-timer company-timer))
+ (company-echo-cancel t)
(company-search-mode 0)
(company-call-frontends 'hide)
(company-enable-overriding-keymap nil))
(when company-timer
(cancel-timer company-timer)
(setq company-timer nil))
+ (company-echo-cancel t)
(company-uninstall-map))
(defun company-post-command ()
(defvar-local company--search-old-selection 0)
+(defvar-local company--search-old-changed nil)
+
(defun company--search (text lines)
(let ((quoted (regexp-quote text))
(i 0))
(interactive)
(company--search-assert-enabled)
(company-search-mode 0)
- (company-set-selection company--search-old-selection t))
+ (company-set-selection company--search-old-selection t)
+ (setq company-selection-changed company--search-old-changed))
(defun company-search-other-char ()
(interactive)
(define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
(define-key keymap (kbd "M-n") 'company-select-next)
(define-key keymap (kbd "M-p") 'company-select-previous)
+ (define-key keymap (kbd "<down>") 'company-select-next-or-abort)
+ (define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
(define-key keymap "\e\e\e" 'company-search-other-char)
(define-key keymap [escape escape escape] 'company-search-other-char)
(define-key keymap (kbd "DEL") 'company-search-delete-char)
(define-key keymap "\C-s" 'company-search-repeat-forward)
(define-key keymap "\C-r" 'company-search-repeat-backward)
(define-key keymap "\C-o" 'company-search-toggle-filtering)
+ (dotimes (i 10)
+ (define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
keymap)
"Keymap used for incrementally searching the completion candidates.")
(if company-search-mode
(if (company-manual-begin)
(progn
- (setq company--search-old-selection company-selection)
+ (setq company--search-old-selection company-selection
+ company--search-old-changed company-selection-changed)
(company-call-frontends 'update)
(company-enable-overriding-keymap company-search-map))
(setq company-search-mode nil))
(kill-local-variable 'company-search-string)
(kill-local-variable 'company-search-filtering)
(kill-local-variable 'company--search-old-selection)
+ (kill-local-variable 'company--search-old-changed)
(when company-backend
(company--search-update-predicate "")
(company-call-frontends 'update))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun company-select-next ()
- "Select the next candidate in the list."
- (interactive)
- (when (company-manual-begin)
- (company-set-selection (1+ company-selection))))
+(defun company-select-next (&optional arg)
+ "Select the next candidate in the list.
-(defun company-select-previous ()
- "Select the previous candidate in the list."
- (interactive)
+With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
- (company-set-selection (1- company-selection))))
+ (company-set-selection (+ (or arg 1) company-selection))))
+
+(defun company-select-previous (&optional arg)
+ "Select the previous candidate in the list.
+
+With ARG, move by that many elements."
+ (interactive "p")
+ (company-select-next (if arg (- arg) -1)))
-(defun company-select-next-or-abort ()
+(defun company-select-next-or-abort (&optional arg)
"Select the next candidate if more than one, else abort
-and invoke the normal binding."
- (interactive)
+and invoke the normal binding.
+
+With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-next)
+ (company-select-next arg)
(company-abort)
(company--unread-last-input)))
-(defun company-select-previous-or-abort ()
+(defun company-select-previous-or-abort (&optional arg)
"Select the previous candidate if more than one, else abort
-and invoke the normal binding."
- (interactive)
+and invoke the normal binding.
+
+With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-previous)
+ (company-select-previous arg)
(company-abort)
(company--unread-last-input)))
(if (and (not (cdr company-candidates))
(equal company-common (car company-candidates)))
(company-complete-selection)
- (when company-common
- (company--insert-candidate company-common)))))
+ (company--insert-candidate company-common))))
-(defun company-complete-common-or-cycle ()
- "Insert the common part of all candidates, or select the next one."
- (interactive)
+(defun company-complete-common-or-cycle (&optional arg)
+ "Insert the common part of all candidates, or select the next one.
+
+With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
(let ((tick (buffer-chars-modified-tick)))
(call-interactively 'company-complete-common)
(when (eq tick (buffer-chars-modified-tick))
- (let ((company-selection-wrap-around t))
+ (let ((company-selection-wrap-around t)
+ (current-prefix-arg arg))
(call-interactively 'company-select-next))))))
(defun company-complete ()
(current-buffer)))
(defvar company--electric-commands
- '(scroll-other-window scroll-other-window-down)
+ '(scroll-other-window scroll-other-window-down mwheel-scroll)
"List of Commands that won't break out of electric commands.")
(defmacro company--electric-do (&rest body)
(and (< (window-height) height)
(< (- (window-height) row 2) company-tooltip-limit)
(recenter (- (window-height) row 2)))
- (while (memq (setq cmd (key-binding (vector (list (read-event)))))
+ (while (memq (setq cmd (key-binding (read-key-sequence-vector nil)))
company--electric-commands)
- (call-interactively cmd))
+ (condition-case err
+ (call-interactively cmd)
+ ((beginning-of-buffer end-of-buffer)
+ (message (error-message-string err)))))
(company--unread-last-input)))))
(defun company--unread-last-input ()
(defun company-show-doc-buffer ()
"Temporarily show the documentation buffer for the selection."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (doc-buffer (or (company-call-backend 'doc-buffer selected)
- (error "No documentation available"))))
- (with-current-buffer doc-buffer
- (goto-char (point-min)))
- (display-buffer doc-buffer t))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (doc-buffer (or (company-call-backend 'doc-buffer selected)
+ (error "No documentation available")))
+ start)
+ (when (consp doc-buffer)
+ (setq start (cdr doc-buffer)
+ doc-buffer (car doc-buffer)))
+ (setq other-window-scroll-buffer (get-buffer doc-buffer))
+ (let ((win (display-buffer doc-buffer t)))
+ (set-window-start win (if start start (point-min))))))))
(put 'company-show-doc-buffer 'company-keep t)
(defun company-show-location ()
"Temporarily display a buffer showing the selected candidate in context."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (location (company-call-backend 'location selected))
- (pos (or (cdr location) (error "No location available")))
- (buffer (or (and (bufferp (car location)) (car location))
- (find-file-noselect (car location) t))))
- (with-selected-window (display-buffer buffer t)
- (save-restriction
- (widen)
- (if (bufferp (car location))
- (goto-char pos)
- (goto-char (point-min))
- (forward-line (1- pos))))
- (set-window-start nil (point))))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (location (company-call-backend 'location selected))
+ (pos (or (cdr location) (error "No location available")))
+ (buffer (or (and (bufferp (car location)) (car location))
+ (find-file-noselect (car location) t))))
+ (setq other-window-scroll-buffer (get-buffer buffer))
+ (with-selected-window (display-buffer buffer t)
+ (save-restriction
+ (widen)
+ (if (bufferp (car location))
+ (goto-char pos)
+ (goto-char (point-min))
+ (forward-line (1- pos))))
+ (set-window-start nil (point)))))))
(put 'company-show-location 'company-keep t)
;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If SHOW-VERSION is non-nil, show the version in the echo area."
(interactive (list t))
(with-temp-buffer
+ (require 'find-func)
(insert-file-contents (find-library-name "company"))
(require 'lisp-mnt)
(if show-version
(message "Company version: %s" (lm-version))
(lm-version))))
+(defun company-diag ()
+ "Pop a buffer with information about completions at point."
+ (interactive)
+ (let* ((bb company-backends)
+ backend
+ (prefix (cl-loop for b in bb
+ thereis (let ((company-backend b))
+ (setq backend b)
+ (company-call-backend 'prefix))))
+ cc annotations)
+ (when (stringp prefix)
+ (let ((company-backend backend))
+ (setq cc (company-call-backend 'candidates prefix)
+ annotations
+ (mapcar
+ (lambda (c) (cons c (company-call-backend 'annotation c)))
+ cc))))
+ (pop-to-buffer (get-buffer-create "*company-diag*"))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert (format "Emacs %s (%s) of %s on %s"
+ emacs-version system-configuration
+ (format-time-string "%Y-%m-%d" emacs-build-time)
+ emacs-build-system))
+ (insert "\nCompany " (company-version) "\n\n")
+ (insert "company-backends: " (pp-to-string bb))
+ (insert "\n")
+ (insert "Used backend: " (pp-to-string backend))
+ (insert "\n")
+ (insert "Prefix: " (pp-to-string prefix))
+ (insert "\n")
+ (insert (message "Completions:"))
+ (unless cc (insert " none"))
+ (save-excursion
+ (dolist (c annotations)
+ (insert "\n " (prin1-to-string (car c)))
+ (when (cdr c)
+ (insert " " (prin1-to-string (cdr c))))))
+ (special-mode)))
+
;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-pseudo-tooltip-overlay nil)
(string-match (regexp-quote company-search-string) value
(length company-prefix)))
(let ((beg (+ margin (match-beginning 0)))
- (end (+ margin (match-end 0))))
- (add-text-properties beg end '(face company-tooltip-search)
- line))
+ (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)
(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 '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)
+ ;; `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 ()
(message ""))))
(defun company-echo-show-soon (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+
+(defun company-echo-cancel (&optional unset)
(when company-echo-timer
(cancel-timer company-echo-timer))
- (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+ (when unset
+ (setq company-echo-timer nil)))
-(defsubst company-echo-show-when-idle (&optional getter)
- (when (sit-for company-echo-delay)
- (company-echo-show getter)))
+(defun company-echo-show-when-idle (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer
+ (run-with-idle-timer company-echo-delay nil 'company-echo-show getter)))
(defun company-echo-format ()