X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/1de23f8ee97aa62fb28e19e963fe2f211e86a600..212c8fc3101781a2f1c55ca61772eb75a2046e87:/company.el diff --git a/company.el b/company.el index d2373ff7c..713a94fd1 100644 --- a/company.el +++ b/company.el @@ -5,7 +5,7 @@ ;; Author: Nikolaj Schumacher ;; Maintainer: Dmitry Gutov ;; URL: http://company-mode.github.io/ -;; Version: 0.9.0-cvs +;; Version: 0.9.0 ;; Keywords: abbrev, convenience, matching ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) @@ -186,9 +186,13 @@ buffer-local wherever it is set." (defun company-frontends-set (variable value) ;; Uniquify. (let ((value (delete-dups (copy-sequence value)))) - (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value) - (memq 'company-pseudo-tooltip-frontend value) - (error "Pseudo tooltip frontend cannot be used twice")) + (and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value) + (memq 'company-pseudo-tooltip-frontend value)) + (and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value) + (memq 'company-pseudo-tooltip-frontend value)) + (and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value) + (memq 'company-pseudo-tooltip-unless-just-one-frontend value))) + (error "Pseudo tooltip frontend cannot be used more than once")) (and (memq 'company-preview-if-just-one-frontend value) (memq 'company-preview-frontend value) (error "Preview frontend cannot be used twice")) @@ -233,6 +237,8 @@ The visualized data is stored in `company-prefix', `company-candidates', company-pseudo-tooltip-frontend) (const :tag "pseudo tooltip, multiple only" company-pseudo-tooltip-unless-just-one-frontend) + (const :tag "pseudo tooltip, multiple only, delayed" + company-pseudo-tooltip-unless-just-one-frontend-with-delay) (const :tag "preview" company-preview-frontend) (const :tag "preview, unique only" company-preview-if-just-one-frontend) @@ -420,11 +426,11 @@ 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 `:separate' 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. +command. If the group contains keyword `:separate', the candidates that +come from different backends are sorted separately in the combined list. Asynchronous backends ===================== @@ -465,6 +471,8 @@ without duplicates." (const :tag "Sort by occurrence" (company-sort-by-occurrence)) (const :tag "Sort by backend importance" (company-sort-by-backend-importance)) + (const :tag "Prefer case sensitive prefix" + (company-sort-prefer-same-case-prefix)) (repeat :tag "User defined" (function)))) (defcustom company-completion-started-hook nil @@ -557,6 +565,13 @@ happens. The value of nil means no idle completion." (const :tag "immediate (0)" 0) (number :tag "seconds"))) +(defcustom company-tooltip-idle-delay .5 + "The idle delay in seconds until tooltip is shown when using +`company-pseudo-tooltip-unless-just-one-frontend-with-delay'." + :type '(choice (const :tag "never (nil)" nil) + (const :tag "immediate (0)" 0) + (number :tag "seconds"))) + (defcustom company-begin-commands '(self-insert-command org-self-insert-command orgtbl-self-insert-command @@ -905,19 +920,19 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (let ((backends (cl-loop for b in backends when (not (and (symbolp b) (eq 'failed (get b 'company-init)))) - collect b))) + collect b)) + (separate (memq :separate backends))) (when (eq command 'prefix) (setq backends (butlast backends (length (member :with backends))))) - (unless (memq command '(sorted)) - (setq backends (cl-delete-if #'keywordp backends))) + (setq backends (cl-delete-if #'keywordp backends)) (pcase command (`candidates - (company--multi-backend-adapter-candidates backends (car args))) - (`sorted (memq :sorted backends)) - (`duplicates t) + (company--multi-backend-adapter-candidates backends (car args) separate)) + (`sorted separate) + (`duplicates (not separate)) ((or `prefix `ignore-case `no-cache `require-match) (let (value) (cl-dolist (backend backends) @@ -931,26 +946,35 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (car backends)))) (apply backend command args)))))))) -(defun company--multi-backend-adapter-candidates (backends prefix) - (let ((pairs (cl-loop for backend in (cdr backends) +(defun company--multi-backend-adapter-candidates (backends prefix separate) + (let ((pairs (cl-loop for backend in backends when (equal (company--prefix-str (funcall backend 'prefix)) prefix) collect (cons (funcall backend 'candidates prefix) - (let ((b backend)) - (lambda (candidates) - (mapcar - (lambda (str) - (propertize str 'company-backend b)) - candidates))))))) - (when (equal (company--prefix-str (funcall (car backends) 'prefix)) prefix) - ;; Small perf optimization: don't tag the candidates received - ;; from the first backend in the group. - (push (cons (funcall (car backends) 'candidates prefix) - 'identity) - pairs)) + (company--multi-candidates-mapper + backend + separate + ;; Small perf optimization: don't tag the + ;; candidates received from the first + ;; backend in the group. + (not (eq backend (car backends)))))))) (company--merge-async pairs (lambda (values) (apply #'append values))))) +(defun company--multi-candidates-mapper (backend separate tag) + (lambda (candidates) + (when separate + (let ((company-backend backend)) + (setq candidates + (company--preprocess-candidates candidates)))) + (when tag + (setq candidates + (mapcar + (lambda (str) + (propertize str 'company-backend backend)) + candidates))) + candidates)) + (defun company--merge-async (pairs merger) (let ((async (cl-loop for pair in pairs thereis @@ -1017,6 +1041,7 @@ Controlled by `company-auto-complete'.") (defvar-local company-point nil) (defvar company-timer nil) +(defvar company-tooltip-timer nil) (defsubst company-strip-prefix (str) (substring str (length company-prefix))) @@ -1096,7 +1121,8 @@ can retrieve meta-data for them." (defun company--group-lighter (candidate base) (let ((backend (or (get-text-property 0 'company-backend candidate) - (car company-backend)))) + (cl-some (lambda (x) (and (not (keywordp x)) x)) + company-backend)))) (when (and backend (symbolp backend)) (let ((name (replace-regexp-in-string "company-\\|-company" "" (symbol-name backend)))) @@ -1166,10 +1192,11 @@ can retrieve meta-data for them." t)))) (defun company--fetch-candidates (prefix) - (let ((c (if company--manual-action - (company-call-backend 'candidates prefix) - (company-call-backend-raw 'candidates prefix))) - res) + (let* ((non-essential (not (company-explicit-action-p))) + (c (if company--manual-action + (company-call-backend 'candidates prefix) + (company-call-backend-raw 'candidates prefix))) + res) (if (not (eq (car c) :async)) c (let ((buf (current-buffer)) @@ -1200,10 +1227,11 @@ can retrieve meta-data for them." (progn (setq res 'done) nil))))) (defun company--preprocess-candidates (candidates) + (cl-assert (cl-every #'stringp candidates)) (unless (company-call-backend 'sorted) (setq candidates (sort candidates 'string<))) (when (company-call-backend 'duplicates) - (setq candidates (company--strip-duplicates candidates))) + (company--strip-duplicates candidates)) candidates) (defun company--postprocess-candidates (candidates) @@ -1214,37 +1242,27 @@ can retrieve meta-data for them." (company--transform-candidates candidates)) (defun company--strip-duplicates (candidates) - (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))) + (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))))) (defun company--transform-candidates (candidates) (let ((c candidates)) @@ -1338,6 +1356,16 @@ from the rest of the backends in the group, if any, will be left at the end." (let ((b1 (get-text-property 0 'company-backend c1))) (or (not b1) (not (memq b1 low-priority))))))))))) +(defun company-sort-prefer-same-case-prefix (candidates) + "Prefer CANDIDATES with the exact same prefix. +If a backend returns case insensitive matches, candidates with the an exact +prefix match (same case) will be prioritized." + (cl-loop for candidate in candidates + if (string-prefix-p company-prefix candidate) + collect candidate into same-case + else collect candidate into other-case + finally return (append same-case other-case))) + (defun company-idle-begin (buf win tick pos) (and (eq buf (current-buffer)) (eq win (selected-window)) @@ -1362,6 +1390,7 @@ from the rest of the backends in the group, if any, will be left at the end." (company-cancel)) (quit (company-cancel)))))) +;;;###autoload (defun company-manual-begin () (interactive) (company-assert-enabled) @@ -1593,7 +1622,8 @@ from the rest of the backends in the group, if any, will be left at the end." (company-uninstall-map)) (defun company-post-command () - (when (null this-command) + (when (and company-candidates + (null this-command)) ;; Happens when the user presses `C-g' while inside ;; `flyspell-post-command-hook', for example. ;; Or any other `post-command-hook' function that can call `sit-for', @@ -2053,6 +2083,16 @@ With ARG, move by that many elements." (eq old-tick (buffer-chars-modified-tick))) (company-complete-common)))))) +(defun company-select-next-if-tooltip-visible-or-complete-selection () + "Insert selection if appropriate, or select the next candidate. +Insert selection if only preview is showing or only one candidate, +otherwise select the next candidate." + (interactive) + (if (and (company-tooltip-visible-p) (> company-candidates-length 1)) + (call-interactively 'company-select-next) + (call-interactively 'company-complete-selection))) + +;;;###autoload (defun company-complete () "Insert the common part of all candidates or the current selection. The first time this is called, the common part is inserted, the second @@ -2822,6 +2862,30 @@ Returns a negative number if the tooltip should be displayed above point." (company--show-inline-p)) (company-pseudo-tooltip-frontend command))) +(defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command) + "`compandy-pseudo-tooltip-frontend', but shown after a delay. +Delay is determined by `company-tooltip-idle-delay'." + (cl-case command + (pre-command + (company-pseudo-tooltip-unless-just-one-frontend command) + (when company-tooltip-timer + (cancel-timer company-tooltip-timer) + (setq company-tooltip-timer nil))) + (post-command + (if (or company-tooltip-timer + (overlayp company-pseudo-tooltip-overlay)) + (if (not (memq 'company-preview-frontend company-frontends)) + (company-pseudo-tooltip-unless-just-one-frontend command) + (company-preview-frontend 'pre-command) + (company-pseudo-tooltip-unless-just-one-frontend command) + (company-preview-frontend 'post-command)) + (setq company-tooltip-timer + (run-with-timer company-tooltip-idle-delay nil + 'company-pseudo-tooltip-unless-just-one-frontend-with-delay + 'post-command)))) + (t + (company-pseudo-tooltip-unless-just-one-frontend command)))) + ;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar-local company-preview-overlay nil) @@ -2896,6 +2960,11 @@ Returns a negative number if the tooltip should be displayed above point." (or (eq (company-call-backend 'ignore-case) 'keep-prefix) (string-prefix-p company-prefix company-common)))) +(defun company-tooltip-visible-p () + "Returns whether the tooltip is visible." + (when (overlayp company-pseudo-tooltip-overlay) + (not (overlay-get company-pseudo-tooltip-overlay 'invisible)))) + ;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar-local company-echo-last-msg nil)