X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/39eb1158909bae3754d24f00437a2e8e969ac573..c6d53302b114ba50a8e48ce98b906849fded86f4:/company.el diff --git a/company.el b/company.el index f83eeb45a..a92f67825 100644 --- a/company.el +++ b/company.el @@ -45,8 +45,7 @@ ;; ;; (defun company-my-backend (command &optional arg &rest ignored) ;; (pcase command -;; (`prefix (when (looking-back "foo\\>") -;; (match-string 0))) +;; (`prefix (company-grab-symbol)) ;; (`candidates (list "foobar" "foobaz" "foobarbaz")) ;; (`meta (format "This value is named %s" arg)))) ;; @@ -187,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")) @@ -234,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) @@ -313,9 +318,10 @@ This doesn't include the margins and the scroll bar." company-eclim company-semantic company-clang company-xcode company-cmake company-capf + company-files (company-dabbrev-code company-gtags company-etags company-keywords) - company-oddmuse company-files company-dabbrev) + company-oddmuse company-dabbrev) "The list of active backends (completion engines). Only one backend is used at a time. The choice depends on the order of @@ -334,10 +340,10 @@ of the following: text immediately before point. Returning nil from this command passes control to the next backend. The function should return `stop' if it should complete but cannot (e.g. if it is in the middle of a string). -Instead of a string, the backend may return a cons where car is the prefix -and cdr is used instead of the actual prefix length in the comparison -against `company-minimum-prefix-length'. It must be either number or t, -and in the latter case the test automatically succeeds. +Instead of a string, the backend may return a cons (PREFIX . LENGTH) +where LENGTH is a number used in place of PREFIX's length when +comparing against `company-minimum-prefix-length'. LENGTH can also +be just t, and in the latter case the test automatically succeeds. `candidates': The second argument is the prefix to be completed. The return value should be a list of candidates that match the prefix. @@ -432,7 +438,8 @@ Asynchronous backends The return value of each command can also be a cons (:async . FETCHER) where FETCHER is a function of one argument, CALLBACK. When the data arrives, FETCHER must call CALLBACK and pass it the appropriate return -value, as described above. +value, as described above. That call must happen in the same buffer as +where completion was initiated. True asynchronous operation is only supported for command `candidates', and only during idle completion. Other commands will block the user interface, @@ -464,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 @@ -556,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 @@ -627,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) @@ -832,7 +847,8 @@ means that `company-mode' is always turned on except in `message-mode' buffers." 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))) + (let ((inhibit-field-text-motion t)) + (company-grab regexp expression (point-at-bol)))) (defun company-grab-symbol () "If point is at the end of a symbol, return it. @@ -854,7 +870,7 @@ Otherwise, if point is not inside a symbol, return an empty string." (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 +SYMBOL is as returned by `company-grab-symbol'. If the text before point matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (let ((symbol (company-grab-symbol))) (when symbol @@ -1015,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))) @@ -1094,7 +1111,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)))) @@ -1164,10 +1182,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)) @@ -1186,7 +1205,11 @@ can retrieve meta-data for them." company-candidates-cache (list (cons prefix (company--preprocess-candidates candidates)))) - (company-idle-begin buf win tick pt))))) + (unwind-protect + (company-idle-begin buf win tick pt) + (unless company-candidates + (setq company-backend nil + company-candidates-cache nil))))))) ;; FIXME: Relying on the fact that the callers ;; will interpret nil as "do nothing" is shaky. ;; A throw-catch would be one possible improvement. @@ -1194,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) @@ -1208,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)) @@ -1332,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)) @@ -1356,6 +1380,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) @@ -1525,21 +1550,8 @@ from the rest of the backends in the group, if any, will be left at the end." (company-call-frontends 'update))) (defun company-cancel (&optional result) - (unwind-protect - (progn - (when company-timer - (cancel-timer company-timer)) - (company-echo-cancel t) - (company-search-mode 0) - (company-call-frontends 'hide) - (company-enable-overriding-keymap nil) - (when company-prefix - (if (stringp result) - (progn - (company-call-backend 'pre-completion result) - (run-hook-with-args 'company-completion-finished-hook result) - (company-call-backend 'post-completion result)) - (run-hook-with-args 'company-completion-cancelled-hook result)))) + (let ((prefix company-prefix) + (backend company-backend)) (setq company-backend nil company-prefix nil company-candidates nil @@ -1552,7 +1564,22 @@ from the rest of the backends in the group, if any, will be left at the end." company--manual-action nil company--manual-prefix nil company--point-max nil - company-point nil)) + company-point nil) + (when company-timer + (cancel-timer company-timer)) + (company-echo-cancel t) + (company-search-mode 0) + (company-call-frontends 'hide) + (company-enable-overriding-keymap nil) + (when prefix + ;; FIXME: RESULT can also be e.g. `unique'. We should call + ;; `company-completion-finished-hook' in that case, with right argument. + (if (stringp result) + (let ((company-backend backend)) + (company-call-backend 'pre-completion result) + (run-hook-with-args 'company-completion-finished-hook result) + (company-call-backend 'post-completion result)) + (run-hook-with-args 'company-completion-cancelled-hook result)))) ;; Make return value explicit. nil) @@ -1568,6 +1595,7 @@ from the rest of the backends in the group, if any, will be left at the end." (and (symbolp command) (get command 'company-keep))) (defun company-pre-command () + (company--electric-restore-window-configuration) (unless (company-keep this-command) (condition-case-unless-debug err (when company-candidates @@ -1584,7 +1612,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', @@ -1639,7 +1668,9 @@ each one wraps a part of the input string." (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))) + company-search-words-in-any-order-regexp) + (const :tag "All characters in given order, with anything in between" + company-search-flex-regexp))) (defvar-local company-search-string "") @@ -1669,6 +1700,15 @@ each one wraps a part of the input string." permutations "\\|"))) +(defun company-search-flex-regexp (input) + (if (zerop (length input)) + "" + (concat (regexp-quote (string (aref input 0))) + (mapconcat (lambda (c) + (concat "[^" (string c) "]*" + (regexp-quote (string c)))) + (substring input 1) "")))) + (defun company--permutations (lst) (if (not lst) '(nil) @@ -2033,6 +2073,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 @@ -2118,28 +2168,30 @@ character, stripping the modifiers. That character must be a digit." (insert string))) (current-buffer))) +(defvar company--electric-saved-window-configuration nil) + (defvar company--electric-commands '(scroll-other-window scroll-other-window-down mwheel-scroll) "List of Commands that won't break out of electric commands.") +(defun company--electric-restore-window-configuration () + "Restore window configuration (after electric commands)." + (when (and company--electric-saved-window-configuration + (not (memq this-command company--electric-commands))) + (set-window-configuration company--electric-saved-window-configuration) + (setq company--electric-saved-window-configuration nil))) + (defmacro company--electric-do (&rest body) (declare (indent 0) (debug t)) `(when (company-manual-begin) - (save-window-excursion - (let ((height (window-height)) - (row (company--row)) - cmd) - ,@body - (and (< (window-height) height) - (< (- (window-height) row 2) company-tooltip-limit) - (recenter (- (window-height) row 2))) - (while (memq (setq cmd (key-binding (read-key-sequence-vector nil))) - company--electric-commands) - (condition-case err - (call-interactively cmd) - ((beginning-of-buffer end-of-buffer) - (message (error-message-string err))))) - (company--unread-last-input))))) + (cl-assert (null company--electric-saved-window-configuration)) + (setq company--electric-saved-window-configuration (current-window-configuration)) + (let ((height (window-height)) + (row (company--row))) + ,@body + (and (< (window-height) height) + (< (- (window-height) row 2) company-tooltip-limit) + (recenter (- (window-height) row 2)))))) (defun company--unread-last-input () (when last-input-event @@ -2800,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) @@ -2874,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) @@ -2961,8 +3042,8 @@ Returns a negative number if the tooltip should be displayed above point." "}"))) (defun company-echo-hide () - (unless (null company-echo-last-msg) - (setq company-echo-last-msg nil) + (unless (equal company-echo-last-msg "") + (setq company-echo-last-msg "") (company-echo-show))) (defun company-echo-frontend (command)