;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.9.0-cvs
+;; Version: 0.8.7
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; enrich gtags with dabbrev-code results (to emulate local variables).
;; To do this, add a list with both 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
-;; wrong, unless company is allowed to temporarily insert a fake newline.
-;; This behavior is enabled by `company-end-of-buffer-workaround'.
-;;
;;; Change Log:
;;
;; See NEWS.md in the repository.
(t (:background "green")))
"Face used for the selection in the tooltip.")
+(defface company-tooltip-search
+ '((default :inherit company-tooltip-selection))
+ "Face used for the search string in the tooltip.")
+
(defface company-tooltip-mouse
'((default :inherit highlight))
"Face used for the tooltip item under the mouse.")
(defcustom company-idle-delay .5
"The idle delay in seconds until completion starts automatically.
-A value of nil means no idle completion, t means show candidates
-immediately when a prefix of `company-minimum-prefix-length' is reached."
+The prefix still has to satisfy `company-minimum-prefix-length' before that
+happens. The value of nil means no idle completion."
:type '(choice (const :tag "never (nil)" nil)
- (const :tag "immediate (t)" t)
+ (const :tag "immediate (0)" 0)
(number :tag "seconds")))
-(defcustom company-begin-commands '(self-insert-command org-self-insert-command)
+(defcustom company-begin-commands '(self-insert-command
+ org-self-insert-command
+ orgtbl-self-insert-command
+ c-scope-operator
+ c-electric-colon
+ c-electric-lt-gt
+ c-electric-slash)
"A list of commands after which idle completion is allowed.
If this is t, it can show completions after any command except a few from a
pre-defined list. See `company-idle-delay'.
treated as if it was on this list."
:type '(choice (const :tag "Any command" t)
(const :tag "Self insert command" '(self-insert-command))
- (repeat :tag "Commands" function)))
+ (repeat :tag "Commands" function))
+ :package-version '(company . "0.8.4"))
(defcustom company-continue-commands '(not save-buffer save-some-buffers
save-buffers-kill-terminal
:type '(choice (const :tag "off" nil)
(const :tag "on" t)))
-(defvar company-end-of-buffer-workaround t
- "Work around a visualization bug when completing at the end of the buffer.
-The work-around consists of adding a newline.")
-
(defvar company-async-wait 0.03
"Pause between checks to see if the value's been set when turning an
asynchronous call into synchronous.")
(define-key keymap "\C-s" 'company-search-candidates)
(define-key keymap "\C-\M-s" 'company-filter-candidates)
(dotimes (i 10)
- (define-key keymap (vector (+ (aref (kbd "M-0") 0) i))
- `(lambda ()
- (interactive)
- (company-complete-number ,(if (zerop i) 10 i)))))
-
- keymap)
+ (define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
+ keymap)
"Keymap that is enabled during an active completion.")
(defvar company--disabled-backends nil)
nil company-lighter company-mode-map
(if company-mode
(progn
+ (when (eq company-idle-delay t)
+ (setq company-idle-delay 0)
+ (warn "Setting `company-idle-delay' to t is deprecated. Set it to 0 instead."))
(add-hook 'pre-command-hook 'company-pre-command nil t)
(add-hook 'post-command-hook 'company-post-command nil t)
(mapc 'company-init-backend company-backends))
;; Hack:
;; 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.
-;; XXX: Seems not to be needed anymore in Emacs 24.4
+;; XXX: Even in Emacs 24.4, seems to be needed in the terminal.
(defun company-ignore ()
(interactive)
(setq this-command last-command))
(defun company-input-noop ()
(push 31415926 unread-command-events))
-(defun company--column (&optional pos)
- (save-excursion
- (when pos (goto-char pos))
- (save-restriction
- (+ (save-excursion
- (vertical-motion 0)
- (narrow-to-region (point) (point-max))
- (let ((prefix (get-text-property (point) 'line-prefix)))
- (if prefix (length prefix) 0)))
- (current-column)))))
+(defun company--posn-col-row (posn)
+ (let ((col (car (posn-col-row posn)))
+ ;; `posn-col-row' doesn't work well with lines of different height.
+ ;; `posn-actual-col-row' doesn't handle multiple-width characters.
+ (row (cdr (posn-actual-col-row posn))))
+ (when (and header-line-format (version< emacs-version "24.3.93.3"))
+ ;; http://debbugs.gnu.org/18384
+ (cl-decf row))
+ (cons (+ col (window-hscroll)) row)))
+
+(defun company--col-row (&optional pos)
+ (company--posn-col-row (posn-at-point pos)))
(defun company--row (&optional pos)
- (save-excursion
- (when pos (goto-char pos))
- (count-screen-lines (window-start)
- (progn (vertical-motion 0) (point)))))
+ (cdr (company--col-row pos)))
;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
res))))
(defun company-call-backend-raw (&rest args)
- (condition-case err
+ (condition-case-unless-debug err
(if (functionp company-backend)
(apply company-backend args)
(apply #'company--multi-backend-adapter company-backend args))
(defvar company-timer nil)
-(defvar-local company-added-newline nil)
-
(defsubst company-strip-prefix (str)
(substring str (length company-prefix)))
(company--insert-candidate ,candidate)
(unwind-protect
(progn ,@body)
- (delete-region company-point (point)))))
+ (delete-region company-point (point))
+ (set-buffer-modified-p modified-p))))
(defun company-explicit-action-p ()
"Return whether explicit completion action was taken by the user."
candidate))
(defun company--should-complete ()
- (and (eq company-idle-delay t)
+ (and (eq company-idle-delay 'now)
(not (or buffer-read-only overriding-terminal-local-map
overriding-local-map))
;; Check if in the middle of entering a key combination.
(defun company-call-frontends (command)
(dolist (frontend company-frontends)
- (condition-case err
+ (condition-case-unless-debug err
(funcall frontend command)
(error (error "Company: Front-end %s error \"%s\" on command %s"
frontend (error-message-string err) command)))))
(setq c (funcall tr c)))
c))
+(defcustom company-occurrence-weight-function
+ #'company-occurrence-prefer-closest-above
+ "Function to weigh matches in `company-sort-by-occurrence'.
+It's called with three arguments: cursor position, the beginning and the
+end of the match."
+ :type '(choice
+ (const :tag "First above point, then below point"
+ company-occurrence-prefer-closest-above)
+ (const :tag "Prefer closest in any direction"
+ company-occurrence-prefer-any-closest)))
+
+(defun company-occurrence-prefer-closest-above (pos match-beg match-end)
+ "Give priority to the matches above point, then those below point."
+ (if (< match-beg pos)
+ (- pos match-end)
+ (- match-beg (window-start))))
+
+(defun company-occurrence-prefer-any-closest (pos _match-beg match-end)
+ "Give priority to the matches closest to the point."
+ (abs (- pos match-end)))
+
(defun company-sort-by-occurrence (candidates)
"Sort CANDIDATES according to their occurrences.
Searches for each in the currently visible part of the current buffer and
-gives priority to the closest ones above point, then closest ones below
-point. The rest of the list is appended unchanged.
+prioritizes the matches according to `company-occurrence-weight-function'.
+The rest of the list is appended unchanged.
Keywords and function definition names are ignored."
- (let* (occurs
+ (let* ((w-start (window-start))
+ (w-end (window-end))
+ (start-point (point))
+ occurs
(noccurs
- (cl-delete-if
- (lambda (candidate)
- (when (or
- (save-excursion
- (progn (forward-char (- (length company-prefix)))
- (search-backward candidate (window-start) t)))
- (save-excursion
- (search-forward candidate (window-end) t)))
- (let ((beg (match-beginning 0))
- (end (match-end 0)))
- (when (save-excursion
- (goto-char end)
- (and (not (memq (get-text-property (point) 'face)
- '(font-lock-function-name-face
- font-lock-keyword-face)))
- (let ((prefix (company--prefix-str
- (company-call-backend 'prefix))))
- (and (stringp prefix)
- (= (length prefix) (- end beg))))))
- (push (cons candidate (if (< beg (point))
- (- (point) end)
- (- beg (window-start))))
- occurs)
- t))))
- candidates)))
+ (save-excursion
+ (cl-delete-if
+ (lambda (candidate)
+ (when (catch 'done
+ (goto-char w-start)
+ (while (search-forward candidate w-end t)
+ (when (and (not (eq (point) start-point))
+ (save-match-data
+ (company--occurrence-predicate)))
+ (throw 'done t))))
+ (push
+ (cons candidate
+ (funcall company-occurrence-weight-function
+ start-point
+ (match-beginning 0)
+ (match-end 0)))
+ occurs)
+ t))
+ candidates))))
(nconc
(mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
noccurs)))
+(defun company--occurrence-predicate ()
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (save-excursion
+ (goto-char end)
+ (and (not (memq (get-text-property (1- (point)) 'face)
+ '(font-lock-function-name-face
+ font-lock-keyword-face)))
+ (let ((prefix (company--prefix-str
+ (company-call-backend 'prefix))))
+ (and (stringp prefix)
+ (= (length prefix) (- end beg))))))))
+
(defun company-sort-by-backend-importance (candidates)
"Sort CANDIDATES as two priority groups.
If `company-backend' is a function, do nothing. If it's a list, move
(eq tick (buffer-chars-modified-tick))
(eq pos (point))
(when (company-auto-begin)
- (when (version< emacs-version "24.3.50")
- (company-input-noop))
- (company-post-command))))
+ (company-input-noop)
+ (let ((this-command 'company-idle-begin))
+ (company-post-command)))))
(defun company-auto-begin ()
(and company-mode
(not company-candidates)
- (let ((company-idle-delay t))
+ (let ((company-idle-delay 'now))
(condition-case-unless-debug err
(company--perform)
(error (message "Company: An error occurred in auto-begin")
(or (and company-candidates (company--continue))
(and (company--should-complete) (company--begin-new)))
(when company-candidates
- (let ((modified (buffer-modified-p)))
- (when (and company-end-of-buffer-workaround (eobp))
- (save-excursion (insert "\n"))
- (setq company-added-newline
- (or modified (buffer-chars-modified-tick)))))
(setq company-point (point)
company--point-max (point-max))
(company-ensure-emulation-alist)
(company-call-frontends 'update)))
(defun company-cancel (&optional result)
- (and company-added-newline
- (> (point-max) (point-min))
- (let ((tick (buffer-chars-modified-tick)))
- (delete-region (1- (point-max)) (point-max))
- (equal tick company-added-newline))
- ;; Only set unmodified when tick remained the same since insert,
- ;; and the buffer wasn't modified before.
- (set-buffer-modified-p nil))
(unwind-protect
(when company-prefix
(if (stringp 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
+ (setq company-backend nil
company-prefix nil
company-candidates nil
company-candidates-length nil
(defun company-pre-command ()
(unless (company-keep this-command)
- (condition-case err
+ (condition-case-unless-debug err
(when company-candidates
(company-call-frontends 'pre-command)
(unless (company--should-continue)
(company-uninstall-map))
(defun company-post-command ()
+ (when (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',
+ ;; or any quittable timer function.
+ (company-abort)
+ (setq this-command 'company-abort))
(unless (company-keep this-command)
- (condition-case err
+ (condition-case-unless-debug err
(progn
(unless (equal (point) company-point)
- (let ((company-idle-delay (and (eq company-idle-delay t)
- (company--should-begin)
- t)))
+ (let (company-idle-delay) ; Against misbehavior while debugging.
(company--perform)))
(if company-candidates
(company-call-frontends 'post-command)
(defun company-search-printing-char ()
(interactive)
(company-search-assert-enabled)
- (setq company-search-string
- (concat (or company-search-string "") (string last-command-event))
- company-search-lighter (concat " Search: \"" company-search-string
- "\""))
- (let ((pos (company-search company-search-string
- (nthcdr company-selection company-candidates))))
+ (let* ((ss (concat company-search-string (string last-command-event)))
+ (pos (company-search ss (nthcdr company-selection company-candidates))))
(if (null pos)
(ding)
+ (setq company-search-string ss
+ company-search-lighter (concat " Search: \"" ss "\""))
(company-set-selection (+ company-selection pos) t))))
(defun company-search-repeat-forward ()
(company-set-selection (- company-selection pos 1) t))))
(defun company-create-match-predicate ()
- (setq company-candidates-predicate
- `(lambda (candidate)
- ,(if company-candidates-predicate
- `(and (string-match ,company-search-string candidate)
- (funcall ,company-candidates-predicate
- candidate))
- `(string-match ,company-search-string candidate))))
+ (let ((ss company-search-string))
+ (setq company-candidates-predicate
+ (when ss (lambda (candidate) (string-match ss candidate)))))
(company-update-candidates
(company-apply-predicate company-candidates company-candidates-predicate))
;; Invalidate cache.
(>= evt-row (+ row height)))))))
(defun company--event-col-row (event)
- (let* ((col-row (posn-actual-col-row (event-start event)))
- (col (car col-row))
- (row (cdr col-row)))
- (cl-incf col (window-hscroll))
- (and header-line-format
- (version< "24" emacs-version)
- (cl-decf row))
- (cons col row)))
+ (company--posn-col-row (event-start event)))
(defun company-select-mouse (event)
"Select the candidate picked by the mouse."
(setq this-command 'company-complete-common))))
(defun company-complete-number (n)
- "Insert the Nth candidate.
+ "Insert the Nth candidate visible in the tooltip.
To show the number next to the candidates in some back-ends, enable
-`company-show-numbers'."
+`company-show-numbers'. When called interactively, uses the last typed
+character, stripping the modifiers. That character must be a digit."
+ (interactive
+ (list (let* ((type (event-basic-type last-command-event))
+ (char (if (characterp type)
+ ;; Number on the main row.
+ type
+ ;; Keypad number, if bound directly.
+ (car (last (string-to-list (symbol-name type))))))
+ (n (- char ?0)))
+ (if (zerop n) 10 n))))
(when (company-manual-begin)
- (and (or (< n 1) (> n company-candidates-length))
+ (and (or (< n 1) (> n (- company-candidates-length
+ company-tooltip-offset)))
(error "No candidate number %d" n))
(cl-decf n)
- (company-finish (nth n company-candidates))))
+ (company-finish (nth (+ n company-tooltip-offset)
+ company-candidates))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-fill-propertize (value annotation width selected left right)
(let* ((margin (length left))
- (common (+ (or (company-call-backend 'match value)
- (length company-common)) margin))
+ (common (or (company-call-backend 'match value)
+ (if company-common
+ (string-width company-common)
+ 0)))
(ann-ralign company-tooltip-align-annotations)
+ (value (company--clean-string value))
(ann-truncate (< width
(+ (length value) (length annotation)
(if ann-ralign 1 0))))
(- width (length annotation)))
annotation))
right)))
+ (setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
(add-text-properties 0 width '(face company-tooltip
(length company-prefix)))
(let ((beg (+ margin (match-beginning 0)))
(end (+ margin (match-end 0))))
- (add-text-properties beg end '(face company-tooltip-selection)
+ (add-text-properties beg end '(face company-tooltip-search)
line)
(when (< beg common)
(add-text-properties beg common
line)))
line))
+(defun company--clean-string (str)
+ (replace-regexp-in-string
+ "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
+ (lambda (match)
+ (cond
+ ((match-beginning 1)
+ ;; FIXME: Better char for 'non-printable'?
+ ;; We shouldn't get any of these, but sometimes we might.
+ "\u2017")
+ ((match-beginning 2)
+ ;; Zero-width non-breakable space.
+ "")
+ ((> (string-width match) 1)
+ (concat
+ (make-string (1- (string-width match)) ?\ufeff)
+ match))
+ (t match)))
+ str))
+
;;; replace
(defun company-buffer-lines (beg end)
(goto-char beg)
- (let (lines)
- (while (and (= 1 (vertical-motion 1))
+ (let (lines lines-moved)
+ (while (and (> (setq lines-moved (vertical-motion 1)) 0)
(<= (point) end))
(let ((bound (min end (1- (point)))))
;; A visual line can contain several physical lines (e.g. with outline's
(re-search-forward "$" bound 'move)
(point)))
lines))
+ ;; One physical line can be displayed as several visual ones as well:
+ ;; add empty strings to the list, to even the count.
+ (dotimes (_ (1- lines-moved))
+ (push "" lines))
(setq beg (point)))
(unless (eq beg end)
(push (buffer-substring beg end) lines))
limit
(length lst)))
+(defsubst company--window-height ()
+ (if (fboundp 'window-screen-lines)
+ (floor (window-screen-lines))
+ (window-body-height)))
+
+(defsubst company--window-width ()
+ (let ((ww (window-body-width)))
+ ;; Account for the line continuation column.
+ (when (zerop (cadr (window-fringes)))
+ (cl-decf ww))
+ (unless (or (display-graphic-p)
+ (version< "24.3.1" emacs-version))
+ ;; Emacs 24.3 and earlier included margins
+ ;; in window-width when in TTY.
+ (cl-decf ww
+ (let ((margins (window-margins)))
+ (+ (or (car margins) 0)
+ (or (cdr margins) 0)))))
+ ww))
+
(defun company--replacement-string (lines old column nl &optional align-top)
(cl-decf column company-tooltip-margin)
(while old
(push (company-modify-line (pop old)
(company--offset-line (pop lines) offset)
- column) new))
+ column)
+ new))
;; Append whole new lines.
(while lines
(push (concat (company-space-string column)
(company--offset-line (pop lines) offset))
new))
- (let ((str (concat (when nl "\n")
+ (let ((str (concat (when nl " ")
+ "\n"
(mapconcat 'identity (nreverse new) "\n")
"\n")))
(font-lock-append-text-property 0 (length str) 'face 'default str)
+ (when nl (put-text-property 0 1 'cursor t str))
str)))
(defun company--offset-line (line offset)
(defun company--create-lines (selection limit)
(let ((len company-candidates-length)
- (numbered 99999)
(window-width (company--window-width))
lines
width
;; `lisp-completion-at-point' adds a space.
(setq annotation (comment-string-strip annotation t nil)))
(push (cons value annotation) items)
- (setq width (max (+ (length value)
+ (setq width (max (+ (string-width value)
(if (and annotation company-tooltip-align-annotations)
(1+ (length annotation))
(length annotation)))
(setq width (min window-width
(max company-tooltip-minimum-width
- (if (and company-show-numbers
- (< company-tooltip-offset 10))
+ (if company-show-numbers
(+ 2 width)
width))))
- ;; number can make tooltip too long
- (when company-show-numbers
- (setq numbered company-tooltip-offset))
-
- (let ((items (nreverse items)) new)
+ (let ((items (nreverse items))
+ (numbered (if company-show-numbers 0 99999))
+ new)
(when previous
(push (company--scrollpos-line previous width) new))
;; show
-(defsubst company--window-inner-height ()
- (let ((edges (window-inside-edges)))
- (- (nth 3 edges) (nth 1 edges))))
-
-(defsubst company--window-width ()
- (let ((ww (window-width)))
- ;; Account for the line continuation column.
- (when (zerop (cadr (window-fringes)))
- (cl-decf ww))
- (unless (or (display-graphic-p)
- (version< "24.3.1" emacs-version))
- ;; Emacs 24.3 and earlier included margins
- ;; in window-width when in TTY.
- (cl-decf ww
- (let ((margins (window-margins)))
- (+ (or (car margins) 0)
- (or (cdr margins) 0)))))
- ww))
-
(defun company--pseudo-tooltip-height ()
"Calculate the appropriate tooltip height.
Returns a negative number if the tooltip should be displayed above point."
(let* ((lines (company--row))
- (below (- (company--window-inner-height) 1 lines)))
+ (below (- (company--window-height) 1 lines)))
(if (and (< below (min company-tooltip-minimum company-candidates-length))
(> lines below))
(- (max 3 (min company-tooltip-limit lines)))
(end (save-excursion
(move-to-window-line (+ row (abs height)))
(point)))
- (ov (make-overlay beg end))
+ (ov (make-overlay (if nl beg (1- beg)) end nil t t))
(args (list (mapcar 'company-plainify
(company-buffer-lines beg end))
column nl above)))
(overlay-put ov 'company-replacement-args args)
(let ((lines (company--create-lines selection (abs height))))
- (overlay-put ov 'company-after
+ (overlay-put ov 'company-display
(apply 'company--replacement-string lines args))
(overlay-put ov 'company-width (string-width (car lines))))
(overlay-put ov 'company-column column)
(overlay-put ov 'company-height height)))))
-(defun company-pseudo-tooltip-show-at-point (pos)
- (let ((row (company--row pos))
- (col (company--column pos)))
- (company-pseudo-tooltip-show (1+ row) col company-selection)))
+(defun company-pseudo-tooltip-show-at-point (pos column-offset)
+ (let* ((col-row (company--col-row pos))
+ (col (- (car col-row) column-offset)))
+ (when (< col 0) (setq col 0))
+ (company-pseudo-tooltip-show (1+ (cdr col-row)) col company-selection)))
(defun company-pseudo-tooltip-edit (selection)
(let* ((height (overlay-get company-pseudo-tooltip-overlay 'company-height))
(lines (company--create-lines selection (abs height))))
(overlay-put company-pseudo-tooltip-overlay 'company-width
(string-width (car lines)))
- (overlay-put company-pseudo-tooltip-overlay 'company-after
+ (overlay-put company-pseudo-tooltip-overlay 'company-display
(apply 'company--replacement-string
lines
(overlay-get company-pseudo-tooltip-overlay
(defun company-pseudo-tooltip-hide-temporarily ()
(when (overlayp company-pseudo-tooltip-overlay)
(overlay-put company-pseudo-tooltip-overlay 'invisible nil)
- (overlay-put company-pseudo-tooltip-overlay 'line-prefix nil)
(overlay-put company-pseudo-tooltip-overlay 'after-string nil)))
(defun company-pseudo-tooltip-unhide ()
(when company-pseudo-tooltip-overlay
- (overlay-put company-pseudo-tooltip-overlay 'invisible t)
- ;; Beat outline's folding overlays, at least.
- (overlay-put company-pseudo-tooltip-overlay 'priority 1)
- ;; No (extra) prefix for the first line.
- (overlay-put company-pseudo-tooltip-overlay 'line-prefix "")
- (overlay-put company-pseudo-tooltip-overlay 'after-string
- (overlay-get company-pseudo-tooltip-overlay 'company-after))
- (overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
+ (let* ((ov company-pseudo-tooltip-overlay)
+ (disp (overlay-get ov 'company-display)))
+ ;; Beat outline's folding overlays, at least.
+ (overlay-put ov 'priority 1)
+ ;; `display' could be better (http://debbugs.gnu.org/18285), but it
+ ;; doesn't work when the overlay is empty, which is what happens at eob.
+ ;; It also seems to interact badly with `cursor'.
+ ;; We deal with priorities by having the overlay start before the newline.
+ (overlay-put ov 'after-string disp)
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'window (selected-window)))))
(defun company-pseudo-tooltip-guard ()
- (buffer-substring-no-properties
- (point) (overlay-start company-pseudo-tooltip-overlay)))
+ (cons
+ (save-excursion (beginning-of-visual-line))
+ (let ((ov company-pseudo-tooltip-overlay)
+ (overhang (save-excursion (end-of-visual-line)
+ (- (line-end-position) (point)))))
+ (when (>= (overlay-get ov 'company-height) 0)
+ (cons
+ (buffer-substring-no-properties (point) (overlay-start ov))
+ (when (>= overhang 0) overhang))))))
(defun company-pseudo-tooltip-frontend (command)
"`company-mode' front-end similar to a tooltip but based on overlays."
(cl-case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
- (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))
- (equal (company-pseudo-tooltip-guard)
- (overlay-get company-pseudo-tooltip-overlay
- 'company-guard)))
- ;; Redraw needed.
- (company-pseudo-tooltip-show-at-point (- (point)
- (length company-prefix)))
- (overlay-put company-pseudo-tooltip-overlay
- 'company-guard (company-pseudo-tooltip-guard))))
+ (unless (when (overlayp company-pseudo-tooltip-overlay)
+ (let* ((ov company-pseudo-tooltip-overlay)
+ (old-height (overlay-get ov 'company-height))
+ (new-height (company--pseudo-tooltip-height)))
+ (and
+ (>= (* old-height new-height) 0)
+ (>= (abs old-height) (abs new-height))
+ (equal (company-pseudo-tooltip-guard)
+ (overlay-get ov 'company-guard)))))
+ ;; Redraw needed.
+ (company-pseudo-tooltip-show-at-point (point) (length company-prefix))
+ (overlay-put company-pseudo-tooltip-overlay
+ 'company-guard (company-pseudo-tooltip-guard)))
(company-pseudo-tooltip-unhide))
(hide (company-pseudo-tooltip-hide)
(setq company-tooltip-offset 0))
(defun company-preview-show-at-point (pos)
(company-preview-hide)
- (setq company-preview-overlay (make-overlay pos (1+ pos)))
+ (setq company-preview-overlay (make-overlay pos pos))
(let ((completion (nth company-selection company-candidates)))
(setq completion (propertize completion 'face 'company-preview))
(not (equal completion ""))
(add-text-properties 0 1 '(cursor t) completion))
- (overlay-put company-preview-overlay 'display
- (concat completion (unless (eq pos (point-max))
- (buffer-substring pos (1+ pos)))))
- (overlay-put company-preview-overlay 'window (selected-window))))
+ (let ((ov company-preview-overlay))
+ (overlay-put ov 'after-string completion)
+ (overlay-put ov 'window (selected-window)))))
(defun company-preview-hide ()
(when company-preview-overlay
(defun company--show-inline-p ()
(and (not (cdr company-candidates))
company-common
- (string-prefix-p company-prefix company-common
- (company-call-backend 'ignore-case))))
+ (or (eq (company-call-backend 'ignore-case) 'keep-prefix)
+ (string-prefix-p company-prefix company-common))))
;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-echo-format ()
- (let ((limit (window-width (minibuffer-window)))
+ (let ((limit (window-body-width (minibuffer-window)))
(len -1)
;; Roll to selection.
(candidates (nthcdr company-selection company-candidates))
(defun company-echo-strip-common-format ()
- (let ((limit (window-width (minibuffer-window)))
+ (let ((limit (window-body-width (minibuffer-window)))
(len (+ (length company-prefix) 2))
;; Roll to selection.
(candidates (nthcdr company-selection company-candidates))