X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/433ae926feed34b90251e94ad5df7fb26a786e5a..c845c43aaa6cfc42e8b4a8eeaa370aa85caf02f2:/company.el diff --git a/company.el b/company.el index 96bfbf06a..498920afb 100644 --- a/company.el +++ b/company.el @@ -26,19 +26,15 @@ ;;; 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: @@ -55,8 +51,8 @@ ;; (`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: ;; @@ -66,6 +62,7 @@ (require 'cl-lib) (require 'newcomment) +(require 'pcase) ;; FIXME: Use `user-error'. (add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$") @@ -427,7 +424,7 @@ 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 group can also contain keywords. Currently, `:with' and `:sorted' +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 @@ -833,9 +830,15 @@ means that `company-mode' is always turned on except in `message-mode' buffers." (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))) @@ -843,6 +846,8 @@ means that `company-mode' is always turned on except in `message-mode' buffers." ""))) (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))) @@ -850,6 +855,9 @@ means that `company-mode' is always turned on except in `message-mode' buffers." ""))) (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 @@ -861,6 +869,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers." 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))) @@ -1190,7 +1199,7 @@ can retrieve meta-data for them." (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) @@ -1201,27 +1210,37 @@ can retrieve meta-data for them." (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)) @@ -1612,6 +1631,17 @@ from the rest of the backends in the group, if any, will be left at the end." ;;; 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 '(" " @@ -1627,11 +1657,33 @@ from the rest of the backends in the group, if any, will be left at the end." (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)))) @@ -1649,11 +1701,12 @@ from the rest of the backends in the group, if any, will be left at the end." (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))) @@ -1808,6 +1861,9 @@ Don't start this directly, use `company-search-candidates' or 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) @@ -2178,6 +2234,9 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)" 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. @@ -2327,16 +2386,18 @@ If SHOW-VERSION is non-nil, show the version in the echo area." mouse-face company-tooltip-mouse) 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))) + (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) + (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) @@ -2346,6 +2407,16 @@ If SHOW-VERSION is non-nil, show the version in the echo area." 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--clean-string (str) (replace-regexp-in-string "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]" @@ -2729,12 +2800,14 @@ Returns a negative number if the tooltip should be displayed above point." '(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)) + (add-text-properties mbeg + mend + '(face company-preview-search) + completion))) (setq completion (company-strip-prefix completion))