X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/4efb1b0899a27905e55700f019b59835523de665..5ffa21480181cbff600a90f2cf75803b9a92a006:/company.el diff --git a/company.el b/company.el index 66eddd7c5..d388e3ee3 100644 --- a/company.el +++ b/company.el @@ -1,10 +1,10 @@ ;;; company.el --- extensible inline text completion mechanism ;; -;; Copyright (C) 2009 Nikolaj Schumacher +;; Copyright (C) 2009-2010 Nikolaj Schumacher ;; ;; Author: Nikolaj Schumacher -;; Version: 0.3.1 -;; Keywords: abbrev, convenience, matchis +;; Version: 0.4.3 +;; Keywords: abbrev, convenience, matching ;; URL: http://nschum.de/src/emacs/company/ ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x ;; @@ -54,13 +54,9 @@ ;; ('meta (format "This value is named %s" arg)))) ;; ;; Sometimes it is a good idea to mix two back-ends together, for example to -;; enrich gtags with dabbrev text (to emulate local variables): -;; -;; (defun gtags-gtags-dabbrev-backend (command &optional arg &rest ignored) -;; (case command -;; (prefix (company-gtags 'prefix)) -;; (candidates (append (company-gtags 'candidates arg) -;; (company-dabbrev 'candidates arg))))) +;; enrich gtags with dabbrev-code results (to emulate local variables): +;; To do this, add a list with the merged back-ends as an element in +;; company-backends. ;; ;; Known Issues: ;; When point is at the very end of the buffer, the pseudo-tooltip appears very @@ -69,6 +65,35 @@ ;; ;;; Change Log: ;; +;; `company-ropemacs' now provides location and docs. (Fernando H. Silva) +;; Added `company-with-candidate-inserted' macro. +;; Added `company-clang' back-end. +;; Added new mechanism for non-consecutive insertion. +;; (So far only used by clang for ObjC.) +;; The semantic back-end now shows meta information for local symbols. +;; Added compatibility for CEDET in Emacs 23.2 and from CVS. (Oleg Andreev) +;; +;; 2009-05-07 (0.4.3) +;; Added `company-other-backend'. +;; Idle completion no longer interrupts multi-key command input. +;; Added `company-ropemacs' and `company-pysmell' back-ends. +;; +;; 2009-04-25 (0.4.2) +;; In C modes . and -> now count towards `company-minimum-prefix-length'. +;; Reverted default front-end back to `company-preview-if-just-one-frontend'. +;; The pseudo tooltip will no longer be clipped at the right window edge. +;; Added `company-tooltip-minimum'. +;; Windows compatibility fixes. +;; +;; 2009-04-19 (0.4.1) +;; Added `global-company-mode'. +;; Performance enhancements. +;; Added `company-eclim' back-end. +;; Added safer workaround for Emacs `posn-col-row' bug. +;; +;; 2009-04-18 (0.4) +;; Automatic completion is now aborted if the prefix gets too short. +;; Added option `company-dabbrev-time-limit'. ;; `company-backends' now supports merging back-ends. ;; Added back-end `company-dabbrev-code' for generic code. ;; Fixed `company-begin-with'. @@ -117,12 +142,13 @@ (add-to-list 'debug-ignored-errors "^Company not ") (add-to-list 'debug-ignored-errors "^No candidate number ") (add-to-list 'debug-ignored-errors "^Cannot complete at point$") +(add-to-list 'debug-ignored-errors "^No other back-end$") (defgroup company nil "Extensible inline text completion mechanism" :group 'abbrev :group 'convenience - :group 'maching) + :group 'matching) (defface company-tooltip '((t :background "yellow" @@ -154,11 +180,6 @@ "*Face used for the selected common completion in the tool tip." :group 'company) -(defcustom company-tooltip-limit 10 - "*The maximum number of candidates in the tool tip" - :group 'company - :type 'integer) - (defface company-preview '((t :background "blue4" :foreground "wheat")) @@ -207,7 +228,7 @@ (set variable value)) (defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend - company-preview-frontend + company-preview-if-just-one-frontend company-echo-metadata-frontend) "*The list of active front-ends (visualizations). Each front-end is a function that takes one argument. It is called with @@ -244,10 +265,37 @@ The visualized data is stored in `company-prefix', `company-candidates', company-preview-if-just-one-frontend) (function :tag "custom function" nil)))) +(defcustom company-tooltip-limit 10 + "*The maximum number of candidates in the tool tip" + :group 'company + :type 'integer) + +(defcustom company-tooltip-minimum 6 + "*The minimum height of the tool tip. +If this many lines are not available, prefer to display the tooltip above." + :group 'company + :type 'integer) + (defvar company-safe-backends - '(company-abbrev company-css company-dabbrev-code company-dabbrev - company-elisp company-etags company-files company-gtags company-ispell - company-nxml company-oddmuse company-semantic company-tempo company-xcode)) + '((company-abbrev . "Abbrev") + (company-clang . "clang") + (company-css . "CSS") + (company-dabbrev . "dabbrev for plain text") + (company-dabbrev-code . "dabbrev for code") + (company-eclim . "eclim (an Eclipse interace)") + (company-elisp . "Emacs Lisp") + (company-etags . "etags") + (company-files . "Files") + (company-gtags . "GNU Global") + (company-ispell . "ispell") + (company-keywords . "Programming language keywords") + (company-nxml . "nxml") + (company-oddmuse . "Oddmuse") + (company-pysmell . "PySmell") + (company-ropemacs . "ropemacs") + (company-semantic . "CEDET Semantic") + (company-tempo . "Tempo templates") + (company-xcode . "Xcode"))) (put 'company-safe-backends 'risky-local-variable t) (defun company-safe-backends-p (backends) @@ -255,18 +303,23 @@ The visualized data is stored in `company-prefix', `company-candidates', (not (dolist (backend backends) (unless (if (consp backend) (company-safe-backends-p backend) - (memq backend company-safe-backends)) + (assq backend company-safe-backends)) (return t)))))) (defcustom company-backends '(company-elisp company-nxml company-css - company-semantic company-xcode - (company-gtags company-etags company-dabbrev-code) + company-eclim company-semantic company-clang + company-xcode company-ropemacs + (company-gtags company-etags company-dabbrev-code + company-pysmell company-keywords) company-oddmuse company-files company-dabbrev) "*The list of active back-ends (completion engines). Each list elements can itself be a list of back-ends. In that case their completions are merged. Otherwise only the first matching back-end returns results. +`company-begin-backend' can be used to start a specific back-end, +`company-other-backend' will skip to the next matching back-end in the list. + Each back-end is a function that takes a variable number of arguments. The first argument is the command requested from the back-end. It is one of the following: @@ -274,7 +327,10 @@ of the following: 'prefix: The back-end should return the text to be completed. It must be text immediately before `point'. Returning nil passes control to the next back-end. The function should return 'stop if it should complete but cannot -\(e.g. if it is in the middle of a string\). +\(e.g. if it is in the middle of a string\). If the returned value is only +part of the prefix (e.g. the part after \"->\" in C), the back-end may return a +cons of prefix and prefix length, which is then used in the +`company-minimum-prefix-length' test. 'candidates: The second argument is the prefix to be completed. The return value should be a list of candidates that start with the prefix. @@ -311,11 +367,20 @@ The back-end should return nil for all commands it does not support or does not know about. It should also be callable interactively and use `company-begin-backend' to start itself in that case." :group 'company - :type '(repeat (choice (symbol :tag "Back-end") - (repeat :tag "Merge" - (symbol :tag "Back-end"))))) - -(put 'company-backends 'safe-local-variable 'company-safe-backend-p) + :type `(repeat + (choice + :tag "Back-end" + ,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b))) + company-safe-backends) + (symbol :tag "User defined") + (repeat :tag "Merged Back-ends" + (choice :tag "Back-end" + ,@(mapcar (lambda (b) + `(const :tag ,(cdr b) ,(car b))) + company-safe-backends) + (symbol :tag "User defined")))))) + +(put 'company-backends 'safe-local-variable 'company-safe-backends-p) (defcustom company-completion-started-hook nil "*Hook run when company starts completing. @@ -457,6 +522,8 @@ The work-around consists of adding a newline.") keymap) "Keymap that is enabled during an active completion.") +(defvar company--disabled-backends nil) + (defun company-init-backend (backend) (and (symbolp backend) (not (fboundp backend)) @@ -464,12 +531,24 @@ The work-around consists of adding a newline.") (if (or (symbolp backend) (functionp backend)) - (if (ignore-errors (funcall backend 'init) t) - (put backend 'company-init t) - (message "Company back-end '%s' could not be initialized" - backend)) + (condition-case err + (progn + (funcall backend 'init) + (put backend 'company-init t)) + (error + (put backend 'company-init 'failed) + (unless (memq backend company--disabled-backends) + (message "Company back-end '%s' could not be initialized:\n%s" + backend (error-message-string err))) + (push backend company--disabled-backends) + nil)) (mapc 'company-init-backend backend))) +(defvar company-default-lighter " company") + +(defvar company-lighter company-default-lighter) +(make-variable-buffer-local 'company-lighter) + ;;;###autoload (define-minor-mode company-mode "\"complete anything\"; in in-buffer completion framework. @@ -495,7 +574,7 @@ regular keymap (`company-mode-map'): keymap during active completions (`company-active-map'): \\{company-active-map}" - nil " comp" company-mode-map + nil company-lighter company-mode-map (if company-mode (progn (add-hook 'pre-command-hook 'company-pre-command nil t) @@ -506,6 +585,9 @@ keymap during active completions (`company-active-map'): (company-cancel) (kill-local-variable 'company-point))) +(define-globalized-minor-mode global-company-mode company-mode + (lambda () (company-mode 1))) + (defsubst company-assert-enabled () (unless company-mode (company-uninstall-map) @@ -543,13 +625,26 @@ keymap during active completions (`company-active-map'): ;; Emacs calculates the active keymaps before reading the event. That means we ;; cannot change the keymap from a timer. So we send a bogus command. (defun company-ignore () - (interactive)) + (interactive) + (setq this-command last-command)) (global-set-key '[31415926] 'company-ignore) (defun company-input-noop () (push 31415926 unread-command-events)) +;; Hack: +;; posn-col-row is incorrect in older Emacsen when line-spacing is set +(defun company--col-row (&optional pos) + (let ((posn (posn-at-point pos))) + (cons (car (posn-col-row posn)) (cdr (posn-actual-col-row posn))))) + +(defsubst company--column (&optional pos) + (car (posn-col-row (posn-at-point pos)))) + +(defsubst company--row (&optional pos) + (cdr (posn-actual-col-row (posn-at-point pos)))) + ;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun company-grab (regexp &optional expression limit) @@ -579,6 +674,18 @@ keymap during active completions (`company-active-map'): (car (setq ppss (cdr ppss))) (nth 3 ppss)))) +(if (fboundp 'locate-dominating-file) + (defalias 'company-locate-dominating-file 'locate-dominating-file) + (defun company-locate-dominating-file (file name) + (catch 'root + (let ((dir (file-name-directory file)) + (prev-dir nil)) + (while (not (equal dir prev-dir)) + (when (file-exists-p (expand-file-name name dir)) + (throw 'root dir)) + (setq prev-dir dir + dir (file-name-directory (directory-file-name dir)))))))) + (defun company-call-backend (&rest args) (if (functionp company-backend) (apply company-backend args) @@ -630,7 +737,8 @@ keymap during active completions (`company-active-map'): "Non-nil, if explicit completion took place.") (make-variable-buffer-local 'company--explicit-action) -(defvar company--this-command nil) +(defvar company--point-max nil) +(make-variable-buffer-local 'company--point-max) (defvar company-point nil) (make-variable-buffer-local 'company-point) @@ -643,6 +751,19 @@ keymap during active completions (`company-active-map'): (defsubst company-strip-prefix (str) (substring str (length company-prefix))) +(defmacro company-with-candidate-inserted (candidate &rest body) + "Evaluate BODY with CANDIDATE temporarily inserted. +This is a tool for back-ends that need candidates inserted before they +can retrieve meta-data for them." + (declare (indent 1)) + `(let ((inhibit-modification-hooks t) + (inhibit-point-motion-hooks t) + (modified-p (buffer-modified-p))) + (insert (company-strip-prefix ,candidate)) + (unwind-protect + (progn ,@body) + (delete-region company-point (point))))) + (defun company-explicit-action-p () "Return whether explicit completion action was taken by the user." (or company--explicit-action @@ -656,9 +777,12 @@ keymap during active completions (`company-active-map'): (defun company--should-complete () (and (not (or buffer-read-only overriding-terminal-local-map overriding-local-map)) + ;; Check if in the middle of entering a key combination. + (or (equal (this-command-keys-vector) []) + (not (keymapp (key-binding (this-command-keys-vector))))) (eq company-idle-delay t) (or (eq t company-begin-commands) - (memq company--this-command company-begin-commands) + (memq this-command company-begin-commands) (and (symbolp this-command) (get this-command 'company-begin))) (not (and transient-mark-mode mark-active)))) @@ -708,30 +832,32 @@ keymap during active completions (`company-active-map'): (setq company-candidates nil))) (defun company-calculate-candidates (prefix) - (let ((candidates - (or (cdr (assoc prefix company-candidates-cache)) - (when company-candidates-cache - (let ((len (length prefix)) - (completion-ignore-case (company-call-backend - 'ignore-case)) - prev) - (dotimes (i (1+ len)) - (when (setq prev (cdr (assoc (substring prefix 0 (- len i)) - company-candidates-cache))) - (return (all-completions prefix prev)))))) - (let ((c (company-call-backend 'candidates prefix))) - (when company-candidates-predicate - (setq c (company-apply-predicate - c company-candidates-predicate))) - (unless (company-call-backend 'sorted) - (setq c (sort c 'string<))) - (when (company-call-backend 'duplicates) - ;; strip duplicates - (let ((c2 c)) - (while c2 - (setcdr c2 (progn (while (equal (pop c2) (car c2))) - c2))))) - c)))) + (let ((candidates (cdr (assoc prefix company-candidates-cache)))) + (or candidates + (when company-candidates-cache + (let ((len (length prefix)) + (completion-ignore-case (company-call-backend 'ignore-case)) + prev) + (dotimes (i (1+ len)) + (when (setq prev (cdr (assoc (substring prefix 0 (- len i)) + company-candidates-cache))) + (setq candidates (all-completions prefix prev)) + (return t))))) + ;; no cache match, call back-end + (progn + (setq candidates (company-call-backend 'candidates prefix)) + (when company-candidates-predicate + (setq candidates + (company-apply-predicate candidates + company-candidates-predicate))) + (unless (company-call-backend 'sorted) + (setq candidates (sort candidates 'string<))) + (when (company-call-backend 'duplicates) + ;; strip duplicates + (let ((c2 candidates)) + (while c2 + (setcdr c2 (progn (while (equal (pop c2) (car c2))) + c2))))))) (if (or (cdr candidates) (not (equal (car candidates) prefix))) ;; Don't start when already completed and unique. @@ -747,28 +873,45 @@ keymap during active completions (`company-active-map'): (eq pos (point)) (not company-candidates) (not (equal (point) company-point)) - (let ((company-idle-delay t)) + (let ((company-idle-delay t) + (company-begin-commands t)) (company-begin) (when company-candidates (company-input-noop) (company-post-command))))) -(defun company-manual-begin () - (interactive) +(defun company-auto-begin () (company-assert-enabled) (and company-mode (not company-candidates) (let ((company-idle-delay t) (company-minimum-prefix-length 0) (company-begin-commands t)) - (setq company--explicit-action t) (company-begin))) ;; Return non-nil if active. company-candidates) -(defsubst company-incremental-p (old-prefix new-prefix) - (and (> (length new-prefix) (length old-prefix)) - (equal old-prefix (substring new-prefix 0 (length old-prefix))))) +(defun company-manual-begin () + (interactive) + (setq company--explicit-action t) + (company-auto-begin)) + +(defun company-other-backend (&optional backward) + (interactive (list current-prefix-arg)) + (company-assert-enabled) + (if company-backend + (let* ((after (cdr (member company-backend company-backends))) + (before (cdr (member company-backend (reverse company-backends)))) + (next (if backward + (append before (reverse after)) + (append after (reverse before))))) + (company-cancel) + (dolist (backend next) + (when (ignore-errors (company-begin-backend backend)) + (return t)))) + (company-manual-begin)) + (unless company-candidates + (error "No other back-end"))) (defun company-require-match-p () (let ((backend-value (company-call-backend 'require-match))) @@ -782,90 +925,127 @@ keymap during active completions (`company-active-map'): "Return non-nil, if input starts with punctuation or parentheses." (memq (char-syntax (string-to-char input)) '(?. ?\( ?\)))) -(defun company-auto-complete-p (beg end) +(defun company-auto-complete-p (input) "Return non-nil, if input starts with punctuation or parentheses." - (and (> end beg) - (if (functionp company-auto-complete) + (and (if (functionp company-auto-complete) (funcall company-auto-complete) company-auto-complete) (if (functionp company-auto-complete-chars) - (funcall company-auto-complete-chars (buffer-substring beg end)) + (funcall company-auto-complete-chars input) (if (consp company-auto-complete-chars) - (memq (char-syntax (char-after beg)) company-auto-complete-chars) - (string-match (buffer-substring beg (1+ beg)) - company-auto-complete-chars))))) + (memq (char-syntax (string-to-char input)) + company-auto-complete-chars) + (string-match (substring input 0 1) company-auto-complete-chars))))) + +(defun company--incremental-p () + (and (> (point) company-point) + (> (point-max) company--point-max) + (not (eq this-command 'backward-delete-char-untabify)) + (equal (buffer-substring (- company-point (length company-prefix)) + company-point) + company-prefix))) + +(defsubst company--string-incremental-p (old-prefix new-prefix) + (and (> (length new-prefix) (length old-prefix)) + (equal old-prefix (substring new-prefix 0 (length old-prefix))))) -(defun company-continue () +(defun company--continue-failed (new-prefix) + (when (company--incremental-p) + (let ((input (buffer-substring-no-properties (point) company-point))) + (cond + ((company-auto-complete-p input) + ;; auto-complete + (save-excursion + (goto-char company-point) + (company-complete-selection) + nil)) + ((and (company--string-incremental-p company-prefix new-prefix) + (company-require-match-p)) + ;; wrong incremental input, but required match + (backward-delete-char (length input)) + (ding) + (message "Matching input is required") + company-candidates) + ((equal company-prefix (car company-candidates)) + ;; last input was actually success + (company-cancel company-prefix) + nil))))) + +(defun company--good-prefix-p (prefix) + (and (or (company-explicit-action-p) + (>= (or (cdr-safe prefix) (length prefix)) + company-minimum-prefix-length)) + (stringp (or (car-safe prefix) prefix)))) + +(defun company--continue () (when (company-call-backend 'no-cache company-prefix) ;; Don't complete existing candidates, fetch new ones. (setq company-candidates-cache nil)) - (let ((new-prefix (company-call-backend 'prefix))) - (if (= (- (point) (length new-prefix)) - (- company-point (length company-prefix))) - (unless (or (equal company-prefix new-prefix) - (let ((c (company-calculate-candidates new-prefix))) - ;; t means complete/unique. - (if (eq c t) - (progn (company-cancel new-prefix) t) - (when (consp c) - (setq company-prefix new-prefix) - (company-update-candidates c) - t)))) - (if (not (and (company-incremental-p company-prefix new-prefix) - (company-require-match-p))) - (progn - (when (equal company-prefix (car company-candidates)) - ;; cancel, but last input was actually success - (company-cancel company-prefix)) - (setq company-candidates nil)) - (backward-delete-char (length new-prefix)) - (insert company-prefix) - (ding) - (message "Matching input is required"))) - (when (company-auto-complete-p company-point (point)) - (save-excursion - (goto-char company-point) - (company-complete-selection))) - (setq company-candidates nil)) - company-candidates)) + (let* ((new-prefix (company-call-backend 'prefix)) + (c (when (and (company--good-prefix-p new-prefix) + (setq new-prefix (or (car-safe new-prefix) new-prefix)) + (= (- (point) (length new-prefix)) + (- company-point (length company-prefix)))) + (setq new-prefix (or (car-safe new-prefix) new-prefix)) + (company-calculate-candidates new-prefix)))) + (or (cond + ((eq c t) + ;; t means complete/unique. + (company-cancel new-prefix) + nil) + ((consp c) + ;; incremental match + (setq company-prefix new-prefix) + (company-update-candidates c) + c) + (t (company--continue-failed new-prefix))) + (company-cancel)))) + +(defun company--begin-new () + (let (prefix c) + (dolist (backend (if company-backend + ;; prefer manual override + (list company-backend) + company-backends)) + (setq prefix + (if (or (symbolp backend) + (functionp backend)) + (when (or (not (symbolp backend)) + (eq t (get backend 'company-init)) + (unless (get backend 'company-init) + (company-init-backend backend))) + (funcall backend 'prefix)) + (company--multi-backend-adapter backend 'prefix))) + (when prefix + (when (company--good-prefix-p prefix) + (setq prefix (or (car-safe prefix) prefix) + company-backend backend + c (company-calculate-candidates prefix)) + ;; t means complete/unique. We don't start, so no hooks. + (if (not (consp c)) + (when company--explicit-action + (message "No completion found")) + (setq company-prefix prefix) + (when (symbolp backend) + (setq company-lighter (concat " " (symbol-name backend)))) + (company-update-candidates c) + (run-hook-with-args 'company-completion-started-hook + (company-explicit-action-p)) + (company-call-frontends 'show))) + (return c))))) (defun company-begin () - (when (and (not (and company-candidates (company-continue))) - (company--should-complete)) - (let (prefix) - (dolist (backend (if company-backend - ;; prefer manual override - (list company-backend) - company-backends)) - (setq prefix - (if (or (symbolp backend) - (functionp backend)) - (when (or (not (symbolp backend)) - (get backend 'company-init)) - (funcall backend 'prefix)) - (company--multi-backend-adapter backend 'prefix))) - (when prefix - (when (and (stringp prefix) - (>= (length prefix) company-minimum-prefix-length)) - (setq company-backend backend - company-prefix prefix) - (let ((c (company-calculate-candidates prefix))) - ;; t means complete/unique. We don't start, so no hooks. - (when (consp c) - (company-update-candidates c) - (run-hook-with-args 'company-completion-started-hook - (company-explicit-action-p)) - (company-call-frontends 'show)))) - (return prefix))))) - (if company-candidates - (progn - (when (and company-end-of-buffer-workaround (eobp)) - (save-excursion (insert "\n")) - (setq company-added-newline (buffer-chars-modified-tick))) - (setq company-point (point)) - (company-enable-overriding-keymap company-active-map) - (company-call-frontends 'update)) - (company-cancel))) + (setq company-candidates + (or (and company-candidates (company--continue)) + (and (company--should-complete) (company--begin-new)))) + (when company-candidates + (when (and company-end-of-buffer-workaround (eobp)) + (save-excursion (insert "\n")) + (setq company-added-newline (buffer-chars-modified-tick))) + (setq company-point (point) + company--point-max (point-max)) + (company-enable-overriding-keymap company-active-map) + (company-call-frontends 'update))) (defun company-cancel (&optional result) (and company-added-newline @@ -877,7 +1057,10 @@ keymap during active completions (`company-active-map'): (set-buffer-modified-p nil)) (when company-prefix (if (stringp result) - (run-hook-with-args 'company-completion-finished-hook 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))) (setq company-added-newline nil company-backend nil @@ -890,6 +1073,8 @@ keymap during active completions (`company-active-map'): company-selection 0 company-selection-changed nil company--explicit-action nil + company-lighter company-default-lighter + company--point-max nil company-point nil) (when company-timer (cancel-timer company-timer)) @@ -921,23 +1106,26 @@ keymap during active completions (`company-active-map'): (message "%s" (error-message-string err)) (company-cancel)))) (when company-timer - (cancel-timer company-timer)) + (cancel-timer company-timer) + (setq company-timer nil)) (company-uninstall-map)) (defun company-post-command () (unless (company-keep this-command) (condition-case err (progn - (setq company--this-command this-command) (unless (equal (point) company-point) (company-begin)) - (when company-candidates - (company-call-frontends 'post-command)) - (when (numberp company-idle-delay) - (setq company-timer - (run-with-timer company-idle-delay nil 'company-idle-begin - (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point))))) + (if company-candidates + (company-call-frontends 'post-command) + (and (numberp company-idle-delay) + (or (eq t company-begin-commands) + (memq this-command company-begin-commands)) + (setq company-timer + (run-with-timer company-idle-delay nil + 'company-idle-begin + (current-buffer) (selected-window) + (buffer-chars-modified-tick) (point)))))) (error (message "Company: An error occurred in post-command") (message "%s" (error-message-string err)) (company-cancel)))) @@ -1151,7 +1339,7 @@ followed by `company-search-kill-others' after each input." (interactive "e") (when (nth 4 (event-start event)) (company-set-selection (- (cdr (posn-actual-col-row (event-start event))) - (cdr (posn-actual-col-row (posn-at-point))) + (company--row) 1)) t)) @@ -1239,19 +1427,24 @@ To show the number next to the candidates in some back-ends, enable (erase-buffer) (current-buffer))) -(defmacro company-electric (&rest body) +(defvar company--electric-commands + '(scroll-other-window scroll-other-window-down) + "List of Commands that won't break out of electric commands.") + +(defmacro company--electric-do (&rest body) (declare (indent 0) (debug t)) `(when (company-manual-begin) (save-window-excursion (let ((height (window-height)) - (row (cdr (posn-actual-col-row (posn-at-point))))) + (row (company--row)) + cmd) ,@body (and (< (window-height) height) (< (- (window-height) row 2) company-tooltip-limit) (recenter (- (window-height) row 2))) - (while (eq 'scroll-other-window - (key-binding (vector (list (read-event))))) - (call-interactively 'scroll-other-window)) + (while (memq (setq cmd (key-binding (vector (list (read-event))))) + company--electric-commands) + (call-interactively cmd)) (when last-input-event (clear-this-command-keys t) (setq unread-command-events (list last-input-event))))))) @@ -1259,25 +1452,31 @@ To show the number next to the candidates in some back-ends, enable (defun company-show-doc-buffer () "Temporarily show a buffer with the complete documentation for the selection." (interactive) - (company-electric - (let ((selected (nth company-selection company-candidates))) - (display-buffer (or (company-call-backend 'doc-buffer selected) - (error "No documentation available")) t)))) + (company--electric-do + (let* ((selected (nth company-selection company-candidates)) + (doc-buffer (or (company-call-backend 'doc-buffer selected) + (error "No documentation available")))) + (with-current-buffer doc-buffer + (goto-char (point-min))) + (display-buffer doc-buffer t)))) (put 'company-show-doc-buffer 'company-keep t) (defun company-show-location () "Temporarily display a buffer showing the selected candidate in context." (interactive) - (company-electric + (company--electric-do (let* ((selected (nth company-selection company-candidates)) (location (company-call-backend 'location selected)) (pos (or (cdr location) (error "No location available"))) (buffer (or (and (bufferp (car location)) (car location)) (find-file-noselect (car location) t)))) (with-selected-window (display-buffer buffer t) - (if (bufferp (car location)) - (goto-char pos) - (goto-line pos)) + (save-restriction + (widen) + (if (bufferp (car location)) + (goto-char pos) + (goto-char (point-min)) + (forward-line (1- pos)))) (set-window-start nil (point)))))) (put 'company-show-location 'company-keep t) @@ -1293,7 +1492,8 @@ To show the number next to the candidates in some back-ends, enable (remove-hook 'company-completion-finished-hook company-callback t) (remove-hook 'company-completion-cancelled-hook 'company-remove-callback t) (remove-hook 'company-completion-finished-hook 'company-remove-callback t) - (set-marker company-begin-with-marker nil)) + (when company-begin-with-marker + (set-marker company-begin-with-marker nil))) (defun company-begin-backend (backend &optional callback) "Start a completion at point using BACKEND." @@ -1322,16 +1522,17 @@ completes the input. Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)" + (setq company-begin-with-marker (copy-marker (point) t)) (company-begin-backend - (let ((start (- (point) (or prefix-length 0)))) - (setq company-begin-with-marker (copy-marker (point) t)) - `(lambda (command &optional arg &rest ignored) - (case command - ('prefix (when (equal (point) - (marker-position company-begin-with-marker)) - (buffer-substring ,start (point)))) - ('candidates (all-completions arg ',candidates)) - ('require-match ,require-match)))) + `(lambda (command &optional arg &rest ignored) + (cond + ((eq command 'prefix) + (when (equal (point) (marker-position company-begin-with-marker)) + (buffer-substring ,(- (point) (or prefix-length 0)) (point)))) + ((eq command 'candidates) + (all-completions arg ',candidates)) + ((eq command 'require-match) + ,require-match))) callback)) ;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1411,7 +1612,7 @@ Example: (defun company-buffer-lines (beg end) (goto-char beg) - (let ((row (cdr (posn-actual-col-row (posn-at-point)))) + (let ((row (company--row)) lines) (while (and (equal (move-to-window-line (incf row)) row) (<= (point) end)) @@ -1426,9 +1627,23 @@ Example: new (company-safe-substring old (+ offset (length new))))) -(defun company-replacement-string (old lines column nl) +(defsubst company--length-limit (lst limit) + (if (nthcdr limit lst) + limit + (length lst))) + +(defun company--replacement-string (lines old column nl &optional align-top) + + (let ((width (length (car lines)))) + (when (> width (- (window-width) column)) + (setq column (max 0 (- (window-width) width))))) + (let (new) - ;; Inject into old lines. + (when align-top + ;; untouched lines first + (dotimes (i (- (length old) (length lines))) + (push (pop old) new))) + ;; length into old lines. (while old (push (company-modify-line (pop old) (pop lines) column) new)) ;; Append whole new lines. @@ -1438,7 +1653,7 @@ Example: (mapconcat 'identity (nreverse new) "\n") "\n"))) -(defun company-create-lines (column selection limit) +(defun company--create-lines (selection limit) (let ((len company-candidates-length) (numbered 99999) @@ -1460,14 +1675,14 @@ Example: (setq remainder (format "...(%d)" remainder)))) (decf selection company-tooltip-offset) - (setq width (min (length previous) (length remainder)) + (setq width (max (length previous) (length remainder)) lines (nthcdr company-tooltip-offset company-candidates) len (min limit len) lines-copy lines) (dotimes (i len) (setq width (max (length (pop lines-copy)) width))) - (setq width (min width (- (window-width) column))) + (setq width (min width (window-width))) (setq lines-copy lines) @@ -1501,11 +1716,19 @@ Example: ;; show -(defsubst company-pseudo-tooltip-height () - "Calculate the appropriate tooltip height." - (max 3 (min company-tooltip-limit - (- (window-height) 2 - (count-lines (window-start) (point-at-bol)))))) +(defsubst company--window-inner-height () + (let ((edges (window-inside-edges (selected-window)))) + (- (nth 3 edges) (nth 1 edges)))) + +(defsubst company--pseudo-tooltip-height () + "Calculate the appropriate tooltip height. +Returns a negative number if the tooltip should be displayed above point." + (let* ((lines (count-lines (window-start) (point-at-bol))) + (below (- (company--window-inner-height) 1 lines))) + (if (and (< below (min company-tooltip-minimum company-candidates-length)) + (> lines below)) + (- (max 3 (min company-tooltip-limit lines))) + (max 3 (min company-tooltip-limit below))))) (defun company-pseudo-tooltip-show (row column selection) (company-pseudo-tooltip-hide) @@ -1513,42 +1736,48 @@ Example: (move-to-column 0) - (let* ((height (company-pseudo-tooltip-height)) - (lines (company-create-lines column selection height)) - (nl (< (move-to-window-line row) row)) - (beg (point)) - (end (save-excursion - (move-to-window-line (+ row height)) - (point))) - (old-string - (mapcar 'company-untabify (company-buffer-lines beg end))) - str) - - (setq company-pseudo-tooltip-overlay (make-overlay beg end)) - - (overlay-put company-pseudo-tooltip-overlay 'company-old old-string) - (overlay-put company-pseudo-tooltip-overlay 'company-column column) - (overlay-put company-pseudo-tooltip-overlay 'company-nl nl) - (overlay-put company-pseudo-tooltip-overlay 'company-before - (company-replacement-string old-string lines column nl)) - (overlay-put company-pseudo-tooltip-overlay 'company-height height) - - (overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))) + (let* ((height (company--pseudo-tooltip-height)) + above) + + (when (< height 0) + (setq row (+ row height -1) + above t)) + + (let* ((nl (< (move-to-window-line row) row)) + (beg (point)) + (end (save-excursion + (move-to-window-line (+ row (abs height))) + (point))) + (ov (make-overlay beg end)) + (args (list (mapcar 'company-untabify + (company-buffer-lines beg end)) + column nl above))) + + (setq company-pseudo-tooltip-overlay ov) + (overlay-put ov 'company-replacement-args args) + (overlay-put ov 'company-before + (apply 'company--replacement-string + (company--create-lines selection (abs height)) + args)) + + (overlay-put ov 'company-column column) + (overlay-put ov 'company-height (abs height)) + (overlay-put ov 'window (selected-window)))))) (defun company-pseudo-tooltip-show-at-point (pos) - (let ((col-row (posn-actual-col-row (posn-at-point pos)))) + (let ((col-row (company--col-row pos))) (when col-row (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row) company-selection)))) (defun company-pseudo-tooltip-edit (lines selection) - (let* ((old-string (overlay-get company-pseudo-tooltip-overlay 'company-old)) - (column (overlay-get company-pseudo-tooltip-overlay 'company-column)) - (nl (overlay-get company-pseudo-tooltip-overlay 'company-nl)) - (height (overlay-get company-pseudo-tooltip-overlay 'company-height)) - (lines (company-create-lines column selection height))) + (let ((column (overlay-get company-pseudo-tooltip-overlay 'company-column)) + (height (overlay-get company-pseudo-tooltip-overlay 'company-height))) (overlay-put company-pseudo-tooltip-overlay 'company-before - (company-replacement-string old-string lines column nl)))) + (apply 'company--replacement-string + (company--create-lines selection height) + (overlay-get company-pseudo-tooltip-overlay + 'company-replacement-args))))) (defun company-pseudo-tooltip-hide () (when company-pseudo-tooltip-overlay @@ -1572,13 +1801,16 @@ Example: (case command ('pre-command (company-pseudo-tooltip-hide-temporarily)) ('post-command - (unless (and (overlayp company-pseudo-tooltip-overlay) - (equal (overlay-get company-pseudo-tooltip-overlay - 'company-height) - (company-pseudo-tooltip-height))) - ;; Redraw needed. - (company-pseudo-tooltip-show-at-point (- (point) - (length company-prefix)))) + (let ((old-height (if (overlayp company-pseudo-tooltip-overlay) + (overlay-get company-pseudo-tooltip-overlay + 'company-height) + 0)) + (new-height (company--pseudo-tooltip-height))) + (unless (and (>= (* old-height new-height) 0) + (>= (abs old-height) (abs new-height))) + ;; Redraw needed. + (company-pseudo-tooltip-show-at-point (- (point) + (length company-prefix))))) (company-pseudo-tooltip-unhide)) ('hide (company-pseudo-tooltip-hide) (setq company-tooltip-offset 0)) @@ -1649,7 +1881,7 @@ Example: (defvar company-echo-timer nil) -(defvar company-echo-delay .1) +(defvar company-echo-delay .01) (defun company-echo-show (&optional getter) (when getter @@ -1748,5 +1980,9 @@ Example: ('post-command (company-echo-show-soon 'company-fetch-metadata)) ('hide (company-echo-hide)))) +;; templates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(autoload 'company-template-declare-template "company-template") + (provide 'company) ;;; company.el ends here