X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/d97c98fed8fb5e6a03804d96031591e9c433cf58..900ae0d7a2270ea1d2ea00567e80a619333fd4e5:/company.el diff --git a/company.el b/company.el index c1af40bc6..18cd2e3e9 100644 --- a/company.el +++ b/company.el @@ -830,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))) @@ -840,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))) @@ -847,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 @@ -858,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))) @@ -1187,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) @@ -1198,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)) @@ -2212,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. @@ -2380,6 +2405,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area." '(face company-tooltip-common-selection mouse-face company-tooltip-selection) line))) + (company--apply-company-face line) line)) (defun company--search-chunks () @@ -2392,6 +2418,21 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (push (cons (car md) (cadr md)) res)))) res)) +(defun company--apply-company-face (str) + (let ((start (if (get-text-property 0 'company-face str) + 0 + (next-single-property-change 0 'company-face str))) + end value) + (while start + (setq end (or (next-single-property-change start 'company-face str) + (length str))) + (setq value (get-text-property start 'company-face str)) + (font-lock-prepend-text-property start end 'face value str) + (font-lock-prepend-text-property start end 'mouse-face value str) + (setq start (next-single-property-change end 'company-face str))) + (when end + (remove-text-properties 0 end '(company-face) str)))) + (defun company--clean-string (str) (replace-regexp-in-string "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"