X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/077182c12c2c4956faace68b2f20ab3595091889..c6d53302b114ba50a8e48ce98b906849fded86f4:/company.el diff --git a/company.el b/company.el index 23ed09a30..a92f67825 100644 --- a/company.el +++ b/company.el @@ -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) @@ -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 @@ -628,7 +643,6 @@ asynchronous call into synchronous.") (define-key keymap [mouse-3] 'company-select-mouse) (define-key keymap [up-mouse-1] 'ignore) (define-key keymap [up-mouse-3] 'ignore) - (define-key keymap [return] 'company-complete-selection) (define-key keymap (kbd "RET") 'company-complete-selection) (define-key keymap [tab] 'company-complete-common) (define-key keymap (kbd "TAB") 'company-complete-common) @@ -1017,6 +1031,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))) @@ -1202,10 +1217,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) @@ -1216,37 +1232,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)) @@ -1340,6 +1346,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 same case sensitive prefix. +If a backend returns case insensitive matches, candidates with the an exact +prefix match will be prioritized even if this changes the lexical order." + (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)) @@ -2057,6 +2073,15 @@ 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. @@ -2827,6 +2852,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) @@ -2901,6 +2950,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)