;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
-;; Version: 0.6.7
+;; Version: 0.6.9
;; Keywords: abbrev, convenience, matching
-;; URL: http://company-mode.github.com/
+;; URL: http://company-mode.github.io/
;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
;; This file is part of GNU Emacs.
(eval-when-compile (require 'cl))
+;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
(add-to-list 'debug-ignored-errors "^Echo area cannot be used twice$")
(add-to-list 'debug-ignored-errors "^No \\(document\\|loc\\)ation available$")
(:background "cornsilk"))
(((class color) (min-colors 88) (background dark))
(:background "yellow")))
- "Face used for the tool tip.")
+ "Face used for the tooltip.")
(defface company-tooltip-selection
'((default :inherit company-tooltip)
(((class color) (min-colors 88) (background dark))
(:background "orange1"))
(t (:background "green")))
- "Face used for the selection in the tool tip.")
+ "Face used for the selection in the tooltip.")
(defface company-tooltip-mouse
'((default :inherit highlight))
- "Face used for the tool tip item under the mouse.")
+ "Face used for the tooltip item under the mouse.")
(defface company-tooltip-common
'((default :inherit company-tooltip)
:foreground "darkred")
(((background dark))
:foreground "red"))
- "Face used for the common completion in the tool tip.")
+ "Face used for the common completion in the tooltip.")
(defface company-tooltip-common-selection
'((default :inherit company-tooltip-selection)
:foreground "darkred")
(((background dark))
:foreground "red"))
- "Face used for the selected common completion in the tool tip.")
+ "Face used for the selected common completion in the tooltip.")
(defface company-preview
'((t :background "blue4"
Each front-end is a function that takes one argument. It is called with
one of the following arguments:
-'show: When the visualization should start.
+`show': When the visualization should start.
-'hide: When the visualization should end.
+`hide': When the visualization should end.
-'update: When the data has been updated.
+`update': When the data has been updated.
-'pre-command: Before every command that is executed while the
+`pre-command': Before every command that is executed while the
visualization is active.
-'post-command: After every command that is executed while the
+`post-command': After every command that is executed while the
visualization is active.
The visualized data is stored in `company-prefix', `company-candidates',
(function :tag "custom function" nil))))
(defcustom company-tooltip-limit 10
- "The maximum number of candidates in the tool tip"
+ "The maximum number of candidates in the tooltip"
:type 'integer)
(defcustom company-tooltip-minimum 6
- "The minimum height of the tool tip.
+ "The minimum height of the tooltip.
If this many lines are not available, prefer to display the tooltip above."
:type 'integer)
(defvar company-safe-backends
'((company-abbrev . "Abbrev")
- (company-clang . "clang")
+ (company-capf . "completion-at-point-functions")
+ (company-clang . "Clang")
(company-css . "CSS")
(company-dabbrev . "dabbrev for plain text")
(company-dabbrev-code . "dabbrev for code")
- (company-eclim . "eclim (an Eclipse interace)")
+ (company-eclim . "Eclim (an Eclipse interface)")
(company-elisp . "Emacs Lisp")
(company-etags . "etags")
(company-files . "Files")
(company-gtags . "GNU Global")
- (company-ispell . "ispell")
+ (company-ispell . "Ispell")
(company-keywords . "Programming language keywords")
(company-nxml . "nxml")
(company-oddmuse . "Oddmuse")
(company-pysmell . "PySmell")
(company-ropemacs . "ropemacs")
- (company-semantic . "CEDET Semantic")
+ (company-semantic . "Semantic")
(company-tempo . "Tempo templates")
(company-xcode . "Xcode")))
(put 'company-safe-backends 'risky-local-variable t)
(assq backend company-safe-backends))
(return t))))))
-(defun company-capf (command &optional arg &rest args)
- "`company-mode' back-end using `completion-at-point-functions'.
-Requires Emacs 24.1 or newer."
- (interactive (list 'interactive))
- (case command
- (interactive (company-begin-backend 'company-capf))
- (prefix
- (let ((res (run-hook-wrapped 'completion-at-point-functions
- ;; Ignore misbehaving functions.
- #'completion--capf-wrapper 'optimist)))
- (when (consp res)
- (if (> (nth 2 res) (point))
- 'stop
- (buffer-substring-no-properties (nth 1 res) (point))))))
- (candidates
- (let ((res (run-hook-wrapped 'completion-at-point-functions
- ;; Ignore misbehaving functions.
- #'completion--capf-wrapper 'optimist)))
- (when (consp res)
- (all-completions arg (nth 3 res)
- (plist-get (nthcdr 4 res) :predicate)))))))
-
(defcustom company-backends '(company-elisp company-nxml company-css
- company-clang company-semantic company-eclim
+ company-semantic company-clang company-eclim
company-xcode company-ropemacs
(company-gtags company-etags company-dabbrev-code
company-keywords)
The first argument is the command requested from the back-end. It is one
of the following:
-`prefix': The back-end should return the text to be completed. It must be
-text immediately before `point'. Returning nil passes 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\). If the returned value is only
-part of the prefix (e.g. the part after \"->\" in C), the back-end may return a
-cons of prefix and prefix length, which is then used in the
-`company-minimum-prefix-length' test.
+`prefix': The back-end should return the text to be completed. It must be text
+immediately before point. Returning nil passes 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's either number or t, in which 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.
"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
-'require-match. `company-auto-complete' also takes precedence over this."
+This can be overridden by the back-end, 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")
(const :tag "On, if user interaction took place"
'company-explicit-action-p)
(const :tag "On" t)))
-(defcustom company-auto-complete 'company-explicit-action-p
+(defcustom company-auto-complete nil
"Determines when to auto-complete.
If this is enabled, all characters from `company-auto-complete-chars' complete
the selected completion. This can also be a function."
'company-explicit-action-p)
(const :tag "On" t)))
-(defcustom company-auto-complete-chars '(?\ ?\( ?\) ?. ?\" ?$ ?\' ?< ?| ?!)
+(defcustom company-auto-complete-chars '(?\ ?\) ?.)
"Determines which characters trigger an automatic completion.
See `company-auto-complete'. If this is a string, each string character causes
completion. If it is a list of syntax description characters (see
(defun company-input-noop ()
(push 31415926 unread-command-events))
-;; Hack:
-;; posn-col-row is incorrect in older Emacsen when line-spacing is set
-(defun company--col-row (&optional pos)
- (let ((posn (posn-at-point pos)))
- (cons (car (posn-col-row posn)) (cdr (posn-actual-col-row posn)))))
-
-(defsubst company--column (&optional pos)
- (car (posn-col-row (posn-at-point pos))))
-
-(defsubst company--row (&optional pos)
- (cdr (posn-actual-col-row (posn-at-point pos))))
+(defun company--column (&optional pos)
+ (save-excursion
+ (when pos (goto-char pos))
+ (let ((pt (point)))
+ (save-restriction
+ (+ (save-excursion
+ (vertical-motion 0)
+ (narrow-to-region (point) pt)
+ (let ((prefix (get-text-property (point) 'line-prefix)))
+ (if prefix (length prefix) 0)))
+ (current-column))))))
+
+(defun company--row (&optional pos)
+ (save-excursion
+ (when pos (goto-char pos))
+ (count-screen-lines (window-start)
+ (progn (vertical-motion 0) (point)))))
;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar company-backend nil)
+(make-variable-buffer-local 'company-backend)
+
(defun company-grab (regexp &optional expression limit)
(when (looking-back regexp limit)
(or (match-string-no-properties (or expression 0)) "")))
;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar company-backend nil)
-(make-variable-buffer-local 'company-backend)
-
(defvar company-prefix nil)
(make-variable-buffer-local 'company-prefix)
(or company--explicit-action
company-selection-changed))
-(defsubst company-reformat (candidate)
+(defun company-reformat (candidate)
;; company-ispell needs this, because the results are always lower-case
;; It's mory efficient to fix it only when they are displayed.
(concat company-prefix (substring candidate (length company-prefix))))
(and (symbolp this-command) (get this-command 'company-begin)))
(not (and transient-mark-mode mark-active))))
-(defsubst company-call-frontends (command)
+(defun company-call-frontends (command)
(dolist (frontend company-frontends)
(condition-case err
(funcall frontend command)
(error (error "Company: Front-end %s error \"%s\" on command %s"
frontend (error-message-string err) command)))))
-(defsubst company-set-selection (selection &optional force-update)
+(defun company-set-selection (selection &optional force-update)
(setq selection (max 0 (min (1- company-candidates-length) selection)))
(when (or force-update (not (equal selection company-selection)))
(setq company-selection selection
(defun company-require-match-p ()
(let ((backend-value (company-call-backend 'require-match)))
(or (eq backend-value t)
- (and (if (functionp company-require-match)
+ (and (not (eq backend-value 'never))
+ (if (functionp company-require-match)
(funcall company-require-match)
- (eq company-require-match t))
- (not (eq backend-value 'never))))))
-
-(defun company-punctuation-p (input)
- "Return non-nil, if input starts with punctuation or parentheses."
- (memq (char-syntax (string-to-char input)) '(?. ?\( ?\))))
+ (eq company-require-match t))))))
(defun company-auto-complete-p (input)
"Return non-nil, if input starts with punctuation or parentheses."
((and (company--string-incremental-p company-prefix new-prefix)
(company-require-match-p))
;; wrong incremental input, but required match
- (backward-delete-char (length input))
+ (delete-char (- (length input)))
(ding)
(message "Matching input is required")
company-candidates)
(defun company--good-prefix-p (prefix)
(and (or (company-explicit-action-p)
(unless (eq prefix 'stop)
- (>= (or (cdr-safe prefix) (length prefix))
- company-minimum-prefix-length)))
+ (or (eq (cdr-safe prefix) t)
+ (>= (or (cdr-safe prefix) (length prefix))
+ company-minimum-prefix-length))))
(stringp (or (car-safe prefix) prefix))))
(defun company--continue ()
(kill-local-variable 'company-search-old-selection)
(company-enable-overriding-keymap company-active-map)))
-(defsubst company-search-assert-enabled ()
+(defun company-search-assert-enabled ()
(company-assert-enabled)
(unless company-search-mode
(company-uninstall-map)
(company-abort)
(company--unread-last-input)))
+(defvar company-pseudo-tooltip-overlay)
+
+(defvar company-tooltip-offset)
+
+(defun company--inside-tooltip-p (event-col-row row height)
+ (let* ((ovl company-pseudo-tooltip-overlay)
+ (column (overlay-get ovl 'company-column))
+ (width (overlay-get ovl 'company-width))
+ (evt-col (car event-col-row))
+ (evt-row (cdr event-col-row)))
+ (and (>= evt-col column)
+ (< evt-col (+ column width))
+ (if (> height 0)
+ (and (> evt-row row)
+ (<= evt-row (+ row height) ))
+ (and (< evt-row row)
+ (>= evt-row (+ row height)))))))
+
+(defun company--event-col-row (event)
+ (let* ((col-row (posn-actual-col-row (event-start event)))
+ (col (car col-row))
+ (row (cdr col-row)))
+ (incf col (window-hscroll))
+ (and header-line-format
+ (version< "24" emacs-version)
+ (decf row))
+ (cons col row)))
+
(defun company-select-mouse (event)
"Select the candidate picked by the mouse."
(interactive "e")
- (when (nth 4 (event-start event))
- (company-set-selection (- (cdr (posn-actual-col-row (event-start event)))
- (company--row)
- 1))
- t))
+ (let ((event-col-row (company--event-col-row event))
+ (ovl-row (company--row))
+ (ovl-height (and company-pseudo-tooltip-overlay
+ (min (overlay-get company-pseudo-tooltip-overlay
+ 'company-height)
+ company-candidates-length))))
+ (if (and ovl-height
+ (company--inside-tooltip-p event-col-row ovl-row ovl-height))
+ (progn
+ (company-set-selection (+ (cdr event-col-row)
+ (if (zerop company-tooltip-offset)
+ -1
+ (- company-tooltip-offset 2))
+ (- ovl-row)
+ (if (< ovl-height 0)
+ (- 1 ovl-height)
+ 0)))
+ t)
+ (company-abort)
+ (company--unread-last-input)
+ nil)))
(defun company-complete-mouse (event)
"Complete the candidate picked by the mouse."
(push (make-string (- company-space-strings-limit 1 i) ?\ ) lst))
(apply 'vector lst)))
-(defsubst company-space-string (len)
+(defun company-space-string (len)
(if (< len company-space-strings-limit)
(aref company-space-strings len)
(make-string len ?\ )))
-(defsubst company-safe-substring (str from &optional to)
+(defun company-safe-substring (str from &optional to)
(if (> from (string-width str))
""
(with-temp-buffer
(cons selected (company-call-backend 'meta selected))))
(cdr company-last-metadata)))
-(defun company-doc-buffer (&optional string)
+(defun company-doc-buffer (&optional _string)
(with-current-buffer (get-buffer-create "*Company meta-data*")
(erase-buffer)
(current-buffer)))
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)
(let (lines)
(while (and (= 1 (vertical-motion 1))
(<= (point) end))
- (push (buffer-substring beg (min end (1- (point)))) lines)
+ (let ((bound (min end (1- (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
+ (save-excursion
+ (goto-char beg)
+ (re-search-forward "$" bound 'move)
+ (point)))
+ lines))
(setq beg (point)))
(unless (eq beg end)
(push (buffer-substring beg end) lines))
(nreverse lines)))
-(defsubst company-modify-line (old new offset)
- (concat (company-safe-substring old 0 offset)
- new
- (company-safe-substring old (+ offset (length new)))))
+(defun company-modify-line (old new offset)
+ (let ((prefix (get-text-property 0 'line-prefix old)))
+ (when prefix ; Keep the original value unmodified, for no special reason.
+ (setq old (concat prefix old))
+ (remove-text-properties 0 (length old) '(line-prefix) old))
+ (concat (company-safe-substring old 0 offset)
+ new
+ (company-safe-substring old (+ offset (length new))))))
(defsubst company--length-limit (lst limit)
(if (nthcdr limit lst)
(defun company--replacement-string (lines old column nl &optional align-top)
- (let ((width (length (car lines))))
- (when (> width (- (window-width) column))
- (setq column (max 0 (- (window-width) width)))))
+ (let ((width (length (car lines)))
+ (remaining-cols (- (+ (window-width) (window-hscroll))
+ column)))
+ (when (> width remaining-cols)
+ (decf column (- width remaining-cols))))
(let (new)
(when align-top
;; untouched lines first
- (dotimes (i (- (length old) (length lines)))
+ (dotimes (_ (- (length old) (length lines)))
(push (pop old) new)))
;; length into old lines.
(while old
len (min limit len)
lines-copy lines)
- (dotimes (i len)
+ (dotimes (_ len)
(setq width (max (length (pop lines-copy)) width)))
(setq width (min width (window-width)))
;; show
(defsubst company--window-inner-height ()
- (let ((edges (window-inside-edges (selected-window))))
+ (let ((edges (window-inside-edges)))
(- (nth 3 edges) (nth 1 edges))))
-(defsubst company--pseudo-tooltip-height ()
+(defun company--pseudo-tooltip-height ()
"Calculate the appropriate tooltip height.
Returns a negative number if the tooltip should be displayed above point."
(let* ((lines (company--row))
(company-pseudo-tooltip-hide)
(save-excursion
- (move-to-column 0)
-
(let* ((height (company--pseudo-tooltip-height))
above)
(setq company-pseudo-tooltip-overlay ov)
(overlay-put ov 'company-replacement-args args)
- (overlay-put ov 'company-before
- (apply 'company--replacement-string
- (company--create-lines selection (abs height))
- args))
+
+ (let ((lines (company--create-lines selection (abs height))))
+ (overlay-put ov 'company-before
+ (apply 'company--replacement-string lines args))
+ (overlay-put ov 'company-width (string-width (car lines))))
(overlay-put ov 'company-column column)
(overlay-put ov 'company-height height)))))
(defun company-pseudo-tooltip-show-at-point (pos)
- (let ((col-row (company--col-row pos)))
- (when col-row
- (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
- company-selection))))
-
-(defun company-pseudo-tooltip-edit (lines selection)
- (let ((column (overlay-get company-pseudo-tooltip-overlay 'company-column))
- (height (overlay-get company-pseudo-tooltip-overlay 'company-height)))
+ (let ((row (company--row pos))
+ (col (company--column pos)))
+ (company-pseudo-tooltip-show (1+ row) col company-selection)))
+
+(defun company-pseudo-tooltip-edit (selection)
+ (let ((height (overlay-get company-pseudo-tooltip-overlay 'company-height)))
(overlay-put company-pseudo-tooltip-overlay 'company-before
(apply 'company--replacement-string
(company--create-lines selection (abs height))
(defun company-pseudo-tooltip-unhide ()
(when company-pseudo-tooltip-overlay
(overlay-put company-pseudo-tooltip-overlay 'invisible t)
+ ;; Beat outline's folding overlays, at least.
+ (overlay-put company-pseudo-tooltip-overlay 'priority 1)
+ ;; No (extra) prefix for the first line.
+ (overlay-put company-pseudo-tooltip-overlay 'line-prefix "")
(overlay-put company-pseudo-tooltip-overlay 'before-string
(overlay-get company-pseudo-tooltip-overlay 'company-before))
(overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
(point) (overlay-start company-pseudo-tooltip-overlay)))
(defun company-pseudo-tooltip-frontend (command)
- "`company-mode' front-end similar to a tool-tip but based on overlays."
+ "`company-mode' front-end similar to a tooltip but based on overlays."
(case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
(hide (company-pseudo-tooltip-hide)
(setq company-tooltip-offset 0))
(update (when (overlayp company-pseudo-tooltip-overlay)
- (company-pseudo-tooltip-edit company-candidates
- company-selection)))))
+ (company-pseudo-tooltip-edit company-selection)))))
(defun company-pseudo-tooltip-unless-just-one-frontend (command)
"`company-pseudo-tooltip-frontend', but not shown for single candidates."
(message "%s" company-echo-last-msg)
(message ""))))
-(defsubst company-echo-show-soon (&optional getter)
+(defun company-echo-show-soon (&optional getter)
(when company-echo-timer
(cancel-timer company-echo-timer))
(setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
(defsubst company-echo-show-when-idle (&optional getter)
- (when (sit-for .01)
- (company-echo-show getter)))
-
-(defsubst company-echo-show-when-not-busy (&optional getter)
- "Run `company-echo-show' with arg GETTER once Emacs isn't busy."
(when (sit-for company-echo-delay)
(company-echo-show getter)))