# History of user-visible changes
+ ## 2014-10-15 (0.8.6)
+
+ * `company-clang` and `company-template-c-like-templatify` support templated
+ functions and arguments.
+ * `company-dabbrev` ignores "uninteresting" buffers by default. Depends on the
+ new user option, `company-dabbrev-ignore-buffers`.
+ * `company-files` checks directory's last modification time.
+ * `company-files` supports relative paths and Windows drive letters.
+
## 2014-08-13 (0.8.4)
* `company-ropemacs` is only used when `ropemacs-mode` is on.
(declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-search "bbdb-com")
+ (defun company-bbdb--candidates (arg)
+ (cl-mapcan (lambda (record)
+ (mapcar (lambda (mail) (bbdb-dwim-mail record mail))
+ (bbdb-record-get-field record 'mail)))
+ (eval '(bbdb-search (bbdb-records) arg nil arg))))
+
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion back-end for `bbdb'."
(looking-back "^\\(To\\|Cc\\|Bcc\\):.*"
(line-beginning-position))
(company-grab-symbol)))
- (candidates (cl-mapcan (lambda (record)
- (mapcar (lambda (mail) (bbdb-dwim-mail record mail))
- (bbdb-record-get-field record 'mail)))
- (bbdb-search (bbdb-records) arg nil arg)))
+ (candidates (company-bbdb--candidates arg))
(sorted t)
(no-cache t)))
"Additional arguments to pass to clang when completing.
Prefix files (-include ...) can be selected with `company-clang-set-prefix'
or automatically through a custom `company-clang-prefix-guesser'."
- :type '(repeat (string :tag "Argument" nil)))
+ :type '(repeat (string :tag "Argument")))
(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
"A function to determine the prefix file for the current buffer."
;; TODO: Handle Pattern (syntactic hints would be neat).
;; Do we ever see OVERLOAD (or OVERRIDE)?
(defconst company-clang--completion-pattern
- "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?$")
+ "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:<>]*\\)\\(?: : \\(.*\\)$\\)?$")
(defconst company-clang--error-buffer-name "*clang-error*")
(insert anno)
(if (string-match "\\`:[^:]" anno)
(company-clang-objc-templatify anno)
- (company-template-c-like-templatify anno)))))))
+ (company-template-c-like-templatify
+ (concat arg anno))))))))
(provide 'company-clang)
;;; company-clang.el ends here
(defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers.
- If `all', search all other buffers. If t, search buffers with the same
- major mode. If `code', search all buffers with major modes in
- `company-dabbrev-code-modes', or derived from one of them.
- See also `company-dabbrev-code-time-limit'."
+ If `all', search all other buffers, except the ignored ones. If t, search
+ buffers with the same major mode. If `code', search all buffers with major
+ modes in `company-dabbrev-code-modes', or derived from one of them. See
+ also `company-dabbrev-code-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "Code major modes" code)
(defcustom company-dabbrev-other-buffers 'all
"Determines whether `company-dabbrev' should search other buffers.
- If `all', search all other buffers. If t, search buffers with the same
- major mode.
- See also `company-dabbrev-time-limit'."
+ If `all', search all other buffers, except the ignored ones. If t, search
+ buffers with the same major mode. See also `company-dabbrev-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "All" all)))
+ (defcustom company-dabbrev-ignore-buffers "\\`[ *]"
+ "Regexp matching the names of buffers to ignore."
+ :type 'regexp)
+
(defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches."
:type '(choice (const :tag "Off" nil)
(when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
(with-current-buffer buffer
- (when (or (eq other-buffer-modes 'all)
- (apply #'derived-mode-p other-buffer-modes))
+ (when (if (eq other-buffer-modes 'all)
+ (not (string-match-p company-dabbrev-ignore-buffers
+ (buffer-name)))
+ (apply #'derived-mode-p other-buffer-modes))
(setq symbols
(company-dabbrev--search-buffer regexp nil symbols start
limit ignore-comments))))
- ;;; company-files.el --- company-mode completion back-end for file names
+ ;;; company-files.el --- company-mode completion back-end for file paths
- ;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(require 'company)
(require 'cl-lib)
- (defun company-files-directory-files (dir prefix)
+ (defun company-files--directory-files (dir prefix)
(ignore-errors
(if (equal prefix "")
(directory-files dir nil "\\`[^.]\\|\\`.[^.]")
(file-name-all-completions prefix dir))))
- (defvar company-files-regexps
- (let ((begin (if (eq system-type 'windows-nt)
- "[a-z][A-Z]\\"
- "~?/")))
+ (defvar company-files--regexps
+ (let* ((root (if (eq system-type 'windows-nt)
+ "[a-zA-Z]:/"
+ "/"))
+ (begin (concat "\\(?:\\.\\{1,2\\}/\\|~/\\|" root "\\)")))
(list (concat "\"\\(" begin "[^\"\n]*\\)")
(concat "\'\\(" begin "[^\'\n]*\\)")
(concat "\\(?:[ \t]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
- (defun company-files-grab-existing-name ()
- ;; Grab file names with spaces, only when they include quotes.
+ (defun company-files--grab-existing-name ()
+ ;; Grab the file name.
+ ;; When surrounded with quotes, it can include spaces.
(let (file dir)
- (and (cl-dolist (regexp company-files-regexps)
+ (and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
(setq dir (file-name-directory file))
(file-name-all-completions (file-name-nondirectory file) dir)
file)))
- (defvar company-files-completion-cache nil)
+ (defvar company-files--completion-cache nil)
- (defun company-files-complete (prefix)
+ (defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
+ (key (list (file-name-nondirectory prefix)
+ (expand-file-name dir)
+ (nth 5 (file-attributes dir))))
(file (file-name-nondirectory prefix))
candidates directories)
- (unless (equal dir (car company-files-completion-cache))
- (dolist (file (company-files-directory-files dir file))
+ (unless (company-file--keys-match-p key (car company-files--completion-cache))
+ (dolist (file (company-files--directory-files dir file))
(setq file (concat dir file))
(push file candidates)
(when (file-directory-p file)
(push file directories)))
(dolist (directory (reverse directories))
;; Add one level of children.
- (dolist (child (company-files-directory-files directory ""))
+ (dolist (child (company-files--directory-files directory ""))
(push (concat directory
(unless (eq (aref directory (1- (length directory))) ?/) "/")
child) candidates)))
- (setq company-files-completion-cache (cons dir (nreverse candidates))))
+ (setq company-files--completion-cache (cons key (nreverse candidates))))
(all-completions prefix
- (cdr company-files-completion-cache))))
+ (cdr company-files--completion-cache))))
+
+ (defun company-file--keys-match-p (new old)
+ (and (equal (cdr old) (cdr new))
+ (string-prefix-p (car old) (car new))))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
- "`company-mode' completion back-end existing file names."
+ "`company-mode' completion back-end existing file names.
+ Completions works for proper absolute and relative files paths.
+ File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-files))
- (prefix (company-files-grab-existing-name))
- (candidates (company-files-complete arg))
+ (prefix (company-files--grab-existing-name))
+ (candidates (company-files--complete arg))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
(sorted t)
(cl-case command
(interactive (company-begin-backend 'company-gtags))
(prefix (and company-gtags-executable
+ buffer-file-name
(apply #'derived-mode-p company-gtags-modes)
(not (company-in-string-or-comment))
(company-gtags--tags-available-p)
;;; company-template.el
- ;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
+ ;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
(defun company-template-c-like-templatify (call)
(let* ((end (point-marker))
(beg (- (point) (length call)))
- (cnt 0))
- (when (re-search-backward ")" beg t)
- (delete-region (match-end 0) end))
- (goto-char beg)
- (when (search-forward "(" end 'move)
- (if (eq (char-after) ?\))
+ (cnt 0)
+ (templ (company-template-declare-template beg end))
+ paren-open paren-close)
+ (with-syntax-table (make-char-table 'syntax-table nil)
+ (modify-syntax-entry ?\( "(")
+ (modify-syntax-entry ?\) ")")
+ (modify-syntax-entry ?< "(")
+ (modify-syntax-entry ?> ")")
+ (when (search-backward ")" beg t)
+ (setq paren-close (point-marker))
+ (forward-char 1)
+ (delete-region (point) end)
+ (backward-sexp)
+ (forward-char 1)
+ (setq paren-open (point-marker)))
+ (when (search-backward ">" beg t)
+ (let ((angle-close (point-marker)))
(forward-char 1)
- (let ((templ (company-template-declare-template beg end)))
- (while (re-search-forward (concat " *\\([^,)]*\\)[,)]") end t)
- (let ((sig (match-string 1)))
- (delete-region (match-beginning 1) (match-end 1))
- (save-excursion
- (company-template-add-field templ (match-beginning 1)
- (format "arg%d" cnt) sig))
- (cl-incf cnt)))
- (company-template-move-to-first templ))))))
+ (backward-sexp)
+ (forward-char)
+ (setq cnt (company-template--c-like-args templ angle-close
+ cnt))))
+ (when paren-open
+ (goto-char paren-open)
+ (company-template--c-like-args templ paren-close cnt)))
+ (if (overlay-get templ 'company-template-fields)
+ (company-template-move-to-first templ)
+ (company-template-remove-template templ)
+ (goto-char end))))
+
+ (defun company-template--c-like-args (templ end counter)
+ (let ((last-pos (point)))
+ (while (re-search-forward "\\([^,]+\\),?" end 'move)
+ (when (zerop (car (parse-partial-sexp last-pos (point))))
+ (let ((sig (buffer-substring-no-properties last-pos (match-end 1))))
+ (save-excursion
+ (company-template-add-field templ last-pos
+ (format "arg%d" counter) sig)
+ (delete-region (point) (+ (point) (length sig))))
+ (skip-chars-forward " ")
+ (setq last-pos (point))
+ (cl-incf counter)))))
+ counter)
(provide 'company-template)
;;; company-template.el ends here
(should (eq 'company-tooltip-selection
(get-text-property (1- ww) 'face
(car res))))
+ )))
- )))
+ (ert-deftest company-create-lines-clears-out-non-printables ()
+ :tags '(interactive)
+ (let (company-show-numbers
+ (company-candidates (list
+ (decode-coding-string "avalis\351e" 'utf-8)
+ "avatar"))
+ (company-candidates-length 2)
+ (company-backend 'ignore))
+ (should (equal '(" avalis‗e "
+ " avatar ")
+ (company--create-lines 0 999)))))
+
+ (ert-deftest company-create-lines-handles-multiple-width ()
+ :tags '(interactive)
+ (let (company-show-numbers
+ (company-candidates '("蛙蛙蛙蛙" "蛙abc"))
+ (company-candidates-length 2)
+ (company-backend 'ignore))
+ (should (equal '(" 蛙蛙蛙蛙 "
+ " 蛙abc ")
+ (company--create-lines 0 999)))))
(ert-deftest company-column-with-composition ()
:tags '(interactive)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0")))))
+ (ert-deftest company-template-c-like-templatify-generics ()
+ (with-temp-buffer
+ (let ((text "foo<TKey, TValue>(int i, Dict<TKey, TValue>, long l)"))
+ (insert text)
+ (company-template-c-like-templatify text)
+ (should (equal "foo<arg0, arg1>(arg2, arg3, arg4)" (buffer-string)))
+ (should (looking-at "arg0"))
+ (should (equal "TKey" (overlay-get (company-template-field-at) 'display)))
+ (search-forward "arg3")
+ (forward-char -1)
+ (should (equal "Dict<TKey, TValue>"
+ (overlay-get (company-template-field-at) 'display))))))
+
;;; Clang
(ert-deftest company-clang-objc-templatify ()
;;; Code:
+ (require 'company)
(require 'cl-lib)
- (require 'yasnippet)
+
+ (declare-function yas--table-hash "yasnippet")
+ (declare-function yas--get-snippet-tables "yasnippet")
+ (declare-function yas-expand-snippet "yasnippet")
+ (declare-function yas--template-content "yasnippet")
+ (declare-function yas--template-expand-env "yasnippet")
(defun company-yasnippet--candidates (prefix)
- (mapcan
+ (cl-mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
res)
(prefix
;; Should probably use `yas--current-key', but that's bound to be slower.
;; How many trigger keys start with non-symbol characters anyway?
- (and yas-minor-mode
+ (and (bound-and-true-p yas-minor-mode)
(company-grab-symbol)))
(annotation
(concat
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
- ;; Version: 0.8.5
+ ;; Version: 0.8.6
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
(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
(define-key keymap "\C-s" 'company-search-candidates)
(define-key keymap "\C-\M-s" 'company-filter-candidates)
(dotimes (i 10)
- (define-key keymap (kbd (format "M-%d" i)) 'company-complete-number))
+ (define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
keymap)
"Keymap that is enabled during an active completion.")
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))
(if (eq (company-call-backend 'ignore-case) 'keep-prefix)
(insert (company-strip-prefix candidate))
(delete-region (- (point) (length company-prefix)) (point))
- (insert-before-markers candidate)))
+ (insert candidate)))
(defmacro company-with-candidate-inserted (candidate &rest body)
"Evaluate BODY with CANDIDATE temporarily inserted.
(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)))))
(eq pos (point))
(when (company-auto-begin)
(company-input-noop)
- (company-post-command))))
+ (let ((this-command 'company-idle-begin))
+ (company-post-command)))))
(defun company-auto-begin ()
(and company-mode
(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) ; Against misbehavior while debugging.
(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.
(defun company-fill-propertize (value annotation width selected left right)
(let* ((margin (length left))
(common (or (company-call-backend 'match value)
- (length company-common)))
+ (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))))
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)
;; `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)))
(end (save-excursion
(move-to-window-line (+ row (abs height)))
(point)))
- (ov (make-overlay (if nl beg (1- beg)) end nil t))
+ (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)))