;; Copyright (C) 2009 Nikolaj Schumacher
;;
;; Author: Nikolaj Schumacher <bugs * nschum de>
-;; Version: 0.3.1
+;; Version: 0.4.1
;; Keywords: abbrev, convenience, matchis
;; URL: http://nschum.de/src/emacs/company/
;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
;;
;;; Change Log:
;;
+;; 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.
(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-semantic . "CEDET Semantic")
(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-xcode
+ (company-gtags company-etags company-dabbrev-code
+ 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
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))
(functionp backend))
(if (ignore-errors (funcall backend 'init) t)
(put backend 'company-init t)
- (message "Company back-end '%s' could not be initialized"
- backend))
+ (put backend 'company-init 'failed)
+ (unless (memq backend company--disabled-backends)
+ (message "Company back-end '%s' could not be initialized"
+ backend)
+ (push backend company--disabled-backends))
+ nil)
(mapc 'company-init-backend backend)))
;;;###autoload
(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)
;; 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)
(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)
(defvar company--point-max nil)
(make-variable-buffer-local 'company--point-max)
-(defvar company--this-command nil)
-
(defvar company-point nil)
(make-variable-buffer-local 'company-point)
overriding-local-map))
(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))))
(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.
(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)
+(defun company-manual-begin ()
+ (interactive)
+ (setq company--explicit-action t)
+ (company-auto-begin))
+
(defun company-require-match-p ()
(let ((backend-value (company-call-backend 'require-match)))
(or (eq backend-value t)
(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)))
(= (- (point) (length new-prefix))
(- company-point (length company-prefix))))
(company-calculate-candidates new-prefix))))
- (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)))))
+ (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)
(if (or (symbolp backend)
(functionp backend))
(when (or (not (symbolp backend))
- (get backend 'company-init))
+ (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 (and (stringp prefix)
(>= (length prefix) company-minimum-prefix-length))
(setq company-backend backend
- company-prefix prefix
c (company-calculate-candidates prefix))
;; t means complete/unique. We don't start, so no hooks.
(when (consp c)
+ (setq company-prefix prefix)
(company-update-candidates c)
(run-hook-with-args 'company-completion-started-hook
(company-explicit-action-p))
(setq company-candidates
(or (and company-candidates (company--continue))
(and (company--should-complete) (company--begin-new))))
- (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--point-max (point-max))
- (company-enable-overriding-keymap company-active-map)
- (company-call-frontends 'update))
- (company-cancel)))
+ (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
(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))))
(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))
`(when (company-manual-begin)
(save-window-excursion
(let ((height (window-height))
- (row (cdr (posn-actual-col-row (posn-at-point)))))
+ (row (company--row)))
,@body
(and (< (window-height) height)
(< (- (window-height) row 2) company-tooltip-limit)
(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))
(overlay-put company-pseudo-tooltip-overlay '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))))