Upgrade packages

This commit is contained in:
Gergely Polonkai 2016-04-21 23:27:19 +02:00
parent 93b23592b5
commit 47318dfe18
273 changed files with 52696 additions and 10190 deletions

15
.gitmodules vendored
View File

@ -1,21 +1,6 @@
[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
[submodule "move-line"]
path = move-line
url = git://github.com/nflath/move-line.git
[submodule "ggtags"]
path = ggtags
url = https://github.com/leoliu/ggtags.git

View File

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

View File

@ -1,12 +1,9 @@
;;; ag-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (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))
;;;### (autoloads nil "ag" "ag.el" (22297 19677 174516 738000))
;;; Generated autoloads from ag.el
(autoload 'ag "ag" "\
@ -18,12 +15,13 @@ 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.
Search using ag in a given DIRECTORY for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to
the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX DIRECTORY)" t nil)
\(fn STRING FILE-TYPE DIRECTORY)" t nil)
(autoload 'ag-regexp "ag" "\
Search using ag in a given directory for a given regexp.
@ -42,12 +40,13 @@ 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.
Search using ag for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to the
symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX)" t nil)
\(fn STRING FILE-TYPE)" t nil)
(autoload 'ag-project-regexp "ag" "\
Guess the root of the current project and search it with ag
@ -104,26 +103,20 @@ See also `ag-dired-regexp'.
\(fn REGEXP)" t nil)
(autoload 'ag-kill-buffers "ag" "\
Kill all ag-mode buffers.
Kill all `ag-mode' buffers.
\(fn)" t nil)
(autoload 'ag-kill-other-buffers "ag" "\
Kill all ag-mode buffers other than the current buffer.
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

View File

@ -0,0 +1 @@
(define-package "ag" "20160321.1606" "A front-end for ag ('the silver searcher'), the C ack replacement." '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")))

View File

@ -4,8 +4,9 @@
;;
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Created: 11 January 2013
;; Version: 0.42
;; Version: 0.48
;; Package-Version: 20160321.1606
;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
;;; Commentary:
;; Please see README.md for documentation, or read it online at
@ -32,8 +33,11 @@
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile (require 'cl)) ;; dolist, defun*, flet
(require 'cl-lib) ;; cl-letf, cl-defun
(require 'dired) ;; dired-sort-inhibit
(require 'dash)
(require 's)
(require 'find-dired) ;; find-dired-filter
(defcustom ag-executable
"ag"
@ -42,8 +46,14 @@
:group 'ag)
(defcustom ag-arguments
(list "--smart-case" "--nogroup" "--column" "--")
"Default arguments passed to ag."
(list "--line-number" "--smart-case" "--nogroup" "--column" "--stats" "--")
"Default arguments passed to ag.
Ag.el requires --nogroup and --column, so we recommend you add any
additional arguments to the start of this list.
--line-number is required on Windows, as otherwise ag will not
print line numbers when the input is a stream."
:type '(repeat (string))
:group 'ag)
@ -79,6 +89,11 @@ If set to nil, fall back to finding VCS root directories."
(function :tag "Function"))
:group 'ag)
(defcustom ag-ignore-list nil
"A list of patterns to ignore when searching."
:type '(repeat (string))
:group 'ag)
(require 'compile)
;; Although ag results aren't exactly errors, we treat them as errors
@ -93,65 +108,120 @@ If set to nil, fall back to finding VCS root directories."
"Face name to use for ag matches."
:group 'ag)
(defvar ag-search-finished-hook nil
"Hook run when ag completes a search in a buffer.")
(defun ag/run-finished-hook (buffer how-finished)
"Run the ag hook to signal that the search has completed."
(with-current-buffer buffer
(run-hooks 'ag-search-finished-hook)))
(defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body)
"Temporarily override the definition of FUN-NAME whilst BODY is executed.
Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)."
`(cl-letf (((symbol-function ,fun-name)
(lambda ,fun-args ,fun-body)))
,@body))
(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'."
different window, according to `ag-reuse-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))
(ag/with-patch-function
'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)))
;; 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.
(defvar ag/file-column-pattern
"^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):"
"A regexp pattern that groups output into filename, line number and column number.")
(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-regexp-alist)
(list 'compilation-ag-nogroup))
(set (make-local-variable 'compilation-error-regexp-alist-alist)
(list (cons 'compilation-ag-nogroup (list ag/file-column-pattern 1 2 3))))
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
(set (make-local-variable 'next-error-function) 'ag/next-error-function)
(set (make-local-variable 'next-error-function) #'ag/next-error-function)
(set (make-local-variable 'compilation-finish-functions)
#'ag/run-finished-hook)
(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)
(define-key ag-mode-map (kbd "p") #'compilation-previous-error)
(define-key ag-mode-map (kbd "n") #'compilation-next-error)
(define-key ag-mode-map (kbd "k") '(lambda () (interactive)
(let (kill-buffer-query-functions) (kill-buffer))))
(defun ag/buffer-name (search-string directory regexp)
"Return a buffer name formatted according to ag.el conventions."
(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))
(defun ag/format-ignore (ignores)
"Prepend '--ignore' to every item in IGNORES."
(apply #'append
(mapcar (lambda (item) (list "--ignore" item)) ignores)))
(cl-defun ag/search (string directory
&key (regexp nil) (file-regex nil) (file-type 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)))
(setq arguments (cons "--literal" arguments)))
(if ag-highlight-search
;; We're highlighting, so pass additional arguments for
;; highlighting the current search term using shell escape
;; sequences.
(setq arguments (append '("--color" "--color-match" "30;43") arguments))
(setq arguments (append '("--nocolor") arguments)))
;; We're not highlighting.
(if (eq system-type 'windows-nt)
;; Use --vimgrep to work around issue #97 on Windows.
(setq arguments (append '("--vimgrep") arguments))
(setq arguments (append '("--nocolor") arguments))))
(when (char-or-string-p file-regex)
(setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
(when file-type
(setq arguments (cons (format "--%s" file-type) arguments)))
(when (integerp current-prefix-arg)
(setq arguments (cons (format "--context=%d" (abs current-prefix-arg)) arguments)))
(when ag-ignore-list
(setq arguments (append (ag/format-ignore ag-ignore-list) arguments)))
(unless (file-exists-p default-directory)
(error "No such directory %s" default-directory))
(let ((command-string
(mapconcat 'shell-quote-argument
(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)))
;; If we're called with a prefix, let the user modify the command before
;; running it. Typically this means they want to pass additional arguments.
;; The numeric value is used for context lines: positive is just context
;; number (no modification), negative allows further modification.
(when (and current-prefix-arg (not (and (integerp current-prefix-arg) (> current-prefix-arg 0))))
;; Make a space in the command-string for the user to enter more arguments.
(setq command-string (ag/replace-first command-string " -- " " -- "))
;; Prompt for the command.
(let ((adjusted-point (- (length command-string) (length string) 5)))
(setq command-string
(read-from-minibuffer "ag command: "
(cons command-string adjusted-point)))))
;; Call ag.
(compilation-start
command-string
'ag-mode
#'ag-mode
`(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
(defun ag/dwim-at-point ()
@ -169,7 +239,7 @@ 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))
(format "\\.%s$" (ag/escape-pcre (file-name-extension file-name)))
"")))
(defun ag/longest-string (&rest strings)
@ -184,6 +254,13 @@ Returns an empty string otherwise."
(setq longest-string string)))))
longest-string))
(defun ag/replace-first (string before after)
"Replace the first occurrence of BEFORE in STRING with AFTER."
(replace-regexp-in-string
(concat "\\(" (regexp-quote before) "\\)" ".*\\'")
after string
nil nil 1))
(autoload 'vc-git-root "vc-git")
(require 'vc-svn)
@ -194,6 +271,8 @@ Returns an empty string otherwise."
(autoload 'vc-hg-root "vc-hg")
(autoload 'vc-bzr-root "vc-bzr")
(defun ag/project-root (file-path)
"Guess the project root of the given FILE-PATH.
@ -204,9 +283,24 @@ roots."
(or (ag/longest-string
(vc-git-root file-path)
(vc-svn-root file-path)
(vc-hg-root file-path))
(vc-hg-root file-path)
(vc-bzr-root file-path))
file-path)))
(defun ag/dired-align-size-column ()
(beginning-of-line)
(when (looking-at "^ ")
(forward-char 2)
(search-forward " " nil t 4)
(let* ((size-start (point))
(size-end (search-forward " " nil t))
(width (and size-end (- size-end size-start))))
(when (and size-end
(< width 12)
(> width 1))
(goto-char size-start)
(insert (make-string (- 12 width) ? ))))))
(defun ag/dired-filter (proc string)
"Filter the output of ag to make it suitable for `dired-mode'."
(let ((buf (process-buffer proc))
@ -221,17 +315,20 @@ roots."
(insert string)
(goto-char beg)
(or (looking-at "^")
(forward-line 1))
(progn
(ag/dired-align-size-column)
(forward-line 1)))
(while (looking-at "^")
(insert " ")
(ag/dired-align-size-column)
(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))
(while (search-forward (concat " " default-directory) nil t)
(replace-match " " nil t))
(goto-char (point-max))
(if (search-backward "\n" (process-mark proc) t)
(progn
@ -260,6 +357,7 @@ roots."
;; will stay around until M-x list-processes.
(delete-process proc)
(force-mode-line-update)))
(run-hooks 'dired-after-readin-hook)
(message "%s finished." (current-buffer))))))
(defun ag/kill-process ()
@ -276,14 +374,14 @@ roots."
"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))))))
(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)
@ -291,20 +389,21 @@ matched literally."
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))
(interactive (list (ag/read-from-minibuffer "Search string")
(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.
(defun ag-files (string file-type directory)
"Search using ag in a given DIRECTORY for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults 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))
(interactive (list (ag/read-from-minibuffer "Search string")
(ag/read-file-type)
(read-directory-name "Directory: ")))
(ag/search string directory :file-regex file-regex))
(apply #'ag/search string directory file-type))
;;;###autoload
(defun ag-regexp (string directory)
@ -321,18 +420,38 @@ If called with a prefix, prompts for flags to pass to 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))))
(interactive (list (ag/read-from-minibuffer "Search string")))
(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.
(defun ag-project-files (string file-type)
"Search using ag for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults 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))
(interactive (list (ag/read-from-minibuffer "Search string")
(ag/read-file-type)))
(apply 'ag/search string (ag/project-root default-directory) file-type))
(defun ag/read-from-minibuffer (prompt)
"Read a value from the minibuffer with PROMPT.
If there's a string at point, offer that as a default."
(let* ((suggested (ag/dwim-at-point))
(final-prompt
(if suggested
(format "%s (default %s): " prompt suggested)
(format "%s: " prompt)))
;; Ask the user for input, but add `suggested' to the history
;; so they can use M-n if they want to modify it.
(user-input (read-from-minibuffer
final-prompt
nil nil nil nil suggested)))
;; Return the input provided by the user, or use `suggested' if
;; the input was empty.
(if (> (length user-input) 0)
user-input
suggested)))
;;;###autoload
(defun ag-project-regexp (regexp)
@ -341,8 +460,7 @@ 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)))))
(interactive (list (ag/read-from-minibuffer "Search regexp")))
(ag/search regexp (ag/project-root default-directory) :regexp t))
(autoload 'symbol-at-point "thingatpt")
@ -352,7 +470,8 @@ If called with a prefix, prompts for flags to pass to ag."
(make-obsolete 'ag-project-at-point 'ag-project "0.19")
;;;###autoload
(defalias 'ag-regexp-project-at-point 'ag-project-regexp) ; TODO: mark as obsolete
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
(make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46")
;;;###autoload
(defun ag-dired (dir pattern)
@ -387,7 +506,10 @@ See also `find-dired'."
(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 " {} &")))
(cmd (concat ag-executable " --nocolor -g '" regexp "' "
(shell-quote-argument dir)
" | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/ | xargs -I '{}' ls "
dired-listing-switches " '{}' &")))
(with-current-buffer (get-buffer-create buffer-name)
(switch-to-buffer (current-buffer))
(widen)
@ -397,6 +519,7 @@ See also `find-dired'."
(setq buffer-read-only nil))
(let ((inhibit-read-only t)) (erase-buffer))
(setq default-directory dir)
(run-hooks 'dired-before-readin-hook)
(shell-command cmd (current-buffer))
(insert " " dir ":\n")
(insert " " cmd "\n")
@ -408,7 +531,7 @@ See also `find-dired'."
(set (make-local-variable 'dired-sort-inhibit) t)
(set (make-local-variable 'revert-buffer-function)
`(lambda (ignore-auto noconfirm)
(ag-dired ,orig-dir ,regexp)))
(ag-dired-regexp ,orig-dir ,regexp)))
(if (fboundp 'dired-simple-subdir-alist)
(dired-simple-subdir-alist)
(set (make-local-variable 'dired-subdir-alist)
@ -438,7 +561,7 @@ See also `ag-dired-regexp'."
;;;###autoload
(defun ag-kill-buffers ()
"Kill all ag-mode buffers."
"Kill all `ag-mode' buffers."
(interactive)
(dolist (buffer (buffer-list))
(when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
@ -446,7 +569,7 @@ See also `ag-dired-regexp'."
;;;###autoload
(defun ag-kill-other-buffers ()
"Kill all ag-mode buffers other than the current buffer."
"Kill all `ag-mode' buffers other than the current buffer."
(interactive)
(let ((current-buffer (current-buffer)))
(dolist (buffer (buffer-list))
@ -480,5 +603,28 @@ This function is called from `compilation-filter-hook'."
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
(replace-match "" t t)))))))
(defun ag/get-supported-types ()
"Query the ag executable for which file types it recognises."
(let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable)))
(lines (-map #'s-trim (s-lines ag-output)))
(types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines))
(extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines))))
(-zip types extensions)))
(defun ag/read-file-type ()
"Prompt the user for a known file type, or let them specify a PCRE regex."
(let* ((all-types-with-extensions (ag/get-supported-types))
(all-types (mapcar 'car all-types-with-extensions))
(file-type
(completing-read "Select file type: "
(append '("custom (provide a PCRE regex)") all-types)))
(file-type-extensions
(cdr (assoc file-type all-types-with-extensions))))
(if file-type-extensions
(list :file-type file-type)
(list :file-regex
(read-from-minibuffer "Filenames which match PCRE: "
(ag/buffer-extension-regex))))))
(provide 'ag)
;;; ag.el ends here

View File

@ -1 +0,0 @@
(define-package "buffer-move" "0.6.1" "" 'nil)

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "buffer-move" "buffer-move.el" (21831 16639
;;;;;; 808187 792000))
;;;### (autoloads nil "buffer-move" "buffer-move.el" (22297 19848
;;;;;; 209528 72000))
;;; Generated autoloads from buffer-move.el
(autoload 'buf-move-up "buffer-move" "\
@ -35,6 +35,14 @@ Swap the current buffer and the buffer on the right of the split.
\(fn)" t nil)
(autoload 'buf-move "buffer-move" "\
Begin moving the current buffer to different windows.
Use the arrow keys to move in the desired direction. Pressing
any other key exits this function.
\(fn)" t nil)
;;;***
;; Local Variables:

View File

@ -0,0 +1 @@
(define-package "buffer-move" "20160108.708" "easily swap buffers" 'nil :url "https://github.com/lukhas/buffer-move" :keywords '("lisp" "convenience"))

View File

@ -1,14 +1,15 @@
;;; buffer-move.el ---
;;; buffer-move.el --- easily swap buffers
;; Copyright (C) 2004-2014 Lucas Bonnet <lucas@rincevent.net>
;; Copyright (C) 2014 Mathis Hofer <mathis@fsfe.org>
;; Copyright (C) 2014 Geyslan G. Bem <geyslan@gmail.com>
;; Copyright (C) 2014-2015 Geyslan G. Bem <geyslan@gmail.com>
;; Authors: Lucas Bonnet <lucas@rincevent.net>
;; Geyslan G. Bem <geyslan@gmail.com>
;; Mathis Hofer <mathis@fsfe.org>
;; Keywords: lisp,convenience
;; Version: 0.6.1
;; Package-Version: 20160108.708
;; Version: 0.6.2
;; URL : https://github.com/lukhas/buffer-move
;; This program is free software; you can redistribute it and/or
@ -100,6 +101,10 @@
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No window in this direction")
(if (window-dedicated-p other-win)
(error "The window in this direction is dedicated"))
(if (string-match "^ \\*Minibuf" (buffer-name (window-buffer other-win)))
(error "The window in this direction is the Minibuf"))
(if (eq buffer-move-behavior 'move)
;; switch selected window to previous buffer (moving)
(switch-to-prev-buffer (selected-window))
@ -147,6 +152,20 @@
(interactive)
(buf-move-to 'right))
;;;###autoload
(defun buf-move ()
"Begin moving the current buffer to different windows.
Use the arrow keys to move in the desired direction. Pressing
any other key exits this function."
(interactive)
(let ((map (make-sparse-keymap)))
(dolist (x '(("<up>" . buf-move-up)
("<left>" . buf-move-left)
("<down>" . buf-move-down)
("<right>" . buf-move-right)))
(define-key map (read-kbd-macro (car x)) (cdr x)))
(set-transient-map map t)))
(provide 'buffer-move)
;;; buffer-move.el ends here

View File

@ -1 +0,0 @@
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2015-03-05T11:05:01+0100 using DSA

View File

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

View File

@ -1,5 +0,0 @@
.travis.yml
.gitignore
Makefile
test/
company-tests.el

View File

@ -1,310 +0,0 @@
2015-03-04 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'e085a333867959a1b36015a3ad8e12e5bd6550d9' from company
2015-02-04 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '3e70e12bd942bbd0acac4963b5caca63756ad784' from company
2015-02-02 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'a015fb350abe50d250e3e7a9c3c762397326977f' from company
2015-01-23 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'a4ac0dead8e9cb440c1f8aec9141d6c64bad4933' from company
2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/test/clang-tests.el: Add copyright notice
2015-01-13 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'd12ddaa05f582ecc00e74bc42fd46652153ec7a6' from company
2015-01-13 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'eb0d8d9e687e1364098f9abc6f9281fcbc0d3abd' from company
2014-10-28 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'd3fcbefcf56d2caad172e22f24de95397c635bf2' from company
2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-xcode.el (company-xcode-fetch): Avoid
add-to-list on local var.
* packages/company/company.el (company--window-height)
(company--window-width): Move before first use.
2014-10-15 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '60d4c09c982a1c562a70cd6aa705f47ab3badcfb' from company
2014-09-14 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'fa4ba155a3e22ddc4b8bc33fcbf8cc69ef8f0043' from company
2014-09-13 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '2ef6263c65a109b4d36503e6484fdbf4cb307d0f' from company
2014-08-27 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'f4ffe2b47cf6854ff3bc3ca1717efe1258c01547' from company
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

@ -1,329 +0,0 @@
# History of user-visible changes
## 2015-02-02 (0.8.10)
* New variable `company-lighter-base`.
* Better tracking of the current selection.
* Pressing `M-0`...`M-9` works in the search mode.
* Pressing `<up>` or `<down>` doesn't quit the search mode.
## 2015-01-23 (0.8.9)
* New commands `company-next-page` and `company-previous-page`, remapping
`scroll-up-command` and `scroll-down-command` during completion.
## 2015-01-13 (0.8.8)
* Pressing `M-n` or `M-p` doesn't quit the search mode.
* New command `company-complete-common-or-cycle`. No default binding.
* `company-search-toggle-filtering` replaced `company-search-kill-others`.
* Quitting the search mode resets the filtering.
* Pressing `backspace` in the search mode deletes the character at the end of
the search string.
* `company-semantic` displays function arguments as annotations.
* New user option, `company-bbdb-modes`.
* `company-show-numbers` and `company-complete-number` now use visual numbering
of the candidates, taking into account only the ones currently displayed.
* `company-complete-number` can be bound to keypad numbers directly, with or
without modifiers.
* `company-cmake` expands `<LANG>` and `<CONFIG>` placeholders inside variable
names.
## 2014-10-15 (0.8.6)
* `company-clang` and `company-template-c-like-templatify` support templated
functions and arguments.
* `company-dabbrev` ignores "uninteresting" buffers by default. Depends on the
new user option, `company-dabbrev-ignore-buffers`.
* `company-files` checks directory's last modification time.
* `company-files` supports relative paths and Windows drive letters.
## 2014-08-13 (0.8.4)
* `company-ropemacs` is only used when `ropemacs-mode` is on.
* `company-gtags` is enabled in all `prog-mode` derivatives by default.
* `company-end-of-buffer-workaround` is not used anymore.
* `company-begin-commands` includes some of `cc-mode` commands.
## 2014-08-27 (0.8.3)
* On Emacs 24.4 or newer, tooltip positioning takes line-spacing into account.
* New face `company-tooltip-search`, used for the search string in the tooltip.
* The default value of `company-dabbrev-minimum-length` is set to 4, independent
of the `company-minimum-prefix-length` value.
## 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

@ -1,4 +0,0 @@
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

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

View File

@ -1,69 +0,0 @@
;;; 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

@ -1,72 +0,0 @@
;;; company-ropemacs.el --- company-mode completion back-end for ropemacs
;; 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 '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. Requires `ropemacs-mode' to be on."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ropemacs))
(prefix (and (bound-and-true-p ropemacs-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

@ -1,28 +0,0 @@
;;; all-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(defvar company-test-path
(file-name-directory (or load-file-name buffer-file-name)))
(require 'ert)
(dolist (test-file (directory-files company-test-path t "-tests.el$"))
(load test-file nil t))

View File

@ -1,217 +0,0 @@
;;; async-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(defun company-async-backend (command &optional _)
(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 _)
(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 _)
(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")))))))
(ert-deftest company-multi-backend-merges-deferred-candidates-2 ()
(with-temp-buffer
(let ((company-backend (list (lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("a" "b")))))))
(lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("c" "d")))))))
(lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("e" "f"))))))))))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal '("a" "b" "c" "d" "e" "f")
(company-call-backend 'candidates "foo"))))))
(ert-deftest company-multi-backend-merges-deferred-candidates-3 ()
(with-temp-buffer
(let ((company-backend (list (lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("a" "b")))))))
(lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda ()
(funcall cb '("c" "d")))))))))
(lambda (command &optional _)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda ()
(funcall cb '("e" "f"))))))))))))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal '("a" "b" "c" "d" "e" "f")
(company-call-backend 'candidates "foo"))))))

View File

@ -1,46 +0,0 @@
;;; clang-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(require 'company-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))))))
(ert-deftest company-clang-simple-annotation ()
(let ((str (propertize
"foo" 'meta
"wchar_t * wmemchr(wchar_t *__p, wchar_t __c, size_t __n)")))
(should (equal (company-clang 'annotation str)
"(wchar_t *__p, wchar_t __c, size_t __n)"))))
(ert-deftest company-clang-generic-annotation ()
(let ((str (propertize
"foo" 'meta
"shared_ptr<_Tp> make_shared<typename _Tp>(_Args &&__args...)")))
(should (equal (company-clang 'annotation str)
"<typename _Tp>(_Args &&__args...)"))))

View File

@ -1,481 +0,0 @@
;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(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 _)
(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-common-with-non-prefix-completion ()
(let ((company-backend #'ignore)
(company-prefix "abc")
company-candidates
company-candidates-length
company-candidates-cache
company-common)
(company-update-candidates '("abc" "def-abc"))
(should (null company-common))
(company-update-candidates '("abc" "abe-c"))
(should (null company-common))
(company-update-candidates '("abcd" "abcde" "abcdf"))
(should (equal "abcd" company-common))))
(ert-deftest company-multi-backend-with-lambdas ()
(let ((company-backend
(list (lambda (command &optional _ &rest _r)
(cl-case command
(prefix "z")
(candidates '("a" "b"))))
(lambda (command &optional _ &rest _r)
(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 _ &rest _r)
(cl-case command
(prefix (cons "z" t))
(candidates '("a" "b"))))
(lambda (command &optional _ &rest _r)
(cl-case command
(prefix "t")
(candidates '("c" "d"))))
(lambda (command &optional _ &rest _r)
(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 _)
(cl-case command
(ignore-case nil)
(annotation "1")
(candidates '("a" "c"))
(post-completion "13")))
(lambda (command &optional _)
(cl-case command
(ignore-case t)
(annotation "2")
(candidates '("b" "d"))
(post-completion "42")))
(lambda (command &optional _)
(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 _)
(cl-case command
(prefix "a")
(candidates '("abb" "abc" "abd")))))
(secundo (lambda (command &optional _)
(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 #'ignore))
(let (company-frontends
(company-backends
(list (lambda (command &optional _)
(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 _)
(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 _)
(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-was-a-match-and-old-prefix-ended ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-auto-complete
(company-require-match t)
(company-backends
(list (lambda (command &optional _)
(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-dont-require-match-if-was-a-match-and-new-prefix-is-stop ()
(with-temp-buffer
(company-mode)
(insert "c")
(let (company-frontends
(company-require-match t)
(company-backends
(list (lambda (command &optional _)
(cl-case command
(prefix (if (> (point) 2)
'stop
(buffer-substring (point-min) (point))))
(candidates '("a" "b" "c")))))))
(let (this-command)
(company-complete))
(should (eq 3 company-candidates-length))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (not company-candidates)))))
(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 _)
(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 _)
(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 _)
(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 _)
(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-backends
(list (lambda (command &optional _)
(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 _)
(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-backends
(list (lambda (command &optional _)
(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))))))
(defvar ct-sorted nil)
(defun ct-equal-including-properties (list1 list2)
(or (and (not list1) (not list2))
(and (ert-equal-including-properties (car list1) (car list2))
(ct-equal-including-properties (cdr list1) (cdr list2)))))
(ert-deftest company-strips-duplicates-within-groups ()
(let* ((kvs '(("a" . "b")
("a" . nil)
("a" . "b")
("a" . "c")
("a" . "b")
("b" . "c")
("b" . nil)
("a" . "b")))
(fn (lambda (kvs)
(mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
kvs)))
(company-backend
(lambda (command &optional arg)
(pcase command
(`prefix "")
(`sorted ct-sorted)
(`duplicates t)
(`annotation (get-text-property 0 'ann arg)))))
(reference '(("a" . "b")
("a" . nil)
("a" . "c")
("b" . "c")
("b" . nil)
("a" . "b"))))
(let ((ct-sorted t))
(should (ct-equal-including-properties
(company--preprocess-candidates (funcall fn kvs))
(funcall fn reference))))
(should (ct-equal-including-properties
(company--preprocess-candidates (funcall fn kvs))
(funcall fn (butlast reference))))))
;;; Row and column
(ert-deftest company-column-with-composition ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "lambda ()")
(compose-region 1 (1+ (length "lambda")) "\\")
(should (= (company--column) 4)))))
(ert-deftest company-column-with-line-prefix ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo")
(put-text-property (point-min) (point) 'line-prefix " ")
(should (= (company--column) 5)))))
(ert-deftest company-column-with-line-prefix-on-empty-line ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "\n")
(forward-char -1)
(put-text-property (point-min) (point-max) 'line-prefix " ")
(should (= (company--column) 2)))))
(ert-deftest company-column-with-tabs ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "|\t|\t|\t(")
(let ((tab-width 8))
(should (= (company--column) 25))))))
(ert-deftest company-row-with-header-line-format ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(should (= (company--row) 0))
(setq header-line-format "aaaaaaa")
(should (= (company--row) 0)))))

View File

@ -1,190 +0,0 @@
;;; elisp-tests.el --- company-elisp tests
;; Copyright (C) 2013-2015 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/>.
;;; Code:
(require 'company-tests)
(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

@ -1,332 +0,0 @@
;;; frontends-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(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 _)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
(should (eq 1 (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-display)
"\n 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)
(str (overlay-get ov 'after-string)))
(should (string= str "123"))
(should (eq (get-text-property 0 'cursor str) 1)))))))
(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-display)
"\n 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-display)
"\n 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-create-lines-truncates-common-part ()
(let* ((ww (company--window-width))
(company-candidates-length 2)
(company-tooltip-margin 1)
(company-backend #'ignore))
(let* ((company-common (make-string (- ww 3) ?1))
(company-candidates `(,(concat company-common "2")
,(concat company-common "3"))))
(should (equal (list (format " %s2 " (make-string (- ww 3) ?1))
(format " %s3 " (make-string (- ww 3) ?1)))
(company--create-lines 0 999))))
(let* ((company-common (make-string (- ww 2) ?1))
(company-candidates `(,(concat company-common "2")
,(concat company-common "3"))))
(should (equal (list (format " %s " company-common)
(format " %s " company-common))
(company--create-lines 0 999))))
(let* ((company-common (make-string ww ?1))
(company-candidates `(,(concat company-common "2")
,(concat company-common "3")))
(res (company--create-lines 0 999)))
(should (equal (list (format " %s " (make-string (- ww 2) ?1))
(format " %s " (make-string (- ww 2) ?1)))
res))
(should (eq 'company-tooltip-common-selection
(get-text-property (- ww 2) 'face
(car res))))
(should (eq 'company-tooltip-selection
(get-text-property (1- ww) 'face
(car res))))
)))
(ert-deftest company-create-lines-clears-out-non-printables ()
:tags '(interactive)
(let (company-show-numbers
(company-candidates (list
(decode-coding-string "avalis\351e" 'utf-8)
"avatar"))
(company-candidates-length 2)
(company-backend 'ignore))
(should (equal '(" avalis‗e "
" avatar ")
(company--create-lines 0 999)))))
(ert-deftest company-create-lines-handles-multiple-width ()
:tags '(interactive)
(let (company-show-numbers
(company-candidates '("蛙蛙蛙蛙" "蛙abc"))
(company-candidates-length 2)
(company-backend 'ignore))
(should (equal '(" 蛙蛙蛙蛙 "
" 蛙abc ")
(company--create-lines 0 999)))))
(ert-deftest company-create-lines-handles-multiple-width-in-annotation ()
(let* (company-show-numbers
(alist '(("a" . "") ("b" . " ︸︸")))
(company-candidates (mapcar #'car alist))
(company-candidates-length 2)
(company-backend (lambda (c &optional a)
(when (eq c 'annotation)
(assoc-default a alist)))))
(should (equal '(" a ︸ "
" b ︸︸ ")
(company--create-lines 0 999)))))
(ert-deftest company-create-lines-with-multiple-width-and-keep-prefix ()
:tags '(interactive)
(let* (company-show-numbers
(company-candidates '("MIRAI発売1カ月"
"MIRAI発売2カ月"))
(company-candidates-length 2)
(company-prefix "MIRAI発")
(company-backend (lambda (c &optional _arg)
(pcase c
(`ignore-case 'keep-prefix)))))
(should (equal '(" MIRAI売1"
" MIRAI売2")
(company--create-lines 0 999)))))
(ert-deftest company-fill-propertize-truncates-search-highlight ()
(let ((company-search-string "foo")
(company-backend #'ignore)
(company-prefix ""))
(should (equal-including-properties
(company-fill-propertize "barfoo" nil 6 t nil nil)
#("barfoo"
0 3 (face company-tooltip mouse-face company-tooltip-mouse)
3 6 (face company-tooltip-search mouse-face company-tooltip-mouse))))
(should (equal-including-properties
(company-fill-propertize "barfoo" nil 5 t "" " ")
#("barfo "
0 3 (face company-tooltip mouse-face company-tooltip-mouse)
3 5 (face company-tooltip-search mouse-face company-tooltip-mouse)
5 6 (face company-tooltip mouse-face company-tooltip-mouse))))
(should (equal-including-properties
(company-fill-propertize "barfoo" nil 3 t " " " ")
#(" bar "
0 5 (face company-tooltip mouse-face company-tooltip-mouse))))))
(ert-deftest company-column-with-composition ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "lambda ()")
(compose-region 1 (1+ (length "lambda")) "\\")
(should (= (company--column) 4)))))
(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-buffer-lines-with-lines-folded ()
:tags '(interactive)
(with-temp-buffer
(insert (propertize "aaa\nbbb\nccc\nddd\n" 'display "aaa+\n"))
(insert "eee\nfff\nggg")
(should (equal (company-buffer-lines (point-min) (point-max))
'("aaa" "eee" "fff" "ggg")))))
(ert-deftest company-buffer-lines-with-multiline-display ()
:tags '(interactive)
(with-temp-buffer
(insert (propertize "a" 'display "bbb\nccc\ndddd\n"))
(insert "eee\nfff\nggg")
(should (equal (company-buffer-lines (point-min) (point-max))
'("" "" "" "eee" "fff" "ggg")))))
(ert-deftest company-buffer-lines-with-multiline-after-string-at-eob ()
:tags '(interactive)
(with-temp-buffer
(insert "a\nb\nc\n")
(let ((ov (make-overlay (point-max) (point-max) nil t t)))
(overlay-put ov 'after-string "~\n~\n~"))
(should (equal (company-buffer-lines (point-min) (point-max))
'("a" "b" "c")))))
(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))))

View File

@ -1,32 +0,0 @@
;;; keywords-tests.el --- company-keywords tests -*- lexical-binding: t -*-
;; Copyright (C) 2011, 2013-2015 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/>.
(require 'company-keywords)
(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))))))

View File

@ -1,91 +0,0 @@
;;; template-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(require 'company-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 (_ 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))))))
(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")))))
(ert-deftest company-template-c-like-templatify-generics ()
(with-temp-buffer
(let ((text "foo<TKey, TValue>(int i, Dict<TKey, TValue>, long l)"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo<arg0, arg1>(arg2, arg3, arg4)" (buffer-string)))
(should (looking-at "arg0"))
(should (equal "TKey" (overlay-get (company-template-field-at) 'display)))
(search-forward "arg3")
(forward-char -1)
(should (equal "Dict<TKey, TValue>"
(overlay-get (company-template-field-at) 'display))))))

View File

@ -1,58 +0,0 @@
;;; transformers-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2015 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/>.
(require 'company-tests)
(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"))))))))

View File

@ -1,6 +1,6 @@
;;; company-abbrev.el --- company-mode completion back-end for abbrev
;;; company-abbrev.el --- company-mode completion backend for abbrev
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -35,7 +35,7 @@
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
"`company-mode' completion back-end for abbrev."
"`company-mode' completion backend for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
@ -44,8 +44,7 @@
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
(meta (abbrev-expansion arg))
(require-match t)))
(meta (abbrev-expansion arg))))
(provide 'company-abbrev)
;;; company-abbrev.el ends here

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "company" "company.el" (21831 16638 858187
;;;;;; 859000))
;;;### (autoloads nil "company" "company.el" (22297 19838 628699
;;;;;; 424000))
;;; Generated autoloads from company.el
(autoload 'company-mode "company" "\
@ -22,9 +22,12 @@ Completions can be searched with `company-search-candidates' or
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
using `company-frontends'. If you want to start a specific backend, call
it interactively or use `company-begin-backend'.
By default, the completions list is sorted alphabetically, unless the
backend chooses otherwise, or `company-transformers' changes it later.
regular keymap (`company-mode-map'):
\\{company-mode-map}
@ -55,93 +58,106 @@ See `company-mode' for more information on Company mode.
\(fn &optional ARG)" t nil)
(autoload 'company-manual-begin "company" "\
\(fn)" t nil)
(autoload 'company-complete "company" "\
Insert the common part of all candidates or the current selection.
The first time this is called, the common part is inserted, the second
time, or when the selection has been changed, the selected candidate is
inserted.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (21831
;;;;;; 16638 696187 870000))
;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (22297
;;;;;; 19840 603664 101000))
;;; Generated autoloads from company-abbrev.el
(autoload 'company-abbrev "company-abbrev" "\
`company-mode' completion back-end for abbrev.
`company-mode' completion backend for abbrev.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (21831 16638
;;;;;; 863187 858000))
;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (22297 19840
;;;;;; 163671 971000))
;;; Generated autoloads from company-bbdb.el
(autoload 'company-bbdb "company-bbdb" "\
`company-mode' completion back-end for BBDB.
`company-mode' completion backend for BBDB.
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
;;;***
;;;### (autoloads nil "company-css" "company-css.el" (21831 16638
;;;;;; 709187 869000))
;;;### (autoloads nil "company-css" "company-css.el" (22297 19838
;;;;;; 501701 694000))
;;; Generated autoloads from company-css.el
(autoload 'company-css "company-css" "\
`company-mode' completion back-end for `css-mode'.
`company-mode' completion backend for `css-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (21831
;;;;;; 16638 718187 869000))
;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (22297
;;;;;; 19839 391685 775000))
;;; Generated autoloads from company-dabbrev.el
(autoload 'company-dabbrev "company-dabbrev" "\
dabbrev-like `company-mode' completion back-end.
dabbrev-like `company-mode' completion backend.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el"
;;;;;; (21831 16638 894187 856000))
;;;;;; (22297 19839 228688 691000))
;;; 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
dabbrev-like `company-mode' backend for code.
The backend looks for all symbols in the current buffer that aren't in
comments or strings.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-elisp" "company-elisp.el" (21831 16638
;;;;;; 736187 867000))
;;;### (autoloads nil "company-elisp" "company-elisp.el" (22297 19840
;;;;;; 862659 468000))
;;; Generated autoloads from company-elisp.el
(autoload 'company-elisp "company-elisp" "\
`company-mode' completion back-end for Emacs Lisp.
`company-mode' completion backend for Emacs Lisp.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-etags" "company-etags.el" (21831 16638
;;;;;; 649187 873000))
;;;### (autoloads nil "company-etags" "company-etags.el" (22297 19838
;;;;;; 926694 94000))
;;; Generated autoloads from company-etags.el
(autoload 'company-etags "company-etags" "\
`company-mode' completion back-end for etags.
`company-mode' completion backend for etags.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-files" "company-files.el" (21831 16638
;;;;;; 745187 867000))
;;;### (autoloads nil "company-files" "company-files.el" (22297 19839
;;;;;; 535683 204000))
;;; Generated autoloads from company-files.el
(autoload 'company-files "company-files" "\
`company-mode' completion back-end existing file names.
`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings.
@ -149,118 +165,106 @@ File paths with spaces are only supported inside strings.
;;;***
;;;### (autoloads nil "company-gtags" "company-gtags.el" (21831 16638
;;;;;; 899187 856000))
;;;### (autoloads nil "company-gtags" "company-gtags.el" (22297 19837
;;;;;; 942711 689000))
;;; Generated autoloads from company-gtags.el
(autoload 'company-gtags "company-gtags" "\
`company-mode' completion back-end for GNU Global.
`company-mode' completion backend for GNU Global.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-ispell" "company-ispell.el" (21831
;;;;;; 16638 631187 875000))
;;;### (autoloads nil "company-ispell" "company-ispell.el" (22297
;;;;;; 19840 704662 296000))
;;; Generated autoloads from company-ispell.el
(autoload 'company-ispell "company-ispell" "\
`company-mode' completion back-end using Ispell.
`company-mode' completion backend using Ispell.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-keywords" "company-keywords.el" (21831
;;;;;; 16638 658187 873000))
;;;### (autoloads nil "company-keywords" "company-keywords.el" (22297
;;;;;; 19839 758679 212000))
;;; Generated autoloads from company-keywords.el
(autoload 'company-keywords "company-keywords" "\
`company-mode' back-end for programming language keywords.
`company-mode' backend for programming language keywords.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-nxml" "company-nxml.el" (21831 16638
;;;;;; 667187 872000))
;;;### (autoloads nil "company-nxml" "company-nxml.el" (22297 19840
;;;;;; 287669 753000))
;;; Generated autoloads from company-nxml.el
(autoload 'company-nxml "company-nxml" "\
`company-mode' completion back-end for `nxml-mode'.
`company-mode' completion backend for `nxml-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (21831
;;;;;; 16638 755187 866000))
;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (22297
;;;;;; 19838 346704 465000))
;;; Generated autoloads from company-oddmuse.el
(autoload 'company-oddmuse "company-oddmuse" "\
`company-mode' completion back-end for `oddmuse-mode'.
`company-mode' completion backend for `oddmuse-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-pysmell" "company-pysmell.el" (21831
;;;;;; 16638 848187 859000))
;;; 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 nil "company-semantic" "company-semantic.el" (21831
;;;;;; 16638 936187 853000))
;;;### (autoloads nil "company-semantic" "company-semantic.el" (22297
;;;;;; 19838 125708 417000))
;;; Generated autoloads from company-semantic.el
(autoload 'company-semantic "company-semantic" "\
`company-mode' completion back-end using CEDET Semantic.
`company-mode' completion backend using CEDET Semantic.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-tempo" "company-tempo.el" (21831 16638
;;;;;; 874187 858000))
;;;### (autoloads nil "company-tempo" "company-tempo.el" (22297 19839
;;;;;; 349686 528000))
;;; Generated autoloads from company-tempo.el
(autoload 'company-tempo "company-tempo" "\
`company-mode' completion back-end for tempo.
`company-mode' completion backend for tempo.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-xcode" "company-xcode.el" (21831 16638
;;;;;; 885187 857000))
;;;### (autoloads nil "company-xcode" "company-xcode.el" (22297 19840
;;;;;; 505665 854000))
;;; Generated autoloads from company-xcode.el
(autoload 'company-xcode "company-xcode" "\
`company-mode' completion back-end for Xcode projects.
`company-mode' completion backend for Xcode projects.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el"
;;;;;; (21831 16638 920187 854000))
;;;;;; (22297 19840 373668 214000))
;;; Generated autoloads from company-yasnippet.el
(autoload 'company-yasnippet "company-yasnippet" "\
`company-mode' back-end for `yasnippet'.
`company-mode' backend 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:
This backend should be used with care, because as long as there are
snippets defined for the current major mode, this backend will always
shadow backends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end or
* In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
@ -268,7 +272,7 @@ shadow back-ends that come after it. Recommended usages:
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other back-ends.
* After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
@ -281,8 +285,8 @@ shadow back-ends that come after it. Recommended usages:
;;;***
;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el"
;;;;;; "company-eclim.el" "company-pkg.el" "company-ropemacs.el"
;;;;;; "company-template.el") (21831 16638 948260 900000))
;;;;;; "company-eclim.el" "company-pkg.el" "company-template.el")
;;;;;; (22297 19841 194698 166000))
;;;***

View File

@ -1,6 +1,6 @@
;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode
;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
@ -28,7 +28,7 @@
(declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
"Completion back-end for BBDB."
"Completion backend for BBDB."
:group 'company)
(defcustom company-bbdb-modes '(message-mode)
@ -44,13 +44,13 @@
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion back-end for BBDB."
"`company-mode' completion backend for BBDB."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (memq major-mode company-bbdb-modes)
(featurep 'bbdb-com)
(looking-back "^\\(To\\|Cc\\|Bcc\\): *\\(.*\\)"
(looking-back "^\\(To\\|Cc\\|Bcc\\): *.*?\\([^,; ]*\\)"
(line-beginning-position))
(match-string-no-properties 2)))
(candidates (company-bbdb--candidates arg))

View File

@ -1,6 +1,6 @@
;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
@ -48,22 +48,36 @@
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions)))
(completion-at-point-functions (company--capf-workaround))
(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)))
(when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
(declare-function python-shell-get-process "python")
(defun company--capf-workaround ()
;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
(if (or (not (listp completion-at-point-functions))
(not (memq 'python-completion-complete-at-point completion-at-point-functions))
(python-shell-get-process))
completion-at-point-functions
(remq 'python-completion-complete-at-point completion-at-point-functions)))
(defun company-capf (command &optional arg &rest _args)
"`company-mode' back-end using `completion-at-point-functions'."
"`company-mode' backend 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))))))
(let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
(prefix (buffer-substring-no-properties (nth 1 res) (point))))
(cond
((> (nth 2 res) (point)) 'stop)
(length (cons prefix length))
(t prefix))))))
(`candidates
(let ((res (company--capf-data)))
(when res
@ -95,16 +109,16 @@
(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)
(let ((start (if (get-text-property 0 'face arg)
0
(next-single-property-change 0 'font-lock-face arg))))
(next-single-property-change 0 '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)))
(let ((value (get-text-property start 'face arg)))
(text-property-not-all start (length arg)
'font-lock-face value arg))
'face value arg))
(length arg)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle

View File

@ -1,6 +1,6 @@
;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*-
;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -30,7 +30,7 @@
(require 'cl-lib)
(defgroup company-clang nil
"Completion back-end for Clang."
"Completion backend for Clang."
:group 'company)
(defcustom company-clang-executable
@ -144,6 +144,18 @@ or automatically through a custom `company-clang-prefix-guesser'."
(get-text-property 0 'meta candidate))
(defun company-clang--annotation (candidate)
(let ((ann (company-clang--annotation-1 candidate)))
(if (not (and ann (string-prefix-p "(*)" ann)))
ann
(with-temp-buffer
(insert ann)
(search-backward ")")
(let ((pt (1+ (point))))
(re-search-forward ".\\_>" nil t)
(delete-region pt (point)))
(buffer-string)))))
(defun company-clang--annotation-1 (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
@ -191,9 +203,11 @@ or automatically through a custom `company-clang-prefix-guesser'."
(buf (get-buffer-create "*clang-output*"))
;; Looks unnecessary in Emacs 25.1 and later.
(process-adaptive-read-buffering nil))
(with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf)
(funcall callback nil)
(with-current-buffer buf
(erase-buffer)
(setq buffer-undo-list t))
(let ((process (apply #'start-process "company-clang" buf
company-clang-executable args)))
(set-process-sentinel
@ -275,26 +289,8 @@ or automatically through a custom `company-clang-prefix-guesser'."
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.
"`company-mode' completion backend 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
@ -327,7 +323,7 @@ passed via standard input."
(when (and company-clang-insert-arguments anno)
(insert anno)
(if (string-match "\\`:[^:]" anno)
(company-clang-objc-templatify anno)
(company-template-objc-templatify anno)
(company-template-c-like-templatify
(concat arg anno))))))))

View File

@ -1,4 +1,4 @@
;;; company-cmake.el --- company-mode completion back-end for CMake
;;; company-cmake.el --- company-mode completion backend for CMake
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-cmake nil
"Completion back-end for CMake."
"Completion backend for CMake."
:group 'company)
(defcustom company-cmake-executable
@ -178,7 +178,7 @@ They affect which types of symbols we get completion candidates for.")
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
"`company-mode' completion back-end for CMake.
"`company-mode' completion backend for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command

View File

@ -1,4 +1,4 @@
;;; company-css.el --- company-mode completion back-end for css-mode -*- lexical-binding: t -*-
;;; company-css.el --- company-mode completion backend for css-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
@ -26,6 +26,8 @@
(require 'company)
(require 'cl-lib)
(declare-function web-mode-language-at-pos "web-mode" (&optional pos))
(defconst company-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
@ -411,11 +413,13 @@ Returns \"\" if no property found, but feasible at this position."
;;;###autoload
(defun company-css (command &optional arg &rest ignored)
"`company-mode' completion back-end for `css-mode'."
"`company-mode' completion backend for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
(prefix (and (derived-mode-p 'css-mode)
(prefix (and (or (derived-mode-p 'css-mode)
(and (derived-mode-p 'web-mode)
(string= (web-mode-language-at-pos) "css")))
(or (company-grab company-css-tag-regexp 1)
(company-grab company-css-pseudo-regexp 1)
(company-grab company-css-property-value-regexp 2)

View File

@ -1,4 +1,4 @@
;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end for code -*- lexical-binding: t -*-
;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
@ -30,7 +30,7 @@
(require 'cl-lib)
(defgroup company-dabbrev-code nil
"dabbrev-like completion back-end for code."
"dabbrev-like completion backend for code."
:group 'company)
(defcustom company-dabbrev-code-modes
@ -40,10 +40,10 @@
"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
`company-dabbrev-code' will pass control to other backends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
:type '(choice (repeat (symbol :tag "Major mode"))
(const tag "All modes" t)))
:type '(choice (repeat :tag "Some modes" (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.
@ -69,7 +69,7 @@ also `company-dabbrev-code-time-limit'."
"Non-nil to ignore case when collecting completion candidates."
:type 'boolean)
(defsubst company-dabbrev-code--make-regexp (prefix)
(defun company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
@ -77,8 +77,8 @@ also `company-dabbrev-code-time-limit'."
;;;###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
"dabbrev-like `company-mode' backend for code.
The backend looks for all symbols in the current buffer that aren't in
comments or strings."
(interactive (list 'interactive))
(cl-case command

View File

@ -1,6 +1,6 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*- lexical-binding: t -*-
;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-dabbrev nil
"dabbrev-like completion back-end."
"dabbrev-like completion backend."
:group 'company)
(defcustom company-dabbrev-other-buffers 'all
@ -74,46 +74,60 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
:type 'integer
:package-version '(company . "0.8.3"))
(defmacro company-dabrev--time-limit-while (test start limit &rest body)
(defcustom company-dabbrev-ignore-invisible nil
"Non-nil to skip invisible text."
:type 'boolean
:package-version '(company . "0.9.0"))
(defmacro company-dabrev--time-limit-while (test start limit freq &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)
(= (cl-incf company-time-limit-while-counter) ,freq)
(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--make-regexp ()
(concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
(let (match)
(cl-labels ((maybe-collect-match
()
(let ((match (match-string-no-properties 0)))
(when (and (>= (length match) company-dabbrev-minimum-length)
(not (and company-dabbrev-ignore-invisible
(invisible-p (match-beginning 0)))))
(push match symbols)))))
(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))
(goto-char (nth 8 (syntax-ppss)))
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
;; Search before pos.
(let ((tmp-end (point)))
(company-dabrev--time-limit-while (> tmp-end (point-min))
start limit 1
(ignore-errors
(forward-char -10000))
(forward-line 0)
(save-excursion
;; Before, we used backward search, but it matches non-greedily, and
;; that forced us to use the "beginning/end of word" anchors in
;; `company-dabbrev--make-regexp'. It's also about 2x slower.
(while (re-search-forward regexp tmp-end t)
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
(maybe-collect-match))))
(setq tmp-end (point))))
(goto-char (or pos (point-min)))
;; search after pos
;; 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))
start limit 25
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
(maybe-collect-match)))
symbols)))
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
@ -136,16 +150,28 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(cl-return))))
symbols))
(defun company-dabbrev--prefix ()
;; Not in the middle of a word.
(unless (looking-at company-dabbrev-char-regexp)
;; Emacs can't do greedy backward-search.
(company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
company-dabbrev-char-regexp)
1)))
(defun company-dabbrev--filter (prefix candidates)
(let ((completion-ignore-case company-dabbrev-ignore-case))
(all-completions prefix candidates)))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
"dabbrev-like `company-mode' completion back-end."
"dabbrev-like `company-mode' completion backend."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-grab-word))
(prefix (company-dabbrev--prefix))
(candidates
(let* ((case-fold-search company-dabbrev-ignore-case)
(words (company-dabbrev--search (company-dabbrev--make-regexp arg)
(words (company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
@ -153,6 +179,7 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
(setq words (company-dabbrev--filter arg words))
(if downcase-p
(mapcar 'downcase words)
words)))

View File

@ -1,6 +1,6 @@
;;; company-eclim.el --- company-mode completion back-end for Eclim
;;; company-eclim.el --- company-mode completion backend for Eclim
;; Copyright (C) 2009, 2011, 2013 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -21,10 +21,10 @@
;;; Commentary:
;;
;; Using `emacs-eclim' together with (or instead of) this back-end is
;; Using `emacs-eclim' together with (or instead of) this backend is
;; recommended, as it allows you to use other Eclim features.
;;
;; The alternative back-end provided by `emacs-eclim' uses `yasnippet'
;; The alternative backend provided by `emacs-eclim' uses `yasnippet'
;; instead of `company-template' to expand function calls, and it supports
;; some languages other than Java.
@ -35,7 +35,7 @@
(require 'cl-lib)
(defgroup company-eclim nil
"Completion back-end for Eclim."
"Completion backend for Eclim."
:group 'company)
(defun company-eclim-executable-find ()
@ -48,7 +48,9 @@
(cl-return file)))))
(defcustom company-eclim-executable
(or (executable-find "eclim") (company-eclim-executable-find))
(or (bound-and-true-p eclim-executable)
(executable-find "eclim")
(company-eclim-executable-find))
"Location of eclim executable."
:type 'file)
@ -153,7 +155,7 @@ eclim can only complete correctly when the buffer has been saved."
prefix)))
(defun company-eclim (command &optional arg &rest ignored)
"`company-mode' completion back-end for Eclim.
"`company-mode' completion backend for Eclim.
Eclim provides access to Eclipse Java IDE features for other editors.
Eclim version 1.7.13 or newer (?) is required.

View File

@ -1,4 +1,4 @@
;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*- lexical-binding: t -*-
;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
@ -31,7 +31,7 @@
(require 'find-func)
(defgroup company-elisp nil
"Completion back-end for Emacs Lisp."
"Completion backend for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
@ -193,7 +193,7 @@ first in the candidates list."
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
"`company-mode' completion back-end for Emacs Lisp."
"`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))

View File

@ -1,4 +1,4 @@
;;; company-etags.el --- company-mode completion back-end for etags
;;; company-etags.el --- company-mode completion backend for etags
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@ -30,7 +30,7 @@
(require 'etags)
(defgroup company-etags nil
"Completion back-end for etags."
"Completion backend for etags."
:group 'company)
(defcustom company-etags-use-main-table-list t
@ -45,17 +45,28 @@ buffer automatically."
:type 'boolean
:package-version '(company . "0.7.3"))
(defcustom company-etags-everywhere nil
"Non-nil to offer completions in comments and strings.
Set it to t or to a list of major modes."
:type '(choice (const :tag "Off" nil)
(const :tag "Any supported mode" t)
(repeat :tag "Some major modes"
(symbol :tag "Major mode")))
:package-version '(company . "0.9.0"))
(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")))
(let ((file (expand-file-name
"TAGS"
(locate-dominating-file (or buffer-file-name
default-directory)
"TAGS"))))
(when (and file (file-regular-p file))
(list (expand-file-name file)))))
(list file))))
(defun company-etags-buffer-table ()
(or (and company-etags-use-main-table-list tags-table-list)
@ -74,12 +85,14 @@ buffer automatically."
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
"`company-mode' completion back-end for etags."
"`company-mode' completion backend 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))
(prefix (and (apply #'derived-mode-p company-etags-modes)
(or (eq t company-etags-everywhere)
(apply #'derived-mode-p company-etags-everywhere)
(not (company-in-string-or-comment)))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))

View File

@ -1,6 +1,6 @@
;;; company-files.el --- company-mode completion back-end for file paths
;;; company-files.el --- company-mode completion backend for file paths
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -30,9 +30,12 @@
(defun company-files--directory-files (dir prefix)
(ignore-errors
(if (equal prefix "")
(directory-files dir nil "\\`[^.]\\|\\`.[^.]")
(file-name-all-completions prefix dir))))
;; Don't use directory-files. It produces directories without trailing /.
(let ((comp (sort (file-name-all-completions prefix dir)
(lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
(if (equal prefix "")
(delete "../" (delete "./" comp))
comp))))
(defvar company-files--regexps
(let* ((root (if (eq system-type 'windows-nt)
@ -50,35 +53,47 @@
(and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
(company-files--connected-p 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)))
(defun company-files--connected-p (file)
(or (not (file-remote-p file))
(file-remote-p file nil t)))
(defun company-files--trailing-slash-p (file)
;; `file-directory-p' is very expensive on remotes. We are relying on
;; `file-name-all-completions' returning directories with trailing / instead.
(let ((len (length file)))
(and (> len 0) (eq (aref file (1- len)) ?/))))
(defvar company-files--completion-cache nil)
(defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
(key (list (file-name-nondirectory prefix)
(file (file-name-nondirectory prefix))
(key (list file
(expand-file-name dir)
(nth 5 (file-attributes dir))))
(file (file-name-nondirectory prefix))
(completion-ignore-case read-file-name-completion-ignore-case)
candidates directories)
(completion-ignore-case read-file-name-completion-ignore-case))
(unless (company-file--keys-match-p key (car company-files--completion-cache))
(dolist (file (company-files--directory-files dir file))
(setq file (concat dir file))
(push file candidates)
(when (file-directory-p file)
(push file directories)))
(dolist (directory (reverse directories))
;; Add one level of children.
(dolist (child (company-files--directory-files directory ""))
(push (concat directory
(unless (eq (aref directory (1- (length directory))) ?/) "/")
child) candidates)))
(setq company-files--completion-cache (cons key (nreverse candidates))))
(let* ((candidates (mapcar (lambda (f) (concat dir f))
(company-files--directory-files dir file)))
(directories (unless (file-remote-p dir)
(cl-remove-if-not (lambda (f)
(and (company-files--trailing-slash-p f)
(not (file-remote-p f))
(company-files--connected-p f)))
candidates)))
(children (and directories
(cl-mapcan (lambda (d)
(mapcar (lambda (c) (concat d c))
(company-files--directory-files d "")))
directories))))
(setq company-files--completion-cache
(cons key (append candidates children)))))
(all-completions prefix
(cdr company-files--completion-cache))))
@ -88,7 +103,7 @@
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
"`company-mode' completion back-end existing file names.
"`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
@ -98,6 +113,8 @@ File paths with spaces are only supported inside strings."
(candidates (company-files--complete arg))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
(post-completion (when (company-files--trailing-slash-p arg)
(delete-char -1)))
(sorted t)
(no-cache t)))

View File

@ -1,4 +1,4 @@
;;; company-gtags.el --- company-mode completion back-end for GNU Global
;;; company-gtags.el --- company-mode completion backend for GNU Global
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@ -26,10 +26,11 @@
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-gtags nil
"Completion back-end for GNU Global."
"Completion backend for GNU Global."
:group 'company)
(defcustom company-gtags-executable
@ -90,7 +91,7 @@ completion."
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
"`company-mode' completion back-end for GNU Global."
"`company-mode' completion backend for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))

View File

@ -1,6 +1,6 @@
;;; company-ispell.el --- company-mode completion back-end using Ispell
;;; company-ispell.el --- company-mode completion backend using Ispell
;; Copyright (C) 2009-2011, 2013-2015 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -30,7 +30,7 @@
(require 'ispell)
(defgroup company-ispell nil
"Completion back-end using Ispell."
"Completion backend using Ispell."
:group 'company)
(defcustom company-ispell-dictionary nil
@ -41,11 +41,16 @@ If nil, use `ispell-complete-word-dict'."
(defvar company-ispell-available 'unknown)
(defalias 'company-ispell--lookup-words
(if (fboundp 'ispell-lookup-words)
'ispell-lookup-words
'lookup-words))
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
(lookup-words "WHATEVER")
(company-ispell--lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company: ispell-look-command not found")
@ -54,15 +59,16 @@ If nil, use `ispell-complete-word-dict'."
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
"`company-mode' completion back-end using Ispell."
"`company-mode' completion backend using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates
(let ((words (lookup-words arg (or company-ispell-dictionary
ispell-complete-word-dict)))
(let ((words (company-ispell--lookup-words
arg
(or company-ispell-dictionary ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
;; Small optimization.

View File

@ -1,6 +1,6 @@
;;; company-keywords.el --- A company back-end for programming language keywords
;;; company-keywords.el --- A company backend for programming language keywords
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -35,13 +35,16 @@
(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"
"alignas" "alignof" "asm" "auto" "bool" "break" "case" "catch" "char"
"char16_t" "char32_t" "class" "const" "const_cast" "constexpr" "continue"
"decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum"
"explicit" "export" "extern" "false" "final" "float" "for" "friend"
"goto" "if" "inline" "int" "long" "mutable" "namespace" "new" "noexcept"
"nullptr" "operator" "override"
"private" "protected" "public" "register" "reinterpret_cast"
"return" "short" "signed" "sizeof" "static" "static_assert"
"static_cast" "struct" "switch" "template" "this" "thread_local"
"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"
@ -207,17 +210,31 @@
"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")
(scala-mode
"abstract" "case" "catch" "class" "def" "do" "else" "extends" "false"
"final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match"
"new" "null" "object" "override" "package" "private" "protected"
"return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
"var" "while" "with" "yield")
(julia-mode
"abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
"end" "eval" "export" "false" "finally" "for" "function" "global" "if"
"ifelse" "immutable" "import" "importall" "in" "let" "macro" "module"
"otherwise" "quote" "return" "switch" "throw" "true" "try" "type"
"typealias" "using" "while"
)
;; aliases
(js2-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(cperl-mode . perl-mode)
(jde-mode . java-mode))
(jde-mode . java-mode)
(ess-julia-mode . julia-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."
"`company-mode' backend for programming language keywords."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-keywords))

View File

@ -1,4 +1,4 @@
;;; company-nxml.el --- company-mode completion back-end for nxml-mode
;;; company-nxml.el --- company-mode completion backend for nxml-mode
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
@ -121,7 +121,7 @@
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
"`company-mode' completion back-end for `nxml-mode'."
"`company-mode' completion backend for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-nxml))

View File

@ -1,4 +1,4 @@
;;; company-oddmuse.el --- company-mode completion back-end for oddmuse-mode
;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@ -27,7 +27,7 @@
(require 'company)
(require 'cl-lib)
(eval-when-compile (require 'yaooddmuse nil t))
(eval-when-compile (require 'yaoddmuse nil t))
(eval-when-compile (require 'oddmuse nil t))
(defvar company-oddmuse-link-regexp
@ -42,7 +42,7 @@
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
"`company-mode' completion back-end for `oddmuse-mode'."
"`company-mode' completion backend for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-oddmuse))

View File

@ -0,0 +1,8 @@
(define-package "company" "20160413.1347" "Modular text completion framework"
'((emacs "24.1")
(cl-lib "0.5"))
:url "http://company-mode.github.io/" :keywords
'("abbrev" "convenience" "matching"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -1,6 +1,6 @@
;;; company-semantic.el --- company-mode completion back-end using Semantic
;;; company-semantic.el --- company-mode completion backend using Semantic
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -26,6 +26,7 @@
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defvar semantic-idle-summary-function)
@ -38,15 +39,30 @@
(declare-function semantic-tag-start "semantic/tag")
(declare-function semantic-tag-buffer "semantic/tag")
(declare-function semantic-active-p "semantic")
(declare-function semantic-format-tag-prototype "semantic/format")
(defgroup company-semantic nil
"Completion back-end using Semantic."
"Completion backend 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)
(defcustom company-semantic-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-semantic-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.9.0"))
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
(defvar-local company-semantic--current-tags nil
@ -89,7 +105,7 @@
(let ((completion-ignore-case nil)
(context (semantic-analyze-current-context)))
(setq company-semantic--current-tags
(semantic-analyze-possible-completions context))
(semantic-analyze-possible-completions context 'no-unique))
(all-completions prefix company-semantic--current-tags))))
(defun company-semantic-completions-raw (prefix)
@ -100,33 +116,21 @@
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic-annotation (argument tags)
(let* ((tag (assoc argument tags))
(let* ((tag (assq argument tags))
(kind (when tag (elt tag 1))))
(cl-case kind
(function (let* ((prototype (semantic-format-tag-prototype tag nil nil))
(par-pos (string-match "(" prototype)))
(when par-pos (substring prototype par-pos)))))))
(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))))))
(defun company-semantic--prefix ()
(if company-semantic-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
"`company-mode' completion back-end using CEDET Semantic."
"`company-mode' completion backend using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-semantic))
@ -134,9 +138,9 @@ Symbols are chained by \".\" or \"->\"."
(semantic-active-p)
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
(or (company-semantic--grab) 'stop)))
(or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
(not (looking-back "->\\|\\.")))
(not (looking-back "->\\|\\." (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
@ -147,10 +151,17 @@ Symbols are chained by \".\" or \"->\"."
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
(duplicates t)
(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)))))))
(semantic-tag-start tag)))))
(post-completion (let ((anno (company-semantic-annotation
arg company-semantic--current-tags)))
(when (and company-semantic-insert-arguments anno)
(insert anno)
(company-template-c-like-templatify (concat arg anno)))
))))
(provide 'company-semantic)
;;; company-semantic.el ends here

View File

@ -1,6 +1,6 @@
;;; company-template.el
;;; company-template.el --- utility library for template expansion
;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -93,16 +93,14 @@
(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.
(defun company-template-add-field (templ beg end &optional display)
"Add new field to template TEMPL spanning from BEG to END.
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))))
(when (> end (overlay-end templ))
(move-overlay templ (overlay-start templ) end))
(let ((ov (make-overlay beg end))
(siblings (overlay-get templ 'company-template-fields)))
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'intangible t)
@ -149,7 +147,6 @@ Leave point at the end of the field."
(defun company-template-c-like-templatify (call)
(let* ((end (point-marker))
(beg (- (point) (length call)))
(cnt 0)
(templ (company-template-declare-template beg end))
paren-open paren-close)
(with-syntax-table (make-syntax-table (syntax-table))
@ -167,29 +164,51 @@ Leave point at the end of the field."
(forward-char 1)
(backward-sexp)
(forward-char)
(setq cnt (company-template--c-like-args templ angle-close
cnt))))
(company-template--c-like-args templ angle-close)))
(when (looking-back "\\((\\*)\\)(" (line-beginning-position))
(delete-region (match-beginning 1) (match-end 1)))
(when paren-open
(goto-char paren-open)
(company-template--c-like-args templ paren-close cnt)))
(company-template--c-like-args templ paren-close)))
(if (overlay-get templ 'company-template-fields)
(company-template-move-to-first templ)
(company-template-remove-template templ)
(goto-char end))))
(defun company-template--c-like-args (templ end counter)
(defun company-template--c-like-args (templ end)
(let ((last-pos (point)))
(while (re-search-forward "\\([^,]+\\),?" end 'move)
(when (zerop (car (parse-partial-sexp last-pos (point))))
(let ((sig (buffer-substring-no-properties last-pos (match-end 1))))
(save-excursion
(company-template-add-field templ last-pos
(format "arg%d" counter) sig)
(delete-region (point) (+ (point) (length sig))))
(skip-chars-forward " ")
(setq last-pos (point))
(cl-incf counter)))))
counter)
(company-template-add-field templ last-pos (match-end 1))
(skip-chars-forward " ")
(setq last-pos (point))))))
;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-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)
(if (looking-at "\\(([^)]*)\\) ?")
(company-template-add-field templ (point) (match-end 1))
;; Not sure which conditions this case manifests under, but
;; apparently it did before, when I wrote the first test for this
;; function. FIXME: Revisit it.
(company-template-add-field templ (point)
(progn
(insert (format "arg%d" cnt))
(point)))
(when (< (point) end)
(insert " "))
(cl-incf cnt))
(when (>= (point) end)
(throw 'stop t)))))
(company-template-move-to-first templ)))
(provide 'company-template)
;;; company-template.el ends here

View File

@ -1,6 +1,6 @@
;;; company-tempo.el --- company-mode completion back-end for tempo
;;; company-tempo.el --- company-mode completion backend for tempo
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@ -29,6 +29,15 @@
(require 'cl-lib)
(require 'tempo)
(defgroup company-tempo nil
"Tempo completion backend."
:group 'company)
(defcustom company-tempo-expand nil
"Whether to expand a tempo tag after completion."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defsubst company-tempo-lookup (match)
(cdr (assoc match (tempo-build-collection))))
@ -48,15 +57,14 @@
;;;###autoload
(defun company-tempo (command &optional arg &rest ignored)
"`company-mode' completion back-end for tempo."
"`company-mode' completion backend for tempo."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-tempo
'company-tempo-insert))
(interactive (company-begin-backend 'company-tempo))
(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)
(post-completion (when company-tempo-expand (company-tempo-insert arg)))
(sorted t)))
(provide 'company-tempo)

View File

@ -1,4 +1,4 @@
;;; company-xcode.el --- company-mode completion back-end for Xcode projects
;;; company-xcode.el --- company-mode completion backend for Xcode projects
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-xcode nil
"Completion back-end for Xcode projects."
"Completion backend for Xcode projects."
:group 'company)
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
@ -106,7 +106,7 @@ valid in most contexts."
company-xcode-tags))))))
;;;###autoload
(defun company-xcode (command &optional arg &rest ignored)
"`company-mode' completion back-end for Xcode projects."
"`company-mode' completion backend for Xcode projects."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-xcode))

View File

@ -1,6 +1,6 @@
;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet
;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@ -33,8 +33,47 @@
(declare-function yas-expand-snippet "yasnippet")
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
(declare-function yas--warning "yasnippet")
(defun company-yasnippet--key-prefixes ()
;; Mostly copied from `yas--templates-for-key-at-point'.
(defvar yas-key-syntaxes)
(save-excursion
(let ((original (point))
(methods yas-key-syntaxes)
prefixes
method)
(while methods
(unless (eq method (car methods))
(goto-char original))
(setq method (car methods))
(cond ((stringp method)
(skip-syntax-backward method)
(setq methods (cdr methods)))
((functionp method)
(unless (eq (funcall method original)
'again)
(setq methods (cdr methods))))
(t
(setq methods (cdr methods))
(yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
(let ((prefix (buffer-substring-no-properties (point) original)))
(unless (equal prefix (car prefixes))
(push prefix prefixes))))
prefixes)))
(defun company-yasnippet--candidates (prefix)
;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
;; matches, so the longest prefix with any matches should be the most useful.
(cl-loop with tables = (yas--get-snippet-tables)
for key-prefix in (company-yasnippet--key-prefixes)
;; Only consider keys at least as long as the symbol at point.
when (>= (length key-prefix) (length prefix))
thereis (company-yasnippet--completions-for-prefix prefix
key-prefix
tables)))
(defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
(cl-mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
@ -43,28 +82,30 @@
(maphash
(lambda (key value)
(when (and (stringp key)
(string-prefix-p prefix key))
(string-prefix-p key-prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
'yas-template template)
'yas-template template
'yas-prefix-offset (- (length key-prefix)
(length prefix)))
res))
value)))
keyhash))
res))
(yas--get-snippet-tables)))
tables))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
"`company-mode' back-end for `yasnippet'.
"`company-mode' backend 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:
This backend should be used with care, because as long as there are
snippets defined for the current major mode, this backend will always
shadow backends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end or
* In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
@ -72,7 +113,7 @@ shadow back-ends that come after it. Recommended usages:
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other back-ends.
* After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
@ -93,10 +134,12 @@ shadow back-ends that come after it. Recommended usages:
(unless company-tooltip-align-annotations " -> ")
(get-text-property 0 'yas-annotation arg)))
(candidates (company-yasnippet--candidates arg))
(no-cache t)
(post-completion
(let ((template (get-text-property 0 'yas-template arg)))
(let ((template (get-text-property 0 'yas-template arg))
(prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
(yas-expand-snippet (yas--template-content template)
(- (point) (length arg))
(- (point) (length arg) prefix-offset)
(point)
(yas--template-expand-env template))))))

View File

@ -1 +0,0 @@
(define-package "dash" "20160223.1028" "A modern list library for Emacs" 'nil :keywords '("lists"))

View File

@ -3,7 +3,7 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("dash.el") (22221 60697 93676 700000))
;;;### (autoloads nil nil ("dash.el") (22297 19836 790973 907000))
;;;***

View File

@ -0,0 +1 @@
(define-package "dash" "20160306.1222" "A modern list library for Emacs" 'nil :keywords '("lists"))

View File

@ -4,7 +4,7 @@
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 2.12.1
;; Package-Version: 20160223.1028
;; Package-Version: 20160306.1222
;; Keywords: lists
;; This program is free software; you can redistribute it and/or modify
@ -1190,6 +1190,29 @@ as `(nth i list)` for all i from INDICES."
(!cons (nth it list) r))
(nreverse r)))
(defun -select-columns (columns table)
"Select COLUMNS from TABLE.
TABLE is a list of lists where each element represents one row.
It is assumed each row has the same length.
Each row is transformed such that only the specified COLUMNS are
selected.
See also: `-select-column', `-select-by-indices'"
(--map (-select-by-indices columns it) table))
(defun -select-column (column table)
"Select COLUMN from TABLE.
TABLE is a list of lists where each element represents one row.
It is assumed each row has the same length.
The single selected column is returned as a list.
See also: `-select-columns', `-select-by-indices'"
(--mapcat (-select-by-indices (list column) it) table))
(defmacro -> (x &optional form &rest more)
"Thread the expr through the forms. Insert X as the second item
in the first form, making a list of it if it is not a list
@ -2342,6 +2365,8 @@ structure such as plist or alist."
"-find-last-index"
"--find-last-index"
"-select-by-indices"
"-select-columns"
"-select-column"
"-grade-up"
"-grade-down"
"->"

View File

@ -1 +0,0 @@
(define-package "erlang" "2.4.1" "Major modes for editing and running Erlang" 'nil)

View File

@ -3,7 +3,7 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "erlang" "erlang.el" (21600 43785 98197 57000))
;;;### (autoloads nil "erlang" "erlang.el" (22297 19833 531790 580000))
;;; Generated autoloads from erlang.el
(autoload 'erlang-mode "erlang" "\
@ -68,8 +68,10 @@ Other commands:
\(fn)" t nil)
(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
(autoload 'erlang-find-tag "erlang" "\
Like `find-tag'. Capable of retreiving Erlang modules.
Like `find-tag'. Capable of retrieving Erlang modules.
Tags can be given on the forms `tag', `module:', `module:tag'.
@ -97,11 +99,12 @@ Compile Erlang module in current buffer.
(autoload 'inferior-erlang "erlang" "\
Run an inferior Erlang.
With prefix command, prompt for command to start Erlang with.
This is just like running Erlang in a normal shell, except that
an Emacs buffer is used for input and output.
The command line history can be accessed with M-p and M-n.
\\<comint-mode-map>
The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
The history is saved between sessions.
Entry to this mode calls the functions in the variables
@ -111,7 +114,25 @@ The following commands imitate the usual Unix interrupt and
editing control characters:
\\{erlang-shell-mode-map}
\(fn)" t nil)
\(fn &optional COMMAND)" t nil)
;;;***
;;;### (autoloads nil "erlang-start" "erlang-start.el" (22297 19833
;;;;;; 146797 463000))
;;; Generated autoloads from erlang-start.el
(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist))))
(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
(let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext (let ((cie completion-ignored-extensions)) (while (and cie (not (string-equal (car cie) (car erl-ext)))) (setq cie (cdr cie))) (if (null cie) (setq completion-ignored-extensions (cons (car erl-ext) completion-ignored-extensions)))) (setq erl-ext (cdr erl-ext))))
;;;***
;;;### (autoloads nil nil ("erlang-eunit.el" "erlang-flymake.el"
;;;;;; "erlang-pkg.el" "erlang-skels-old.el" "erlang-skels.el" "erlang_appwiz.el")
;;;;;; (22297 19834 170483 735000))
;;;***

View File

@ -0,0 +1,453 @@
;;
;; %CopyrightBegin%
;;
;; Copyright Ericsson AB 2009-2010. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; %CopyrightEnd%
;;;
;;; Purpose: Provide EUnit utilities.
;;;
;;; Author: Klas Johansson
(eval-when-compile
(require 'cl))
(defvar erlang-eunit-src-candidate-dirs '("../src" ".")
"*Name of directories which to search for source files matching
an EUnit test file. The first directory in the list will be used,
if there is no match.")
(defvar erlang-eunit-test-candidate-dirs '("../test" ".")
"*Name of directories which to search for EUnit test files matching
a source file. The first directory in the list will be used,
if there is no match.")
(defvar erlang-eunit-autosave nil
"*Set to non-nil to automtically save unsaved buffers before running tests.
This is useful, reducing the save-compile-load-test cycle to one keychord.")
(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
"Info about the most recent running of an EUnit test representation.")
(defvar erlang-error-regexp-alist
'(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
"*Patterns for matching Erlang errors.")
;;;
;;; Switch between src/EUnit test buffers
;;;
(defun erlang-eunit-toggle-src-and-test-file-other-window ()
"Switch to the src file if the EUnit test file is the current
buffer and vice versa"
(interactive)
(if (erlang-eunit-test-file-p buffer-file-name)
(erlang-eunit-open-src-file-other-window buffer-file-name)
(erlang-eunit-open-test-file-other-window buffer-file-name)))
;;;
;;; Open the EUnit test file which corresponds to a src file
;;;
(defun erlang-eunit-open-test-file-other-window (src-file-path)
"Open the EUnit test file which corresponds to a src file"
(find-file-other-window (erlang-eunit-test-filename src-file-path)))
;;;
;;; Open the src file which corresponds to the an EUnit test file
;;;
(defun erlang-eunit-open-src-file-other-window (test-file-path)
"Open the src file which corresponds to the an EUnit test file"
(find-file-other-window (erlang-eunit-src-filename test-file-path)))
;;; Return the name and path of the EUnit test file
;;, (input may be either the source filename itself or the EUnit test filename)
(defun erlang-eunit-test-filename (file-path)
(if (erlang-eunit-test-file-p file-path)
file-path
(erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs)))
;;; Return the name and path of the source file
;;, (input may be either the source filename itself or the EUnit test filename)
(defun erlang-eunit-src-filename (file-path)
(if (erlang-eunit-src-file-p file-path)
file-path
(erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs)))
;;; Rewrite a filename from the src or test filename to the other
(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs)
(or (erlang-eunit-locate-buddy orig-file-path candidate-dirs)
(erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs))))
;;; Search for a file's buddy file (a source file's EUnit test file,
;;; or an EUnit test file's source file) in a list of candidate
;;; directories.
(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs)
(when candidate-dirs
(let ((buddy-file-path (erlang-eunit-buddy-file-path
orig-file-path
(car candidate-dirs))))
(if (file-readable-p buddy-file-path)
buddy-file-path
(erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs))))))
(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name)
(let* ((orig-dir-name (file-name-directory orig-file-path))
(buddy-dir-name (file-truename
(filename-join orig-dir-name buddy-dir-name)))
(buddy-base-name (erlang-eunit-buddy-basename orig-file-path)))
(filename-join buddy-dir-name buddy-base-name)))
;;; Return the basename of the buddy file:
;;; /tmp/foo/src/x.erl --> x_tests.erl
;;; /tmp/foo/test/x_tests.erl --> x.erl
(defun erlang-eunit-buddy-basename (file-path)
(let ((src-module-name (erlang-eunit-source-module-name file-path)))
(cond
((erlang-eunit-src-file-p file-path)
(concat src-module-name "_tests.erl"))
((erlang-eunit-test-file-p file-path)
(concat src-module-name ".erl")))))
;;; Checks whether a file is a source file or not
(defun erlang-eunit-src-file-p (file-path)
(not (erlang-eunit-test-file-p file-path)))
;;; Checks whether a file is a EUnit test file or not
(defun erlang-eunit-test-file-p (file-path)
(erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
;;; Return the module name of the source file
;;; /tmp/foo/src/x.erl --> x
;;; /tmp/foo/test/x_tests.erl --> x
(defun erlang-eunit-source-module-name (file-path)
(interactive)
(let ((module-name (erlang-eunit-module-name file-path)))
(if (string-match "^\\(.+\\)_tests$" module-name)
(substring module-name (match-beginning 1) (match-end 1))
module-name)))
;;; Return the module name of the file
;;; /tmp/foo/src/x.erl --> x
;;; /tmp/foo/test/x_tests.erl --> x_tests
(defun erlang-eunit-module-name (file-path)
(interactive)
(file-name-sans-extension (file-name-nondirectory file-path)))
;;; Older emacsen don't have string-match-p.
(defun erlang-eunit-string-match-p (regexp string &optional start)
(if (fboundp 'string-match-p) ;; appeared in emacs 23
(string-match-p regexp string start)
(save-match-data ;; fallback for earlier versions of emacs
(string-match regexp string start))))
;;; Join filenames
(defun filename-join (dir file)
(if (or (= (elt file 0) ?/)
(= (car (last (append dir nil))) ?/))
(concat dir file)
(concat dir "/" file)))
;;; Get info about the most recent running of EUnit
(defun erlang-eunit-recent (key)
(cdr (assq key erlang-eunit-recent-info)))
;;; Record info about the most recent running of EUnit
;;; Known modes are 'module-mode and 'test-mode
(defun erlang-eunit-record-recent (mode module test)
(setcdr (assq 'mode erlang-eunit-recent-info) mode)
(setcdr (assq 'module erlang-eunit-recent-info) module)
(setcdr (assq 'test erlang-eunit-recent-info) test))
;;; Record whether the most recent running of EUnit included cover
;;; compilation
(defun erlang-eunit-record-recent-compile (under-cover)
(setcdr (assq 'cover erlang-eunit-recent-info) under-cover))
;;; Determine options for EUnit.
(defun erlang-eunit-opts ()
(if current-prefix-arg ", [verbose]" ""))
;;; Determine current test function
(defun erlang-eunit-current-test ()
(save-excursion
(erlang-end-of-function 1)
(erlang-beginning-of-function 1)
(erlang-name-of-function)))
(defun erlang-eunit-simple-test-p (test-name)
(if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
(defun erlang-eunit-test-generator-p (test-name)
(if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
;;; Run one EUnit test
(defun erlang-eunit-run-test (module-name test-name)
(let ((command
(cond ((erlang-eunit-simple-test-p test-name)
(format "eunit:test({%s, %s}%s)."
module-name test-name (erlang-eunit-opts)))
((erlang-eunit-test-generator-p test-name)
(format "eunit:test({generator, %s, %s}%s)."
module-name test-name (erlang-eunit-opts)))
(t (format "%% WARNING: '%s' is not a test function" test-name)))))
(erlang-eunit-record-recent 'test-mode module-name test-name)
(erlang-eunit-inferior-erlang-send-command command)))
;;; Run EUnit tests for the current module
(defun erlang-eunit-run-module-tests (module-name)
(let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
(erlang-eunit-record-recent 'module-mode module-name nil)
(erlang-eunit-inferior-erlang-send-command command)))
(defun erlang-eunit-compile-and-run-recent ()
"Compile the source and test files and repeat the most recent EUnit test run.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(case (erlang-eunit-recent 'mode)
('test-mode
(erlang-eunit-compile-and-test
'erlang-eunit-run-test (list (erlang-eunit-recent 'module)
(erlang-eunit-recent 'test))))
('module-mode
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module))
(erlang-eunit-recent 'cover)))
(t (error "EUnit has not yet been run. Please run a test first."))))
(defun erlang-eunit-cover-compile ()
"Cover compile current module."
(interactive)
(let* ((erlang-compile-extra-opts
(append (list 'debug_info) erlang-compile-extra-opts))
(module-name
(erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(compile-command
(format "cover:compile_beam(%s)." module-name)))
(erlang-compile)
(if (erlang-eunit-last-compilation-successful-p)
(erlang-eunit-inferior-erlang-send-command compile-command))))
(defun erlang-eunit-analyze-coverage ()
"Analyze the data collected by cover tool for the module in the
current buffer.
Assumes that the module has been cover compiled prior to this
call. This function will do two things: print the number of
covered and uncovered functions in the erlang shell and display a
new buffer called *<module name> coverage* which shows the source
code along with the coverage analysis results."
(interactive)
(let* ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(tmp-filename (make-temp-file "cover"))
(analyze-command (format "cover:analyze_to_file(%s, \"%s\"). "
module-name tmp-filename))
(buf-name (format "*%s coverage*" module-name)))
(erlang-eunit-inferior-erlang-send-command analyze-command)
;; The purpose of the following snippet is to get the result of the
;; analysis from a file into a new buffer (or an old, if one with
;; the specified name already exists). Also we want the erlang-mode
;; *and* view-mode to be enabled.
(save-excursion
(let ((buf (get-buffer-create (format "*%s coverage*" module-name))))
(set-buffer buf)
(setq buffer-read-only nil)
(insert-file-contents tmp-filename nil nil nil t)
(if (= (buffer-size) 0)
(kill-buffer buf)
;; FIXME: this would be a good place to enable (emacs-mode)
;; to get some nice syntax highlighting in the
;; coverage report, but it doesn't play well with
;; flymake. Leave it off for now.
(view-buffer buf))))
(delete-file tmp-filename)))
(defun erlang-eunit-compile-and-run-current-test ()
"Compile the source and test files and run the current EUnit test.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-module-name buffer-file-name)))
(test-name (erlang-eunit-current-test)))
(erlang-eunit-compile-and-test
'erlang-eunit-run-test (list module-name test-name))))
(defun erlang-eunit-compile-and-run-module-tests ()
"Compile the source and test files and run all EUnit tests in the module.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-source-module-name buffer-file-name))))
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list module-name))))
;;; Compile source and EUnit test file and finally run EUnit tests for
;;; the current module
(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover)
"Compile the source and test files and run the EUnit test suite.
If under-cover is set to t, the module under test is compile for
code coverage analysis. If under-cover is left out or not set,
coverage analysis is disabled. The result of the code coverage
is both printed to the erlang shell (the number of covered vs
uncovered functions in a module) and written to a buffer called
*<module> coverage* (which shows the source code for the module
and the number of times each line is covered).
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(erlang-eunit-record-recent-compile under-cover)
(let ((src-filename (erlang-eunit-src-filename buffer-file-name))
(test-filename (erlang-eunit-test-filename buffer-file-name)))
;; The purpose of out-maneuvering `save-some-buffers', as is done
;; below, is to ask the question about saving buffers only once,
;; instead of possibly several: one for each file to compile,
;; for instance for both x.erl and x_tests.erl.
(save-some-buffers erlang-eunit-autosave)
(flet ((save-some-buffers (&optional any) nil))
;; Compilation of the source file is mandatory (the file must
;; exist, otherwise the procedure is aborted). Compilation of the
;; test file on the other hand, is optional, since eunit tests may
;; be placed in the source file instead. Any compilation error
;; will prevent the subsequent steps to be run (hence the `and')
(and (erlang-eunit-compile-file src-filename under-cover)
(if (file-readable-p test-filename)
(erlang-eunit-compile-file test-filename)
t)
(apply test-fun test-args)
(if under-cover
(save-excursion
(set-buffer (find-file-noselect src-filename))
(erlang-eunit-analyze-coverage)))))))
(defun erlang-eunit-compile-and-run-module-tests-under-cover ()
"Compile the source and test files and run the EUnit test suite and measure
code coverage.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
(let ((module-name (erlang-add-quotes-if-needed
(erlang-eunit-source-module-name buffer-file-name))))
(erlang-eunit-compile-and-test
'erlang-eunit-run-module-tests (list module-name) t)))
(defun erlang-eunit-compile-file (file-path &optional under-cover)
(if (file-readable-p file-path)
(save-excursion
(set-buffer (find-file-noselect file-path))
;; In order to run a code coverage analysis on a
;; module, we have two options:
;;
;; * either compile the module with cover:compile instead of the
;; regular compiler
;;
;; * or first compile the module with the regular compiler (but
;; *with* debug_info) and then compile it for coverage
;; analysis using cover:compile_beam.
;;
;; We could accomplish the first by changing the
;; erlang-compile-erlang-function to cover:compile, but there's
;; a risk that that's used for other purposes. Therefore, a
;; safer alternative (although with more steps) is to add
;; debug_info to the list of compiler options and go for the
;; second alternative.
(if under-cover
(erlang-eunit-cover-compile)
(erlang-compile))
(erlang-eunit-last-compilation-successful-p))
(let ((msg (format "Could not read %s" file-path)))
(erlang-eunit-inferior-erlang-send-command
(format "%% WARNING: %s" msg))
(error msg))))
(defun erlang-eunit-last-compilation-successful-p ()
(save-excursion
(set-buffer inferior-erlang-buffer)
(goto-char compilation-parsing-end)
(erlang-eunit-all-list-elems-fulfill-p
(lambda (re) (let ((continue t)
(result t))
(while continue ; ignore warnings, stop at errors
(if (re-search-forward re (point-max) t)
(if (erlang-eunit-is-compilation-warning)
t
(setq result nil)
(setq continue nil))
(setq result t)
(setq continue nil)))
result))
(mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
(defun erlang-eunit-is-compilation-warning ()
(erlang-eunit-string-match-p
"[0-9]+: Warning:"
(buffer-substring (line-beginning-position) (line-end-position))))
(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
(let ((matches-p t))
(while (and list matches-p)
(if (not (funcall pred (car list)))
(setq matches-p nil))
(setq list (cdr list)))
matches-p))
;;; Evaluate a command in an erlang buffer
(defun erlang-eunit-inferior-erlang-send-command (command)
"Evaluate a command in an erlang buffer."
(interactive "P")
(inferior-erlang-prepare-for-input)
(inferior-erlang-send-command command)
(sit-for 0) ;; redisplay
(inferior-erlang-wait-prompt))
;;;====================================================================
;;; Key bindings
;;;====================================================================
(defconst erlang-eunit-key-bindings
'(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)
("\C-c\C-el" erlang-eunit-compile-and-run-recent)
("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover)
("\C-c\C-ev" erlang-eunit-cover-compile)
("\C-c\C-ea" erlang-eunit-analyze-coverage)))
(defun erlang-eunit-add-key-bindings ()
(dolist (binding erlang-eunit-key-bindings)
(erlang-eunit-bind-key (car binding) (cadr binding))))
(defun erlang-eunit-bind-key (key function)
(erlang-eunit-ensure-keymap-for-key key)
(local-set-key key function))
(defun erlang-eunit-ensure-keymap-for-key (key-seq)
(let ((prefix-keys (butlast (append key-seq nil)))
(prefix-seq ""))
(while prefix-keys
(setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
(setq prefix-keys (cdr prefix-keys))
(if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
(local-set-key prefix-seq (make-sparse-keymap))))))
(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
(provide 'erlang-eunit)
;; erlang-eunit ends here

View File

@ -0,0 +1,103 @@
;; erlang-flymake.el
;;
;; Syntax check erlang source code on the fly (integrates with flymake).
;;
;; Start using flymake with erlang by putting the following somewhere
;; in your .emacs file:
;;
;; (require 'erlang-flymake)
;;
;; Flymake is rather eager and does its syntax checks frequently by
;; default and if you are bothered by this, you might want to put the
;; following in your .emacs as well:
;;
;; (erlang-flymake-only-on-save)
;;
;; There are a couple of variables which control the compilation options:
;; * erlang-flymake-get-code-path-dirs-function
;; * erlang-flymake-get-include-dirs-function
;; * erlang-flymake-extra-opts
;;
;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang.
(require 'flymake)
(eval-when-compile
(require 'cl))
(defvar erlang-flymake-command
"erlc"
"The command that will be used to perform the syntax check")
(defvar erlang-flymake-get-code-path-dirs-function
'erlang-flymake-get-code-path-dirs
"Return a list of ebin directories to add to the code path.")
(defvar erlang-flymake-get-include-dirs-function
'erlang-flymake-get-include-dirs
"Return a list of include directories to add to the compiler options.")
(defvar erlang-flymake-extra-opts
(list "+warn_obsolete_guard"
"+warn_unused_import"
"+warn_shadow_vars"
"+warn_export_vars"
"+strong_validation"
"+report")
"A list of options that will be passed to the compiler")
(defun erlang-flymake-only-on-save ()
"Trigger flymake only when the buffer is saved (disables syntax
check on newline and when there are no changes)."
(interactive)
;; There doesn't seem to be a way of disabling this; set to the
;; largest int available as a workaround (most-positive-fixnum
;; equates to 8.5 years on my machine, so it ought to be enough ;-) )
(setq flymake-no-changes-timeout most-positive-fixnum)
(setq flymake-start-syntax-check-on-newline nil))
(defun erlang-flymake-get-code-path-dirs ()
(list (concat (erlang-flymake-get-app-dir) "ebin")))
(defun erlang-flymake-get-include-dirs ()
(list (concat (erlang-flymake-get-app-dir) "include")
(concat (erlang-flymake-get-app-dir) "deps")))
(defun erlang-flymake-get-app-dir ()
(let ((src-path (file-name-directory (buffer-file-name))))
(file-name-directory (directory-file-name src-path))))
(defun erlang-flymake-init ()
(let* ((temp-file
(flet ((flymake-get-temp-dir () (erlang-flymake-temp-dir)))
(flymake-init-create-temp-buffer-copy
'flymake-create-temp-with-folder-structure)))
(code-dir-opts
(erlang-flymake-flatten
(mapcar (lambda (dir) (list "-pa" dir))
(funcall erlang-flymake-get-code-path-dirs-function))))
(inc-dir-opts
(erlang-flymake-flatten
(mapcar (lambda (dir) (list "-I" dir))
(funcall erlang-flymake-get-include-dirs-function))))
(compile-opts
(append inc-dir-opts
code-dir-opts
erlang-flymake-extra-opts)))
(list erlang-flymake-command (append compile-opts (list temp-file)))))
(defun erlang-flymake-temp-dir ()
;; Squeeze the user's name in there in order to make sure that files
;; for two users who are working on the same computer (like a linux
;; box) don't collide
(format "%s/flymake-%s" temporary-file-directory user-login-name))
(defun erlang-flymake-flatten (list)
(apply #'append list))
(add-to-list 'flymake-allowed-file-name-masks
'("\\.erl\\'" erlang-flymake-init))
(add-hook 'erlang-mode-hook 'flymake-mode)
(provide 'erlang-flymake)
;; erlang-flymake ends here

View File

@ -0,0 +1,4 @@
(define-package "erlang" "20151013.157" "Erlang major mode" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,124 @@
;; erlang-start.el --- Load this file to initialize the Erlang package.
;; Copyright (C) 1998 Ericsson Telecom AB
;; Author: Anders Lindgren
;; Version: 2.3
;; Keywords: erlang, languages, processes
;; Created: 1996-09-18
;; Date: 1998-03-16
;;; Commentary:
;; Introduction:
;; ------------
;;
;; This package provides support for the programming language Erlang.
;; The package provides an editing mode with lots of bells and
;; whistles, compilation support, and it makes it possible for the
;; user to start Erlang shells that run inside Emacs.
;;
;; See the Erlang distribution for full documentation of this package.
;; Installation:
;; ------------
;;
;; Place this file in Emacs load path, byte-compile it, and add the
;; following line to the appropriate init file:
;;
;; (require 'erlang-start)
;;
;; The full documentation contains much more extensive description of
;; the installation procedure.
;; Reporting Bugs:
;; --------------
;;
;; Please send bug reports to the following email address:
;; support@erlang.ericsson.se
;;
;; Please state as exactly as possible:
;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
;; and of any other relevant software.
;; - What the expected result was.
;; - What you did, preferably in a repeatable step-by-step form.
;; - A description of the unexpected result.
;; - Relevant pieces of Erlang code causing the problem.
;; - Personal Emacs customisations, if any.
;;
;; Should the Emacs generate an error, please set the emacs variable
;; `debug-on-error' to `t'. Repeat the error and enclose the debug
;; information in your bug-report.
;;
;; To set the variable you can use the following command:
;; M-x set-variable RET debug-on-error RET t RET
;;; Code:
;;
;; Declare functions in "erlang.el".
;;
(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t)
(autoload 'erlang-version "erlang"
"Return the current version of Erlang mode." t)
(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t)
(autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
(autoload 'erlang-compile "erlang"
"Compile Erlang module in current buffer." t)
(autoload 'erlang-man-module "erlang"
"Find manual page for MODULE." t)
(autoload 'erlang-man-function "erlang"
"Find manual page for NAME, where NAME is module:function." t)
(autoload 'erlang-find-tag "erlang"
"Like `find-tag'. Capable of retreiving Erlang modules.")
(autoload 'erlang-find-tag-other-window "erlang"
"Like `find-tag-other-window'. Capable of retreiving Erlang modules.")
;;
;; Associate files extensions ".erl" and ".hrl" with Erlang mode.
;;
;;;###autoload
(let ((a '("\\.erl\\'" . erlang-mode))
(b '("\\.hrl\\'" . erlang-mode)))
(or (assoc (car a) auto-mode-alist)
(setq auto-mode-alist (cons a auto-mode-alist)))
(or (assoc (car b) auto-mode-alist)
(setq auto-mode-alist (cons b auto-mode-alist))))
;;
;; Associate files using interpreter "escript" with Erlang mode.
;;
;;;###autoload
(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
;;
;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
;; file completion.
;;
;;;###autoload
(let ((erl-ext '(".jam" ".vee" ".beam")))
(while erl-ext
(let ((cie completion-ignored-extensions))
(while (and cie (not (string-equal (car cie) (car erl-ext))))
(setq cie (cdr cie)))
(if (null cie)
(setq completion-ignored-extensions
(cons (car erl-ext) completion-ignored-extensions))))
(setq erl-ext (cdr erl-ext))))
;;
;; The end.
;;
(provide 'erlang-start)
;; erlang-start.el ends here.

File diff suppressed because it is too large Load Diff

View File

@ -1,43 +0,0 @@
;;; 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

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

View File

@ -1,243 +0,0 @@
;;; 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,65 @@
;;; fiplr-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "fiplr" "fiplr.el" (22297 19831 573825 595000))
;;; Generated autoloads from fiplr.el
(autoload 'fiplr-find-file "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'.
\(fn)" t nil)
(autoload 'fiplr-find-file-other-window "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-window'.
\(fn)" t nil)
(autoload 'fiplr-find-file-other-frame "fiplr" "\
Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-frame'.
\(fn)" t nil)
(autoload 'fiplr-find-directory "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'.
\(fn)" t nil)
(autoload 'fiplr-find-directory-other-window "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-window'.
\(fn)" t nil)
(autoload 'fiplr-find-directory-other-frame "fiplr" "\
Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-frame'.
\(fn)" t 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") (22297 19831 829667 665000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; fiplr-autoloads.el ends here

View File

@ -0,0 +1,6 @@
(define-package "fiplr" "20140723.2345" "Fuzzy Search for Files in Projects"
'((grizzl "0.1.0")
(cl-lib "0.1")))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,346 @@
;;; 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.2.8
;; 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 easy to find files anywhere within your entire
;; project by using a cached directory tree and delegating to grizzl.el
;; 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)
;;
;; Because fiplr caches the project tree, you may sometimes wish to clear the
;; cache while searching. Use "C-c r" to do this.
(eval-when-compile
(require 'cl-lib)
(require 'grizzl))
;;; --- Package Configuration
(defvar *fiplr-caches* '((files) (directories))
"Internal caches used by fiplr.")
(defvar *fiplr-default-root-markers* '(".git" ".svn" ".hg" ".bzr")
"A list of files/directories to look for that mark a project root.")
(defvar *fiplr-default-ignored-globs*
'((directories (".git" ".svn" ".hg" ".bzr"))
(files (".#*" "*~" "*.so" "*.jpg" "*.png" "*.gif" "*.pdf" "*.gz" "*.zip")))
"An alist of files and directories to exclude from searches.")
(defgroup fiplr nil
"Configuration options for fiplr - find in project."
:group 'convenience)
(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)
(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)
(defcustom fiplr-list-files-function 'fiplr-list-files
"A function receiving DIR, TYPE and IGNORED, returning a list of files.
DIR is the directory under which to locate files (recursively).
TYPE is one of the symboles 'FILES or 'DIRECTORIES.
IGNORED is an alist of glob patterns to exclude. Its keys are 'DIRECTORIES
and 'FILES, so that entire directories can be excluded.
This setting allows for cross-platform compatibility by abstracting away the
details of locating files in a directory tree. The default uses a GNU/BSD
compatible `find' command.
This function is only invoked once, when building the search index."
:type 'function
:group 'fiplr)
;;; --- Public Functions
;;;###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))
;;;###autoload
(defun fiplr-find-file-other-window ()
"Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-window'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs
#'find-file-other-window))
;;;###autoload
(defun fiplr-find-file-other-frame ()
"Runs a completing prompt to find a file from the project.
The root of the project is the return value of `fiplr-root'. The
file is opened using `find-file-other-frame'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs
#'find-file-other-frame))
;;;###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))
;;;###autoload
(defun fiplr-find-directory-other-window ()
"Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-window'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs
#'dired-other-window))
;;;###autoload
(defun fiplr-find-directory-other-frame ()
"Runs a completing prompt to find a directory from the project.
The root of the project is the return value of `fiplr-root'. The
directory is opened using `dired-other-frame'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs
#'dired-other-frame))
;;;###autoload
(defun fiplr-clear-cache ()
"Clears the internal caches used by fiplr so the project is searched again."
(interactive)
(setq *fiplr-caches*
(list (list 'files)
(list 'directories))))
;;; --- Minor Mode Definition
(defvar *fiplr-keymap* (make-sparse-keymap)
"Internal keymap used by the minor-mode in fiplr.")
(define-key *fiplr-keymap* (kbd "C-c r") 'fiplr-reload-list)
(define-minor-mode fiplr-mode
"Toggle the internal mode used by fiplr."
nil
" fiplr"
*fiplr-keymap*)
;;; --- Private Macros
(defmacro fiplr-cache (type)
"Get the internal cache used by fiplr for files of TYPE."
`(cdr (assoc ,type *fiplr-caches*)))
;;; --- Private Functions
(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)))
(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)))))
(defun fiplr-anyp (pred seq)
"True if any value in SEQ matches PRED."
(catch 'found
(cl-map nil (lambda (v)
(when (funcall pred v)
(throw 'found v)))
seq)))
(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)))
(fiplr-anyp (lambda (marker)
(file-exists-p (concat dir marker)))
root-markers)))
(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"
"-L"
,(shell-quote-argument (directory-file-name path))
,(funcall matcher 'directories)
"-prune"
"-o"
"-not"
,(funcall matcher 'files)
"-type"
,(funcall type-abbrev type)
"-print")
" ")))
(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 (cl-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 '()))))
(defun fiplr-reload-list ()
"Clear caches and reload the file listing."
(interactive)
(when (minibufferp)
(exit-minibuffer))
(fiplr-clear-cache)
(funcall last-command))
(defun fiplr-report-progress (n total)
"Show the number of files processed in the message area."
(when (= 0 (mod n 1000))
(message (format "Indexing (%d/%d)" n total))))
(defun fiplr-find-file-in-directory
(path ignored-globs &optional find-file-function)
"Locate a file under the specified PATH.
If the directory has been searched previously, the cache is used.
Use FIND-FILE-FUNCTION to open the selected file, or `find-file'
if FIND-FILE-FUNCTION is `nil'."
(let* ((root-dir (file-name-as-directory path))
(index (fiplr-get-index 'files root-dir ignored-globs))
(file (minibuffer-with-setup-hook
(lambda ()
(fiplr-mode 1))
(grizzl-completing-read (format "Find in project (%s)" root-dir)
index))))
(if (eq this-command 'fiplr-reload-list) ; exited for reload
(fiplr-reload-list)
(funcall (or find-file-function #'find-file)
(concat root-dir file)))))
(defun fiplr-find-directory-in-directory
(path ignored-globs &optional dired-function)
"Locate a directory and run dired under the specified PATH.
If the directory has been searched previously, the cache is used.
Use DIRED-FUNCTION to open the selected file, or `dired' if
DIRED-FUNCTION is `nil'."
(let* ((root-dir (file-name-as-directory path))
(index (fiplr-get-index 'directories root-dir ignored-globs))
(dir (minibuffer-with-setup-hook
(lambda ()
(fiplr-mode 1))
(grizzl-completing-read (format "Dired in project (%s)" root-dir)
index))))
(if (eq this-command 'fiplr-reload-list) ; exited for reload
(fiplr-reload-list)
(funcall (or dired-function #'dired) (concat root-dir dir)))))
(defun fiplr-get-index (type path ignored-globs)
"Internal function to lazily get a fiplr fuzzy search index."
(let ((fiplr-cache-key (cons path ignored-globs)))
(unless (assoc fiplr-cache-key (fiplr-cache type))
(message (format "Scanning... (%s)" path))
(push (cons fiplr-cache-key
(grizzl-make-index (funcall fiplr-list-files-function
type
path
ignored-globs)
:progress-fn #'fiplr-report-progress))
(fiplr-cache type)))
(cdr (assoc fiplr-cache-key (fiplr-cache type)))))
(provide 'fiplr)
;;; fiplr.el ends here

View File

@ -0,0 +1,51 @@
;;; ggtags-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "ggtags" "ggtags.el" (22297 20828 347968 373000))
;;; Generated autoloads from ggtags.el
(autoload 'ggtags-find-project "ggtags" "\
\(fn)" nil nil)
(autoload 'ggtags-find-tag-dwim "ggtags" "\
Find NAME by context.
If point is at a definition tag, find references, and vice versa.
If point is at a line that matches `ggtags-include-pattern', find
the include file instead.
When called interactively with a prefix arg, always find
definition tags.
\(fn NAME &optional WHAT)" t nil)
(autoload 'ggtags-mode "ggtags" "\
Toggle Ggtags mode on or off.
With a prefix argument ARG, enable Ggtags mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
\\{ggtags-mode-map}
\(fn &optional ARG)" t nil)
(autoload 'ggtags-build-imenu-index "ggtags" "\
A function suitable for `imenu-create-index-function'.
\(fn)" nil nil)
(autoload 'ggtags-try-complete-tag "ggtags" "\
A function suitable for `hippie-expand-try-functions-list'.
\(fn OLD)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; ggtags-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "ggtags" "20151214.1344" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience"))

File diff suppressed because it is too large Load Diff

View File

@ -1 +0,0 @@
(define-package "git-commit" "20160130.649" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160128.1201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc"))

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-commit" "git-commit.el" (22221 60698 575000
;;;;;; 0))
;;;### (autoloads nil "git-commit" "git-commit.el" (22297 19830 709841
;;;;;; 48000))
;;; Generated autoloads from git-commit.el
(defvar global-git-commit-mode t "\
@ -25,6 +25,11 @@ provide such a commit message.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil nil ("git-commit-pkg.el") (22297 19831 32984
;;;;;; 389000))
;;;***
;; Local Variables:

View File

@ -0,0 +1 @@
(define-package "git-commit" "20160414.251" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc"))

View File

@ -11,9 +11,9 @@
;; Marius Vollmer <marius.vollmer@gmail.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160128.1201"))
;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201"))
;; Keywords: git tools vc
;; Package-Version: 20160130.649
;; Package-Version: 20160414.251
;; Homepage: https://github.com/magit/magit
;; This file is not part of GNU Emacs.
@ -466,7 +466,7 @@ second line is empty."
t ; Just try; we don't know whether --allow-empty-message was used.
(and (or (equal (match-string 2) "")
(y-or-n-p "Summary line is too long. Commit anyway? "))
(or (equal (match-string 3) "")
(or (not (match-string 3))
(y-or-n-p "Second line is not empty. Commit anyway? ")))))))
(defun git-commit-cancel-message ()
@ -512,6 +512,9 @@ With a numeric prefix ARG, go forward ARG comments."
(with-temp-buffer
(insert str)
(goto-char (point-min))
(when (re-search-forward (concat flush " -+ >8 -+$") nil t)
(delete-region (point-at-bol) (point-max)))
(goto-char (point-min))
(flush-lines flush)
(goto-char (point-max))
(unless (eq (char-before) ?\n)
@ -610,7 +613,7 @@ With a numeric prefix ARG, go forward ARG comments."
;; Summary line
(format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length)
;; Non-empty non-comment second line
(format "\\(?:\n%s\\|\n\\(.*\\)\\)?" comment-start)))
(format "\\(?:\n%s\\|\n\\(.+\\)\\)?" comment-start)))
(defun git-commit-mode-font-lock-keywords ()
`(;; Comments
@ -648,6 +651,7 @@ With a numeric prefix ARG, go forward ARG comments."
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^diff --git" nil t)
(beginning-of-line)
(let ((buffer (current-buffer)))
(insert
(with-temp-buffer
@ -657,15 +661,17 @@ With a numeric prefix ARG, go forward ARG comments."
(delete-region (point) (point-max)))))
(diff-mode)
(let (font-lock-verbose font-lock-support-mode)
(if (fboundp 'font-lock-flush)
(font-lock-flush)
(if (fboundp 'font-lock-ensure)
(font-lock-ensure)
(with-no-warnings
(font-lock-fontify-buffer))))
(let (next (pos (point-min)))
(while (setq next (next-single-property-change pos 'face))
(put-text-property pos next 'font-lock-face
(get-text-property pos 'face))
(setq pos next)))
(setq pos next))
(put-text-property pos (point-max) 'font-lock-face
(get-text-property pos 'face)))
(buffer-string)))))))
;;; git-commit.el ends soon

View File

@ -1 +0,0 @@
(define-package "git-gutter" "0.78" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24")))

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-gutter" "git-gutter.el" (21633 45696 229043
;;;;;; 874000))
;;;### (autoloads nil "git-gutter" "git-gutter.el" (22297 19829 459863
;;;;;; 402000))
;;; Generated autoloads from git-gutter.el
(autoload 'git-gutter:linum-setup "git-gutter" "\
@ -38,57 +38,16 @@ See `git-gutter-mode' for more information on Git-Gutter mode.
\(fn &optional ARG)" t nil)
(autoload 'git-gutter:revert-hunk "git-gutter" "\
Revert current hunk.
\(fn)" t nil)
(autoload 'git-gutter:stage-hunk "git-gutter" "\
Stage this hunk like 'git add -p'.
\(fn)" t nil)
(autoload 'git-gutter:popup-hunk "git-gutter" "\
Popup current diff hunk.
\(fn &optional DIFFINFO)" t nil)
(autoload 'git-gutter:next-hunk "git-gutter" "\
Move to next diff hunk
\(fn ARG)" t nil)
(autoload 'git-gutter:previous-hunk "git-gutter" "\
Move to previous diff hunk
\(fn ARG)" t nil)
(autoload 'git-gutter "git-gutter" "\
Show diff information in gutter
\(fn)" t nil)
(autoload 'git-gutter:clear "git-gutter" "\
Clear diff information in gutter.
\(fn)" t nil)
(autoload 'git-gutter:toggle "git-gutter" "\
Toggle to show diff information.
\(fn)" t nil)
(autoload 'git-gutter:set-start-revision "git-gutter" "\
Set start revision. If `start-rev' is nil or empty string then reset
start revision.
\(fn START-REV)" t nil)
(autoload 'git-gutter:update-all-windows "git-gutter" "\
Update git-gutter informations for all visible buffers.
\(fn)" t nil)
;;;***
;; Local Variables:

View File

@ -0,0 +1 @@
(define-package "git-gutter" "20160409.713" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24")) :url "https://github.com/syohex/emacs-git-gutter")

View File

@ -1,10 +1,11 @@
;;; git-gutter.el --- Port of Sublime Text plugin GitGutter -*- lexical-binding: t; -*-
;; Copyright (C) 2014 by Syohei YOSHIDA
;; Copyright (C) 2016 by Syohei YOSHIDA
;; Author: Syohei YOSHIDA <syohex@gmail.com>
;; URL: https://github.com/syohex/emacs-git-gutter
;; Version: 0.78
;; Package-Version: 20160409.713
;; Version: 0.87
;; Package-Requires: ((cl-lib "0.5") (emacs "24"))
;; This program is free software; you can redistribute it and/or modify
@ -37,127 +38,117 @@
"Character width of gutter window. Emacs mistakes width of some characters.
It is better to explicitly assign width to this variable, if you use full-width
character for signs of changes"
:type 'integer
:group 'git-gutter)
:type 'integer)
(defcustom git-gutter:diff-option ""
"Option of 'git diff'"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:subversion-diff-option ""
"Option of 'svn diff'"
:type 'string)
(defcustom git-gutter:mercurial-diff-option ""
"Option of 'hg diff'"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:bazaar-diff-option ""
"Option of 'bzr diff'"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:update-commands
'(ido-switch-buffer helm-buffers-list)
"Each command of this list is executed, gutter information is updated."
:type '(list (function :tag "Update command")
(repeat :inline t (function :tag "Update command")))
:group 'git-gutter)
(repeat :inline t (function :tag "Update command"))))
(defcustom git-gutter:update-windows-commands
'(kill-buffer ido-kill-buffer)
"Each command of this list is executed, gutter information is updated and
gutter information of other windows."
:type '(list (function :tag "Update command")
(repeat :inline t (function :tag "Update command")))
:group 'git-gutter)
(repeat :inline t (function :tag "Update command"))))
(defcustom git-gutter:update-hooks
'(after-save-hook after-revert-hook find-file-hook after-change-major-mode-hook
text-scale-mode-hook magit-revert-buffer-hook)
text-scale-mode-hook)
"hook points of updating gutter"
:type '(list (hook :tag "HookPoint")
(repeat :inline t (hook :tag "HookPoint")))
:group 'git-gutter)
(repeat :inline t (hook :tag "HookPoint"))))
(defcustom git-gutter:always-show-separator nil
"Show separator even if there are no changes."
:type 'boolean)
(defcustom git-gutter:separator-sign nil
"Separator sign"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:modified-sign "="
"Modified sign"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:added-sign "+"
"Added sign"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:deleted-sign "-"
"Deleted sign"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:unchanged-sign nil
"Unchanged sign"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:hide-gutter nil
"Hide gutter if there are no changes"
:type 'boolean
:group 'git-gutter)
:type 'boolean)
(defcustom git-gutter:lighter " GitGutter"
"Minor mode lighter in mode-line"
:type 'string
:group 'git-gutter)
:type 'string)
(defcustom git-gutter:verbosity 0
"Log/message level. 4 means all, 0 nothing."
:type 'integer
:group 'git-gutter)
:type 'integer)
(defcustom git-gutter:visual-line nil
"Show sign at gutter by visual line."
:type 'boolean)
(defface git-gutter:separator
'((t (:foreground "cyan" :weight bold)))
"Face of separator"
:group 'git-gutter)
'((t (:foreground "cyan" :weight bold :inherit default)))
"Face of separator")
(defface git-gutter:modified
'((t (:foreground "magenta" :weight bold)))
"Face of modified"
:group 'git-gutter)
'((t (:foreground "magenta" :weight bold :inherit default)))
"Face of modified")
(defface git-gutter:added
'((t (:foreground "green" :weight bold)))
"Face of added"
:group 'git-gutter)
'((t (:foreground "green" :weight bold :inherit default)))
"Face of added")
(defface git-gutter:deleted
'((t (:foreground "red" :weight bold)))
"Face of deleted"
:group 'git-gutter)
"Face of deleted")
(defface git-gutter:unchanged
'((t (:background "yellow")))
"Face of unchanged"
:group 'git-gutter)
"Face of unchanged")
(defcustom git-gutter:disabled-modes nil
"A list of modes which `global-git-gutter-mode' should be disabled."
:type '(repeat symbol)
:group 'git-gutter)
:type '(repeat symbol))
(defcustom git-gutter:handled-backends '(git hg)
(defcustom git-gutter:handled-backends '(git)
"List of version control backends for which `git-gutter.el` will be used.
`git', `hg', and `bzr' are supported."
:type '(repeat symbol)
:group 'git-gutter)
`git', `svn', `hg', and `bzr' are supported."
:type '(repeat symbol))
(defvar git-gutter:view-diff-function 'git-gutter:view-diff-infos
(defvar git-gutter:view-diff-function #'git-gutter:view-diff-infos
"Function of viewing changes")
(defvar git-gutter:clear-function 'git-gutter:clear-diff-infos
(defvar git-gutter:clear-function #'git-gutter:clear-diff-infos
"Function of clear changes")
(defvar git-gutter:init-function 'nil
@ -165,17 +156,21 @@ gutter information of other windows."
(defcustom git-gutter-mode-on-hook nil
"Hook run when git-gutter mode enable"
:type 'hook
:group 'git-gutter)
:type 'hook)
(defcustom git-gutter-mode-off-hook nil
"Hook run when git-gutter mode disable"
:type 'hook
:group 'git-gutter)
:type 'hook)
(defcustom git-gutter:update-interval 0
"Time interval in seconds for updating diff information."
:type 'integer)
(defcustom git-gutter:ask-p t
"Ask whether commit/revert or not"
:type 'boolean)
(defvar git-gutter:enabled nil)
(defvar git-gutter:toggle-flag t)
(defvar git-gutter:force nil)
(defvar git-gutter:diffinfos nil)
(defvar git-gutter:has-indirect-buffers nil)
(defvar git-gutter:real-this-command nil)
@ -184,6 +179,8 @@ gutter information of other windows."
(defvar git-gutter:vcs-type nil)
(defvar git-gutter:start-revision nil)
(defvar git-gutter:revision-history nil)
(defvar git-gutter:update-timer nil)
(defvar git-gutter:last-sha1 nil)
(defvar git-gutter:popup-buffer "*git-gutter:diff*")
(defvar git-gutter:ignore-commands
@ -200,7 +197,7 @@ gutter information of other windows."
(when it ,@body)))
(defsubst git-gutter:execute-command (cmd output &rest args)
(apply 'process-file cmd nil output nil args))
(apply #'process-file cmd nil output nil args))
(defun git-gutter:in-git-repository-p ()
(when (executable-find "git")
@ -210,28 +207,22 @@ gutter information of other windows."
(string= "true" (buffer-substring-no-properties
(point) (line-end-position)))))))
(defun git-gutter:in-hg-repository-p ()
(and (executable-find "hg")
(locate-dominating-file default-directory ".hg")
(zerop (git-gutter:execute-command "hg" nil "root"))
(not (string-match-p "/\.hg/" default-directory))))
(defun git-gutter:in-bzr-repository-p ()
(and (executable-find "bzr")
(locate-dominating-file default-directory ".bzr")
(zerop (git-gutter:execute-command "bzr" nil "root"))
(not (string-match-p "/\.bzr/" default-directory))))
(defun git-gutter:in-repository-common-p (cmd check-subcmd repodir)
(and (executable-find cmd)
(locate-dominating-file default-directory repodir)
(zerop (apply #'git-gutter:execute-command cmd nil check-subcmd))
(not (string-match-p (regexp-quote (concat "/" repodir "/")) default-directory))))
(defsubst git-gutter:vcs-check-function (vcs)
(cl-case vcs
(git 'git-gutter:in-git-repository-p)
(hg 'git-gutter:in-hg-repository-p)
(bzr 'git-gutter:in-bzr-repository-p)))
(git (git-gutter:in-git-repository-p))
(svn (git-gutter:in-repository-common-p "svn" '("info") ".svn"))
(hg (git-gutter:in-repository-common-p "hg" '("root") ".hg"))
(bzr (git-gutter:in-repository-common-p "bzr" '("root") ".bzr"))))
(defsubst git-gutter:in-repository-p ()
(cl-loop for vcs in git-gutter:handled-backends
for check-func = (git-gutter:vcs-check-function vcs)
when (funcall check-func)
when (git-gutter:vcs-check-function vcs)
return (set (make-local-variable 'git-gutter:vcs-type) vcs)))
(defsubst git-gutter:changes-to-number (str)
@ -255,26 +246,26 @@ gutter information of other windows."
(goto-char (point-max)))
(buffer-substring curpoint (point)))))
(defun git-gutter:process-diff-output (proc)
(when (buffer-live-p (process-buffer proc))
(let ((regexp "^@@ -\\(?:[0-9]+\\),?\\([0-9]*\\) \\+\\([0-9]+\\),?\\([0-9]*\\) @@"))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(cl-loop while (re-search-forward regexp nil t)
for new-line = (string-to-number (match-string 2))
for orig-changes = (git-gutter:changes-to-number (match-string 1))
for new-changes = (git-gutter:changes-to-number (match-string 3))
for type = (cond ((zerop orig-changes) 'added)
((zerop new-changes) 'deleted)
(t 'modified))
for end-line = (if (eq type 'deleted)
new-line
(1- (+ new-line new-changes)))
for content = (git-gutter:diff-content)
collect
(let ((start (if (zerop new-line) 1 new-line))
(end (if (zerop end-line) 1 end-line)))
(git-gutter:make-diffinfo type content start end)))))))
(defun git-gutter:process-diff-output (buf)
(when (buffer-live-p buf)
(with-current-buffer buf
(goto-char (point-min))
(cl-loop with regexp = "^@@ -\\(?:[0-9]+\\),?\\([0-9]*\\) \\+\\([0-9]+\\),?\\([0-9]*\\) @@"
while (re-search-forward regexp nil t)
for new-line = (string-to-number (match-string 2))
for orig-changes = (git-gutter:changes-to-number (match-string 1))
for new-changes = (git-gutter:changes-to-number (match-string 3))
for type = (cond ((zerop orig-changes) 'added)
((zerop new-changes) 'deleted)
(t 'modified))
for end-line = (if (eq type 'deleted)
new-line
(1- (+ new-line new-changes)))
for content = (git-gutter:diff-content)
collect
(let ((start (if (zerop new-line) 1 new-line))
(end (if (zerop end-line) 1 end-line)))
(git-gutter:make-diffinfo type content start end))))))
(defsubst git-gutter:window-margin ()
(or git-gutter:window-width (git-gutter:longest-sign-width)))
@ -297,10 +288,25 @@ gutter information of other windows."
(defun git-gutter:start-git-diff-process (file proc-buf)
(let ((arg (git-gutter:git-diff-arguments file)))
(apply 'start-file-process "git-gutter" proc-buf
"git" "--no-pager" "diff" "--no-color" "--no-ext-diff" "--relative" "-U0"
(apply #'start-file-process "git-gutter" proc-buf
"git" "--no-pager" "-c" "diff.autorefreshindex=0"
"diff" "--no-color" "--no-ext-diff" "--relative" "-U0"
arg)))
(defun git-gutter:svn-diff-arguments (file)
(let (args)
(unless (string= git-gutter:subversion-diff-option "")
(setq args (nreverse (split-string git-gutter:subversion-diff-option))))
(when (git-gutter:revision-set-p)
(push "-r" args)
(push git-gutter:start-revision args))
(nreverse (cons file args))))
(defsubst git-gutter:start-svn-diff-process (file proc-buf)
(let ((args (git-gutter:svn-diff-arguments file)))
(apply #'start-file-process "git-gutter" proc-buf "svn" "diff" "--diff-cmd"
"diff" "-x" "-U0" args)))
(defun git-gutter:hg-diff-arguments (file)
(let (args)
(unless (string= git-gutter:mercurial-diff-option "")
@ -312,7 +318,7 @@ gutter information of other windows."
(defsubst git-gutter:start-hg-diff-process (file proc-buf)
(let ((args (git-gutter:hg-diff-arguments file)))
(apply 'start-file-process "git-gutter" proc-buf "hg" "diff" "-U0" args)))
(apply #'start-file-process "git-gutter" proc-buf "hg" "diff" "-U0" args)))
(defun git-gutter:bzr-diff-arguments (file)
(let (args)
@ -325,12 +331,13 @@ gutter information of other windows."
(defsubst git-gutter:start-bzr-diff-process (file proc-buf)
(let ((args (git-gutter:bzr-diff-arguments file)))
(apply 'start-file-process "git-gutter" proc-buf
(apply #'start-file-process "git-gutter" proc-buf
"bzr" "diff" "--context=0" args)))
(defun git-gutter:start-diff-process1 (file proc-buf)
(cl-case git-gutter:vcs-type
(git (git-gutter:start-git-diff-process file proc-buf))
(svn (git-gutter:start-svn-diff-process file proc-buf))
(hg (git-gutter:start-hg-diff-process file proc-buf))
(bzr (git-gutter:start-bzr-diff-process file proc-buf))))
@ -345,7 +352,7 @@ gutter information of other windows."
(lambda (proc _event)
(when (eq (process-status proc) 'exit)
(setq git-gutter:enabled nil)
(let ((diffinfos (git-gutter:process-diff-output proc)))
(let ((diffinfos (git-gutter:process-diff-output (process-buffer proc))))
(when (buffer-live-p curbuf)
(with-current-buffer curbuf
(git-gutter:update-diffinfo diffinfos)
@ -384,20 +391,23 @@ gutter information of other windows."
when (overlay-get ov 'linum-str)
return ov))
(defun git-gutter:view-at-pos-linum (sign pos)
(git-gutter:awhen (git-gutter:linum-get-overlay pos)
(overlay-put it 'before-string
(propertize " "
'display
`((margin left-margin)
,(concat sign (overlay-get it 'linum-str)))))))
(defun git-gutter:put-signs-linum (sign points)
(dolist (pos points)
(git-gutter:awhen (git-gutter:linum-get-overlay pos)
(overlay-put it 'before-string
(propertize " "
'display
`((margin left-margin)
,(concat sign (overlay-get it 'linum-str))))))))
(defun git-gutter:view-at-pos (sign pos)
(defun git-gutter:put-signs (sign points)
(if git-gutter:linum-enabled
(git-gutter:view-at-pos-linum sign pos)
(let ((ov (make-overlay pos pos)))
(overlay-put ov 'before-string (git-gutter:before-string sign))
(overlay-put ov 'git-gutter t))))
(git-gutter:put-signs-linum sign points)
(dolist (pos points)
(let ((ov (make-overlay pos pos))
(gutter-sign (git-gutter:before-string sign)))
(overlay-put ov 'before-string gutter-sign)
(overlay-put ov 'git-gutter t)))))
(defsubst git-gutter:sign-width (sign)
(cl-loop for s across sign
@ -409,19 +419,29 @@ gutter information of other windows."
git-gutter:deleted-sign)))
(when git-gutter:unchanged-sign
(push git-gutter:unchanged-sign signs))
(+ (apply 'max (mapcar 'git-gutter:sign-width signs))
(+ (apply #'max (mapcar 'git-gutter:sign-width signs))
(git-gutter:sign-width git-gutter:separator-sign))))
(defun git-gutter:next-visual-line (arg)
(let ((line-move-visual t))
(with-no-warnings
(next-line arg))))
(defun git-gutter:view-for-unchanged ()
(save-excursion
(let ((sign (if git-gutter:unchanged-sign
(propertize git-gutter:unchanged-sign
'face 'git-gutter:unchanged)
" ")))
" "))
(move-fn (if git-gutter:visual-line
#'git-gutter:next-visual-line
#'forward-line))
points)
(goto-char (point-min))
(while (not (eobp))
(git-gutter:view-at-pos sign (point))
(forward-line 1)))))
(push (point) points)
(funcall move-fn 1))
(git-gutter:put-signs sign points))))
(defsubst git-gutter:check-file-and-directory ()
(and (git-gutter:base-file)
@ -463,15 +483,17 @@ gutter information of other windows."
(defsubst git-gutter:linum-padding ()
(cl-loop repeat (git-gutter:window-margin)
collect " " into paddings
finally return (apply 'concat paddings)))
finally return (apply #'concat paddings)))
(defun git-gutter:linum-prepend-spaces ()
(save-excursion
(goto-char (point-min))
(let ((padding (git-gutter:linum-padding)))
(let ((padding (git-gutter:linum-padding))
points)
(while (not (eobp))
(git-gutter:view-at-pos-linum padding (point))
(forward-line 1)))))
(push (point) points)
(forward-line 1))
(git-gutter:put-signs-linum padding points))))
(defun git-gutter:linum-update (diffinfos)
(let ((linum-width (car (window-margins))))
@ -500,10 +522,14 @@ gutter information of other windows."
(car (window-margins)))))
(set-window-margins curwin margin (cdr (window-margins curwin)))))))
(defun git-gutter:show-backends ()
(mapconcat (lambda (backend)
(capitalize (symbol-name backend)))
git-gutter:handled-backends "/"))
;;;###autoload
(define-minor-mode git-gutter-mode
"Git-Gutter mode"
:group 'git-gutter
:init-value nil
:global nil
:lighter git-gutter:lighter
@ -515,7 +541,6 @@ gutter information of other windows."
(funcall git-gutter:init-function))
(make-local-variable 'git-gutter:enabled)
(set (make-local-variable 'git-gutter:has-indirect-buffers) nil)
(set (make-local-variable 'git-gutter:toggle-flag) t)
(make-local-variable 'git-gutter:diffinfos)
(set (make-local-variable 'git-gutter:start-revision) nil)
(add-hook 'kill-buffer-hook 'git-gutter:kill-buffer-hook nil t)
@ -523,16 +548,19 @@ gutter information of other windows."
(add-hook 'post-command-hook 'git-gutter:post-command-hook nil t)
(dolist (hook git-gutter:update-hooks)
(add-hook hook 'git-gutter nil t))
(git-gutter))
(git-gutter)
(when (and (not git-gutter:update-timer) (> git-gutter:update-interval 0))
(setq git-gutter:update-timer
(run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update))))
(when (> git-gutter:verbosity 2)
(message "Here is not Git/Mercurial work tree"))
(message "Here is not %s work tree" (git-gutter:show-backends)))
(git-gutter-mode -1))
(remove-hook 'kill-buffer-hook 'git-gutter:kill-buffer-hook t)
(remove-hook 'pre-command-hook 'git-gutter:pre-command-hook)
(remove-hook 'post-command-hook 'git-gutter:post-command-hook t)
(dolist (hook git-gutter:update-hooks)
(remove-hook hook 'git-gutter t))
(git-gutter:clear)))
(git-gutter:clear-gutter)))
(defun git-gutter--turn-on ()
(when (and (buffer-file-name)
@ -540,8 +568,7 @@ gutter information of other windows."
(git-gutter-mode +1)))
;;;###autoload
(define-global-minor-mode global-git-gutter-mode git-gutter-mode git-gutter--turn-on
:group 'git-gutter)
(define-global-minor-mode global-git-gutter-mode git-gutter-mode git-gutter--turn-on)
(defsubst git-gutter:show-gutter-p (diffinfos)
(if git-gutter:hide-gutter
@ -553,49 +580,57 @@ gutter information of other windows."
(git-gutter:set-window-margin (git-gutter:window-margin))))
(defun git-gutter:view-set-overlays (diffinfos)
(when (or git-gutter:unchanged-sign git-gutter:separator-sign)
(git-gutter:view-for-unchanged))
(save-excursion
(goto-char (point-min))
(cl-loop with curline = 1
with move-fn = (if git-gutter:visual-line
#'git-gutter:next-visual-line
#'forward-line)
for info in diffinfos
for start-line = (plist-get info :start-line)
for end-line = (plist-get info :end-line)
for type = (plist-get info :type)
for sign = (git-gutter:propertized-sign type)
for points = nil
do
(progn
(forward-line (- start-line curline))
(let ((bound (progn
(forward-line (- end-line curline))
(point))))
(forward-line (- start-line end-line))
(cl-case type
((modified added)
(setq curline start-line)
(while (and (<= curline end-line) (not (eobp)))
(git-gutter:view-at-pos sign (point))
(cl-incf curline)
(forward-line 1)))
(while (and (<= (point) bound) (not (eobp)))
(push (point) points)
(funcall move-fn 1))
(git-gutter:put-signs sign points))
(deleted
(git-gutter:view-at-pos sign (point))
(forward-line 1)
(setq curline (1+ end-line))))))))
(git-gutter:put-signs sign (list (point)))
(forward-line 1)))
(setq curline (1+ end-line))))))
(defun git-gutter:view-diff-infos (diffinfos)
(when diffinfos
(when (or git-gutter:unchanged-sign git-gutter:separator-sign)
(git-gutter:view-for-unchanged))
(when (or diffinfos git-gutter:always-show-separator)
(git-gutter:view-set-overlays diffinfos))
(git-gutter:show-gutter diffinfos))
(defsubst git-gutter:reset-window-margin-p ()
(or git-gutter:force
git-gutter:hide-gutter
(not global-git-gutter-mode)))
(or git-gutter:hide-gutter (not global-git-gutter-mode)))
(defun git-gutter:clear-diff-infos ()
(when (git-gutter:reset-window-margin-p)
(git-gutter:set-window-margin 0))
(remove-overlays (point-min) (point-max) 'git-gutter t))
(defsubst git-gutter:clear-gutter ()
(when git-gutter:clear-function
(funcall git-gutter:clear-function)))
(defun git-gutter:clear-gutter ()
(save-restriction
(widen)
(when git-gutter:clear-function
(funcall git-gutter:clear-function)))
(setq git-gutter:enabled nil
git-gutter:diffinfos nil))
(defun git-gutter:update-diffinfo (diffinfos)
(save-restriction
@ -607,7 +642,7 @@ gutter information of other windows."
(defun git-gutter:search-near-diff-index (diffinfos is-reverse)
(cl-loop with current-line = (line-number-at-pos)
with cmp-fn = (if is-reverse '> '<)
with cmp-fn = (if is-reverse #'> #'<)
for diffinfo in (if is-reverse (reverse diffinfos) diffinfos)
for index = 0 then (1+ index)
for start-line = (plist-get diffinfo :start-line)
@ -617,12 +652,15 @@ gutter information of other windows."
index)))
(defun git-gutter:search-here-diffinfo (diffinfos)
(cl-loop with current-line = (line-number-at-pos)
for diffinfo in diffinfos
for start = (plist-get diffinfo :start-line)
for end = (or (plist-get diffinfo :end-line) (1+ start))
when (and (>= current-line start) (<= current-line end))
return diffinfo))
(save-restriction
(widen)
(cl-loop with current-line = (line-number-at-pos)
for diffinfo in diffinfos
for start = (plist-get diffinfo :start-line)
for end = (or (plist-get diffinfo :end-line) (1+ start))
when (and (>= current-line start) (<= current-line end))
return diffinfo
finally do (error "Here is not changed!!"))))
(defun git-gutter:collect-deleted-line (str)
(with-temp-buffer
@ -662,22 +700,30 @@ gutter information of other windows."
(defsubst git-gutter:popup-buffer-window ()
(get-buffer-window (get-buffer git-gutter:popup-buffer)))
;;;###autoload
(defun git-gutter:query-action (action action-fn update-fn)
(git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos)
(save-window-excursion
(when git-gutter:ask-p
(git-gutter:popup-hunk it))
(when (or (not git-gutter:ask-p) (yes-or-no-p (format "%s current hunk ? " action)))
(funcall action-fn it)
(funcall update-fn))
(if git-gutter:ask-p
(delete-window (git-gutter:popup-buffer-window))
(message "%s current hunk." action)))))
(defun git-gutter:revert-hunk ()
"Revert current hunk."
(interactive)
(git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos)
(save-window-excursion
(git-gutter:popup-hunk it)
(when (yes-or-no-p "Revert current hunk ?")
(git-gutter:do-revert-hunk it)
(save-buffer))
(delete-window (git-gutter:popup-buffer-window)))))
(git-gutter:query-action "Revert" #'git-gutter:do-revert-hunk #'save-buffer))
(defun git-gutter:extract-hunk-header ()
(git-gutter:awhen (git-gutter:base-file)
(with-temp-buffer
(when (zerop (git-gutter:execute-command "git" t "diff" "--relative" it))
(when (zerop (git-gutter:execute-command
"git" t "--no-pager" "-c" "diff.autorefreshindex=0"
"diff" "--no-color" "--no-ext-diff"
"--relative" (file-name-nondirectory it)))
(goto-char (point-min))
(forward-line 4)
(buffer-substring-no-properties (point-min) (point))))))
@ -724,23 +770,30 @@ gutter information of other windows."
(options (list "--cached" patch)))
(when dir-option
(setq options (cons "--directory" (cons dir-option options))))
(unless (zerop (apply 'git-gutter:execute-command
(unless (zerop (apply #'git-gutter:execute-command
"git" nil "apply" "--unidiff-zero"
options))
(message "Failed: stating this hunk"))
(delete-file patch)))))
;;;###autoload
(defun git-gutter:stage-hunk ()
"Stage this hunk like 'git add -p'."
(interactive)
(git-gutter:query-action "Stage" #'git-gutter:do-stage-hunk #'git-gutter))
(defsubst git-gutter:line-point (line)
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(point)))
(defun git-gutter:mark-hunk ()
(interactive)
(git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos)
(save-window-excursion
(git-gutter:popup-hunk it)
(when (yes-or-no-p "Stage current hunk ?")
(git-gutter:do-stage-hunk it)
(git-gutter))
(delete-window (git-gutter:popup-buffer-window)))))
(let ((start (git-gutter:line-point (plist-get it :start-line)))
(end (git-gutter:line-point (1+ (plist-get it :end-line)))))
(goto-char start)
(push-mark end nil t))))
(defun git-gutter:update-popuped-buffer (diffinfo)
(with-current-buffer (get-buffer-create git-gutter:popup-buffer)
@ -754,7 +807,6 @@ gutter information of other windows."
(view-mode +1)
(current-buffer)))
;;;###autoload
(defun git-gutter:popup-hunk (&optional diffinfo)
"Popup current diff hunk."
(interactive)
@ -763,7 +815,6 @@ gutter information of other windows."
(save-selected-window
(pop-to-buffer (git-gutter:update-popuped-buffer it)))))
;;;###autoload
(defun git-gutter:next-hunk (arg)
"Move to next diff hunk"
(interactive "p")
@ -781,10 +832,11 @@ gutter information of other windows."
(diffinfo (nth real-index diffinfos)))
(goto-char (point-min))
(forward-line (1- (plist-get diffinfo :start-line)))
(when (> git-gutter:verbosity 0)
(message "Move to %d/%d hunk" (1+ real-index) len))
(when (buffer-live-p (get-buffer git-gutter:popup-buffer))
(git-gutter:update-popuped-buffer diffinfo)))))
;;;###autoload
(defun git-gutter:previous-hunk (arg)
"Move to previous diff hunk"
(interactive "p")
@ -811,7 +863,7 @@ gutter information of other windows."
(defun git-gutter ()
"Show diff information in gutter"
(interactive)
(when (or git-gutter:force git-gutter:toggle-flag)
(when (or git-gutter:vcs-type (git-gutter:in-repository-p))
(let* ((file (git-gutter:base-file))
(proc-buf (git-gutter:diff-process-buffer file)))
(when (and (called-interactively-p 'interactive) (get-buffer proc-buf))
@ -828,6 +880,10 @@ gutter information of other windows."
(when git-gutter-mode
(run-with-idle-timer 0.1 nil 'git-gutter)))
(defadvice toggle-truncate-lines (after git-gutter:toggle-truncate-lines activate)
(when (and git-gutter-mode git-gutter:visual-line)
(run-with-idle-timer 0.1 nil 'git-gutter)))
;; `quit-window' and `switch-to-buffer' are called from other
;; commands. So we should use `defadvice' instead of `post-command-hook'.
(defadvice quit-window (after git-gutter:quit-window activate)
@ -838,41 +894,32 @@ gutter information of other windows."
(when git-gutter-mode
(git-gutter)))
;;;###autoload
(defun git-gutter:clear ()
"Clear diff information in gutter."
(interactive)
(save-restriction
(widen)
(git-gutter:clear-gutter))
(setq git-gutter:enabled nil
git-gutter:diffinfos nil))
(git-gutter-mode -1))
(make-obsolete 'git-gutter:clear #'git-gutter-mode "0.86")
;;;###autoload
(defun git-gutter:toggle ()
"Toggle to show diff information."
(interactive)
(let ((git-gutter:force t))
(if git-gutter:enabled
(progn
(git-gutter:clear)
(setq git-gutter-mode nil
git-gutter:toggle-flag nil))
(git-gutter)
(setq git-gutter-mode t
git-gutter:toggle-flag t))
(force-mode-line-update)))
(if git-gutter-mode
(git-gutter-mode -1)
(git-gutter-mode +1)))
(make-obsolete 'git-gutter:toggle #'git-gutter-mode "0.86")
(defun git-gutter:revision-valid-p (revision)
(zerop (cl-case git-gutter:vcs-type
(git (git-gutter:execute-command "git" nil
"rev-parse" "--quiet" "--verify"
revision))
(svn (git-gutter:execute-command "svn" nil "info" "-r" revision
(file-relative-name (buffer-file-name))))
(hg (git-gutter:execute-command "hg" nil "id" "-r" revision))
(bzr (git-gutter:execute-command "bzr" nil
"revno" "-r" revision)))))
;;;###autoload
(defun git-gutter:set-start-revision (start-rev)
"Set start revision. If `start-rev' is nil or empty string then reset
start revision."
@ -885,9 +932,8 @@ start revision."
(setq git-gutter:start-revision start-rev)
(git-gutter))
;;;###autoload
(defun git-gutter:update-all-windows ()
"Update git-gutter informations for all visible buffers."
"Update git-gutter information for all visible buffers."
(interactive)
(dolist (win (window-list))
(let ((buf (window-buffer win)))
@ -895,10 +941,124 @@ start revision."
(when git-gutter-mode
(git-gutter))))))
(defun git-gutter:start-update-timer ()
(interactive)
(when git-gutter:update-timer
(error "Update timer is already running."))
(setq git-gutter:update-timer
(run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update)))
(defun git-gutter:cancel-update-timer ()
(interactive)
(unless git-gutter:update-timer
(error "Timer is no running."))
(cancel-timer git-gutter:update-timer)
(setq git-gutter:update-timer nil))
(defsubst git-gutter:write-current-content (tmpfile)
(let ((content (buffer-substring-no-properties (point-min) (point-max))))
(with-temp-file tmpfile
(insert content))))
(defsubst git-gutter:original-file-content (file)
(with-temp-buffer
(when (zerop (process-file "git" nil t nil "show" (concat ":" file)))
(buffer-substring-no-properties (point-min) (point-max)))))
(defun git-gutter:write-original-content (tmpfile filename)
(git-gutter:awhen (git-gutter:original-file-content filename)
(with-temp-file tmpfile
(insert it)
t)))
(defsubst git-gutter:start-raw-diff-process (proc-buf original now)
(start-file-process "git-gutter:update-timer" proc-buf
"diff" "-U0" original now))
(defun git-gutter:start-live-update (file original now)
(let ((proc-bufname (git-gutter:diff-process-buffer file)))
(when (get-buffer proc-bufname)
(kill-buffer proc-bufname))
(let* ((curbuf (current-buffer))
(proc-buf (get-buffer-create proc-bufname))
(process (git-gutter:start-raw-diff-process proc-buf original now)))
(set-process-query-on-exit-flag process nil)
(set-process-sentinel
process
(lambda (proc _event)
(when (eq (process-status proc) 'exit)
(setq git-gutter:enabled nil)
(let ((diffinfos (git-gutter:process-diff-output (process-buffer proc))))
(when (buffer-live-p curbuf)
(with-current-buffer curbuf
(git-gutter:update-diffinfo diffinfos)
(setq git-gutter:enabled t)))
(kill-buffer proc-buf)
(delete-file original)
(delete-file now))))))))
(defun git-gutter:should-update-p ()
(let ((sha1 (secure-hash 'sha1 (current-buffer))))
(unless (equal sha1 git-gutter:last-sha1)
(setq git-gutter:last-sha1 sha1))))
(defun git-gutter:live-update ()
(git-gutter:awhen (git-gutter:base-file)
(when (and git-gutter:enabled
(buffer-modified-p)
(git-gutter:should-update-p))
(let ((file (file-name-nondirectory it))
(now (make-temp-file "git-gutter-cur"))
(original (make-temp-file "git-gutter-orig")))
(when (git-gutter:write-original-content original file)
(git-gutter:write-current-content now)
(git-gutter:start-live-update file original now))))))
;; for linum-user
(when (and global-linum-mode (not (boundp 'git-gutter-fringe)))
(git-gutter:linum-setup))
(defun git-gutter:all-hunks ()
"Cound unstaged hunks in all buffers"
(let ((sum 0))
(dolist (buf (buffer-list))
(with-current-buffer buf
(when git-gutter-mode
(cl-incf sum (git-gutter:buffer-hunks)))))
sum))
(defun git-gutter:buffer-hunks ()
"Count unstaged hunks in current buffer."
(length git-gutter:diffinfos))
(defun git-gutter:stat-hunk (hunk)
(cl-case (plist-get hunk :type)
(modified (with-temp-buffer
(insert (plist-get hunk :content))
(goto-char (point-min))
(let ((added 0)
(deleted 0))
(while (not (eobp))
(cond ((looking-at-p "\\+") (cl-incf added))
((looking-at-p "\\-") (cl-incf deleted)))
(forward-line 1))
(cons added deleted))))
(added (cons (- (plist-get hunk :end-line) (plist-get hunk :start-line)) 0))
(deleted (cons 0 (- (plist-get hunk :end-line) (plist-get hunk :start-line))))))
(defun git-gutter:statistic ()
"Return statistic unstaged hunks in current buffer."
(interactive)
(cl-loop for hunk in git-gutter:diffinfos
for (add . del) = (git-gutter:stat-hunk hunk)
sum add into added
sum del into deleted
finally
return (progn
(when (called-interactively-p 'interactive)
(message "Added %d lines, Deleted %d lines" added deleted))
(cons added deleted))))
(provide 'git-gutter)
;;; git-gutter.el ends here

View File

@ -1 +0,0 @@
(define-package "gitconfig-mode" "0.3" "Major mode for editing .gitconfig files" 'nil)

View File

@ -1,105 +0,0 @@
;;; gitconfig-mode.el --- Major mode for editing .gitconfig files -*- lexical-binding: t; -*-
;; Copyright (c) 2012, 2013 Sebastian Wiesner <lunaryorn@gmail.com>
;;
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; URL: https://github.com/lunaryorn/git-modes
;; Version: 0.3
;; Keywords: convenience vc git
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free Software
;; Foundation; either version 2 of the License, or (at your option) any later
;; version.
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;; You should have received a copy of the GNU General Public License along with
;; this program; if not, write to the Free Software Foundation, Inc., 51
;; Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; A major mode for editing .gitconfig files.
;;; Code:
(require 'conf-mode)
(defun gitconfig-line-indented-p ()
"Determine whether the current line is indented correctly.
Return t if so, or nil otherwise."
(save-excursion
(beginning-of-line)
(or (looking-at "^\\[\\_<.*?\\]")
(looking-at "^\t\\_<\\(?:\\sw|\\s_\\)"))))
(defun gitconfig-point-in-indentation-p ()
"Determine whether the point is in the indentation of the current line.
Return t if so, or nil otherwise."
(save-excursion
(let ((pos (point)))
(back-to-indentation)
(< pos (point)))))
(defun gitconfig-indent-line ()
"Indent the current line."
(interactive)
(unless (gitconfig-line-indented-p)
(let ((old-point (point-marker))
(was-in-indent (gitconfig-point-in-indentation-p)))
(beginning-of-line)
(delete-horizontal-space)
(unless (= (char-after) ?\[)
(insert-char ?\t 1))
(if was-in-indent
(back-to-indentation)
(goto-char (marker-position old-point))))))
(defvar gitconfig-mode-syntax-table
(let ((table (make-syntax-table conf-unix-mode-syntax-table)))
;; ; is a comment in .gitconfig
(modify-syntax-entry ?\; "<" table)
table)
"Syntax table to use in .gitconfig buffers.")
(defvar gitconfig-mode-font-lock-keywords
`(
;; Highlight section and subsection gitconfig headers, and override
;; syntactic fontification in these.
("^\\s-*\\[\\_<\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>\\(?:\\s-+\\(\\s\".+?\\s\"\\)\\)?\\]\\s-*"
(1 'font-lock-type-face t nil)
(2 'font-lock-function-name-face t t))
("^\\s-*\\_<\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>\\s-*\\(?:=.*\\)?$"
(1 'font-lock-variable-name-face))
;; Highlight booleans and numbers
(,(format "=\\s-*%s\\s-*$"
(regexp-opt '("yes" "no" "true" "false" "on" "off") 'words))
(1 'font-lock-keyword-face))
("=\\s-*\\<\\([0-9]+\\)\\>\\s-*$" (1 'font-lock-constant-face))))
;;;###autoload
(define-derived-mode gitconfig-mode conf-unix-mode "Gitconfig"
"A major mode for editing .gitconfig files."
;; .gitconfig is indented with tabs only
(conf-mode-initialize "#" gitconfig-mode-font-lock-keywords)
(setq indent-tabs-mode t)
(set (make-local-variable 'indent-line-function)
'gitconfig-indent-line))
;;;###autoload
(setq auto-mode-alist
(append '(("/\\.gitconfig\\'" . gitconfig-mode)
("/\\.git/config\\'" . gitconfig-mode))
auto-mode-alist))
(provide 'gitconfig-mode)
;;; gitconfig-mode.el ends here

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gitconfig-mode" "gitconfig-mode.el" (21633
;;;;;; 45695 432043 861000))
;;;### (autoloads nil "gitconfig-mode" "gitconfig-mode.el" (22297
;;;;;; 19828 264884 774000))
;;; Generated autoloads from gitconfig-mode.el
(autoload 'gitconfig-mode "gitconfig-mode" "\
@ -12,7 +12,7 @@ A major mode for editing .gitconfig files.
\(fn)" t nil)
(setq auto-mode-alist (append '(("/\\.gitconfig\\'" . gitconfig-mode) ("/\\.git/config\\'" . gitconfig-mode)) auto-mode-alist))
(dolist (pattern '("/\\.gitconfig\\'" "/\\.git/config\\'" "/modules/.*/config\\'" "/git/config\\'" "/\\.gitmodules\\'" "/etc/gitconfig\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitconfig-mode)))
;;;***

View File

@ -0,0 +1 @@
(define-package "gitconfig-mode" "20160319.302" "Major mode for editing .gitconfig files" 'nil :url "https://github.com/magit/git-modes" :keywords '("convenience" "vc" "git"))

View File

@ -0,0 +1,137 @@
;;; gitconfig-mode.el --- Major mode for editing .gitconfig files -*- lexical-binding: t; -*-
;; Copyright (c) 2012-2013 Sebastian Wiesner
;; Copyright (C) 2012-2016 The Magit Project Contributors
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/git-modes
;; Keywords: convenience vc git
;; Package-Version: 20160319.302
;; This file is not part of GNU Emacs.
;; This file 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.
;; This file 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 file. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A major mode for editing .gitconfig files.
;;; Code:
(require 'rx)
(require 'conf-mode)
(defun gitconfig-line-indented-p ()
"Return t if the current line is indented correctly."
(save-excursion
(beginning-of-line)
(or (looking-at (rx line-start "["
symbol-start
(minimal-match (zero-or-more not-newline))
symbol-end "]"))
(looking-at (concat (rx line-start)
(gitconfig-indentation-string)
(rx symbol-start (or (syntax word)
(syntax symbol)))))
(looking-at (rx (zero-or-one "\t") (or "#" ";"))))))
(defun gitconfig-point-in-indentation-p ()
"Return if the point is in the indentation of the current line."
(save-excursion
(let ((pos (point)))
(back-to-indentation)
(<= pos (point)))))
(defun gitconfig-indent-line ()
"Indent the current line."
(interactive)
(if (gitconfig-line-indented-p)
(when (gitconfig-point-in-indentation-p)
(back-to-indentation))
(let ((old-point (point-marker))
(was-in-indent (gitconfig-point-in-indentation-p)))
(beginning-of-line)
(delete-horizontal-space)
(unless (equal (char-after) ?\[)
(insert (gitconfig-indentation-string)))
(if was-in-indent
(back-to-indentation)
(goto-char (marker-position old-point)))
(set-marker old-point nil))))
(defun gitconfig-indentation-string ()
(if indent-tabs-mode "\t" (make-string tab-width ?\ )))
(defvar gitconfig-mode-syntax-table
(let ((table (make-syntax-table conf-unix-mode-syntax-table)))
;; ; is a comment in .gitconfig
(modify-syntax-entry ?\; "<" table)
;; ' is not used for string quoting
(modify-syntax-entry ?\' "." table)
table)
"Syntax table to use in .gitconfig buffers.")
(defvar gitconfig-mode-font-lock-keywords
`(
;; Highlight section and subsection gitconfig headers, and override
;; syntactic fontification in these.
(,(rx line-start (zero-or-more (syntax whitespace))
"[" symbol-start
(group (one-or-more (or (syntax word) (syntax symbol))))
symbol-end
(optional (one-or-more (syntax whitespace))
(group (syntax string-quote)
(minimal-match (one-or-more not-newline))
(syntax string-quote)))
"]" (zero-or-more (syntax whitespace)) line-end)
(1 'font-lock-type-face t nil)
(2 'font-lock-function-name-face t t))
(,(rx line-start (zero-or-more (syntax whitespace)) symbol-start
(group (one-or-more (or (syntax word) (syntax symbol))))
symbol-end (zero-or-more (syntax whitespace))
(optional "=" (zero-or-more not-newline)) line-end)
(1 'font-lock-variable-name-face))
;; Highlight booleans and numbers
(,(rx "="
(zero-or-more (syntax whitespace)) word-start
(group (or "yes" "no" "true" "false" "on" "off"))
word-end (zero-or-more (syntax whitespace)) line-end)
(1 'font-lock-keyword-face))
(,(rx "="
(zero-or-more (syntax whitespace)) word-start
(group (one-or-more digit))
word-end (zero-or-more (syntax whitespace)) line-end)
(1 'font-lock-constant-face))))
;;;###autoload
(define-derived-mode gitconfig-mode conf-unix-mode "Gitconfig"
"A major mode for editing .gitconfig files."
;; .gitconfig is indented with tabs only
(conf-mode-initialize "#" gitconfig-mode-font-lock-keywords)
(setq indent-tabs-mode t)
(set (make-local-variable 'indent-line-function)
'gitconfig-indent-line))
;;;###autoload
(dolist (pattern '("/\\.gitconfig\\'" "/\\.git/config\\'"
"/modules/.*/config\\'" "/git/config\\'"
"/\\.gitmodules\\'" "/etc/gitconfig\\'"))
(add-to-list 'auto-mode-alist (cons pattern 'gitconfig-mode)))
(provide 'gitconfig-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; gitconfig-mode.el ends here

View File

@ -1 +0,0 @@
(define-package "gitignore-mode" "1.1.0" "Major mode for editing .gitignore files" 'nil)

View File

@ -3,8 +3,8 @@
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (21831
;;;;;; 16635 816188 71000))
;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (22297
;;;;;; 19827 120905 236000))
;;; Generated autoloads from gitignore-mode.el
(autoload 'gitignore-mode "gitignore-mode" "\
@ -12,7 +12,7 @@ A major mode for editing .gitignore files.
\(fn)" t nil)
(dolist (pattern (list "/\\.gitignore\\'" "/\\.git/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
(dolist (pattern (list "/\\.gitignore\\'" "/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
;;;***

View File

@ -0,0 +1 @@
(define-package "gitignore-mode" "20160319.302" "Major mode for editing .gitignore files" 'nil :url "https://github.com/magit/git-modes" :keywords '("convenience" "vc" "git"))

View File

@ -1,13 +1,13 @@
;;; gitignore-mode.el --- Major mode for editing .gitignore files -*- lexical-binding: t; -*-
;; Copyright (c) 2012-2013 Sebastian Wiesner
;; Copyright (C) 2012-2015 The Magit Project Developers
;; Copyright (C) 2012-2016 The Magit Project Contributors
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/git-modes
;; Keywords: convenience vc git
;; Package-Version: 1.1.0
;; Package-Version: 20160319.302
;; This file is not part of GNU Emacs.
@ -50,7 +50,7 @@
;;;###autoload
(dolist (pattern (list "/\\.gitignore\\'"
"/\\.git/info/exclude\\'"
"/info/exclude\\'"
"/git/ignore\\'"))
(add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))

View File

@ -1 +0,0 @@
(define-package "go-mode" "20131222" "Major mode for the Go programming language" 'nil)

File diff suppressed because it is too large Load Diff

View File

@ -1,9 +1,10 @@
;;; go-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "go-mode" "go-mode.el" (21633 45694 92043 840000))
;;;### (autoloads nil "go-mode" "go-mode.el" (22297 19826 179922
;;;;;; 64000))
;;; Generated autoloads from go-mode.el
(autoload 'go-mode "go-mode" "\
@ -25,14 +26,22 @@ Playground (uploading and downloading pastes).
The following extra functions are defined:
- `gofmt'
- `godoc'
- `godoc' and `godoc-at-point'
- `go-import-add'
- `go-remove-unused-imports'
- `go-goto-arguments'
- `go-goto-docstring'
- `go-goto-function'
- `go-goto-function-name'
- `go-goto-imports'
- `go-goto-return-values'
- `go-goto-method-receiver'
- `go-play-buffer' and `go-play-region'
- `go-download-play'
- `godef-describe' and `godef-jump'
- `go-coverage'
- `go-set-project'
- `go-reset-gopath'
If you want to automatically run `gofmt' before saving a file,
add the following hook to your emacs configuration:
@ -49,16 +58,17 @@ for `find-tag':
Please note that godef is an external dependency. You can install
it with
go get code.google.com/p/rog-go/exp/cmd/godef
go get github.com/rogpeppe/godef
If you're looking for even more integration with Go, namely
on-the-fly syntax checking, auto-completion and snippets, it is
recommended that you look at goflymake
\(https://github.com/dougm/goflymake), gocode
\(https://github.com/nsf/gocode), go-eldoc
\(github.com/syohex/emacs-go-eldoc) and yasnippet-go
\(https://github.com/dominikh/yasnippet-go)
recommended that you look at flycheck
\(see URL `https://github.com/flycheck/flycheck') or flymake in combination
with goflymake (see URL `https://github.com/dougm/goflymake'), gocode
\(see URL `https://github.com/nsf/gocode'), go-eldoc
\(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go
\(see URL `https://github.com/dominikh/yasnippet-go')
\(fn)" t nil)
@ -74,21 +84,28 @@ you save any file, kind of defeating the point of autoloading.
\(fn)" t nil)
(autoload 'godoc "go-mode" "\
Show go documentation for a query, much like M-x man.
Show Go documentation for QUERY, much like M-x man.
\(fn QUERY)" t nil)
(autoload 'go-download-play "go-mode" "\
Downloads a paste from the playground and inserts it in a Go
buffer. Tries to look for a URL at point.
Download a paste from the playground and insert it in a Go buffer.
Tries to look for a URL at point.
\(fn URL)" t nil)
;;;***
;;;### (autoloads nil nil ("go-mode-pkg.el") (22297 19826 479482
;;;;;; 139000))
;;;***
(provide 'go-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; go-mode-autoloads.el ends here

View File

@ -0,0 +1,5 @@
(define-package "go-mode" "20160404.2" "Major mode for the Go programming language" 'nil :url "https://github.com/dominikh/go-mode.el" :keywords
'("languages" "go"))
;; Local Variables:
;; no-byte-compile: t
;; End:

File diff suppressed because it is too large Load Diff

View File

@ -1,226 +0,0 @@
;;; 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

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

View File

@ -1,186 +0,0 @@
;;; 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

Some files were not shown because too many files have changed in this diff Show More