+;;; company.el --- extensible inline text completion mechanism
+;;
+;; Copyright (C) 2009 Nikolaj Schumacher
+;;
+;; Author: Nikolaj Schumacher <bugs * nschum de>
+;; Version:
+;; Keywords: abbrev, convenience, matchis
+;; URL: http://nschum.de/src/emacs/company/
+;; Compatibility: GNU Emacs 23.x
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;;; Change Log:
+;;
+;; Initial release.
+;;
+;;; Code:
+
(eval-when-compile (require 'cl))
(add-to-list 'debug-ignored-errors
"^Pseudo tooltip frontend cannot be used twice$")
(add-to-list 'debug-ignored-errors "^Preview frontend cannot be used twice$")
+(add-to-list 'debug-ignored-errors "^Echo area cannot be used twice$")
+(add-to-list 'debug-ignored-errors "^No documentation available$")
(defgroup company nil
""
(and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-frontend value)
(error "Preview frontend cannot be used twice"))
+ (and (memq 'company-echo value)
+ (memq 'company-echo-metadata-frontend value)
+ (error "Echo area cannot be used twice"))
;; preview must come last
(dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
(when (memq f value)
(setq value (append (delq f value) (list f)))))
(set variable value))
-(defcustom company-frontends '(company-echo-frontend
- company-pseudo-tooltip-unless-just-one-frontend
- company-preview-if-just-one-frontend)
+(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
+ company-preview-if-just-one-frontend
+ company-echo-metadata-frontend)
"*"
:set 'company-frontends-set
:group 'company
(function :tag "custom function" nil))))
(defcustom company-backends '(company-elisp company-nxml company-css
- company-ispell)
+ company-semantic company-oddmuse
+ company-dabbrev)
"*"
:group 'company
:type '(repeat (function :tag "function" nil)))
;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar company-mode-map
+(defvar company-current-map (make-sparse-keymap))
+
+(defvar company-mode-map (make-sparse-keymap))
+
+(defvar company-active-map
(let ((keymap (make-sparse-keymap)))
+ (set-keymap-parent keymap company-mode-map)
(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)
+ (define-key keymap "\C-m" 'company-complete-selection)
+ (define-key keymap "\t" 'company-complete-common)
+ (define-key keymap (kbd "<f1>") 'company-show-doc-buffer)
keymap))
;;;###autoload
(define-minor-mode company-mode
""
- nil " comp" company-mode-map
+ nil " comp" nil
(if company-mode
(progn
+ (add-to-list 'minor-mode-overriding-map-alist
+ (cons 'company-mode company-current-map))
(add-hook 'pre-command-hook 'company-pre-command nil t)
(add-hook 'post-command-hook 'company-post-command nil t)
(company-timer-set 'company-idle-delay
(if company-candidates
(progn
(setq company-point (point))
+ (set-keymap-parent company-current-map company-active-map)
(company-call-frontends 'update))
(company-cancel)))
company-selection 0
company-selection-changed nil
company-point nil)
- (company-call-frontends 'hide))
+ (company-call-frontends 'hide)
+ (set-keymap-parent company-current-map company-mode-map))
(defun company-abort ()
(company-cancel)
(setq company-point (point)))
(defun company-pre-command ()
- (when company-candidates
- (company-call-frontends 'pre-command)))
+ (unless (eq this-command 'company-show-doc-buffer)
+ (condition-case err
+ (when company-candidates
+ (company-call-frontends 'pre-command))
+ (error (message "Company: An error occurred in pre-command")
+ (message "%s" (error-message-string err))
+ (company-cancel)))))
(defun company-post-command ()
- (unless (equal (point) company-point)
- (company-begin))
- (when company-candidates
- (company-call-frontends 'post-command)))
+ (unless (eq this-command 'company-show-doc-buffer)
+ (condition-case err
+ (progn
+ (unless (equal (point) company-point)
+ (company-begin))
+ (when company-candidates
+ (company-call-frontends 'post-command)))
+ (error (message "Company: An error occurred in post-command")
+ (message "%s" (error-message-string err))
+ (company-cancel)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(company-space-string (- to len)))
(substring str from to)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar company-last-metadata nil)
+(make-variable-buffer-local 'company-last-metadata)
+
+(defun company-fetch-metadata ()
+ (let ((selected (nth company-selection company-candidates)))
+ (unless (equal selected (car company-last-metadata))
+ (setq company-last-metadata
+ (cons selected (funcall company-backend 'meta selected))))
+ (cdr company-last-metadata)))
+
+(defun company-doc-buffer (&optional string)
+ (with-current-buffer (get-buffer-create "*Company meta-data*")
+ (erase-buffer)
+ (current-buffer)))
+
+(defun company-show-doc-buffer ()
+ (interactive)
+ (when company-candidates
+ (save-window-excursion
+ (let* ((selected (nth company-selection company-candidates))
+ (buffer (funcall company-backend 'doc-buffer selected)))
+ (if (not buffer)
+ (error "No documentation available.")
+ (display-buffer buffer)
+ (read-event)
+ (when last-input-event
+ (clear-this-command-keys t)
+ (setq unread-command-events (list last-input-event))))))))
+
;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-pseudo-tooltip-overlay nil)
(goto-char beg)
(let ((row (cdr (posn-col-row (posn-at-point))))
lines)
- (while (< (point) end)
- (move-to-window-line (incf row))
+ (while (and (equal (move-to-window-line (incf row)) row)
+ (<= (point) end))
(push (buffer-substring beg (min end (1- (point)))) lines)
(setq beg (point)))
+ (unless (eq beg end)
+ (push (buffer-substring beg end) lines))
(nreverse lines)))
(defun company-modify-line (old new offset)
('post-command (company-echo-show company-candidates))
('hide (setq company-echo-last-msg nil))))
+(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))))
+
+
(provide 'company)
;;; company.el ends here