(function :tag "custom function" nil))))
(defcustom company-backends '(company-elisp company-nxml company-css
- company-ispell)
+ company-semantic company-oddmuse company-ispell)
"*"
:group 'company
:type '(repeat (function :tag "function" nil)))
(define-key keymap (kbd "M-n") 'company-select-next)
(define-key keymap (kbd "M-p") 'company-select-previous)
(define-key keymap (kbd "M-<return>") 'company-complete-selection)
- (define-key keymap "\t" 'company-complete-common)
+ (define-key keymap "\t" 'company-complete)
keymap))
;;;###autoload
(defvar company-candidates nil)
(make-variable-buffer-local 'company-candidates)
+(defvar company-candidates-cache nil)
+(make-variable-buffer-local 'company-candidates-cache)
+
(defvar company-common nil)
(make-variable-buffer-local 'company-common)
(dolist (frontend company-frontends)
(funcall frontend command)))
+(defsubst company-calculate-candidates (prefix)
+ (or (setq company-candidates (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)))
+ (setq company-candidates (all-completions prefix prev))
+ (return t))))
+ (progn
+ (setq company-candidates (funcall company-backend 'candidates prefix))
+ (unless (funcall company-backend 'sorted)
+ (setq company-candidates (sort company-candidates 'string<)))))
+ (unless (assoc prefix company-candidates-cache)
+ (push (cons prefix company-candidates) company-candidates-cache))
+ (setq company-selection 0
+ company-prefix prefix)
+ (let ((completion-ignore-case (funcall company-backend 'ignore-case)))
+ (setq company-common (try-completion company-prefix company-candidates)))
+ (when (eq company-common t)
+ (setq company-candidates nil))
+ company-candidates)
+
(defun company-idle-begin ()
(and company-mode
(not company-candidates)
;; Return non-nil if active.
company-candidates)
-(defun company-continue-or-cancel ()
+(defun company-continue ()
(when company-candidates
- (let ((old-point (- company-point (length company-prefix)))
- (company-idle-delay t)
- (company-minimum-prefix-length 0))
- ;; TODO: Make more efficient.
- (setq company-candidates nil)
- (company-begin)
- (unless (and company-candidates
- (equal old-point (- company-point (length company-prefix))))
- (company-cancel))
- company-candidates)))
+ (let ((new-prefix (funcall company-backend 'prefix)))
+ (unless (and (= (- (point) (length new-prefix))
+ (- company-point (length company-prefix)))
+ (or (equal company-prefix new-prefix)
+ (company-calculate-candidates new-prefix)))
+ (setq company-candidates nil)))))
(defun company-begin ()
- (or (company-continue-or-cancel)
- (let (prefix)
- (dolist (backend company-backends)
- (unless (fboundp backend)
- (ignore-errors (require backend nil t)))
- (if (fboundp backend)
- (when (setq prefix (funcall backend 'prefix))
- (when (company-should-complete prefix)
- (setq company-backend backend
- company-prefix prefix
- company-candidates
- (funcall company-backend 'candidates prefix)
- company-common
- (let ((completion-ignore-case (funcall backend
- 'ignore-case)))
- (try-completion prefix company-candidates))
- company-selection 0
- company-point (point))
- (unless (funcall company-backend 'sorted)
- (setq company-candidates
- (sort company-candidates 'string<)))
- (company-call-frontends 'update))
- (return prefix))
- (unless (memq backend company-disabled-backends)
- (push backend company-disabled-backends)
- (message "Company back-end '%s' could not be initialized"
- backend))))
- (unless (and company-candidates
- (not (eq t company-common)))
- (company-cancel)))))
+ (company-continue)
+ (unless company-candidates
+ (let (prefix)
+ (dolist (backend company-backends)
+ (unless (fboundp backend)
+ (ignore-errors (require backend nil t)))
+ (if (fboundp backend)
+ (when (setq prefix (funcall backend 'prefix))
+ (when (company-should-complete prefix)
+ (setq company-backend backend)
+ (company-calculate-candidates prefix))
+ (return prefix))
+ (unless (memq backend company-disabled-backends)
+ (push backend company-disabled-backends)
+ (message "Company back-end '%s' could not be initialized"
+ backend))))))
+ (if company-candidates
+ (progn
+ (setq company-point (point))
+ (company-call-frontends 'update))
+ (company-cancel)))
(defun company-cancel ()
(setq company-backend nil
company-prefix nil
company-candidates nil
+ company-candidates-cache nil
company-common nil
company-selection 0
company-selection-changed nil
(when (company-manual-begin)
(setq company-selection (min (1- (length company-candidates))
(1+ company-selection))
- company-selection-changed t)))
+ company-selection-changed t))
+ (company-call-frontends 'update))
(defun company-select-previous ()
(interactive)
(when (company-manual-begin)
(setq company-selection (max 0 (1- company-selection))
- company-selection-changed t)))
+ company-selection-changed t))
+ (company-call-frontends 'update))
(defun company-complete-selection ()
(interactive)
(when (company-manual-begin)
(insert (company-strip-prefix company-common))))
+(defun company-complete ()
+ (interactive)
+ (when (company-manual-begin)
+ (if (or company-selection-changed
+ (eq last-command 'company-complete-common))
+ (call-interactively 'company-complete-selection)
+ (call-interactively 'company-complete-common)
+ (setq this-command 'company-complete-common))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst company-space-strings-limit 100)
(defvar company-tooltip-offset 0)
(make-variable-buffer-local 'company-tooltip-offset)
+(defun company-pseudo-tooltip-update-offset (selection num-lines limit)
+
+ (decf limit 2)
+ (setq company-tooltip-offset
+ (max (min selection company-tooltip-offset)
+ (- selection -1 limit)))
+
+ (when (<= company-tooltip-offset 1)
+ (incf limit)
+ (setq company-tooltip-offset 0))
+
+ (when (>= company-tooltip-offset (- num-lines limit 1))
+ (incf limit)
+ (when (= selection (1- num-lines))
+ (setq company-tooltip-offset (max (1- company-tooltip-offset) 0))))
+
+ limit)
+
;;; propertize
(defun company-fill-propertize (line width selected)
new
(company-safe-substring old (+ offset (length new)))))
-(defun company-modified-substring (beg end lines column nl)
- (let ((old (company-buffer-lines beg end))
- new)
+(defun company-replacement-string (old lines column nl)
+ (let (new)
;; Inject into old lines.
(while old
(push (company-modify-line (pop old) (pop lines) column) new))
(mapconcat 'identity (nreverse new) "\n")
"\n")))
-;; show
+(defun company-create-lines (column lines selection)
-(defun company-pseudo-tooltip-show (row column lines selection)
- (company-pseudo-tooltip-hide)
- (unless lines (error "No text provided"))
- (save-excursion
+ (let ((limit (max company-tooltip-limit 3))
+ (len (length lines))
+ width
+ lines-copy
+ previous
+ remainder
+ new)
;; Scroll to offset.
- (setq company-tooltip-offset
- (max (min selection company-tooltip-offset)
- (- selection -1 company-tooltip-limit)))
+ (setq limit (company-pseudo-tooltip-update-offset selection len limit))
+
+ (when (> company-tooltip-offset 0)
+ (setq previous (format "...(%d)" company-tooltip-offset)))
+
+ (setq remainder (- len limit company-tooltip-offset)
+ remainder (when (> remainder 0)
+ (setq remainder (format "...(%d)" remainder))))
- (setq lines (nthcdr company-tooltip-offset lines))
(decf selection company-tooltip-offset)
+ (setq width (min (length previous) (length remainder))
+ lines (nthcdr company-tooltip-offset lines)
+ len (min limit (length lines))
+ lines-copy lines)
+
+ (dotimes (i len)
+ (setq width (max (length (pop lines-copy)) width)))
+ (setq width (min width (- (window-width) column)))
+
+ (when previous
+ (push (propertize (company-safe-substring previous 0 width)
+ 'face 'company-tooltip)
+ new))
- (let ((width 0)
- (lines-copy lines)
- (len (min company-tooltip-limit (length lines)))
- new)
- (dotimes (i len)
- (setq width (max (length (pop lines-copy)) width)))
- (setq width (min width (- (window-width) column)))
- (dotimes (i len)
- (push (company-fill-propertize (company-reformat (pop lines))
- width (equal i selection))
- new))
+ (dotimes (i len)
+ (push (company-fill-propertize (company-reformat (pop lines))
+ width (equal i selection))
+ new))
+
+ (when remainder
+ (push (propertize (company-safe-substring remainder 0 width)
+ 'face 'company-tooltip)
+ new))
+
+ (setq lines (nreverse new))))
+
+;; show
- (setq lines (nreverse new)))
+(defun company-pseudo-tooltip-show (row column lines selection)
+ (company-pseudo-tooltip-hide)
+ (unless lines (error "No text provided"))
+ (save-excursion
(move-to-column 0)
- (let ((nl (< (move-to-window-line row) row))
- (beg (point))
- (end (save-excursion
- (move-to-window-line (min (window-height)
- (+ row company-tooltip-limit)))
- (point)))
- str)
+ (let* ((lines (company-create-lines column lines selection))
+ (nl (< (move-to-window-line row) row))
+ (beg (point))
+ (end (save-excursion
+ (move-to-window-line (min (window-height)
+ (+ row company-tooltip-limit)))
+ (point)))
+ (old-string (company-buffer-lines beg end))
+ str)
(setq company-pseudo-tooltip-overlay (make-overlay beg end))
- (overlay-put company-pseudo-tooltip-overlay 'before-string
- (company-modified-substring beg end lines column nl))
- (overlay-put company-pseudo-tooltip-overlay 'invisible t)
+ (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 'window (selected-window)))))
(defun company-pseudo-tooltip-show-at-point (pos)
(company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
company-candidates 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))
+ (lines (company-create-lines column lines selection)))
+ (overlay-put company-pseudo-tooltip-overlay 'company-before
+ (company-replacement-string old-string lines column nl))))
+
(defun company-pseudo-tooltip-hide ()
(when company-pseudo-tooltip-overlay
(delete-overlay company-pseudo-tooltip-overlay)
(setq company-pseudo-tooltip-overlay nil)))
+(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 'before-string nil)))
+
+(defun company-pseudo-tooltip-unhide ()
+ (when company-pseudo-tooltip-overlay
+ (overlay-put company-pseudo-tooltip-overlay 'invisible t)
+ (overlay-put company-pseudo-tooltip-overlay 'before-string
+ (overlay-get company-pseudo-tooltip-overlay 'company-before))))
+
(defun company-pseudo-tooltip-frontend (command)
(case command
- ('pre-command (company-pseudo-tooltip-hide))
- ('post-command (company-pseudo-tooltip-show-at-point
- (- (point) (length company-prefix))))
+ ('pre-command (company-pseudo-tooltip-hide-temporarily))
+ ('post-command
+ (unless (overlayp company-pseudo-tooltip-overlay)
+ (company-pseudo-tooltip-show-at-point (- (point)
+ (length company-prefix))))
+ (company-pseudo-tooltip-unhide))
('hide (company-pseudo-tooltip-hide)
- (setq company-tooltip-offset 0))))
+ (setq company-tooltip-offset 0))
+ ('update (when (overlayp company-pseudo-tooltip-overlay)
+ (company-pseudo-tooltip-edit company-candidates
+ company-selection)))))
(defun company-pseudo-tooltip-unless-just-one-frontend (command)
(unless (and (eq command 'post-command)