;;; Commentary:
;;
-;; Company is a modular completion mechanism. Modules for retrieving completion
+;; Company is a modular completion framework. Modules for retrieving completion
;; candidates are called backends, modules for displaying them are frontends.
;;
-;; Company comes with many backends, e.g. `company-elisp'. These are
+;; Company comes with many backends, e.g. `company-etags'. These are
;; distributed in separate files and can be used individually.
;;
-;; Place company.el and the backends you want to use in a directory and add the
-;; following to your .emacs:
-;; (add-to-list 'load-path "/path/to/company")
-;; (autoload 'company-mode "company" nil t)
-;;
-;; Enable company-mode with M-x company-mode. For further information look at
-;; the documentation for `company-mode' (C-h f company-mode RET)
+;; Enable `company-mode' in all buffers with M-x global-company-mode. For
+;; further information look at the documentation for `company-mode' (C-h f
+;; company-mode RET).
;;
;; If you want to start a specific backend, call it interactively or use
;; `company-begin-backend'. For example:
;; (`meta (format "This value is named %s" arg))))
;;
;; Sometimes it is a good idea to mix several backends together, for example to
-;; enrich gtags with dabbrev-code results (to emulate local variables).
-;; To do this, add a list with both backends as an element in company-backends.
+;; enrich gtags with dabbrev-code results (to emulate local variables). To do
+;; this, add a list with both backends as an element in `company-backends'.
;;
;;; Change Log:
;;
(require 'cl-lib)
(require 'newcomment)
+(require 'pcase)
;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
"Face used for the tooltip.")
(defface company-tooltip-selection
- '((default :inherit company-tooltip)
- (((class color) (min-colors 88) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "light blue"))
(((class color) (min-colors 88) (background dark))
(:background "orange1"))
"Face used for the tooltip item under the mouse.")
(defface company-tooltip-common
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "darkred")
(((background dark))
:foreground "red"))
"Face used for the common completion in the tooltip.")
(defface company-tooltip-common-selection
- '((default :inherit company-tooltip-selection)
- (((background light))
- :foreground "darkred")
- (((background dark))
- :foreground "red"))
+ '((default :inherit company-tooltip-common))
"Face used for the selected common completion in the tooltip.")
(defface company-tooltip-annotation
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "firebrick4")
(((background dark))
:foreground "red4"))
"Face used for the tooltip scrollbar thumb.")
(defface company-scrollbar-bg
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:background "wheat")
(((background dark))
:background "gold"))
(defface company-preview
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit (company-tooltip-selection company-tooltip))
(((background dark))
:background "blue4"
:foreground "wheat"))
(defface company-preview-common
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit company-tooltip-common-selection)
(((background dark))
:inherit company-preview
:foreground "red"))
feature must disable cache (return t to `no-cache') and might also want to
respond to `match'.
-Optional commands:
+Optional commands
+=================
`sorted': Return t here to indicate that the candidates are sorted and will
not need to be sorted again.
does not know about. It should also be callable interactively and use
`company-begin-backend' to start itself in that case.
-Grouped backends:
+Grouped backends
+================
-An element of `company-backends' can also itself be a list of backends,
-then it's considered to be a \"grouped\" backend.
+An element of `company-backends' can also be a list of backends. The
+completions from backends in such groups are merged, but only from those
+backends which return the same `prefix'.
-When possible, commands taking a candidate as an argument are dispatched to
-the backend it came from. In other cases, the first non-nil value among
+If a backend command takes a candidate as an argument (e.g. `meta'), the
+call is dispatched to the backend the candidate came from. In other
+cases (except for `duplicates' and `sorted'), the first non-nil value among
all the backends is returned.
-The latter is the case for the `prefix' command. But if the group contains
-the keyword `:with', the backends after it are ignored for this command.
+The group can also contain keywords. Currently, `:with' and `:sorted'
+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.
-The completions from backends in a group are merged (but only from those
-that return the same `prefix').
-
-Asynchronous backends:
+Asynchronous backends
+=====================
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
(or (match-string-no-properties (or expression 0)) "")))
(defun company-grab-line (regexp &optional expression)
+ "Return a match string for REGEXP if it matches text before point.
+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)))
(defun company-grab-symbol ()
+ "If point is at the end of a symbol, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
(if (looking-at "\\_>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
(point)))
"")))
(defun company-grab-word ()
+ "If point is at the end of a word, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
(if (looking-at "\\>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "w")
(point)))
"")))
(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
+matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(let ((symbol (company-grab-symbol)))
(when symbol
(save-excursion
symbol)))))
(defun company-in-string-or-comment ()
+ "Return non-nil if point is within a string or comment."
(let ((ppss (syntax-ppss)))
(or (car (setq ppss (nthcdr 3 ppss)))
(car (setq ppss (cdr ppss)))
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)))
+
+ (when (eq command 'prefix)
+ (setq backends (butlast backends (length (member :with backends)))))
+
+ (unless (memq command '(sorted))
+ (setq backends (cl-delete-if #'keywordp backends)))
+
(pcase command
(`candidates
(company--multi-backend-adapter-candidates backends (car args)))
- (`sorted nil)
+ (`sorted (memq :sorted backends))
(`duplicates t)
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(unless (company-call-backend 'sorted)
(setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates)
- (company--strip-duplicates candidates))
+ (setq candidates (company--strip-duplicates candidates)))
candidates)
(defun company--postprocess-candidates (candidates)
(company--transform-candidates candidates))
(defun company--strip-duplicates (candidates)
- (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)))))
+ (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)))
(defun company--transform-candidates (candidates)
(let ((c candidates))
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defcustom company-search-regexp-function #'regexp-quote
+ "Function to construct the search regexp from input.
+It's called with one argument, the current search input. It must return
+either a regexp without groups, or one where groups don't intersect and
+each one wraps a part of the input string."
+ :type '(choice
+ (const :tag "Exact match" regexp-quote)
+ (const :tag "Words separated with spaces" company-search-words-regexp)
+ (const :tag "Words separated with spaces, in any order"
+ company-search-words-in-any-order-regexp)))
+
(defvar-local company-search-string "")
(defvar company-search-lighter '(" "
(defvar-local company--search-old-changed nil)
+(defun company-search-words-regexp (input)
+ (mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t) ".*"))
+
+(defun company-search-words-in-any-order-regexp (input)
+ (let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t)))
+ (permutations (company--permutations words)))
+ (mapconcat (lambda (words)
+ (mapconcat #'identity words ".*"))
+ permutations
+ "\\|")))
+
+(defun company--permutations (lst)
+ (if (not lst)
+ '(nil)
+ (cl-mapcan
+ (lambda (e)
+ (mapcar (lambda (perm) (cons e perm))
+ (company--permutations (cl-remove e lst :count 1))))
+ lst)))
+
(defun company--search (text lines)
- (let ((quoted (regexp-quote text))
+ (let ((re (funcall company-search-regexp-function text))
(i 0))
(cl-dolist (line lines)
- (when (string-match quoted line (length company-prefix))
+ (when (string-match-p re line (length company-prefix))
(cl-return i))
(cl-incf i))))
(company--search-update-predicate ss))
(company--search-update-string ss)))
-(defun company--search-update-predicate (&optional ss)
- (let* ((company-candidates-predicate
- (and (not (string= ss ""))
+(defun company--search-update-predicate (ss)
+ (let* ((re (funcall company-search-regexp-function ss))
+ (company-candidates-predicate
+ (and (not (string= re ""))
company-search-filtering
- (lambda (candidate) (string-match ss candidate))))
+ (lambda (candidate) (string-match re candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
Regular characters are appended to the search string.
+Customize `company-search-regexp-function' to change how the input
+is interpreted when searching.
+
The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
uses the search string to filter the completion candidates."
(interactive)
require-match)))
callback)))
+(declare-function find-library-name "find-func")
+(declare-function lm-version "lisp-mnt")
+
(defun company-version (&optional show-version)
"Get the Company version as string.
(if company-common
(string-width company-common)
0)))
+ (_ (setq value (company--pre-render value)
+ annotation (and annotation (company--pre-render annotation t))))
(ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width
(+ (length value) (length annotation)
(setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
- (add-text-properties 0 width '(face company-tooltip
- mouse-face company-tooltip-mouse)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common
- mouse-face company-tooltip-mouse)
- line)
+ (font-lock-append-text-property 0 width '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))
+ (font-lock-append-text-property ann-start ann-end 'face
+ 'company-tooltip-annotation
+ line))
+ (font-lock-prepend-text-property margin common 'face
+ (if selected
+ 'company-tooltip-common-selection
+ 'company-tooltip-common)
+ line)
(when selected
- (if (and (not (string= company-search-string ""))
- (string-match (regexp-quote company-search-string) value
- (length company-prefix)))
- (let ((beg (+ margin (match-beginning 0)))
- (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)
- (add-text-properties margin common
- '(face company-tooltip-common-selection
- mouse-face company-tooltip-selection)
- line)))
+ (if (let ((re (funcall company-search-regexp-function
+ company-search-string)))
+ (and (not (string= re ""))
+ (string-match re value (length company-prefix))))
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (let ((beg (+ margin mbeg))
+ (end (+ margin mend))
+ (width (- width (length right))))
+ (when (< beg width)
+ (font-lock-prepend-text-property beg (min end width)
+ 'face 'company-tooltip-search
+ line))))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip-selection
+ line)))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip
+ line)
line))
+(defun company--search-chunks ()
+ (let ((md (match-data t))
+ res)
+ (if (<= (length md) 2)
+ (push (cons (nth 0 md) (nth 1 md)) res)
+ (while (setq md (nthcdr 2 md))
+ (when (car md)
+ (push (cons (car md) (cadr md)) res))))
+ res))
+
+(defun company--pre-render (str &optional annotation-p)
+ (or (company-call-backend 'pre-render str annotation-p)
+ (progn
+ (when (or (text-property-not-all 0 (length str) 'face nil str)
+ (text-property-not-all 0 (length str) 'mouse-face nil str))
+ (setq str (copy-sequence str))
+ (remove-text-properties 0 (length str)
+ '(face nil font-lock-face nil mouse-face nil)
+ str))
+ str)))
+
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
(company-preview-hide)
(let ((completion (nth company-selection company-candidates)))
- (setq completion (propertize completion 'face 'company-preview))
- (add-text-properties 0 (length company-common)
- '(face company-preview-common) completion)
+ (setq completion (copy-sequence (company--pre-render completion)))
+ (font-lock-append-text-property 0 (length completion)
+ 'face 'company-preview
+ completion)
+ (font-lock-prepend-text-property 0 (length company-common)
+ 'face 'company-preview-common
+ completion)
;; Add search string
- (and company-search-string
- (string-match (regexp-quote company-search-string) completion)
- (add-text-properties (match-beginning 0)
- (match-end 0)
- '(face company-preview-search)
- completion))
+ (and (string-match (funcall company-search-regexp-function
+ company-search-string)
+ completion)
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (font-lock-prepend-text-property mbeg mend
+ 'face 'company-preview-search
+ completion)))
(setq completion (company-strip-prefix completion))