X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/433ae926feed34b90251e94ad5df7fb26a786e5a..250ca1c395c6f05b733abce69a2d928b6cd31618:/company.el diff --git a/company.el b/company.el index 96bfbf06a..48f41d49e 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))) @@ -1612,6 +1621,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 +1647,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 +1691,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 +1851,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 +2224,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 +2376,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 +2397,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 +2790,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))