X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/02d0e7447d1a4e817b0a7c6ab9eec4b4e01a9cd8..946c798dfc19047ae3cebe63d00db84ec525a9bc:/company.el

diff --git a/company.el b/company.el
index a90c0c637..498920afb 100644
--- a/company.el
+++ b/company.el
@@ -62,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$")
@@ -829,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)))
@@ -839,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)))
@@ -846,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
@@ -857,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)))
@@ -1186,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)
@@ -1197,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))
@@ -1608,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 '(" "
@@ -1623,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))))
 
@@ -1645,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)))
@@ -1804,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)
@@ -2174,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.
 
@@ -2323,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)
@@ -2342,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:]]"
@@ -2725,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))