Initial version

This commit is contained in:
Gergely Polonkai 2014-10-05 14:57:41 +02:00
commit ef4409f2a2
91 changed files with 28061 additions and 0 deletions

5
.gitignore vendored Normal file
View File

@ -0,0 +1,5 @@
*~
/session*
/tramp
*.elc
/elpa/archives/

15
.gitmodules vendored Normal file
View File

@ -0,0 +1,15 @@
[submodule "nyan-mode"]
path = nyan-mode
url = git://github.com/TeMPOraL/nyan-mode.git
[submodule "helm"]
path = helm
url = git://github.com/emacs-helm/helm.git
[submodule "emacs-async"]
path = emacs-async
url = git://github.com/jwiegley/emacs-async.git
[submodule "gobgen"]
path = gobgen
url = git://github.com/gergelypolonkai/gobgen.el.git
[submodule "emacs-helm-gtags"]
path = emacs-helm-gtags
url = git://github.com/syohex/emacs-helm-gtags.git

View File

@ -0,0 +1,129 @@
;;; ag-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (ag-kill-other-buffers ag-kill-buffers ag-project-dired-regexp
;;;;;; ag-project-dired ag-dired-regexp ag-dired ag-project-regexp
;;;;;; ag-project-files ag-project ag-regexp ag-files ag) "ag" "ag.el"
;;;;;; (21529 49183 36687 867000))
;;; Generated autoloads from ag.el
(autoload 'ag "ag" "\
Search using ag in a given DIRECTORY for a given search STRING,
with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING DIRECTORY)" t nil)
(autoload 'ag-files "ag" "\
Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX DIRECTORY)" t nil)
(autoload 'ag-regexp "ag" "\
Search using ag in a given directory for a given regexp.
The regexp should be in PCRE syntax, not Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING DIRECTORY)" t nil)
(autoload 'ag-project "ag" "\
Guess the root of the current project and search it with ag
for the given string.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING)" t nil)
(autoload 'ag-project-files "ag" "\
Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX)" t nil)
(autoload 'ag-project-regexp "ag" "\
Guess the root of the current project and search it with ag
for the given regexp. The regexp should be in PCRE syntax, not
Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag.
\(fn REGEXP)" t nil)
(defalias 'ag-project-at-point 'ag-project)
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
(autoload 'ag-dired "ag" "\
Recursively find files in DIR matching PATTERN.
The PATTERN is matched against the full path to the file, not
only against the file name.
The results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `ag-dired-regexp'.
\(fn DIR PATTERN)" t nil)
(autoload 'ag-dired-regexp "ag" "\
Recursively find files in DIR matching REGEXP.
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
The REGEXP is matched against the full path to the file, not
only against the file name.
Results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `find-dired'.
\(fn DIR REGEXP)" t nil)
(autoload 'ag-project-dired "ag" "\
Recursively find files in current project matching PATTERN.
See also `ag-dired'.
\(fn PATTERN)" t nil)
(autoload 'ag-project-dired-regexp "ag" "\
Recursively find files in current project matching REGEXP.
See also `ag-dired-regexp'.
\(fn REGEXP)" t nil)
(autoload 'ag-kill-buffers "ag" "\
Kill all ag-mode buffers.
\(fn)" t nil)
(autoload 'ag-kill-other-buffers "ag" "\
Kill all ag-mode buffers other than the current buffer.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("ag-pkg.el") (21529 49183 172114 552000))
;;;***
(provide 'ag-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; ag-autoloads.el ends here

1
elpa/ag-0.42/ag-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "ag" "0.42" "A front-end for ag ('the silver searcher'), the C ack replacement." (quote nil))

484
elpa/ag-0.42/ag.el Normal file
View File

@ -0,0 +1,484 @@
;;; ag.el --- A front-end for ag ('the silver searcher'), the C ack replacement.
;; Copyright (C) 2013-2014 Wilfred Hughes <me@wilfred.me.uk>
;;
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Created: 11 January 2013
;; Version: 0.42
;;; Commentary:
;; Please see README.md for documentation, or read it online at
;; https://github.com/Wilfred/ag.el/#agel
;;; License:
;; This file is not part of GNU Emacs.
;; However, it is distributed under the same license.
;; GNU Emacs 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 3, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile (require 'cl)) ;; dolist, defun*, flet
(require 'dired) ;; dired-sort-inhibit
(defcustom ag-executable
"ag"
"Name of the ag executable to use."
:type 'string
:group 'ag)
(defcustom ag-arguments
(list "--smart-case" "--nogroup" "--column" "--")
"Default arguments passed to ag."
:type '(repeat (string))
:group 'ag)
(defcustom ag-highlight-search nil
"Non-nil means we highlight the current search term in results.
This requires the ag command to support --color-match, which is only in v0.14+"
:type 'boolean
:group 'ag)
(defcustom ag-reuse-buffers nil
"Non-nil means we reuse the existing search results buffer or
dired results buffer, rather than creating one buffer per unique
search."
:type 'boolean
:group 'ag)
(defcustom ag-reuse-window nil
"Non-nil means we open search results in the same window,
hiding the results buffer."
:type 'boolean
:group 'ag)
(defcustom ag-project-root-function nil
"A function to determine the project root for `ag-project'.
If set to a function, call this function with the name of the
file or directory for which to determine the project root
directory.
If set to nil, fall back to finding VCS root directories."
:type '(choice (const :tag "Default (VCS root)" nil)
(function :tag "Function"))
:group 'ag)
(require 'compile)
;; Although ag results aren't exactly errors, we treat them as errors
;; so `next-error' and `previous-error' work. However, we ensure our
;; face inherits from `compilation-info-face' so the results are
;; styled appropriately.
(defface ag-hit-face '((t :inherit compilation-info))
"Face name to use for ag matches."
:group 'ag)
(defface ag-match-face '((t :inherit match))
"Face name to use for ag matches."
:group 'ag)
(defun ag/next-error-function (n &optional reset)
"Open the search result at point in the current window or a
different window, according to `ag-open-in-other-window'."
(if ag-reuse-window
;; prevent changing the window
(flet ((pop-to-buffer (buffer &rest args)
(switch-to-buffer buffer)))
(compilation-next-error-function n reset))
;; just navigate to the results as normal
(compilation-next-error-function n reset)))
(define-compilation-mode ag-mode "Ag"
"Ag results compilation mode"
(let ((smbl 'compilation-ag-nogroup)
;; Note that we want to use as tight a regexp as we can to try and
;; handle weird file names (with colons in them) as well as possible.
;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
;; in file names.
(pttrn '("^\\([^:\n]+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):" 1 2 3)))
(set (make-local-variable 'compilation-error-regexp-alist) (list smbl))
(set (make-local-variable 'compilation-error-regexp-alist-alist) (list (cons smbl pttrn))))
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
(set (make-local-variable 'next-error-function) 'ag/next-error-function)
(add-hook 'compilation-filter-hook 'ag-filter nil t))
(define-key ag-mode-map (kbd "p") 'compilation-previous-error)
(define-key ag-mode-map (kbd "n") 'compilation-next-error)
(defun ag/buffer-name (search-string directory regexp)
(cond
(ag-reuse-buffers "*ag search*")
(regexp (format "*ag search regexp:%s dir:%s*" search-string directory))
(:else (format "*ag search text:%s dir:%s*" search-string directory))))
(defun* ag/search (string directory
&key (regexp nil) (file-regex nil))
"Run ag searching for the STRING given in DIRECTORY.
If REGEXP is non-nil, treat STRING as a regular expression."
(let ((default-directory (file-name-as-directory directory))
(arguments ag-arguments)
(shell-command-switch "-c"))
(unless regexp
(setq arguments (cons "--literal" arguments)))
(if ag-highlight-search
(setq arguments (append '("--color" "--color-match" "30;43") arguments))
(setq arguments (append '("--nocolor") arguments)))
(when (char-or-string-p file-regex)
(setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
(unless (file-exists-p default-directory)
(error "No such directory %s" default-directory))
(let ((command-string
(mapconcat 'shell-quote-argument
(append (list ag-executable) arguments (list string "."))
" ")))
(when current-prefix-arg
(setq command-string (read-from-minibuffer "ag command: " command-string)))
(compilation-start
command-string
'ag-mode
`(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
(defun ag/dwim-at-point ()
"If there's an active selection, return that.
Otherwise, get the symbol at point, as a string."
(cond ((use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end)))
((symbol-at-point)
(substring-no-properties
(symbol-name (symbol-at-point))))))
(defun ag/buffer-extension-regex ()
"If the current buffer has an extension, return
a PCRE pattern that matches files with that extension.
Returns an empty string otherwise."
(let ((file-name (buffer-file-name)))
(if (stringp file-name)
(format "\\.%s" (file-name-extension file-name))
"")))
(defun ag/longest-string (&rest strings)
"Given a list of strings and nils, return the longest string."
(let ((longest-string nil))
(dolist (string strings)
(cond ((null longest-string)
(setq longest-string string))
((stringp string)
(when (< (length longest-string)
(length string))
(setq longest-string string)))))
longest-string))
(autoload 'vc-git-root "vc-git")
(require 'vc-svn)
;; Emacs 23.4 doesn't provide vc-svn-root.
(unless (functionp 'vc-svn-root)
(defun vc-svn-root (file)
(vc-find-root file vc-svn-admin-directory)))
(autoload 'vc-hg-root "vc-hg")
(defun ag/project-root (file-path)
"Guess the project root of the given FILE-PATH.
Use `ag-project-root-function' if set, or fall back to VCS
roots."
(if ag-project-root-function
(funcall ag-project-root-function file-path)
(or (ag/longest-string
(vc-git-root file-path)
(vc-svn-root file-path)
(vc-hg-root file-path))
file-path)))
(defun ag/dired-filter (proc string)
"Filter the output of ag to make it suitable for `dired-mode'."
(let ((buf (process-buffer proc))
(inhibit-read-only t))
(if (buffer-name buf)
(with-current-buffer buf
(save-excursion
(save-restriction
(widen)
(let ((beg (point-max)))
(goto-char beg)
(insert string)
(goto-char beg)
(or (looking-at "^")
(forward-line 1))
(while (looking-at "^")
(insert " ")
(forward-line 1))
(goto-char beg)
(beginning-of-line)
;; Remove occurrences of default-directory.
(while (search-forward default-directory nil t)
(replace-match "" nil t))
(goto-char (point-max))
(if (search-backward "\n" (process-mark proc) t)
(progn
(dired-insert-set-properties (process-mark proc)
(1+ (point)))
(move-marker (process-mark proc) (1+ (point)))))))))
(delete-process proc))))
(defun ag/dired-sentinel (proc state)
"Update the status/modeline after the process finishes."
(let ((buf (process-buffer proc))
(inhibit-read-only t))
(if (buffer-name buf)
(with-current-buffer buf
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(insert "\n ag " state)
(forward-char -1) ;Back up before \n at end of STATE.
(insert " at " (substring (current-time-string) 0 19))
(forward-char 1)
(setq mode-line-process
(concat ":" (symbol-name (process-status proc))))
;; Since the buffer and mode line will show that the
;; process is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc)
(force-mode-line-update)))
(message "%s finished." (current-buffer))))))
(defun ag/kill-process ()
"Kill the `ag' process running in the current buffer."
(interactive)
(let ((ag (get-buffer-process (current-buffer))))
(and ag (eq (process-status ag) 'run)
(eq (process-filter ag) (function find-dired-filter))
(condition-case nil
(delete-process ag)
(error nil)))))
(defun ag/escape-pcre (regexp)
"Escape the PCRE-special characters in REGEXP so that it is
matched literally."
(let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
(apply 'concat
(mapcar
(lambda (c)
(cond
((not (string-match-p (regexp-quote c) alphanum))
(concat "\\" c))
(t c)))
(mapcar 'char-to-string (string-to-list regexp))))))
;;;###autoload
(defun ag (string directory)
"Search using ag in a given DIRECTORY for a given search STRING,
with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-directory-name "Directory: ")))
(ag/search string directory))
;;;###autoload
(defun ag-files (string file-regex directory)
"Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex))
(read-directory-name "Directory: ")))
(ag/search string directory :file-regex file-regex))
;;;###autoload
(defun ag-regexp (string directory)
"Search using ag in a given directory for a given regexp.
The regexp should be in PCRE syntax, not Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag."
(interactive "sSearch regexp: \nDDirectory: ")
(ag/search string directory :regexp t))
;;;###autoload
(defun ag-project (string)
"Guess the root of the current project and search it with ag
for the given string.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))))
(ag/search string (ag/project-root default-directory)))
;;;###autoload
(defun ag-project-files (string file-regex)
"Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex))))
(ag/search string (ag/project-root default-directory) :file-regex file-regex))
;;;###autoload
(defun ag-project-regexp (regexp)
"Guess the root of the current project and search it with ag
for the given regexp. The regexp should be in PCRE syntax, not
Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search regexp: "
(ag/escape-pcre (ag/dwim-at-point)))))
(ag/search regexp (ag/project-root default-directory) :regexp t))
(autoload 'symbol-at-point "thingatpt")
;;;###autoload
(defalias 'ag-project-at-point 'ag-project)
(make-obsolete 'ag-project-at-point 'ag-project "0.19")
;;;###autoload
(defalias 'ag-regexp-project-at-point 'ag-project-regexp) ; TODO: mark as obsolete
;;;###autoload
(defun ag-dired (dir pattern)
"Recursively find files in DIR matching PATTERN.
The PATTERN is matched against the full path to the file, not
only against the file name.
The results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `ag-dired-regexp'."
(interactive "DDirectory: \nsFile pattern: ")
(ag-dired-regexp dir (ag/escape-pcre pattern)))
;;;###autoload
(defun ag-dired-regexp (dir regexp)
"Recursively find files in DIR matching REGEXP.
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
The REGEXP is matched against the full path to the file, not
only against the file name.
Results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `find-dired'."
(interactive "DDirectory: \nsFile regexp: ")
(let* ((dired-buffers dired-buffers) ;; do not mess with regular dired buffers
(orig-dir dir)
(dir (file-name-as-directory (expand-file-name dir)))
(buffer-name (if ag-reuse-buffers
"*ag dired*"
(format "*ag dired pattern:%s dir:%s*" regexp dir)))
(cmd (concat "ag --nocolor -g '" regexp "' " dir " | grep -v '^$' | xargs -I {} ls " dired-listing-switches " {} &")))
(with-current-buffer (get-buffer-create buffer-name)
(switch-to-buffer (current-buffer))
(widen)
(kill-all-local-variables)
(if (fboundp 'read-only-mode)
(read-only-mode -1)
(setq buffer-read-only nil))
(let ((inhibit-read-only t)) (erase-buffer))
(setq default-directory dir)
(shell-command cmd (current-buffer))
(insert " " dir ":\n")
(insert " " cmd "\n")
(dired-mode dir)
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(define-key map "\C-c\C-k" 'ag/kill-process)
(use-local-map map))
(set (make-local-variable 'dired-sort-inhibit) t)
(set (make-local-variable 'revert-buffer-function)
`(lambda (ignore-auto noconfirm)
(ag-dired ,orig-dir ,regexp)))
(if (fboundp 'dired-simple-subdir-alist)
(dired-simple-subdir-alist)
(set (make-local-variable 'dired-subdir-alist)
(list (cons default-directory (point-min-marker)))))
(let ((proc (get-buffer-process (current-buffer))))
(set-process-filter proc #'ag/dired-filter)
(set-process-sentinel proc #'ag/dired-sentinel)
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) 1 (current-buffer)))
(setq mode-line-process '(":%s")))))
;;;###autoload
(defun ag-project-dired (pattern)
"Recursively find files in current project matching PATTERN.
See also `ag-dired'."
(interactive "sFile pattern: ")
(ag-dired-regexp (ag/project-root default-directory) (ag/escape-pcre pattern)))
;;;###autoload
(defun ag-project-dired-regexp (regexp)
"Recursively find files in current project matching REGEXP.
See also `ag-dired-regexp'."
(interactive "sFile regexp: ")
(ag-dired-regexp (ag/project-root default-directory) regexp))
;;;###autoload
(defun ag-kill-buffers ()
"Kill all ag-mode buffers."
(interactive)
(dolist (buffer (buffer-list))
(when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
(kill-buffer buffer))))
;;;###autoload
(defun ag-kill-other-buffers ()
"Kill all ag-mode buffers other than the current buffer."
(interactive)
(let ((current-buffer (current-buffer)))
(dolist (buffer (buffer-list))
(when (and
(eq (buffer-local-value 'major-mode buffer) 'ag-mode)
(not (eq buffer current-buffer)))
(kill-buffer buffer)))))
;; Taken from grep-filter, just changed the color regex.
(defun ag-filter ()
"Handle match highlighting escape sequences inserted by the ag process.
This function is called from `compilation-filter-hook'."
(when ag-highlight-search
(save-excursion
(forward-line 0)
(let ((end (point)) beg)
(goto-char compilation-filter-start)
(forward-line 0)
(setq beg (point))
;; Only operate on whole lines so we don't get caught with part of an
;; escape sequence in one chunk and the rest in another.
(when (< (point) end)
(setq end (copy-marker end))
;; Highlight ag matches and delete marking sequences.
(while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[[0-9]*m" end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face 'ag-match-face)
t t))
;; Delete all remaining escape sequences
(goto-char beg)
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
(replace-match "" t t)))))))
(provide 'ag)
;;; ag.el ends here

View File

@ -0,0 +1,4 @@
((nil . ((indent-tabs-mode . nil)
(fill-column . 80)
(sentence-end-double-space . t)
(emacs-lisp-docstring-fill-column . 75))))

2
elpa/company-0.8.2/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.elc
ert.el

View File

@ -0,0 +1,26 @@
# https://github.com/rolandwalker/emacs-travis
language: emacs-lisp
env:
matrix:
- EMACS=emacs24
- EMACS=emacs-snapshot
install:
- if [ "$EMACS" = "emacs24" ]; then
sudo add-apt-repository -y ppa:cassou/emacs &&
sudo apt-get update -qq &&
sudo apt-get install -qq emacs24 emacs24-el;
fi
- if [ "$EMACS" = "emacs-snapshot" ]; then
sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
sudo apt-get update -qq &&
sudo apt-get install -qq emacs-snapshot;
fi
before_script:
make downloads
script:
make test-batch EMACS=${EMACS}

View File

@ -0,0 +1,255 @@
2014-07-26 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'b1d019a4c815ac8bdc240d69eaa74eb4e34640e8' from
company-master
2014-07-01 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '7c14dedc79bf0c6eaad5bf50b80ea80dd721afdc' from company
Conflicts:
packages/company/company-pysmell.el
2014-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
* company/company-capf.el: Don't ignore things like semantic-capf.
2014-04-19 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '51c140ca9ee32d27cacc7b2b07d4539bf98ae575' from
company-master
Conflicts:
packages/company/company-pysmell.el
2014-03-25 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '4a7995ff69b25990dc520ed9e466dfbcdb7eafc8' from company
2014-03-19 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'fec7c0b4a8651160c5d759cc6703b2c45852d5bb'
2014-03-18 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '7be4321260f0c73ef4c3cadc646f6bb496650253' from company
2014-02-18 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '119822078ee3024c2d27017d45ef4578fa36040f' from company
2014-02-03 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '67ab56a5469f16652e73667ec3b4f76ff6befee6' from company
2014-01-25 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '8dc8f9525714db66f659a2a51322345068764bd3' from company
Conflicts:
packages/company/company-capf.el
2014-01-24 Stefan Monnier <monnier@iro.umontreal.ca>
* company-capf.el (company--capf-data): Don't get confused by lambda
exps.
2014-01-20 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '2badcc6227a88e1aba288f442af5f4e1ce55d366' from company
2014-01-15 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '8b4d7da0d6aa1e24379fe5ace5bd2705352ea07e' from company
2014-01-14 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '67a96dbbfe645b64291ed62eab6f1eb391a834e0' from company
Conflicts:
packages/company/company-elisp.el
packages/company/company-oddmuse.el
2014-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-etags.el: Require `cl' for `case'.
* packages/company/company-oddmuse.el: Avoid `eval-when' before
requiring `cl'.
* packages/company/company-elisp.el (company-elisp): Simplify.
2013-10-06 Dmitry Gutov <dgutov@yandex.ru>
Sync from company/master
2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-capf.el (company-capf): Add preliminary
support for doc-buffer, meta, location, and require-match.
2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-cmake.el: Fix up copyright. Require CL.
* packages/company/company-template.el
(company-template--buffer-templates): Declare before first use.
* packages/company/company-eclim.el (json-array-type): Declare
json-array-type.
(company-eclim--candidates): Remove unused var `project-name'.
2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
Sync from company/master
2013-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
Mark merge point of company.
2013-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
* GNUmakefile: Rename from Makefile. Add targets for in-place use.
(all, all-in-place): New targets.
* admin/archive-contents.el (archive--simple-package-p): Ignore
autosave files.
(archive--refresh-pkg-file): New function.
(archive--write-pkg-file): Print with ' and ` shorthands.
* packages/company/company-pysmell.el: Don't require pysmell during
compile.
* packages/muse/htmlize-hack.el: Don't require htmlize during compile.
* packages/shen-mode/shen-mode.el (shen-functions): Define during
compile.
* smart-operator/smart-operator.el (smart-operator-insert-1): Use
pcase.
2013-05-26 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.10
* Plays nicer with `org-indent-mode`.
* Works in horizontally scrolled windows.
Git commit 764d2aa4ba50081adf69408e62d4863905b68b7f
2013-05-10 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.9
* `company-capf` respects `:exit-function` completion property.
* `company-backends`: `prefix` command can return `t` in the cdr.
* `company-clang-begin-after-member-access`: New option.
* Mouse click outside the tooltip aborts completion.
* `company-clang` uses standard input to pass the contents of current
buffer to
Clang 2.9+, otherwise saves the buffer and passes the path to the
file.
* `company-clang-auto-save` option has been removed.
* Better interaction with `outline-minor-mode`.
* `company-dabbrev-code` supports all `prog-mode` derivatives.
Git commit 4c735454d91f9674da0ecea950504888b1e10ff7
2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
* company.el (company-capf): Add support for `sorted' and
`post-completion'.
(company--capf-data): New function.
(company-backend): Declare before first use.
(company-require-match-p): Only call company-require-match is needed.
(company--continue-failed): Don't use backward-delete-char
non-interactively.
(company-search-assert-enabled): Demote it, since it comes too late to
be inlined.
(company-begin-with): Use a lexical closure, so the code is
byte-compiled.
(company--replacement-string, company--create-lines)
(company-pseudo-tooltip-edit, company-doc-buffer): Silence the
byte-compiler.
2013-04-16 Dmitry Gutov <dgutov@yandex.ru>
Release 0.6.8
* `company-auto-complete` is disabled by default.
* `company-auto-complete-chars` default value includes fewer syntax
classes.
* In expanded function calls, arguments skipped by the user default to
"argN".
* `company-eclim` and `company-clang` do not strip argument types from
fields.
* `company-clang` expands function calls for all three modes now.
* `company-clang` supports `c++-mode` by default.
Git commit 92ac3d0ef663bca26abbda33cc20a02a58b1c328
2013-04-05 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.7
* Two `company-elisp` tweaks.
Git commit 8dceda389115b397de48becc4b68a64f4dc4bbab
2013-04-01 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.6
## 2013-04-01 (0.6.6)
* `company-elisp` doesn't offer completions when typing the name and
the arguments of a new function or macro definition, allowing to
fall back to other back-ends like `company-dabbrev-code`.
## 2013-03-30 (0.6.5)
* Fixed keybindings when running in a terminal.
* `company-elisp-show-locals-first`: new customizable variable.
* `company-elisp` shows more accurate and comprehensive candidates
list.
## 2013-03-26 (0.6.4)
* `company-eclim` shows valid completions after an opening paren.
* Expanded template does not get removed until the point leaves it.
After your input the last argument in a method call expanded by
`company-eclim`, you can press `<tab>` once more, to jump after the
closing paren. No other bundled back-ends are affected.
## 2013-03-25 (0.6.3)
* New tooltip face colors used on themes with light background.
* Pseudo-tooltip stays up-to-date when text is inserted after the
point.
* Fixed `company-require-match` mechanics.
2013-03-24 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.2
2013-03-23 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.1
2013-03-21 Dmitry Gutov <dgutov@yandex.ru>
company: Remove angle brackets from README
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company: Update pkg.el and summary string
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company-tests.el: add copyright boilerplate
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company-mode: Release 0.6
2011-08-01 Stefan Monnier <monnier@iro.umontreal.ca>
* company/*.el: Fix case misunderstanding. Use checkdoc.
* company/company.el (company-capf): First cut at making Company use
completion-at-point-functions.
2011-06-30 Chong Yidong <cyd@stupidchicken.com>
Remove version numbers in packages/ directory

View File

@ -0,0 +1,37 @@
EMACS=emacs
CURL=curl --silent
ERT_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24.3
.PHONY: ert test test-batch
package: *.el
@ver=`grep -o "Version: .*" company.el | cut -c 10-`; \
tar cjvf company-$$ver.tar.bz2 --mode 644 `git ls-files '*.el' | xargs`
elpa: *.el
@version=`grep -o "Version: .*" company.el | cut -c 10-`; \
dir=company-$$version; \
mkdir -p "$$dir"; \
cp `git ls-files '*.el' | xargs` company-$$version; \
echo "(define-package \"company\" \"$$version\" \
\"Modular in-buffer completion framework\")" \
> "$$dir"/company-pkg.el; \
tar cvf company-$$version.tar --mode 644 "$$dir"
clean:
@rm -rf company-*/ company-*.tar company-*.tar.bz2 *.elc ert.el
test:
${EMACS} -Q -nw -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(let (pop-up-windows) (ert t))"
test-batch:
${EMACS} -Q --batch -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))"
downloads:
${EMACS} -Q --batch -l ert || \
${CURL} ${ERT_URL} > ert.el
compile:
${EMACS} -Q --batch -L . -f batch-byte-compile company.el company-*.el

277
elpa/company-0.8.2/NEWS.md Normal file
View File

@ -0,0 +1,277 @@
# History of user-visible changes
## 2014-07-26 (0.8.2)
* New user option `company-occurrence-weight-function`, allowing to tweak the
behavior of the transformer `company-sort-by-occurrence`.
* Setting `company-idle-delay` to `t` is deprecated. Use the value 0 instead.
## 2014-07-01 (0.8.1)
* `company-require-match` is not in effect when the new input doesn't continue
the previous prefix, and that prefix was a match.
* The meaning of `company-begin-commands` value t has slightly changed.
* New transformer, `company-sort-by-backend-importance`.
* When grouped back-ends are used, the back-end of the current candidate is
indicated in the mode-line, enclosed in angle brackets.
* New user option `company-gtags-insert-arguments`, t by default.
* `company-css` knows about CSS3.
* `company-gtags` supports `meta` and `annotation`.
* User option `company-dabbrev-code-other-buffers` can have a new value: `code`.
* New user option `company-tooltip-flip-when-above`.
* `company-clang` uses the standard header search paths by default.
* `C-h` is bound to `company-show-doc-buffer` (like `f1`).
## 2014-04-19 (0.8.0)
* `company-capf` is included in `company-backends` in any supported Emacs
version (>= 24.1). `company-elisp` goes before it if Emacs version is < 24.4.
* New user option `company-clang-insert-arguments`, by default t.
* Default value of `company-idle-delay` lowered to `0.5`.
* New user option `company-tooltip-minimum-width`, by default 0.
* New function `company-grab-symbol-cons`.
* `company-clang` fetches completion candidates asynchronously.
* Added support for asynchronous back-ends (experimental).
* Support for back-end command `crop` dropped (it was never documented).
* Support for Emacs 23 dropped.
* New user option `company-abort-manual-when-too-short`.
## 2014-03-25 (0.7.3)
* New user option `company-etags-ignore-case`.
## 2014-03-19 (0.7.2)
* Support for Emacs 22 officially dropped.
* `company-clang` supports `indent-tabs-mode` and multibyte chars before point.
## 2014-03-18 (0.7.1)
* Group of back-ends can now contain keyword `:with`, which makes all back-ends
after it to be skipped for prefix calculation.
* New function `company-version`.
* New bundled back-end `company-yasnippet`.
* Completion candidates returned from grouped back-ends are tagged to remember
which back-end each came from.
* New user option `company-tooltip-align-annotations`, off by default.
* New bundled back-end `company-bbdb`.
## 2014-02-18 (0.7)
* New back-end command, `match`, for non-prefix completion.
* New user option `company-continue-commands`. The default value aborts
completion on buffer saving commands.
* New back-end command, `annotation`, for text displayed inline in the popup
that's not a part of completion candidate.
* `company-capf`, `company-clang` and `company-eclim` use `annotation`.
* `company-preview*` faces inherit from `company-tooltip-selection` and
`company-tooltip-common-selection` on light themes.
* New user option `company-transformers`.
* First transformer, `company-sort-by-occurrence`.
* New user options controlling `company-dabbrev` and `company-dabbrev-code`.
## 2014-01-25 (0.6.14)
* The tooltip front-end is rendered with scrollbar, controlled by the user
option `company-tooltip-offset-display`.
* The tooltip front-end is rendered with margins, controlled by the user option
`company-tooltip-margin`.
## 2014-01-14 (0.6.13)
* Experimental support for non-prefix completion.
* Starting with Emacs version 24.4, `company-capf` is included in
`company-backends` and replaces `company-elisp`.
* `company-capf` supports completion tables that return non-default boundaries.
* `company-elisp` is enabled in `inferior-emacs-lisp-mode`.
## 2013-09-28 (0.6.12)
* Default value of `company-begin-commands` changed to `(self-insert-command)`.
* Futher improvement in `org-indent-mode` compatibility.
## 2013-08-18 (0.6.11)
* `company-template-c-like-templatify` removes all text after closing paren, for
use in backends that display additional info there.
* `company-cmake` is now bundled.
* Better `linum` compatibility in Emacs <= 24.2.
* `company-global-modes`: New option.
## 2013-05-26 (0.6.10)
* Plays nicer with `org-indent-mode`.
* Works in horizontally scrolled windows.
## 2013-05-10 (0.6.9)
* `company-capf` respects `:exit-function` completion property.
* `company-backends`: `prefix` command can return `t` in the cdr.
* `company-clang-begin-after-member-access`: New option.
* Mouse click outside the tooltip aborts completion.
* `company-clang` uses standard input to pass the contents of current buffer to
Clang 2.9+, otherwise saves the buffer and passes the path to the file.
* `company-clang-auto-save` option has been removed.
* Better interaction with `outline-minor-mode`.
* `company-dabbrev-code` supports all `prog-mode` derivatives.
## 2013-04-16 (0.6.8)
* `company-auto-complete` is disabled by default.
* `company-auto-complete-chars` default value includes fewer syntax classes.
* In expanded function calls, arguments skipped by the user default to "argN".
* `company-eclim` and `company-clang` do not strip argument types from fields.
* `company-clang` expands function calls for all three modes now.
* `company-clang` supports `c++-mode` by default.
## 2013-04-05 (0.6.7)
* Two `company-elisp` tweaks.
## 2013-04-01 (0.6.6)
* `company-elisp` doesn't offer completions when typing the name and the
arguments of a new function or macro definition, allowing to fall back to
other back-ends like `company-dabbrev-code`.
## 2013-03-30 (0.6.5)
* Fixed keybindings when running in a terminal.
* `company-elisp-show-locals-first`: new customizable variable.
* `company-elisp` shows more accurate and comprehensive candidates list.
## 2013-03-26 (0.6.4)
* `company-eclim` shows valid completions after an opening paren.
* Expanded template does not get removed until the point leaves it. After your
input the last argument in a method call expanded by `company-eclim`, you can
press `<tab>` once more, to jump after the closing paren. No other bundled
back-ends are affected.
## 2013-03-25 (0.6.3)
* New tooltip face colors used on themes with light background.
* Pseudo-tooltip stays up-to-date when text is inserted after the point.
* Fixed `company-require-match` mechanics.
## 2013-03-24 (0.6.2)
* `global-company-mode` is now autoloaded.
## 2013-03-23 (0.6.1)
* Documented `init` and `post-completion` back-end commands.
* `company-eclim` and `company-clang` only expand the template on explicit user
action (such as `company-complete-{selection,number,mouse}`).
* `company-template` has some breaking changes. When point is at one of the
fields, it's displayed at the beginning, not right after it; `<tab>` jumps to
the next field, `forward-word` and `subword-forward` remappings are removed;
when you jump to the next field, if the current one hasn't been edited, the
overlay gets removed but the text remains.
* `company-eclim` shows method overloads and expands templates for calls.
* `company-clang-objc-templatify` does not insert spaces after colons anymore.
* `company-clang` is now only initialized in supported buffers.
So, no error messages if you don't have Clang until you open a C file.
* `company-clang` recognizes Clang included in recent Xcode.
* New commands `company-select-previous-or-abort` and
`company-select-next-or-abort`, bound to `<up>` and `<down>`.
## 2013-03-19 (0.6)
* Across-the-board bugfixing.
* `company-pysmell` is not used by default anymore.
* Loading of `nxml`, `semantic`, `pymacs` and `ropemacs` is now deferred.
* Candidates from grouped back-ends are merged more conservatively: only
back-ends that return the same prefix at point are used.
* `company-clang` now shows meta information, too.
* Some performance improvements.
* Fixed two old tooltip annoyances.
* Instead of `overrriding-terminal-local-map`, we're now using
`emulation-mode-map-alists` (experimental). This largely means that when the
completion keymap is active, other minor modes' keymaps are still used, so,
for example, it's not as easy to accidentally circumvent `paredit-mode`
when it's enabled.
* `company-elisp` has seen some improvements.
* Added `company-capf`: completion adapter using
`completion-at-point-functions`. (Stefan Monnier)
* Clang completions now include macros and are case-sensitive.
* Switching between tag files now works correctly with `company-etags`.
## 2010-02-24 (0.5)
* `company-ropemacs` now provides location and docs. (Fernando H. Silva)
* Added `company-with-candidate-inserted` macro.
* Added `company-clang` back-end.
* Added new mechanism for non-consecutive insertion.
(So far only used by clang for ObjC.)
* The semantic back-end now shows meta information for local symbols.
* Added compatibility for CEDET in Emacs 23.2 and from CVS. (Oleg Andreev)
## 2009-05-07 (0.4.3)
* Added `company-other-backend`.
* Idle completion no longer interrupts multi-key command input.
* Added `company-ropemacs` and `company-pysmell` back-ends.
## 2009-04-25 (0.4.2)
* In C modes . and -> now count towards `company-minimum-prefix-length`.
* Reverted default front-end back to `company-preview-if-just-one-frontend`.
* The pseudo tooltip will no longer be clipped at the right window edge.
* Added `company-tooltip-minimum`.
* 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.
* Added back-end `company-dabbrev-code` for generic code.
* Fixed `company-begin-with`.
## 2009-04-15 (0.3.1)
* Added 'stop prefix to prevent dabbrev from completing inside of symbols.
* Fixed issues with tabbar-mode and line-spacing.
* Performance enhancements.
## 2009-04-12 (0.3)
* Added `company-begin-commands` option.
* Added abbrev, tempo and Xcode back-ends.
* Back-ends are now interactive. You can start them with M-x backend-name.
* Added `company-begin-with` for starting company from elisp-code.
* Added hooks.
* Added `company-require-match` and `company-auto-complete` options.
## 2009-04-05 (0.2.1)
* Improved Emacs Lisp back-end behavior for local variables.
* Added `company-elisp-detect-function-context` option.
* The mouse can now be used for selection.
## 2009-03-22 (0.2)
* Added `company-show-location`.
* Added etags back-end.
* Added work-around for end-of-buffer bug.
* Added `company-filter-candidates`.
* More local Lisp variables are now included in the candidates.
## 2009-03-21 (0.1.5)
* Fixed elisp documentation buffer always showing the same doc.
* Added `company-echo-strip-common-frontend`.
* Added `company-show-numbers` option and M-0 ... M-9 default bindings.
* Don't hide the echo message if it isn't shown.
## 2009-03-20 (0.1)
* Initial release.

View File

@ -0,0 +1,4 @@
See the [homepage](http://company-mode.github.com/).
[![githalytics.com alpha](https://cruel-carlota.pagodabox.com/336ef4be2595a7859d52e2c17b7da2b2 "githalytics.com")](http://githalytics.com/company-mode/company-mode)
[![Build Status](https://travis-ci.org/company-mode/company-mode.png?branch=master)](https://travis-ci.org/company-mode/company-mode)

View File

@ -0,0 +1,51 @@
;;; company-abbrev.el --- company-mode completion back-end for abbrev
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'abbrev)
(defun company-abbrev-insert (match)
"Replace MATCH with the expanded abbrev."
(expand-abbrev))
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
"`company-mode' completion back-end for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
'company-abbrev-insert))
(prefix (company-grab-symbol))
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
(meta (abbrev-expansion arg))
(require-match t)))
(provide 'company-abbrev)
;;; company-abbrev.el ends here

View File

@ -0,0 +1,295 @@
;;; company-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (global-company-mode company-mode) "company" "company.el"
;;;;;; (21475 23817 56009 901000))
;;; Generated autoloads from company.el
(autoload 'company-mode "company" "\
\"complete anything\"; is an in-buffer completion framework.
Completion starts automatically, depending on the values
`company-idle-delay' and `company-minimum-prefix-length'.
Completion can be controlled with the commands:
`company-complete-common', `company-complete-selection', `company-complete',
`company-select-next', `company-select-previous'. If these commands are
called before `company-idle-delay', completion will also start.
Completions can be searched with `company-search-candidates' or
`company-filter-candidates'. These can be used while completion is
inactive, as well.
The completion data is retrieved using `company-backends' and displayed
using `company-frontends'. If you want to start a specific back-end, call
it interactively or use `company-begin-backend'.
regular keymap (`company-mode-map'):
\\{company-mode-map}
keymap during active completions (`company-active-map'):
\\{company-active-map}
\(fn &optional ARG)" t nil)
(defvar global-company-mode nil "\
Non-nil if Global-Company mode is enabled.
See the command `global-company-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-company-mode'.")
(custom-autoload 'global-company-mode "company" nil)
(autoload 'global-company-mode "company" "\
Toggle Company mode in all buffers.
With prefix ARG, enable Global-Company mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Company mode is enabled in all buffers where
`company-mode-on' would do it.
See `company-mode' for more information on Company mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (company-abbrev) "company-abbrev" "company-abbrev.el"
;;;;;; (21475 23816 615018 715000))
;;; Generated autoloads from company-abbrev.el
(autoload 'company-abbrev "company-abbrev" "\
`company-mode' completion back-end for abbrev.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-bbdb) "company-bbdb" "company-bbdb.el"
;;;;;; (21475 23817 97009 82000))
;;; Generated autoloads from company-bbdb.el
(autoload 'company-bbdb "company-bbdb" "\
`company-mode' completion back-end for `bbdb'.
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
;;;***
;;;### (autoloads (company-css) "company-css" "company-css.el" (21475
;;;;;; 23816 641018 195000))
;;; Generated autoloads from company-css.el
(autoload 'company-css "company-css" "\
`company-mode' completion back-end for `css-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-dabbrev) "company-dabbrev" "company-dabbrev.el"
;;;;;; (21475 23816 683017 356000))
;;; Generated autoloads from company-dabbrev.el
(autoload 'company-dabbrev "company-dabbrev" "\
dabbrev-like `company-mode' completion back-end.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-dabbrev-code) "company-dabbrev-code" "company-dabbrev-code.el"
;;;;;; (21475 23817 330004 425000))
;;; Generated autoloads from company-dabbrev-code.el
(autoload 'company-dabbrev-code "company-dabbrev-code" "\
dabbrev-like `company-mode' back-end for code.
The back-end looks for all symbols in the current buffer that aren't in
comments or strings.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-elisp) "company-elisp" "company-elisp.el"
;;;;;; (21475 23816 807014 878000))
;;; Generated autoloads from company-elisp.el
(autoload 'company-elisp "company-elisp" "\
`company-mode' completion back-end for Emacs Lisp.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-etags) "company-etags" "company-etags.el"
;;;;;; (21475 23816 392023 172000))
;;; Generated autoloads from company-etags.el
(autoload 'company-etags "company-etags" "\
`company-mode' completion back-end for etags.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-files) "company-files" "company-files.el"
;;;;;; (21475 23816 847014 78000))
;;; Generated autoloads from company-files.el
(autoload 'company-files "company-files" "\
`company-mode' completion back-end existing file names.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-gtags) "company-gtags" "company-gtags.el"
;;;;;; (21475 23817 379003 447000))
;;; Generated autoloads from company-gtags.el
(autoload 'company-gtags "company-gtags" "\
`company-mode' completion back-end for GNU Global.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-ispell) "company-ispell" "company-ispell.el"
;;;;;; (21475 23816 351023 991000))
;;; Generated autoloads from company-ispell.el
(autoload 'company-ispell "company-ispell" "\
`company-mode' completion back-end using Ispell.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-keywords) "company-keywords" "company-keywords.el"
;;;;;; (21475 23816 426022 492000))
;;; Generated autoloads from company-keywords.el
(autoload 'company-keywords "company-keywords" "\
`company-mode' back-end for programming language keywords.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-nxml) "company-nxml" "company-nxml.el"
;;;;;; (21475 23816 467021 673000))
;;; Generated autoloads from company-nxml.el
(autoload 'company-nxml "company-nxml" "\
`company-mode' completion back-end for `nxml-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-oddmuse) "company-oddmuse" "company-oddmuse.el"
;;;;;; (21475 23816 881013 399000))
;;; Generated autoloads from company-oddmuse.el
(autoload 'company-oddmuse "company-oddmuse" "\
`company-mode' completion back-end for `oddmuse-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-pysmell) "company-pysmell" "company-pysmell.el"
;;;;;; (21475 23816 990011 221000))
;;; Generated autoloads from company-pysmell.el
(autoload 'company-pysmell "company-pysmell" "\
`company-mode' completion back-end for pysmell.
This requires pysmell.el and pymacs.el.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-semantic) "company-semantic" "company-semantic.el"
;;;;;; (21475 23817 594999 129000))
;;; Generated autoloads from company-semantic.el
(autoload 'company-semantic "company-semantic" "\
`company-mode' completion back-end using CEDET Semantic.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-tempo) "company-tempo" "company-tempo.el"
;;;;;; (21475 23817 172007 583000))
;;; Generated autoloads from company-tempo.el
(autoload 'company-tempo "company-tempo" "\
`company-mode' completion back-end for tempo.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-xcode) "company-xcode" "company-xcode.el"
;;;;;; (21475 23817 247006 84000))
;;; Generated autoloads from company-xcode.el
(autoload 'company-xcode "company-xcode" "\
`company-mode' completion back-end for Xcode projects.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-yasnippet) "company-yasnippet" "company-yasnippet.el"
;;;;;; (21475 23817 487001 288000))
;;; Generated autoloads from company-yasnippet.el
(autoload 'company-yasnippet "company-yasnippet" "\
`company-mode' back-end for `yasnippet'.
This back-end should be used with care, because as long as there are
snippets defined for the current major mode, this back-end will always
shadow back-ends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end or
several that provide actual text completions.
(add-hook 'js-mode-hook
(lambda ()
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other back-ends.
(push '(company-semantic :with company-yasnippet) company-backends)
* Not in `company-backends', just bound to a key.
(global-set-key (kbd \"C-c y\") 'company-yasnippet)
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
;;;***
;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el"
;;;;;; "company-eclim.el" "company-elisp-tests.el" "company-pkg.el"
;;;;;; "company-ropemacs.el" "company-template.el" "company-tests.el")
;;;;;; (21475 23817 679245 801000))
;;;***
(provide 'company-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; company-autoloads.el ends here

View File

@ -0,0 +1,49 @@
;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
(require 'company)
(require 'cl-lib)
(declare-function bbdb-record-get-field "bbdb")
(declare-function bbdb-records "bbdb")
(declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-search "bbdb-com")
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion back-end for `bbdb'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (eq major-mode 'message-mode)
(featurep 'bbdb-com)
(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)))
(sorted t)
(no-cache t)))
(provide 'company-bbdb)
;;; company-bbdb.el ends here

View File

@ -0,0 +1,135 @@
;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defun company--capf-data ()
(cl-letf* (((default-value 'completion-at-point-functions)
;; Ignore tags-completion-at-point-function because it subverts
;; company-etags in the default value of company-backends, where
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions)))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
(when (and (consp (cdr data)) (numberp (nth 1 data))) data)))
(defun company-capf (command &optional arg &rest _args)
"`company-mode' back-end using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
(if (> (nth 2 res) (point))
'stop
(buffer-substring-no-properties (nth 1 res) (point))))))
(`candidates
(let ((res (company--capf-data)))
(when res
(let* ((table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate))
(meta (completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
table pred))
(sortfun (cdr (assq 'display-sort-function meta)))
(candidates (completion-all-completions arg table pred (length arg)))
(last (last candidates))
(base-size (and (numberp (cdr last)) (cdr last))))
(when base-size
(setcdr last nil))
(when sortfun
(setq candidates (funcall sortfun candidates)))
(if (not (zerop (or base-size 0)))
(let ((before (substring arg 0 base-size)))
(mapcar (lambda (candidate)
(concat before candidate))
candidates))
candidates)))))
(`sorted
(let ((res (company--capf-data)))
(when res
(let ((meta (completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
(nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
(cdr (assq 'display-sort-function meta))))))
(`match
;; Can't just use 0 when base-size (see above) is non-zero.
(let ((start (if (get-text-property 0 'font-lock-face arg)
0
(next-single-property-change 0 'font-lock-face arg))))
(when start
;; completions-common-part comes first, but we can't just look for this
;; value because it can be in a list.
(or
(let ((value (get-text-property start 'font-lock-face arg)))
(text-property-not-all start (length arg)
'font-lock-face value arg))
(length arg)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
;non-prefix matches.
(`meta
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
(when f (funcall f arg))))
(`doc-buffer
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
(when f (funcall f arg))))
(`location
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
(when f (funcall f arg))))
(`annotation
(save-excursion
;; FIXME: `company-begin' sets `company-point' after calling
;; `company--begin-new'. We shouldn't rely on `company-point' here,
;; better to cache the capf-data value instead. However: we can't just
;; save the last capf-data value in `prefix', because that command can
;; get called more often than `candidates', and at any point in the
;; buffer (https://github.com/company-mode/company-mode/issues/153).
;; We could try propertizing the returned prefix string, but it's not
;; passed to `annotation', and `company-prefix' is set only after
;; `company--strip-duplicates' is called.
(when company-point
(goto-char company-point))
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function)))
(when f (funcall f arg)))))
(`require-match
(plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
(`init nil) ;Don't bother: plenty of other ways to initialize the code.
(`post-completion
(let* ((res (company--capf-data))
(exit-function (plist-get (nthcdr 4 res) :exit-function)))
(if exit-function
(funcall exit-function arg 'finished))))
))
(provide 'company-capf)
;;; company-capf.el ends here

View File

@ -0,0 +1,326 @@
;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-clang nil
"Completion back-end for Clang."
:group 'company)
(defcustom company-clang-executable
(executable-find "clang")
"Location of clang executable."
:type 'file)
(defcustom company-clang-begin-after-member-access t
"When non-nil, automatic completion will start whenever the current
symbol is preceded by \".\", \"->\" or \"::\", ignoring
`company-minimum-prefix-length'.
If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
and `c-electric-colon', for automatic completion right after \">\" and
\":\".")
(defcustom company-clang-arguments nil
"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)))
(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
"A function to determine the prefix file for the current buffer."
:type '(function :tag "Guesser function" nil))
(defvar company-clang-modes '(c-mode c++-mode objc-mode)
"Major modes which clang may complete.")
(defcustom company-clang-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.8.0"))
;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-clang--prefix nil)
(defsubst company-clang--guess-pch-file (file)
(let ((dir (directory-file-name (file-name-directory file))))
(when (equal (file-name-nondirectory dir) "Classes")
(setq dir (file-name-directory dir)))
(car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t))))
(defsubst company-clang--file-substring (file beg end)
(with-temp-buffer
(insert-file-contents-literally file nil beg end)
(buffer-string)))
(defun company-clang-guess-prefix ()
"Try to guess the prefix file for the current buffer."
;; Prefixes seem to be called .pch. Pre-compiled headers do, too.
;; So we look at the magic number to rule them out.
(let* ((file (company-clang--guess-pch-file buffer-file-name))
(magic-number (and file (company-clang--file-substring file 0 4))))
(unless (member magic-number '("CPCH" "gpch"))
file)))
(defun company-clang-set-prefix (&optional prefix)
"Use PREFIX as a prefix (-include ...) file for clang completion."
(interactive (let ((def (funcall company-clang-prefix-guesser)))
(unless (stringp def)
(setq def default-directory))
(list (read-file-name "Prefix file: "
(when def (file-name-directory def))
def t (when def (file-name-nondirectory def))))))
;; TODO: pre-compile?
(setq company-clang--prefix (and (stringp prefix)
(file-regular-p prefix)
prefix)))
;; Clean-up on exit.
(add-hook 'kill-emacs-hook 'company-clang-set-prefix)
;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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_:]*\\)\\(?: : \\(.*\\)$\\)?$")
(defconst company-clang--error-buffer-name "*clang-error*")
(defun company-clang--lang-option ()
(if (eq major-mode 'objc-mode)
(if (string= "m" (file-name-extension buffer-file-name))
"objective-c" "objective-c++")
(substring (symbol-name major-mode) 0 -5)))
(defun company-clang--parse-output (prefix _objc)
(goto-char (point-min))
(let ((pattern (format company-clang--completion-pattern
(regexp-quote prefix)))
(case-fold-search nil)
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(unless (equal match "Pattern")
(save-match-data
(when (string-match ":" match)
(setq match (substring match 0 (match-beginning 0)))))
(let ((meta (match-string-no-properties 2)))
(when (and meta (not (string= match meta)))
(put-text-property 0 1 'meta
(company-clang--strip-formatting meta)
match)))
(push match lines)))
lines))
(defun company-clang--meta (candidate)
(get-text-property 0 'meta candidate))
(defun company-clang--annotation (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
((string-match "[^:]:[^:]" meta)
(substring meta (1+ (match-beginning 0))))
((string-match "\\((.*)[ a-z]*\\'\\)" meta)
(match-string 1 meta)))))
(defun company-clang--strip-formatting (text)
(replace-regexp-in-string
"#]" " "
(replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t)
t))
(defun company-clang--handle-error (res args)
(goto-char (point-min))
(let* ((buf (get-buffer-create company-clang--error-buffer-name))
(cmd (concat company-clang-executable " " (mapconcat 'identity args " ")))
(pattern (format company-clang--completion-pattern ""))
(err (if (re-search-forward pattern nil t)
(buffer-substring-no-properties (point-min)
(1- (match-beginning 0)))
;; Warn the user more aggressively if no match was found.
(message "clang failed with error %d:\n%s" res cmd)
(buffer-string))))
(with-current-buffer buf
(let ((inhibit-read-only t))
(erase-buffer)
(insert (current-time-string)
(format "\nclang failed with error %d:\n" res)
cmd "\n\n")
(insert err)
(setq buffer-read-only t)
(goto-char (point-min))))))
(defun company-clang--start-process (prefix callback &rest args)
(let ((objc (derived-mode-p 'objc-mode))
(buf (get-buffer-create "*clang-output*")))
(with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf)
(funcall callback nil)
(let ((process (apply #'start-process "company-clang" buf
company-clang-executable args)))
(set-process-sentinel
process
(lambda (proc status)
(unless (string-match-p "hangup" status)
(funcall
callback
(let ((res (process-exit-status proc)))
(with-current-buffer buf
(unless (eq 0 res)
(company-clang--handle-error res args))
;; Still try to get any useful input.
(company-clang--parse-output prefix objc)))))))
(unless (company-clang--auto-save-p)
(send-region process (point-min) (point-max))
(send-string process "\n")
(process-send-eof process))))))
(defsubst company-clang--build-location (pos)
(save-excursion
(goto-char pos)
(format "%s:%d:%d"
(if (company-clang--auto-save-p) buffer-file-name "-")
(line-number-at-pos)
(1+ (length
(encode-coding-region
(line-beginning-position)
(point)
'utf-8
t))))))
(defsubst company-clang--build-complete-args (pos)
(append '("-fsyntax-only" "-Xclang" "-code-completion-macros")
(unless (company-clang--auto-save-p)
(list "-x" (company-clang--lang-option)))
company-clang-arguments
(when (stringp company-clang--prefix)
(list "-include" (expand-file-name company-clang--prefix)))
(list "-Xclang" (format "-code-completion-at=%s"
(company-clang--build-location pos)))
(list (if (company-clang--auto-save-p) buffer-file-name "-"))))
(defun company-clang--candidates (prefix callback)
(and (company-clang--auto-save-p)
(buffer-modified-p)
(basic-save-buffer))
(when (null company-clang--prefix)
(company-clang-set-prefix (or (funcall company-clang-prefix-guesser)
'none)))
(apply 'company-clang--start-process
prefix
callback
(company-clang--build-complete-args (- (point) (length prefix)))))
(defun company-clang--prefix ()
(if company-clang-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst company-clang-required-version 1.1)
(defvar company-clang--version nil)
(defun company-clang--auto-save-p ()
(< company-clang--version 2.9))
(defsubst company-clang-version ()
"Return the version of `company-clang-executable'."
(with-temp-buffer
(call-process company-clang-executable nil t nil "--version")
(goto-char (point-min))
(if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t)
(let ((ver (string-to-number (match-string-no-properties 1))))
(if (> ver 100)
(/ ver 100)
ver))
0)))
(defun company-clang-objc-templatify (selector)
(let* ((end (point-marker))
(beg (- (point) (length selector) 1))
(templ (company-template-declare-template beg end))
(cnt 0))
(save-excursion
(goto-char beg)
(catch 'stop
(while (search-forward ":" end t)
(when (looking-at "([^)]*) ?")
(delete-region (match-beginning 0) (match-end 0)))
(company-template-add-field templ (point) (format "arg%d" cnt))
(if (< (point) end)
(insert " ")
(throw 'stop t))
(cl-incf cnt))))
(company-template-move-to-first templ)))
(defun company-clang (command &optional arg &rest ignored)
"`company-mode' completion back-end for Clang.
Clang is a parser for C and ObjC. Clang version 1.1 or newer is required.
Additional command line arguments can be specified in
`company-clang-arguments'. Prefix files (-include ...) can be selected
with `company-clang-set-prefix' or automatically through a custom
`company-clang-prefix-guesser'.
With Clang versions before 2.9, we have to save the buffer before
performing completion. With Clang 2.9 and later, buffer contents are
passed via standard input."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-clang))
(init (when (memq major-mode company-clang-modes)
(unless company-clang-executable
(error "Company found no clang executable"))
(setq company-clang--version (company-clang-version))
(when (< company-clang--version company-clang-required-version)
(error "Company requires clang version 1.1"))))
(prefix (and (memq major-mode company-clang-modes)
buffer-file-name
company-clang-executable
(not (company-in-string-or-comment))
(or (company-clang--prefix) 'stop)))
(candidates (cons :async
(lambda (cb) (company-clang--candidates arg cb))))
(meta (company-clang--meta arg))
(annotation (company-clang--annotation arg))
(post-completion (let ((anno (company-clang--annotation arg)))
(when (and company-clang-insert-arguments anno)
(insert anno)
(if (string-match "\\`:[^:]" anno)
(company-clang-objc-templatify anno)
(company-template-c-like-templatify anno)))))))
(provide 'company-clang)
;;; company-clang.el ends here

View File

@ -0,0 +1,129 @@
;;; company-cmake.el --- company-mode completion back-end for CMake
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.1
;; 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 3 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:
;;
;; company-cmake offers completions for module names, variable names and
;; commands used by CMake. And their descriptions.
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-cmake nil
"Completion back-end for CMake."
:group 'company)
(defcustom company-cmake-executable
(executable-find "cmake")
"Location of cmake executable."
:type 'file)
(defvar company-cmake-executable-arguments
'("--help-command-list"
"--help-module-list"
"--help-variable-list")
"The arguments we pass to cmake, separately.
They affect which types of symbols we get completion candidates for.")
(defvar company-cmake--completion-pattern
"^\\(%s[a-zA-Z0-9_]%s\\)$"
"Regexp to match the candidates.")
(defvar company-cmake-modes '(cmake-mode)
"Major modes in which cmake may complete.")
(defvar company-cmake--meta-command-cache nil
"Cache for command arguments to retrieve descriptions for the candidates.")
(defun company-cmake--parse-output (prefix cmd)
"Analyze the temp buffer and collect lines."
(goto-char (point-min))
(let ((pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(case-fold-search nil)
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(puthash match cmd company-cmake--meta-command-cache)
(push match lines))
lines))
(defun company-cmake--candidates (prefix)
(let ((res 0)
results
cmd)
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal))
(dolist (arg company-cmake-executable-arguments)
(with-temp-buffer
(setq res (call-process company-cmake-executable nil t nil arg))
(unless (eq 0 res)
(message "cmake executable exited with error=%d" res))
(setq cmd (replace-regexp-in-string "-list$" "" arg) )
(setq results (nconc results (company-cmake--parse-output prefix cmd)))))
results))
(defun company-cmake--meta (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache))
result)
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; Go to the third line, trim it and return the result.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(setq result (buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
(setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result))
result)))
(defun company-cmake--doc-buffer (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache)))
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; Go to the third line, trim it and return the doc buffer.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(company-doc-buffer
(buffer-substring-no-properties (line-beginning-position)
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
"`company-mode' completion back-end for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-cmake))
(init (when (memq major-mode company-cmake-modes)
(unless company-cmake-executable
(error "Company found no cmake executable"))))
(prefix (and (memq major-mode company-cmake-modes)
(not (company-in-string-or-comment))
(company-grab-symbol)))
(candidates (company-cmake--candidates arg))
(meta (company-cmake--meta arg))
(doc-buffer (company-cmake--doc-buffer arg))
))
(provide 'company-cmake)
;;; company-cmake.el ends here

View File

@ -0,0 +1,438 @@
;;; company-css.el --- company-mode completion back-end for css-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'company)
(require 'cl-lib)
(defconst company-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
"center-right" "right" "far-right" "right-side" "behind" "leftwards"
"rightwards")
("background" background-color background-image background-repeat
background-attachment background-position
background-clip background-origin background-size)
("background-attachment" "scroll" "fixed")
("background-color" color "transparent")
("background-image" uri "none")
("background-position" percentage length "left" "center" "right" percentage
length "top" "center" "bottom" "left" "center" "right" "top" "center"
"bottom")
("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat")
("border" border-width border-style border-color)
("border-bottom" border)
("border-bottom-color" border-color)
("border-bottom-style" border-style)
("border-bottom-width" border-width)
("border-collapse" "collapse" "separate")
("border-color" color "transparent")
("border-left" border)
("border-left-color" border-color)
("border-left-style" border-style)
("border-left-width" border-width)
("border-right" border)
("border-right-color" border-color)
("border-right-style" border-style)
("border-right-width" border-width)
("border-spacing" length length)
("border-style" border-style)
("border-top" border)
("border-top-color" border-color)
("border-top-style" border-style)
("border-top-width" border-width)
("border-width" border-width)
("bottom" length percentage "auto")
("caption-side" "top" "bottom")
("clear" "none" "left" "right" "both")
("clip" shape "auto")
("color" color)
("content" "normal" "none" string uri counter "attr()" "open-quote"
"close-quote" "no-open-quote" "no-close-quote")
("counter-increment" identifier integer "none")
("counter-reset" identifier integer "none")
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize"
"ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize"
"w-resize" "text" "wait" "help" "progress")
("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "run-in" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group" "table-footer-group"
"table-row" "table-column-group" "table-column" "table-cell"
"table-caption" "none")
("elevation" angle "below" "level" "above" "higher" "lower")
("empty-cells" "show" "hide")
("float" "left" "right" "none")
("font" font-style font-weight font-size "/" line-height
font-family "caption" "icon" "menu" "message-box" "small-caption"
"status-bar" "normal" "small-caps"
;; CSS3
font-stretch)
("font-family" family-name generic-family)
("font-size" absolute-size relative-size length percentage)
("font-style" "normal" "italic" "oblique")
("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400"
"500" "600" "700" "800" "900")
("height" length percentage "auto")
("left" length percentage "auto")
("letter-spacing" "normal" length)
("line-height" "normal" number length percentage)
("list-style" list-style-type list-style-position list-style-image)
("list-style-image" uri "none")
("list-style-position" "inside" "outside")
("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero"
"lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin"
"armenian" "georgian" "lower-alpha" "upper-alpha" "none")
("margin" margin-width)
("margin-bottom" margin-width)
("margin-left" margin-width)
("margin-right" margin-width)
("margin-top" margin-width)
("max-height" length percentage "none")
("max-width" length percentage "none")
("min-height" length percentage)
("min-width" length percentage)
("orphans" integer)
("outline" outline-color outline-style outline-width)
("outline-color" color "invert")
("outline-style" border-style)
("outline-width" border-width)
("overflow" "visible" "hidden" "scroll" "auto"
;; CSS3:
"no-display" "no-content")
("padding" padding-width)
("padding-bottom" padding-width)
("padding-left" padding-width)
("padding-right" padding-width)
("padding-top" padding-width)
("page-break-after" "auto" "always" "avoid" "left" "right")
("page-break-before" "auto" "always" "avoid" "left" "right")
("page-break-inside" "avoid" "auto")
("pause" time percentage)
("pause-after" time percentage)
("pause-before" time percentage)
("pitch" frequency "x-low" "low" "medium" "high" "x-high")
("pitch-range" number)
("play-during" uri "mix" "repeat" "auto" "none")
("position" "static" "relative" "absolute" "fixed")
("quotes" string string "none")
("richness" number)
("right" length percentage "auto")
("speak" "normal" "none" "spell-out")
("speak-header" "once" "always")
("speak-numeral" "digits" "continuous")
("speak-punctuation" "code" "none")
("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster"
"slower")
("stress" number)
("table-layout" "auto" "fixed")
("text-align" "left" "right" "center" "justify")
("text-indent" length percentage)
("text-transform" "capitalize" "uppercase" "lowercase" "none")
("top" length percentage "auto")
("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle"
"bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
("voice-family" specific-voice generic-voice "*" specific-voice
generic-voice)
("volume" number percentage "silent" "x-soft" "soft" "medium" "loud"
"x-loud")
("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line")
("widows" integer)
("width" length percentage "auto")
("word-spacing" "normal" length)
("z-index" "auto" integer)
;; CSS3
("align-content" align-stretch "space-between" "space-around")
("align-items" align-stretch "baseline")
("align-self" align-items "auto")
("animation" animation-name animation-duration animation-timing-function
animation-delay animation-iteration-count animation-direction
animation-fill-mode)
("animation-delay" time)
("animation-direction" "normal" "reverse" "alternate" "alternate-reverse")
("animation-duration" time)
("animation-fill-mode" "none" "forwards" "backwards" "both")
("animation-iteration-count" integer "infinite")
("animation-name" "none")
("animation-play-state" "paused" "running")
("animation-timing-function" transition-timing-function
"step-start" "step-end" "steps(,)")
("backface-visibility" "visible" "hidden")
("background-clip" background-origin)
("background-origin" "border-box" "padding-box" "content-box")
("background-size" length percentage "auto" "cover" "contain")
("border-image" border-image-outset border-image-repeat border-image-source
border-image-slice border-image-width)
("border-image-outset" length)
("border-image-repeat" "stretch" "repeat" "round" "space")
("border-image-source" uri "none")
("border-image-slice" length)
("border-image-width" length percentage)
("border-radius" length)
("border-top-left-radius" length)
("border-top-right-radius" length)
("border-bottom-left-radius" length)
("border-bottom-right-radius" length)
("box-decoration-break" "slice" "clone")
("box-shadow" length color)
("box-sizing" "content-box" "border-box")
("break-after" "auto" "always" "avoid" "left" "right" "page" "column"
"avoid-page" "avoid-column")
("break-before" break-after)
("break-inside" "avoid" "auto")
("columns" column-width column-count)
("column-count" integer)
("column-fill" "auto" "balance")
("column-gap" length "normal")
("column-rule" column-rule-width column-rule-style column-rule-color)
("column-rule-color" color)
("column-rule-style" border-style)
("column-rule-width" border-width)
("column-span" "all" "none")
("column-width" length "auto")
("filter" url "blur()" "brightness()" "contrast()" "drop-shadow()"
"grayscale()" "hue-rotate()" "invert()" "opacity()" "saturate()" "sepia()")
("flex" flex-grow flex-shrink flex-basis)
("flex-basis" percentage length "auto")
("flex-direction" "row" "row-reverse" "column" "column-reverse")
("flex-flow" flex-direction flex-wrap)
("flex-grow" number)
("flex-shrink" number)
("flex-wrap" "nowrap" "wrap" "wrap-reverse")
("font-feature-setting" normal string number)
("font-kerning" "auto" "normal" "none")
("font-language-override" "normal" string)
("font-size-adjust" "none" number)
("font-stretch" "normal" "ultra-condensed" "extra-condensed" "condensed"
"semi-condensed" "semi-expanded" "expanded" "extra-expanded" "ultra-expanded")
("font-synthesis" "none" "weight" "style")
("font-variant" font-variant-alternates font-variant-caps
font-variant-east-asian font-variant-ligatures font-variant-numeric
font-variant-position)
("font-variant-alternates" "normal" "historical-forms" "stylistic()"
"styleset()" "character-variant()" "swash()" "ornaments()" "annotation()")
("font-variant-caps" "normal" "small-caps" "all-small-caps" "petite-caps"
"all-petite-caps" "unicase" "titling-caps")
("font-variant-east-asian" "jis78" "jis83" "jis90" "jis04" "simplified"
"traditional" "full-width" "proportional-width" "ruby")
("font-variant-ligatures" "normal" "none" "common-ligatures"
"no-common-ligatures" "discretionary-ligatures" "no-discretionary-ligatures"
"historical-ligatures" "no-historical-ligatures" "contextual" "no-contextual")
("font-variant-numeric" "normal" "ordinal" "slashed-zero"
"lining-nums" "oldstyle-nums" "proportional-nums" "tabular-nums"
"diagonal-fractions" "stacked-fractions")
("font-variant-position" "normal" "sub" "super")
("hyphens" "none" "manual" "auto")
("justify-content" align-common "space-between" "space-around")
("line-break" "auto" "loose" "normal" "strict")
("marquee-direction" "forward" "reverse")
("marquee-play-count" integer "infinite")
("marquee-speed" "slow" "normal" "fast")
("marquee-style" "scroll" "slide" "alternate")
("opacity" number)
("order" number)
("outline-offset" length)
("overflow-x" overflow)
("overflow-y" overflow)
("overflow-style" "auto" "marquee-line" "marquee-block")
("overflow-wrap" "normal" "break-word")
("perspective" "none" length)
("perspective-origin" percentage length "left" "center" "right" "top" "bottom")
("resize" "none" "both" "horizontal" "vertical")
("tab-size" integer length)
("text-align-last" "auto" "start" "end" "left" "right" "center" "justify")
("text-decoration" text-decoration-color text-decoration-line text-decoration-style)
("text-decoration-color" color)
("text-decoration-line" "none" "underline" "overline" "line-through" "blink")
("text-decoration-style" "solid" "double" "dotted" "dashed" "wavy")
("text-overflow" "clip" "ellipsis")
("text-shadow" color length)
("text-underline-position" "auto" "under" "left" "right")
("transform" "matrix(,,,,,)" "translate(,)" "translateX()" "translateY()"
"scale()" "scaleX()" "scaleY()" "rotate()" "skewX()" "skewY()" "none")
("transform-origin" perspective-origin)
("transform-style" "flat" "preserve-3d")
("transition" transition-property transition-duration
transition-timing-function transition-delay)
("transition-delay" time)
("transition-duration" time)
("transition-timing-function"
"ease" "linear" "ease-in" "ease-out" "ease-in-out" "cubic-bezier(,,,)")
("transition-property" "none" "all" identifier)
("word-wrap" overflow-wrap)
("word-break" "normal" "break-all" "keep-all"))
"A list of CSS properties and their possible values.")
(defconst company-css-value-classes
'((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large"
"xx-large")
(align-common "flex-start" "flex-end" "center")
(align-stretch align-common "stretch")
(border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove"
"ridge" "inset" "outset")
(border-width "thick" "medium" "thin")
(color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy"
"olive" "orange" "purple" "red" "silver" "teal" "white" "yellow")
(counter "counter(,)")
(family-name "Courier" "Helvetica" "Times")
(generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace")
(generic-voice "male" "female" "child")
(margin-width "auto") ;; length percentage
(relative-size "larger" "smaller")
(shape "rect(,,,)")
(uri "url()"))
"A list of CSS property value classes and their contents.")
;; missing, because not completable
;; <angle><frequency><identifier><integer><length><number><padding-width>
;; <percentage><specific-voice><string><time><uri>
(defconst company-css-html-tags
'("a" "abbr" "acronym" "address" "applet" "area" "b" "base" "basefont" "bdo"
"big" "blockquote" "body" "br" "button" "caption" "center" "cite" "code"
"col" "colgroup" "dd" "del" "dfn" "dir" "div" "dl" "dt" "em" "fieldset"
"font" "form" "frame" "frameset" "h1" "h2" "h3" "h4" "h5" "h6" "head" "hr"
"html" "i" "iframe" "img" "input" "ins" "isindex" "kbd" "label" "legend"
"li" "link" "map" "menu" "meta" "noframes" "noscript" "object" "ol"
"optgroup" "option" "p" "param" "pre" "q" "s" "samp" "script" "select"
"small" "span" "strike" "strong" "style" "sub" "sup" "table" "tbody" "td"
"textarea" "tfoot" "th" "thead" "title" "tr" "tt" "u" "ul" "var"
;; HTML5
"section" "article" "aside" "header" "footer" "nav" "figure" "figcaption"
"time" "mark" "main")
"A list of HTML tags for use in CSS completion.")
(defconst company-css-pseudo-classes
'("active" "after" "before" "first" "first-child" "first-letter" "first-line"
"focus" "hover" "lang" "left" "link" "right" "visited")
"Identifiers for CSS pseudo-elements and pseudo-classes.")
(defconst company-css-property-cache (make-hash-table :size 115 :test 'equal))
(defun company-css-property-values (attribute)
"Access the `company-css-property-alist' cached and flattened."
(or (gethash attribute company-css-property-cache)
(let (results)
(dolist (value (cdr (assoc attribute company-css-property-alist)))
(if (symbolp value)
(dolist (child (or (cdr (assoc value company-css-value-classes))
(company-css-property-values
(symbol-name value))))
(push child results))
(push value results)))
(setq results (sort results 'string<))
(puthash attribute
(if (fboundp 'delete-consecutive-dups)
(delete-consecutive-dups results)
(delete-dups results))
company-css-property-cache)
results)))
;;; bracket detection
(defconst company-css-braces-syntax-table
(let ((table (make-syntax-table)))
(setf (aref table ?{) '(4 . 125))
(setf (aref table ?}) '(5 . 123))
table)
"A syntax table giving { and } paren syntax.")
(defun company-css-inside-braces-p ()
"Return non-nil, if point is within matched { and }."
(ignore-errors
(with-syntax-table company-css-braces-syntax-table
(let ((parse-sexp-ignore-comments t))
(scan-lists (point) -1 1)))))
;;; tags
(defconst company-css-tag-regexp
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
;; multiple
"\\(?:"
;; previous tags:
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
;; space or selectors
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
"\\)*"
"\\(\\(?:#\\|\\_<[[:alpha:]]\\)\\(?:[[:alnum:]-#]*\\_>\\)?\\_>\\|\\)"
"\\=")
"A regular expression matching CSS tags.")
;;; pseudo id
(defconst company-css-pseudo-regexp
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
;; multiple
"\\(?:"
;; previous tags:
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
;; space or delimiters
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
"\\)*"
"\\(?:\\(?:\\#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\):"
"\\([[:alpha:]-]+\\_>\\|\\)\\_>\\=")
"A regular expression matching CSS pseudo classes.")
;;; properties
(defun company-css-grab-property ()
"Return the CSS property before point, if any.
Returns \"\" if no property found, but feasible at this position."
(when (company-css-inside-braces-p)
(company-grab-symbol)))
;;; values
(defconst company-css-property-value-regexp
"\\_<\\([[:alpha:]-]+\\):\\(?:[^{};]*[[:space:]]+\\)?\\([^{};]*\\_>\\|\\)\\="
"A regular expression matching CSS tags.")
;;;###autoload
(defun company-css (command &optional arg &rest ignored)
"`company-mode' completion back-end for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
(prefix (and (derived-mode-p 'css-mode)
(or (company-grab company-css-tag-regexp 1)
(company-grab company-css-pseudo-regexp 1)
(company-grab company-css-property-value-regexp 2)
(company-css-grab-property))))
(candidates
(cond
((company-grab company-css-tag-regexp 1)
(all-completions arg company-css-html-tags))
((company-grab company-css-pseudo-regexp 1)
(all-completions arg company-css-pseudo-classes))
((company-grab company-css-property-value-regexp 2)
(all-completions arg
(company-css-property-values
(company-grab company-css-property-value-regexp 1))))
((company-css-grab-property)
(all-completions arg company-css-property-alist))))
(sorted t)))
(provide 'company-css)
;;; company-css.el ends here

View File

@ -0,0 +1,104 @@
;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end for code -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-dabbrev)
(require 'cl-lib)
(defgroup company-dabbrev-code nil
"dabbrev-like completion back-end for code."
:group 'company)
(defcustom company-dabbrev-code-modes
'(prog-mode
batch-file-mode csharp-mode css-mode erlang-mode haskell-mode jde-mode
lua-mode python-mode)
"Modes that use `company-dabbrev-code'.
In all these modes (and their derivatives) `company-dabbrev-code' will
complete only symbols, not text in comments or strings. In other modes
`company-dabbrev-code' will pass control to other back-ends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
:type '(choice (repeat (symbol :tag "Major mode"))
(const tag "All modes" t)))
(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'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "Code major modes" code)
(const :tag "All" all)))
(defcustom company-dabbrev-code-time-limit .1
"Determines how long `company-dabbrev-code' should look for matches."
:type '(choice (const :tag "Off" nil)
(number :tag "Seconds")))
(defcustom company-dabbrev-code-everywhere nil
"Non-nil to offer completions in comments and strings."
:type 'boolean)
(defcustom company-dabbrev-code-ignore-case nil
"Non-nil to ignore case in completion candidates."
:type 'boolean)
(defsubst company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
"\\(\\sw\\|\\s_\\)*\\_>"))
;;;###autoload
(defun company-dabbrev-code (command &optional arg &rest ignored)
"dabbrev-like `company-mode' back-end for code.
The back-end looks for all symbols in the current buffer that aren't in
comments or strings."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev-code))
(prefix (and (or (eq t company-dabbrev-code-modes)
(apply #'derived-mode-p company-dabbrev-code-modes))
(or company-dabbrev-code-everywhere
(not (company-in-string-or-comment)))
(or (company-grab-symbol) 'stop)))
(candidates (let ((case-fold-search company-dabbrev-code-ignore-case))
(company-dabbrev--search
(company-dabbrev-code--make-regexp arg)
company-dabbrev-code-time-limit
(pcase company-dabbrev-code-other-buffers
(`t (list major-mode))
(`code company-dabbrev-code-modes)
(`all `all))
t)))
(ignore-case company-dabbrev-code-ignore-case)
(duplicates t)))
(provide 'company-dabbrev-code)
;;; company-dabbrev-code.el ends here

View File

@ -0,0 +1,153 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-dabbrev nil
"dabbrev-like completion back-end."
:group 'company)
(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'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "All" all)))
(defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches."
:type '(choice (const :tag "Off" nil)
(number :tag "Seconds")))
(defcustom company-dabbrev-char-regexp "\\sw"
"A regular expression matching the characters `company-dabbrev' looks for."
:type 'regexp)
(defcustom company-dabbrev-ignore-case 'keep-prefix
"The value of `ignore-case' returned by `company-dabbrev'.")
(defcustom company-dabbrev-downcase 'case-replace
"Whether to downcase the returned candidates.
The value of nil means keep them as-is.
`case-replace' means use the value of `case-replace'.
Any other value means downcase.
If you set this value to nil, you may also want to set
`company-dabbrev-ignore-case' to any value other than `keep-prefix'.")
(defcustom company-dabbrev-minimum-length (1+ company-minimum-prefix-length)
"The minimum length for the string to be included."
:type 'integer)
(defmacro company-dabrev--time-limit-while (test start limit &rest body)
(declare (indent 3) (debug t))
`(let ((company-time-limit-while-counter 0))
(catch 'done
(while ,test
,@body
(and ,limit
(eq (cl-incf company-time-limit-while-counter) 25)
(setq company-time-limit-while-counter 0)
(> (float-time (time-since ,start)) ,limit)
(throw 'done 'company-time-out))))))
(defsubst company-dabbrev--make-regexp (prefix)
(concat "\\<" (if (equal prefix "")
company-dabbrev-char-regexp
(regexp-quote prefix))
"\\(" company-dabbrev-char-regexp "\\)*\\>"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
(let (match)
(goto-char (if pos (1- pos) (point-min)))
;; search before pos
(company-dabrev--time-limit-while (re-search-backward regexp nil t)
start limit
(setq match (match-string-no-properties 0))
(if (and ignore-comments (company-in-string-or-comment))
(re-search-backward "\\s<\\|\\s!\\|\\s\"\\|\\s|" nil t)
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
(goto-char (or pos (point-min)))
;; search after pos
(company-dabrev--time-limit-while (re-search-forward regexp nil t)
start limit
(setq match (match-string-no-properties 0))
(if (and ignore-comments (company-in-string-or-comment))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
symbols)))
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
ignore-comments)
(let* ((start (current-time))
(symbols (company-dabbrev--search-buffer regexp (point) nil start limit
ignore-comments)))
(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))
(setq symbols
(company-dabbrev--search-buffer regexp nil symbols start
limit ignore-comments))))
(and limit
(> (float-time (time-since start)) limit)
(cl-return))))
symbols))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
"dabbrev-like `company-mode' completion back-end."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-grab-word))
(candidates
(let ((words (company-dabbrev--search (company-dabbrev--make-regexp arg)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
(`all `all))))
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
(if downcase-p
(mapcar 'downcase words)
words)))
(ignore-case company-dabbrev-ignore-case)
(duplicates t)))
(provide 'company-dabbrev)
;;; company-dabbrev.el ends here

View File

@ -0,0 +1,183 @@
;;; company-eclim.el --- company-mode completion back-end for Eclim
;; Copyright (C) 2009, 2011, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Using `emacs-eclim' together with (or instead of) this back-end is
;; recommended, as it allows you to use other Eclim features.
;;
;; The alternative back-end provided by `emacs-eclim' uses `yasnippet'
;; instead of `company-template' to expand function calls, and it supports
;; some languages other than Java.
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-eclim nil
"Completion back-end for Eclim."
:group 'company)
(defun company-eclim-executable-find ()
(let (file)
(cl-dolist (eclipse-root '("/Applications/eclipse" "/usr/lib/eclipse"
"/usr/local/lib/eclipse"))
(and (file-exists-p (setq file (expand-file-name "plugins" eclipse-root)))
(setq file (car (last (directory-files file t "^org.eclim_"))))
(file-exists-p (setq file (expand-file-name "bin/eclim" file)))
(cl-return file)))))
(defcustom company-eclim-executable
(or (executable-find "eclim") (company-eclim-executable-find))
"Location of eclim executable."
:type 'file)
(defcustom company-eclim-auto-save t
"Determines whether to save the buffer when retrieving completions.
eclim can only complete correctly when the buffer has been saved."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-eclim--project-dir 'unknown)
(defvar-local company-eclim--project-name nil)
(declare-function json-read "json")
(defvar json-array-type)
(defun company-eclim--call-process (&rest args)
(let ((coding-system-for-read 'utf-8)
res)
(require 'json)
(with-temp-buffer
(if (= 0 (setq res (apply 'call-process company-eclim-executable nil t nil
"-command" args)))
(let ((json-array-type 'list))
(goto-char (point-min))
(unless (eobp)
(json-read)))
(message "Company-eclim command failed with error %d:\n%s" res
(buffer-substring (point-min) (point-max)))
nil))))
(defun company-eclim--project-list ()
(company-eclim--call-process "project_list"))
(defun company-eclim--project-dir ()
(if (eq company-eclim--project-dir 'unknown)
(setq company-eclim--project-dir
(directory-file-name
(expand-file-name
(locate-dominating-file buffer-file-name ".project"))))
company-eclim--project-dir))
(defun company-eclim--project-name ()
(or company-eclim--project-name
(let ((dir (company-eclim--project-dir)))
(when dir
(setq company-eclim--project-name
(cl-loop for project in (company-eclim--project-list)
when (equal (cdr (assoc 'path project)) dir)
return (cdr (assoc 'name project))))))))
(defun company-eclim--candidates (prefix)
(interactive "d")
(let ((project-file (file-relative-name buffer-file-name
(company-eclim--project-dir)))
completions)
(when company-eclim-auto-save
(when (buffer-modified-p)
(basic-save-buffer))
;; FIXME: Sometimes this isn't finished when we complete.
(company-eclim--call-process "java_src_update"
"-p" (company-eclim--project-name)
"-f" project-file))
(dolist (item (cdr (assoc 'completions
(company-eclim--call-process
"java_complete" "-p" (company-eclim--project-name)
"-f" project-file
"-o" (number-to-string
(company-eclim--search-point prefix))
"-e" "utf-8"
"-l" "standard"))))
(let* ((meta (cdr (assoc 'info item)))
(completion meta))
(when (string-match " ?[(:-]" completion)
(setq completion (substring completion 0 (match-beginning 0))))
(put-text-property 0 1 'meta meta completion)
(push completion completions)))
(let ((completion-ignore-case nil))
(all-completions prefix completions))))
(defun company-eclim--search-point (prefix)
(if (or (cl-plusp (length prefix)) (eq (char-before) ?.))
(1- (point))
(point)))
(defun company-eclim--meta (candidate)
(get-text-property 0 'meta candidate))
(defun company-eclim--annotation (candidate)
(let ((meta (company-eclim--meta candidate)))
(when (string-match "\\(([^-]*\\) -" meta)
(substring meta (match-beginning 1) (match-end 1)))))
(defun company-eclim--prefix ()
(let ((prefix (company-grab-symbol)))
(when prefix
;; Completion candidates for annotations don't include '@'.
(when (eq ?@ (string-to-char prefix))
(setq prefix (substring prefix 1)))
prefix)))
(defun company-eclim (command &optional arg &rest ignored)
"`company-mode' completion back-end for Eclim.
Eclim provides access to Eclipse Java IDE features for other editors.
Eclim version 1.7.13 or newer (?) is required.
Completions only work correctly when the buffer has been saved.
`company-eclim-auto-save' determines whether to do this automatically."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-eclim))
(prefix (and (derived-mode-p 'java-mode 'jde-mode)
buffer-file-name
company-eclim-executable
(company-eclim--project-name)
(not (company-in-string-or-comment))
(or (company-eclim--prefix) 'stop)))
(candidates (company-eclim--candidates arg))
(meta (company-eclim--meta arg))
;; because "" doesn't return everything
(no-cache (equal arg ""))
(annotation (company-eclim--annotation arg))
(post-completion (let ((anno (company-eclim--annotation arg)))
(when anno
(insert anno)
(company-template-c-like-templatify anno))))))
(provide 'company-eclim)
;;; company-eclim.el ends here

View File

@ -0,0 +1,193 @@
;;; company-elisp-tests.el --- company-elisp tests
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company-elisp)
(defmacro company-elisp-with-buffer (contents &rest body)
(declare (indent 0))
`(with-temp-buffer
(insert ,contents)
(setq major-mode 'emacs-lisp-mode)
(re-search-backward "|")
(replace-match "")
(let ((company-elisp-detect-function-context t))
,@body)))
(ert-deftest company-elisp-candidates-predicate ()
(company-elisp-with-buffer
"(foo ba|)"
(should (eq (company-elisp--candidates-predicate "ba")
'boundp))
(should (eq (let (company-elisp-detect-function-context)
(company-elisp--candidates-predicate "ba"))
'company-elisp--predicate)))
(company-elisp-with-buffer
"(foo| )"
(should (eq (company-elisp--candidates-predicate "foo")
'fboundp))
(should (eq (let (company-elisp-detect-function-context)
(company-elisp--candidates-predicate "foo"))
'company-elisp--predicate)))
(company-elisp-with-buffer
"(foo 'b|)"
(should (eq (company-elisp--candidates-predicate "b")
'company-elisp--predicate))))
(ert-deftest company-elisp-candidates-predicate-in-docstring ()
(company-elisp-with-buffer
"(def foo () \"Doo be doo `ide|"
(should (eq 'company-elisp--predicate
(company-elisp--candidates-predicate "ide")))))
;; This one's also an integration test.
(ert-deftest company-elisp-candidates-recognizes-binding-form ()
(let ((company-elisp-detect-function-context t)
(obarray [when what whelp])
(what 1)
(whelp 2)
(wisp 3))
(company-elisp-with-buffer
"(let ((foo 7) (wh| )))"
(should (equal '("what" "whelp")
(company-elisp-candidates "wh"))))
(company-elisp-with-buffer
"(cond ((null nil) (wh| )))"
(should (equal '("when")
(company-elisp-candidates "wh"))))))
(ert-deftest company-elisp-candidates-predicate-binding-without-value ()
(cl-loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp)
("(let (foo (bar|" "bar" boundp)
("(let (foo) (bar|" "bar" fboundp))
do
(eval `(company-elisp-with-buffer
,text
(should (eq ',predicate
(company-elisp--candidates-predicate ,prefix)))))))
(ert-deftest company-elisp-finds-vars ()
(let ((obarray [boo bar baz backquote])
(boo t)
(bar t)
(baz t))
(should (equal '("bar" "baz")
(company-elisp--globals "ba" 'boundp)))))
(ert-deftest company-elisp-finds-functions ()
(let ((obarray [when what whelp])
(what t)
(whelp t))
(should (equal '("when")
(company-elisp--globals "wh" 'fboundp)))))
(ert-deftest company-elisp-finds-things ()
(let ((obarray [when what whelp])
(what t)
(whelp t))
(should (equal '("what" "whelp" "when")
(sort (company-elisp--globals "wh" 'company-elisp--predicate)
'string<)))))
(ert-deftest company-elisp-locals-vars ()
(company-elisp-with-buffer
"(let ((foo 5) (bar 6))
(cl-labels ((borg ()))
(lambda (boo baz)
b|)))"
(should (equal '("bar" "baz" "boo")
(company-elisp--locals "b" nil)))))
(ert-deftest company-elisp-locals-single-var ()
(company-elisp-with-buffer
"(dotimes (itk 100)
(dolist (item items)
it|))"
(should (equal '("itk" "item")
(company-elisp--locals "it" nil)))))
(ert-deftest company-elisp-locals-funs ()
(company-elisp-with-buffer
"(cl-labels ((foo ())
(fee ()))
(let ((fun 4))
(f| )))"
(should (equal '("fee" "foo")
(sort (company-elisp--locals "f" t) 'string<)))))
(ert-deftest company-elisp-locals-skips-current-varlist ()
(company-elisp-with-buffer
"(let ((foo 1)
(f| )))"
(should (null (company-elisp--locals "f" nil)))))
(ert-deftest company-elisp-show-locals-first ()
(company-elisp-with-buffer
"(let ((floo 1)
(flop 2)
(flee 3))
fl|)"
(let ((obarray [float-pi]))
(let (company-elisp-show-locals-first)
(should (eq nil (company-elisp 'sorted))))
(let ((company-elisp-show-locals-first t))
(should (eq t (company-elisp 'sorted)))
(should (equal '("flee" "floo" "flop" "float-pi")
(company-elisp-candidates "fl")))))))
(ert-deftest company-elisp-candidates-no-duplicates ()
(company-elisp-with-buffer
"(let ((float-pi 4))
f|)"
(let ((obarray [float-pi])
(company-elisp-show-locals-first t))
(should (equal '("float-pi") (company-elisp-candidates "f"))))))
(ert-deftest company-elisp-shouldnt-complete-defun-name ()
(company-elisp-with-buffer
"(defun foob|)"
(should (null (company-elisp 'prefix)))))
(ert-deftest company-elisp-should-complete-def-call ()
(company-elisp-with-buffer
"(defu|"
(should (equal "defu" (company-elisp 'prefix)))))
(ert-deftest company-elisp-should-complete-in-defvar ()
;; It will also complete the var name, at least for now.
(company-elisp-with-buffer
"(defvar abc de|"
(should (equal "de" (company-elisp 'prefix)))))
(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist ()
(company-elisp-with-buffer
"(defsubst foobar (ba|"
(should (null (company-elisp 'prefix)))))
(ert-deftest company-elisp-prefix-in-defun-body ()
(company-elisp-with-buffer
"(defun foob ()|)"
(should (equal "" (company-elisp 'prefix)))))

View File

@ -0,0 +1,225 @@
;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'help-mode)
(require 'find-func)
(defgroup company-elisp nil
"Completion back-end for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
"If enabled, offer Lisp functions only in appropriate contexts.
Functions are offered for completion only after ' and \(."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defcustom company-elisp-show-locals-first t
"If enabled, locally bound variables and functions are displayed
first in the candidates list."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defun company-elisp--prefix ()
(let ((prefix (company-grab-symbol)))
(if prefix
(when (if (company-in-string-or-comment)
(= (char-before (- (point) (length prefix))) ?`)
(company-elisp--should-complete))
prefix)
'stop)))
(defun company-elisp--predicate (symbol)
(or (boundp symbol)
(fboundp symbol)
(facep symbol)
(featurep symbol)))
(defun company-elisp--fns-regexp (&rest names)
(concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
(defvar company-elisp-parse-limit 30)
(defvar company-elisp-parse-depth 100)
(defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
(defvar company-elisp-var-binding-regexp
(apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
company-elisp-defun-names)
"Regular expression matching head of a multiple variable bindings form.")
(defvar company-elisp-var-binding-regexp-1
(company-elisp--fns-regexp "dolist" "dotimes")
"Regular expression matching head of a form with one variable binding.")
(defvar company-elisp-fun-binding-regexp
(company-elisp--fns-regexp "flet" "labels")
"Regular expression matching head of a function bindings form.")
(defvar company-elisp-defuns-regexp
(concat "([ \t\n]*"
(apply #'company-elisp--fns-regexp company-elisp-defun-names)))
(defun company-elisp--should-complete ()
(let ((start (point))
(depth (car (syntax-ppss))))
(not
(when (> depth 0)
(save-excursion
(up-list (- depth))
(when (looking-at company-elisp-defuns-regexp)
(forward-char)
(forward-sexp 1)
(unless (= (point) start)
(condition-case nil
(let ((args-end (scan-sexps (point) 2)))
(or (null args-end)
(> args-end start)))
(scan-error
t)))))))))
(defun company-elisp--locals (prefix functions-p)
(let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
"\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
(pos (point))
res)
(condition-case nil
(save-excursion
(dotimes (_ company-elisp-parse-depth)
(up-list -1)
(save-excursion
(when (eq (char-after) ?\()
(forward-char 1)
(when (ignore-errors
(save-excursion (forward-list)
(<= (point) pos)))
(skip-chars-forward " \t\n")
(cond
((looking-at (if functions-p
company-elisp-fun-binding-regexp
company-elisp-var-binding-regexp))
(down-list 1)
(condition-case nil
(dotimes (_ company-elisp-parse-limit)
(save-excursion
(when (looking-at "[ \t\n]*(")
(down-list 1))
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))
(forward-sexp))
(scan-error nil)))
((unless functions-p
(looking-at company-elisp-var-binding-regexp-1))
(down-list 1)
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))))))))
(scan-error nil))
res))
(defun company-elisp-candidates (prefix)
(let* ((predicate (company-elisp--candidates-predicate prefix))
(locals (company-elisp--locals prefix (eq predicate 'fboundp)))
(globals (company-elisp--globals prefix predicate))
(locals (cl-loop for local in locals
when (not (member local globals))
collect local)))
(if company-elisp-show-locals-first
(append (sort locals 'string<)
(sort globals 'string<))
(append locals globals))))
(defun company-elisp--globals (prefix predicate)
(all-completions prefix obarray predicate))
(defun company-elisp--candidates-predicate (prefix)
(let* ((completion-ignore-case nil)
(beg (- (point) (length prefix)))
(before (char-before beg)))
(if (and company-elisp-detect-function-context
(not (memq before '(?' ?`))))
(if (and (eq before ?\()
(not
(save-excursion
(ignore-errors
(goto-char (1- beg))
(or (company-elisp--before-binding-varlist-p)
(progn
(up-list -1)
(company-elisp--before-binding-varlist-p)))))))
'fboundp
'boundp)
'company-elisp--predicate)))
(defun company-elisp--before-binding-varlist-p ()
(save-excursion
(and (prog1 (search-backward "(")
(forward-char 1))
(looking-at company-elisp-var-binding-regexp))))
(defun company-elisp--doc (symbol)
(let* ((symbol (intern symbol))
(doc (if (fboundp symbol)
(documentation symbol t)
(documentation-property symbol 'variable-documentation t))))
(and (stringp doc)
(string-match ".*$" doc)
(match-string 0 doc))))
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
"`company-mode' completion back-end for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))
(prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
(company-elisp--prefix)))
(candidates (company-elisp-candidates arg))
(sorted company-elisp-show-locals-first)
(meta (company-elisp--doc arg))
(doc-buffer (let ((symbol (intern arg)))
(save-window-excursion
(ignore-errors
(cond
((fboundp symbol) (describe-function symbol))
((boundp symbol) (describe-variable symbol))
((featurep symbol) (describe-package symbol))
((facep symbol) (describe-face symbol))
(t (signal 'user-error nil)))
(help-buffer)))))
(location (let ((sym (intern arg)))
(cond
((fboundp sym) (find-definition-noselect sym nil))
((boundp sym) (find-definition-noselect sym 'defvar))
((featurep sym) (cons (find-file-noselect (find-library-name
(symbol-name sym)))
0))
((facep sym) (find-definition-noselect sym 'defface)))))))
(provide 'company-elisp)
;;; company-elisp.el ends here

View File

@ -0,0 +1,94 @@
;;; company-etags.el --- company-mode completion back-end for etags
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'etags)
(defgroup company-etags nil
"Completion back-end for etags."
:group 'company)
(defcustom company-etags-use-main-table-list t
"Always search `tags-table-list' if set.
If this is disabled, `company-etags' will try to find the one table for each
buffer automatically."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)))
(defcustom company-etags-ignore-case nil
"Non-nil to ignore case in completion candidates."
:type 'boolean
:package-version '(company . "0.7.3"))
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
jde-mode pascal-mode perl-mode python-mode))
(defvar-local company-etags-buffer-table 'unknown)
(defun company-etags-find-table ()
(let ((file (locate-dominating-file (or buffer-file-name
default-directory)
"TAGS")))
(when file
(list (expand-file-name file)))))
(defun company-etags-buffer-table ()
(or (and company-etags-use-main-table-list tags-table-list)
(if (eq company-etags-buffer-table 'unknown)
(setq company-etags-buffer-table (company-etags-find-table))
company-etags-buffer-table)))
(defun company-etags--candidates (prefix)
(let ((tags-table-list (company-etags-buffer-table))
(completion-ignore-case company-etags-ignore-case))
(and (or tags-file-name tags-table-list)
(fboundp 'tags-completion-table)
(save-excursion
(visit-tags-table-buffer)
(all-completions prefix (tags-completion-table))))))
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
"`company-mode' completion back-end for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
(prefix (and (apply 'derived-mode-p company-etags-modes)
(not (company-in-string-or-comment))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))
(location (let ((tags-table-list (company-etags-buffer-table)))
(when (fboundp 'find-tag-noselect)
(save-excursion
(let ((buffer (find-tag-noselect arg)))
(cons buffer (with-current-buffer buffer (point))))))))
(ignore-case company-etags-ignore-case)))
(provide 'company-etags)
;;; company-etags.el ends here

View File

@ -0,0 +1,93 @@
;;; company-files.el --- company-mode completion back-end for file names
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(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]\\"
"~?/")))
(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.
(let (file dir)
(and (cl-dolist (regexp company-files-regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
(setq dir (file-name-directory file))
(not (string-match "//" dir))
(file-exists-p dir)
(file-name-all-completions (file-name-nondirectory file) dir)
file)))
(defvar company-files-completion-cache nil)
(defun company-files-complete (prefix)
(let* ((dir (file-name-directory prefix))
(file (file-name-nondirectory prefix))
candidates directories)
(unless (equal dir (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 ""))
(push (concat directory
(unless (eq (aref directory (1- (length directory))) ?/) "/")
child) candidates)))
(setq company-files-completion-cache (cons dir (nreverse candidates))))
(all-completions prefix
(cdr company-files-completion-cache))))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
"`company-mode' completion back-end existing file names."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-files))
(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)
(no-cache t)))
(provide 'company-files)
;;; company-files.el ends here

View File

@ -0,0 +1,109 @@
;;; company-gtags.el --- company-mode completion back-end for GNU Global
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-gtags nil
"Completion back-end for GNU Global."
:group 'company)
(defcustom company-gtags-executable
(executable-find "global")
"Location of GNU global executable."
:type 'string)
(define-obsolete-variable-alias
'company-gtags-gnu-global-program-name
'company-gtags-executable "earlier")
(defcustom company-gtags-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.8.1"))
(defvar-local company-gtags--tags-available-p 'unknown)
(defvar company-gtags-modes '(c-mode c++-mode jde-mode java-mode php-mode))
(defun company-gtags--tags-available-p ()
(if (eq company-gtags--tags-available-p 'unknown)
(setq company-gtags--tags-available-p
(locate-dominating-file buffer-file-name "GTAGS"))
company-gtags--tags-available-p))
(defun company-gtags--fetch-tags (prefix)
(with-temp-buffer
(let (tags)
(when (= 0 (call-process company-gtags-executable nil
(list (current-buffer) nil) nil "-xGq" (concat "^" prefix)))
(goto-char (point-min))
(cl-loop while
(re-search-forward (concat
"^"
"\\([^ ]*\\)" ;; completion
"[ \t]+\\([[:digit:]]+\\)" ;; linum
"[ \t]+\\([^ \t]+\\)" ;; file
"[ \t]+\\(.*\\)" ;; definition
"$"
) nil t)
collect
(propertize (match-string 1)
'meta (match-string 4)
'location (cons (expand-file-name (match-string 3))
(string-to-number (match-string 2)))
))))))
(defun company-gtags--annotation (arg)
(let ((meta (get-text-property 0 'meta arg)))
(when (string-match (concat arg "\\((.*)\\).*") meta)
(match-string 1 meta))))
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
"`company-mode' completion back-end for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
(prefix (and company-gtags-executable
(memq major-mode company-gtags-modes)
(not (company-in-string-or-comment))
(company-gtags--tags-available-p)
(or (company-grab-symbol) 'stop)))
(candidates (company-gtags--fetch-tags arg))
(sorted t)
(duplicates t)
(annotation (company-gtags--annotation arg))
(meta (get-text-property 0 'meta arg))
(location (get-text-property 0 'location arg))
(post-completion (let ((anno (company-gtags--annotation arg)))
(when (and company-gtags-insert-arguments anno)
(insert anno)
(company-template-c-like-templatify anno))))))
(provide 'company-gtags)
;;; company-gtags.el ends here

View File

@ -0,0 +1,69 @@
;;; company-ispell.el --- company-mode completion back-end using Ispell
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'ispell)
(defgroup company-ispell nil
"Completion back-end using Ispell."
:group 'company)
(defcustom company-ispell-dictionary nil
"Dictionary to use for `company-ispell'.
If nil, use `ispell-complete-word-dict'."
:type '(choice (const :tag "default (nil)" nil)
(file :tag "dictionary" t)))
(defvar company-ispell-available 'unknown)
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
(lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company: ispell-look-command not found")
(setq company-ispell-available nil))))
company-ispell-available)
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
"`company-mode' completion back-end using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates (lookup-words arg (or company-ispell-dictionary
ispell-complete-word-dict)))
(sorted t)
(ignore-case 'keep-prefix)))
(provide 'company-ispell)
;;; company-ispell.el ends here

View File

@ -0,0 +1,236 @@
;;; company-keywords.el --- A company back-end for programming language keywords
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defun company-keywords-upper-lower (&rest lst)
;; Upcase order is different for _.
(nconc (sort (mapcar 'upcase lst) 'string<) lst))
(defvar company-keywords-alist
;; Please contribute corrections or additions.
`((c++-mode
"asm" "auto" "bool" "break" "case" "catch" "char" "class" "const"
"const_cast" "continue" "default" "delete" "do" "double" "dynamic_cast"
"else" "enum" "explicit" "export" "extern" "false" "float" "for" "friend"
"goto" "if" "inline" "int" "long" "mutable" "namespace" "new"
"operator" "private" "protected" "public" "register" "reinterpret_cast"
"return" "short" "signed" "sizeof" "static" "static_cast" "struct" "switch"
"template" "this" "throw" "true" "try" "typedef" "typeid" "typename"
"union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while")
(c-mode
"auto" "break" "case" "char" "const" "continue" "default" "do"
"double" "else" "enum" "extern" "float" "for" "goto" "if" "int" "long"
"register" "return" "short" "signed" "sizeof" "static" "struct"
"switch" "typedef" "union" "unsigned" "void" "volatile" "while")
(csharp-mode
"abstract" "add" "alias" "as" "base" "bool" "break" "byte" "case"
"catch" "char" "checked" "class" "const" "continue" "decimal" "default"
"delegate" "do" "double" "else" "enum" "event" "explicit" "extern"
"false" "finally" "fixed" "float" "for" "foreach" "get" "global" "goto"
"if" "implicit" "in" "int" "interface" "internal" "is" "lock" "long"
"namespace" "new" "null" "object" "operator" "out" "override" "params"
"partial" "private" "protected" "public" "readonly" "ref" "remove"
"return" "sbyte" "sealed" "set" "short" "sizeof" "stackalloc" "static"
"string" "struct" "switch" "this" "throw" "true" "try" "typeof" "uint"
"ulong" "unchecked" "unsafe" "ushort" "using" "value" "var" "virtual"
"void" "volatile" "where" "while" "yield")
(d-mode
;; from http://www.digitalmars.com/d/2.0/lex.html
"abstract" "alias" "align" "asm"
"assert" "auto" "body" "bool" "break" "byte" "case" "cast" "catch"
"cdouble" "cent" "cfloat" "char" "class" "const" "continue" "creal"
"dchar" "debug" "default" "delegate" "delete" "deprecated" "do"
"double" "else" "enum" "export" "extern" "false" "final" "finally"
"float" "for" "foreach" "foreach_reverse" "function" "goto" "idouble"
"if" "ifloat" "import" "in" "inout" "int" "interface" "invariant"
"ireal" "is" "lazy" "long" "macro" "mixin" "module" "new" "nothrow"
"null" "out" "override" "package" "pragma" "private" "protected"
"public" "pure" "real" "ref" "return" "scope" "short" "static" "struct"
"super" "switch" "synchronized" "template" "this" "throw" "true" "try"
"typedef" "typeid" "typeof" "ubyte" "ucent" "uint" "ulong" "union"
"unittest" "ushort" "version" "void" "volatile" "wchar" "while" "with")
(f90-mode .
;; from f90.el
;; ".AND." ".GE." ".GT." ".LT." ".LE." ".NE." ".OR." ".TRUE." ".FALSE."
,(company-keywords-upper-lower
"abs" "abstract" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
"align" "all" "all_prefix" "all_scatter" "all_suffix" "allocatable"
"allocate" "allocated" "and" "anint" "any" "any_prefix" "any_scatter"
"any_suffix" "asin" "assign" "assignment" "associate" "associated"
"asynchronous" "atan" "atan2" "backspace" "bind" "bit_size" "block"
"btest" "c_alert" "c_associated" "c_backspace" "c_bool"
"c_carriage_return" "c_char" "c_double" "c_double_complex" "c_f_pointer"
"c_f_procpointer" "c_float" "c_float_complex" "c_form_feed" "c_funloc"
"c_funptr" "c_horizontal_tab" "c_int" "c_int16_t" "c_int32_t" "c_int64_t"
"c_int8_t" "c_int_fast16_t" "c_int_fast32_t" "c_int_fast64_t"
"c_int_fast8_t" "c_int_least16_t" "c_int_least32_t" "c_int_least64_t"
"c_int_least8_t" "c_intmax_t" "c_intptr_t" "c_loc" "c_long"
"c_long_double" "c_long_double_complex" "c_long_long" "c_new_line"
"c_null_char" "c_null_funptr" "c_null_ptr" "c_ptr" "c_short"
"c_signed_char" "c_size_t" "c_vertical_tab" "call" "case" "ceiling"
"char" "character" "character_storage_size" "class" "close" "cmplx"
"command_argument_count" "common" "complex" "conjg" "contains" "continue"
"copy_prefix" "copy_scatter" "copy_suffix" "cos" "cosh" "count"
"count_prefix" "count_scatter" "count_suffix" "cpu_time" "cshift"
"cycle" "cyclic" "data" "date_and_time" "dble" "deallocate" "deferred"
"digits" "dim" "dimension" "distribute" "do" "dot_product" "double"
"dprod" "dynamic" "elemental" "else" "elseif" "elsewhere" "end" "enddo"
"endfile" "endif" "entry" "enum" "enumerator" "eoshift" "epsilon" "eq"
"equivalence" "eqv" "error_unit" "exit" "exp" "exponent" "extends"
"extends_type_of" "external" "extrinsic" "false" "file_storage_size"
"final" "floor" "flush" "forall" "format" "fraction" "function" "ge"
"generic" "get_command" "get_command_argument" "get_environment_variable"
"goto" "grade_down" "grade_up" "gt" "hpf_alignment" "hpf_distribution"
"hpf_template" "huge" "iachar" "iall" "iall_prefix" "iall_scatter"
"iall_suffix" "iand" "iany" "iany_prefix" "iany_scatter" "iany_suffix"
"ibclr" "ibits" "ibset" "ichar" "ieee_arithmetic" "ieee_exceptions"
"ieee_features" "ieee_get_underflow_mode" "ieee_set_underflow_mode"
"ieee_support_underflow_control" "ieor" "if" "ilen" "implicit"
"import" "include" "independent" "index" "inherit" "input_unit"
"inquire" "int" "integer" "intent" "interface" "intrinsic" "ior"
"iostat_end" "iostat_eor" "iparity" "iparity_prefix" "iparity_scatter"
"iparity_suffix" "ishft" "ishftc" "iso_c_binding" "iso_fortran_env"
"kind" "lbound" "le" "leadz" "len" "len_trim" "lge" "lgt" "lle" "llt"
"log" "log10" "logical" "lt" "matmul" "max" "maxexponent" "maxloc"
"maxval" "maxval_prefix" "maxval_scatter" "maxval_suffix" "merge"
"min" "minexponent" "minloc" "minval" "minval_prefix" "minval_scatter"
"minval_suffix" "mod" "module" "modulo" "move_alloc" "mvbits" "namelist"
"ne" "nearest" "neqv" "new" "new_line" "nint" "non_intrinsic"
"non_overridable" "none" "nopass" "not" "null" "nullify"
"number_of_processors" "numeric_storage_size" "only" "onto" "open"
"operator" "optional" "or" "output_unit" "pack" "parameter" "parity"
"parity_prefix" "parity_scatter" "parity_suffix" "pass" "pause"
"pointer" "popcnt" "poppar" "precision" "present" "print" "private"
"procedure" "processors" "processors_shape" "product" "product_prefix"
"product_scatter" "product_suffix" "program" "protected" "public"
"pure" "radix" "random_number" "random_seed" "range" "read" "real"
"realign" "recursive" "redistribute" "repeat" "reshape" "result"
"return" "rewind" "rrspacing" "same_type_as" "save" "scale" "scan"
"select" "selected_char_kind" "selected_int_kind" "selected_real_kind"
"sequence" "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing"
"spread" "sqrt" "stop" "subroutine" "sum" "sum_prefix" "sum_scatter"
"sum_suffix" "system_clock" "tan" "tanh" "target" "template" "then"
"tiny" "transfer" "transpose" "trim" "true" "type" "ubound" "unpack"
"use" "value" "verify" "volatile" "wait" "where" "while" "with" "write"))
(java-mode
"abstract" "assert" "boolean" "break" "byte" "case" "catch" "char" "class"
"continue" "default" "do" "double" "else" "enum" "extends" "final"
"finally" "float" "for" "if" "implements" "import" "instanceof" "int"
"interface" "long" "native" "new" "package" "private" "protected" "public"
"return" "short" "static" "strictfp" "super" "switch" "synchronized"
"this" "throw" "throws" "transient" "try" "void" "volatile" "while")
(javascript-mode
"break" "catch" "const" "continue" "delete" "do" "else" "export" "for"
"function" "if" "import" "in" "instanceOf" "label" "let" "new" "return"
"switch" "this" "throw" "try" "typeof" "var" "void" "while" "with" "yield")
(objc-mode
"@catch" "@class" "@encode" "@end" "@finally" "@implementation"
"@interface" "@private" "@protected" "@protocol" "@public"
"@selector" "@synchronized" "@throw" "@try" "alloc" "autorelease"
"bycopy" "byref" "in" "inout" "oneway" "out" "release" "retain")
(perl-mode
;; from cperl.el
"AUTOLOAD" "BEGIN" "CHECK" "CORE" "DESTROY" "END" "INIT" "__END__"
"__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2" "bind"
"binmode" "bless" "caller" "chdir" "chmod" "chomp" "chop" "chown" "chr"
"chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
"crypt" "dbmclose" "dbmopen" "defined" "delete" "die" "do" "dump" "each"
"else" "elsif" "endgrent" "endhostent" "endnetent" "endprotoent"
"endpwent" "endservent" "eof" "eq" "eval" "exec" "exists" "exit" "exp"
"fcntl" "fileno" "flock" "for" "foreach" "fork" "format" "formline"
"ge" "getc" "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
"gethostbyname" "gethostent" "getlogin" "getnetbyaddr" "getnetbyname"
"getnetent" "getpeername" "getpgrp" "getppid" "getpriority"
"getprotobyname" "getprotobynumber" "getprotoent" "getpwent" "getpwnam"
"getpwuid" "getservbyname" "getservbyport" "getservent" "getsockname"
"getsockopt" "glob" "gmtime" "goto" "grep" "gt" "hex" "if" "index" "int"
"ioctl" "join" "keys" "kill" "last" "lc" "lcfirst" "le" "length"
"link" "listen" "local" "localtime" "lock" "log" "lstat" "lt" "map"
"mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "my" "ne" "next" "no"
"not" "oct" "open" "opendir" "or" "ord" "our" "pack" "package" "pipe"
"pop" "pos" "print" "printf" "push" "q" "qq" "quotemeta" "qw" "qx"
"rand" "read" "readdir" "readline" "readlink" "readpipe" "recv" "redo"
"ref" "rename" "require" "reset" "return" "reverse" "rewinddir" "rindex"
"rmdir" "scalar" "seek" "seekdir" "select" "semctl" "semget" "semop"
"send" "setgrent" "sethostent" "setnetent" "setpgrp" "setpriority"
"setprotoent" "setpwent" "setservent" "setsockopt" "shift" "shmctl"
"shmget" "shmread" "shmwrite" "shutdown" "sin" "sleep" "socket"
"socketpair" "sort" "splice" "split" "sprintf" "sqrt" "srand" "stat"
"study" "sub" "substr" "symlink" "syscall" "sysopen" "sysread" "system"
"syswrite" "tell" "telldir" "tie" "time" "times" "tr" "truncate" "uc"
"ucfirst" "umask" "undef" "unless" "unlink" "unpack" "unshift" "untie"
"until" "use" "utime" "values" "vec" "wait" "waitpid"
"wantarray" "warn" "while" "write" "x" "xor" "y")
(php-mode
"__CLASS__" "__DIR__" "__FILE__" "__FUNCTION__" "__LINE__" "__METHOD__"
"__NAMESPACE__" "_once" "abstract" "and" "array" "as" "break" "case"
"catch" "cfunction" "class" "clone" "const" "continue" "declare"
"default" "die" "do" "echo" "else" "elseif" "empty" "enddeclare"
"endfor" "endforeach" "endif" "endswitch" "endwhile" "eval" "exception"
"exit" "extends" "final" "for" "foreach" "function" "global"
"goto" "if" "implements" "include" "instanceof" "interface"
"isset" "list" "namespace" "new" "old_function" "or" "php_user_filter"
"print" "private" "protected" "public" "require" "require_once" "return"
"static" "switch" "this" "throw" "try" "unset" "use" "var" "while" "xor")
(python-mode
"and" "assert" "break" "class" "continue" "def" "del" "elif" "else"
"except" "exec" "finally" "for" "from" "global" "if" "import" "in" "is"
"lambda" "not" "or" "pass" "print" "raise" "return" "try" "while" "yield")
(ruby-mode
"BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?"
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
"next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super"
"then" "true" "undef" "unless" "until" "when" "while" "yield")
;; aliases
(js2-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(cperl-mode . perl-mode)
(jde-mode . java-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
"`company-mode' back-end for programming language keywords."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-keywords))
(prefix (and (assq major-mode company-keywords-alist)
(not (company-in-string-or-comment))
(or (company-grab-symbol) 'stop)))
(candidates
(let ((completion-ignore-case nil)
(symbols (cdr (assq major-mode company-keywords-alist))))
(all-completions arg (if (consp symbols)
symbols
(cdr (assq symbols company-keywords-alist))))))
(sorted t)))
(provide 'company-keywords)
;;; company-keywords.el ends here

View File

@ -0,0 +1,142 @@
;;; company-nxml.el --- company-mode completion back-end for nxml-mode
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defvar rng-open-elements)
(defvar rng-validate-mode)
(defvar rng-in-attribute-regex)
(defvar rng-in-attribute-value-regex)
(declare-function rng-set-state-after "rng-nxml")
(declare-function rng-match-possible-start-tag-names "rng-match")
(declare-function rng-adjust-state-for-attribute "rng-nxml")
(declare-function rng-match-possible-attribute-names "rng-match")
(declare-function rng-adjust-state-for-attribute-value "rng-nxml")
(declare-function rng-match-possible-value-strings "rng-match")
(defconst company-nxml-token-regexp
"\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
(defvar company-nxml-in-attribute-value-regexp
(replace-regexp-in-string "w" company-nxml-token-regexp
"<w\\(?::w\\)?\
\\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
\[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
\[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
\\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
t t))
(defvar company-nxml-in-tag-name-regexp
(replace-regexp-in-string "w" company-nxml-token-regexp
"<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
(defun company-nxml-all-completions (prefix alist)
(let ((candidates (mapcar 'cdr alist))
(case-fold-search nil)
filtered)
(when (cdar rng-open-elements)
(push (concat "/" (cdar rng-open-elements)) candidates))
(setq candidates (sort (all-completions prefix candidates) 'string<))
(while candidates
(unless (equal (car candidates) (car filtered))
(push (car candidates) filtered))
(pop candidates))
(nreverse filtered)))
(defmacro company-nxml-prepared (&rest body)
(declare (indent 0) (debug t))
`(let ((lt-pos (save-excursion (search-backward "<" nil t)))
xmltok-dtd)
(when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
,@body)))
(defun company-nxml-tag (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(company-grab company-nxml-in-tag-name-regexp 1)))
(candidates (company-nxml-prepared
(company-nxml-all-completions
arg (rng-match-possible-start-tag-names))))
(sorted t)))
(defun company-nxml-attribute (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(memq (char-after) '(?\ ?\t ?\n)) ;; outside word
(company-grab rng-in-attribute-regex 1)))
(candidates (company-nxml-prepared
(and (rng-adjust-state-for-attribute
lt-pos (- (point) (length arg)))
(company-nxml-all-completions
arg (rng-match-possible-attribute-names)))))
(sorted t)))
(defun company-nxml-attribute-value (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(and (memq (char-after) '(?' ?\" ?\ ?\t ?\n)) ;; outside word
(looking-back company-nxml-in-attribute-value-regexp)
(or (match-string-no-properties 4)
(match-string-no-properties 5)
""))))
(candidates (company-nxml-prepared
(let (attr-start attr-end colon)
(and (looking-back rng-in-attribute-value-regex lt-pos)
(setq colon (match-beginning 2)
attr-start (match-beginning 1)
attr-end (match-end 1))
(rng-adjust-state-for-attribute lt-pos attr-start)
(rng-adjust-state-for-attribute-value
attr-start colon attr-end)
(all-completions
arg (rng-match-possible-value-strings))))))))
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
"`company-mode' completion back-end for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-nxml))
(prefix (or (company-nxml-tag 'prefix)
(company-nxml-attribute 'prefix)
(company-nxml-attribute-value 'prefix)))
(candidates (cond
((company-nxml-tag 'prefix)
(company-nxml-tag 'candidates arg))
((company-nxml-attribute 'prefix)
(company-nxml-attribute 'candidates arg))
((company-nxml-attribute-value 'prefix)
(sort (company-nxml-attribute-value 'candidates arg)
'string<))))
(sorted t)))
(provide 'company-nxml)
;;; company-nxml.el ends here

View File

@ -0,0 +1,57 @@
;;; company-oddmuse.el --- company-mode completion back-end for oddmuse-mode
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(eval-when-compile (require 'yaooddmuse nil t))
(eval-when-compile (require 'oddmuse nil t))
(defvar company-oddmuse-link-regexp
"\\(\\<[A-Z][[:alnum:]]*\\>\\)\\|\\[\\[\\([[:alnum:]]+\\>\\|\\)")
(defun company-oddmuse-get-page-table ()
(cl-case major-mode
(yaoddmuse-mode (with-no-warnings
(yaoddmuse-get-pagename-table yaoddmuse-wikiname)))
(oddmuse-mode (with-no-warnings
(oddmuse-make-completion-table oddmuse-wiki)))))
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
"`company-mode' completion back-end for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-oddmuse))
(prefix (let ((case-fold-search nil))
(and (memq major-mode '(oddmuse-mode yaoddmuse-mode))
(looking-back company-oddmuse-link-regexp (point-at-bol))
(or (match-string 1)
(match-string 2)))))
(candidates (all-completions arg (company-oddmuse-get-page-table)))))
(provide 'company-oddmuse)
;;; company-oddmuse.el ends here

View File

@ -0,0 +1,2 @@
;; Generated package description from company.el
(define-package "company" "0.8.2" "Modular text completion framework" '((emacs "24.1") (cl-lib "0.5")) :url "http://company-mode.github.io/" :keywords '("abbrev" "convenience" "matching"))

View File

@ -0,0 +1,69 @@
;;; company-pysmell.el --- company-mode completion back-end for pysmell.el
;; Copyright (C) 2009-2011, 2013-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The main problem with using this backend is installing Pysmell.
;; I couldn't manage to do that. --Dmitry
;;; Code:
(if t (require 'pysmell)) ;Don't load during compilation.
(require 'company)
(require 'cl-lib)
(defvar-local company-pysmell--available-p 'unknown)
(defun company-pysmell--available-p ()
(if (eq company-pysmell--available-p 'unknown)
(setq company-pysmell--available-p
(locate-dominating-file buffer-file-name "PYSMELLTAGS"))
company-pysmell--available-p))
(defun company-pysmell--grab-symbol ()
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol
(save-excursion
(let ((pos (point)))
(goto-char (- (point) (length symbol)))
(while (eq (char-before) ?.)
(goto-char (1- (point)))
(skip-syntax-backward "w_"))
(- pos (point))))))))
;;;###autoload
(defun company-pysmell (command &optional arg &rest ignored)
"`company-mode' completion back-end for pysmell.
This requires pysmell.el and pymacs.el."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-pysmell))
(prefix (and (derived-mode-p 'python-mode)
buffer-file-name
(not (company-in-string-or-comment))
(company-pysmell--available-p)
(company-pysmell--grab-symbol)))
(candidates (delete "" (pysmell-get-all-completions)))))
(provide 'company-pysmell)
;;; company-pysmell.el ends here

View File

@ -0,0 +1,76 @@
;;; company-ropemacs.el --- company-mode completion back-end for ropemacs
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cl-lib)
(defun company-ropemacs--grab-symbol ()
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol
(save-excursion
(let ((pos (point)))
(goto-char (- (point) (length symbol)))
(while (eq (char-before) ?.)
(goto-char (1- (point)))
(skip-syntax-backward "w_"))
(- pos (point))))))))
(defun company-ropemacs-doc-buffer (candidate)
"Return buffer with docstring of CANDIDATE if it is available."
(let ((doc (company-with-candidate-inserted candidate (rope-get-doc))))
(when doc
(company-doc-buffer doc))))
(defun company-ropemacs-location (candidate)
"Return location of CANDIDATE in cons form (FILE . LINE) if it is available."
(let ((location (company-with-candidate-inserted candidate
(rope-definition-location))))
(when location
(cons (elt location 0) (elt location 1)))))
(defun company-ropemacs (command &optional arg &rest ignored)
"`company-mode' completion back-end for ropemacs.
Depends on third-party code: Pymacs (both Python and Emacs packages),
rope, ropemacs and ropemode."
(interactive (list 'interactive))
(cl-case command
(init (when (and (derived-mode-p 'python-mode)
(not (fboundp 'rope-completions)))
(require 'pymacs)
(pymacs-load "ropemacs" "rope-")))
(interactive (company-begin-backend 'company-ropemacs))
(prefix (and (derived-mode-p 'python-mode)
(not (company-in-string-or-comment))
(company-ropemacs--grab-symbol)))
(candidates (mapcar (lambda (element) (concat arg element))
(rope-completions)))
(doc-buffer (company-ropemacs-doc-buffer arg))
(location (company-ropemacs-location arg))))
(provide 'company-ropemacs)
;;; company-ropemacs.el ends here

View File

@ -0,0 +1,146 @@
;;; company-semantic.el --- company-mode completion back-end using Semantic
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defvar semantic-idle-summary-function)
(declare-function semantic-documentation-for-tag "semantic/doc" )
(declare-function semantic-analyze-current-context "semantic/analyze")
(declare-function semantic-analyze-possible-completions "semantic/complete")
(declare-function semantic-analyze-find-tags-by-prefix "semantic/analyze/fcn")
(declare-function semantic-tag-class "semantic/tag")
(declare-function semantic-tag-name "semantic/tag")
(declare-function semantic-tag-start "semantic/tag")
(declare-function semantic-tag-buffer "semantic/tag")
(declare-function semantic-active-p "semantic")
(defgroup company-semantic nil
"Completion back-end using Semantic."
:group 'company)
(defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc
"The function turning a semantic tag into doc information."
:type 'function)
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
(defvar-local company-semantic--current-tags nil
"Tags for the current context.")
(defun company-semantic-documentation-for-tag (tag)
(when (semantic-tag-buffer tag)
;; When TAG's buffer is unknown, the function below raises an error.
(semantic-documentation-for-tag tag)))
(defun company-semantic-doc-or-summary (tag)
(or (company-semantic-documentation-for-tag tag)
(and (require 'semantic-idle nil t)
(require 'semantic/idle nil t)
(funcall semantic-idle-summary-function tag nil t))))
(defun company-semantic-summary-and-doc (tag)
(let ((doc (company-semantic-documentation-for-tag tag))
(summary (funcall semantic-idle-summary-function tag nil t)))
(and (stringp doc)
(string-match "\n*\\(.*\\)$" doc)
(setq doc (match-string 1 doc)))
(concat summary
(when doc
(if (< (+ (length doc) (length summary) 4) (window-width))
" -- "
"\n"))
doc)))
(defun company-semantic-doc-buffer (tag)
(let ((doc (company-semantic-documentation-for-tag tag)))
(when doc
(company-doc-buffer
(concat (funcall semantic-idle-summary-function tag nil t)
"\n"
doc)))))
(defsubst company-semantic-completions (prefix)
(ignore-errors
(let ((completion-ignore-case nil)
(context (semantic-analyze-current-context)))
(setq company-semantic--current-tags
(semantic-analyze-possible-completions context))
(all-completions prefix company-semantic--current-tags))))
(defun company-semantic-completions-raw (prefix)
(setq company-semantic--current-tags nil)
(dolist (tag (semantic-analyze-find-tags-by-prefix prefix))
(unless (eq (semantic-tag-class tag) 'include)
(push tag company-semantic--current-tags)))
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic--pre-prefix-length (prefix-length)
"Sum up the length of all chained symbols before POS.
Symbols are chained by \".\" or \"->\"."
(save-excursion
(let ((pos (point)))
(goto-char (- (point) prefix-length))
(while (looking-back "->\\|\\.")
(goto-char (match-beginning 0))
(skip-syntax-backward "w_"))
(- pos (point)))))
(defun company-semantic--grab ()
"Grab the semantic prefix, but return everything before -> or . as length."
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol (company-semantic--pre-prefix-length (length symbol))))))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
"`company-mode' completion back-end using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-semantic))
(prefix (and (featurep 'semantic)
(semantic-active-p)
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
(or (company-semantic--grab) 'stop)))
(candidates (if (and (equal arg "")
(not (looking-back "->\\|\\.")))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
(assoc arg company-semantic--current-tags)))
(doc-buffer (company-semantic-doc-buffer
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
(location (let ((tag (assoc arg company-semantic--current-tags)))
(when (buffer-live-p (semantic-tag-buffer tag))
(cons (semantic-tag-buffer tag)
(semantic-tag-start tag)))))))
(provide 'company-semantic)
;;; company-semantic.el ends here

View File

@ -0,0 +1,170 @@
;;; company-template.el
;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(defface company-template-field
'((((background dark)) (:background "yellow" :foreground "black"))
(((background light)) (:background "orange" :foreground "black")))
"Face used for editable text in template fields."
:group 'company)
(defvar company-template-nav-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap [tab] 'company-template-forward-field)
(define-key keymap (kbd "TAB") 'company-template-forward-field)
keymap))
(defvar-local company-template--buffer-templates nil)
;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-templates-at (pos)
(let (os)
(dolist (o (overlays-at pos))
;; FIXME: Always return the whole list of templates?
;; We remove templates not at point after every command.
(when (memq o company-template--buffer-templates)
(push o os)))
os))
(defun company-template-move-to-first (templ)
(interactive)
(goto-char (overlay-start templ))
(company-template-forward-field))
(defun company-template-forward-field ()
(interactive)
(let* ((start (point))
(templates (company-template-templates-at (point)))
(minimum (apply 'max (mapcar 'overlay-end templates)))
(fields (cl-loop for templ in templates
append (overlay-get templ 'company-template-fields))))
(dolist (pos (mapcar 'overlay-start fields))
(and pos
(> pos (point))
(< pos minimum)
(setq minimum pos)))
(push-mark)
(goto-char minimum)
(company-template-remove-field (company-template-field-at start))))
(defun company-template-field-at (&optional point)
(cl-loop for ovl in (overlays-at (or point (point)))
when (overlay-get ovl 'company-template-parent)
return ovl))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-declare-template (beg end)
(let ((ov (make-overlay beg end)))
;; (overlay-put ov 'face 'highlight)
(overlay-put ov 'keymap company-template-nav-map)
(overlay-put ov 'priority 101)
(overlay-put ov 'evaporate t)
(push ov company-template--buffer-templates)
(add-hook 'post-command-hook 'company-template-post-command nil t)
ov))
(defun company-template-remove-template (templ)
(mapc 'company-template-remove-field
(overlay-get templ 'company-template-fields))
(setq company-template--buffer-templates
(delq templ company-template--buffer-templates))
(delete-overlay templ))
(defun company-template-add-field (templ pos text &optional display)
"Add new field to template TEMPL at POS, inserting TEXT.
When DISPLAY is non-nil, set the respective property on the overlay.
Leave point at the end of the field."
(cl-assert templ)
(goto-char pos)
(insert text)
(when (> (point) (overlay-end templ))
(move-overlay templ (overlay-start templ) (point)))
(let ((ov (make-overlay pos (+ pos (length text))))
(siblings (overlay-get templ 'company-template-fields)))
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'intangible t)
(overlay-put ov 'face 'company-template-field)
(when display
(overlay-put ov 'display display))
(overlay-put ov 'company-template-parent templ)
(overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook))
(push ov siblings)
(overlay-put templ 'company-template-fields siblings)))
(defun company-template-remove-field (ovl &optional clear)
(when (overlayp ovl)
(when (overlay-buffer ovl)
(when clear
(delete-region (overlay-start ovl) (overlay-end ovl)))
(delete-overlay ovl))
(let* ((templ (overlay-get ovl 'company-template-parent))
(siblings (overlay-get templ 'company-template-fields)))
(setq siblings (delq ovl siblings))
(overlay-put templ 'company-template-fields siblings))))
(defun company-template-clean-up (&optional pos)
"Clean up all templates that don't contain POS."
(let ((local-ovs (overlays-at (or pos (point)))))
(dolist (templ company-template--buffer-templates)
(unless (memq templ local-ovs)
(company-template-remove-template templ)))))
;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-insert-hook (ovl after-p &rest _ignore)
"Called when a snippet input prompt is modified."
(unless after-p
(company-template-remove-field ovl t)))
(defun company-template-post-command ()
(company-template-clean-up)
(unless company-template--buffer-templates
(remove-hook 'post-command-hook 'company-template-post-command t)))
;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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) ?\))
(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))))))
(provide 'company-template)
;;; company-template.el ends here

View File

@ -0,0 +1,63 @@
;;; company-tempo.el --- company-mode completion back-end for tempo
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'tempo)
(defsubst company-tempo-lookup (match)
(cdr (assoc match (tempo-build-collection))))
(defun company-tempo-insert (match)
"Replace MATCH with the expanded tempo template."
(search-backward match)
(goto-char (match-beginning 0))
(replace-match "")
(call-interactively (company-tempo-lookup match)))
(defsubst company-tempo-meta (match)
(let ((templ (company-tempo-lookup match))
doc)
(and templ
(setq doc (documentation templ t))
(car (split-string doc "\n" t)))))
;;;###autoload
(defun company-tempo (command &optional arg &rest ignored)
"`company-mode' completion back-end for tempo."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-tempo
'company-tempo-insert))
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
(candidates (all-completions arg (tempo-build-collection)))
(meta (company-tempo-meta arg))
(require-match t)
(sorted t)))
(provide 'company-tempo)
;;; company-tempo.el ends here

View File

@ -0,0 +1,830 @@
;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ert)
(require 'company)
(require 'company-keywords)
(require 'company-clang)
;;; Core
(ert-deftest company-sorted-keywords ()
"Test that keywords in `company-keywords-alist' are in alphabetical order."
(dolist (pair company-keywords-alist)
(when (consp (cdr pair))
(let ((prev (cadr pair)))
(dolist (next (cddr pair))
(should (not (equal prev next)))
(should (string< prev next))
(setq prev next))))))
(ert-deftest company-good-prefix ()
(let ((company-minimum-prefix-length 5)
company-abort-manual-when-too-short
company--manual-action ;idle begin
(company-selection-changed t)) ;has no effect
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq nil (company--good-prefix-p "abcd")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq nil (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p '("foo" . t))))))
(ert-deftest company--manual-prefix-set-and-unset ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-manual-begin)
(should (equal "ab" company--manual-prefix))
(company-abort)
(should (null company--manual-prefix)))))
(ert-deftest company-abort-manual-when-too-short ()
(let ((company-minimum-prefix-length 5)
(company-abort-manual-when-too-short t)
(company-selection-changed t)) ;has not effect
(let ((company--manual-action nil)) ;idle begin
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq t (company--good-prefix-p '("foo" . t)))))
(let ((company--manual-action t)
(company--manual-prefix "abc")) ;manual begin from this prefix
(should (eq t (company--good-prefix-p "!@#$")))
(should (eq nil (company--good-prefix-p "ab")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p "abcd")))
(should (eq t (company--good-prefix-p "abc")))
(should (eq t (company--good-prefix-p '("bar" . t)))))))
(ert-deftest company-multi-backend-with-lambdas ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("c" "d")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
(ert-deftest company-multi-backend-filters-backends-by-prefix ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix (cons "z" t))
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "t")
(candidates '("c" "d"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("e" "f")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
(ert-deftest company-multi-backend-remembers-candidate-backend ()
(let ((company-backend
(list (lambda (command &optional arg)
(cl-case command
(ignore-case nil)
(annotation "1")
(candidates '("a" "c"))
(post-completion "13")))
(lambda (command &optional arg)
(cl-case command
(ignore-case t)
(annotation "2")
(candidates '("b" "d"))
(post-completion "42")))
(lambda (command &optional arg)
(cl-case command
(annotation "3")
(candidates '("e"))
(post-completion "74"))))))
(let ((candidates (company-calculate-candidates nil)))
(should (equal candidates '("a" "b" "c" "d" "e")))
(should (equal t (company-call-backend 'ignore-case)))
(should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
(should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
(should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
(should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
(should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
(should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
(ert-deftest company-multi-backend-handles-keyword-with ()
(let ((primo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("abb" "abc" "abd")))))
(secundo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("acc" "acd"))))))
(let ((company-backend (list 'ignore 'ignore :with secundo)))
(should (null (company-call-backend 'prefix))))
(let ((company-backend (list 'ignore primo :with secundo)))
(should (equal "a" (company-call-backend 'prefix)))
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
(company-mode)
(should-error
(company-begin-backend (lambda (command &rest ignore))))
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("a" "ab" "ac")))))))
(let (this-command)
(company-call 'complete))
(should (eq 3 company-candidates-length)))))
(ert-deftest company-require-match-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 2 company-candidates-length))
(should (eq 3 (point))))))
(ert-deftest company-dont-require-match-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-minimum-prefix-length 2)
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (eq 2 company-candidates-length))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq nil company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-dont-require-match-if-old-prefix-ended-and-was-a-match ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (company-grab-word))
(candidates '("abc" "ab" "abd"))
(sorted t))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 3 company-candidates-length))
(should (eq 3 (point)))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (null company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-should-complete-whitelist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands nil))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-should-complete-blacklist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands '(not backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(not backward-delete-char-untabify)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-auto-complete-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "abcd " (buffer-string))))))
(ert-deftest company-no-auto-complete-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-minimum-prefix-length 2)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "ab " (buffer-string))))))
(ert-deftest company-clears-explicit-action-when-no-matches ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-backends)
(company-call 'manual-begin) ;; fails
(should (null company-candidates))
(should (null (company-explicit-action-p))))))
(ert-deftest company-ignore-case-replaces-prefix ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case t))))))
(insert "A")
(let (this-command)
(company-complete))
(should (string= "ab" (buffer-string)))
(delete-char -2)
(insert "A") ; hack, to keep it in one test
(company-complete-selection)
(should (string= "abcd" (buffer-string))))))
(ert-deftest company-ignore-case-with-keep-prefix ()
(with-temp-buffer
(insert "AB")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case 'keep-prefix))))))
(let (this-command)
(company-complete))
(company-complete-selection)
(should (string= "ABcd" (buffer-string))))))
(ert-deftest company-non-prefix-completion ()
(with-temp-buffer
(insert "tc")
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("tea-cup" "teal-color")))))))
(let (this-command)
(company-complete))
(should (string= "tc" (buffer-string)))
(company-complete-selection)
(should (string= "tea-cup" (buffer-string))))))
(ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(save-excursion (insert " ff"))
(company-mode)
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
(list (lambda (c &optional arg)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
(should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
(ert-deftest company-pseudo-tooltip-show ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "aaaa\n bb\nccccccc\nddd")
(search-backward "bb")
(let ((col (company--column))
(company-candidates-length 2)
(company-candidates '("123" "45"))
(company-backend 'ignore))
(company-pseudo-tooltip-show (company--row) col 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 5))
;; FIXME: Make it 2?
(should (eq (overlay-get ov 'company-height) company-tooltip-limit))
(should (eq (overlay-get ov 'company-column) col))
(should (string= (overlay-get ov 'company-after)
" 123 \nc 45 c\nddd\n")))))))
(ert-deftest company-pseudo-tooltip-edit-updates-width ()
:tags '(interactive)
(with-temp-buffer
(set-window-buffer nil (current-buffer))
(let ((company-candidates-length 5)
(company-candidates '("123" "45" "67" "89" "1011"))
(company-backend 'ignore)
(company-tooltip-limit 4)
(company-tooltip-offset-display 'scrollbar))
(company-pseudo-tooltip-show (company--row)
(company--column)
0)
(should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
6))
(company-pseudo-tooltip-edit 4)
(should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
7)))))
(ert-deftest company-preview-show-with-annotations ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(save-excursion (insert "\n"))
(let ((company-candidates-length 1)
(company-candidates '("123")))
(company-preview-show-at-point (point))
(let ((ov company-preview-overlay))
(should (string= (overlay-get ov 'display) "123\n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert " ")
(save-excursion (insert "\n"))
(let ((company-candidates-length 2)
(company-backend (lambda (action &optional arg &rest _ignore)
(when (eq action 'annotation)
(cdr (assoc arg '(("123" . "(4)")))))))
(company-candidates '("123" "45"))
company-tooltip-align-annotations)
(company-pseudo-tooltip-show-at-point (point) 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 8))
(should (string= (overlay-get ov 'company-after)
" 123(4) \n 45 \n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert " ")
(save-excursion (insert "\n"))
(let ((company-candidates-length 3)
(company-backend (lambda (action &optional arg &rest _ignore)
(when (eq action 'annotation)
(cdr (assoc arg '(("123" . "(4)")
("67" . "(891011)")))))))
(company-candidates '("123" "45" "67"))
(company-tooltip-align-annotations t))
(company-pseudo-tooltip-show-at-point (point) 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 13))
(should (string= (overlay-get ov 'company-after)
" 123 (4) \n 45 \n 67 (891011) \n")))))))
(ert-deftest company-create-lines-shows-numbers ()
(let ((company-show-numbers t)
(company-candidates '("x" "y" "z"))
(company-candidates-length 3)
(company-backend 'ignore))
(should (equal '(" x 1 " " y 2 " " z 3 ")
(company--create-lines 0 999)))))
(ert-deftest company-create-lines-truncates-annotations ()
(let* ((ww (company--window-width))
(data `(("1" . "(123)")
("2" . nil)
("3" . ,(concat "(" (make-string (- ww 2) ?4) ")"))
(,(make-string ww ?4) . "<4>")))
(company-candidates (mapcar #'car data))
(company-candidates-length 4)
(company-tooltip-margin 1)
(company-backend (lambda (cmd &optional arg)
(when (eq cmd 'annotation)
(cdr (assoc arg data)))))
company-tooltip-align-annotations)
(should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
(format " 2%s " (company-space-string (- ww 3)))
(format " 3(444%s " (make-string (- ww 7) ?4))
(format " %s " (make-string (- ww 2) ?4)))
(company--create-lines 0 999)))
(let ((company-tooltip-align-annotations t))
(should (equal (list (format " 1%s(123) " (company-space-string (- ww 8)))
(format " 2%s " (company-space-string (- ww 3)))
(format " 3 (444%s " (make-string (- ww 8) ?4))
(format " %s " (make-string (- ww 2) ?4)))
(company--create-lines 0 999))))))
(ert-deftest company-column-with-composition ()
(with-temp-buffer
(insert "lambda ()")
(compose-region 1 (1+ (length "lambda")) "\\")
(should (= (company--column) 4))))
(ert-deftest company-column-with-line-prefix ()
(with-temp-buffer
(insert "foo")
(put-text-property (point-min) (point) 'line-prefix " ")
(should (= (company--column) 5))))
(ert-deftest company-column-wth-line-prefix-on-empty-line ()
(with-temp-buffer
(insert "\n")
(forward-char -1)
(put-text-property (point-min) (point-max) 'line-prefix " ")
(should (= (company--column) 2))))
(ert-deftest company-plainify ()
(let ((tab-width 8))
(should (equal-including-properties
(company-plainify "\tabc\td\t")
(concat " "
"abc "
"d "))))
(should (equal-including-properties
(company-plainify (propertize "foobar" 'line-prefix "-*-"))
"-*-foobar")))
(ert-deftest company-modify-line ()
(let ((str "-*-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 4)
"-*-fzzbar"))
(should (equal-including-properties
(company-modify-line str "xx" 0)
"xx-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 10)
"-*-foobar zz"))))
(ert-deftest company-scrollbar-bounds ()
(should (equal nil (company--scrollbar-bounds 0 3 3)))
(should (equal nil (company--scrollbar-bounds 0 4 3)))
(should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
(should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
(should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
(should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
(should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
;;; Async
(defun company-async-backend (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb)
(run-with-timer 0.05 nil
#'funcall cb '("abc" "abd")))))))
(ert-deftest company-call-backend-forces-sync ()
(let ((company-backend 'company-async-backend)
(company-async-timeout 0.1))
(should (equal '("abc" "abd") (company-call-backend 'candidates)))))
(ert-deftest company-call-backend-errors-on-timeout ()
(with-temp-buffer
(let* ((company-backend (lambda (command &optional _arg)
(pcase command
(`candidates (cons :async 'ignore)))))
(company-async-timeout 0.1)
(err (should-error (company-call-backend 'candidates "foo"))))
(should (string-match-p "async timeout" (cadr err))))))
(ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
(let ((company-backend 'company-async-backend))
(should (equal "foo" (company-call-backend-raw 'prefix)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
(ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-manual-begin)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-allows-async-candidates ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(sleep-for 0.1)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(insert "a")
(sleep-for 0.1)
(should (null company-candidates)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(pcase command
(`prefix (buffer-substring (point-min) (point)))
(`candidates
(let ((c (all-completions arg '("abc" "def"))))
(cons :async
(lambda (cb) (funcall cb c)))))
(`no-cache t)))))
(company-minimum-prefix-length 0))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (equal '("abc" "def") company-candidates))
(let ((last-command-event ?a))
(company-call 'self-insert-command 1))
(should (equal '("abc") company-candidates)))))
(ert-deftest company-multi-backend-forces-prefix-to-sync ()
(with-temp-buffer
(let ((company-backend (list 'ignore
(lambda (command)
(should (eq command 'prefix))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb nil))))))
(lambda (command)
(should (eq command 'prefix))
"foo"))))
(should (equal "foo" (company-call-backend-raw 'prefix))))
(let ((company-backend (list (lambda (_command)
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb "bar"))))))
(lambda (_command)
"foo"))))
(should (equal "bar" (company-call-backend-raw 'prefix))))))
(ert-deftest company-multi-backend-merges-deferred-candidates ()
(with-temp-buffer
(let* ((immediate (lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("f"))))))))
(company-backend (list 'ignore
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(should (equal arg "foo"))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb '("a" "b")))))))))
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates '("c" "d" "e"))))
immediate)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal '("a" "b" "c" "d" "e" "f")
(company-call-backend 'candidates "foo")))
(let ((company-backend (list immediate)))
(should (equal '("f") (company-call-backend 'candidates "foo")))))))
;;; Transformers
(ert-deftest company-occurrence-prefer-closest-above ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-closest-above))
(should (equal '("foo1" "foo0" "foo3" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
(ert-deftest company-occurrence-prefer-any-closest ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-any-closest))
(should (equal '("foo1" "foo3" "foo0" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(dotimes (i 2)
(insert " ")
(company-template-add-field tpl (point) "foo")))
(company-call 'template-forward-field)
(should (= 3 (point)))
(company-call 'template-forward-field)
(should (= 7 (point)))
(company-call 'template-forward-field)
(should (= 11 (point)))
(should (zerop (length (overlay-get tpl 'company-template-fields))))
(should (null (overlay-buffer tpl))))))
(ert-deftest company-template-removed-after-input-and-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(insert " ")
(company-template-add-field tpl (point) "bar"))
(company-call 'template-move-to-first tpl)
(should (= 3 (point)))
(dolist (c (string-to-list "tee"))
(let ((last-command-event c))
(company-call 'self-insert-command 1)))
(should (string= "{ tee }" (buffer-string)))
(should (overlay-buffer tpl))
(company-call 'template-forward-field)
(should (= 7 (point)))
(should (null (overlay-buffer tpl))))))
(defun company-call (name &rest args)
(let* ((maybe (intern (format "company-%s" name)))
(command (if (fboundp maybe) maybe name)))
(let ((this-command command))
(run-hooks 'pre-command-hook))
(apply command args)
(let ((this-command command))
(run-hooks 'post-command-hook))))
(ert-deftest company-template-c-like-templatify ()
(with-temp-buffer
(let ((text "foo(int a, short b)"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0"))
(should (equal "int a"
(overlay-get (company-template-field-at) 'display))))))
(ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
(with-temp-buffer
(let ((text "foo(int a, short b)!@ #1334 a"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0")))))
;;; Clang
(ert-deftest company-clang-objc-templatify ()
(with-temp-buffer
(let ((text "createBookWithTitle:andAuthor:"))
(insert text)
(company-clang-objc-templatify text)
(should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
(should (looking-at "arg0"))
(should (null (overlay-get (company-template-field-at) 'display))))))

View File

@ -0,0 +1,123 @@
;;; company-xcode.el --- company-mode completion back-end for Xcode projects
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-xcode nil
"Completion back-end for Xcode projects."
:group 'company)
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
"Location of xcodeindex executable."
:type 'file)
(defvar company-xcode-tags nil)
(defun company-xcode-reset ()
"Reset the cached tags."
(interactive)
(setq company-xcode-tags nil))
(defcustom company-xcode-types
'("Class" "Constant" "Enum" "Macro" "Modeled Class" "Structure"
"Type" "Union" "Function")
"The types of symbols offered by `company-xcode'.
No context-enabled completion is available. Types like methods will be
offered regardless of whether the class supports them. The defaults should be
valid in most contexts."
:set (lambda (variable value)
(set variable value)
(company-xcode-reset))
:type '(set (const "Category") (const "Class") (const "Class Method")
(const "Class Variable") (const "Constant") (const "Enum")
(const "Field") (const "Instance Method")
(const "Instance Variable") (const "Macro")
(const "Modeled Class") (const "Modeled Method")
(const "Modeled Property") (const "Property") (const "Protocol")
(const "Structure") (const "Type") (const "Union")
(const "Variable") (const "Function")))
(defvar-local company-xcode-project 'unknown)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-xcode-fetch (project-bundle)
(setq project-bundle (directory-file-name project-bundle))
(message "Retrieving dump from %s..." project-bundle)
(with-temp-buffer
(let ((default-directory (file-name-directory project-bundle)))
(call-process company-xcode-xcodeindex-executable nil (current-buffer)
nil "dump" "-project"
(file-name-nondirectory project-bundle) "-quiet")
(goto-char (point-min))
(let ((regexp (concat "^\\([^\t\n]*\\)\t[^\t\n]*\t"
(regexp-opt company-xcode-types)
"\t[^\t\n]*\t[^\t\n]*"))
candidates)
(while (re-search-forward regexp nil t)
(add-to-list 'candidates (match-string 1)))
(message "Retrieving dump from %s...done" project-bundle)
candidates))))
(defun company-xcode-find-project ()
(let ((dir (if buffer-file-name
(file-name-directory buffer-file-name)
(expand-file-name default-directory)))
(prev-dir nil)
file)
(while (not (or file (equal dir prev-dir)))
(setq file (car (directory-files dir t ".xcodeproj\\'" t))
prev-dir dir
dir (file-name-directory (directory-file-name dir))))
file))
(defun company-xcode-tags ()
(when (eq company-xcode-project 'unknown)
(setq company-xcode-project (company-xcode-find-project)))
(when company-xcode-project
(cdr (or (assoc company-xcode-project company-xcode-tags)
(car (push (cons company-xcode-project
(company-xcode-fetch company-xcode-project))
company-xcode-tags))))))
;;;###autoload
(defun company-xcode (command &optional arg &rest ignored)
"`company-mode' completion back-end for Xcode projects."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-xcode))
(prefix (and company-xcode-xcodeindex-executable
(company-xcode-tags)
(not (company-in-string-or-comment))
(or (company-grab-symbol) 'stop)))
(candidates (let ((completion-ignore-case nil))
(company-xcode-tags)
(all-completions arg (company-xcode-tags))))))
(provide 'company-xcode)
;;; company-xcode.el ends here

View File

@ -0,0 +1,98 @@
;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cl-lib)
(require 'yasnippet)
(defun company-yasnippet--candidates (prefix)
(mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
res)
(when keyhash
(maphash
(lambda (key value)
(when (and (stringp key)
(string-prefix-p prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
'yas-template template)
res))
value)))
keyhash))
res))
(yas--get-snippet-tables)))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
"`company-mode' back-end for `yasnippet'.
This back-end should be used with care, because as long as there are
snippets defined for the current major mode, this back-end will always
shadow back-ends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end or
several that provide actual text completions.
(add-hook 'js-mode-hook
(lambda ()
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other back-ends.
(push '(company-semantic :with company-yasnippet) company-backends)
* Not in `company-backends', just bound to a key.
(global-set-key (kbd \"C-c y\") 'company-yasnippet)
"
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-yasnippet))
(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
(company-grab-symbol)))
(annotation
(concat
(unless company-tooltip-align-annotations " -> ")
(get-text-property 0 'yas-annotation arg)))
(candidates (company-yasnippet--candidates arg))
(post-completion
(let ((template (get-text-property 0 'yas-template arg)))
(yas-expand-snippet (yas--template-content template)
(- (point) (length arg))
(point)
(yas--template-expand-env template))))))
(provide 'company-yasnippet)
;;; company-yasnippet.el ends here

File diff suppressed because it is too large Load Diff

36
elpa/company-readme.txt Normal file
View File

@ -0,0 +1,36 @@
Company is a modular completion mechanism. Modules for retrieving completion
candidates are called back-ends, modules for displaying them are front-ends.
Company comes with many back-ends, e.g. `company-elisp'. These are
distributed in separate files and can be used individually.
Place company.el and the back-ends you want to use in a directory and add the
following to your .emacs:
(add-to-list 'load-path "/path/to/company")
(autoload 'company-mode "company" nil t)
Enable company-mode with M-x company-mode. For further information look at
the documentation for `company-mode' (C-h f company-mode RET)
If you want to start a specific back-end, call it interactively or use
`company-begin-backend'. For example:
M-x company-abbrev will prompt for and insert an abbrev.
To write your own back-end, look at the documentation for `company-backends'.
Here is a simple example completing "foo":
(defun company-my-backend (command &optional arg &rest ignored)
(pcase command
(`prefix (when (looking-back "foo\\>")
(match-string 0)))
(`candidates (list "foobar" "foobaz" "foobarbaz"))
(`meta (format "This value is named %s" arg))))
Sometimes it is a good idea to mix several back-ends together, for example to
enrich gtags with dabbrev-code results (to emulate local variables).
To do this, add a list with both back-ends as an element in company-backends.
Known Issues:
When point is at the very end of the buffer, the pseudo-tooltip appears very
wrong, unless company is allowed to temporarily insert a fake newline.
This behavior is enabled by `company-end-of-buffer-workaround'.

View File

@ -0,0 +1,43 @@
;;; fiplr-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (fiplr-clear-cache fiplr-find-directory fiplr-find-file
;;;;;; fiplr-root) "fiplr" "fiplr.el" (21530 2995 788494 33000))
;;; Generated autoloads from fiplr.el
(autoload 'fiplr-root "fiplr" "\
Locate the root of the project by walking up the directory tree.
\(fn)" nil nil)
(autoload 'fiplr-find-file "fiplr" "\
Runs a completing prompt to find a file from the project.
\(fn)" nil nil)
(autoload 'fiplr-find-directory "fiplr" "\
Runs a completing prompt to find a directory from the project.
\(fn)" nil nil)
(autoload 'fiplr-clear-cache "fiplr" "\
Clears the internal caches used by fiplr so the project is searched again.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("fiplr-pkg.el") (21530 2995 927265 98000))
;;;***
(provide 'fiplr-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; fiplr-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "fiplr" "0.1.3" "Fuzzy finder for files in a project." (quote nil))

243
elpa/fiplr-0.1.3/fiplr.el Normal file
View File

@ -0,0 +1,243 @@
;;; fiplr.el --- Fuzzy finder for files in a project.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/fiplr
;; Version: 0.1.3
;; Keywords: convenience, usability, project
;; This file is not part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; Overview:
;;
;; Fiplr makes it really use to find files anywhere within your entire project
;; by using a cached directory tree and delegating to ido while you search the
;; tree.
;;
;; M-x fiplr-find-file
;;
;; By default it looks through all the parent directories of the file you're
;; editing until it finds a .git, .hg, .bzr or .svn directory. You can
;; customize this list of root markers by setting `fiplr-root-markers'.
;;
;; (setq fiplr-root-markers '(".git" ".svn"))
;;
;; Some files are ignored from the directory tree because they are not text
;; files, or simply to speed up the search. The default list can be
;; customized by setting `fiplr-ignored-globs'.
;;
;; (setq fiplr-ignored-globs '((directories (".git" ".svn"))
;; (files ("*.jpg" "*.png" "*.zip" "*~"))))
;;
;; These globs are used by the UNIX `find' command's -name flag.
;;
;; Usage:
;;
;; Find files: M-x fiplr-find-file
;; Find directories: M-x fiplr-find-directory
;; Clear caches: M-x fiplr-clear-cache
;;
;; For convenience, bind "C-x f" to `fiplr-find-file':
;;
;; (global-set-key (kbd "C-x f") 'fiplr-find-file)
;;
(require 'cl)
;;; --- Package Configuration
;; A cache to avoid repeat searching.
(setq *fiplr-file-cache* '())
;; A cache to avoid repeat searching.
(setq *fiplr-directory-cache* '())
;; The default set of files/directories to look for at the root of a project.
(defvar *fiplr-default-root-markers*
'(".git" ".svn" ".hg" ".bzr"))
;; The default set of patterns to exclude from searches.
(defvar *fiplr-default-ignored-globs*
'((directories (".git" ".svn" ".hg" ".bzr"))
(files (".#*" "*.so"))))
;; Customization group declaration.
(defgroup fiplr nil
"Configuration options for fiplr - find in project.")
;; Settings for project root directories.
(defcustom fiplr-root-markers *fiplr-default-root-markers*
"A list of files or directories that are found at the root of a project."
:type '(repeat string)
:group 'fiplr
:options *fiplr-default-root-markers*)
;; Settings for files and directories that should be ignored.
(defcustom fiplr-ignored-globs *fiplr-default-ignored-globs*
"An alist of glob patterns to exclude from search results."
:type '(alist :key-type symbol :value-type (repeat string))
:group 'fiplr
:options *fiplr-default-ignored-globs*)
;;; --- Public Functions
;; Defines fiplr's determination of the project root.
;;;###autoload
(defun fiplr-root ()
"Locate the root of the project by walking up the directory tree."
"The first directory containing one of fiplr-root-markers is the root."
"If no root marker is found, the current working directory is used."
(let ((cwd (if (buffer-file-name)
(directory-file-name
(file-name-directory (buffer-file-name)))
(file-truename "."))))
(or (fiplr-find-root cwd fiplr-root-markers)
cwd)))
;; Locate a file in the current project.
;;;###autoload
(defun fiplr-find-file ()
"Runs a completing prompt to find a file from the project."
"The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs))
;; Locate a directory in the current project.
;;;###autoload
(defun fiplr-find-directory ()
"Runs a completing prompt to find a directory from the project."
"The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs))
;; Clear the caches.
;;;###autoload
(defun fiplr-clear-cache ()
"Clears the internal caches used by fiplr so the project is searched again."
(interactive)
(setq *fiplr-file-cache* '())
(setq *fiplr-directory-cache* '()))
;;; --- Private Functions
;; Search algorithm to find dir with .git etc.
(defun fiplr-find-root (path root-markers)
"Tail-recursive part of project-root."
(let* ((this-dir (file-name-as-directory (file-truename path)))
(parent-dir (expand-file-name (concat this-dir "..")))
(system-root-dir (expand-file-name "/")))
(cond
((fiplr-root-p path root-markers) this-dir)
((equal system-root-dir this-dir) nil)
(t (fiplr-find-root parent-dir root-markers)))))
;; Predicate looking at path for a root marker.
(defun fiplr-root-p (path root-markers)
"Predicate to check if the given directory is a project root."
(let ((dir (file-name-as-directory path)))
(cl-member-if (lambda (marker)
(file-exists-p (concat dir marker)))
root-markers)))
;; Builds a gigantic `find' shell command with -prune, -o, -not and shit.
(defun fiplr-list-files-shell-command (type path ignored-globs)
"Builds the `find' command to locate all project files & directories."
"Path is the base directory to recurse from."
"Ignored-globs is an alist with keys 'directories and 'files."
(let* ((type-abbrev
(lambda (assoc-type)
(cl-case assoc-type
('directories "d")
('files "f"))))
(name-matcher
(lambda (glob)
(mapconcat 'identity
`("-name" ,(shell-quote-argument glob))
" ")))
(grouped-name-matchers
(lambda (type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
,(mapconcat (lambda (v) (funcall name-matcher v))
(cadr (assoc type ignored-globs))
" -o ")
,(shell-quote-argument ")"))
" ")))
(matcher
(lambda (assoc-type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
"-type"
,(funcall type-abbrev assoc-type)
,(funcall grouped-name-matchers assoc-type)
,(shell-quote-argument ")"))
" "))))
(mapconcat 'identity
`("find"
,(shell-quote-argument (directory-file-name path))
,(funcall matcher 'directories)
"-prune"
"-o"
"-not"
,(funcall matcher 'files)
"-type"
,(funcall type-abbrev type)
"-print")
" ")))
;; List all files found under the given path, ignoring ignored-globs.
(defun fiplr-list-files (type path ignored-globs)
"Expands to a flat list of files/directories found under path."
"The first parameter - type - is the symbol 'directories or 'files."
(let* ((prefix (file-name-as-directory (file-truename path)))
(prefix-length (length prefix))
(list-string
(shell-command-to-string (fiplr-list-files-shell-command
type
prefix
ignored-globs))))
(reverse (reduce (lambda (acc file)
(if (> (length file) prefix-length)
(cons (substring file prefix-length) acc)
acc))
(split-string list-string "[\r\n]+" t)
:initial-value '()))))
;; Runs the find file prompt for the specified path.
(defun fiplr-find-file-in-directory (path ignored-globs)
"Locate a file under the specified directory."
"If the directory has been searched previously, the cache is used."
(let ((root-dir (file-name-as-directory path)))
(unless (assoc root-dir *fiplr-file-cache*)
(push (cons root-dir (fiplr-list-files 'files root-dir ignored-globs))
*fiplr-file-cache*))
(let* ((project-files (cdr (assoc root-dir *fiplr-file-cache*)))
(prompt "Find project file: ")
(file (ido-completing-read prompt project-files)))
(find-file (concat root-dir file)))))
;; Runs the find directory prompt for the specified path.
(defun fiplr-find-directory-in-directory (path ignored-globs)
"Locate a directory under the specified directory."
"If the directory has been searched previously, the cache is used."
(let ((root-dir (file-name-as-directory path)))
(unless (assoc root-dir *fiplr-directory-cache*)
(push (cons root-dir (fiplr-list-files 'directories root-dir ignored-globs))
*fiplr-directory-cache*))
(let* ((project-dirs (cdr (assoc root-dir *fiplr-directory-cache*)))
(prompt "Find project directory: ")
(dirname (ido-completing-read prompt project-dirs)))
(condition-case nil
(dired (concat root-dir dirname))
(error (message (concat "Cannot open directory: " dirname)))))))
(provide 'fiplr)
;;; fiplr.el ends here

View File

@ -0,0 +1,85 @@
;;; grizzl-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (grizzl-result-strings grizzl-result-count grizzl-search
;;;;;; grizzl-make-index) "grizzl-core" "grizzl-core.el" (21530
;;;;;; 3273 796740 656000))
;;; Generated autoloads from grizzl-core.el
(autoload 'grizzl-make-index "grizzl-core" "\
Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive.
\(fn STRINGS &rest OPTIONS)" nil nil)
(autoload 'grizzl-search "grizzl-core" "\
Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'.
\(fn TERM INDEX &optional OLD-RESULT)" nil nil)
(autoload 'grizzl-result-count "grizzl-core" "\
Returns the number of matches present in RESULT.
\(fn RESULT)" nil nil)
(autoload 'grizzl-result-strings "grizzl-core" "\
Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned.
\(fn RESULT INDEX &rest OPTIONS)" nil nil)
;;;***
;;;### (autoloads (grizzl-set-selection-1 grizzl-set-selection+1
;;;;;; grizzl-selected-result grizzl-completing-read) "grizzl-read"
;;;;;; "grizzl-read.el" (21530 3273 902738 462000))
;;; Generated autoloads from grizzl-read.el
(autoload 'grizzl-completing-read "grizzl-read" "\
Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches.
\(fn PROMPT INDEX)" nil nil)
(autoload 'grizzl-selected-result "grizzl-read" "\
Get the selected string from INDEX in a `grizzl-completing-read'.
\(fn INDEX)" nil nil)
(autoload 'grizzl-set-selection+1 "grizzl-read" "\
Move the selection up one row in `grizzl-completing-read'.
\(fn)" t nil)
(autoload 'grizzl-set-selection-1 "grizzl-read" "\
Move the selection down one row in `grizzl-completing-read'.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("grizzl-pkg.el" "grizzl.el") (21530 3273
;;;;;; 979764 956000))
;;;***
(provide 'grizzl-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; grizzl-autoloads.el ends here

View File

@ -0,0 +1,226 @@
;;; grizzl-core.el --- Fast fuzzy search index for Emacs.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; Grizzl provides a fuzzy completion framework for general purpose
;; use in Emacs Lisp projects.
;;
;; grizzl-core.el provides the underlying data structures and sesrch
;; algorithm without any UI attachment. At the core, a fuzzy search
;; index is created from a list of strings, using `grizzl-make-index'.
;; A fuzzy search term is then used to get a result from this index
;; with `grizzl-search'. Because grizzl considers the usage of a
;; fuzzy search index to operate in real-time as a user enters a
;; search term in the minibuffer, the framework optimizes for this use
;; case. Any result can be passed back into `grizzl-search' as a hint
;; to continue searching. The search algorithm is able to understand
;; insertions and deletions and therefore minimizes the work it needs
;; to do in this case. The intended use here is to collect a result
;; on each key press and feed that result into the search for the next
;; key press. Once a search is complete, the matched strings are then
;; read, using `grizzl-result-strings'. The results are ordered on the
;; a combination of the Levenshtein Distance and a character-proximity
;; scoring calculation. This means shorter strings are favoured, but
;; adjacent letters are more heavily favoured.
;;
;; It is assumed that the index will be re-used across multiple
;; searches on larger sets of data.
;;
;;
(eval-when-compile
(require 'cl-lib))
;;; --- Public Functions
;;;###autoload
(defun grizzl-make-index (strings &rest options)
"Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive."
(let ((lookup-table (make-hash-table))
(total-strs (length strings))
(case-sensitive (plist-get options :case-sensitive))
(progress-fn (plist-get options :progress-fn))
(string-data (vconcat (mapcar (lambda (s)
(cons s (length s)))
strings))))
(reduce (lambda (list-offset str)
(grizzl-index-insert str list-offset lookup-table
:case-sensitive case-sensitive)
(when progress-fn
(funcall progress-fn (1+ list-offset) total-strs))
(1+ list-offset))
strings
:initial-value 0)
(maphash (lambda (char str-map)
(maphash (lambda (list-offset locations)
(puthash list-offset (reverse locations) str-map))
str-map)) lookup-table)
`((case-sensitive . ,case-sensitive)
(lookup-table . ,lookup-table)
(string-data . ,string-data))))
;;;###autoload
(defun grizzl-search (term index &optional old-result)
"Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'."
(let* ((cased-term (if (grizzl-index-case-sensitive-p index)
term
(downcase term)))
(result (grizzl-rewind-result cased-term index old-result))
(matches (copy-hash-table (grizzl-result-matches result)))
(from-pos (length (grizzl-result-term result)))
(remainder (substring cased-term from-pos))
(lookup-table (grizzl-lookup-table index)))
(reduce (lambda (acc-res ch)
(let ((sub-table (gethash ch lookup-table)))
(if (not sub-table)
(clrhash matches)
(grizzl-search-increment sub-table matches))
(grizzl-cons-result cased-term matches acc-res)))
remainder
:initial-value result)))
;;;###autoload
(defun grizzl-result-count (result)
"Returns the number of matches present in RESULT."
(hash-table-count (grizzl-result-matches result)))
;;;###autoload
(defun grizzl-result-strings (result index &rest options)
"Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned."
(let* ((matches (grizzl-result-matches result))
(strings (grizzl-index-strings index))
(loaded '())
(start (plist-get options :start))
(end (plist-get options :end)))
(maphash (lambda (string-offset char-offset)
(push string-offset loaded))
matches)
(let* ((ordered (sort loaded
(lambda (a b)
(< (cadr (gethash a matches))
(cadr (gethash b matches))))))
(best (if (or start end)
(delete-if-not 'identity
(subseq ordered (or start 0) end))
ordered)))
(mapcar (lambda (n)
(car (elt strings n)))
best))))
;;; --- Private Functions
(defun grizzl-cons-result (term matches results)
"Build a new result for TERM and hash-table MATCHES consed with RESULTS."
(cons (cons term matches) results))
(defun grizzl-rewind-result (term index result)
"Adjusts RESULT according to TERM, ready for a new search."
(if result
(let* ((old-term (grizzl-result-term result))
(new-len (length term))
(old-len (length old-term)))
(if (and (>= new-len old-len)
(string-equal old-term (substring term 0 old-len)))
result
(grizzl-rewind-result term index (cdr result))))
(grizzl-cons-result "" (grizzl-base-matches index) nil)))
(defun grizzl-base-matches (index)
"Returns the full set of matches in INDEX, with an out-of-bound offset."
(let ((matches (make-hash-table)))
(reduce (lambda (n s-len)
(puthash n (list -1 0 (cdr s-len)) matches)
(1+ n))
(grizzl-index-strings index)
:initial-value 0)
matches))
(defun grizzl-result-term (result)
"Returns the search term used to find the matches in RESULT."
(car (car result)))
(defun grizzl-result-matches (result)
"Returns the internal hash used to track the matches in RESULT."
(cdar result))
(defun grizzl-index-insert (string list-offset index &rest options)
"Inserts STRING at LIST-OFFSET into INDEX."
(let ((case-sensitive (plist-get options :case-sensitive)))
(reduce (lambda (char-offset cs-char)
(let* ((char (if case-sensitive
cs-char
(downcase cs-char)))
(str-map (or (gethash char index)
(puthash char (make-hash-table) index)))
(offsets (gethash list-offset str-map)))
(puthash list-offset
(cons char-offset offsets)
str-map)
(1+ char-offset)))
string
:initial-value 0)))
(defun grizzl-lookup-table (index)
"Returns the lookup table portion of INDEX."
(cdr (assoc 'lookup-table index)))
(defun grizzl-index-strings (index)
"Returns the vector of strings stored in INDEX."
(cdr (assoc 'string-data index)))
(defun grizzl-index-case-sensitive-p (index)
"Predicate to test of INDEX is case-sensitive."
(cdr (assoc 'case-sensitive index)))
(defun grizzl-search-increment (sub-table result)
"Use the search lookup table to filter already-accumulated results."
(cl-flet ((next-offset (key current sub-table)
(find-if (lambda (v)
(> v current))
(gethash key sub-table))))
(maphash (lambda (k v)
(let* ((oldpos (car v))
(oldrank (cadr v))
(len (caddr v))
(newpos (next-offset k oldpos sub-table)))
(if newpos
(puthash k (list newpos
(grizzl-inc-rank oldrank oldpos newpos len)
len)
result)
(remhash k result))))
result)))
(defun grizzl-inc-rank (oldrank oldpos newpos len)
"Increment the current match distance as a new char is matched."
(let ((distance (if (< oldpos 0) 1 (- newpos oldpos))))
(+ oldrank (* len (* distance distance)))))
(provide 'grizzl-core)
;;; grizzl-core.el ends here

View File

@ -0,0 +1,3 @@
(define-package "grizzl" "0.1.1"
"Fuzzy Search Library & Completing Read"
'((cl-lib "0.1")))

View File

@ -0,0 +1,186 @@
;;; grizzl-read.el --- A fuzzy completing-read backed by grizzl.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; grizzl-read.el provides an implementation of the built-in Emacs
;; completing-read function, except it is backed by the grizzl fuzzy
;; search index. The goals are similar to ido-mode and helm, but grizzl
;; is heavily optimized for large data-sets, and as-such uses a
;; persistent fuzzy search index in its algorithm.
;;
;; The indexing and searching algorithm itself is defined in grizzl-core.el
;; with grizzl-read.el simply wrapping the search in a minibuffer with a
;; minor-mode defined.
;;
;; ---- Usage
;;
;; Call `grizzl-completing-read' with an index returned by
;; `grizzl-make-index':
;;
;; (defvar *index* (grizzl-make-index '("one" "two" "three")))
;; (grizzl-completing-read "Number: " index)
;;
;; When the user hits ENTER, either one of the strings is returned on
;; success, or nil of nothing matched.
;;
;; The arrow keys can be used to navigate within the results.
;;
(eval-when-compile
(require 'cl-lib))
;;; --- Configuration Variables
(defvar *grizzl-read-max-results* 10
"The maximum number of results to show in `grizzl-completing-read'.")
;;; --- Runtime Processing Variables
(defvar *grizzl-current-result* nil
"The search result in `grizzl-completing-read'.")
(defvar *grizzl-current-selection* 0
"The selected offset in `grizzl-completing-read'.")
;;; --- Minor Mode Definition
(defvar *grizzl-keymap* (make-sparse-keymap)
"Internal keymap used by the minor-mode in `grizzl-completing-read'.")
(define-key *grizzl-keymap* (kbd "<up>") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "<down>") 'grizzl-set-selection-1)
(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1)
(define-minor-mode grizzl-mode
"Toggle the internal mode used by `grizzl-completing-read'."
nil
" Grizzl"
*grizzl-keymap*)
;;; --- Public Functions
;;;###autoload
(defun grizzl-completing-read (prompt index)
"Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches."
(minibuffer-with-setup-hook
(lambda ()
(setq *grizzl-current-result* nil)
(setq *grizzl-current-selection* 0)
(grizzl-mode 1)
(lexical-let*
((hookfun (lambda ()
(setq *grizzl-current-result*
(grizzl-search (minibuffer-contents)
index
*grizzl-current-result*))
(grizzl-display-result index prompt)))
(exitfun (lambda ()
(grizzl-mode -1)
(remove-hook 'post-command-hook hookfun t))))
(add-hook 'minibuffer-exit-hook exitfun nil t)
(add-hook 'post-command-hook hookfun nil t)))
(read-from-minibuffer ">>> ")
(grizzl-selected-result index)))
;;;###autoload
(defun grizzl-selected-result (index)
"Get the selected string from INDEX in a `grizzl-completing-read'."
(elt (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)
(grizzl-current-selection)))
;;;###autoload
(defun grizzl-set-selection+1 ()
"Move the selection up one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection 1))
;;;###autoload
(defun grizzl-set-selection-1 ()
"Move the selection down one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection -1))
;;; --- Private Functions
(defun grizzl-move-selection (delta)
"Move the selection by DELTA rows in `grizzl-completing-read'."
(setq *grizzl-current-selection* (+ (grizzl-current-selection) delta))
(when (not (= (grizzl-current-selection) *grizzl-current-selection*))
(beep)))
(defun grizzl-display-result (index prompt)
"Renders a series of overlays to list the matches in the result."
(let* ((matches (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)))
(delete-all-overlays)
(overlay-put (make-overlay (point-min) (point-min))
'before-string
(format "%s\n%s\n"
(mapconcat 'identity
(grizzl-map-format-matches matches)
"\n")
(grizzl-format-prompt-line prompt)))
(set-window-text-height nil (max 3 (+ 2 (length matches))))))
(defun grizzl-map-format-matches (matches)
"Convert the set of string MATCHES into propertized text objects."
(if (= 0 (length matches))
(list (propertize "-- NO MATCH --" 'face 'outline-3))
(cdr (reduce (lambda (acc str)
(let* ((idx (car acc))
(lst (cdr acc))
(sel (= idx (grizzl-current-selection))))
(cons (1+ idx)
(cons (grizzl-format-match str sel) lst))))
matches
:initial-value '(0)))))
(defun grizzl-format-match (match-str selected)
"Default match string formatter in `grizzl-completing-read'.
MATCH-STR is the string in the selection list and SELECTED is non-nil
if this is the current selection."
(let ((margin (if selected "> " " "))
(face (if selected 'diredp-symlink 'default)))
(propertize (format "%s%s" margin match-str) 'face face)))
(defun grizzl-format-prompt-line (prompt)
"Returns a string to render a full-width prompt in `grizzl-completing-read'."
(let* ((count (grizzl-result-count *grizzl-current-result*))
(match-info (format " (%d candidate%s) ---- *-"
count (if (= count 1) "" "s"))))
(concat (propertize (format "-*%s *-" prompt) 'face 'modeline-inactive)
(propertize " "
'face 'modeline-inactive
'display `(space :align-to (- right
,(1+ (length match-info)))))
(propertize match-info 'face 'modeline-inactive))))
(defun grizzl-current-selection ()
"Get the currently selected index in `grizzl-completing-read'."
(let ((max-selection
(min (1- *grizzl-read-max-results*)
(1- (grizzl-result-count *grizzl-current-result*)))))
(max 0 (min max-selection *grizzl-current-selection*))))
(provide 'grizzl-read)
;;; grizzl-read.el ends here

View File

@ -0,0 +1,26 @@
;;; grizzl.el --- Fast fuzzy search index for Emacs.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; This package is broken into separate files.
;;
(require 'grizzl-core)
(require 'grizzl-read)
(provide 'grizzl)
;;; grizzl.el ends here

View File

@ -0,0 +1,33 @@
;;; haml-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (haml-mode) "haml-mode" "haml-mode.el" (21553 16292
;;;;;; 429141 493000))
;;; Generated autoloads from haml-mode.el
(autoload 'haml-mode "haml-mode" "\
Major mode for editing Haml files.
\\{haml-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.haml\\'" . haml-mode))
;;;***
;;;### (autoloads nil nil ("haml-mode-pkg.el") (21553 16292 546790
;;;;;; 825000))
;;;***
(provide 'haml-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; haml-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "haml-mode" "3.1.5" "Major mode for editing Haml files" (quote ((ruby-mode "1.0"))))

View File

@ -0,0 +1,888 @@
;;; haml-mode.el --- Major mode for editing Haml files
;; Copyright (c) 2007, 2008 Nathan Weizenbaum
;; Author: Nathan Weizenbaum
;; URL: http://github.com/nex3/haml/tree/master
;; Package-Requires: ((ruby-mode "1.0"))
;; Version: 3.1.5
;; Created: 2007-03-08
;; By: Nathan Weizenbaum
;; Keywords: markup, language, html
;;; Commentary:
;; Because Haml's indentation schema is similar
;; to that of YAML and Python, many indentation-related
;; functions are similar to those in yaml-mode and python-mode.
;; To install, save this on your load path and add the following to
;; your .emacs file:
;;
;; (require 'haml-mode)
;;; Code:
(eval-when-compile (require 'cl))
(require 'ruby-mode)
;; Additional (optional) libraries for fontification
(require 'css-mode nil t)
(require 'textile-mode nil t)
(require 'markdown-mode nil t)
(or
(require 'js nil t)
(require 'javascript-mode "javascript" t))
;; User definable variables
(defgroup haml nil
"Support for the Haml template language."
:group 'languages
:prefix "haml-")
(defcustom haml-mode-hook nil
"Hook run when entering Haml mode."
:type 'hook
:group 'haml)
(defcustom haml-indent-offset 2
"Amount of offset per level of indentation."
:type 'integer
:group 'haml)
(defcustom haml-backspace-backdents-nesting t
"Non-nil to have `haml-electric-backspace' re-indent blocks of code.
This means that all code nested beneath the backspaced line is
re-indented along with the line itself."
:type 'boolean
:group 'haml)
(defvar haml-indent-function 'haml-indent-p
"A function for checking if nesting is allowed.
This function should look at the current line and return t
if the next line could be nested within this line.
The function can also return a positive integer to indicate
a specific level to which the current line could be indented.")
(defconst haml-tag-beg-re
"^[ \t]*\\([%\\.#][a-z0-9_:\\-]+\\)+\\(?:(.*)\\|{.*}\\|\\[.*\\]\\)*"
"A regexp matching the beginning of a Haml tag, through (), {}, and [].")
(defvar haml-block-openers
`(,(concat haml-tag-beg-re "[><]*[ \t]*$")
"^[ \t]*[&!]?[-=~].*do[ \t]*\\(|.*|[ \t]*\\)?$"
,(concat "^[ \t]*[&!]?[-=~][ \t]*\\("
(regexp-opt '("if" "unless" "while" "until" "else" "for"
"begin" "elsif" "rescue" "ensure" "when"))
"\\)")
"^[ \t]*/\\(\\[.*\\]\\)?[ \t]*$"
"^[ \t]*-#"
"^[ \t]*:")
"A list of regexps that match lines of Haml that open blocks.
That is, a Haml line that can have text nested beneath it should
be matched by a regexp in this list.")
;; Font lock
(defun haml-nested-regexp (re)
"Create a regexp to match a block starting with RE.
The line containing RE is matched, as well as all lines indented beneath it."
(concat "^\\([ \t]*\\)\\(" re "\\)\\([ \t]*\\(?:\n\\(?:\\1 +[^\n]*\\)?\\)*\n?\\)$"))
(defconst haml-font-lock-keywords
`((haml-highlight-interpolation 1 font-lock-variable-name-face prepend)
(haml-highlight-ruby-tag 1 font-lock-preprocessor-face)
(haml-highlight-ruby-script 1 font-lock-preprocessor-face)
;; TODO: distinguish between "/" comments, which can contain HAML
;; output directives, and "-#", which are completely ignored
haml-highlight-comment
haml-highlight-filter
("^!!!.*" 0 font-lock-constant-face)
("\\s| *$" 0 font-lock-string-face)))
(defconst haml-filter-re (haml-nested-regexp ":\\w+"))
(defconst haml-comment-re (haml-nested-regexp "\\(?:-\\#\\|/\\)[^\n]*"))
(defun haml-highlight-comment (limit)
"Highlight any -# or / comment found up to LIMIT."
(when (re-search-forward haml-comment-re limit t)
(let ((beg (match-beginning 0))
(end (match-end 0)))
(put-text-property beg end 'face 'font-lock-comment-face)
(goto-char end))))
;; Fontifying sub-regions for other languages
(defun haml-fontify-region
(beg end keywords syntax-table syntactic-keywords syntax-propertize-fn)
"Fontify a region between BEG and END using another mode's fontification.
KEYWORDS, SYNTAX-TABLE, SYNTACTIC-KEYWORDS and
SYNTAX-PROPERTIZE-FN are the values of that mode's
`font-lock-keywords', `font-lock-syntax-table',
`font-lock-syntactic-keywords', and `syntax-propertize-function'
respectively."
(save-excursion
(save-match-data
(let ((font-lock-keywords keywords)
(font-lock-syntax-table syntax-table)
(font-lock-syntactic-keywords syntactic-keywords)
(syntax-propertize-function syntax-propertize-fn)
(font-lock-multiline 'undecided)
(font-lock-dont-widen t)
font-lock-keywords-only
font-lock-extend-region-functions
font-lock-keywords-case-fold-search)
(save-restriction
(narrow-to-region (1- beg) end)
;; font-lock-fontify-region apparently isn't inclusive,
;; so we have to move the beginning back one char
(font-lock-fontify-region (1- beg) end))))))
(defun haml-fontify-region-as-ruby (beg end)
"Use Ruby's font-lock variables to fontify the region between BEG and END."
(haml-fontify-region beg end ruby-font-lock-keywords
ruby-font-lock-syntax-table
(when (boundp 'ruby-font-lock-syntactic-keywords)
ruby-font-lock-syntactic-keywords)
(when (fboundp 'ruby-syntax-propertize-function)
#'ruby-syntax-propertize-function)))
(defun haml-fontify-region-as-css (beg end)
"Fontify CSS code from BEG to END.
This requires that `css-mode' is available.
`css-mode' is included with Emacs 23."
(when (boundp 'css-font-lock-keywords)
(haml-fontify-region beg end
css-font-lock-keywords
css-mode-syntax-table
nil
nil)))
(defun haml-fontify-region-as-javascript (beg end)
"Fontify javascript code from BEG to END.
This requires that Karl Landström's javascript mode be available, either as the
\"js.el\" bundled with Emacs >= 23, or as \"javascript.el\" found in ELPA and
elsewhere."
(let ((keywords (or (and (featurep 'js) js--font-lock-keywords-3)
(and (featurep 'javascript-mode) js-font-lock-keywords-3)))
(syntax-table (or (and (featurep 'js) js-mode-syntax-table)
(and (featurep 'javascript-mode) javascript-mode-syntax-table)))
(syntax-propertize (and (featurep 'js) 'js-syntax-propertize)))
(when keywords
(when (and (fboundp 'js--update-quick-match-re) (null js--quick-match-re-func))
(js--update-quick-match-re))
(haml-fontify-region beg end keywords syntax-table nil syntax-propertize))))
(defun haml-fontify-region-as-textile (beg end)
"Highlight textile from BEG to END.
This requires that `textile-mode' be available.
Note that the results are not perfect, since `textile-mode' expects
certain constructs such as \"h1.\" to be at the beginning of a line,
and indented Haml filters always have leading whitespace."
(if (boundp 'textile-font-lock-keywords)
(haml-fontify-region beg end textile-font-lock-keywords nil nil nil)))
(defun haml-fontify-region-as-markdown (beg end)
"Highlight markdown from BEG to END.
This requires that `markdown-mode' be available."
(if (boundp 'markdown-mode-font-lock-keywords)
(haml-fontify-region beg end
markdown-mode-font-lock-keywords
markdown-mode-syntax-table
nil
nil)))
(defvar haml-fontify-filter-functions-alist
'(("ruby" . haml-fontify-region-as-ruby)
("css" . haml-fontify-region-as-css)
("javascript" . haml-fontify-region-as-javascript)
("textile" . haml-fontify-region-as-textile)
("markdown" . haml-fontify-region-as-markdown))
"An alist of (FILTER-NAME . FUNCTION) used to fontify code regions.
FILTER-NAME is a string and FUNCTION is a function which will be
used to fontify the filter's indented code region. FUNCTION will
be passed the extents of that region in two arguments BEG and
END.")
(defun haml-highlight-filter (limit)
"Highlight any :filter region found in the text up to LIMIT."
(when (re-search-forward haml-filter-re limit t)
;; fontify the filter name
(put-text-property (match-beginning 2) (1+ (match-end 2))
'face font-lock-preprocessor-face)
(let ((filter-name (substring (match-string 2) 1))
(code-start (1+ (match-beginning 3)))
(code-end (match-end 3)))
(save-match-data
(funcall (or (cdr (assoc filter-name haml-fontify-filter-functions-alist))
#'(lambda (beg end)
(put-text-property beg end
'face
'font-lock-string-face)))
code-start code-end))
(goto-char (match-end 0)))))
(defconst haml-possibly-multiline-code-re
"\\(\\(?:.*?,[ \t]*\n\\)*.*\\)"
"Regexp to match trailing ruby code which may continue onto subsequent lines.")
(defconst haml-ruby-script-re
(concat "^[ \t]*\\(-\\|[&!]?[=~]\\) " haml-possibly-multiline-code-re)
"Regexp to match -, = or ~ blocks and any continued code lines.")
(defun haml-highlight-ruby-script (limit)
"Highlight a Ruby script expression (-, =, or ~).
LIMIT works as it does in `re-search-forward'."
(when (re-search-forward haml-ruby-script-re limit t)
(haml-fontify-region-as-ruby (match-beginning 2) (match-end 2))))
(defun haml-move (re)
"Try matching and moving to the end of regular expression RE.
Returns non-nil if the expression was sucessfully matched."
(when (looking-at re)
(goto-char (match-end 0))
t))
(defun haml-highlight-ruby-tag (limit)
"Highlight Ruby code within a Haml tag.
LIMIT works as it does in `re-search-forward'.
This highlights the tag attributes and object refs of the tag,
as well as the script expression (-, =, or ~) following the tag.
For example, this will highlight all of the following:
%p{:foo => 'bar'}
%p[@bar]
%p= 'baz'
%p{:foo => 'bar'}[@bar]= 'baz'"
(when (re-search-forward "^[ \t]*[%.#]" limit t)
(forward-char -1)
;; Highlight tag, classes, and ids
(while (haml-move "\\([.#%]\\)[a-z0-9_:\\-]*")
(put-text-property (match-beginning 0) (match-end 0) 'face
(case (char-after (match-beginning 1))
(?% font-lock-keyword-face)
(?# font-lock-function-name-face)
(?. font-lock-variable-name-face))))
(block loop
(while t
(let ((eol (save-excursion (end-of-line) (point))))
(case (char-after)
;; Highlight obj refs
(?\[
(forward-char 1)
(let ((beg (point)))
(haml-limited-forward-sexp eol)
(haml-fontify-region-as-ruby beg (point))))
;; Highlight new attr hashes
(?\(
(forward-char 1)
(while
(and (haml-parse-new-attr-hash
(lambda (type beg end)
(case type
(name (put-text-property beg end
'face
font-lock-constant-face))
(value (haml-fontify-region-as-ruby beg end)))))
(not (eobp)))
(forward-line 1)
(beginning-of-line)))
;; Highlight old attr hashes
(?\{
(let ((beg (point)))
(haml-limited-forward-sexp eol)
;; Check for multiline
(while (and (eolp) (eq (char-before) ?,) (not (eobp)))
(forward-line)
(let ((eol (save-excursion (end-of-line) (point))))
;; If no sexps are closed,
;; we're still continuing a multiline hash
(if (>= (car (parse-partial-sexp (point) eol)) 0)
(end-of-line)
;; If sexps have been closed,
;; set the point at the end of the total sexp
(goto-char beg)
(haml-limited-forward-sexp eol))))
(haml-fontify-region-as-ruby (1+ beg) (point))))
(t (return-from loop))))))
;; Move past end chars
(haml-move "[<>&!]+")
;; Highlight script
(if (looking-at (concat "\\([=~]\\) " haml-possibly-multiline-code-re))
(haml-fontify-region-as-ruby (match-beginning 2) (match-end 2))
;; Give font-lock something to highlight
(forward-char -1)
(looking-at "\\(\\)"))
t))
(defun haml-highlight-interpolation (limit)
"Highlight Ruby interpolation (#{foo}).
LIMIT works as it does in `re-search-forward'."
(when (re-search-forward "\\(#{\\)" limit t)
(save-match-data
(forward-char -1)
(let ((beg (point)))
(haml-limited-forward-sexp limit)
(haml-fontify-region-as-ruby (1+ beg) (point)))
(when (eq (char-before) ?\})
(put-text-property (1- (point)) (point)
'face font-lock-variable-name-face))
t)))
(defun haml-limited-forward-sexp (limit &optional arg)
"Move forward using `forward-sexp' or to LIMIT, whichever comes first.
With ARG, do it that many times."
(let (forward-sexp-function)
(condition-case err
(save-restriction
(narrow-to-region (point) limit)
(forward-sexp arg))
(scan-error
(unless (equal (nth 1 err) "Unbalanced parentheses")
(signal 'scan-error (cdr err)))
(goto-char limit)))))
(defun haml-find-containing-block (re)
"If point is inside a block matching RE, return (start . end) for the block."
(save-excursion
(let ((pos (point))
start end)
(beginning-of-line)
(when (and
(or (looking-at re)
(when (re-search-backward re nil t)
(looking-at re)))
(< pos (match-end 0)))
(setq start (match-beginning 0)
end (match-end 0)))
(when start
(cons start end)))))
(defun haml-maybe-extend-region (extender)
"Maybe extend the font lock region using EXTENDER.
With point at the beginning of the font lock region, EXTENDER is called.
If it returns a (START . END) pair, those positions are used to possibly
extend the font lock region."
(let ((old-beg font-lock-beg)
(old-end font-lock-end))
(save-excursion
(goto-char font-lock-beg)
(let ((new-bounds (funcall extender)))
(when new-bounds
(setq font-lock-beg (min font-lock-beg (car new-bounds))
font-lock-end (max font-lock-end (cdr new-bounds))))))
(or (/= old-beg font-lock-beg)
(/= old-end font-lock-end))))
(defun haml-extend-region-nested-below ()
"Extend the font-lock region to any subsequent indented lines."
(haml-maybe-extend-region
(lambda ()
(beginning-of-line)
(when (looking-at (haml-nested-regexp "[^ \t].*"))
(cons (match-beginning 0) (match-end 0))))))
(defun haml-extend-region-to-containing-block (re)
"Extend the font-lock region to the smallest containing block matching RE."
(haml-maybe-extend-region
(lambda ()
(haml-find-containing-block re))))
(defun haml-extend-region-filter ()
"Extend the font-lock region to an enclosing filter."
(haml-extend-region-to-containing-block haml-filter-re))
(defun haml-extend-region-comment ()
"Extend the font-lock region to an enclosing comment."
(haml-extend-region-to-containing-block haml-comment-re))
(defun haml-extend-region-ruby-script ()
"Extend the font-lock region to encompass any current -/=/~ line."
(haml-extend-region-to-containing-block haml-ruby-script-re))
(defun haml-extend-region-multiline-hashes ()
"Extend the font-lock region to encompass multiline attribute hashes."
(haml-maybe-extend-region
(lambda ()
(let ((attr-props (haml-parse-multiline-attr-hash))
multiline-end
start)
(when attr-props
(setq start (cdr (assq 'point attr-props)))
(end-of-line)
;; Move through multiline attrs
(when (eq (char-before) ?,)
(save-excursion
(while (progn (end-of-line)
(and (eq (char-before) ?,) (not (eobp))))
(forward-line))
(forward-line -1)
(end-of-line)
(setq multiline-end (point))))
(goto-char (+ (cdr (assq 'point attr-props))
(cdr (assq 'hash-indent attr-props))
-1))
(haml-limited-forward-sexp
(or multiline-end
(save-excursion (end-of-line) (point))))
(cons start (point)))))))
(defun haml-extend-region-contextual ()
"Extend the font lock region piecemeal.
The result of calling this function repeatedly until it returns
nil is that (FONT-LOCK-BEG . FONT-LOCK-END) will be the smallest
possible region in which font-locking could be affected by
changes in the initial region."
(or
(haml-extend-region-filter)
(haml-extend-region-comment)
(haml-extend-region-ruby-script)
(haml-extend-region-multiline-hashes)
(haml-extend-region-nested-below)
(font-lock-extend-region-multiline)))
;; Mode setup
(defvar haml-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?: "." table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?' "\"" table)
table)
"Syntax table in use in `haml-mode' buffers.")
(defvar haml-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [backspace] 'haml-electric-backspace)
(define-key map "\C-?" 'haml-electric-backspace)
(define-key map "\C-c\C-f" 'haml-forward-sexp)
(define-key map "\C-c\C-b" 'haml-backward-sexp)
(define-key map "\C-c\C-u" 'haml-up-list)
(define-key map "\C-c\C-d" 'haml-down-list)
(define-key map "\C-c\C-k" 'haml-kill-line-and-indent)
(define-key map "\C-c\C-r" 'haml-output-region)
(define-key map "\C-c\C-l" 'haml-output-buffer)
map))
(defalias 'haml-parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
;;;###autoload
(define-derived-mode haml-mode haml-parent-mode "Haml"
"Major mode for editing Haml files.
\\{haml-mode-map}"
(set-syntax-table haml-mode-syntax-table)
(setq font-lock-extend-region-functions '(haml-extend-region-contextual))
(set (make-local-variable 'jit-lock-contextually) t)
(set (make-local-variable 'font-lock-multiline) t)
(set (make-local-variable 'indent-line-function) 'haml-indent-line)
(set (make-local-variable 'indent-region-function) 'haml-indent-region)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set (make-local-variable 'comment-start) "-#")
(setq font-lock-defaults '((haml-font-lock-keywords) t t))
(setq indent-tabs-mode nil))
;; Useful functions
(defun haml-comment-block ()
"Comment the current block of Haml code."
(interactive)
(save-excursion
(let ((indent (current-indentation)))
(back-to-indentation)
(insert "-#")
(newline)
(indent-to indent)
(beginning-of-line)
(haml-mark-sexp)
(haml-reindent-region-by haml-indent-offset))))
(defun haml-uncomment-block ()
"Uncomment the current block of Haml code."
(interactive)
(save-excursion
(beginning-of-line)
(while (not (looking-at haml-comment-re))
(haml-up-list)
(beginning-of-line))
(haml-mark-sexp)
(kill-line 1)
(haml-reindent-region-by (- haml-indent-offset))))
(defun haml-replace-region (start end)
"Replace the current block of Haml code with the HTML equivalent.
Called from a program, START and END specify the region to indent."
(interactive "r")
(save-excursion
(goto-char end)
(setq end (point-marker))
(goto-char start)
(let ((ci (current-indentation)))
(while (re-search-forward "^ +" end t)
(replace-match (make-string (- (current-indentation) ci) ? ))))
(shell-command-on-region start end "haml" "haml-output" t)))
(defun haml-output-region (start end)
"Displays the HTML output for the current block of Haml code.
Called from a program, START and END specify the region to indent."
(interactive "r")
(kill-new (buffer-substring start end))
(with-temp-buffer
(yank)
(haml-indent-region (point-min) (point-max))
(shell-command-on-region (point-min) (point-max) "haml" "haml-output")))
(defun haml-output-buffer ()
"Displays the HTML output for entire buffer."
(interactive)
(haml-output-region (point-min) (point-max)))
;; Navigation
(defun haml-forward-through-whitespace (&optional backward)
"Move the point forward through any whitespace.
The point will move forward at least one line, until it reaches
either the end of the buffer or a line with no whitespace.
If BACKWARD is non-nil, move the point backward instead."
(let ((arg (if backward -1 1))
(endp (if backward 'bobp 'eobp)))
(loop do (forward-line arg)
while (and (not (funcall endp))
(looking-at "^[ \t]*$")))))
(defun haml-at-indent-p ()
"Return non-nil if the point is before any text on the line."
(let ((opoint (point)))
(save-excursion
(back-to-indentation)
(>= (point) opoint))))
(defun haml-forward-sexp (&optional arg)
"Move forward across one nested expression.
With ARG, do it that many times. Negative arg -N means move
backward across N balanced expressions.
A sexp in Haml is defined as a line of Haml code as well as any
lines nested beneath it."
(interactive "p")
(or arg (setq arg 1))
(if (and (< arg 0) (not (haml-at-indent-p)))
(back-to-indentation)
(while (/= arg 0)
(let ((indent (current-indentation)))
(loop do (haml-forward-through-whitespace (< arg 0))
while (and (not (eobp))
(not (bobp))
(> (current-indentation) indent)))
(unless (eobp)
(back-to-indentation))
(setq arg (+ arg (if (> arg 0) -1 1)))))))
(defun haml-backward-sexp (&optional arg)
"Move backward across one nested expression.
With ARG, do it that many times. Negative arg -N means move
forward across N balanced expressions.
A sexp in Haml is defined as a line of Haml code as well as any
lines nested beneath it."
(interactive "p")
(haml-forward-sexp (if arg (- arg) -1)))
(defun haml-up-list (&optional arg)
"Move out of one level of nesting.
With ARG, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (> arg 0)
(let ((indent (current-indentation)))
(loop do (haml-forward-through-whitespace t)
while (and (not (bobp))
(>= (current-indentation) indent)))
(setq arg (1- arg))))
(back-to-indentation))
(defun haml-down-list (&optional arg)
"Move down one level of nesting.
With ARG, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (> arg 0)
(let ((indent (current-indentation)))
(haml-forward-through-whitespace)
(when (<= (current-indentation) indent)
(haml-forward-through-whitespace t)
(back-to-indentation)
(error "Nothing is nested beneath this line"))
(setq arg (1- arg))))
(back-to-indentation))
(defun haml-mark-sexp ()
"Mark the next Haml block."
(let ((forward-sexp-function 'haml-forward-sexp))
(mark-sexp)))