(defvar company-candidates nil)
(make-variable-buffer-local 'company-candidates)
+(defvar company-candidates-length nil)
+(make-variable-buffer-local 'company-candidates-length)
+
(defvar company-candidates-cache nil)
(make-variable-buffer-local 'company-candidates-cache)
(defsubst company-call-frontends (command)
(dolist (frontend company-frontends)
- (funcall frontend command)))
+ (condition-case err
+ (funcall frontend command)
+ (error (error "Company: Front-end %s error \"%s\" on command %s"
+ frontend (error-message-string err) command)))))
(defsubst company-set-selection (selection &optional force-update)
- (setq selection (max 0 (min (1- (length company-candidates)) selection)))
+ (setq selection (max 0 (min (1- company-candidates-length) selection)))
(when (or force-update (not (equal selection company-selection)))
(setq company-selection selection
company-selection-changed t)
(nreverse new)))
(defun company-update-candidates (candidates)
+ (setq company-candidates-length (length candidates))
(if (> company-selection 0)
;; Try to restore the selection
(let ((selected (nth company-selection company-candidates)))
(incf company-selection))
(unless candidates
;; Make sure selection isn't out of bounds.
- (setq company-selection (min (1- (length company-candidates))
+ (setq company-selection (min (1- company-candidates-length)
company-selection)))))
(setq company-selection 0
company-candidates candidates))
(setq company-prefix prefix)
(company-update-candidates
(or (cdr (assoc prefix company-candidates-cache))
- (let ((len (length prefix))
- (completion-ignore-case (funcall company-backend 'ignore-case))
- prev)
- (dotimes (i len)
- (when (setq prev (cdr (assoc (substring prefix 0 (- len i))
- company-candidates-cache)))
- (return (all-completions prefix prev)))))
+ (when company-candidates-cache
+ (let ((len (length prefix))
+ (completion-ignore-case (funcall company-backend 'ignore-case))
+ prev)
+ (dotimes (i len)
+ (when (setq prev (cdr (assoc (substring prefix 0 (- len i))
+ company-candidates-cache)))
+ (return (all-completions prefix prev))))))
(let ((candidates (funcall company-backend 'candidates prefix)))
- (and company-candidates-predicate
- (setq candidates
- (company-apply-predicate candidates
- company-candidates-predicate)))
+ (when company-candidates-predicate
+ (setq candidates
+ (company-apply-predicate candidates
+ company-candidates-predicate)))
(unless (funcall company-backend 'sorted)
(setq candidates (sort candidates 'string<)))
candidates)))
(defun company-continue ()
(when company-candidates
- (when (funcall company-backend 'no-cache)
+ (when (funcall company-backend 'no-cache company-prefix)
;; Don't complete existing candidates, fetch new ones.
(setq company-candidates-cache nil))
(let ((new-prefix (funcall company-backend 'prefix)))
(setq company-backend nil
company-prefix nil
company-candidates nil
+ company-candidates-length nil
company-candidates-cache nil
company-candidates-predicate nil
company-common nil
(defun company-search-repeat-backward ()
(interactive)
(let ((pos (company-search company-search-string
- (nthcdr (- (length company-candidates)
+ (nthcdr (- company-candidates-length
company-selection)
(reverse company-candidates)))))
(if (null pos)
;;; propertize
+(defsubst company-round-tab (arg)
+ (* (/ (+ arg tab-width) tab-width) tab-width))
+
+(defun company-untabify (str)
+ (let* ((pieces (split-string str "\t"))
+ (copy pieces))
+ (while (cdr copy)
+ (setcar copy (company-safe-substring
+ (car copy) 0 (company-round-tab (string-width (car copy)))))
+ (pop copy))
+ (apply 'concat pieces)))
+
(defun company-fill-propertize (line width selected)
(setq line (company-safe-substring line 0 width))
(add-text-properties 0 width (list 'face 'company-tooltip) line)
(mapconcat 'identity (nreverse new) "\n")
"\n")))
-(defun company-create-lines (column lines selection limit)
+(defun company-create-lines (column selection limit)
- (let ((len (length lines))
+ (let ((len company-candidates-length)
+ lines
width
lines-copy
previous
(decf selection company-tooltip-offset)
(setq width (min (length previous) (length remainder))
- lines (nthcdr company-tooltip-offset lines)
- len (min limit (length lines))
+ lines (nthcdr company-tooltip-offset company-candidates)
+ len (min limit len)
lines-copy lines)
(dotimes (i len)
(defsubst company-pseudo-tooltip-height ()
"Calculate the appropriate tooltip height."
(max 3 (min company-tooltip-limit
- (- (window-height) (cdr (posn-col-row (posn-at-point))) 2))))
+ (- (window-height) 2
+ (count-lines (window-start) (point-at-bol))))))
-(defun company-pseudo-tooltip-show (row column lines selection)
+(defun company-pseudo-tooltip-show (row column selection)
(company-pseudo-tooltip-hide)
- (unless lines (error "No text provided"))
(save-excursion
(move-to-column 0)
(let* ((height (company-pseudo-tooltip-height))
- (lines (company-create-lines column lines selection 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 (company-buffer-lines beg end))
+ (old-string
+ (mapcar 'company-untabify (company-buffer-lines beg end)))
str)
(setq company-pseudo-tooltip-overlay (make-overlay beg end))
(defun company-pseudo-tooltip-show-at-point (pos)
(let ((col-row (posn-col-row (posn-at-point pos))))
- (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
- company-candidates company-selection)))
+ (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 lines selection height)))
+ (lines (company-create-lines column selection height)))
(overlay-put company-pseudo-tooltip-overlay 'company-before
(company-replacement-string old-string lines column nl))))
(defvar company-echo-last-msg nil)
(make-variable-buffer-local 'company-echo-last-msg)
-(defun company-echo-refresh ()
+(defvar company-echo-timer nil)
+
+(defvar company-echo-delay .1)
+
+(defun company-echo-show (&optional getter)
+ (when getter
+ (setq company-echo-last-msg (funcall getter)))
(let ((message-log-max nil))
(if company-echo-last-msg
(message "%s" company-echo-last-msg)
(message ""))))
-(defun company-echo-show (candidates)
+(defsubst company-echo-show-soon (&optional getter)
+ (when company-echo-timer
+ (cancel-timer company-echo-timer))
+ (setq company-echo-timer (run-with-timer company-echo-delay nil
+ 'company-echo-show getter)))
- ;; Roll to selection.
- (setq candidates (nthcdr company-selection candidates))
+(defun company-echo-format ()
(let ((limit (window-width (minibuffer-window)))
(len -1)
+ ;; Roll to selection.
+ (candidates (nthcdr company-selection company-candidates))
comp msg)
+
(while candidates
(setq comp (company-reformat (pop candidates))
len (+ len 1 (length comp)))
'(face company-echo-common) comp)
(push comp msg)))
- (setq company-echo-last-msg (mapconcat 'identity (nreverse msg) " "))
- (company-echo-refresh)))
+ (mapconcat 'identity (nreverse msg) " ")))
+
+(defun company-echo-hide ()
+ (when company-echo-timer
+ (cancel-timer company-echo-timer))
+ (setq company-echo-last-msg "")
+ (company-echo-show))
(defun company-echo-frontend (command)
(case command
- ('pre-command (company-echo-refresh))
- ('post-command (company-echo-show company-candidates))
- ('hide (setq company-echo-last-msg nil))))
+ ('pre-command (company-echo-show-soon))
+ ('post-command (company-echo-show-soon 'company-echo-format))
+ ('hide (company-echo-hide))))
(defun company-echo-metadata-frontend (command)
(case command
- ('pre-command (company-echo-refresh))
- ('post-command (setq company-echo-last-msg (company-fetch-metadata))
- (company-echo-refresh))
- ('hide (setq company-echo-last-msg nil))))
-
+ ('pre-command (company-echo-show-soon))
+ ('post-command (company-echo-show-soon 'company-fetch-metadata))
+ ('hide (company-echo-hide))))
(provide 'company)
;;; company.el ends here