Upgrade packages

This commit is contained in:
Gergely Polonkai 2015-05-04 11:52:24 +02:00
parent 4cef57c82e
commit a3caedf27d
91 changed files with 14707 additions and 11818 deletions

View File

@ -1,18 +0,0 @@
;;; buffer-move-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads nil nil ("buffer-move-pkg.el" "buffer-move.el")
;;;;;; (21553 16645 222241 807000))
;;;***
(provide 'buffer-move-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; buffer-move-autoloads.el ends here

View File

@ -1 +0,0 @@
(define-package "buffer-move" "0.4" "swap buffers between windows" (quote nil))

View File

@ -1,135 +0,0 @@
;;; buffer-move.el --- swap buffers between windows
;; Copyright (C) 2004 Lucas Bonnet <lukhas@free.fr>
;; Author: Lucas Bonnet <lucas@rincevent.net>
;; Keywords: lisp,convenience
;; Version: 0.4
;; URL: http://www.emacswiki.org/cgi-bin/wiki/buffer-move.el
;; 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., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Commentary:
;; This file is for lazy people wanting to swap buffers without
;; typing C-x b on each window. This is useful when you have :
;; +--------------+-------------+
;; | | |
;; | #emacs | #gnus |
;; | | |
;; +--------------+-------------+
;; | |
;; | .emacs |
;; | |
;; +----------------------------+
;; and you want to have :
;; +--------------+-------------+
;; | | |
;; | #gnus | .emacs |
;; | | |
;; +--------------+-------------+
;; | |
;; | #emacs |
;; | |
;; +----------------------------+
;; With buffer-move, just go in #gnus, do buf-move-left, go to #emacs
;; (which now should be on top right) and do buf-move-down.
;; To use it, simply put a (require 'buffer-move) in your ~/.emacs and
;; define some keybindings. For example, i use :
;; (global-set-key (kbd "<C-S-up>") 'buf-move-up)
;; (global-set-key (kbd "<C-S-down>") 'buf-move-down)
;; (global-set-key (kbd "<C-S-left>") 'buf-move-left)
;; (global-set-key (kbd "<C-S-right>") 'buf-move-right)
;;; Code:
(require 'windmove)
(defun buf-move-up ()
"Swap the current buffer and the buffer above the split.
If there is no split, ie now window above the current one, an
error is signaled."
;; "Switches between the current buffer, and the buffer above the
;; split, if possible."
(interactive)
(let* ((other-win (windmove-find-other-window 'up))
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No window above this one")
;; swap top with this one
(set-window-buffer (selected-window) (window-buffer other-win))
;; move this one to top
(set-window-buffer other-win buf-this-buf)
(select-window other-win))))
(defun buf-move-down ()
"Swap the current buffer and the buffer under the split.
If there is no split, ie now window under the current one, an
error is signaled."
(interactive)
(let* ((other-win (windmove-find-other-window 'down))
(buf-this-buf (window-buffer (selected-window))))
(if (or (null other-win)
(string-match "^ \\*Minibuf" (buffer-name (window-buffer other-win))))
(error "No window under this one")
;; swap top with this one
(set-window-buffer (selected-window) (window-buffer other-win))
;; move this one to top
(set-window-buffer other-win buf-this-buf)
(select-window other-win))))
(defun buf-move-left ()
"Swap the current buffer and the buffer on the left of the split.
If there is no split, ie now window on the left of the current
one, an error is signaled."
(interactive)
(let* ((other-win (windmove-find-other-window 'left))
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No left split")
;; swap top with this one
(set-window-buffer (selected-window) (window-buffer other-win))
;; move this one to top
(set-window-buffer other-win buf-this-buf)
(select-window other-win))))
(defun buf-move-right ()
"Swap the current buffer and the buffer on the right of the split.
If there is no split, ie now window on the right of the current
one, an error is signaled."
(interactive)
(let* ((other-win (windmove-find-other-window 'right))
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No right split")
;; swap top with this one
(set-window-buffer (selected-window) (window-buffer other-win))
;; move this one to top
(set-window-buffer other-win buf-this-buf)
(select-window other-win))))
(provide 'buffer-move)
;;; buffer-move.el ends here

View File

@ -0,0 +1,45 @@
;;; buffer-move-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "buffer-move" "buffer-move.el" (21831 16639
;;;;;; 808187 792000))
;;; Generated autoloads from buffer-move.el
(autoload 'buf-move-up "buffer-move" "\
Swap the current buffer and the buffer above the split.
If there is no split, ie now window above the current one, an
error is signaled.
\(fn)" t nil)
(autoload 'buf-move-down "buffer-move" "\
Swap the current buffer and the buffer under the split.
If there is no split, ie now window under the current one, an
error is signaled.
\(fn)" t nil)
(autoload 'buf-move-left "buffer-move" "\
Swap the current buffer and the buffer on the left of the split.
If there is no split, ie now window on the left of the current
one, an error is signaled.
\(fn)" t nil)
(autoload 'buf-move-right "buffer-move" "\
Swap the current buffer and the buffer on the right of the split.
If there is no split, ie now window on the right of the current
one, an error is signaled.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; buffer-move-autoloads.el ends here

View File

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

View File

@ -0,0 +1,152 @@
;;; buffer-move.el ---
;; 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>
;; Authors: Lucas Bonnet <lucas@rincevent.net>
;; Geyslan G. Bem <geyslan@gmail.com>
;; Mathis Hofer <mathis@fsfe.org>
;; Keywords: lisp,convenience
;; Version: 0.6.1
;; URL : https://github.com/lukhas/buffer-move
;; 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., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Commentary:
;; This file is for lazy people wanting to swap buffers without
;; typing C-x b on each window. This is useful when you have :
;; +--------------+-------------+
;; | | |
;; | #emacs | #gnus |
;; | | |
;; +--------------+-------------+
;; | |
;; | .emacs |
;; | |
;; +----------------------------+
;; and you want to have :
;; +--------------+-------------+
;; | | |
;; | #gnus | .emacs |
;; | | |
;; +--------------+-------------+
;; | |
;; | #emacs |
;; | |
;; +----------------------------+
;; With buffer-move, just go in #gnus, do buf-move-left, go to #emacs
;; (which now should be on top right) and do buf-move-down.
;; To use it, simply put a (require 'buffer-move) in your ~/.emacs and
;; define some keybindings. For example, i use :
;; (global-set-key (kbd "<C-S-up>") 'buf-move-up)
;; (global-set-key (kbd "<C-S-down>") 'buf-move-down)
;; (global-set-key (kbd "<C-S-left>") 'buf-move-left)
;; (global-set-key (kbd "<C-S-right>") 'buf-move-right)
;; Alternatively, you may let the current window switch back to the previous
;; buffer, instead of swapping the buffers of both windows. Set the
;; following customization variable to 'move to activate this behavior:
;; (setq buffer-move-behavior 'move)
;;; Code:
(require 'windmove)
(defconst buffer-move-version "0.6.1"
"Version of buffer-move.el")
(defgroup buffer-move nil
"Swap buffers without typing C-x b on each window"
:group 'tools)
(defcustom buffer-move-behavior 'swap
"If set to 'swap (default), the buffers will be exchanged
(i.e. swapped), if set to 'move, the current window is switch back to the
previously displayed buffer (i.e. the buffer is moved)."
:group 'buffer-move
:type 'symbol)
(defun buf-move-to (direction)
"Helper function to move the current buffer to the window in the given
direction (with must be 'up, 'down', 'left or 'right). An error is
thrown, if no window exists in this direction."
(let* ((other-win (windmove-find-other-window direction))
(buf-this-buf (window-buffer (selected-window))))
(if (null other-win)
(error "No window in this direction")
(if (eq buffer-move-behavior 'move)
;; switch selected window to previous buffer (moving)
(switch-to-prev-buffer (selected-window))
;; switch selected window to buffer of other window (swapping)
(set-window-buffer (selected-window) (window-buffer other-win))
)
;; switch other window to this buffer
(set-window-buffer other-win buf-this-buf)
(select-window other-win))))
;;;###autoload
(defun buf-move-up ()
"Swap the current buffer and the buffer above the split.
If there is no split, ie now window above the current one, an
error is signaled."
;; "Switches between the current buffer, and the buffer above the
;; split, if possible."
(interactive)
(buf-move-to 'up))
;;;###autoload
(defun buf-move-down ()
"Swap the current buffer and the buffer under the split.
If there is no split, ie now window under the current one, an
error is signaled."
(interactive)
(buf-move-to 'down))
;;;###autoload
(defun buf-move-left ()
"Swap the current buffer and the buffer on the left of the split.
If there is no split, ie now window on the left of the current
one, an error is signaled."
(interactive)
(buf-move-to 'left))
;;;###autoload
(defun buf-move-right ()
"Swap the current buffer and the buffer on the right of the split.
If there is no split, ie now window on the right of the current
one, an error is signaled."
(interactive)
(buf-move-to 'right))
(provide 'buffer-move)
;;; buffer-move.el ends here

View File

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

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

View File

@ -1,3 +1,46 @@
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> 2014-09-14 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'fa4ba155a3e22ddc4b8bc33fcbf8cc69ef8f0043' from company Merge commit 'fa4ba155a3e22ddc4b8bc33fcbf8cc69ef8f0043' from company

View File

@ -1,11 +1,49 @@
# History of user-visible changes # 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) ## 2014-08-13 (0.8.4)
* `company-ropemacs` is only used when `ropemacs-mode` is on. * `company-ropemacs` is only used when `ropemacs-mode` is on.
* `company-gtags` is enabled in all `prog-mode` derivatives by default. * `company-gtags` is enabled in all `prog-mode` derivatives by default.
* `company-end-of-buffer-workaround` is not used anymore. * `company-end-of-buffer-workaround` is not used anymore.
* `company-begin-commands` includes several `cc-mode` commands. * `company-begin-commands` includes some of `cc-mode` commands.
## 2014-08-27 (0.8.3) ## 2014-08-27 (0.8.3)

View File

@ -1,10 +1,10 @@
;;; company-autoloads.el --- automatically extracted autoloads ;;; company-autoloads.el --- automatically extracted autoloads
;; ;;
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads (global-company-mode company-mode) "company" "company.el" ;;;### (autoloads nil "company" "company.el" (21831 16638 858187
;;;;;; (21553 22041 719690 945000)) ;;;;;; 859000))
;;; Generated autoloads from company.el ;;; Generated autoloads from company.el
(autoload 'company-mode "company" "\ (autoload 'company-mode "company" "\
@ -57,8 +57,8 @@ See `company-mode' for more information on Company mode.
;;;*** ;;;***
;;;### (autoloads (company-abbrev) "company-abbrev" "company-abbrev.el" ;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (21831
;;;;;; (21553 22041 262700 327000)) ;;;;;; 16638 696187 870000))
;;; Generated autoloads from company-abbrev.el ;;; Generated autoloads from company-abbrev.el
(autoload 'company-abbrev "company-abbrev" "\ (autoload 'company-abbrev "company-abbrev" "\
@ -68,19 +68,19 @@ See `company-mode' for more information on Company mode.
;;;*** ;;;***
;;;### (autoloads (company-bbdb) "company-bbdb" "company-bbdb.el" ;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (21831 16638
;;;;;; (21553 22041 760690 102000)) ;;;;;; 863187 858000))
;;; Generated autoloads from company-bbdb.el ;;; Generated autoloads from company-bbdb.el
(autoload 'company-bbdb "company-bbdb" "\ (autoload 'company-bbdb "company-bbdb" "\
`company-mode' completion back-end for `bbdb'. `company-mode' completion back-end for BBDB.
\(fn COMMAND &optional ARG &rest IGNORE)" t nil) \(fn COMMAND &optional ARG &rest IGNORE)" t nil)
;;;*** ;;;***
;;;### (autoloads (company-css) "company-css" "company-css.el" (21553 ;;;### (autoloads nil "company-css" "company-css.el" (21831 16638
;;;;;; 22041 295699 650000)) ;;;;;; 709187 869000))
;;; Generated autoloads from company-css.el ;;; Generated autoloads from company-css.el
(autoload 'company-css "company-css" "\ (autoload 'company-css "company-css" "\
@ -90,8 +90,8 @@ See `company-mode' for more information on Company mode.
;;;*** ;;;***
;;;### (autoloads (company-dabbrev) "company-dabbrev" "company-dabbrev.el" ;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (21831
;;;;;; (21553 22041 336698 811000)) ;;;;;; 16638 718187 869000))
;;; Generated autoloads from company-dabbrev.el ;;; Generated autoloads from company-dabbrev.el
(autoload 'company-dabbrev "company-dabbrev" "\ (autoload 'company-dabbrev "company-dabbrev" "\
@ -101,8 +101,8 @@ dabbrev-like `company-mode' completion back-end.
;;;*** ;;;***
;;;### (autoloads (company-dabbrev-code) "company-dabbrev-code" "company-dabbrev-code.el" ;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el"
;;;;;; (21553 22041 992685 338000)) ;;;;;; (21831 16638 894187 856000))
;;; Generated autoloads from company-dabbrev-code.el ;;; Generated autoloads from company-dabbrev-code.el
(autoload 'company-dabbrev-code "company-dabbrev-code" "\ (autoload 'company-dabbrev-code "company-dabbrev-code" "\
@ -114,8 +114,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-elisp) "company-elisp" "company-elisp.el" ;;;### (autoloads nil "company-elisp" "company-elisp.el" (21831 16638
;;;;;; (21553 22041 461696 242000)) ;;;;;; 736187 867000))
;;; Generated autoloads from company-elisp.el ;;; Generated autoloads from company-elisp.el
(autoload 'company-elisp "company-elisp" "\ (autoload 'company-elisp "company-elisp" "\
@ -125,8 +125,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-etags) "company-etags" "company-etags.el" ;;;### (autoloads nil "company-etags" "company-etags.el" (21831 16638
;;;;;; (21553 22041 55704 578000)) ;;;;;; 649187 873000))
;;; Generated autoloads from company-etags.el ;;; Generated autoloads from company-etags.el
(autoload 'company-etags "company-etags" "\ (autoload 'company-etags "company-etags" "\
@ -136,19 +136,21 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-files) "company-files" "company-files.el" ;;;### (autoloads nil "company-files" "company-files.el" (21831 16638
;;;;;; (21553 22041 511695 221000)) ;;;;;; 745187 867000))
;;; Generated autoloads from company-files.el ;;; Generated autoloads from company-files.el
(autoload 'company-files "company-files" "\ (autoload 'company-files "company-files" "\
`company-mode' completion back-end existing file names. `company-mode' completion back-end existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil) \(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;*** ;;;***
;;;### (autoloads (company-gtags) "company-gtags" "company-gtags.el" ;;;### (autoloads nil "company-gtags" "company-gtags.el" (21831 16638
;;;;;; (21553 22042 50684 150000)) ;;;;;; 899187 856000))
;;; Generated autoloads from company-gtags.el ;;; Generated autoloads from company-gtags.el
(autoload 'company-gtags "company-gtags" "\ (autoload 'company-gtags "company-gtags" "\
@ -158,8 +160,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-ispell) "company-ispell" "company-ispell.el" ;;;### (autoloads nil "company-ispell" "company-ispell.el" (21831
;;;;;; (21553 22041 3705 646000)) ;;;;;; 16638 631187 875000))
;;; Generated autoloads from company-ispell.el ;;; Generated autoloads from company-ispell.el
(autoload 'company-ispell "company-ispell" "\ (autoload 'company-ispell "company-ispell" "\
@ -169,8 +171,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-keywords) "company-keywords" "company-keywords.el" ;;;### (autoloads nil "company-keywords" "company-keywords.el" (21831
;;;;;; (21553 22041 88703 901000)) ;;;;;; 16638 658187 873000))
;;; Generated autoloads from company-keywords.el ;;; Generated autoloads from company-keywords.el
(autoload 'company-keywords "company-keywords" "\ (autoload 'company-keywords "company-keywords" "\
@ -180,8 +182,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-nxml) "company-nxml" "company-nxml.el" ;;;### (autoloads nil "company-nxml" "company-nxml.el" (21831 16638
;;;;;; (21553 22041 130703 38000)) ;;;;;; 667187 872000))
;;; Generated autoloads from company-nxml.el ;;; Generated autoloads from company-nxml.el
(autoload 'company-nxml "company-nxml" "\ (autoload 'company-nxml "company-nxml" "\
@ -191,8 +193,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-oddmuse) "company-oddmuse" "company-oddmuse.el" ;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (21831
;;;;;; (21553 22041 544694 537000)) ;;;;;; 16638 755187 866000))
;;; Generated autoloads from company-oddmuse.el ;;; Generated autoloads from company-oddmuse.el
(autoload 'company-oddmuse "company-oddmuse" "\ (autoload 'company-oddmuse "company-oddmuse" "\
@ -202,8 +204,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads (company-pysmell) "company-pysmell" "company-pysmell.el" ;;;### (autoloads nil "company-pysmell" "company-pysmell.el" (21831
;;;;;; (21553 22041 652692 320000)) ;;;;;; 16638 848187 859000))
;;; Generated autoloads from company-pysmell.el ;;; Generated autoloads from company-pysmell.el
(autoload 'company-pysmell "company-pysmell" "\ (autoload 'company-pysmell "company-pysmell" "\
@ -214,8 +216,8 @@ This requires pysmell.el and pymacs.el.
;;;*** ;;;***
;;;### (autoloads (company-semantic) "company-semantic" "company-semantic.el" ;;;### (autoloads nil "company-semantic" "company-semantic.el" (21831
;;;;;; (21553 22042 308678 850000)) ;;;;;; 16638 936187 853000))
;;; Generated autoloads from company-semantic.el ;;; Generated autoloads from company-semantic.el
(autoload 'company-semantic "company-semantic" "\ (autoload 'company-semantic "company-semantic" "\
@ -225,8 +227,8 @@ This requires pysmell.el and pymacs.el.
;;;*** ;;;***
;;;### (autoloads (company-tempo) "company-tempo" "company-tempo.el" ;;;### (autoloads nil "company-tempo" "company-tempo.el" (21831 16638
;;;;;; (21553 22041 835688 555000)) ;;;;;; 874187 858000))
;;; Generated autoloads from company-tempo.el ;;; Generated autoloads from company-tempo.el
(autoload 'company-tempo "company-tempo" "\ (autoload 'company-tempo "company-tempo" "\
@ -236,8 +238,8 @@ This requires pysmell.el and pymacs.el.
;;;*** ;;;***
;;;### (autoloads (company-xcode) "company-xcode" "company-xcode.el" ;;;### (autoloads nil "company-xcode" "company-xcode.el" (21831 16638
;;;;;; (21553 22041 901687 207000)) ;;;;;; 885187 857000))
;;; Generated autoloads from company-xcode.el ;;; Generated autoloads from company-xcode.el
(autoload 'company-xcode "company-xcode" "\ (autoload 'company-xcode "company-xcode" "\
@ -247,8 +249,8 @@ This requires pysmell.el and pymacs.el.
;;;*** ;;;***
;;;### (autoloads (company-yasnippet) "company-yasnippet" "company-yasnippet.el" ;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el"
;;;;;; (21553 22042 158681 930000)) ;;;;;; (21831 16638 920187 854000))
;;; Generated autoloads from company-yasnippet.el ;;; Generated autoloads from company-yasnippet.el
(autoload 'company-yasnippet "company-yasnippet" "\ (autoload 'company-yasnippet "company-yasnippet" "\
@ -279,17 +281,14 @@ shadow back-ends that come after it. Recommended usages:
;;;*** ;;;***
;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el" ;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el"
;;;;;; "company-eclim.el" "company-elisp-tests.el" "company-pkg.el" ;;;;;; "company-eclim.el" "company-pkg.el" "company-ropemacs.el"
;;;;;; "company-ropemacs.el" "company-template.el" "company-tests.el") ;;;;;; "company-template.el") (21831 16638 948260 900000))
;;;;;; (21553 22042 393632 690000))
;;;*** ;;;***
(provide 'company-autoloads)
;; Local Variables: ;; Local Variables:
;; version-control: never ;; version-control: never
;; no-byte-compile: t ;; no-byte-compile: t
;; no-update-autoloads: t ;; no-update-autoloads: t
;; coding: utf-8
;; End: ;; End:
;;; company-autoloads.el ends here ;;; company-autoloads.el ends here

View File

@ -27,21 +27,33 @@
(declare-function bbdb-dwim-mail "bbdb-com") (declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-search "bbdb-com") (declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
"Completion back-end for BBDB."
:group 'company)
(defcustom company-bbdb-modes '(message-mode)
"Major modes in which `company-bbdb' may complete."
:type '(repeat (symbol :tag "Major mode"))
:package-version '(company . "0.8.8"))
(defun company-bbdb--candidates (arg)
(cl-mapcan (lambda (record)
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
(bbdb-record-get-field record 'mail)))
(eval '(bbdb-search (bbdb-records) arg nil arg))))
;;;###autoload ;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore) (defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion back-end for `bbdb'." "`company-mode' completion back-end for BBDB."
(interactive (list 'interactive)) (interactive (list 'interactive))
(cl-case command (cl-case command
(interactive (company-begin-backend 'company-bbdb)) (interactive (company-begin-backend 'company-bbdb))
(prefix (and (eq major-mode 'message-mode) (prefix (and (memq major-mode company-bbdb-modes)
(featurep 'bbdb-com) (featurep 'bbdb-com)
(looking-back "^\\(To\\|Cc\\|Bcc\\):.*" (looking-back "^\\(To\\|Cc\\|Bcc\\): *\\(.*\\)"
(line-beginning-position)) (line-beginning-position))
(company-grab-symbol))) (match-string-no-properties 2)))
(candidates (cl-mapcan (lambda (record) (candidates (company-bbdb--candidates arg))
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
(bbdb-record-get-field record 'mail)))
(bbdb-search (bbdb-records) arg nil arg)))
(sorted t) (sorted t)
(no-cache t))) (no-cache t)))

View File

@ -138,9 +138,14 @@
(`init nil) ;Don't bother: plenty of other ways to initialize the code. (`init nil) ;Don't bother: plenty of other ways to initialize the code.
(`post-completion (`post-completion
(let* ((res (company--capf-data)) (let* ((res (company--capf-data))
(exit-function (plist-get (nthcdr 4 res) :exit-function))) (exit-function (plist-get (nthcdr 4 res) :exit-function))
(table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate)))
(if exit-function (if exit-function
(funcall exit-function arg 'finished)))) ;; Follow the example of `completion--done'.
(funcall exit-function arg
(if (eq (try-completion arg table pred) t)
'finished 'sole)))))
)) ))
(provide 'company-capf) (provide 'company-capf)

View File

@ -51,7 +51,7 @@ and `c-electric-colon', for automatic completion right after \">\" and
"Additional arguments to pass to clang when completing. "Additional arguments to pass to clang when completing.
Prefix files (-include ...) can be selected with `company-clang-set-prefix' Prefix files (-include ...) can be selected with `company-clang-set-prefix'
or automatically through a custom `company-clang-prefix-guesser'." or automatically through a custom `company-clang-prefix-guesser'."
:type '(repeat (string :tag "Argument" nil))) :type '(repeat (string :tag "Argument")))
(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix (defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
"A function to determine the prefix file for the current buffer." "A function to determine the prefix file for the current buffer."
@ -150,7 +150,13 @@ or automatically through a custom `company-clang-prefix-guesser'."
((string-match "[^:]:[^:]" meta) ((string-match "[^:]:[^:]" meta)
(substring meta (1+ (match-beginning 0)))) (substring meta (1+ (match-beginning 0))))
((string-match "\\((.*)[ a-z]*\\'\\)" meta) ((string-match "\\((.*)[ a-z]*\\'\\)" meta)
(match-string 1 meta))))) (let ((paren (match-beginning 1)))
(if (not (eq (aref meta (1- paren)) ?>))
(match-string 1 meta)
(with-temp-buffer
(insert meta)
(goto-char paren)
(substring meta (1- (search-backward "<"))))))))))
(defun company-clang--strip-formatting (text) (defun company-clang--strip-formatting (text)
(replace-regexp-in-string (replace-regexp-in-string
@ -182,7 +188,9 @@ or automatically through a custom `company-clang-prefix-guesser'."
(defun company-clang--start-process (prefix callback &rest args) (defun company-clang--start-process (prefix callback &rest args)
(let ((objc (derived-mode-p 'objc-mode)) (let ((objc (derived-mode-p 'objc-mode))
(buf (get-buffer-create "*clang-output*"))) (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)) (with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf) (if (get-buffer-process buf)
(funcall callback nil) (funcall callback nil)
@ -320,7 +328,8 @@ passed via standard input."
(insert anno) (insert anno)
(if (string-match "\\`:[^:]" anno) (if (string-match "\\`:[^:]" anno)
(company-clang-objc-templatify anno) (company-clang-objc-templatify anno)
(company-template-c-like-templatify anno))))))) (company-template-c-like-templatify
(concat arg anno))))))))
(provide 'company-clang) (provide 'company-clang)
;;; company-clang.el ends here ;;; company-clang.el ends here

View File

@ -0,0 +1,198 @@
;;; company-cmake.el --- company-mode completion back-end for CMake
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.2
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; company-cmake offers completions for module names, variable names and
;; commands used by CMake. And their descriptions.
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-cmake nil
"Completion back-end for CMake."
:group 'company)
(defcustom company-cmake-executable
(executable-find "cmake")
"Location of cmake executable."
:type 'file)
(defvar company-cmake-executable-arguments
'("--help-command-list"
"--help-module-list"
"--help-variable-list")
"The arguments we pass to cmake, separately.
They affect which types of symbols we get completion candidates for.")
(defvar company-cmake--completion-pattern
"^\\(%s[a-zA-Z0-9_<>]%s\\)$"
"Regexp to match the candidates.")
(defvar company-cmake-modes '(cmake-mode)
"Major modes in which cmake may complete.")
(defvar company-cmake--candidates-cache nil
"Cache for the raw candidates.")
(defvar company-cmake--meta-command-cache nil
"Cache for command arguments to retrieve descriptions for the candidates.")
(defun company-cmake--replace-tags (rlt)
(setq rlt (replace-regexp-in-string
"\\(.*?\\(IS_GNU\\)?\\)<LANG>\\(.*\\)"
(lambda (_match)
(mapconcat 'identity
(if (match-beginning 2)
'("\\1CXX\\3" "\\1C\\3" "\\1G77\\3")
'("\\1CXX\\3" "\\1C\\3" "\\1Fortran\\3"))
"\n"))
rlt t))
(setq rlt (replace-regexp-in-string
"\\(.*\\)<CONFIG>\\(.*\\)"
(mapconcat 'identity '("\\1DEBUG\\2" "\\1RELEASE\\2"
"\\1RELWITHDEBINFO\\2" "\\1MINSIZEREL\\2")
"\n")
rlt))
rlt)
(defun company-cmake--fill-candidates-cache (arg)
"Fill candidates cache if needed."
(let (rlt)
(unless company-cmake--candidates-cache
(setq company-cmake--candidates-cache (make-hash-table :test 'equal)))
;; If hash is empty, fill it.
(unless (gethash arg company-cmake--candidates-cache)
(with-temp-buffer
(let ((res (call-process company-cmake-executable nil t nil arg)))
(unless (zerop res)
(message "cmake executable exited with error=%d" res)))
(setq rlt (buffer-string)))
(setq rlt (company-cmake--replace-tags rlt))
(puthash arg rlt company-cmake--candidates-cache))
))
(defun company-cmake--parse (prefix content cmd)
(let ((start 0)
(pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(lines (split-string content "\n"))
match
rlt)
(dolist (line lines)
(when (string-match pattern line)
(let ((match (match-string 1 line)))
(when match
(puthash match cmd company-cmake--meta-command-cache)
(push match rlt)))))
rlt))
(defun company-cmake--candidates (prefix)
(let (results
cmd-opts
str)
(unless company-cmake--meta-command-cache
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal)))
(dolist (arg company-cmake-executable-arguments)
(company-cmake--fill-candidates-cache arg)
(setq cmd-opts (replace-regexp-in-string "-list$" "" arg) )
(setq str (gethash arg company-cmake--candidates-cache))
(when str
(setq results (nconc results
(company-cmake--parse prefix str cmd-opts)))))
results))
(defun company-cmake--unexpand-candidate (candidate)
(cond
((string-match "^CMAKE_\\(C\\|CXX\\|Fortran\\)\\(_.*\\)$" candidate)
(setq candidate (concat "CMAKE_<LANG>" (match-string 2 candidate))))
;; C flags
((string-match "^\\(.*_\\)IS_GNU\\(C\\|CXX\\|G77\\)$" candidate)
(setq candidate (concat (match-string 1 candidate) "IS_GNU<LANG>")))
;; C flags
((string-match "^\\(.*_\\)OVERRIDE_\\(C\\|CXX\\|Fortran\\)$" candidate)
(setq candidate (concat (match-string 1 candidate) "OVERRIDE_<LANG>")))
((string-match "^\\(.*\\)\\(_DEBUG\\|_RELEASE\\|_RELWITHDEBINFO\\|_MINSIZEREL\\)\\(.*\\)$" candidate)
(setq candidate (concat (match-string 1 candidate)
"_<CONFIG>"
(match-string 3 candidate)))))
candidate)
(defun company-cmake--meta (candidate)
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache))
result)
(setq candidate (company-cmake--unexpand-candidate candidate))
;; Don't cache the documentation of every candidate (command)
;; Cache in this case will cost too much memory.
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts candidate)
;; Go to the third line, trim it and return the result.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(setq result (buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
(setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result))
result)))
(defun company-cmake--doc-buffer (candidate)
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache)))
(setq candidate (company-cmake--unexpand-candidate candidate))
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts candidate)
;; Go to the third line, trim it and return the doc buffer.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(company-doc-buffer
(buffer-substring-no-properties (line-beginning-position)
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
"`company-mode' completion back-end for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-cmake))
(init (when (memq major-mode company-cmake-modes)
(unless company-cmake-executable
(error "Company found no cmake executable"))))
(prefix (and (memq major-mode company-cmake-modes)
(not (company-in-string-or-comment))
(company-grab-symbol)))
(candidates (company-cmake--candidates arg))
(meta (company-cmake--meta arg))
(doc-buffer (company-cmake--doc-buffer arg))
))
(provide 'company-cmake)
;;; company-cmake.el ends here

View File

@ -47,10 +47,10 @@ complete only symbols, not text in comments or strings. In other modes
(defcustom company-dabbrev-code-other-buffers t (defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers. "Determines whether `company-dabbrev-code' should search other buffers.
If `all', search all other buffers. If t, search buffers with the same If `all', search all other buffers, except the ignored ones. If t, search
major mode. If `code', search all buffers with major modes in buffers with the same major mode. If `code', search all buffers with major
`company-dabbrev-code-modes', or derived from one of them. modes in `company-dabbrev-code-modes', or derived from one of them. See
See also `company-dabbrev-code-time-limit'." also `company-dabbrev-code-time-limit'."
:type '(choice (const :tag "Off" nil) :type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t) (const :tag "Same major mode" t)
(const :tag "Code major modes" code) (const :tag "Code major modes" code)

View File

@ -34,13 +34,16 @@
(defcustom company-dabbrev-other-buffers 'all (defcustom company-dabbrev-other-buffers 'all
"Determines whether `company-dabbrev' should search other buffers. "Determines whether `company-dabbrev' should search other buffers.
If `all', search all other buffers. If t, search buffers with the same If `all', search all other buffers, except the ignored ones. If t, search
major mode. buffers with the same major mode. See also `company-dabbrev-time-limit'."
See also `company-dabbrev-time-limit'."
:type '(choice (const :tag "Off" nil) :type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t) (const :tag "Same major mode" t)
(const :tag "All" all))) (const :tag "All" all)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
"Regexp matching the names of buffers to ignore."
:type 'regexp)
(defcustom company-dabbrev-time-limit .1 (defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches." "Determines how many seconds `company-dabbrev' should look for matches."
:type '(choice (const :tag "Off" nil) :type '(choice (const :tag "Off" nil)
@ -121,7 +124,9 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(when other-buffer-modes (when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list))) (cl-dolist (buffer (delq (current-buffer) (buffer-list)))
(with-current-buffer buffer (with-current-buffer buffer
(when (or (eq other-buffer-modes 'all) (when (if (eq other-buffer-modes 'all)
(not (string-match-p company-dabbrev-ignore-buffers
(buffer-name)))
(apply #'derived-mode-p other-buffer-modes)) (apply #'derived-mode-p other-buffer-modes))
(setq symbols (setq symbols
(company-dabbrev--search-buffer regexp nil symbols start (company-dabbrev--search-buffer regexp nil symbols start

View File

@ -54,7 +54,7 @@ buffer automatically."
(let ((file (locate-dominating-file (or buffer-file-name (let ((file (locate-dominating-file (or buffer-file-name
default-directory) default-directory)
"TAGS"))) "TAGS")))
(when file (when (and file (file-regular-p file))
(list (expand-file-name file))))) (list (expand-file-name file)))))
(defun company-etags-buffer-table () (defun company-etags-buffer-table ()

View File

@ -1,6 +1,6 @@
;;; company-files.el --- company-mode completion back-end for file names ;;; company-files.el --- company-mode completion back-end for file paths
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc. ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
@ -28,24 +28,26 @@
(require 'company) (require 'company)
(require 'cl-lib) (require 'cl-lib)
(defun company-files-directory-files (dir prefix) (defun company-files--directory-files (dir prefix)
(ignore-errors (ignore-errors
(if (equal prefix "") (if (equal prefix "")
(directory-files dir nil "\\`[^.]\\|\\`.[^.]") (directory-files dir nil "\\`[^.]\\|\\`.[^.]")
(file-name-all-completions prefix dir)))) (file-name-all-completions prefix dir))))
(defvar company-files-regexps (defvar company-files--regexps
(let ((begin (if (eq system-type 'windows-nt) (let* ((root (if (eq system-type 'windows-nt)
"[a-z][A-Z]\\" "[a-zA-Z]:/"
"~?/"))) "/"))
(begin (concat "\\(?:\\.\\{1,2\\}/\\|~/\\|" root "\\)")))
(list (concat "\"\\(" begin "[^\"\n]*\\)") (list (concat "\"\\(" begin "[^\"\n]*\\)")
(concat "\'\\(" begin "[^\'\n]*\\)") (concat "\'\\(" begin "[^\'\n]*\\)")
(concat "\\(?:[ \t]\\|^\\)\\(" begin "[^ \t\n]*\\)")))) (concat "\\(?:[ \t]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
(defun company-files-grab-existing-name () (defun company-files--grab-existing-name ()
;; Grab file names with spaces, only when they include quotes. ;; Grab the file name.
;; When surrounded with quotes, it can include spaces.
(let (file dir) (let (file dir)
(and (cl-dolist (regexp company-files-regexps) (and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1)) (when (setq file (company-grab-line regexp 1))
(cl-return file))) (cl-return file)))
(setq dir (file-name-directory file)) (setq dir (file-name-directory file))
@ -54,36 +56,46 @@
(file-name-all-completions (file-name-nondirectory file) dir) (file-name-all-completions (file-name-nondirectory file) dir)
file))) file)))
(defvar company-files-completion-cache nil) (defvar company-files--completion-cache nil)
(defun company-files-complete (prefix) (defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix)) (let* ((dir (file-name-directory prefix))
(key (list (file-name-nondirectory prefix)
(expand-file-name dir)
(nth 5 (file-attributes dir))))
(file (file-name-nondirectory prefix)) (file (file-name-nondirectory prefix))
(completion-ignore-case read-file-name-completion-ignore-case)
candidates directories) candidates directories)
(unless (equal dir (car company-files-completion-cache)) (unless (company-file--keys-match-p key (car company-files--completion-cache))
(dolist (file (company-files-directory-files dir file)) (dolist (file (company-files--directory-files dir file))
(setq file (concat dir file)) (setq file (concat dir file))
(push file candidates) (push file candidates)
(when (file-directory-p file) (when (file-directory-p file)
(push file directories))) (push file directories)))
(dolist (directory (reverse directories)) (dolist (directory (reverse directories))
;; Add one level of children. ;; Add one level of children.
(dolist (child (company-files-directory-files directory "")) (dolist (child (company-files--directory-files directory ""))
(push (concat directory (push (concat directory
(unless (eq (aref directory (1- (length directory))) ?/) "/") (unless (eq (aref directory (1- (length directory))) ?/) "/")
child) candidates))) child) candidates)))
(setq company-files-completion-cache (cons dir (nreverse candidates)))) (setq company-files--completion-cache (cons key (nreverse candidates))))
(all-completions prefix (all-completions prefix
(cdr company-files-completion-cache)))) (cdr company-files--completion-cache))))
(defun company-file--keys-match-p (new old)
(and (equal (cdr old) (cdr new))
(string-prefix-p (car old) (car new))))
;;;###autoload ;;;###autoload
(defun company-files (command &optional arg &rest ignored) (defun company-files (command &optional arg &rest ignored)
"`company-mode' completion back-end existing file names." "`company-mode' completion back-end existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive)) (interactive (list 'interactive))
(cl-case command (cl-case command
(interactive (company-begin-backend 'company-files)) (interactive (company-begin-backend 'company-files))
(prefix (company-files-grab-existing-name)) (prefix (company-files--grab-existing-name))
(candidates (company-files-complete arg)) (candidates (company-files--complete arg))
(location (cons (dired-noselect (location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1)) (file-name-directory (directory-file-name arg))) 1))
(sorted t) (sorted t)

View File

@ -95,6 +95,7 @@ completion."
(cl-case command (cl-case command
(interactive (company-begin-backend 'company-gtags)) (interactive (company-begin-backend 'company-gtags))
(prefix (and company-gtags-executable (prefix (and company-gtags-executable
buffer-file-name
(apply #'derived-mode-p company-gtags-modes) (apply #'derived-mode-p company-gtags-modes)
(not (company-in-string-or-comment)) (not (company-in-string-or-comment))
(company-gtags--tags-available-p) (company-gtags--tags-available-p)

View File

@ -1,6 +1,6 @@
;;; company-ispell.el --- company-mode completion back-end using Ispell ;;; company-ispell.el --- company-mode completion back-end using Ispell
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009-2011, 2013-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
@ -60,8 +60,15 @@ If nil, use `ispell-complete-word-dict'."
(interactive (company-begin-backend 'company-ispell)) (interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available) (prefix (when (company-ispell-available)
(company-grab-word))) (company-grab-word)))
(candidates (lookup-words arg (or company-ispell-dictionary (candidates
(let ((words (lookup-words arg (or company-ispell-dictionary
ispell-complete-word-dict))) ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
;; Small optimization.
words
;; Work around issue #284.
(all-completions arg words))))
(sorted t) (sorted t)
(ignore-case 'keep-prefix))) (ignore-case 'keep-prefix)))

View File

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

@ -99,6 +99,14 @@
(push tag company-semantic--current-tags))) (push tag company-semantic--current-tags)))
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags))) (delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic-annotation (argument tags)
(let* ((tag (assoc 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) (defun company-semantic--pre-prefix-length (prefix-length)
"Sum up the length of all chained symbols before POS. "Sum up the length of all chained symbols before POS.
Symbols are chained by \".\" or \"->\"." Symbols are chained by \".\" or \"->\"."
@ -133,6 +141,8 @@ Symbols are chained by \".\" or \"->\"."
(company-semantic-completions arg))) (company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function (meta (funcall company-semantic-metadata-function
(assoc arg company-semantic--current-tags))) (assoc arg company-semantic--current-tags)))
(annotation (company-semantic-annotation arg
company-semantic--current-tags))
(doc-buffer (company-semantic-doc-buffer (doc-buffer (company-semantic-doc-buffer
(assoc arg company-semantic--current-tags))) (assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables. ;; Because "" is an empty context and doesn't return local variables.

View File

@ -1,6 +1,6 @@
;;; company-template.el ;;; company-template.el
;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc. ;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
@ -149,22 +149,47 @@ Leave point at the end of the field."
(defun company-template-c-like-templatify (call) (defun company-template-c-like-templatify (call)
(let* ((end (point-marker)) (let* ((end (point-marker))
(beg (- (point) (length call))) (beg (- (point) (length call)))
(cnt 0)) (cnt 0)
(when (re-search-backward ")" beg t) (templ (company-template-declare-template beg end))
(delete-region (match-end 0) end)) paren-open paren-close)
(goto-char beg) (with-syntax-table (make-syntax-table (syntax-table))
(when (search-forward "(" end 'move) (modify-syntax-entry ?< "(")
(if (eq (char-after) ?\)) (modify-syntax-entry ?> ")")
(when (search-backward ")" beg t)
(setq paren-close (point-marker))
(forward-char 1) (forward-char 1)
(let ((templ (company-template-declare-template beg end))) (delete-region (point) end)
(while (re-search-forward (concat " *\\([^,)]*\\)[,)]") end t) (backward-sexp)
(let ((sig (match-string 1))) (forward-char 1)
(delete-region (match-beginning 1) (match-end 1)) (setq paren-open (point-marker)))
(when (search-backward ">" beg t)
(let ((angle-close (point-marker)))
(forward-char 1)
(backward-sexp)
(forward-char)
(setq cnt (company-template--c-like-args templ angle-close
cnt))))
(when paren-open
(goto-char paren-open)
(company-template--c-like-args templ paren-close cnt)))
(if (overlay-get templ 'company-template-fields)
(company-template-move-to-first templ)
(company-template-remove-template templ)
(goto-char end))))
(defun company-template--c-like-args (templ end counter)
(let ((last-pos (point)))
(while (re-search-forward "\\([^,]+\\),?" end 'move)
(when (zerop (car (parse-partial-sexp last-pos (point))))
(let ((sig (buffer-substring-no-properties last-pos (match-end 1))))
(save-excursion (save-excursion
(company-template-add-field templ (match-beginning 1) (company-template-add-field templ last-pos
(format "arg%d" cnt) sig)) (format "arg%d" counter) sig)
(cl-incf cnt))) (delete-region (point) (+ (point) (length sig))))
(company-template-move-to-first templ)))))) (skip-chars-forward " ")
(setq last-pos (point))
(cl-incf counter)))))
counter)
(provide 'company-template) (provide 'company-template)
;;; company-template.el ends here ;;; company-template.el ends here

View File

@ -1,6 +1,6 @@
;;; company-xcode.el --- company-mode completion back-end for Xcode projects ;;; company-xcode.el --- company-mode completion back-end for Xcode projects
;; Copyright (C) 2009-2011 Free Software Foundation, Inc. ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
@ -80,7 +80,7 @@ valid in most contexts."
"\t[^\t\n]*\t[^\t\n]*")) "\t[^\t\n]*\t[^\t\n]*"))
candidates) candidates)
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(add-to-list 'candidates (match-string 1))) (cl-pushnew (match-string 1) candidates :test #'equal))
(message "Retrieving dump from %s...done" project-bundle) (message "Retrieving dump from %s...done" project-bundle)
candidates)))) candidates))))

View File

@ -25,11 +25,17 @@
;;; Code: ;;; Code:
(require 'company)
(require 'cl-lib) (require 'cl-lib)
(require 'yasnippet)
(declare-function yas--table-hash "yasnippet")
(declare-function yas--get-snippet-tables "yasnippet")
(declare-function yas-expand-snippet "yasnippet")
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
(defun company-yasnippet--candidates (prefix) (defun company-yasnippet--candidates (prefix)
(mapcan (cl-mapcan
(lambda (table) (lambda (table)
(let ((keyhash (yas--table-hash table)) (let ((keyhash (yas--table-hash table))
res) res)
@ -80,7 +86,7 @@ shadow back-ends that come after it. Recommended usages:
(prefix (prefix
;; Should probably use `yas--current-key', but that's bound to be slower. ;; Should probably use `yas--current-key', but that's bound to be slower.
;; How many trigger keys start with non-symbol characters anyway? ;; How many trigger keys start with non-symbol characters anyway?
(and yas-minor-mode (and (bound-and-true-p yas-minor-mode)
(company-grab-symbol))) (company-grab-symbol)))
(annotation (annotation
(concat (concat

View File

@ -1,11 +1,11 @@
;;; company.el --- Modular text completion framework -*- lexical-binding: t -*- ;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru> ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/ ;; URL: http://company-mode.github.io/
;; Version: 0.8.5 ;; Version: 0.8.12
;; Keywords: abbrev, convenience, matching ;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
@ -340,20 +340,20 @@ The first argument is the command requested from the back-end. It is one
of the following: of the following:
`prefix': The back-end should return the text to be completed. It must be `prefix': The back-end should return the text to be completed. It must be
text immediately before point. Returning nil passes control to the next text immediately before point. Returning nil from this command passes
back-end. The function should return `stop' if it should complete but control to the next back-end. The function should return `stop' if it
cannot (e.g. if it is in the middle of a string). Instead of a string, should complete but cannot (e.g. if it is in the middle of a string).
the back-end may return a cons where car is the prefix and cdr is used in Instead of a string, the back-end may return a cons where car is the prefix
`company-minimum-prefix-length' test. It must be either number or t, and and cdr is used in `company-minimum-prefix-length' test. It must be either
in the latter case the test automatically succeeds. number or t, and in the latter case the test automatically succeeds.
`candidates': The second argument is the prefix to be completed. The `candidates': The second argument is the prefix to be completed. The
return value should be a list of candidates that match the prefix. return value should be a list of candidates that match the prefix.
Non-prefix matches are also supported (candidates that don't start with the Non-prefix matches are also supported (candidates that don't start with the
prefix, but match it in some backend-defined way). Backends that use this prefix, but match it in some backend-defined way). Backends that use this
feature must disable cache (return t to `no-cache') and should also respond feature must disable cache (return t to `no-cache') and might also want to
to `match'. respond to `match'.
Optional commands: Optional commands:
@ -384,10 +384,10 @@ be kept if they have different annotations. For that to work properly,
backends should store the related information on candidates using text backends should store the related information on candidates using text
properties. properties.
`match': The second argument is a completion candidate. Backends that `match': The second argument is a completion candidate. Return the index
provide non-prefix completions should return the position of the end of after the end of text matching `prefix' within the candidate string. It
text in the candidate that matches `prefix'. It will be used when will be used when rendering the popup. This command only makes sense for
rendering the popup. backends that provide non-prefix completion.
`require-match': If this returns t, the user is not allowed to enter `require-match': If this returns t, the user is not allowed to enter
anything not offered as a candidate. Use with care! The default value nil anything not offered as a candidate. Use with care! The default value nil
@ -449,9 +449,11 @@ even if the back-end uses the asynchronous calling convention."
(put 'company-backends 'safe-local-variable 'company-safe-backends-p) (put 'company-backends 'safe-local-variable 'company-safe-backends-p)
(defcustom company-transformers nil (defcustom company-transformers nil
"Functions to change the list of candidates received from backends, "Functions to change the list of candidates received from backends.
after sorting and removal of duplicates (if appropriate).
Each function gets called with the return value of the previous one." Each function gets called with the return value of the previous one.
The first one gets passed the list of candidates, already sorted and
without duplicates."
:type '(choice :type '(choice
(const :tag "None" nil) (const :tag "None" nil)
(const :tag "Sort by occurrence" (company-sort-by-occurrence)) (const :tag "Sort by occurrence" (company-sort-by-occurrence))
@ -551,6 +553,7 @@ happens. The value of nil means no idle completion."
(defcustom company-begin-commands '(self-insert-command (defcustom company-begin-commands '(self-insert-command
org-self-insert-command org-self-insert-command
orgtbl-self-insert-command
c-scope-operator c-scope-operator
c-electric-colon c-electric-colon
c-electric-lt-gt c-electric-lt-gt
@ -611,6 +614,8 @@ asynchronous call into synchronous.")
(define-key keymap (kbd "M-p") 'company-select-previous) (define-key keymap (kbd "M-p") 'company-select-previous)
(define-key keymap (kbd "<down>") 'company-select-next-or-abort) (define-key keymap (kbd "<down>") 'company-select-next-or-abort)
(define-key keymap (kbd "<up>") 'company-select-previous-or-abort) (define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
(define-key keymap [remap scroll-up-command] 'company-next-page)
(define-key keymap [remap scroll-down-command] 'company-previous-page)
(define-key keymap [down-mouse-1] 'ignore) (define-key keymap [down-mouse-1] 'ignore)
(define-key keymap [down-mouse-3] 'ignore) (define-key keymap [down-mouse-3] 'ignore)
(define-key keymap [mouse-1] 'company-complete-mouse) (define-key keymap [mouse-1] 'company-complete-mouse)
@ -627,7 +632,7 @@ asynchronous call into synchronous.")
(define-key keymap "\C-s" 'company-search-candidates) (define-key keymap "\C-s" 'company-search-candidates)
(define-key keymap "\C-\M-s" 'company-filter-candidates) (define-key keymap "\C-\M-s" 'company-filter-candidates)
(dotimes (i 10) (dotimes (i 10)
(define-key keymap (kbd (format "M-%d" i)) 'company-complete-number)) (define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
keymap) keymap)
"Keymap that is enabled during an active completion.") "Keymap that is enabled during an active completion.")
@ -657,9 +662,26 @@ asynchronous call into synchronous.")
(unless (keywordp b) (unless (keywordp b)
(company-init-backend b)))))) (company-init-backend b))))))
(defvar company-default-lighter " company") (defcustom company-lighter-base "company"
"Base string to use for the `company-mode' lighter."
:type 'string
:package-version '(company . "0.8.10"))
(defvar-local company-lighter company-default-lighter) (defvar company-lighter '(" "
(company-backend
(:eval
(if (consp company-backend)
(company--group-lighter (nth company-selection
company-candidates)
company-lighter-base)
(symbol-name company-backend)))
company-lighter-base))
"Mode line lighter for Company.
The value of this variable is a mode line template as in
`mode-line-format'.")
(put 'company-lighter 'risky-local-variable t)
;;;###autoload ;;;###autoload
(define-minor-mode company-mode (define-minor-mode company-mode
@ -766,10 +788,10 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(interactive) (interactive)
(setq this-command last-command)) (setq this-command last-command))
(global-set-key '[31415926] 'company-ignore) (global-set-key '[company-dummy-event] 'company-ignore)
(defun company-input-noop () (defun company-input-noop ()
(push 31415926 unread-command-events)) (push 'company-dummy-event unread-command-events))
(defun company--posn-col-row (posn) (defun company--posn-col-row (posn)
(let ((col (car (posn-col-row posn))) (let ((col (car (posn-col-row posn)))
@ -848,7 +870,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
res)))) res))))
(defun company-call-backend-raw (&rest args) (defun company-call-backend-raw (&rest args)
(condition-case err (condition-case-unless-debug err
(if (functionp company-backend) (if (functionp company-backend)
(apply company-backend args) (apply company-backend args)
(apply #'company--multi-backend-adapter company-backend args)) (apply #'company--multi-backend-adapter company-backend args))
@ -912,26 +934,26 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
(cons (cons
:async :async
(lambda (callback) (lambda (callback)
(let* (lst pending (let* (lst
(pending (mapcar #'car pairs))
(finisher (lambda () (finisher (lambda ()
(unless pending (unless pending
(funcall callback (funcall callback
(funcall merger (funcall merger
(nreverse lst))))))) (nreverse lst)))))))
(dolist (pair pairs) (dolist (pair pairs)
(let ((val (car pair))
(mapper (cdr pair)))
(if (not (eq :async (car-safe val)))
(push (funcall mapper val) lst)
(push nil lst) (push nil lst)
(let ((cell lst) (let* ((cell lst)
(fetcher (cdr val))) (val (car pair))
(push fetcher pending) (mapper (cdr pair))
(funcall fetcher (this-finisher (lambda (res)
(lambda (res) (setq pending (delq val pending))
(setq pending (delq fetcher pending))
(setcar cell (funcall mapper res)) (setcar cell (funcall mapper res))
(funcall finisher))))))))))))) (funcall finisher))))
(if (not (eq :async (car-safe val)))
(funcall this-finisher val)
(let ((fetcher (cdr val)))
(funcall fetcher this-finisher)))))))))))
(defun company--prefix-str (prefix) (defun company--prefix-str (prefix)
(or (car-safe prefix) prefix)) (or (car-safe prefix) prefix))
@ -977,8 +999,9 @@ Controlled by `company-auto-complete'.")
;; XXX: Return value we check here is subject to change. ;; XXX: Return value we check here is subject to change.
(if (eq (company-call-backend 'ignore-case) 'keep-prefix) (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
(insert (company-strip-prefix candidate)) (insert (company-strip-prefix candidate))
(unless (equal company-prefix candidate)
(delete-region (- (point) (length company-prefix)) (point)) (delete-region (- (point) (length company-prefix)) (point))
(insert-before-markers candidate))) (insert candidate))))
(defmacro company-with-candidate-inserted (candidate &rest body) (defmacro company-with-candidate-inserted (candidate &rest body)
"Evaluate BODY with CANDIDATE temporarily inserted. "Evaluate BODY with CANDIDATE temporarily inserted.
@ -1028,7 +1051,7 @@ can retrieve meta-data for them."
(defun company-call-frontends (command) (defun company-call-frontends (command)
(dolist (frontend company-frontends) (dolist (frontend company-frontends)
(condition-case err (condition-case-unless-debug err
(funcall frontend command) (funcall frontend command)
(error (error "Company: Front-end %s error \"%s\" on command %s" (error (error "Company: Front-end %s error \"%s\" on command %s"
frontend (error-message-string err) command))))) frontend (error-message-string err) command)))))
@ -1039,58 +1062,49 @@ can retrieve meta-data for them."
(mod selection company-candidates-length) (mod selection company-candidates-length)
(max 0 (min (1- company-candidates-length) selection)))) (max 0 (min (1- company-candidates-length) selection))))
(when (or force-update (not (equal selection company-selection))) (when (or force-update (not (equal selection company-selection)))
(company--update-group-lighter (nth selection company-candidates))
(setq company-selection selection (setq company-selection selection
company-selection-changed t) company-selection-changed t)
(company-call-frontends 'update))) (company-call-frontends 'update)))
(defun company--update-group-lighter (candidate) (defun company--group-lighter (candidate base)
(when (listp company-backend)
(let ((backend (or (get-text-property 0 'company-backend candidate) (let ((backend (or (get-text-property 0 'company-backend candidate)
(car company-backend)))) (car company-backend))))
(when (and backend (symbolp backend)) (when (and backend (symbolp backend))
(let ((name (replace-regexp-in-string "company-\\|-company" "" (let ((name (replace-regexp-in-string "company-\\|-company" ""
(symbol-name backend)))) (symbol-name backend))))
(setq company-lighter (format " company-<%s>" name))))))) (format "%s-<%s>" base name)))))
(defun company-apply-predicate (candidates predicate)
(let (new)
(dolist (c candidates)
(when (funcall predicate c)
(push c new)))
(nreverse new)))
(defun company-update-candidates (candidates) (defun company-update-candidates (candidates)
(setq company-candidates-length (length candidates)) (setq company-candidates-length (length candidates))
(if (> company-selection 0) (if company-selection-changed
;; Try to restore the selection ;; Try to restore the selection
(let ((selected (nth company-selection company-candidates))) (let ((selected (nth company-selection company-candidates)))
(setq company-selection 0 (setq company-selection 0
company-candidates candidates) company-candidates candidates)
(when selected (when selected
(while (and candidates (string< (pop candidates) selected)) (catch 'found
(while candidates
(let ((candidate (pop candidates)))
(when (and (string= candidate selected)
(equal (company-call-backend 'annotation candidate)
(company-call-backend 'annotation selected)))
(throw 'found t)))
(cl-incf company-selection)) (cl-incf company-selection))
(unless candidates (setq company-selection 0
;; Make sure selection isn't out of bounds. company-selection-changed nil))))
(setq company-selection (min (1- company-candidates-length)
company-selection)))))
(setq company-selection 0 (setq company-selection 0
company-candidates candidates)) company-candidates candidates))
;; Save in cache:
(push (cons company-prefix company-candidates) company-candidates-cache)
;; Calculate common. ;; Calculate common.
(let ((completion-ignore-case (company-call-backend 'ignore-case))) (let ((completion-ignore-case (company-call-backend 'ignore-case)))
;; We want to support non-prefix completion, so filtering is the ;; We want to support non-prefix completion, so filtering is the
;; responsibility of each respective backend, not ours. ;; responsibility of each respective backend, not ours.
;; On the other hand, we don't want to replace non-prefix input in ;; On the other hand, we don't want to replace non-prefix input in
;; `company-complete-common'. ;; `company-complete-common', unless there's only one candidate.
(setq company-common (setq company-common
(if (cdr company-candidates) (if (cdr company-candidates)
(let ((common (try-completion company-prefix company-candidates))) (let ((common (try-completion "" company-candidates)))
(if (eq common t) (when (string-prefix-p company-prefix common
;; Mulple equal strings, probably with different completion-ignore-case)
;; annotations.
company-prefix
common)) common))
(car company-candidates))))) (car company-candidates)))))
@ -1107,11 +1121,14 @@ can retrieve meta-data for them."
company-candidates-cache))) company-candidates-cache)))
(setq candidates (all-completions prefix prev)) (setq candidates (all-completions prefix prev))
(cl-return t))))) (cl-return t)))))
;; no cache match, call back-end (progn
(setq candidates ;; No cache match, call the backend.
(company--process-candidates (setq candidates (company--preprocess-candidates
(company--fetch-candidates prefix)))) (company--fetch-candidates prefix)))
(setq candidates (company--transform-candidates candidates)) ;; Save in cache.
(push (cons prefix candidates) company-candidates-cache)))
;; Only now apply the predicate and transformers.
(setq candidates (company--postprocess-candidates candidates))
(when candidates (when candidates
(if (or (cdr candidates) (if (or (cdr candidates)
(not (eq t (compare-strings (car candidates) nil nil (not (eq t (compare-strings (car candidates) nil nil
@ -1136,13 +1153,13 @@ can retrieve meta-data for them."
(cdr c) (cdr c)
(lambda (candidates) (lambda (candidates)
(if (not (and candidates (eq res 'done))) (if (not (and candidates (eq res 'done)))
;; Fetcher called us back right away. ;; There's no completions to display,
;; or the fetcher called us back right away.
(setq res candidates) (setq res candidates)
(setq company-backend backend (setq company-backend backend
company-candidates-cache company-candidates-cache
(list (cons prefix (list (cons prefix
(company--process-candidates (company--preprocess-candidates candidates))))
candidates))))
(company-idle-begin buf win tick pt))))) (company-idle-begin buf win tick pt)))))
;; FIXME: Relying on the fact that the callers ;; FIXME: Relying on the fact that the callers
;; will interpret nil as "do nothing" is shaky. ;; will interpret nil as "do nothing" is shaky.
@ -1150,33 +1167,40 @@ can retrieve meta-data for them."
(or res (or res
(progn (setq res 'done) nil))))) (progn (setq res 'done) nil)))))
(defun company--process-candidates (candidates) (defun company--preprocess-candidates (candidates)
(when company-candidates-predicate
(setq candidates
(company-apply-predicate candidates
company-candidates-predicate)))
(unless (company-call-backend 'sorted) (unless (company-call-backend 'sorted)
(setq candidates (sort candidates 'string<))) (setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates) (when (company-call-backend 'duplicates)
(company--strip-duplicates candidates)) (company--strip-duplicates candidates))
candidates) candidates)
(defun company--postprocess-candidates (candidates)
(when (or company-candidates-predicate company-transformers)
(setq candidates (copy-sequence candidates)))
(when company-candidates-predicate
(setq candidates (cl-delete-if-not company-candidates-predicate candidates)))
(company--transform-candidates candidates))
(defun company--strip-duplicates (candidates) (defun company--strip-duplicates (candidates)
(let ((c2 candidates)) (let ((c2 candidates)
(annos 'unk))
(while c2 (while c2
(setcdr c2 (setcdr c2
(let ((str (car c2)) (let ((str (pop c2)))
(anno 'unk))
(pop c2)
(while (let ((str2 (car c2))) (while (let ((str2 (car c2)))
(if (not (equal str str2)) (if (not (equal str str2))
nil (progn
(when (eq anno 'unk) (setq annos 'unk)
(setq anno (company-call-backend nil)
'annotation str))) (when (eq annos 'unk)
(equal anno (setq annos (list (company-call-backend
(company-call-backend 'annotation str))))
'annotation str2)))) (let ((anno2 (company-call-backend
'annotation str2)))
(if (member anno2 annos)
t
(push anno2 annos)
nil))))
(pop c2)) (pop c2))
c2))))) c2)))))
@ -1279,22 +1303,22 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(eq pos (point)) (eq pos (point))
(when (company-auto-begin) (when (company-auto-begin)
(company-input-noop) (company-input-noop)
(company-post-command)))) (let ((this-command 'company-idle-begin))
(company-post-command)))))
(defun company-auto-begin () (defun company-auto-begin ()
(and company-mode (and company-mode
(not company-candidates) (not company-candidates)
(let ((company-idle-delay 'now)) (let ((company-idle-delay 'now))
(condition-case-unless-debug err (condition-case-unless-debug err
(progn
(company--perform) (company--perform)
;; Return non-nil if active.
company-candidates)
(error (message "Company: An error occurred in auto-begin") (error (message "Company: An error occurred in auto-begin")
(message "%s" (error-message-string err)) (message "%s" (error-message-string err))
(company-cancel)) (company-cancel))
(quit (company-cancel))))) (quit (company-cancel))))))
(unless company-candidates
(setq company-backend nil))
;; Return non-nil if active.
company-candidates)
(defun company-manual-begin () (defun company-manual-begin ()
(interactive) (interactive)
@ -1302,7 +1326,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(setq company--manual-action t) (setq company--manual-action t)
(unwind-protect (unwind-protect
(let ((company-minimum-prefix-length 0)) (let ((company-minimum-prefix-length 0))
(company-auto-begin)) (or company-candidates
(company-auto-begin)))
(unless company-candidates (unless company-candidates
(setq company--manual-action nil)))) (setq company--manual-action nil))))
@ -1364,6 +1389,7 @@ from the rest of the back-ends in the group, if any, will be left at the end."
((and (or (not (company-require-match-p)) ((and (or (not (company-require-match-p))
;; Don't require match if the new prefix ;; Don't require match if the new prefix
;; doesn't continue the old one, and the latter was a match. ;; doesn't continue the old one, and the latter was a match.
(not (stringp new-prefix))
(<= (length new-prefix) (length company-prefix))) (<= (length new-prefix) (length company-prefix)))
(member company-prefix company-candidates)) (member company-prefix company-candidates))
;; Last input was a success, ;; Last input was a success,
@ -1441,9 +1467,6 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(message "No completion found")) (message "No completion found"))
(when company--manual-action (when company--manual-action
(setq company--manual-prefix prefix)) (setq company--manual-prefix prefix))
(if (symbolp backend)
(setq company-lighter (concat " " (symbol-name backend)))
(company--update-group-lighter (car c)))
(company-update-candidates c) (company-update-candidates c)
(run-hook-with-args 'company-completion-started-hook (run-hook-with-args 'company-completion-started-hook
(company-explicit-action-p)) (company-explicit-action-p))
@ -1453,7 +1476,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(defun company--perform () (defun company--perform ()
(or (and company-candidates (company--continue)) (or (and company-candidates (company--continue))
(and (company--should-complete) (company--begin-new))) (and (company--should-complete) (company--begin-new)))
(when company-candidates (if (not company-candidates)
(setq company-backend nil)
(setq company-point (point) (setq company-point (point)
company--point-max (point-max)) company--point-max (point-max))
(company-ensure-emulation-alist) (company-ensure-emulation-alist)
@ -1480,7 +1504,6 @@ from the rest of the back-ends in the group, if any, will be left at the end."
company-selection-changed nil company-selection-changed nil
company--manual-action nil company--manual-action nil
company--manual-prefix nil company--manual-prefix nil
company-lighter company-default-lighter
company--point-max nil company--point-max nil
company-point nil) company-point nil)
(when company-timer (when company-timer
@ -1504,7 +1527,7 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(defun company-pre-command () (defun company-pre-command ()
(unless (company-keep this-command) (unless (company-keep this-command)
(condition-case err (condition-case-unless-debug err
(when company-candidates (when company-candidates
(company-call-frontends 'pre-command) (company-call-frontends 'pre-command)
(unless (company--should-continue) (unless (company--should-continue)
@ -1518,8 +1541,15 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(company-uninstall-map)) (company-uninstall-map))
(defun company-post-command () (defun company-post-command ()
(when (null this-command)
;; Happens when the user presses `C-g' while inside
;; `flyspell-post-command-hook', for example.
;; Or any other `post-command-hook' function that can call `sit-for',
;; or any quittable timer function.
(company-abort)
(setq this-command 'company-abort))
(unless (company-keep this-command) (unless (company-keep this-command)
(condition-case err (condition-case-unless-debug err
(progn (progn
(unless (equal (point) company-point) (unless (equal (point) company-point)
(let (company-idle-delay) ; Against misbehavior while debugging. (let (company-idle-delay) ; Against misbehavior while debugging.
@ -1556,15 +1586,22 @@ from the rest of the back-ends in the group, if any, will be left at the end."
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-search-string nil) (defvar-local company-search-string "")
(defvar-local company-search-lighter " Search: \"\"") (defvar company-search-lighter '(" "
(company-search-filtering "Filter" "Search")
": \""
company-search-string
"\""))
(defvar-local company-search-old-map nil) (defvar-local company-search-filtering nil
"Non-nil to filter the completion candidates by the search string")
(defvar-local company-search-old-selection 0) (defvar-local company--search-old-selection 0)
(defun company-search (text lines) (defvar-local company--search-old-changed nil)
(defun company--search (text lines)
(let ((quoted (regexp-quote text)) (let ((quoted (regexp-quote text))
(i 0)) (i 0))
(cl-dolist (line lines) (cl-dolist (line lines)
@ -1572,24 +1609,46 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(cl-return i)) (cl-return i))
(cl-incf i)))) (cl-incf i))))
(defun company-search-keypad ()
(interactive)
(let* ((name (symbol-name last-command-event))
(last-command-event (aref name (1- (length name)))))
(company-search-printing-char)))
(defun company-search-printing-char () (defun company-search-printing-char ()
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-enabled)
(setq company-search-string (let ((ss (concat company-search-string (string last-command-event))))
(concat (or company-search-string "") (string last-command-event)) (when company-search-filtering
company-search-lighter (concat " Search: \"" company-search-string (company--search-update-predicate ss))
"\"")) (company--search-update-string ss)))
(let ((pos (company-search company-search-string
(nthcdr company-selection company-candidates)))) (defun company--search-update-predicate (&optional ss)
(let* ((company-candidates-predicate
(and (not (string= ss ""))
company-search-filtering
(lambda (candidate) (string-match ss candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
(defun company--search-update-string (new)
(let* ((pos (company--search new (nthcdr company-selection company-candidates))))
(if (null pos) (if (null pos)
(ding) (ding)
(setq company-search-string new)
(company-set-selection (+ company-selection pos) t)))) (company-set-selection (+ company-selection pos) t))))
(defun company--search-assert-input ()
(company--search-assert-enabled)
(when (string= company-search-string "")
(error "Empty search string")))
(defun company-search-repeat-forward () (defun company-search-repeat-forward ()
"Repeat the incremental search in completion candidates forward." "Repeat the incremental search in completion candidates forward."
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-input)
(let ((pos (company-search company-search-string (let ((pos (company--search company-search-string
(cdr (nthcdr company-selection (cdr (nthcdr company-selection
company-candidates))))) company-candidates)))))
(if (null pos) (if (null pos)
@ -1599,8 +1658,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(defun company-search-repeat-backward () (defun company-search-repeat-backward ()
"Repeat the incremental search in completion candidates backwards." "Repeat the incremental search in completion candidates backwards."
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-input)
(let ((pos (company-search company-search-string (let ((pos (company--search company-search-string
(nthcdr (- company-candidates-length (nthcdr (- company-candidates-length
company-selection) company-selection)
(reverse company-candidates))))) (reverse company-candidates)))))
@ -1608,47 +1667,39 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(ding) (ding)
(company-set-selection (- company-selection pos 1) t)))) (company-set-selection (- company-selection pos 1) t))))
(defun company-create-match-predicate () (defun company-search-toggle-filtering ()
(setq company-candidates-predicate "Toggle `company-search-filtering'."
`(lambda (candidate)
,(if company-candidates-predicate
`(and (string-match ,company-search-string candidate)
(funcall ,company-candidates-predicate
candidate))
`(string-match ,company-search-string candidate))))
(company-update-candidates
(company-apply-predicate company-candidates company-candidates-predicate))
;; Invalidate cache.
(setq company-candidates-cache (cons company-prefix company-candidates)))
(defun company-filter-printing-char ()
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-enabled)
(company-search-printing-char) (setq company-search-filtering (not company-search-filtering))
(company-create-match-predicate) (let ((ss company-search-string))
(company-call-frontends 'update)) (company--search-update-predicate ss)
(company--search-update-string ss)))
(defun company-search-kill-others ()
"Limit the completion candidates to the ones matching the search string."
(interactive)
(company-search-assert-enabled)
(company-create-match-predicate)
(company-search-mode 0)
(company-call-frontends 'update))
(defun company-search-abort () (defun company-search-abort ()
"Abort searching the completion candidates." "Abort searching the completion candidates."
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-enabled)
(company-set-selection company-search-old-selection t) (company-search-mode 0)
(company-search-mode 0)) (company-set-selection company--search-old-selection t)
(setq company-selection-changed company--search-old-changed))
(defun company-search-other-char () (defun company-search-other-char ()
(interactive) (interactive)
(company-search-assert-enabled) (company--search-assert-enabled)
(company-search-mode 0) (company-search-mode 0)
(company--unread-last-input)) (company--unread-last-input))
(defun company-search-delete-char ()
(interactive)
(company--search-assert-enabled)
(if (string= company-search-string "")
(ding)
(let ((ss (substring company-search-string 0 -1)))
(when company-search-filtering
(company--search-update-predicate ss))
(company--search-update-string ss))))
(defvar company-search-map (defvar company-search-map
(let ((i 0) (let ((i 0)
(keymap (make-keymap))) (keymap (make-keymap)))
@ -1669,18 +1720,26 @@ from the rest of the back-ends in the group, if any, will be left at the end."
(while (< i 256) (while (< i 256)
(define-key keymap (vector i) 'company-search-printing-char) (define-key keymap (vector i) 'company-search-printing-char)
(cl-incf i)) (cl-incf i))
(dotimes (i 10)
(define-key keymap (read (format "[kp-%s]" i)) 'company-search-keypad))
(let ((meta-map (make-sparse-keymap))) (let ((meta-map (make-sparse-keymap)))
(define-key keymap (char-to-string meta-prefix-char) meta-map) (define-key keymap (char-to-string meta-prefix-char) meta-map)
(define-key keymap [escape] meta-map)) (define-key keymap [escape] meta-map))
(define-key keymap (vector meta-prefix-char t) 'company-search-other-char) (define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
(define-key keymap (kbd "M-n") 'company-select-next)
(define-key keymap (kbd "M-p") 'company-select-previous)
(define-key keymap (kbd "<down>") 'company-select-next-or-abort)
(define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
(define-key keymap "\e\e\e" 'company-search-other-char) (define-key keymap "\e\e\e" 'company-search-other-char)
(define-key keymap [escape escape escape] 'company-search-other-char) (define-key keymap [escape escape escape] 'company-search-other-char)
(define-key keymap (kbd "DEL") 'company-search-other-char) (define-key keymap (kbd "DEL") 'company-search-delete-char)
(define-key keymap [backspace] 'company-search-delete-char)
(define-key keymap "\C-g" 'company-search-abort) (define-key keymap "\C-g" 'company-search-abort)
(define-key keymap "\C-s" 'company-search-repeat-forward) (define-key keymap "\C-s" 'company-search-repeat-forward)
(define-key keymap "\C-r" 'company-search-repeat-backward) (define-key keymap "\C-r" 'company-search-repeat-backward)
(define-key keymap "\C-o" 'company-search-kill-others) (define-key keymap "\C-o" 'company-search-toggle-filtering)
(dotimes (i 10)
(define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
keymap) keymap)
"Keymap used for incrementally searching the completion candidates.") "Keymap used for incrementally searching the completion candidates.")
@ -1692,15 +1751,21 @@ Don't start this directly, use `company-search-candidates' or
(if company-search-mode (if company-search-mode
(if (company-manual-begin) (if (company-manual-begin)
(progn (progn
(setq company-search-old-selection company-selection) (setq company--search-old-selection company-selection
(company-call-frontends 'update)) company--search-old-changed company-selection-changed)
(company-call-frontends 'update)
(company-enable-overriding-keymap company-search-map))
(setq company-search-mode nil)) (setq company-search-mode nil))
(kill-local-variable 'company-search-string) (kill-local-variable 'company-search-string)
(kill-local-variable 'company-search-lighter) (kill-local-variable 'company-search-filtering)
(kill-local-variable 'company-search-old-selection) (kill-local-variable 'company--search-old-selection)
(kill-local-variable 'company--search-old-changed)
(when company-backend
(company--search-update-predicate "")
(company-call-frontends 'update))
(company-enable-overriding-keymap company-active-map))) (company-enable-overriding-keymap company-active-map)))
(defun company-search-assert-enabled () (defun company--search-assert-enabled ()
(company-assert-enabled) (company-assert-enabled)
(unless company-search-mode (unless company-search-mode
(company-uninstall-map) (company-uninstall-map)
@ -1713,14 +1778,14 @@ Don't start this directly, use `company-search-candidates' or
- `company-search-repeat-forward' (\\[company-search-repeat-forward]) - `company-search-repeat-forward' (\\[company-search-repeat-forward])
- `company-search-repeat-backward' (\\[company-search-repeat-backward]) - `company-search-repeat-backward' (\\[company-search-repeat-backward])
- `company-search-abort' (\\[company-search-abort]) - `company-search-abort' (\\[company-search-abort])
- `company-search-delete-char' (\\[company-search-delete-char])
Regular characters are appended to the search string. Regular characters are appended to the search string.
The command `company-search-kill-others' (\\[company-search-kill-others]) The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
uses the search string to limit the completion candidates." uses the search string to filter the completion candidates."
(interactive) (interactive)
(company-search-mode 1) (company-search-mode 1))
(company-enable-overriding-keymap company-search-map))
(defvar company-filter-map (defvar company-filter-map
(let ((keymap (make-keymap))) (let ((keymap (make-keymap)))
@ -1733,10 +1798,10 @@ uses the search string to limit the completion candidates."
(defun company-filter-candidates () (defun company-filter-candidates ()
"Start filtering the completion candidates incrementally. "Start filtering the completion candidates incrementally.
This works the same way as `company-search-candidates' immediately This works the same way as `company-search-candidates' immediately
followed by `company-search-kill-others' after each input." followed by `company-search-toggle-filtering'."
(interactive) (interactive)
(company-search-mode 1) (company-search-mode 1)
(company-enable-overriding-keymap company-filter-map)) (setq company-search-filtering t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1770,6 +1835,20 @@ and invoke the normal binding."
(company-abort) (company-abort)
(company--unread-last-input))) (company--unread-last-input)))
(defun company-next-page ()
"Select the candidate one page further."
(interactive)
(when (company-manual-begin)
(company-set-selection (+ company-selection
company-tooltip-limit))))
(defun company-previous-page ()
"Select the candidate one page earlier."
(interactive)
(when (company-manual-begin)
(company-set-selection (- company-selection
company-tooltip-limit))))
(defvar company-pseudo-tooltip-overlay) (defvar company-pseudo-tooltip-overlay)
(defvar company-tooltip-offset) (defvar company-tooltip-offset)
@ -1840,6 +1919,16 @@ and invoke the normal binding."
(when company-common (when company-common
(company--insert-candidate company-common))))) (company--insert-candidate company-common)))))
(defun company-complete-common-or-cycle ()
"Insert the common part of all candidates, or select the next one."
(interactive)
(when (company-manual-begin)
(let ((tick (buffer-chars-modified-tick)))
(call-interactively 'company-complete-common)
(when (eq tick (buffer-chars-modified-tick))
(let ((company-selection-wrap-around t))
(call-interactively 'company-select-next))))))
(defun company-complete () (defun company-complete ()
"Insert the common part of all candidates or the current selection. "Insert the common part of all candidates or the current selection.
The first time this is called, the common part is inserted, the second The first time this is called, the common part is inserted, the second
@ -1854,18 +1943,26 @@ inserted."
(setq this-command 'company-complete-common)))) (setq this-command 'company-complete-common))))
(defun company-complete-number (n) (defun company-complete-number (n)
"Insert the Nth candidate. "Insert the Nth candidate visible in the tooltip.
To show the number next to the candidates in some back-ends, enable To show the number next to the candidates in some back-ends, enable
`company-show-numbers'. When called interactively, uses the last typed `company-show-numbers'. When called interactively, uses the last typed
character, stripping the modifiers. That character must be a digit." character, stripping the modifiers. That character must be a digit."
(interactive (interactive
(list (let ((n (- (event-basic-type last-command-event) ?0))) (list (let* ((type (event-basic-type last-command-event))
(char (if (characterp type)
;; Number on the main row.
type
;; Keypad number, if bound directly.
(car (last (string-to-list (symbol-name type))))))
(n (- char ?0)))
(if (zerop n) 10 n)))) (if (zerop n) 10 n))))
(when (company-manual-begin) (when (company-manual-begin)
(and (or (< n 1) (> n company-candidates-length)) (and (or (< n 1) (> n (- company-candidates-length
company-tooltip-offset)))
(error "No candidate number %d" n)) (error "No candidate number %d" n))
(cl-decf n) (cl-decf n)
(company-finish (nth n company-candidates)))) (company-finish (nth (+ n company-tooltip-offset)
company-candidates))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -2088,7 +2185,9 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(defun company-fill-propertize (value annotation width selected left right) (defun company-fill-propertize (value annotation width selected left right)
(let* ((margin (length left)) (let* ((margin (length left))
(common (or (company-call-backend 'match value) (common (or (company-call-backend 'match value)
(length company-common))) (if company-common
(string-width company-common)
0)))
(ann-ralign company-tooltip-align-annotations) (ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width (ann-truncate (< width
(+ (length value) (length annotation) (+ (length value) (length annotation)
@ -2128,16 +2227,15 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
mouse-face company-tooltip-mouse) mouse-face company-tooltip-mouse)
line)) line))
(when selected (when selected
(if (and company-search-string (if (and (not (string= company-search-string ""))
(string-match (regexp-quote company-search-string) value (string-match (regexp-quote company-search-string) value
(length company-prefix))) (length company-prefix)))
(let ((beg (+ margin (match-beginning 0))) (let ((beg (+ margin (match-beginning 0)))
(end (+ margin (match-end 0)))) (end (+ margin (match-end 0)))
(add-text-properties beg end '(face company-tooltip-search) (width (- width (length right))))
line) (when (< beg width)
(when (< beg common) (add-text-properties beg (min end width)
(add-text-properties beg common '(face company-tooltip-search)
'(face company-tooltip-common-selection)
line))) line)))
(add-text-properties 0 width '(face company-tooltip-selection (add-text-properties 0 width '(face company-tooltip-selection
mouse-face company-tooltip-selection) mouse-face company-tooltip-selection)
@ -2148,12 +2246,32 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
line))) line)))
line)) line))
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
(lambda (match)
(cond
((match-beginning 1)
;; FIXME: Better char for 'non-printable'?
;; We shouldn't get any of these, but sometimes we might.
"\u2017")
((match-beginning 2)
;; Zero-width non-breakable space.
"")
((> (string-width match) 1)
(concat
(make-string (1- (string-width match)) ?\ufeff)
match))
(t match)))
str))
;;; replace ;;; replace
(defun company-buffer-lines (beg end) (defun company-buffer-lines (beg end)
(goto-char beg) (goto-char beg)
(let (lines lines-moved) (let (lines lines-moved)
(while (and (> (setq lines-moved (vertical-motion 1)) 0) (while (and (not (eobp)) ; http://debbugs.gnu.org/19553
(> (setq lines-moved (vertical-motion 1)) 0)
(<= (point) end)) (<= (point) end))
(let ((bound (min end (1- (point))))) (let ((bound (min end (1- (point)))))
;; A visual line can contain several physical lines (e.g. with outline's ;; A visual line can contain several physical lines (e.g. with outline's
@ -2183,6 +2301,30 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
limit limit
(length lst))) (length lst)))
(defsubst company--window-height ()
(if (fboundp 'window-screen-lines)
(floor (window-screen-lines))
(window-body-height)))
(defun company--window-width ()
(let ((ww (window-body-width)))
;; Account for the line continuation column.
(when (zerop (cadr (window-fringes)))
(cl-decf ww))
(unless (or (display-graphic-p)
(version< "24.3.1" emacs-version))
;; Emacs 24.3 and earlier included margins
;; in window-width when in TTY.
(cl-decf ww
(let ((margins (window-margins)))
(+ (or (car margins) 0)
(or (cdr margins) 0)))))
(when (and word-wrap
(version< emacs-version "24.4.51.5"))
;; http://debbugs.gnu.org/18384
(cl-decf ww))
ww))
(defun company--replacement-string (lines old column nl &optional align-top) (defun company--replacement-string (lines old column nl &optional align-top)
(cl-decf column company-tooltip-margin) (cl-decf column company-tooltip-margin)
@ -2207,7 +2349,8 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(while old (while old
(push (company-modify-line (pop old) (push (company-modify-line (pop old)
(company--offset-line (pop lines) offset) (company--offset-line (pop lines) offset)
column) new)) column)
new))
;; Append whole new lines. ;; Append whole new lines.
(while lines (while lines
(push (concat (company-space-string column) (push (concat (company-space-string column)
@ -2229,7 +2372,6 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(defun company--create-lines (selection limit) (defun company--create-lines (selection limit)
(let ((len company-candidates-length) (let ((len company-candidates-length)
(numbered 99999)
(window-width (company--window-width)) (window-width (company--window-width))
lines lines
width width
@ -2271,9 +2413,12 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(dotimes (_ len) (dotimes (_ len)
(let* ((value (pop lines-copy)) (let* ((value (pop lines-copy))
(annotation (company-call-backend 'annotation value))) (annotation (company-call-backend 'annotation value)))
(when (and annotation company-tooltip-align-annotations) (setq value (company--clean-string (company-reformat value)))
(when annotation
(when company-tooltip-align-annotations
;; `lisp-completion-at-point' adds a space. ;; `lisp-completion-at-point' adds a space.
(setq annotation (comment-string-strip annotation t nil))) (setq annotation (comment-string-strip annotation t nil)))
(setq annotation (company--clean-string annotation)))
(push (cons value annotation) items) (push (cons value annotation) items)
(setq width (max (+ (length value) (setq width (max (+ (length value)
(if (and annotation company-tooltip-align-annotations) (if (and annotation company-tooltip-align-annotations)
@ -2283,22 +2428,19 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
(setq width (min window-width (setq width (min window-width
(max company-tooltip-minimum-width (max company-tooltip-minimum-width
(if (and company-show-numbers (if company-show-numbers
(< company-tooltip-offset 10))
(+ 2 width) (+ 2 width)
width)))) width))))
;; number can make tooltip too long (let ((items (nreverse items))
(when company-show-numbers (numbered (if company-show-numbers 0 99999))
(setq numbered company-tooltip-offset)) new)
(let ((items (nreverse items)) new)
(when previous (when previous
(push (company--scrollpos-line previous width) new)) (push (company--scrollpos-line previous width) new))
(dotimes (i len) (dotimes (i len)
(let* ((item (pop items)) (let* ((item (pop items))
(str (company-reformat (car item))) (str (car item))
(annotation (cdr item)) (annotation (cdr item))
(right (company-space-string company-tooltip-margin)) (right (company-space-string company-tooltip-margin))
(width width)) (width width))
@ -2342,26 +2484,6 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
;; show ;; show
(defsubst company--window-height ()
(if (fboundp 'window-screen-lines)
(floor (window-screen-lines))
(window-body-height)))
(defsubst company--window-width ()
(let ((ww (window-body-width)))
;; Account for the line continuation column.
(when (zerop (cadr (window-fringes)))
(cl-decf ww))
(unless (or (display-graphic-p)
(version< "24.3.1" emacs-version))
;; Emacs 24.3 and earlier included margins
;; in window-width when in TTY.
(cl-decf ww
(let ((margins (window-margins)))
(+ (or (car margins) 0)
(or (cdr margins) 0)))))
ww))
(defun company--pseudo-tooltip-height () (defun company--pseudo-tooltip-height ()
"Calculate the appropriate tooltip height. "Calculate the appropriate tooltip height.
Returns a negative number if the tooltip should be displayed above point." Returns a negative number if the tooltip should be displayed above point."
@ -2493,8 +2615,6 @@ Returns a negative number if the tooltip should be displayed above point."
(defun company-preview-show-at-point (pos) (defun company-preview-show-at-point (pos)
(company-preview-hide) (company-preview-hide)
(setq company-preview-overlay (make-overlay pos pos))
(let ((completion (nth company-selection company-candidates))) (let ((completion (nth company-selection company-candidates)))
(setq completion (propertize completion 'face 'company-preview)) (setq completion (propertize completion 'face 'company-preview))
(add-text-properties 0 (length company-common) (add-text-properties 0 (length company-common)
@ -2512,11 +2632,26 @@ Returns a negative number if the tooltip should be displayed above point."
(and (equal pos (point)) (and (equal pos (point))
(not (equal completion "")) (not (equal completion ""))
(add-text-properties 0 1 '(cursor t) completion)) (add-text-properties 0 1 '(cursor 1) completion))
(let* ((beg pos)
(pto company-pseudo-tooltip-overlay)
(ptf-workaround (and
pto
(char-before pos)
(eq pos (overlay-start pto)))))
;; Try to accomodate for the pseudo-tooltip overlay,
;; which may start at the same position if it's at eol.
(when ptf-workaround
(cl-decf beg)
(setq completion (concat (buffer-substring beg pos) completion)))
(setq company-preview-overlay (make-overlay beg pos))
(let ((ov company-preview-overlay)) (let ((ov company-preview-overlay))
(overlay-put ov 'after-string completion) (overlay-put ov (if ptf-workaround 'display 'after-string)
(overlay-put ov 'window (selected-window))))) completion)
(overlay-put ov 'window (selected-window))))))
(defun company-preview-hide () (defun company-preview-hide ()
(when company-preview-overlay (when company-preview-overlay

View File

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

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

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

@ -0,0 +1,481 @@
;;; 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,6 +1,6 @@
;;; company-elisp-tests.el --- company-elisp tests ;;; elisp-tests.el --- company-elisp tests
;; Copyright (C) 2013-2014 Free Software Foundation, Inc. ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Dmitry Gutov ;; Author: Dmitry Gutov
@ -19,12 +19,9 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code: ;;; Code:
(require 'company-tests)
(require 'company-elisp) (require 'company-elisp)
(defmacro company-elisp-with-buffer (contents &rest body) (defmacro company-elisp-with-buffer (contents &rest body)

View File

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

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

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

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

View File

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

View File

@ -1,129 +0,0 @@
;;; company-cmake.el --- company-mode completion back-end for CMake
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.1
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; company-cmake offers completions for module names, variable names and
;; commands used by CMake. And their descriptions.
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-cmake nil
"Completion back-end for CMake."
:group 'company)
(defcustom company-cmake-executable
(executable-find "cmake")
"Location of cmake executable."
:type 'file)
(defvar company-cmake-executable-arguments
'("--help-command-list"
"--help-module-list"
"--help-variable-list")
"The arguments we pass to cmake, separately.
They affect which types of symbols we get completion candidates for.")
(defvar company-cmake--completion-pattern
"^\\(%s[a-zA-Z0-9_]%s\\)$"
"Regexp to match the candidates.")
(defvar company-cmake-modes '(cmake-mode)
"Major modes in which cmake may complete.")
(defvar company-cmake--meta-command-cache nil
"Cache for command arguments to retrieve descriptions for the candidates.")
(defun company-cmake--parse-output (prefix cmd)
"Analyze the temp buffer and collect lines."
(goto-char (point-min))
(let ((pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(case-fold-search nil)
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(puthash match cmd company-cmake--meta-command-cache)
(push match lines))
lines))
(defun company-cmake--candidates (prefix)
(let ((res 0)
results
cmd)
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal))
(dolist (arg company-cmake-executable-arguments)
(with-temp-buffer
(setq res (call-process company-cmake-executable nil t nil arg))
(unless (eq 0 res)
(message "cmake executable exited with error=%d" res))
(setq cmd (replace-regexp-in-string "-list$" "" arg) )
(setq results (nconc results (company-cmake--parse-output prefix cmd)))))
results))
(defun company-cmake--meta (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache))
result)
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; Go to the third line, trim it and return the result.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(setq result (buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
(setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result))
result)))
(defun company-cmake--doc-buffer (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache)))
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; Go to the third line, trim it and return the doc buffer.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(company-doc-buffer
(buffer-substring-no-properties (line-beginning-position)
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
"`company-mode' completion back-end for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-cmake))
(init (when (memq major-mode company-cmake-modes)
(unless company-cmake-executable
(error "Company found no cmake executable"))))
(prefix (and (memq major-mode company-cmake-modes)
(not (company-in-string-or-comment))
(company-grab-symbol)))
(candidates (company-cmake--candidates arg))
(meta (company-cmake--meta arg))
(doc-buffer (company-cmake--doc-buffer arg))
))
(provide 'company-cmake)
;;; company-cmake.el ends here

View File

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

View File

@ -1,911 +0,0 @@
;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ert)
(require 'company)
(require 'company-keywords)
(require 'company-clang)
(defun company--column (&optional pos)
(car (company--col-row pos)))
;;; Core
(ert-deftest company-sorted-keywords ()
"Test that keywords in `company-keywords-alist' are in alphabetical order."
(dolist (pair company-keywords-alist)
(when (consp (cdr pair))
(let ((prev (cadr pair)))
(dolist (next (cddr pair))
(should (not (equal prev next)))
(should (string< prev next))
(setq prev next))))))
(ert-deftest company-good-prefix ()
(let ((company-minimum-prefix-length 5)
company-abort-manual-when-too-short
company--manual-action ;idle begin
(company-selection-changed t)) ;has no effect
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq nil (company--good-prefix-p "abcd")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq nil (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p '("foo" . t))))))
(ert-deftest company--manual-prefix-set-and-unset ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-manual-begin)
(should (equal "ab" company--manual-prefix))
(company-abort)
(should (null company--manual-prefix)))))
(ert-deftest company-abort-manual-when-too-short ()
(let ((company-minimum-prefix-length 5)
(company-abort-manual-when-too-short t)
(company-selection-changed t)) ;has not effect
(let ((company--manual-action nil)) ;idle begin
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq t (company--good-prefix-p '("foo" . t)))))
(let ((company--manual-action t)
(company--manual-prefix "abc")) ;manual begin from this prefix
(should (eq t (company--good-prefix-p "!@#$")))
(should (eq nil (company--good-prefix-p "ab")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p "abcd")))
(should (eq t (company--good-prefix-p "abc")))
(should (eq t (company--good-prefix-p '("bar" . t)))))))
(ert-deftest company-multi-backend-with-lambdas ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("c" "d")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
(ert-deftest company-multi-backend-filters-backends-by-prefix ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix (cons "z" t))
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "t")
(candidates '("c" "d"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("e" "f")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
(ert-deftest company-multi-backend-remembers-candidate-backend ()
(let ((company-backend
(list (lambda (command &optional arg)
(cl-case command
(ignore-case nil)
(annotation "1")
(candidates '("a" "c"))
(post-completion "13")))
(lambda (command &optional arg)
(cl-case command
(ignore-case t)
(annotation "2")
(candidates '("b" "d"))
(post-completion "42")))
(lambda (command &optional arg)
(cl-case command
(annotation "3")
(candidates '("e"))
(post-completion "74"))))))
(let ((candidates (company-calculate-candidates nil)))
(should (equal candidates '("a" "b" "c" "d" "e")))
(should (equal t (company-call-backend 'ignore-case)))
(should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
(should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
(should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
(should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
(should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
(should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
(ert-deftest company-multi-backend-handles-keyword-with ()
(let ((primo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("abb" "abc" "abd")))))
(secundo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("acc" "acd"))))))
(let ((company-backend (list 'ignore 'ignore :with secundo)))
(should (null (company-call-backend 'prefix))))
(let ((company-backend (list 'ignore primo :with secundo)))
(should (equal "a" (company-call-backend 'prefix)))
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
(company-mode)
(should-error
(company-begin-backend (lambda (command &rest ignore))))
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("a" "ab" "ac")))))))
(let (this-command)
(company-call 'complete))
(should (eq 3 company-candidates-length)))))
(ert-deftest company-require-match-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 2 company-candidates-length))
(should (eq 3 (point))))))
(ert-deftest company-dont-require-match-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-minimum-prefix-length 2)
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (eq 2 company-candidates-length))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq nil company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-dont-require-match-if-old-prefix-ended-and-was-a-match ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (company-grab-word))
(candidates '("abc" "ab" "abd"))
(sorted t))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 3 company-candidates-length))
(should (eq 3 (point)))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (null company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-should-complete-whitelist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands nil))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-should-complete-blacklist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands '(not backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(not backward-delete-char-untabify)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-auto-complete-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "abcd " (buffer-string))))))
(ert-deftest company-no-auto-complete-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-minimum-prefix-length 2)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "ab " (buffer-string))))))
(ert-deftest company-clears-explicit-action-when-no-matches ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-backends)
(company-call 'manual-begin) ;; fails
(should (null company-candidates))
(should (null (company-explicit-action-p))))))
(ert-deftest company-ignore-case-replaces-prefix ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case t))))))
(insert "A")
(let (this-command)
(company-complete))
(should (string= "ab" (buffer-string)))
(delete-char -2)
(insert "A") ; hack, to keep it in one test
(company-complete-selection)
(should (string= "abcd" (buffer-string))))))
(ert-deftest company-ignore-case-with-keep-prefix ()
(with-temp-buffer
(insert "AB")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case 'keep-prefix))))))
(let (this-command)
(company-complete))
(company-complete-selection)
(should (string= "ABcd" (buffer-string))))))
(ert-deftest company-non-prefix-completion ()
(with-temp-buffer
(insert "tc")
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("tea-cup" "teal-color")))))))
(let (this-command)
(company-complete))
(should (string= "tc" (buffer-string)))
(company-complete-selection)
(should (string= "tea-cup" (buffer-string))))))
(ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(save-excursion (insert " ff"))
(company-mode)
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
(list (lambda (c &optional arg)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
(should (eq 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) t)))))))
(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-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)))))
(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-modify-line ()
(let ((str "-*-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 4)
"-*-fzzbar"))
(should (equal-including-properties
(company-modify-line str "xx" 0)
"xx-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 10)
"-*-foobar zz"))))
(ert-deftest company-scrollbar-bounds ()
(should (equal nil (company--scrollbar-bounds 0 3 3)))
(should (equal nil (company--scrollbar-bounds 0 4 3)))
(should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
(should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
(should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
(should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
(should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
;;; Async
(defun company-async-backend (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb)
(run-with-timer 0.05 nil
#'funcall cb '("abc" "abd")))))))
(ert-deftest company-call-backend-forces-sync ()
(let ((company-backend 'company-async-backend)
(company-async-timeout 0.1))
(should (equal '("abc" "abd") (company-call-backend 'candidates)))))
(ert-deftest company-call-backend-errors-on-timeout ()
(with-temp-buffer
(let* ((company-backend (lambda (command &optional _arg)
(pcase command
(`candidates (cons :async 'ignore)))))
(company-async-timeout 0.1)
(err (should-error (company-call-backend 'candidates "foo"))))
(should (string-match-p "async timeout" (cadr err))))))
(ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
(let ((company-backend 'company-async-backend))
(should (equal "foo" (company-call-backend-raw 'prefix)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
(ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-manual-begin)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-allows-async-candidates ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(sleep-for 0.1)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(insert "a")
(sleep-for 0.1)
(should (null company-candidates)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(pcase command
(`prefix (buffer-substring (point-min) (point)))
(`candidates
(let ((c (all-completions arg '("abc" "def"))))
(cons :async
(lambda (cb) (funcall cb c)))))
(`no-cache t)))))
(company-minimum-prefix-length 0))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (equal '("abc" "def") company-candidates))
(let ((last-command-event ?a))
(company-call 'self-insert-command 1))
(should (equal '("abc") company-candidates)))))
(ert-deftest company-multi-backend-forces-prefix-to-sync ()
(with-temp-buffer
(let ((company-backend (list 'ignore
(lambda (command)
(should (eq command 'prefix))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb nil))))))
(lambda (command)
(should (eq command 'prefix))
"foo"))))
(should (equal "foo" (company-call-backend-raw 'prefix))))
(let ((company-backend (list (lambda (_command)
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb "bar"))))))
(lambda (_command)
"foo"))))
(should (equal "bar" (company-call-backend-raw 'prefix))))))
(ert-deftest company-multi-backend-merges-deferred-candidates ()
(with-temp-buffer
(let* ((immediate (lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("f"))))))))
(company-backend (list 'ignore
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(should (equal arg "foo"))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb '("a" "b")))))))))
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates '("c" "d" "e"))))
immediate)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal '("a" "b" "c" "d" "e" "f")
(company-call-backend 'candidates "foo")))
(let ((company-backend (list immediate)))
(should (equal '("f") (company-call-backend 'candidates "foo")))))))
;;; Transformers
(ert-deftest company-occurrence-prefer-closest-above ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-closest-above))
(should (equal '("foo1" "foo0" "foo3" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
(ert-deftest company-occurrence-prefer-any-closest ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-any-closest))
(should (equal '("foo1" "foo3" "foo0" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(dotimes (i 2)
(insert " ")
(company-template-add-field tpl (point) "foo")))
(company-call 'template-forward-field)
(should (= 3 (point)))
(company-call 'template-forward-field)
(should (= 7 (point)))
(company-call 'template-forward-field)
(should (= 11 (point)))
(should (zerop (length (overlay-get tpl 'company-template-fields))))
(should (null (overlay-buffer tpl))))))
(ert-deftest company-template-removed-after-input-and-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(insert " ")
(company-template-add-field tpl (point) "bar"))
(company-call 'template-move-to-first tpl)
(should (= 3 (point)))
(dolist (c (string-to-list "tee"))
(let ((last-command-event c))
(company-call 'self-insert-command 1)))
(should (string= "{ tee }" (buffer-string)))
(should (overlay-buffer tpl))
(company-call 'template-forward-field)
(should (= 7 (point)))
(should (null (overlay-buffer tpl))))))
(defun company-call (name &rest args)
(let* ((maybe (intern (format "company-%s" name)))
(command (if (fboundp maybe) maybe name)))
(let ((this-command command))
(run-hooks 'pre-command-hook))
(apply command args)
(let ((this-command command))
(run-hooks 'post-command-hook))))
(ert-deftest company-template-c-like-templatify ()
(with-temp-buffer
(let ((text "foo(int a, short b)"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0"))
(should (equal "int a"
(overlay-get (company-template-field-at) 'display))))))
(ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
(with-temp-buffer
(let ((text "foo(int a, short b)!@ #1334 a"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0")))))
;;; Clang
(ert-deftest company-clang-objc-templatify ()
(with-temp-buffer
(let ((text "createBookWithTitle:andAuthor:"))
(insert text)
(company-clang-objc-templatify text)
(should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
(should (looking-at "arg0"))
(should (null (overlay-get (company-template-field-at) 'display))))))

View File

@ -1,30 +0,0 @@
;;; git-commit-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-commit-mode" "git-commit-mode.el" (21633
;;;;;; 45697 22043 886000))
;;; Generated autoloads from git-commit-mode.el
(autoload 'git-commit-mode "git-commit-mode" "\
Major mode for editing git commit messages.
This mode helps with editing git commit messages both by
providing commands to do common tasks, and by highlighting the
basic structure of and errors in git commit messages.
\(fn)" t nil)
(eval-after-load 'magit '(progn (setq git-commit-skip-magit-header-regexp (format "\\(?:\\(?:[A-Za-z0-9-_]+: *.*\n\\)*%s\\)?" (regexp-quote magit-log-header-end))) (defvar git-commit-magit-font-lock-keywords `((,git-commit-skip-magit-header-regexp (0 'git-commit-skip-magit-header-face))) "Font lock keywords for Magit Log Edit Mode.") (define-derived-mode magit-log-edit-mode git-commit-mode "Magit Log Edit" (font-lock-add-keywords nil git-commit-magit-font-lock-keywords) (set (make-local-variable 'git-commit-commit-function) (apply-partially #'call-interactively 'magit-log-edit-commit))) (substitute-key-definition 'magit-log-edit-toggle-signoff 'git-commit-signoff magit-log-edit-mode-map) (substitute-key-definition 'magit-log-edit-commit 'git-commit-commit magit-log-edit-mode-map)))
(dolist (pattern '("/COMMIT_EDITMSG\\'" "/NOTES_EDITMSG\\'" "/MERGE_MSG\\'" "/TAG_EDITMSG\\'" "/PULLREQ_EDITMSG\\'")) (add-to-list 'auto-mode-alist (cons pattern 'git-commit-mode)))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; git-commit-mode-autoloads.el ends here

View File

@ -1 +0,0 @@
(define-package "git-commit-mode" "0.13" "Major mode for editing git commit messages" 'nil)

View File

@ -1,601 +0,0 @@
;;; git-commit-mode.el --- Major mode for editing git commit messages -*- lexical-binding: t; -*-
;; Copyright (c) 2012, 2013 Sebastian Wiesner <lunaryorn@gmail.com>
;; Copyright (c) 2010 Florian Ragwitz.
;;
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; Florian Ragwitz <rafl@debian.org>
;; Maintainer: Sebastian Wiesner <lunaryorn@gmail.com>
;; URL: https://github.com/lunaryorn/git-modes
;; Version: 0.13
;; 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 Git commit messages.
;; * Formatting
;;
;; Highlight the formatting of git commit messages and indicate errors according
;; to the guidelines for commit messages (see
;; http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html).
;;
;; Highlight the first line (aka "summary") specially if it exceeds 54
;; characters.
;;
;; Enable `auto-fill-mode' and set the `fill-column' to 72 according to the
;; aforementioned guidelines.
;; * Headers
;;
;; Provide commands to insert standard headers into commit messages.
;;
;; - C-c C-x s or C-c C-s inserts Signed-off-by (`git-commit-signoff').
;; - C-C C-x a inserts Acked-by (`git-commit-ack').
;; - C-c C-x t inserts Tested-by (`git-commit-test').
;; - C-c C-x r inserts Reviewed-by (`git-commit-review').
;; - C-c C-x o inserts Cc (`git-commit-cc').
;; - C-c C-x p inserts Reported-by (`git-commit-reported').
;; * Committing
;;
;; C-c C-c finishes a commit. By default this means to save and kill the
;; buffer. Customize `git-commit-commit-function' to change this behaviour.
;;
;; Check a buffer for stylistic errors before committing, and ask for
;; confirmation before committing with style errors.
;; * Magit integration
;;
;; Overwrite `magit-log-edit-mode' to provide font locking and header insertion
;; for Magit.
;;
;; Change the keymap of `magit-log-edit-mode' to use the header insertion of
;; `git-commit-mode'.
;;; Code:
(defgroup git-commit nil
"Mode for editing git commit messages"
:prefix "git-commit-"
:group 'tools)
(defgroup git-commit-faces nil
"Faces for highlighting git commit messages"
:prefix "git-commit-"
:group 'git-commit
:group 'faces)
(defface git-commit-summary-face
'((t :inherit font-lock-type-face))
"Face used to highlight the summary in git commit messages"
:group 'git-commit-faces)
(defface git-commit-overlong-summary-face
'((t :inherit font-lock-warning-face))
"Face used to highlight overlong parts of git commit message summaries"
:group 'git-commit-faces)
(defface git-commit-nonempty-second-line-face
'((t :inherit font-lock-warning-face))
"Face used to highlight text on the second line of git commit messages"
:group 'git-commit-faces)
(defface git-commit-note-face
'((t :inherit font-lock-string-face))
"Face used to highlight notes in git commit messages"
:group 'git-commit-faces)
(defface git-commit-pseudo-header-face
'((t :inherit font-lock-string-face))
"Font used to hightlight pseudo headers in git commit messages"
:group 'git-commit-faces)
(defface git-commit-known-pseudo-header-face
'((t :inherit font-lock-keyword-face))
"Face used to hightlight common pseudo headers in git commit messages"
:group 'git-commit-faces)
(defface git-commit-branch-face
'((t :inherit font-lock-variable-name-face))
"Face used to highlight the branch name in comments in git commit messages"
:group 'git-commit-faces)
(defface git-commit-no-branch-face
'((t :inherit git-commit-branch-face))
"Face used when a commit is going to be made outside of any branches"
:group 'git-commit-faces)
(defface git-commit-comment-heading-face
'((t :inherit git-commit-known-pseudo-header-face))
"Face used to highlight section headings in the default
comments in git commit messages"
:group 'git-commit-faces)
(defface git-commit-comment-file-face
'((t :inherit git-commit-pseudo-header-face))
"Face used to highlight file names in the default comments in
git commit messages"
:group 'git-commit-faces)
(defface git-commit-comment-action-face
'((t :inherit git-commit-branch-face))
"Face used to highlight what has happened to files in the
default comments in git commit messages"
:group 'git-commit-faces)
(defface git-commit-skip-magit-header-face
'((t :inherit font-lock-preprocessor-face))
"Face used to highlight the magit header that should be skipped"
:group 'git-commit-faces)
(defun git-commit-end-session ()
"Save the buffer and end the session.
If the current buffer has clients from the Emacs server, call
`server-edit' to mark the buffer as done and let the clients
continue, otherwise kill the buffer via `kill-buffer'."
(save-buffer)
(if (and (fboundp 'server-edit)
(boundp 'server-buffer-clients)
server-buffer-clients)
(server-edit) ; The message buffer comes from emacsclient
(kill-buffer)))
(defcustom git-commit-commit-function
#'git-commit-end-session
"Function called by `git-commit-commit' to actually perform a commit.
The function is called without argument, with the current buffer
being the commit message buffer. It shall return t, if the
commit was successful, or nil otherwise."
:group 'git-commit
:type '(radio (function-item :doc "Save the buffer and end the session."
git-commit-end-session)
(function)))
(defcustom git-commit-confirm-commit t
"Whether to ask for confirmation before committing.
If t, ask for confirmation before creating a commit with style
errors, unless the commit is forced. If nil, never ask for
confirmation before committing."
:group 'git-commit
:type '(choice (const :tag "On style errors" t)
(const :tag "Never" nil)))
(defun git-commit-has-style-errors-p ()
"Check whether the current buffer has style errors.
Return t, if the current buffer has style errors, or nil
otherwise."
(save-excursion
(goto-char (point-min))
(when (re-search-forward (git-commit-find-summary-regexp) nil t)
(or (string-match-p ".+" (or (match-string 2) ""))
(string-match-p "^.+$" (or (match-string 3) ""))))))
(defun git-commit-may-do-commit (&optional force)
"Check whether a commit may be performed.
Check for stylistic errors in the current message, unless FORCE
is non-nil. If stylistic errors are found, ask the user to
confirm commit depending on `git-commit-confirm-commit'.
Return t if the commit may be performed, or nil otherwise."
(cond
((or force (not git-commit-confirm-commit))
t)
((git-commit-has-style-errors-p)
(yes-or-no-p "Buffer has style errors. Commit anyway?"))
(t t)))
(defun git-commit-commit (&optional force)
"Finish editing the commit message and commit.
Check for stylistic errors in the current commit, and ask the
user for confirmation depending on `git-commit-confirm-commit'.
If FORCE is non-nil or if a raw prefix arg is given, commit
immediately without asking.
Call `git-commit-commit-function' to actually perform the commit.
Return t, if the commit was successful, or nil otherwise."
(interactive "P")
(if (git-commit-may-do-commit force)
(funcall git-commit-commit-function)
(message "Commit canceled due to stylistic errors.")))
(defun git-commit-git-config-var (key)
"Retrieve a git configuration value.
Invokes 'git config --get' to retrieve the value for the
configuration key KEY."
(ignore-errors
(car (process-lines "git" "config" "--get" key))))
(defun git-commit-first-env-var (&rest vars)
"Get the value of the first defined environment variable.
Walk VARS, call `getenv' on each element and return the first
non-nil return value of `getenv'."
(let ((current vars)
(val nil))
(while (and (not val) current)
(setq val (getenv (car current)))
(setq current (cdr current)))
val))
(defun git-commit-committer-name ()
"Get the git committer name of the current user.
This uses the same mechanism git itself uses. That is, using the
value of the 'GIT_AUTHOR_NAME' or 'GIT_COMMITTER_NAME'
environment variables, or the 'user.name' git configuration
variable.
If the above mechanism fails, the value of the variable
`user-full-name' is used."
(or
(git-commit-first-env-var "GIT_AUTHOR_NAME" "GIT_COMMITTER_NAME")
(git-commit-git-config-var "user.name")
user-full-name))
(defun git-commit-committer-email ()
"Get the git committer email address of the current user.
This uses the same mechanism git itself uses. That is, using the
value of the 'GIT_AUTHOR_EMAIL', 'GIT_COMMITTER_EMAIL', or
'EMAIL' environment variables, or the 'user.email' git
configuration variable.
If the above mechanism fails, the value of the variable
`user-email-address' is used."
(or
(git-commit-first-env-var "GIT_AUTHOR_EMAIL" "GIT_COMMITTER_EMAIL" "EMAIL")
(git-commit-git-config-var "user.email")
user-mail-address))
(defconst git-commit-known-pseudo-headers
'("Signed-off-by"
"Acked-by"
"Cc"
"Reported-by"
"Tested-by"
"Reviewed-by")
"A list of git pseudo headers to be highlighted.")
(defun git-commit-find-pseudo-header-position ()
"Find the position at which commit pseudo headers should be inserted.
Those headers usually live at the end of a commit message, but
before any trailing comments git or the user might have
inserted."
(save-excursion
(goto-char (point-max))
(if (not (re-search-backward "^\\S<.+$" nil t))
;; no comment lines anywhere before end-of-buffer, so we
;; want to insert right there
(point-max)
;; there's some comments at the end, so we want to insert before
;; those; keep going until we find the first non-empty line
;; NOTE: if there is no newline at the end of (point),
;; (forward-line 1) will take us to (point-at-eol).
(if (eq (point-at-bol) (point-at-eol)) (re-search-backward "^.+$" nil t))
(forward-line 1)
(point))))
(defun git-commit-determine-pre-for-pseudo-header ()
"Find the characters to insert before the pseudo header.
Returns either zero, one or two newlines after computation.
`point' either points to an empty line (with a non-empty previous
line) or the end of a non-empty line."
(let ((pre "")
(prev-line nil))
(if (not (eq (point) (point-at-bol)))
(progn
(setq pre (concat pre "\n"))
(setq prev-line (thing-at-point 'line)))
;; else: (point) is at an empty line
(when (not (eq (point) (point-min)))
(setq prev-line
(save-excursion
(forward-line -1)
(thing-at-point 'line)))))
;; we have prev-line now; if it doesn't match any known pseudo
;; header, add a newline
(when prev-line
(if (not (delq nil (mapcar (lambda (pseudo-header) (string-match pseudo-header prev-line))
git-commit-known-pseudo-headers)))
(setq pre (concat pre "\n"))))
pre))
(defun git-commit-insert-header (type name email)
"Insert a header into the commit message.
The inserted headers have the format 'TYPE: NAME <EMAIL>'.
The header is inserted at the position returned by
`git-commit-find-pseudo-header-position'. When this position
isn't after an existing header or a newline, an extra newline is
inserted before the header."
(let ((header-at (git-commit-find-pseudo-header-position)))
(save-excursion
(goto-char header-at)
(let ((pre (git-commit-determine-pre-for-pseudo-header)))
(insert (format "%s%s: %s <%s>\n" pre type name email))))))
(defun git-commit-insert-header-as-self (type)
"Insert a header with the name and email address of the current user.
Call `git-commit-insert-header' with the user name and email
address provided by `git-commit-committer-name' and
`git-commit-committer-email'.
TYPE is passed along unmodified."
(let ((committer-name (git-commit-committer-name))
(committer-email (git-commit-committer-email)))
(git-commit-insert-header type committer-name committer-email)))
(defmacro git-define-git-commit-self (action header)
"Create function git-commit-ACTION.
ACTION will be part of the function name.
HEADER is the actual header to be inserted into the comment."
(let ((func-name (intern (concat "git-commit-" action))))
`(defun ,func-name ()
,(format "Insert a '%s' header at the end of the commit message.
The author name and email address used for the header are
retrieved automatically with the same mechanism git uses."
header)
(interactive)
(git-commit-insert-header-as-self ,header))))
(git-define-git-commit-self "ack" "Acked-by")
(git-define-git-commit-self "review" "Reviewed-by")
(git-define-git-commit-self "signoff" "Signed-off-by")
(git-define-git-commit-self "test" "Tested-by")
(defmacro git-define-git-commit (action header)
"Create interactive function git-commit-ACTION.
ACTION will be part of the function name.
HEADER is the actual header to be inserted into the comment."
(let ((func-name (intern (concat "git-commit-" action))))
`(defun ,func-name (name email)
,(format "Insert a '%s' header at the end of the commit message.
The value of the header is determined by NAME and EMAIL.
When called interactively, both NAME and EMAIL are read from the
minibuffer."
header)
(interactive
(list (read-string "Name: ")
(read-string "Email: ")))
(git-commit-insert-header ,header name email))))
(git-define-git-commit "cc" "Cc")
(git-define-git-commit "reported" "Reported-by")
(defconst git-commit-comment-headings-alist
'(("Not currently on any branch." . git-commit-no-branch-face)
("Changes to be committed:" . git-commit-comment-heading-face)
("Untracked files:" . git-commit-comment-heading-face)
("Changed but not updated:" . git-commit-comment-heading-face)
("Changes not staged for commit:" . git-commit-comment-heading-face)
("Unmerged paths:" . git-commit-comment-heading-face))
"Headings in message comments.
The `car' of each cell is the heading text, the `cdr' the face to
use for fontification.")
(defconst git-commit-skip-before-summary-regexp
"\\(?:\\(?:\\s-*\\|\\s<.*\\)\n\\)*"
"Regexp to skip empty lines and comments before the summary.
Do not use this expression directly, instead call
`git-commit-find-summary-regexp' to create a regular expression
to match the summary line.")
(defconst git-commit-summary-regexp
"\\(?:^\\(.\\{,50\\}\\)\\(.*?\\)$\\)"
"Regexp to match the summary line.
Do not use this expression directly, instead call
`git-commit-find-summary-regexp' to create a regular expression
to match the summary line.")
(defconst git-commit-nonempty-second-line-regexp
"\\(?:\n\\(.*\\)\\)?$"
"Regexp to match a nonempty line following the summary.
Do not use this expression directly, instead call
`git-commit-find-summary-regexp' to create a regular expression
to match the summary line.")
(defvar git-commit-skip-magit-header-regexp nil
"Regexp to skip magit header.
This variable is nil until `magit' is loaded.
Do not use this expression directly, instead call
`git-commit-find-summary-regexp' to create a regular expression
to match the summary line.")
(defun git-commit-find-summary-regexp ()
"Create a regular expression to find the Git summary line.
Return a regular expression that starts at the beginning of the
buffer, skips over empty lines, comments and also over the magit
header, if the current buffer is a `magit-log-edit-mode' buffer,
and finds the summary line.
The regular expression matches three groups. The first group is
the summary line, the second group contains any overlong part of
the summary, and the third group contains a nonempty line
following the summary line. The latter two groups may be empty."
(format "\\`%s%s%s%s"
(if (eq major-mode 'magit-log-edit-mode)
git-commit-skip-magit-header-regexp
"")
git-commit-skip-before-summary-regexp
git-commit-summary-regexp
git-commit-nonempty-second-line-regexp))
(defun git-commit-mode-summary-font-lock-keywords (&optional errors)
"Create font lock keywords to fontify the Git summary.
If ERRORS is non-nil create keywords that highlight errors in the
summary line, not the summary line itself."
(let ((regexp (git-commit-find-summary-regexp)))
(if errors
`(,regexp
(2 'git-commit-overlong-summary-face t t)
(3 'git-commit-nonempty-second-line-face t t))
`(,regexp (1 'git-commit-summary-face t)))))
(defun git-commit-mode-heading-keywords ()
"Create font lock keywords to fontify comment headings.
Known comment headings are provided by `git-commit-comment-headings'."
(mapcar (lambda (cell) `(,(format "^\\s<\\s-+\\(%s\\)$"
(regexp-quote (car cell)))
(1 ',(cdr cell) t)))
git-commit-comment-headings-alist))
(defvar git-commit-mode-font-lock-keywords
(append
`(("^\\s<.*$" . 'font-lock-comment-face)
("^\\s<\\s-On branch \\(.*\\)$" (1 'git-commit-branch-face t))
("^\\s<\t\\(?:\\([^:]+\\):\\s-+\\)?\\(.*\\)$"
(1 'git-commit-comment-action-face t t)
(2 'git-commit-comment-file-face t))
(,(concat "^\\("
(regexp-opt git-commit-known-pseudo-headers)
":\\)\\(\s.*\\)$")
(1 'git-commit-known-pseudo-header-face)
(2 'git-commit-pseudo-header-face))
("^\\<\\S-+:\\s-.*$" . 'git-commit-pseudo-header-face)
(eval . (git-commit-mode-summary-font-lock-keywords))
("\\[[^\n]+?\\]" (0 'git-commit-note-face t)) ; Notes override summary line
;; Warnings from overlong lines and nonempty second line override
;; everything
(eval . (git-commit-mode-summary-font-lock-keywords t)))
(git-commit-mode-heading-keywords)))
(defvar git-commit-mode-map
(let ((map (make-sparse-keymap)))
;; Short shortcut ;) for the frequently used signoff header
(define-key map (kbd "C-c C-s") 'git-commit-signoff)
;; Verbose shortcuts for all headers to avoid conflicts with magit bindings
(define-key map (kbd "C-c C-x s") 'git-commit-signoff)
(define-key map (kbd "C-c C-x a") 'git-commit-ack)
(define-key map (kbd "C-c C-x t") 'git-commit-test)
(define-key map (kbd "C-c C-x r") 'git-commit-review)
(define-key map (kbd "C-c C-x o") 'git-commit-cc)
(define-key map (kbd "C-c C-x p") 'git-commit-reported)
;; Committing
(define-key map (kbd "C-c C-c") 'git-commit-commit)
map)
"Key map used by `git-commit-mode'.")
(defvar git-commit-mode-syntax-table
(let ((table (make-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?# "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\r ">" table)
table)
"Syntax table used by `git-commit-mode'.")
(defun git-commit-font-lock-diff ()
"Add font lock on diff."
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^diff --git" nil t)
(let ((beg (match-beginning 0)))
(let* ((buffer (current-buffer))
(font-lock-verbose nil)
(font-lock-support-mode nil)
(text (with-temp-buffer
(insert
(with-current-buffer buffer
(buffer-substring-no-properties beg (point-max))))
(diff-mode)
(font-lock-fontify-buffer)
(let ((pos (point-min))
next)
(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)))
(buffer-string))))
(delete-region beg (point-max))
(insert text))))))
;;;###autoload
(define-derived-mode git-commit-mode text-mode "Git Commit"
"Major mode for editing git commit messages.
This mode helps with editing git commit messages both by
providing commands to do common tasks, and by highlighting the
basic structure of and errors in git commit messages."
;; Font locking
(setq font-lock-defaults '(git-commit-mode-font-lock-keywords t))
(set (make-local-variable 'font-lock-multiline) t)
(git-commit-font-lock-diff)
;; Filling according to the guidelines
(setq fill-column 72)
(turn-on-auto-fill)
;; Recognize changelog-style paragraphs
(set (make-local-variable 'paragraph-start)
(concat paragraph-start "\\|*\\|("))
;; Do not remember point location in commit messages
(when (fboundp 'toggle-save-place)
(toggle-save-place 0)))
;;;###autoload
;; Overwrite magit-log-edit-mode to derive from git-commit-mode, and change it's
;; key bindings to use our commit and header insertion bindings
(eval-after-load 'magit
'(progn
(setq git-commit-skip-magit-header-regexp
(format
"\\(?:\\(?:[A-Za-z0-9-_]+: *.*\n\\)*%s\\)?"
(regexp-quote magit-log-header-end)))
(defvar git-commit-magit-font-lock-keywords
`((,git-commit-skip-magit-header-regexp
(0 'git-commit-skip-magit-header-face)))
"Font lock keywords for Magit Log Edit Mode.")
(define-derived-mode magit-log-edit-mode git-commit-mode "Magit Log Edit"
(font-lock-add-keywords nil git-commit-magit-font-lock-keywords)
(set (make-local-variable 'git-commit-commit-function)
(apply-partially #'call-interactively 'magit-log-edit-commit)))
(substitute-key-definition 'magit-log-edit-toggle-signoff
'git-commit-signoff
magit-log-edit-mode-map)
(substitute-key-definition 'magit-log-edit-commit
'git-commit-commit
magit-log-edit-mode-map)))
;;;###autoload
(dolist (pattern '("/COMMIT_EDITMSG\\'" "/NOTES_EDITMSG\\'"
"/MERGE_MSG\\'" "/TAG_EDITMSG\\'"
"/PULLREQ_EDITMSG\\'"))
(add-to-list 'auto-mode-alist (cons pattern 'git-commit-mode)))
(provide 'git-commit-mode)
;;; git-commit-mode.el ends here

View File

@ -0,0 +1,35 @@
;;; git-commit-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-commit-mode" "git-commit-mode.el" (21831
;;;;;; 16636 620188 15000))
;;; Generated autoloads from git-commit-mode.el
(autoload 'git-commit-mode "git-commit-mode" "\
Major mode for editing git commit messages.
This mode helps with editing git commit messages both by
providing commands to do common tasks, and by highlighting the
basic structure of and errors in git commit messages.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("/MERGE_MSG\\'" . git-commit-mode))
(add-to-list 'auto-mode-alist '("/\\(?:COMMIT\\|NOTES\\|TAG\\|PULLREQ\\)_EDITMSG\\'" . git-commit-mode))
;;;***
;;;### (autoloads nil nil ("git-commit-mode-pkg.el") (21831 16636
;;;;;; 639156 530000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; git-commit-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "git-commit-mode" "1.0.0" "Major mode for editing git commit messages" 'nil)

View File

@ -0,0 +1,668 @@
;;; git-commit-mode.el --- Major mode for editing git commit messages -*- lexical-binding: t; -*-
;; Copyright (c) 2010-2012 Florian Ragwitz
;; Copyright (c) 2012-2013 Sebastian Wiesner
;; Copyright (C) 2010-2015 The Magit Project Developers
;; Authors: Jonas Bernoulli <jonas@bernoul.li>
;; Sebastian Wiesner <lunaryorn@gmail.com>
;; Florian Ragwitz <rafl@debian.org>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/git-modes
;; Keywords: convenience vc git
;; Package-Version: 1.0.0
;; 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 Git commit messages.
;;;; Formatting
;; Highlight the formatting of git commit messages and indicate errors according
;; to the guidelines for commit messages (see
;; http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html).
;;
;; Highlight the first line (aka "summary") specially if it exceeds 50
;; characters (configurable using `git-commit-summary-max-length').
;;
;; Enable `auto-fill-mode' and set the `fill-column' to 72 according to the
;; aforementioned guidelines (configurable using `git-commit-fill-column').
;;;; Headers
;; Provide commands to insert standard headers into commit messages.
;;
;; - C-c C-s inserts Signed-off-by (`git-commit-signoff').
;; - C-C C-a inserts Acked-by (`git-commit-ack').
;; - C-c C-t inserts Tested-by (`git-commit-test').
;; - C-c C-r inserts Reviewed-by (`git-commit-review').
;; - C-c C-o inserts Cc (`git-commit-cc').
;; - C-c C-p inserts Reported-by (`git-commit-reported').
;;;; Committing
;; C-c C-c finishes a commit.
;;
;; Check a buffer for stylistic errors before committing, and ask for
;; confirmation before committing with style errors.
;;; Code:
(require 'log-edit)
(require 'ring)
(require 'server)
;;; Options
;;;; Variables
(defgroup git-commit nil
"Edit Git commit messages."
:prefix "git-commit-"
:group 'tools)
(defcustom git-commit-confirm-commit nil
"Whether to ask for confirmation before committing.
If t, ask for confirmation before creating a commit with style
errors, unless the commit is forced. If nil, never ask for
confirmation before committing."
:group 'git-commit
:type '(choice (const :tag "On style errors" t)
(const :tag "Never" nil)))
(defcustom git-commit-mode-hook '(turn-on-auto-fill)
"Hook run when entering Git Commit mode."
:options '(turn-on-auto-fill flyspell-mode git-commit-save-message)
:type 'hook
:group 'git-commit)
(defcustom git-commit-kill-buffer-hook '(git-commit-save-message)
"Hook run when killing a Git Commit mode buffer.
This hook is run by both `git-commit-commit'
and `git-commit-abort'."
:options '(git-commit-save-message)
:type 'hook
:group 'git-commit)
(defcustom git-commit-summary-max-length 50
"Fontify characters beyond this column in summary lines as errors."
:group 'git-commit
:type 'number)
(defcustom git-commit-fill-column 72
"Automatically wrap commit message lines beyond this column."
:group 'git-commit
:type 'number)
(defcustom git-commit-known-pseudo-headers
'("Signed-off-by" "Acked-by" "Cc"
"Suggested-by" "Reported-by" "Tested-by" "Reviewed-by")
"A list of git pseudo headers to be highlighted."
:group 'git-commit
:type '(repeat string))
;;;; Faces
(defgroup git-commit-faces nil
"Faces for highlighting Git commit messages."
:prefix "git-commit-"
:group 'git-commit
:group 'faces)
(defface git-commit-summary-face
'((t :inherit font-lock-type-face))
"Face used to highlight the summary in git commit messages"
:group 'git-commit-faces)
(defface git-commit-overlong-summary-face
'((t :inherit font-lock-warning-face))
"Face used to highlight overlong parts of git commit message summaries"
:group 'git-commit-faces)
(defface git-commit-nonempty-second-line-face
'((t :inherit font-lock-warning-face))
"Face used to highlight text on the second line of git commit messages"
:group 'git-commit-faces)
(defface git-commit-note-face
'((t :inherit font-lock-string-face))
"Face used to highlight notes in git commit messages"
:group 'git-commit-faces)
(defface git-commit-pseudo-header-face
'((t :inherit font-lock-string-face))
"Font used to hightlight pseudo headers in git commit messages"
:group 'git-commit-faces)
(defface git-commit-known-pseudo-header-face
'((t :inherit font-lock-keyword-face))
"Face used to hightlight common pseudo headers in git commit messages"
:group 'git-commit-faces)
(defface git-commit-branch-face
'((t :inherit font-lock-variable-name-face))
"Face used to highlight the branch name in comments in git commit messages"
:group 'git-commit-faces)
(defface git-commit-no-branch-face
'((t :inherit git-commit-branch-face))
"Face used when a commit is going to be made outside of any branches"
:group 'git-commit-faces)
(defface git-commit-comment-heading-face
'((t :inherit git-commit-known-pseudo-header-face))
"Face used to highlight section headings in the default
comments in git commit messages"
:group 'git-commit-faces)
(defface git-commit-comment-file-face
'((t :inherit git-commit-pseudo-header-face))
"Face used to highlight file names in the default comments in
git commit messages"
:group 'git-commit-faces)
(defface git-commit-comment-action-face
'((t :inherit git-commit-branch-face))
"Face used to highlight what has happened to files in the
default comments in git commit messages"
:group 'git-commit-faces)
;;; Keymap
(defvar git-commit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") 'git-commit-commit)
(define-key map (kbd "C-c C-k") 'git-commit-abort)
(define-key map (kbd "C-c C-s") 'git-commit-signoff)
(define-key map (kbd "C-c C-a") 'git-commit-ack)
(define-key map (kbd "C-c C-t") 'git-commit-test)
(define-key map (kbd "C-c C-r") 'git-commit-review)
(define-key map (kbd "C-c C-o") 'git-commit-cc)
(define-key map (kbd "C-c C-p") 'git-commit-reported)
(define-key map (kbd "C-c C-i") 'git-commit-suggested)
(define-key map (kbd "C-c M-s") 'git-commit-save-message)
(define-key map (kbd "M-p") 'git-commit-prev-message)
(define-key map (kbd "M-n") 'git-commit-next-message)
(define-key map [remap server-edit] 'git-commit-commit)
(define-key map [remap kill-buffer] 'git-commit-abort)
(define-key map [remap ido-kill-buffer] 'git-commit-abort)
(define-key map [remap iswitchb-kill-buffer] 'git-commit-abort)
;; Old bindings to avoid confusion
(define-key map (kbd "C-c C-x s") 'git-commit-signoff)
(define-key map (kbd "C-c C-x a") 'git-commit-ack)
(define-key map (kbd "C-c C-x t") 'git-commit-test)
(define-key map (kbd "C-c C-x r") 'git-commit-review)
(define-key map (kbd "C-c C-x o") 'git-commit-cc)
(define-key map (kbd "C-c C-x p") 'git-commit-reported)
map)
"Key map used by `git-commit-mode'.")
;;; Menu
(require 'easymenu)
(easy-menu-define git-commit-mode-menu git-commit-mode-map
"Git Commit Mode Menu"
'("Commit"
["Previous" git-commit-prev-message t]
["Next" git-commit-next-message t]
"-"
["Ack" git-commit-ack :active t
:help "Insert an 'Acked-by' header"]
["Sign-Off" git-commit-signoff :active t
:help "Insert a 'Signed-off-by' header"]
["Tested-by" git-commit-test :active t
:help "Insert a 'Tested-by' header"]
["Reviewed-by" git-commit-review :active t
:help "Insert a 'Reviewed-by' header"]
["CC" git-commit-cc t
:help "Insert a 'Cc' header"]
["Reported" git-commit-reported :active t
:help "Insert a 'Reported-by' header"]
["Suggested" git-commit-suggested t
:help "Insert a 'Suggested-by' header"]
"-"
["Save" git-commit-save-message t]
["Cancel" git-commit-abort t]
["Commit" git-commit-commit t]))
;;; Committing
(defvar git-commit-commit-hook nil
"Hook run by `git-commit-commit' unless clients exist.
Only use this if you know what you are doing.")
(defvar git-commit-previous-winconf nil)
(defmacro git-commit-restore-previous-winconf (&rest body)
"Run BODY and then restore `git-commit-previous-winconf'.
When `git-commit-previous-winconf' is nil or was created from
another frame do nothing."
(declare (indent 0))
(let ((winconf (make-symbol "winconf"))
(frame (make-symbol "frame")))
`(let ((,winconf git-commit-previous-winconf)
(,frame (selected-frame)))
,@body
(when (and ,winconf
(equal ,frame (window-configuration-frame ,winconf)))
(set-window-configuration ,winconf)
(setq git-commit-previous-winconf nil)))))
(defun git-commit-commit (&optional force)
"Finish editing the commit message and commit.
Check for stylistic errors in the current commit, and ask the
user for confirmation depending on `git-commit-confirm-commit'.
If FORCE is non-nil or if a raw prefix arg is given, commit
immediately without asking.
Return t, if the commit was successful, or nil otherwise."
(interactive "P")
(if (and git-commit-confirm-commit
(git-commit-has-style-errors-p)
(not force)
(not (y-or-n-p "Commit despite stylistic errors?")))
(message "Commit canceled due to stylistic errors.")
(save-buffer)
(run-hooks 'git-commit-kill-buffer-hook)
(remove-hook 'kill-buffer-query-functions
'git-commit-kill-buffer-noop t)
(git-commit-restore-previous-winconf
(if (git-commit-buffer-clients)
(server-edit)
(run-hook-with-args 'git-commit-commit-hook)
(kill-buffer)))))
(defun git-commit-abort ()
"Abort the commit.
The commit message is saved to the kill ring."
(interactive)
(when (< emacs-major-version 24)
;; Emacsclient doesn't exit with non-zero when -error is used.
;; Instead cause Git to error out by feeding it an empty file.
(erase-buffer))
(save-buffer)
(run-hooks 'git-commit-kill-buffer-hook)
(remove-hook 'kill-buffer-hook 'server-kill-buffer t)
(remove-hook 'kill-buffer-query-functions 'git-commit-kill-buffer-noop t)
(git-commit-restore-previous-winconf
(let ((buffer (current-buffer))
(clients (git-commit-buffer-clients)))
(if clients
(progn
(dolist (client clients)
(ignore-errors
(server-send-string client "-error Commit aborted by user"))
(delete-process client))
(when (buffer-live-p buffer)
(kill-buffer buffer)))
(kill-buffer))))
(accept-process-output nil 0.1)
(message (concat "Commit aborted."
(when (memq 'git-commit-save-message
git-commit-kill-buffer-hook)
" Message saved to `log-edit-comment-ring'."))))
(defun git-commit-buffer-clients ()
(and (fboundp 'server-edit)
(boundp 'server-buffer-clients)
server-buffer-clients))
;;; History
(defun git-commit-save-message ()
"Save current message to `log-edit-comment-ring'."
(interactive)
(let ((message (buffer-substring
(point-min)
(git-commit-find-pseudo-header-position))))
(when (and (string-match "^\\s-*\\sw" message)
(or (ring-empty-p log-edit-comment-ring)
(not (ring-member log-edit-comment-ring message))))
;; if index is nil, we end up cycling back to message we just saved!
(unless log-edit-comment-ring-index
(setq log-edit-comment-ring-index 0))
(ring-insert log-edit-comment-ring message))))
(defun git-commit-prev-message (arg)
"Cycle backward through message history, after saving current message.
With a numeric prefix ARG, go back ARG comments."
(interactive "*p")
(when (and (git-commit-save-message) (> arg 0))
(setq log-edit-comment-ring-index
(log-edit-new-comment-index
arg (ring-length log-edit-comment-ring))))
(save-restriction
(narrow-to-region (point-min) (git-commit-find-pseudo-header-position))
(log-edit-previous-comment arg)))
(defun git-commit-next-message (arg)
"Cycle forward through message history, after saving current message.
With a numeric prefix ARG, go forward ARG comments."
(interactive "*p")
(git-commit-prev-message (- arg)))
;;; Headers
(defun git-commit-find-pseudo-header-position ()
"Find the position at which commit pseudo headers should be inserted.
Those headers usually live at the end of a commit message, but
before any trailing comments git or the user might have
inserted."
(save-excursion
(goto-char (point-max))
(if (re-search-backward "^[^#\n]" nil t)
;; we found last non-empty non-comment line, headers go after
(forward-line 1)
;; there's only blanks & comments, headers go before comments
(goto-char (point-min))
(and (re-search-forward "^#" nil t) (forward-line 0)))
(skip-chars-forward "\n")
(point)))
(defun git-commit-determine-pre-for-pseudo-header ()
"Find the characters to insert before the pseudo header.
Returns either zero, one or two newlines after computation.
`point' either points to an empty line (with a non-empty previous
line) or the end of a non-empty line."
(let ((pre "")
(prev-line nil))
(if (not (eq (point) (point-at-bol)))
(progn
(setq pre (concat pre "\n"))
(setq prev-line (thing-at-point 'line)))
;; else: (point) is at an empty line
(when (not (eq (point) (point-min)))
(setq prev-line
(save-excursion
(forward-line -1)
(thing-at-point 'line)))))
;; we have prev-line now; if it doesn't match any known pseudo
;; header, add a newline
(when prev-line
(if (not (delq nil (mapcar (lambda (pseudo-header)
(string-match pseudo-header prev-line))
git-commit-known-pseudo-headers)))
(setq pre (concat pre "\n"))))
pre))
(defun git-commit-insert-header (type name email)
"Insert a header into the commit message.
The inserted header has the format 'TYPE: NAME <EMAIL>'.
The header is inserted at the position returned by
`git-commit-find-pseudo-header-position'. When this position
isn't after an existing header or a newline, an extra newline is
inserted before the header."
(let ((header-at (git-commit-find-pseudo-header-position)))
(save-excursion
(goto-char header-at)
(let ((pre (git-commit-determine-pre-for-pseudo-header)))
(insert (format "%s%s: %s <%s>\n" pre type name email))))))
(defun git-commit-insert-header-as-self (type)
"Insert a header with the name and email of the current user.
The inserted header has the format 'TYPE: NAME <EMAIL>'.
Also see `git-commit-insert-header'."
(git-commit-insert-header
type
(or (getenv "GIT_AUTHOR_NAME")
(getenv "GIT_COMMITTER_NAME")
(ignore-errors (car (process-lines "git" "config" "user.name")))
user-full-name)
(or (getenv "GIT_AUTHOR_EMAIL")
(getenv "GIT_COMMITTER_EMAIL")
(getenv "EMAIL")
(ignore-errors (car (process-lines "git" "config" "user.email")))
user-mail-address)))
(defmacro git-define-git-commit-self (action header)
"Create function git-commit-ACTION.
ACTION will be part of the function name.
HEADER is the actual header to be inserted into the comment."
(let ((func-name (intern (concat "git-commit-" action))))
`(defun ,func-name ()
,(format "Insert a '%s' header at the end of the commit message.
The author name and email address used for the header are
retrieved automatically with the same mechanism git uses."
header)
(interactive)
(git-commit-insert-header-as-self ,header))))
(git-define-git-commit-self "ack" "Acked-by")
(git-define-git-commit-self "review" "Reviewed-by")
(git-define-git-commit-self "signoff" "Signed-off-by")
(git-define-git-commit-self "test" "Tested-by")
(defmacro git-define-git-commit (action header)
"Create interactive function git-commit-ACTION.
ACTION will be part of the function name.
HEADER is the actual header to be inserted into the comment."
(let ((func-name (intern (concat "git-commit-" action))))
`(defun ,func-name (name email)
,(format "Insert a '%s' header at the end of the commit message.
The value of the header is determined by NAME and EMAIL.
When called interactively, both NAME and EMAIL are read from the
minibuffer."
header)
(interactive
(list (read-string "Name: ")
(read-string "Email: ")))
(git-commit-insert-header ,header name email))))
(git-define-git-commit "cc" "Cc")
(git-define-git-commit "reported" "Reported-by")
(git-define-git-commit "suggested" "Suggested-by")
(defconst git-commit-comment-headings-alist
'(("Not currently on any branch." . git-commit-no-branch-face)
("Changes to be committed:" . git-commit-comment-heading-face)
("Untracked files:" . git-commit-comment-heading-face)
("Changed but not updated:" . git-commit-comment-heading-face)
("Changes not staged for commit:" . git-commit-comment-heading-face)
("Unmerged paths:" . git-commit-comment-heading-face))
"Headings in message comments.
The `car' of each cell is the heading text, the `cdr' the face to
use for fontification.")
(defun git-commit-summary-regexp ()
(concat
;; Skip empty lines or comments before the summary
"\\`\\(?:^\\(?:\\s-*\\|\\s<.*\\)\n\\)*"
;; The summary line
(format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length)
;; Non-empty non-comment second line
;;
;; For instant highlighting of non-empty second lines in font-lock,
;; the last capturing group must capture the empty string ("") in
;; "summary line\n".
;; That's why the simpler regex "\\(?:\n\\([^\n#].*\\)\\)?",
;; which captures 'nil', can't be used.
"\\(?:\n\\#\\|\n\\(.*\\)\\)?"))
(defun git-commit-has-style-errors-p ()
"Check whether the current buffer has style errors.
Return t, if the current buffer has style errors, or nil
otherwise."
(save-excursion
(goto-char (point-min))
(when (re-search-forward (git-commit-summary-regexp) nil t)
(or (string-match-p ".+" (or (match-string 2) ""))
(string-match-p "^.+$" (or (match-string 3) ""))))))
;;; Font-Lock
(defun git-commit-mode-summary-font-lock-keywords (&optional errors)
"Create font lock keywords to fontify the Git summary.
If ERRORS is non-nil create keywords that highlight errors in the
summary line, not the summary line itself."
(if errors
`(,(git-commit-summary-regexp)
(2 'git-commit-overlong-summary-face t t)
(3 'git-commit-nonempty-second-line-face t t))
`(,(git-commit-summary-regexp)
(1 'git-commit-summary-face t))))
(defun git-commit-mode-heading-keywords ()
"Create font lock keywords to fontify comment headings.
Known comment headings are provided by `git-commit-comment-headings'."
(mapcar (lambda (cell) `(,(format "^\\s<\\s-+\\(%s\\)$"
(regexp-quote (car cell)))
(1 ',(cdr cell) t)))
git-commit-comment-headings-alist))
(defun git-commit-mode-font-lock-keywords ()
(append
`(("^\\s<.*$" . 'font-lock-comment-face)
("^\\s<\\s-On branch \\(.*\\)$" (1 'git-commit-branch-face t))
("^\\s<\t\\(?:\\([^:\n]+\\):\\s-+\\)?\\(.*\\)$"
(1 'git-commit-comment-action-face t t)
(2 'git-commit-comment-file-face t))
(,(concat "^\\("
(regexp-opt git-commit-known-pseudo-headers)
":\\)\\(\s.*\\)$")
(1 'git-commit-known-pseudo-header-face)
(2 'git-commit-pseudo-header-face))
("^\\<\\S-+:\\s-.*$" . 'git-commit-pseudo-header-face)
(eval . (git-commit-mode-summary-font-lock-keywords))
("\\[[^\n]+?\\]" (0 'git-commit-note-face t)) ; Notes override summary line
;; Warnings from overlong lines and nonempty second line override
;; everything
(eval . (git-commit-mode-summary-font-lock-keywords t)))
(git-commit-mode-heading-keywords)))
(defun git-commit-font-lock-diff ()
"Add font lock on diff."
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^diff --git" nil t)
(let ((beg (match-beginning 0)))
(let* ((buffer (current-buffer))
(font-lock-verbose nil)
(font-lock-support-mode nil)
(text (with-temp-buffer
(insert
(with-current-buffer buffer
(buffer-substring-no-properties beg (point-max))))
(diff-mode)
(font-lock-fontify-buffer)
(let ((pos (point-min))
next)
(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)))
(buffer-string))))
(delete-region beg (point-max))
(insert text))))))
;;; Mode
(defvar git-commit-mode-syntax-table
(let ((table (make-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?# "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\r ">" table)
table)
"Syntax table used by `git-commit-mode'.")
;;;###autoload
(define-derived-mode git-commit-mode text-mode "Git Commit"
"Major mode for editing git commit messages.
This mode helps with editing git commit messages both by
providing commands to do common tasks, and by highlighting the
basic structure of and errors in git commit messages."
;; Font locking
(setq font-lock-defaults (list (git-commit-mode-font-lock-keywords) t))
(set (make-local-variable 'font-lock-multiline) t)
(git-commit-font-lock-diff)
;; Filling according to the guidelines
(setq fill-column git-commit-fill-column)
;; Recognize changelog-style paragraphs
(set (make-local-variable 'paragraph-start)
(concat paragraph-start "\\|*\\|("))
;; Treat lines starting with a hash/pound as comments
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-start-skip)
(concat "^" (regexp-quote comment-start) "+"
"\\s-*"))
(set (make-local-variable 'comment-use-syntax) nil)
;; Do not remember point location in commit messages
(when (boundp 'save-place)
(setq save-place nil))
;; If the commit summary is empty, insert a newline after point
(when (string= "" (buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
(open-line 1))
;; That's what happens when every little detail is commented
(make-local-variable 'log-edit-comment-ring-index)
;; Make sure `git-commit-abort' cannot be by-passed
(add-hook 'kill-buffer-query-functions
'git-commit-kill-buffer-noop nil t)
;; Make the wrong usage info from `server-execute' go way
(run-with-timer 0.01 nil (lambda (m) (message "%s" m))
(substitute-command-keys
(concat "Type \\[git-commit-commit] "
(let ((n (buffer-file-name)))
(cond ((equal n "TAG_EDITMSG") "to tag")
((or (equal n "NOTES_EDITMSG")
(equal n "PULLREQ_EDITMSG"))
"when done")
(t "to commit")))
" (\\[git-commit-abort] to abort)."))))
(defun git-commit-kill-buffer-noop ()
(message
(substitute-command-keys
"Don't kill this buffer. Instead abort using \\[git-commit-abort]."))
nil)
(defun git-commit-mode-flyspell-verify ()
(not (nth 4 (syntax-ppss)))) ; not inside a comment
(eval-after-load 'flyspell
'(put 'git-commit-mode 'flyspell-mode-predicate
'git-commit-mode-flyspell-verify))
;;;###autoload
(add-to-list 'auto-mode-alist '("/MERGE_MSG\\'" . git-commit-mode))
;;;###autoload
(add-to-list 'auto-mode-alist
'("/\\(?:COMMIT\\|NOTES\\|TAG\\|PULLREQ\\)_EDITMSG\\'"
. git-commit-mode))
(defun git-commit-auto-mode-enable ()
(message "git-commit-auto-mode-enable is obsolete and doesn't do anything"))
(make-obsolete 'git-commit-auto-mode-enable "This mode is a noop now" "")
(provide 'git-commit-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; git-commit-mode.el ends here

View File

@ -0,0 +1,29 @@
;;; git-rebase-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-rebase-mode" "git-rebase-mode.el" (21831
;;;;;; 16621 351189 81000))
;;; Generated autoloads from git-rebase-mode.el
(autoload 'git-rebase-mode "git-rebase-mode" "\
Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("/git-rebase-todo\\'" . git-rebase-mode))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; git-rebase-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "git-rebase-mode" "1.0.0" "Major mode for editing git rebase files" 'nil)

View File

@ -0,0 +1,393 @@
;;; git-rebase-mode.el --- Major mode for editing git rebase files
;; Copyright (C) 2010-2015 The Magit Project Developers
;; Author: Phil Jackson <phil@shellarchive.co.uk>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/git-modes
;; Keywords: convenience vc git
;; Package-Version: 1.0.0
;; 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:
;; Allows the editing of a git rebase file (which you might get when
;; using 'git rebase -i' or hitting 'E' in Magit). Assumes editing is
;; happening in a server.
;;; Code:
(require 'easymenu)
(require 'server)
(require 'thingatpt)
;;; Options
;;;; Variables
(defgroup git-rebase nil
"Edit Git rebase sequences."
:group 'tools)
(defcustom git-rebase-auto-advance nil
"If non-nil, moves point forward a line after running an action."
:group 'git-rebase
:type 'boolean)
(defcustom git-rebase-remove-instructions nil
"Whether to remove the instructions from the rebase buffer.
Because you have seen them before and can still remember."
:group 'git-rebase
:type 'boolean)
;;;; Faces
(defgroup git-rebase-faces nil
"Faces used by Git-Rebase mode."
:group 'faces
:group 'git-rebase)
(defface git-rebase-hash
'((((class color) (background light))
:foreground "firebrick")
(((class color) (background dark))
:foreground "tomato"))
"Face for commit hashes."
:group 'git-rebase-faces)
(defface git-rebase-description nil
"Face for commit descriptions."
:group 'git-rebase-faces)
(defface git-rebase-killed-action
'((((class color))
:inherit font-lock-comment-face
:strike-through t))
"Face for commented action and exec lines."
:group 'git-rebase-faces)
(define-obsolete-face-alias 'git-rebase-description-face
'git-rebase-description "1.0.0")
(define-obsolete-face-alias 'git-rebase-killed-action-face
'git-rebase-killed-action "1.0.0")
;;; Regexps
(defconst git-rebase-action-line-re
(concat "^#?"
"\\([efprs]\\|pick\\|reword\\|edit\\|squash\\|fixup\\) "
"\\([a-z0-9]\\{4,40\\}\\) "
"\\(.*\\)")
"Regexp matching action lines in rebase buffers.")
(defconst git-rebase-exec-line-re
"^#?\\(x\\|exec\\)[[:space:]]\\(.*\\)"
"Regexp matching exec lines in rebase buffer.")
(defconst git-rebase-dead-line-re
(format "^#\\(?:%s\\|%s\\)"
(substring git-rebase-action-line-re 1)
(substring git-rebase-exec-line-re 1))
"Regexp matching commented action and exex lines in rebase buffers.")
;;; Keymaps
(defvar git-rebase-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map (kbd "q") 'git-rebase-server-edit)
(define-key map (kbd "C-c C-c") 'git-rebase-server-edit)
(define-key map (kbd "a") 'git-rebase-abort)
(define-key map (kbd "C-c C-k") 'git-rebase-abort)
(define-key map [remap undo] 'git-rebase-undo)
(define-key map (kbd "RET") 'git-rebase-show-commit)
(define-key map (kbd "x") 'git-rebase-exec)
(define-key map (kbd "c") 'git-rebase-pick)
(define-key map (kbd "r") 'git-rebase-reword)
(define-key map (kbd "e") 'git-rebase-edit)
(define-key map (kbd "s") 'git-rebase-squash)
(define-key map (kbd "f") 'git-rebase-fixup)
(define-key map (kbd "y") 'git-rebase-insert)
(define-key map (kbd "k") 'git-rebase-kill-line)
(define-key map (kbd "C-k") 'git-rebase-kill-line)
(define-key map (kbd "p") 'git-rebase-backward-line)
(define-key map (kbd "n") 'forward-line)
(define-key map (kbd "M-p") 'git-rebase-move-line-up)
(define-key map (kbd "M-n") 'git-rebase-move-line-down)
(define-key map (kbd "M-<up>") 'git-rebase-move-line-up)
(define-key map (kbd "M-<down>") 'git-rebase-move-line-down)
map)
"Keymap for Git-Rebase mode.")
(easy-menu-define git-rebase-mode-menu git-rebase-mode-map
"Git-Rebase mode menu"
'("Rebase"
["Pick" git-rebase-pick t]
["Reword" git-rebase-reword t]
["Edit" git-rebase-edit t]
["Squash" git-rebase-squash t]
["Fixup" git-rebase-fixup t]
["Kill" git-rebase-kill-line t]
["Move Down" git-rebase-move-line-down t]
["Move Up" git-rebase-move-line-up t]
["Execute" git-rebase-exec t]
"---"
["Abort" git-rebase-abort t]
["Done" git-rebase-server-edit t]))
;;; Utilities
(defun git-rebase-edit-line (change-to)
(when (git-rebase-looking-at-action)
(let ((buffer-read-only nil)
(start (point)))
(goto-char (point-at-bol))
(delete-region (point) (progn (forward-word 1) (point)))
(insert change-to)
(goto-char start)
(when git-rebase-auto-advance
(forward-line)))))
(defmacro git-rebase-define-action (sym)
(declare (indent defun))
(let ((fn (intern (format "git-rebase-%s" sym))))
`(progn
(defun ,fn ()
(interactive)
(git-rebase-edit-line ,(symbol-name sym)))
(put ',fn 'definition-name ',sym))))
(defun git-rebase-looking-at-action ()
"Return non-nil if looking at an action line."
(save-excursion
(goto-char (point-at-bol))
(looking-at git-rebase-action-line-re)))
(defun git-rebase-looking-at-action-or-exec ()
"Return non-nil if looking at an action line or exec line."
(save-excursion
(goto-char (point-at-bol))
(or (looking-at git-rebase-action-line-re)
(looking-at git-rebase-exec-line-re))))
(defun git-rebase-looking-at-exec ()
"Return non-nil if cursor is on an exec line."
(string-match git-rebase-exec-line-re (thing-at-point 'line)))
(defun git-rebase-looking-at-killed-exec ()
"Return non-nil if looking at an exec line that has been commented out."
(let ((line (thing-at-point 'line)))
(and (eq (aref line 0) ?#)
(string-match git-rebase-exec-line-re line))))
;;; Commands
(git-rebase-define-action pick)
(git-rebase-define-action reword)
(git-rebase-define-action edit)
(git-rebase-define-action squash)
(git-rebase-define-action fixup)
(defun git-rebase-move-line-up ()
"Move the current action line up."
(interactive)
(when (git-rebase-looking-at-action-or-exec)
(let ((buffer-read-only nil)
(col (current-column)))
(goto-char (point-at-bol))
(unless (bobp)
(transpose-lines 1)
(forward-line -2))
(move-to-column col))))
(defun git-rebase-move-line-down ()
"Assuming the next line is also an action line, move the current line down."
(interactive)
;; if we're on an action and the next line is also an action
(when (and (git-rebase-looking-at-action-or-exec)
(save-excursion
(forward-line)
(git-rebase-looking-at-action-or-exec)))
(let ((buffer-read-only nil)
(col (current-column)))
(forward-line 1)
(transpose-lines 1)
(forward-line -1)
(move-to-column col))))
(defun git-rebase-server-edit ()
"Save the action buffer and end the session."
(interactive)
(save-buffer)
(server-edit))
(defun git-rebase-abort ()
"Abort this rebase.
This is dune by emptying the buffer, saving and closing server
connection."
(interactive)
(when (or (not (buffer-modified-p))
(y-or-n-p "Abort this rebase? "))
(let ((buffer-read-only nil))
(erase-buffer)
(save-buffer)
(server-edit))))
(defun git-rebase-kill-line ()
"Kill the current action line."
(interactive)
(when (and (not (eq (char-after (point-at-bol)) ?#))
(git-rebase-looking-at-action-or-exec))
(beginning-of-line)
(let ((inhibit-read-only t))
(insert "#"))
(forward-line)))
(defun git-rebase-insert (rev)
"Read an arbitrary commit and insert it below current line."
(interactive
(list (if (fboundp 'magit-read-branch-or-commit)
(magit-read-branch-or-commit "Insert revision")
(read-string "Insert revision: "))))
(forward-line)
(let ((summary (if (fboundp 'magit-rev-format)
(magit-rev-format "%h %s" rev)
(process-lines "git" "show" "-s" "--format=%h %s" rev))))
(if summary
(let ((inhibit-read-only t))
(insert "pick " summary ?\n))
(user-error "Unknown revision"))))
(defun git-rebase-exec (edit)
"Prompt the user for a shell command to be executed, and
add it to the todo list.
If the cursor is on a commented-out exec line, uncomment the
current line instead of prompting.
When the prefix argument EDIT is non-nil and the cursor is on an
exec line, edit that line instead of inserting a new one. If the
exec line was commented out, also uncomment it."
(interactive "P")
(cond
((and edit (git-rebase-looking-at-exec))
(let ((new-line (git-rebase-read-exec-line
(match-string-no-properties 2 (thing-at-point 'line))))
(inhibit-read-only t))
(delete-region (point-at-bol) (point-at-eol))
(if (not (equal "" new-line))
(insert "exec " new-line)
(delete-char -1)
(forward-line))
(move-beginning-of-line nil)))
((git-rebase-looking-at-killed-exec)
(save-excursion
(beginning-of-line)
(let ((buffer-read-only nil))
(delete-char 1))))
(t
(let ((inhibit-read-only t)
(line (git-rebase-read-exec-line)))
(unless (equal "" line)
(move-end-of-line nil)
(newline)
(insert (concat "exec " line))))
(move-beginning-of-line nil))))
(defun git-rebase-read-exec-line (&optional initial-line)
(read-shell-command "Execute: " initial-line))
(defun git-rebase-undo (&optional arg)
"A thin wrapper around `undo', which allows undoing in read-only buffers."
(interactive "P")
(let ((inhibit-read-only t))
(undo arg)))
(defun git-rebase-show-commit (&optional arg)
"Show the commit on the current line if any."
(interactive "P")
(save-excursion
(goto-char (point-at-bol))
(when (looking-at git-rebase-action-line-re)
(let ((commit (match-string 2)))
(if (fboundp 'magit-show-commit)
(magit-show-commit commit)
(shell-command (concat "git show " commit)))))))
(defun git-rebase-backward-line (&optional n)
"Move N lines backward (forward if N is negative).
Like `forward-line' but go into the opposite direction."
(interactive "p")
(forward-line (* n -1)))
;;; Mode
;;;###autoload
(define-derived-mode git-rebase-mode special-mode "Git Rebase"
"Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details."
(setq font-lock-defaults '(git-rebase-mode-font-lock-keywords t t))
(when git-rebase-remove-instructions
(let ((inhibit-read-only t))
(flush-lines "^\\($\\|#\\)"))))
(defvar git-rebase-mode-font-lock-keywords
`((,git-rebase-action-line-re
(1 font-lock-keyword-face)
(2 'git-rebase-hash)
(3 'git-rebase-description))
(,git-rebase-exec-line-re 1 font-lock-keyword-face)
("^#.*" 0 font-lock-comment-face)
(,git-rebase-dead-line-re 0 'git-rebase-killed-action t))
"Font lock keywords for Git-Rebase mode.")
(defun git-rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(save-excursion
(goto-char (point-min))
(while (search-forward-regexp "^# \\(.\\), \\([[:alpha:]]+\\) = " nil t)
(let ((start (match-beginning 1))
(end (match-end 1))
(command (intern (concat "git-rebase-" (match-string 2)))))
(when (fboundp command)
(let ((overlay (make-overlay start end)))
(overlay-put
overlay 'display
(key-description (where-is-internal command nil t)))))))))
(add-hook 'git-rebase-mode-hook 'git-rebase-mode-show-keybindings t)
(defun git-rebase-mode-disable-before-save-hook ()
(set (make-local-variable 'before-save-hook) nil))
(add-hook 'git-rebase-mode-hook 'git-rebase-mode-disable-before-save-hook)
;;;###autoload
(add-to-list 'auto-mode-alist
'("/git-rebase-todo\\'" . git-rebase-mode))
(provide 'git-rebase-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; git-rebase-mode.el ends here

View File

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

View File

@ -1,60 +0,0 @@
;;; gitignore-mode.el --- Major mode for editing .gitconfig files
;;; -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (c) 2012 Sebastian Wiesner <lunaryorn@gmail.com>
;;
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; URL: https://github.com/lunaryorn/git-modes
;; Version: 0.1
;; 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 .gitignore files.
;;; Code:
(require 'conf-mode)
(defvar gitignore-mode-font-lock-keywords
'(("^\\s<.*$" . 'font-lock-comment-face)
("^\\(!?\\)" (1 'font-lock-negation-char-face)) ; Negated patterns
("/" . 'font-lock-constant-face) ; Directory separators
("\\(?:\\*\\|\\?\\)" . 'font-lock-keyword-face) ; Glob patterns
("\\[.+?\\]" . 'font-lock-keyword-face) ; Ranged glob patterns
))
;;;###autoload
(define-derived-mode gitignore-mode conf-unix-mode "Gitignore"
"A major mode for editing .gitconfig files."
(conf-mode-initialize "#")
;; Disable syntactic font locking, because comments are only valid at
;; beginning of line.
(setq font-lock-defaults '(gitignore-mode-font-lock-keywords t t))
(set (make-local-variable 'conf-assignment-sign) nil))
;;;###autoload
(setq auto-mode-alist
(append '(("/\\.gitignore\\'" . gitignore-mode)
("/\\.git/info/exclude\\'" . gitignore-mode))
auto-mode-alist))
(provide 'gitignore-mode)
;;; gitignore-mode.el ends here

View File

@ -3,16 +3,16 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (21633 ;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (21831
;;;;;; 45694 775043 851000)) ;;;;;; 16635 816188 71000))
;;; Generated autoloads from gitignore-mode.el ;;; Generated autoloads from gitignore-mode.el
(autoload 'gitignore-mode "gitignore-mode" "\ (autoload 'gitignore-mode "gitignore-mode" "\
A major mode for editing .gitconfig files. A major mode for editing .gitignore files.
\(fn)" t nil) \(fn)" t nil)
(setq auto-mode-alist (append '(("/\\.gitignore\\'" . gitignore-mode) ("/\\.git/info/exclude\\'" . gitignore-mode)) auto-mode-alist)) (dolist (pattern (list "/\\.gitignore\\'" "/\\.git/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
;;;*** ;;;***

View File

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

View File

@ -0,0 +1,61 @@
;;; 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
;; 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
;; 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 .gitignore files.
;;; Code:
(require 'conf-mode)
(defvar gitignore-mode-font-lock-keywords
'(("^\\s<.*$" . font-lock-comment-face)
("^!" . font-lock-negation-char-face) ; Negative pattern
("/" . font-lock-constant-face) ; Directory separators
("[*?]" . font-lock-keyword-face) ; Glob patterns
("\\[.+?\\]" . font-lock-keyword-face))) ; Ranged glob patterns
;;;###autoload
(define-derived-mode gitignore-mode conf-unix-mode "Gitignore"
"A major mode for editing .gitignore files."
(conf-mode-initialize "#")
;; Disable syntactic font locking, because comments are only valid at
;; beginning of line.
(setq font-lock-defaults '(gitignore-mode-font-lock-keywords t t))
(set (make-local-variable 'conf-assignment-sign) nil))
;;;###autoload
(dolist (pattern (list "/\\.gitignore\\'"
"/\\.git/info/exclude\\'"
"/git/ignore\\'"))
(add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
(provide 'gitignore-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; gitignore-mode.el ends here

View File

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

View File

@ -1,10 +1,10 @@
;;; haml-mode-autoloads.el --- automatically extracted autoloads ;;; haml-mode-autoloads.el --- automatically extracted autoloads
;; ;;
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads (haml-mode) "haml-mode" "haml-mode.el" (21553 16292 ;;;### (autoloads nil "haml-mode" "haml-mode.el" (21831 16635 83188
;;;;;; 429141 493000)) ;;;;;; 122000))
;;; Generated autoloads from haml-mode.el ;;; Generated autoloads from haml-mode.el
(autoload 'haml-mode "haml-mode" "\ (autoload 'haml-mode "haml-mode" "\
@ -18,16 +18,9 @@ Major mode for editing Haml files.
;;;*** ;;;***
;;;### (autoloads nil nil ("haml-mode-pkg.el") (21553 16292 546790
;;;;;; 825000))
;;;***
(provide 'haml-mode-autoloads)
;; Local Variables: ;; Local Variables:
;; version-control: never ;; version-control: never
;; no-byte-compile: t ;; no-byte-compile: t
;; no-update-autoloads: t ;; no-update-autoloads: t
;; coding: utf-8
;; End: ;; End:
;;; haml-mode-autoloads.el ends here ;;; haml-mode-autoloads.el ends here

View File

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

View File

@ -1,4 +1,3 @@
;;; haml-mode.el --- Major mode for editing Haml files ;;; haml-mode.el --- Major mode for editing Haml files
;; Copyright (c) 2007, 2008 Nathan Weizenbaum ;; Copyright (c) 2007, 2008 Nathan Weizenbaum
@ -6,7 +5,7 @@
;; Author: Nathan Weizenbaum ;; Author: Nathan Weizenbaum
;; URL: http://github.com/nex3/haml/tree/master ;; URL: http://github.com/nex3/haml/tree/master
;; Package-Requires: ((ruby-mode "1.0")) ;; Package-Requires: ((ruby-mode "1.0"))
;; Version: 3.1.5 ;; Version: 3.1.8
;; Created: 2007-03-08 ;; Created: 2007-03-08
;; By: Nathan Weizenbaum ;; By: Nathan Weizenbaum
;; Keywords: markup, language, html ;; Keywords: markup, language, html
@ -238,7 +237,7 @@ END.")
"Regexp to match trailing ruby code which may continue onto subsequent lines.") "Regexp to match trailing ruby code which may continue onto subsequent lines.")
(defconst haml-ruby-script-re (defconst haml-ruby-script-re
(concat "^[ \t]*\\(-\\|[&!]?[=~]\\) " haml-possibly-multiline-code-re) (concat "^[ \t]*\\(-\\|[&!]?\\(?:=\\|~\\)\\)[^=]" haml-possibly-multiline-code-re)
"Regexp to match -, = or ~ blocks and any continued code lines.") "Regexp to match -, = or ~ blocks and any continued code lines.")
(defun haml-highlight-ruby-script (limit) (defun haml-highlight-ruby-script (limit)

View File

@ -1,164 +0,0 @@
;;; magit-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (magit-status) "magit" "magit.el" (21539 9850 352318
;;;;;; 953000))
;;; Generated autoloads from magit.el
(autoload 'magit-status "magit" "\
Open a Magit status buffer for the Git repository containing
DIR. If DIR is not within a Git repository, offer to create a
Git repository in DIR.
Interactively, a prefix argument means to ask the user which Git
repository to use even if `default-directory' is under Git control.
Two prefix arguments means to ignore `magit-repo-dirs' when asking for
user input.
\(fn DIR)" t nil)
;;;***
;;;### (autoloads (magit-blame-mode) "magit-blame" "magit-blame.el"
;;;;;; (21539 9850 701311 580000))
;;; Generated autoloads from magit-blame.el
(autoload 'magit-blame-mode "magit-blame" "\
Display blame information inline.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (turn-on-magit-stgit magit-stgit-mode) "magit-stgit"
;;;;;; "magit-stgit.el" (21539 9850 618313 333000))
;;; Generated autoloads from magit-stgit.el
(autoload 'magit-stgit-mode "magit-stgit" "\
StGit support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-stgit "magit-stgit" "\
Unconditionally turn on `magit-stgit-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (turn-on-magit-svn magit-svn-mode) "magit-svn"
;;;;;; "magit-svn.el" (21539 9850 435317 198000))
;;; Generated autoloads from magit-svn.el
(autoload 'magit-svn-mode "magit-svn" "\
SVN support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-svn "magit-svn" "\
Unconditionally turn on `magit-svn-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (turn-on-magit-topgit magit-topgit-mode) "magit-topgit"
;;;;;; "magit-topgit.el" (21539 9850 166322 880000))
;;; Generated autoloads from magit-topgit.el
(autoload 'magit-topgit-mode "magit-topgit" "\
Topgit support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-topgit "magit-topgit" "\
Unconditionally turn on `magit-topgit-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (global-magit-wip-save-mode magit-wip-save-mode
;;;;;; magit-wip-mode) "magit-wip" "magit-wip.el" (21539 9850 532315
;;;;;; 150000))
;;; Generated autoloads from magit-wip.el
(defvar magit-wip-mode nil "\
Non-nil if Magit-Wip mode is enabled.
See the command `magit-wip-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `magit-wip-mode'.")
(custom-autoload 'magit-wip-mode "magit-wip" nil)
(autoload 'magit-wip-mode "magit-wip" "\
In Magit log buffers; give wip refs a special appearance.
\(fn &optional ARG)" t nil)
(autoload 'magit-wip-save-mode "magit-wip" "\
Magit support for committing to a work-in-progress ref.
When this minor mode is turned on and a file is saved inside a writable
git repository then it is also committed to a special work-in-progress
ref.
\(fn &optional ARG)" t nil)
(defvar global-magit-wip-save-mode nil "\
Non-nil if Global-Magit-Wip-Save mode is enabled.
See the command `global-magit-wip-save-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-magit-wip-save-mode'.")
(custom-autoload 'global-magit-wip-save-mode "magit-wip" nil)
(autoload 'global-magit-wip-save-mode "magit-wip" "\
Toggle Magit-Wip-Save mode in all buffers.
With prefix ARG, enable Global-Magit-Wip-Save mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Magit-Wip-Save mode is enabled in all buffers where
`turn-on-magit-wip-save' would do it.
See `magit-wip-save-mode' for more information on Magit-Wip-Save mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (rebase-mode) "rebase-mode" "rebase-mode.el" (21539
;;;;;; 9850 228321 571000))
;;; Generated autoloads from rebase-mode.el
(autoload 'rebase-mode "rebase-mode" "\
Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("git-rebase-todo" . rebase-mode))
;;;***
;;;### (autoloads nil nil ("magit-bisect.el" "magit-key-mode.el"
;;;;;; "magit-pkg.el") (21539 9850 772800 71000))
;;;***
(provide 'magit-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; magit-autoloads.el ends here

View File

@ -1,195 +0,0 @@
(require 'magit)
(defvar magit--bisect-last-pos)
(defvar magit--bisect-tmp-file)
(defvar magit--bisect-info nil)
(make-variable-buffer-local 'magit--bisect-info)
(put 'magit--bisect-info 'permanent-local t)
(defun magit--bisecting-p (&optional required-status)
"Return t if a bisect session is running.
If REQUIRED-STATUS is not nil then the current status must also
match REQUIRED-STATUS."
(and (file-exists-p (concat (magit-git-dir) "BISECT_LOG"))
(or (not required-status)
(eq (plist-get (magit--bisect-info) :status)
required-status))))
(defun magit--bisect-info ()
(with-current-buffer (magit-find-status-buffer)
(or (if (local-variable-p 'magit--bisect-info) magit--bisect-info)
(list :status (if (magit--bisecting-p) 'running 'not-running)))))
(defun magit--bisect-cmd (&rest args)
"Run `git bisect ...' and update the status buffer"
(with-current-buffer (magit-find-status-buffer)
(let* ((output (apply 'magit-git-lines (append '("bisect") args)))
(cmd (car args))
(first-line (car output)))
(save-match-data
(setq magit--bisect-info
(cond ((string= cmd "reset")
(list :status 'not-running))
;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
((string-match "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)" first-line)
(list :status 'running
:revs (match-string 1 first-line)
:steps (match-string 2 first-line)))
;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
((string-match "^\\([a-f0-9]+\\)\\s-.*first bad commit" first-line)
(list :status 'finished
:bad (match-string 1 first-line)))
(t
(list :status 'error)))))))
(magit-refresh))
(defun magit--bisect-info-for-status (branch)
"Return bisect info suitable for display in the status buffer"
(let* ((info (magit--bisect-info))
(status (plist-get info :status)))
(cond ((eq status 'not-running)
(or branch "(detached)"))
((eq status 'running)
(format "(bisecting; %s revisions & %s steps left)"
(or (plist-get info :revs) "unknown number of")
(or (plist-get info :steps) "unknown number of")))
((eq status 'finished)
(format "(bisected: first bad revision is %s)" (plist-get info :bad)))
(t
"(bisecting; unknown error occured)"))))
(defun magit-bisect-start ()
"Start a bisect session"
(interactive)
(if (magit--bisecting-p)
(error "Already bisecting"))
(let ((bad (magit-read-rev "Start bisect with known bad revision" "HEAD"))
(good (magit-read-rev "Good revision" (magit-default-rev))))
(magit--bisect-cmd "start" bad good)))
(defun magit-bisect-reset ()
"Quit a bisect session"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit--bisect-cmd "reset"))
(defun magit-bisect-good ()
"Tell git that the current revision is good during a bisect session"
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "good"))
(defun magit-bisect-bad ()
"Tell git that the current revision is bad during a bisect session"
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "bad"))
(defun magit-bisect-skip ()
"Tell git to skip the current revision during a bisect session."
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "skip"))
(defun magit-bisect-log ()
"Show the bisect log"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit-run-git "bisect" "log")
(magit-display-process))
(defun magit-bisect-visualize ()
"Show the remaining suspects with gitk"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit-run-git "bisect" "visualize")
(unless (getenv "DISPLAY")
(magit-display-process)))
(easy-mmode-defmap magit-bisect-minibuffer-local-map
'(("\C-i" . comint-dynamic-complete-filename))
"Keymap for minibuffer prompting of rebase command."
:inherit minibuffer-local-map)
(defvar magit-bisect-mode-history nil
"Previously run bisect commands.")
(defun magit-bisect-run (command)
"Bisect automatically by running commands after each step"
(interactive
(list
(read-from-minibuffer "Run command (like this): "
""
magit-bisect-minibuffer-local-map
nil
'magit-bisect-mode-history)))
(unless (magit--bisecting-p)
(error "Not bisecting"))
(let ((file (make-temp-file "magit-bisect-run"))
buffer)
(with-temp-buffer
(insert "#!/bin/sh\n" command "\n")
(write-region (point-min) (point-max) file))
(set-file-modes file #o755)
(magit-run-git-async "bisect" "run" file)
(magit-display-process)
(setq buffer (get-buffer magit-process-buffer-name))
(with-current-buffer buffer
(set (make-local-variable 'magit--bisect-last-pos) 0)
(set (make-local-variable 'magit--bisect-tmp-file) file))
(set-process-filter (get-buffer-process buffer) 'magit--bisect-run-filter)
(set-process-sentinel (get-buffer-process buffer) 'magit--bisect-run-sentinel)))
(defun magit--bisect-run-filter (process output)
(with-current-buffer (process-buffer process)
(save-match-data
(let ((inhibit-read-only t)
line new-info)
(insert output)
(goto-char magit--bisect-last-pos)
(beginning-of-line)
(while (< (point) (point-max))
(cond ( ;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
(looking-at "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)")
(setq new-info (list :status 'running
:revs (match-string 1)
:steps (match-string 2))))
( ;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
(looking-at "^\\([a-f0-9]+\\)\\s-.*first bad commit")
(setq new-info (list :status 'finished
:bad (match-string 1)))))
(forward-line 1))
(goto-char (point-max))
(setq magit--bisect-last-pos (point))
(if new-info
(with-current-buffer (magit-find-status-buffer)
(setq magit--bisect-info new-info)
(magit--bisect-update-status-buffer)))))))
(defun magit--bisect-run-sentinel (process event)
(if (string-match-p "^finish" event)
(with-current-buffer (process-buffer process)
(delete-file magit--bisect-tmp-file)))
(magit-process-sentinel process event))
(defun magit--bisect-update-status-buffer ()
(with-current-buffer (magit-find-status-buffer)
(save-excursion
(save-match-data
(let ((inhibit-read-only t))
(goto-char (point-min))
(when (search-forward-regexp "Local:" nil t)
(beginning-of-line)
(kill-line)
(insert (format "Local: %s %s"
(propertize (magit--bisect-info-for-status (magit-get-current-branch))
'face 'magit-branch)
(abbreviate-file-name default-directory)))))))))
(provide 'magit-bisect)

View File

@ -1,521 +0,0 @@
(require 'magit)
(eval-when-compile (require 'cl))
(defvar magit-key-mode-key-maps '()
"This will be filled lazily with proper `define-key' built
keymaps as they're requested.")
(defvar magit-key-mode-buf-name "*magit-key*"
"Name of the buffer.")
(defvar magit-key-mode-current-args '()
"Will contain the arguments to be passed to git.")
(defvar magit-key-mode-current-options '()
"Will contain the arguments to be passed to git.")
(defvar magit-log-mode-window-conf nil
"Will hold the pre-menu configuration of magit.")
(defvar magit-key-mode-groups
'((logging
(man-page "git-log")
(actions
("l" "Short" magit-log)
("L" "Long" magit-log-long)
("h" "Reflog" magit-reflog)
("rl" "Ranged short" magit-log-ranged)
("rL" "Ranged long" magit-log-long-ranged)
("rh" "Ranged reflog" magit-reflog-ranged))
(switches
("-m" "Only merge commits" "--merges")
("-f" "First parent" "--first-parent")
("-i" "Case insensitive patterns" "-i")
("-pr" "Pickaxe regex" "--pickaxe-regex")
("-n" "Name only" "--name-only")
("-am" "All match" "--all-match")
("-al" "All" "--all"))
(arguments
("=r" "Relative" "--relative=" read-directory-name)
("=c" "Committer" "--committer=" read-from-minibuffer)
("=>" "Since" "--since=" read-from-minibuffer)
("=<" "Before" "--before=" read-from-minibuffer)
("=s" "Pickaxe search" "-S" read-from-minibuffer)
("=a" "Author" "--author=" read-from-minibuffer)
("=g" "Grep" "--grep=" read-from-minibuffer)))
(running
(actions
("!" "Command from root" magit-shell-command)
(":" "Git command" magit-git-command)
("g" "git gui" magit-run-git-gui)
("k" "gitk" magit-run-gitk)))
(fetching
(man-page "git-fetch")
(actions
("f" "Current" magit-fetch-current)
("a" "All" magit-remote-update)
("o" "Other" magit-fetch))
(switches
("-p" "Prune" "--prune")))
(pushing
(man-page "git-push")
(actions
("P" "Push" magit-push)
("t" "Push tags" magit-push-tags))
(switches
("-f" "Force" "--force")
("-d" "Dry run" "-n")
("-u" "Set upstream" "-u")))
(pulling
(man-page "git-pull")
(actions
("F" "Pull" magit-pull))
(switches
("-r" "Rebase" "--rebase")))
(branching
(man-page "git-branch")
(actions
("v" "Branch manager" magit-branch-manager)
("c" "Create" magit-create-branch)
("r" "Rename" magit-move-branch)
("k" "Delete" magit-delete-branch)
("b" "Checkout" magit-checkout)))
(remoting
(man-page "git-remote")
(actions
("v" "Branch manager" magit-branch-manager)
("a" "Add" magit-add-remote)
("r" "Rename" magit-rename-remote)
("k" "Remove" magit-remove-remote)))
(tagging
(man-page "git-tag")
(actions
("t" "Lightweight" magit-tag)
("a" "Annotated" magit-annotated-tag))
(switches
("-f" "Force" "-f")))
(stashing
(man-page "git-stash")
(actions
("z" "Save" magit-stash)
("s" "Snapshot" magit-stash-snapshot))
(switches
("-k" "Keep index" "--keep-index")
("-u" "Include untracked files" "--include-untracked")
("-a" "Include all files" "--all")))
(merging
(man-page "git-merge")
(actions
("m" "Merge" magit-manual-merge))
(switches
("-ff" "Fast-forward only" "--ff-only")
("-nf" "No fast-forward" "--no-ff")
("-sq" "Squash" "--squash"))
(arguments
("-st" "Strategy" "--strategy=" read-from-minibuffer)))
(rewriting
(actions
("b" "Begin" magit-rewrite-start)
("s" "Stop" magit-rewrite-stop)
("a" "Abort" magit-rewrite-abort)
("f" "Finish" magit-rewrite-finish)
("*" "Set unused" magit-rewrite-set-unused)
("." "Set used" magit-rewrite-set-used)))
(submodule
(man-page "git-submodule")
(actions
("u" "Update" magit-submodule-update)
("b" "Both update and init" magit-submodule-update-init)
("i" "Init" magit-submodule-init)
("s" "Sync" magit-submodule-sync)))
(bisecting
(man-page "git-bisect")
(actions
("b" "Bad" magit-bisect-bad)
("g" "Good" magit-bisect-good)
("k" "Skip" magit-bisect-skip)
("l" "Log" magit-bisect-log)
("r" "Reset" magit-bisect-reset)
("s" "Start" magit-bisect-start)
("u" "Run" magit-bisect-run)
("v" "Visualize" magit-bisect-visualize))))
"Holds the key, help, function mapping for the log-mode. If you
modify this make sure you reset `magit-key-mode-key-maps' to
nil.")
(defun magit-key-mode-delete-group (group)
"Delete a group from `magit-key-mode-key-maps'."
(let ((items (assoc group magit-key-mode-groups)))
(when items
;; reset the cache
(setq magit-key-mode-key-maps nil)
;; delete the whole group
(setq magit-key-mode-groups
(delq items magit-key-mode-groups))
;; unbind the defun
(magit-key-mode-de-generate group))
magit-key-mode-groups))
(defun magit-key-mode-add-group (group)
"Add a new group to `magit-key-mode-key-maps'. If there's
already a group of that name then this will completely remove it
and put in its place an empty one of the same name."
(when (assoc group magit-key-mode-groups)
(magit-key-mode-delete-group group))
(setq magit-key-mode-groups
(cons (list group (list 'actions)) magit-key-mode-groups)))
(defun magit-key-mode-key-defined-p (for-group key)
"If KEY is defined as any of switch, argument or action within
FOR-GROUP then return t"
(catch 'result
(let ((options (magit-key-mode-options-for-group for-group)))
(dolist (type '(actions switches arguments))
(when (assoc key (assoc type options))
(throw 'result t))))))
(defun magit-key-mode-update-group (for-group thing &rest args)
"Abstraction for setting values in `magit-key-mode-key-maps'."
(let* ((options (magit-key-mode-options-for-group for-group))
(things (assoc thing options))
(key (car args)))
(if (cdr things)
(if (magit-key-mode-key-defined-p for-group key)
(error "%s is already defined in the %s group." key for-group)
(setcdr (cdr things) (cons args (cddr things))))
(setcdr things (list args)))
(setq magit-key-mode-key-maps nil)
things))
(defun magit-key-mode-insert-argument (for-group key desc arg read-func)
"Add a new binding (KEY) in FOR-GROUP which will use READ-FUNC
to receive input to apply to argument ARG git is run. DESC should
be a brief description of the binding."
(magit-key-mode-update-group for-group 'arguments key desc arg read-func))
(defun magit-key-mode-insert-switch (for-group key desc switch)
"Add a new binding (KEY) in FOR-GROUP which will add SWITCH to git's
command line when it runs. DESC should be a brief description of
the binding."
(magit-key-mode-update-group for-group 'switches key desc switch))
(defun magit-key-mode-insert-action (for-group key desc func)
"Add a new binding (KEY) in FOR-GROUP which will run command
FUNC. DESC should be a brief description of the binding."
(magit-key-mode-update-group for-group 'actions key desc func))
(defun magit-key-mode-options-for-group (for-group)
"Retrieve the options (switches, commands and arguments) for
the group FOR-GROUP."
(or (cdr (assoc for-group magit-key-mode-groups))
(error "Unknown group '%s'" for-group)))
(defun magit-key-mode-help (for-group)
"Provide help for a key (which the user is prompted for) within
FOR-GROUP."
(let* ((opts (magit-key-mode-options-for-group for-group))
(man-page (cadr (assoc 'man-page opts)))
(seq (read-key-sequence
(format "Enter command prefix%s: "
(if man-page
(format ", `?' for man `%s'" man-page)
""))))
(actions (cdr (assoc 'actions opts))))
(cond
;; if it is an action popup the help for the to-be-run function
((assoc seq actions) (describe-function (nth 2 (assoc seq actions))))
;; if there is "?" show a man page if there is one
((equal seq "?")
(if man-page
(man man-page)
(error "No man page associated with `%s'" for-group)))
(t (error "No help associated with `%s'" seq)))))
(defun magit-key-mode-exec-at-point ()
"Run action/args/option at point."
(interactive)
(let* ((key (or (get-text-property (point) 'key-group-executor)
(error "Nothing at point to do.")))
(def (lookup-key (current-local-map) key)))
(call-interactively def)))
(defun magit-key-mode-jump-to-next-exec ()
"Jump to the next action/args/option point."
(interactive)
(let* ((oldp (point))
(old (get-text-property oldp 'key-group-executor))
(p (if (= oldp (point-max)) (point-min) (1+ oldp))))
(while (let ((new (get-text-property p 'key-group-executor)))
(and (not (= p oldp)) (or (not new) (eq new old))))
(setq p (if (= p (point-max)) (point-min) (1+ p))))
(goto-char p)
(skip-chars-forward " ")))
(defun magit-key-mode-build-keymap (for-group)
"Construct a normal looking keymap for the key mode to use and
put it in magit-key-mode-key-maps for fast lookup."
(let* ((options (magit-key-mode-options-for-group for-group))
(actions (cdr (assoc 'actions options)))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(map (make-sparse-keymap)))
(suppress-keymap map 'nodigits)
;; ret dwim
(define-key map (kbd "RET") 'magit-key-mode-exec-at-point)
;; tab jumps to the next "button"
(define-key map (kbd "TAB") 'magit-key-mode-jump-to-next-exec)
;; all maps should `quit' with `C-g' or `q'
(define-key map (kbd "C-g") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
(define-key map (kbd "q") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
;; run help
(define-key map (kbd "?") `(lambda ()
(interactive)
(magit-key-mode-help ',for-group)))
(flet ((defkey (k action)
(when (and (lookup-key map (car k))
(not (numberp (lookup-key map (car k)))))
(message "Warning: overriding binding for `%s' in %S"
(car k) for-group)
(ding)
(sit-for 2))
(define-key map (car k)
`(lambda () (interactive) ,action))))
(when actions
(dolist (k actions)
(defkey k `(magit-key-mode-command ',(nth 2 k)))))
(when switches
(dolist (k switches)
(defkey k `(magit-key-mode-add-option ',for-group ,(nth 2 k)))))
(when arguments
(dolist (k arguments)
(defkey k `(magit-key-mode-add-argument
',for-group ,(nth 2 k) ',(nth 3 k))))))
(push (cons for-group map) magit-key-mode-key-maps)
map))
(defvar magit-key-mode-prefix nil
"For internal use. Holds the prefix argument to the command
that brought up the key-mode window, so it can be used by the
command that's eventually invoked.")
(defun magit-key-mode-command (func)
(let ((args '()))
;; why can't maphash return a list?!
(maphash (lambda (k v)
(push (concat k (shell-quote-argument v)) args))
magit-key-mode-current-args)
(let ((magit-custom-options (append args magit-key-mode-current-options))
(current-prefix-arg (or current-prefix-arg magit-key-mode-prefix)))
(set-window-configuration magit-log-mode-window-conf)
(when func
(call-interactively func))
(magit-key-mode-kill-buffer))))
(defvar magit-key-mode-current-args nil
"A hash-table of current argument set (which will eventually
make it to the git command-line).")
(defun magit-key-mode-add-argument (for-group arg-name input-func)
(let ((input (funcall input-func (concat arg-name ": "))))
(puthash arg-name input magit-key-mode-current-args)
(magit-key-mode-redraw for-group)))
(defvar magit-key-mode-current-options '()
"Current option set (which will eventually make it to the git
command-line).")
(defun magit-key-mode-add-option (for-group option-name)
"Toggles the appearance of OPTION-NAME in
`magit-key-mode-current-options'."
(if (not (member option-name magit-key-mode-current-options))
(add-to-list 'magit-key-mode-current-options option-name)
(setq magit-key-mode-current-options
(delete option-name magit-key-mode-current-options)))
(magit-key-mode-redraw for-group))
(defun magit-key-mode-kill-buffer ()
(interactive)
(kill-buffer magit-key-mode-buf-name))
(defvar magit-log-mode-window-conf nil
"Pre-popup window configuration.")
(defun magit-key-mode (for-group &optional original-opts)
"Mode for magit key selection. All commands, switches and
options can be toggled/actioned with the key combination
highlighted before the description."
(interactive)
;; save the window config to restore it as was (no need to make this
;; buffer local)
(setq magit-log-mode-window-conf
(current-window-configuration))
;; setup the mode, draw the buffer
(let ((buf (get-buffer-create magit-key-mode-buf-name)))
(delete-other-windows)
(split-window-vertically)
(other-window 1)
(switch-to-buffer buf)
(kill-all-local-variables)
(set (make-local-variable
'magit-key-mode-current-options)
original-opts)
(set (make-local-variable
'magit-key-mode-current-args)
(make-hash-table))
(set (make-local-variable 'magit-key-mode-prefix) current-prefix-arg)
(magit-key-mode-redraw for-group))
(message
(concat
"Type a prefix key to toggle it. Run 'actions' with their prefixes. "
"'?' for more help.")))
(defun magit-key-mode-get-key-map (for-group)
"Get or build the keymap for FOR-GROUP."
(or (cdr (assoc for-group magit-key-mode-key-maps))
(magit-key-mode-build-keymap for-group)))
(defun magit-key-mode-redraw (for-group)
"(re)draw the magit key buffer."
(let ((buffer-read-only nil)
(old-point (point))
(is-first (zerop (buffer-size)))
(actions-p nil))
(erase-buffer)
(make-local-variable 'font-lock-defaults)
(use-local-map (magit-key-mode-get-key-map for-group))
(setq actions-p (magit-key-mode-draw for-group))
(delete-trailing-whitespace)
(setq mode-name "magit-key-mode" major-mode 'magit-key-mode)
(if (and is-first actions-p)
(progn (goto-char actions-p)
(magit-key-mode-jump-to-next-exec))
(goto-char old-point)))
(setq buffer-read-only t)
(fit-window-to-buffer))
(defun magit-key-mode-draw-header (header)
"Draw a header with the correct face."
(insert (propertize header 'face 'font-lock-keyword-face) "\n"))
(defvar magit-key-mode-args-in-cols nil
"When true, draw arguments in columns as with switches and
options.")
(defun magit-key-mode-draw-args (args)
"Draw the args part of the menu."
(magit-key-mode-draw-buttons
"Args"
args
(lambda (x)
(format "(%s) %s"
(nth 2 x)
(propertize (gethash (nth 2 x) magit-key-mode-current-args "")
'face 'widget-field)))
(not magit-key-mode-args-in-cols)))
(defun magit-key-mode-draw-switches (switches)
"Draw the switches part of the menu."
(magit-key-mode-draw-buttons
"Switches"
switches
(lambda (x)
(format "(%s)" (let ((s (nth 2 x)))
(if (member s magit-key-mode-current-options)
(propertize s 'face 'font-lock-warning-face)
s))))))
(defun magit-key-mode-draw-actions (actions)
"Draw the actions part of the menu."
(magit-key-mode-draw-buttons "Actions" actions nil))
(defun magit-key-mode-draw-buttons (section xs maker
&optional one-col-each)
(when xs
(magit-key-mode-draw-header section)
(magit-key-mode-draw-in-cols
(mapcar (lambda (x)
(let* ((head (propertize (car x) 'face 'font-lock-builtin-face))
(desc (nth 1 x))
(more (and maker (funcall maker x)))
(text (format " %s: %s%s%s"
head desc (if more " " "") (or more ""))))
(propertize text 'key-group-executor (car x))))
xs)
one-col-each)))
(defun magit-key-mode-draw-in-cols (strings one-col-each)
"Given a list of strings, print in columns (using `insert'). If
ONE-COL-EACH is true then don't columify, but rather, draw each
item on one line."
(let ((longest-act (apply 'max (mapcar 'length strings))))
(while strings
(let ((str (car strings)))
(let ((padding (make-string (- (+ longest-act 3) (length str)) ? )))
(insert str)
(if (or one-col-each
(and (> (+ (length padding) ;
(current-column)
longest-act)
(window-width))
(cdr strings)))
(insert "\n")
(insert padding))))
(setq strings (cdr strings))))
(insert "\n"))
(defun magit-key-mode-draw (for-group)
"Function used to draw actions, switches and parameters.
Returns the point before the actions part, if any."
(let* ((options (magit-key-mode-options-for-group for-group))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(actions (cdr (assoc 'actions options)))
(p nil))
(magit-key-mode-draw-switches switches)
(magit-key-mode-draw-args arguments)
(when actions (setq p (point-marker)))
(magit-key-mode-draw-actions actions)
(insert "\n")
p))
(defun magit-key-mode-de-generate (group)
"Unbind the function for GROUP."
(fmakunbound
(intern (concat "magit-key-mode-popup-" (symbol-name group)))))
(defun magit-key-mode-generate (group)
"Generate the key-group menu for GROUP"
(let ((opts (magit-key-mode-options-for-group group)))
(eval
`(defun ,(intern (concat "magit-key-mode-popup-" (symbol-name group))) nil
,(concat "Key menu for " (symbol-name group))
(interactive)
(magit-key-mode (quote ,group))))))
;; create the interactive functions for the key mode popups (which are
;; applied in the top-level key maps)
(mapc (lambda (g)
(magit-key-mode-generate (car g)))
magit-key-mode-groups)
(provide 'magit-key-mode)

View File

@ -1 +0,0 @@
(define-package "magit" "1.2.1" "Control Git from Emacs.")

View File

@ -1,288 +0,0 @@
;;; magit-stgit.el --- StGit plug-in for Magit
;; Copyright (C) 2011 Lluis Vilanova
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides StGit functionality as a separate component of Magit.
;; Available actions:
;; - visit: Shows the patch at point in the series (stg show)
;; - apply: Goes to the patch at point in the series (stg goto)
;; - discard: Deletes the marked/at point patch in the series (stg delete)
;; Available commands:
;; - `magit-stgit-refresh': Refresh the marked/at point patch in the series
;; (stg refresh)
;; - `magit-stgit-repair': Repair the StGit metadata (stg repair)
;; - `magit-stgit-rebase': Rebase the whole series (stg rebase)
;; TODO:
;; - Let the user select which files must be included in a refresh.
;; - Missing actions for `magit-show-item-or-scroll-up' and
;; `magit-show-item-or-scroll-down'.
;; - Marking a patch is slow and refreshes all buffers, which resets their
;; position (i.e., the buffer is shown from its first line).
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
;;; Customizables:
(defcustom magit-stgit-executable "stg"
"The name of the StGit executable."
:group 'magit
:type 'string)
(defface magit-stgit-applied
'((t :inherit magit-diff-add))
"Face for an applied stgit patch."
:group 'magit-faces)
(defface magit-stgit-current
'((t :inherit magit-item-highlight))
"Face for the current stgit patch."
:group 'magit-faces)
(defface magit-stgit-other
'((t :inherit magit-diff-del))
"Face for a non-applied stgit patch."
:group 'magit-faces)
(defface magit-stgit-marked
'((t :inherit magit-item-mark))
"Face for a marked stgit patch."
:group 'magit-faces)
(defface magit-stgit-empty
'((t :inherit magit-item-mark))
"Face for an empty stgit patch."
:group 'magit-faces)
;;; Common code:
(defvar magit-stgit--enabled nil
"Whether this buffer has StGit support.")
(make-variable-buffer-local 'magit-stgit--enabled)
(defvar magit-stgit-mode)
(defun magit-stgit--enabled ()
"Whether this buffer has StGit support enabled."
(if (assoc 'magit-stgit--enabled (buffer-local-variables))
magit-stgit--enabled
(setq magit-stgit--enabled
(and magit-stgit-mode
(not (null
(member (concat (magit-get-current-branch) ".stgit")
(mapcar #'(lambda (line)
(string-match "^\\*?\s*\\([^\s]*\\)"
line)
(match-string 1 line))
(magit-git-lines "branch")))))))))
(defun magit-stgit--enabled-reset ()
"Reset the StGit enabled state."
(kill-local-variable 'magit-stgit--enabled))
(defvar magit-stgit--marked-patch nil
"The (per-buffer) currently marked patch in an StGit series.")
(make-variable-buffer-local 'magit-stgit--marked-patch)
;;; Menu:
(easy-menu-define magit-stgit-extension-menu
nil
"StGit extension menu"
'("StGit"
:active (magit-stgit--enabled)
["Refresh patch" magit-stgit-refresh
:help "Refresh the contents of a patch in an StGit series"]
["Repair" magit-stgit-repair
:help "Repair StGit metadata if branch was modified with git commands"]
["Rebase series" magit-stgit-rebase
:help "Rebase an StGit patch series"]
))
(easy-menu-add-item 'magit-mode-menu
'("Extensions")
magit-stgit-extension-menu)
;;; Series section:
(defun magit-stgit--wash-patch ()
(if (search-forward-regexp "^\\(.\\)\\(.\\) \\([^\s]*\\)\\(\s*# ?\\)\\(.*\\)"
(line-end-position) t)
(let* ((empty-str "[empty] ")
(indent-str (make-string (string-bytes empty-str) ?\ ))
(empty (match-string 1))
(state (match-string 2))
(patch (match-string 3))
(descr (match-string 5)))
(delete-region (line-beginning-position) (line-end-position))
(insert
(cond ((string= empty "0")
(propertize (concat empty-str " " state " " descr) 'face 'magit-stgit-empty))
((string= magit-stgit--marked-patch patch)
(propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-marked))
((string= state "+")
(concat indent-str " " (propertize state 'face 'magit-stgit-applied) " " descr))
((string= state ">")
(propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-current))
((string= state "-")
(concat indent-str " " (propertize state 'face 'magit-stgit-other) " " descr))))
(goto-char (line-beginning-position))
(magit-with-section patch 'series
(magit-set-section-info patch)
(goto-char (line-end-position)))
(forward-line))
(delete-region (line-beginning-position) (1+ (line-end-position))))
t)
(defun magit-stgit--wash-series ()
(let ((magit-old-top-section nil))
(magit-wash-sequence #'magit-stgit--wash-patch)))
(magit-define-inserter series ()
(when (executable-find magit-stgit-executable)
(magit-insert-section 'series
"Series:" 'magit-stgit--wash-series
magit-stgit-executable "series" "-a" "-d" "-e")))
;;; Actions:
;; Copy of `magit-refresh-commit-buffer' (version 1.0.0)
(defun magit-stgit--refresh-patch-buffer (patch)
(magit-create-buffer-sections
(magit-insert-section nil nil
'magit-wash-commit
magit-stgit-executable
"show"
patch)))
;; Copy of `magit-show-commit' (version 1.0.0)
(defun magit-stgit--show-patch (patch &optional scroll)
(when (magit-section-p patch)
(setq patch (magit-section-info patch)))
(let ((dir default-directory)
(buf (get-buffer-create magit-commit-buffer-name)))
(cond ((and (equal magit-currently-shown-commit patch)
;; if it's empty then the buffer was killed
(with-current-buffer buf
(> (length (buffer-string)) 1)))
(let ((win (get-buffer-window buf)))
(cond ((not win)
(display-buffer buf))
(scroll
(with-selected-window win
(funcall scroll))))))
(t
(setq magit-currently-shown-commit patch)
(display-buffer buf)
(with-current-buffer buf
(set-buffer buf)
(goto-char (point-min))
(magit-mode-init dir 'magit-commit-mode
#'magit-stgit--refresh-patch-buffer patch))))))
(magit-add-action (item info "visit")
((series)
(magit-stgit--show-patch info)
(pop-to-buffer magit-commit-buffer-name)))
(magit-add-action (item info "apply")
((series)
(magit-run magit-stgit-executable "goto" info)))
(magit-add-action (item info "discard")
((series)
(let ((patch (or magit-stgit--marked-patch info)))
(if (yes-or-no-p (format "Delete patch '%s' in series? " patch))
(progn
(if (string= magit-stgit--marked-patch patch)
(setq magit-stgit--marked-patch nil))
(magit-run magit-stgit-executable "delete" patch))))))
(defun magit-stgit--set-marked-patch (patch)
(setq magit-stgit--marked-patch
(if (string= magit-stgit--marked-patch patch)
nil
patch)))
(magit-add-action (item info "mark")
((series)
(magit-stgit--set-marked-patch info)
(magit-refresh-all)))
;;; Commands:
(defun magit-stgit-refresh ()
"Refresh the contents of a patch in an StGit series.
If there is no marked patch in the series, refreshes the current
patch.
Otherwise, refreshes the marked patch."
(interactive)
(if magit-stgit--marked-patch
(magit-run magit-stgit-executable "refresh" "-p" magit-stgit--marked-patch)
(magit-run magit-stgit-executable "refresh")))
(defun magit-stgit-repair ()
"Repair StGit metadata if branch was modified with git commands.
In the case of Git commits these will be imported as new patches
into the series."
(interactive)
(message "Repairing series...")
(magit-run magit-stgit-executable "repair")
(message ""))
(defun magit-stgit-rebase ()
"Rebase an StGit patch series."
(interactive)
(if (magit-get-current-remote)
(progn
(if (yes-or-no-p "Update remotes? ")
(progn
(message "Updating remotes...")
(magit-run-git-async "remote" "update")))
(magit-run magit-stgit-executable "rebase"
(format "remotes/%s/%s"
(magit-get-current-remote)
(magit-get-current-branch))))))
;;;###autoload
(define-minor-mode magit-stgit-mode "StGit support for Magit"
:lighter " Stg" :require 'magit-stgit
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(if magit-stgit-mode
(progn
(add-hook 'magit-after-insert-stashes-hook 'magit-insert-series nil t))
(progn
(remove-hook 'magit-after-insert-stashes-hook 'magit-insert-series t)))
(when (called-interactively-p 'any)
(magit-refresh)))
;;;###autoload
(defun turn-on-magit-stgit ()
"Unconditionally turn on `magit-stgit-mode'."
(magit-stgit-mode 1))
(provide 'magit-stgit)
;;; magit-stgit.el ends here

View File

@ -1,240 +0,0 @@
;;; magit-svn.el --- git-svn plug-in for Magit
;; Copyright (C) 2008 Alex Ott
;; Copyright (C) 2009 Alexey Voinov
;; Copyright (C) 2009 John Wiegley
;; Copyright (C) 2008 Linh Dang
;; Copyright (C) 2008 Marcin Bachry
;; Copyright (C) 2008, 2009 Marius Vollmer
;; Copyright (C) 2010 Yann Hodique
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides git-svn functionality as a separate component of Magit
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
;; git svn commands
(defun magit-svn-find-rev (rev &optional branch)
(interactive
(list (read-string "SVN revision: ")
(if current-prefix-arg
(read-string "In branch: "))))
(let* ((sha (apply 'magit-git-string
`("svn"
"find-rev"
,(concat "r" rev)
,@(when branch (list branch))))))
(if sha
(magit-show-commit
(magit-with-section sha 'commit
(magit-set-section-info sha)
sha))
(error "Revision %s could not be mapped to a commit" rev))))
(defun magit-svn-create-branch (name)
(interactive "sBranch name: ")
(magit-run-git "svn" "branch" name))
(defun magit-svn-rebase ()
(interactive)
(magit-run-git-async "svn" "rebase"))
(defun magit-svn-dcommit ()
(interactive)
(magit-run-git-async "svn" "dcommit"))
(defun magit-svn-enabled ()
(not (null (magit-svn-get-ref-info t))))
(defun magit-svn-expand-braces-in-branches (branch)
(if (not (string-match "\\(.+\\){\\(.+,.+\\)}\\(.*\\):\\(.*\\)\\\*" branch))
(list branch)
(let ((prefix (match-string 1 branch))
(suffix (match-string 3 branch))
(rhs (match-string 4 branch))
(pieces (split-string (match-string 2 branch) ",")))
(mapcar (lambda (p) (concat prefix p suffix ":" rhs p)) pieces))))
(defun magit-svn-get-local-ref (url)
(let* ((branches (cons (magit-get "svn-remote" "svn" "fetch")
(magit-get-all "svn-remote" "svn" "branches")))
(branches (apply 'nconc
(mapcar 'magit-svn-expand-braces-in-branches
branches)))
(base-url (magit-get "svn-remote" "svn" "url"))
(result nil))
(while branches
(let* ((pats (split-string (pop branches) ":"))
(src (replace-regexp-in-string "\\*" "\\\\(.*\\\\)" (car pats)))
(dst (replace-regexp-in-string "\\*" "\\\\1" (cadr pats)))
(base-url (replace-regexp-in-string "\\+" "\\\\+" base-url))
(base-url (replace-regexp-in-string "//.+@" "//" base-url))
(pat1 (concat "^" src "$"))
(pat2 (cond ((equal src "") (concat "^" base-url "$"))
(t (concat "^" base-url "/" src "$")))))
(cond ((string-match pat1 url)
(setq result (replace-match dst nil nil url))
(setq branches nil))
((string-match pat2 url)
(setq result (replace-match dst nil nil url))
(setq branches nil)))))
result))
(defvar magit-svn-get-ref-info-cache nil
"A cache for svn-ref-info.
As `magit-get-svn-ref-info' might be considered a quite
expensive operation a cache is taken so that `magit-status'
doesn't repeatedly call it.")
(defun magit-svn-get-ref-info (&optional use-cache)
"Gather details about the current git-svn repository.
Return nil if there isn't one. Keys of the alist are ref-path,
trunk-ref-name and local-ref-name.
If USE-CACHE is non-nil then return the value of `magit-get-svn-ref-info-cache'."
(if (and use-cache magit-svn-get-ref-info-cache)
magit-svn-get-ref-info-cache
(let* ((fetch (magit-get "svn-remote" "svn" "fetch"))
(url)
(revision))
(when fetch
(let* ((ref (cadr (split-string fetch ":")))
(ref-path (file-name-directory ref))
(trunk-ref-name (file-name-nondirectory ref)))
(set (make-local-variable
'magit-svn-get-ref-info-cache)
(list
(cons 'ref-path ref-path)
(cons 'trunk-ref-name trunk-ref-name)
;; get the local ref from the log. This is actually
;; the way that git-svn does it.
(cons 'local-ref
(with-temp-buffer
(insert (or (magit-git-string "log" "--first-parent"
"--grep" "git-svn" "-1")
""))
(goto-char (point-min))
(cond ((re-search-forward "git-svn-id: \\(.+/.+?\\)@\\([0-9]+\\)" nil t)
(setq url (match-string 1)
revision (match-string 2))
(magit-svn-get-local-ref url))
(t
(setq url (magit-get "svn-remote" "svn" "url"))
nil))))
(cons 'revision revision)
(cons 'url url))))))))
(defun magit-svn-get-ref (&optional use-cache)
"Get the best guess remote ref for the current git-svn based branch.
If USE-CACHE is non nil, use the cached information."
(let ((info (magit-svn-get-ref-info use-cache)))
(cdr (assoc 'local-ref info))))
(magit-define-inserter svn-unpulled (&optional use-cache)
(when (magit-svn-enabled)
(apply #'magit-git-section
'svn-unpulled "Unpulled commits (SVN):" 'magit-wash-log "log"
(append magit-git-log-options
(list
(format "HEAD..%s" (magit-svn-get-ref use-cache)))))))
(magit-define-inserter svn-unpushed (&optional use-cache)
(when (magit-svn-enabled)
(apply #'magit-git-section
'svn-unpushed "Unpushed commits (SVN):" 'magit-wash-log "log"
(append magit-git-log-options
(list
(format "%s..HEAD" (magit-svn-get-ref use-cache)))))))
(magit-define-section-jumper svn-unpushed "Unpushed commits (SVN)")
(defun magit-svn-remote-string ()
(let ((svn-info (magit-svn-get-ref-info)))
(when svn-info
(concat (cdr (assoc 'url svn-info))
" @ "
(cdr (assoc 'revision svn-info))))))
(defun magit-svn-remote-update ()
(interactive)
(when (magit-svn-enabled)
(magit-run-git-async "svn" "fetch")))
(easy-menu-define magit-svn-extension-menu
nil
"Git SVN extension menu"
'("Git SVN"
:visible magit-svn-mode
["Create branch" magit-svn-create-branch (magit-svn-enabled)]
["Rebase" magit-svn-rebase (magit-svn-enabled)]
["Fetch" magit-svn-remote-update (magit-svn-enabled)]
["Commit" magit-svn-dcommit (magit-svn-enabled)]))
(easy-menu-add-item 'magit-mode-menu
'("Extensions")
magit-svn-extension-menu)
;; add the group and its keys
(progn
;; (re-)create the group
(magit-key-mode-add-group 'svn)
(magit-key-mode-insert-action 'svn "r" "Rebase" 'magit-svn-rebase)
(magit-key-mode-insert-action 'svn "c" "DCommit" 'magit-svn-dcommit)
(magit-key-mode-insert-action 'svn "f" "Fetch" 'magit-svn-remote-update)
(magit-key-mode-insert-action 'svn "s" "Find rev" 'magit-svn-find-rev)
(magit-key-mode-insert-action 'svn "B" "Create branch" 'magit-svn-create-branch)
;; generate and bind the menu popup function
(magit-key-mode-generate 'svn))
(defvar magit-svn-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "N") 'magit-key-mode-popup-svn)
map))
;;;###autoload
(define-minor-mode magit-svn-mode "SVN support for Magit"
:lighter " SVN" :require 'magit-svn :keymap 'magit-svn-mode-map
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(let ((unpulled-hook (lambda () (magit-insert-svn-unpulled t)))
(unpushed-hook (lambda () (magit-insert-svn-unpushed t)))
(remote-hook 'magit-svn-remote-string))
(if magit-svn-mode
(progn
(add-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook nil t)
(add-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook nil t)
(add-hook 'magit-remote-string-hook remote-hook nil t))
(progn
(remove-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook t)
(remove-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook t)
(remove-hook 'magit-remote-string-hook remote-hook t)))
(when (called-interactively-p 'any)
(magit-refresh))))
;;;###autoload
(defun turn-on-magit-svn ()
"Unconditionally turn on `magit-svn-mode'."
(magit-svn-mode 1))
(provide 'magit-svn)
;;; magit-svn.el ends here

View File

@ -1,191 +0,0 @@
;;; magit-topgit.el --- topgit plug-in for Magit
;; Copyright (C) 2010 Nathan Weizenbaum
;; Copyright (C) 2010 Yann Hodique
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides topgit functionality as a separate component of Magit
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
(defcustom magit-topgit-executable "tg"
"The name of the TopGit executable."
:group 'magit
:type 'string)
(defcustom magit-topgit-branch-prefix "t/"
"Convention prefix for topic branch creation."
:group 'magit
:type 'string)
(defface magit-topgit-current
'((t :weight bold :inherit magit-branch))
"Face for section titles."
:group 'magit-faces)
;;; Topic branches (using topgit)
(defun magit-topgit-in-topic-p ()
(and (file-exists-p ".topdeps")
(executable-find magit-topgit-executable)))
(defun magit-topgit-create-branch (branch parent)
(when (zerop (or (string-match magit-topgit-branch-prefix branch) -1))
(magit-run* (list magit-topgit-executable "create"
branch (magit-rev-to-git parent))
nil nil nil t)
t))
(defun magit-topgit-pull ()
(when (magit-topgit-in-topic-p)
(magit-run* (list magit-topgit-executable "update")
nil nil nil t)
t))
(defun magit-topgit-push ()
(when (magit-topgit-in-topic-p)
(let* ((branch (or (magit-get-current-branch)
(error "Don't push a detached head. That's gross")))
(remote (magit-get "topgit" "remote"))
(push-remote (if (or current-prefix-arg (not remote))
(magit-read-remote (format "Push %s to" branch))
remote)))
(when (and (not remote)
(not current-prefix-arg))
(magit-set push-remote "topgit" "remote"))
(magit-run magit-topgit-executable "push" "-r" push-remote))
t))
(defun magit-topgit-remote-update (&optional remote)
(when (magit-topgit-in-topic-p)
(let* ((remote (magit-get "topgit" "remote"))
(remote-update (if (or current-prefix-arg (not remote))
(magit-read-remote)
remote)))
(if (and (not remote)
(not current-prefix-arg))
(progn
(magit-set remote-update "topgit" "remote")
(magit-run magit-topgit-executable "remote"
"--populate" remote-update)))
(magit-run magit-topgit-executable "remote" remote-update))
;; We return nil anyway, as we also want regular "git remote update" to
;; happen
nil))
(defun magit-topgit-parse-flags (flags-string)
(let ((flags (string-to-list flags-string))
(void-flag ?\ ))
(list :current (not (eq (nth 0 flags) void-flag))
:empty (not (eq (nth 1 flags) void-flag)))))
(defun magit-topgit-wash-topic ()
(let ((fmt "^\\(.\\{7\\}\\)\\s-\\(\\S-+\\)\\s-+\\(.*\\)"))
(if (search-forward-regexp fmt (line-end-position) t)
(let ((flags (magit-topgit-parse-flags (match-string 1)))
(topic (match-string 2)))
(goto-char (line-beginning-position))
(delete-char 8)
(insert "\t")
(goto-char (line-beginning-position))
(magit-with-section topic 'topic
(magit-set-section-info topic)
(let ((beg (1+ (line-beginning-position)))
(end (line-end-position)))
(when (plist-get flags :current)
(put-text-property beg end 'face 'magit-topgit-current))
(when (plist-get flags :empty)
(put-text-property beg end 'face `(:strike-through t :inherit ,(get-text-property beg 'face)))))
(forward-line)))
(delete-region (line-beginning-position) (1+ (line-end-position))))
t))
(defun magit-topgit-wash-topics ()
(let ((magit-old-top-section nil))
(magit-wash-sequence #'magit-topgit-wash-topic)))
(defun magit-topgit-section (section title washer &rest args)
(when (executable-find magit-topgit-executable)
(let ((magit-git-executable magit-topgit-executable)
(magit-git-standard-options nil))
(apply 'magit-git-section section title washer args))))
(magit-define-inserter topics ()
(magit-topgit-section 'topics
"Topics:" 'magit-topgit-wash-topics
"summary"))
(magit-add-action (item info "discard")
((topic)
(when (yes-or-no-p "Discard topic? ")
(magit-run* (list magit-topgit-executable "delete" "-f" info)
nil nil nil t))))
(magit-add-action (item info "visit")
((topic)
(magit-checkout info)))
(defun magit-topgit-get-top-bases-color (suffix)
(list nil nil))
(defun magit-topgit-get-remote-top-bases-color (suffix)
(when (string-match "^\\(?:[^/]+\\)/top-bases" suffix)
(list nil nil)))
(defconst magit-topgit-ignored-namespace
'("top-bases" magit-topgit-get-top-bases-color))
;;;###autoload
(define-minor-mode magit-topgit-mode "Topgit support for Magit"
:lighter " Topgit" :require 'magit-topgit
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(if magit-topgit-mode
(progn
(add-hook 'magit-after-insert-stashes-hook 'magit-insert-topics nil t)
(add-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch nil t)
(add-hook 'magit-pull-command-hook 'magit-topgit-pull nil t)
(add-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update nil t)
(add-hook 'magit-push-command-hook 'magit-topgit-push nil t)
;; hide refs for top-bases namespace in any remote
(add-hook 'magit-log-remotes-color-hook
'magit-topgit-get-remote-top-bases-color)
;; hide refs in the top-bases namespace, as they're not meant for the user
(add-to-list 'magit-refs-namespaces magit-topgit-ignored-namespace))
(progn
(remove-hook 'magit-after-insert-stashes-hook 'magit-insert-topics t)
(remove-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch t)
(remove-hook 'magit-pull-command-hook 'magit-topgit-pull t)
(remove-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update t)
(remove-hook 'magit-push-command-hook 'magit-topgit-push t)
(remove-hook 'magit-log-remotes-color-hook
'magit-topgit-get-remote-top-bases-color)
(delete magit-topgit-ignored-namespace magit-refs-namespaces)))
(when (called-interactively-p 'any)
(magit-refresh)))
;;;###autoload
(defun turn-on-magit-topgit ()
"Unconditionally turn on `magit-topgit-mode'."
(magit-topgit-mode 1))
(provide 'magit-topgit)
;;; magit-topgit.el ends here

View File

@ -1,153 +0,0 @@
;;; magit-wip.el --- git-wip plug-in for Magit
;; Copyright (C) 2012 Jonas Bernoulli
;; Copyright (C) 2012 Ryan C. Thompson
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides support for special work-in-progress refs.
;; This requires the third-party git command "git wip" which is available
;; from https://github.com/bartman/git-wip.
;; The global mode `magit-wip-mode' provides highlighting of wip refs in
;; Magit buffers while the local mode `magit-wip-save-mode' commits to
;; such a ref when saving a file-visiting buffer.
;; To enable `magit-wip-save-mode' enable `global-magit-wip-save-mode'
;; and use the Magit extension mechanism to select the repositories in
;; which you want to use a work-in-progress ref. Usually you also want
;; to enable `magit-wip-mode'.
;;
;; (magit-wip-mode 1)
;; (global-magit-wip-save-mode 1)
;;
;; $ git config --add magit.extension wip-save # or
;; $ git config --global --add magit.extension wip-save
;; Note that `global-magit-wip-save-mode' is the only mode that uses the
;; extension mechanism for file-visiting buffers all other global modes
;; making use of it to turn on local modes in Magit buffers.
;;; Code:
(require 'magit)
(require 'format-spec)
;;; Magit Wip Mode.
(defface magit-log-head-label-wip
'((((class color) (background light))
:box t
:background "Grey95"
:foreground "LightSkyBlue3")
(((class color) (background dark))
:box t
:background "Grey07"
:foreground "LightSkyBlue4"))
"Face for git-wip labels shown in log buffer."
:group 'magit-faces)
(defun magit-log-get-wip-color (suffix)
(list (concat "(WIP) " suffix)
'magit-log-head-label-wip))
(defconst magit-wip-refs-namespace
'("wip" magit-log-get-wip-color))
;;;###autoload
(define-minor-mode magit-wip-mode
"In Magit log buffers; give wip refs a special appearance."
:group 'magit
:global t
(if magit-wip-mode
(add-to-list 'magit-refs-namespaces magit-wip-refs-namespace 'append)
(setq magit-refs-namespaces
(delete magit-wip-refs-namespace magit-refs-namespaces))))
;;; Magit Wip Save Mode.
(defcustom magit-wip-commit-message "WIP %r"
"Commit message for git-wip commits.
The following `format'-like specs are supported:
%f the full name of the file being saved, and
%r the name of the file being saved, relative to the repository root
%g the root of the git repository."
:group 'magit
:type 'string)
(defcustom magit-wip-echo-area-message "Wrote %f (wip)"
"Message shown in the echo area after creating a git-wip commit.
The following `format'-like specs are supported:
%f the full name of the file being saved, and
%r the name of the file being saved, relative to the repository root.
%g the root of the git repository."
:group 'magit
:type '(choice (const :tag "No message" nil) string))
(defvar magit-wip-save-mode-lighter " Wip")
;;;###autoload
(define-minor-mode magit-wip-save-mode
"Magit support for committing to a work-in-progress ref.
When this minor mode is turned on and a file is saved inside a writable
git repository then it is also committed to a special work-in-progress
ref."
:lighter magit-wip-save-mode-lighter
(if magit-wip-save-mode
(add-hook 'after-save-hook 'magit-wip-save-safe t t)
(remove-hook 'after-save-hook 'magit-wip-save-safe t)))
;;;###autoload
(define-globalized-minor-mode global-magit-wip-save-mode
magit-wip-save-mode turn-on-magit-wip-save
:group 'magit)
(defun turn-on-magit-wip-save ()
(when (and (buffer-file-name)
(magit-get-top-dir default-directory)
(member "wip-save" (magit-get-all "magit.extension")))
(if (= (magit-git-exit-code "wip" "-h") 0)
(magit-wip-save-mode 1)
(message "Git command 'git wip' cannot be found"))))
(defun magit-wip-save-safe ()
(condition-case err
(magit-wip-save)
(error
(message "Magit WIP got an error: %S" err))))
(defun magit-wip-save ()
(let* ((top-dir (magit-get-top-dir default-directory))
(name (file-truename (buffer-file-name)))
(spec `((?r . ,(file-relative-name name top-dir))
(?f . ,(buffer-file-name))
(?g . ,top-dir))))
(when (and top-dir (file-writable-p top-dir))
(save-excursion ; kludge see https://github.com/magit/magit/issues/441
(magit-run-git "wip" "save"
(format-spec magit-wip-commit-message spec)
"--editor" "--" name))
(when magit-wip-echo-area-message
(message (format-spec magit-wip-echo-area-message spec))))))
(provide 'magit-wip)
;;; magit-wip.el ends here

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,322 +0,0 @@
;;; rebase-mode -- edit git rebase files.
;; Copyright (C) 2010 Phil Jackson
;; Copyright (C) 2011 Peter J Weisberg
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Allows the editing of a git rebase file (which you might get when
;; using 'git rebase -i' or hitting 'E' in Magit). Assumes editing is
;; happening in a server.
;;; Code:
(require 'server)
(defgroup rebase-mode nil
"Customize Rebase Mode"
:group 'faces)
(defface rebase-mode-killed-action-face
'((((class color))
:inherit font-lock-comment-face
:strike-through t))
"Action lines in the rebase TODO list that have been commented out."
:group 'rebase-mode)
(defface rebase-mode-description-face
'((t :inherit font-lock-comment-face))
"Face for one-line commit descriptions"
:group 'rebase-mode)
(defconst rebase-mode-action-line-re
(rx
line-start
(? "#")
(group
(|
(any "presf")
"pick"
"reword"
"edit"
"squash"
"fixup"))
(char space)
(group
(** 4 40 hex-digit)) ;sha1
(char space)
(group
(* not-newline)))
"Regexp that matches an action line in a rebase buffer.")
(defconst rebase-mode-exec-line-re
(rx
line-start
(? "#")
(group
(| "x"
"exec"))
(char space)
(group
(* not-newline)))
"Regexp that matches an exec line in a rebase buffer.")
(defconst rebase-mode-dead-line-re
(rx-to-string `(and line-start
(char ?#)
(or (regexp ,(substring rebase-mode-action-line-re 1))
(regexp ,(substring rebase-mode-exec-line-re 1)))) t)
"Regexp that matches a commented-out exec or action line in a rebase buffer.")
(defvar rebase-mode-font-lock-keywords
(list
(list rebase-mode-action-line-re
'(1 font-lock-keyword-face)
'(2 font-lock-builtin-face)
'(3 'rebase-mode-description-face))
(list rebase-mode-exec-line-re
'(1 font-lock-keyword-face))
(list (rx line-start (char "#") (* not-newline)) 0 font-lock-comment-face)
(list rebase-mode-dead-line-re 0 ''rebase-mode-killed-action-face t))
"Font lock keywords for `rebase-mode'.")
(defvar key-to-action-map
'(("c" . "pick")
("r" . "reword")
("e" . "edit")
("s" . "squash")
("f" . "fixup"))
"Mapping from key to action.")
(defvar rebase-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") 'server-edit)
(define-key map (kbd "C-c C-c") 'server-edit)
(define-key map (kbd "a") 'rebase-mode-abort)
(define-key map (kbd "C-c C-k") 'rebase-mode-abort)
(define-key map (kbd "M-p") 'rebase-mode-move-line-up)
(define-key map (kbd "M-n") 'rebase-mode-move-line-down)
(define-key map (kbd "k") 'rebase-mode-kill-line)
(define-key map (kbd "x") 'rebase-mode-exec)
(define-key map (kbd "n") 'forward-line)
(define-key map (kbd "p") '(lambda(n)
(interactive "p")
(forward-line (* n -1))))
(define-key map [remap undo] 'rebase-mode-undo)
map)
"Keymap for rebase-mode. Note this will be added to by the
top-level code which defines the edit functions.")
(require 'easymenu)
(easy-menu-define rebase-mode-menu rebase-mode-map
"Rebase-mode menu"
'("Rebase"
["Pick" rebase-mode-pick t]
["Reword" rebase-mode-reword t]
["Edit" rebase-mode-edit t]
["Squash" rebase-mode-squash t]
["Fixup" rebase-mode-fixup t]
["Kill" rebase-mode-kill-line t]
["Move Down" rebase-mode-move-line-down t]
["Move Up" rebase-mode-move-line-up t]
["Execute" rebase-mode-exec t]
"---"
["Abort" rebase-mode-abort t]
["Done" server-edit t]))
;; create the functions which edit the action lines themselves (based
;; on `key-to-action-map' above)
(mapc (lambda (key-action)
(let ((fun-name (intern (concat "rebase-mode-" (cdr key-action)))))
;; define the function
(eval `(defun ,fun-name ()
(interactive)
(rebase-mode-edit-line ,(cdr key-action))))
;; bind the function in `rebase-mode-map'
(define-key rebase-mode-map (car key-action) fun-name)))
key-to-action-map)
(defun rebase-mode-edit-line (change-to)
"Change the keyword at the start of the current action line to
that of CHANGE-TO."
(when (rebase-mode-looking-at-action)
(let ((buffer-read-only nil)
(start (point)))
(goto-char (point-at-bol))
(delete-region (point) (progn (forward-word 1) (point)))
(insert change-to)
(goto-char start))))
(defun rebase-mode-looking-at-action ()
"Return non-nil if looking at an action line."
(save-excursion
(goto-char (point-at-bol))
(looking-at rebase-mode-action-line-re)))
(defun rebase-mode-looking-at-action-or-exec ()
"Return non-nil if looking at an action line or exec line."
(save-excursion
(goto-char (point-at-bol))
(or (looking-at rebase-mode-action-line-re)
(looking-at rebase-mode-exec-line-re))))
(defun rebase-mode-looking-at-exec ()
"Return non-nil if cursor is on an exec line."
(string-match rebase-mode-exec-line-re (thing-at-point 'line)))
(defun rebase-mode-looking-at-killed-exec ()
"Return non-nil if looking at an exec line that has been commented out"
(let ((line (thing-at-point 'line)))
(and (eq (aref line 0) ?#)
(string-match rebase-mode-exec-line-re line))))
(defun rebase-mode-move-line-up ()
"Move the current action line up."
(interactive)
(when (rebase-mode-looking-at-action-or-exec)
(let ((buffer-read-only nil)
(col (current-column)))
(transpose-lines 1)
(forward-line -2)
(move-to-column col))))
(defun rebase-mode-move-line-down ()
"Assuming the next line is also an action line, move the current line down."
(interactive)
;; if we're on an action and the next line is also an action
(when (and (rebase-mode-looking-at-action-or-exec)
(save-excursion
(forward-line)
(rebase-mode-looking-at-action-or-exec)))
(let ((buffer-read-only nil)
(col (current-column)))
(forward-line 1)
(transpose-lines 1)
(forward-line -1)
(move-to-column col))))
(defun rebase-mode-abort ()
"Abort this rebase (by emptying the buffer, saving and closing
server connection)."
(interactive)
(when (or (not (buffer-modified-p))
(y-or-n-p "Abort this rebase? "))
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(save-buffer)
(server-edit))))
(defun rebase-mode-kill-line ()
"Kill the current action line."
(interactive)
(when (and (not (eq (char-after (point-at-bol)) ?#))
(rebase-mode-looking-at-action-or-exec))
(beginning-of-line)
(let ((buffer-read-only nil))
(insert "#"))
(forward-line)))
(defun rebase-mode-exec (edit)
"Prompt the user for a shell command to be executed, and add it to
the todo list.
If the cursor is on a commented-out exec line, uncomment the
current line instead of prompting.
When the prefix argument EDIT is non-nil and the cursor is on an
exec line, edit that line instead of inserting a new one. If the
exec line was commented out, also uncomment it."
(interactive "P")
(cond
((and edit (rebase-mode-looking-at-exec))
(let ((new-line (rebase-mode-read-exec-line
(match-string-no-properties 2 (thing-at-point 'line))))
(inhibit-read-only t))
(delete-region (point-at-bol) (point-at-eol))
(if (not (equal "" new-line))
(insert "exec " new-line)
(delete-char -1)
(forward-line))
(move-beginning-of-line nil)))
((rebase-mode-looking-at-killed-exec)
(save-excursion
(beginning-of-line)
(let ((buffer-read-only nil))
(delete-char 1))))
(t
(let ((inhibit-read-only t)
(line (rebase-mode-read-exec-line)))
(unless (equal "" line)
(move-end-of-line nil)
(newline)
(insert (concat "exec " line))))
(move-beginning-of-line nil))))
(defun rebase-mode-read-exec-line (&optional initial-line)
(read-shell-command "Execute: " initial-line))
(defun rebase-mode-undo (&optional arg)
"A thin wrapper around `undo', which allows undoing in
read-only buffers."
(interactive "P")
(let ((inhibit-read-only t))
(undo arg)))
;;;###autoload
(define-derived-mode rebase-mode special-mode "Rebase"
"Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details."
(setq font-lock-defaults '(rebase-mode-font-lock-keywords t t)))
(defun rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(save-excursion
(goto-char (point-min))
(while (search-forward-regexp "^# \\(.\\), \\([[:alpha:]]+\\) = " nil t)
(let ((start (match-beginning 1))
(end (match-end 1))
(command (intern (concat "rebase-mode-" (match-string 2)))))
(when (fboundp command)
(let ((overlay (make-overlay start end)))
(overlay-put overlay
'display
(key-description (where-is-internal command nil t)))))))))
(add-hook 'rebase-mode-hook 'rebase-mode-show-keybindings t)
(defun rebase-mode-disable-before-save-hook ()
(set (make-local-variable 'before-save-hook) nil))
(add-hook 'rebase-mode-hook 'rebase-mode-disable-before-save-hook)
;;;###autoload
(add-to-list 'auto-mode-alist
'("git-rebase-todo" . rebase-mode))
(provide 'rebase-mode)
;;; rebase-mode.el ends here

184
elpa/magit-1.4.1/AUTHORS.md Normal file
View File

@ -0,0 +1,184 @@
Authors
=======
Also see https://github.com/magit/magit/graphs/contributors.
Names below are sorted alphabetically.
Author
------
- Marius Vollmer <marius.vollmer@gmail.com>
Maintainer
----------
- Jonas Bernoulli <jonas@bernoul.li>
Retired Maintainers
-------------------
- Nicolas Dudebout <nicolas.dudebout@gatech.edu>
- Peter J. Weisberg <pj@irregularexpressions.net>
- Phil Jackson <phil@shellarchive.co.uk>
- Rémi Vanicat <vanicat@debian.org>
- Yann Hodique <yann.hodique@gmail.com>
Contributors
------------
- aaa707 <aaa707b@gmail.com>
- Aaron Culich <aculich@gmail.com>
- Abdo Roig-Maranges <abdo.roig@gmail.com>
- acple <silentsphere110@gmail.com>
- Adam Spiers <emacs@adamspiers.org>
- Ævar Arnfjörð Bjarmason <avarab@gmail.com>
- Alan Falloon <alan.falloon@gmail.com>
- Alexey Voinov <alexey.v.voinov@gmail.com>
- Alex Ott <alexott@gmail.com>
- Andreas Fuchs <asf@boinkor.net>
- Andreas Liljeqvist <andreas.liljeqvist@robacks.se>
- Andreas Rottmann <a.rottmann@gmx.at>
- Andrei Chițu <andrei.chitu1@gmail.com>
- Andrew Kirkpatrick <andrew.kirkpatrick@adelaide.edu.au>
- Andrew Schwartzmeyer <andrew@schwartzmeyer.com>
- Andrey Smirnov <andrew.smirnov@gmail.com>
- Bastian Beischer <beischer@physik.rwth-aachen.de>
- Ben Walton <bwalton@artsci.utoronto.ca>
- Bradley Wright <brad@intranation.com>
- Brandon W Maister <quodlibetor@gmail.com>
- Brian Warner <warner@lothar.com>
- Bryan Shell <bryan.shell@orbitz.com>
- Chris Bernard <cebernard@gmail.com>
- Chris Done <chrisdone@gmail.com>
- Chris Moore <dooglus@gmail.com>
- Chris Ring <chris@ringthis.com>
- Christian Dietrich <christian.dietrich@informatik.uni-erlangen.de>
- Christian Kluge <ckfrakturfreak@web.de>
- Christopher Monsanto <chris@monsan.to>
- Cornelius Mika <cornelius.mika@gmail.com>
- Craig Andera <candera@wangdera.com>
- Dale Hagglund <dale.hagglund@gmail.com>
- Damien Cassou <damien.cassou@gmail.com>
- Daniel Brockman <daniel@gointeractive.se>
- Daniel Farina <drfarina@acm.org>
- Daniel Hackney <dan@haxney.org>
- Dan LaManna <dan.lamanna@gmail.com>
- David Abrahams <dave@boostpro.com>
- David Hull <david.hull@openx.com>
- David Wallin <david.wallin@gmail.com>
- Dennis Paskorz <dennis@walltowall.com>
- Divye Kapoor <divye@google.com>
- Dominique Quatravaux <domq@google.com>
- Eli Barzilay <eli@barzilay.org>
- Eric Davis <ed@npri.org>
- Eric Schulte <schulte.eric@gmail.com>
- Evgkeni Sampelnikof <esabof@gmail.com>
- Felix Geller <fgeller@gmail.com>
- Feng Li <fengli@blackmagicdesign.com>
- Geoff Shannon <geoffpshannon@gmail.com>
- George Kadianakis <desnacked@gmail.com>
- Graham Clark <grclark@gmail.com>
- Greg A. Woods <woods@planix.com>
- Greg Sexton <gregsexton@gmail.com>
- Hannu Koivisto <azure@iki.fi>
- Hans-Peter Deifel <hpdeifel@gmx.de>
- Ian Eure <ian.eure@gmail.com>
- Jan Tatarik <jan.tatarik@xing.com>
- Jasper St. Pierre <jstpierre@mecheye.net>
- Jeff Bellegarde <jbellegarde@whitepages.com>
- Jeff Dairiki <dairiki@dairiki.org>
- Jesse Alama <jesse.alama@gmail.com>
- John Wiegley <johnw@newartisans.com>
- Jonas Bernoulli <jonas@bernoul.li>
- Jonathan Roes <jroes@jroes.net>
- Jordan Greenberg <jordan@softwareslave.com>
- Julien Danjou <julien@danjou.info>
- Justin Caratzas <justin.caratzas@gmail.com>
- Kimberly Wolk <kimwolk@hotmail.com>
- Kyle Meyer <kyle@kyleam.com>
- Laurent Laffont <laurent.laffont@gmail.com>
- Leandro Facchinetti <me@leafac.com>
- Lele Gaifax <lele@metapensiero.it>
- Leo Liu <sdl.web@gmail.com>
- Leonardo Etcheverry <leo@kalio.net>
- Lluís Vilanova <vilanova@ac.upc.edu>
- Loic Dachary <loic@dachary.org>
- Luís Borges de Oliveira <lbo@siscog.pt>
- Luke Amdor <luke.amdor@gmail.com>
- Manuel Vázquez Acosta <mva.led@gmail.com>
- Marcel Wolf <mwolf@ml1.net>
- Marc Herbert <marc.herbert@gmail.com>
- Marcin Bachry <hegel666@gmail.com>
- Marco Craveiro <marco.craveiro@gmail.com>
- Marian Schubert <marian.schubert@gooddata.com>
- Marius Vollmer <marius.vollmer@gmail.com>
- Mark Hepburn <Mark.Hepburn@csiro.au>
- Matus Goljer <dota.keys@gmail.com>
- Miles Bader <miles@gnu.org>
- Mitchel Humpherys <mitch.special@gmail.com>
- Moritz Bunkus <moritz@bunkus.org>
- Nathan Weizenbaum <nex342@gmail.com>
- Nguyễn Tuấn Anh <ubolonton@gmail.com>
- Nic Ferier <nic@ferrier.me.uk>
- Nick Alcock <nick.alcock@oracle.com>
- Nick Alexander <nalexander@mozilla.com>
- Nick Dimiduk <ndimiduk@gmail.com>
- Nicolas Dudebout <nicolas.dudebout@gatech.edu>
- Nicolas Richard <theonewiththeevillook@yahoo.fr>
- Noam Postavsky <npostavs@users.sourceforge.net>
- Ole Arndt <oliver.arndt@cegedim.com>
- Óscar Fuentes <ofv@wanadoo.es>
- Paul Stadig <paul@stadig.name>
- Pavel Holejsovsky <pavel.holejsovsky@upek.com>
- Pekka Pessi <nospam@pessi.fi>
- Peter J. Weisberg <pj@irregularexpressions.net>
- Philippe Vaucher <philippe.vaucher@gmail.com>
- Philipp Haselwarter <philipp@haselwarter.org>
- Philip Weaver <philip.weaver@gmail.com>
- Phil Jackson <phil@shellarchive.co.uk>
- Pieter Praet <pieter@praet.org>
- Prathamesh Sonpatki <csonpatki@gmail.com>
- rabio <rabiodev@o2.pl>
- Rafael Laboissiere <rafael@laboissiere.net>
- Raimon Grau <raimonster@gmail.com>
- Ramkumar Ramachandra <artagnon@gmail.com>
- Remco van 't Veer <rwvtveer@xs4all.nl>
- Rémi Vanicat <vanicat@debian.org>
- René Stadler <mail@renestadler.de>
- Robert Boone <robo4288@gmail.com>
- Robin Green <greenrd@greenrd.org>
- Roger Crew <crew@cs.stanford.edu>
- Romain Francoise <romain@orebokech.com>
- Ron Parker <rparker@a123systems.com>
- Roy Crihfield <rscrihf@gmail.com>
- Rüdiger Sonderfeld <ruediger@c-plusplus.de>
- Rüdiger Sonderfeld <ruediger@c-plusplus.net>
- Ryan C. Thompson <rct@thompsonclan.org>
- Samuel Bronson <naesten@gmail.com>
- Sanjoy Das <sanjoy@playingwithpointers.com>
- Sean Bryant <sbryant@hackinggibsons.com>
- Sebastian Wiesner <lunaryorn@gmail.com>
- Sébastien Gross <seb@chezwam.org>
- Seong-Kook Shin <cinsky@gmail.com>
- Sergey Pashinin <sergey@pashinin.com>
- Sergey Vinokurov <serg.foo@gmail.com>
- Servilio Afre Puentes <afrepues@mcmaster.ca>
- Štěpán Němec <stepnem@gmail.com>
- Steven Chow <steve@myfreestuffapp.com>
- Steven Thomas <sthomas314@gmail.com>
- Steve Purcell <steve@sanityinc.com>
- Suhail Shergill <suhailshergill@gmail.com>
- Takafumi Arakaki <aka.tkf@gmail.com>
- Teruki Shigitani <teruki.shigitani@gmail.com>
- Thierry Volpiatto <thierry.volpiatto@gmail.com>
- Thomas Frössman <thomasf@jossystem.se>
- Thomas Jost <thomas.jost@gmail.com>
- Thomas Riccardi <riccardi.thomas@gmail.com>
- Tibor Simko <tibor.simko@cern.ch>
- Timo Juhani Lindfors <timo.lindfors@iki.fi>
- Ting-Yu Lin <aethanyc@gmail.com>
- Tom Feist <shabble@metavore.org>
- Wilfred Hughes <me@wilfred.me.uk>
- Win Treese <treese@acm.org>
- Yann Hodique <yann.hodique@gmail.com>
- York Zhao <gtdplatform@gmail.com>

View File

@ -15,4 +15,4 @@ File: dir, Node: Top This is the top of the INFO tree
* Menu: * Menu:
Emacs Emacs
* Magit: (magit). Using Git from Emacs with Magit. * Magit (1.4.0): (magit). Using Git from Emacs with Magit. (1.4.0)

File diff suppressed because one or more lines are too long

View File

@ -1,15 +1,16 @@
;;; magit-blame.el --- blame support for magit ;;; magit-blame.el --- blame support for Magit
;; Copyright (C) 2012 Rüdiger Sonderfeld ;; Copyright (C) 2012-2015 The Magit Project Developers
;; Copyright (C) 2012 Yann Hodique ;;
;; Copyright (C) 2011 byplayer ;; For a full list of contributors, see the AUTHORS.md file
;; Copyright (C) 2010 Alexander Prusov ;; at the top-level directory of this distribution and at
;; Copyright (C) 2009 Tim Moore ;; https://raw.github.com/magit/magit/master/AUTHORS.md
;; Copyright (C) 2008 Linh Dang
;; Copyright (C) 2008 Marius Vollmer
;; Author: Yann Hodique <yann.hodique@gmail.com> ;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords: ;; Package: magit
;; Contains code from Egg (Emacs Got Git) <https://github.com/byplayer/egg>,
;; released under the GNU General Public License version 3 or later.
;; Magit is free software; you can redistribute it and/or modify it ;; Magit is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by ;; under the terms of the GNU General Public License as published by
@ -26,21 +27,38 @@
;;; Commentary: ;;; Commentary:
;; This code has been backported from Egg (Magit fork) to Magit ;; Control git-blame from Magit.
;; This code has been backported from Egg (Magit fork) to Magit.
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'magit) (require 'magit)
(require 'easymenu)
;;; Options
(defgroup magit-blame nil
"Git-blame support for Magit."
:group 'magit-extensions)
(defcustom magit-blame-ignore-whitespace t
"Ignore whitespace when determining blame information."
:group 'magit-blame
:type 'boolean)
(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
"How to format time in magit-blame header."
:group 'magit-blame
:type 'string)
(defface magit-blame-header (defface magit-blame-header
'((t :inherit magit-header)) '((t :inherit magit-section-title))
"Face for blame header." "Face for blame header."
:group 'magit-faces) :group 'magit-faces)
(defface magit-blame-sha1 (defface magit-blame-sha1
'((t :inherit (magit-log-sha1 '((t :inherit (magit-log-sha1 magit-blame-header)))
magit-blame-header)))
"Face for blame sha1." "Face for blame sha1."
:group 'magit-faces) :group 'magit-faces)
@ -59,8 +77,10 @@
"Face for blame tag line." "Face for blame tag line."
:group 'magit-faces) :group 'magit-faces)
(defconst magit-blame-map ;;; Keymaps
(let ((map (make-sparse-keymap "Magit:Blame")))
(defvar magit-blame-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "l") 'magit-blame-locate-commit) (define-key map (kbd "l") 'magit-blame-locate-commit)
(define-key map (kbd "RET") 'magit-blame-locate-commit) (define-key map (kbd "RET") 'magit-blame-locate-commit)
(define-key map (kbd "q") 'magit-blame-mode) (define-key map (kbd "q") 'magit-blame-mode)
@ -69,8 +89,18 @@
map) map)
"Keymap for an annotated section.\\{magit-blame-map}") "Keymap for an annotated section.\\{magit-blame-map}")
(defvar magit-blame-buffer-read-only) (easy-menu-define magit-blame-mode-menu magit-blame-map
(make-variable-buffer-local 'magit-blame-buffer-read-only) "Magit blame menu"
'("Blame"
["Locate Commit" magit-blame-locate-commit t]
["Next" magit-blame-next-chunk t]
["Previous" magit-blame-previous-chunk t]
"---"
["Quit" magit-blame-mode t]))
;;; Mode
(defvar-local magit-blame-buffer-read-only nil)
;;;###autoload ;;;###autoload
(define-minor-mode magit-blame-mode (define-minor-mode magit-blame-mode
@ -78,20 +108,20 @@
:keymap magit-blame-map :keymap magit-blame-map
:lighter " blame" :lighter " blame"
(unless (buffer-file-name) (unless (buffer-file-name)
(error "Current buffer has no associated file!")) (user-error "Current buffer has no associated file!"))
(when (and (buffer-modified-p) (when (and (buffer-modified-p)
(y-or-n-p (format "save %s first? " (buffer-file-name)))) (y-or-n-p (format "save %s first? " (buffer-file-name))))
(save-buffer)) (save-buffer))
(if magit-blame-mode (cond (magit-blame-mode
(progn
(setq magit-blame-buffer-read-only buffer-read-only) (setq magit-blame-buffer-read-only buffer-read-only)
(magit-blame-file-on (current-buffer)) (magit-blame-file-on (current-buffer))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(setq buffer-read-only t)) (setq buffer-read-only t))
(t
(magit-blame-file-off (current-buffer)) (magit-blame-file-off (current-buffer))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(setq buffer-read-only magit-blame-buffer-read-only))) (setq buffer-read-only magit-blame-buffer-read-only))))
(defun magit-blame-file-off (buffer) (defun magit-blame-file-off (buffer)
(save-excursion (save-excursion
@ -99,7 +129,7 @@
(with-current-buffer buffer (with-current-buffer buffer
(widen) (widen)
(mapc (lambda (ov) (mapc (lambda (ov)
(if (overlay-get ov :blame) (when (overlay-get ov :blame)
(delete-overlay ov))) (delete-overlay ov)))
(overlays-in (point-min) (point-max))))))) (overlays-in (point-min) (point-max)))))))
@ -109,78 +139,47 @@
(with-current-buffer buffer (with-current-buffer buffer
(save-restriction (save-restriction
(with-temp-buffer (with-temp-buffer
(magit-git-insert (list "blame" "--porcelain" "--" (apply 'magit-git-insert "blame" "--porcelain"
(file-name-nondirectory `(,@(and magit-blame-ignore-whitespace (list "-w")) "--"
(buffer-file-name buffer)))) ,(file-name-nondirectory (buffer-file-name buffer))))
(magit-blame-parse buffer (current-buffer))))))) (magit-blame-parse buffer (current-buffer)))))))
;;; Commands
(defun magit-blame-locate-commit (pos) (defun magit-blame-locate-commit (pos)
"Jump to a commit in the branch history from an annotated blame section." "Jump to a commit in the branch history from an annotated blame section."
(interactive "d") (interactive "d")
(let ((overlays (overlays-at pos)) (let ((overlays (overlays-at pos))
sha1) sha1)
(dolist (ov overlays) (dolist (ov overlays)
(if (overlay-get ov :blame) (when (overlay-get ov :blame)
(setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1)))) (setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
(if sha1 (when sha1
(magit-show-commit sha1)))) (magit-show-commit sha1))))
(defun magit-find-next-overlay-change (BEG END PROP) (defun magit-blame-next-chunk ()
"Return the next position after BEG where an overlay matching a
property PROP starts or ends. If there are no matching overlay
boundaries from BEG to END, the return value is nil."
(save-excursion
(goto-char BEG)
(catch 'found
(flet ((overlay-change (pos)
(if (< BEG END) (next-overlay-change pos)
(previous-overlay-change pos)))
(within-bounds-p (pos)
(if (< BEG END) (< pos END)
(> pos END))))
(let ((ov-pos BEG))
;; iterate through overlay changes from BEG to END
(while (within-bounds-p ov-pos)
(let* ((next-ov-pos (overlay-change ov-pos))
;; search for an overlay with a PROP property
(next-ov
(let ((overlays (overlays-at next-ov-pos)))
(while (and overlays
(not (overlay-get (car overlays) PROP)))
(setq overlays (cdr overlays)))
(car overlays))))
(if next-ov
;; found the next overlay with prop PROP at next-ov-pos
(throw 'found next-ov-pos)
;; no matching overlay found, keep looking
(setq ov-pos next-ov-pos)))))))))
(defun magit-blame-next-chunk (pos)
"Go to the next blame chunk." "Go to the next blame chunk."
(interactive "d") (interactive)
(let ((next-chunk-pos (magit-find-next-overlay-change pos (point-max) :blame))) (let ((next (next-single-property-change (point) :blame)))
(when next-chunk-pos (when next
(goto-char next-chunk-pos)))) (goto-char next))))
(defun magit-blame-previous-chunk (pos) (defun magit-blame-previous-chunk ()
"Go to the previous blame chunk." "Go to the previous blame chunk."
(interactive "d") (interactive)
(let ((prev-chunk-pos (magit-find-next-overlay-change pos (point-min) :blame))) (let ((prev (previous-single-property-change (point) :blame)))
(when prev-chunk-pos (when prev
(goto-char prev-chunk-pos)))) (goto-char prev))))
(defcustom magit-time-format-string "%Y-%m-%dT%T%z" ;;; Parse
"How to format time in magit-blame header."
:group 'magit
:type 'string)
(defun magit-blame-decode-time (unixtime &optional tz) (defun magit-blame-decode-time (unixtime &optional tz)
"Decode UNIXTIME into (HIGH LOW) format. "Decode UNIXTIME into (HIGH LOW) format.
The second argument TZ can be used to add the timezone in (-)HHMM The second argument TZ can be used to add the timezone in (-)HHMM
format to UNIXTIME. UNIXTIME should be either a number format to UNIXTIME. UNIXTIME should be either a number
containing seconds since epoch or Emacs's (HIGH LOW containing seconds since epoch or Emacs's (HIGH LOW . IGNORED)
. IGNORED) format." format."
(when (numberp tz) (when (numberp tz)
(unless (numberp unixtime) (unless (numberp unixtime)
(setq unixtime (float-time unixtime))) (setq unixtime (float-time unixtime)))
@ -221,7 +220,9 @@ officially supported at the moment."
(with-current-buffer blame-buf (with-current-buffer blame-buf
(goto-char (point-min)) (goto-char (point-min))
;; search for a ful commit info ;; search for a ful commit info
(while (re-search-forward "^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$" nil t) (while (re-search-forward
"^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$"
nil t)
(setq commit (match-string-no-properties 1) (setq commit (match-string-no-properties 1)
old-line (string-to-number old-line (string-to-number
(match-string-no-properties 2)) (match-string-no-properties 2))
@ -300,4 +301,7 @@ officially supported at the moment."
(overlay-put ov 'before-string blame)))))) (overlay-put ov 'before-string blame))))))
(provide 'magit-blame) (provide 'magit-blame)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-blame.el ends here ;;; magit-blame.el ends here

View File

@ -0,0 +1,735 @@
;;; magit-key-mode.el --- interactively tune git invocation
;; Copyright (C) 2010-2015 The Magit Project Developers
;;
;; For a full list of contributors, see the AUTHORS.md file
;; at the top-level directory of this distribution and at
;; https://raw.github.com/magit/magit/master/AUTHORS.md
;; Author: Phil Jackson <phil@shellarchive.co.uk>
;; Package: magit
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements `magit-key-mode' which is used throughout
;; Magit to let the user interactively select the command, switches
;; and options to call Git with. It can be though of as a way to
;; provide "postfix" arguments.
;;; Code:
(require 'magit)
(eval-when-compile (require 'cl-lib))
(defvar magit-key-mode-keymaps)
(defvar magit-key-mode-last-buffer)
(defvar magit-pre-key-mode-window-conf)
;;; Options
(defcustom magit-key-mode-show-usage t
"Whether to show usage information when entering a popup."
:group 'magit
:type 'boolean)
;;; Faces
(defface magit-key-mode-header-face
'((t :inherit font-lock-keyword-face))
"Face for key mode header lines."
:group 'magit-faces)
(defface magit-key-mode-button-face
'((t :inherit font-lock-builtin-face))
"Face for key mode buttons."
:group 'magit-faces)
(defface magit-key-mode-switch-face
'((t :inherit font-lock-warning-face))
"Face for key mode switches."
:group 'magit-faces)
(defface magit-key-mode-args-face
'((t :inherit widget-field))
"Face for key mode switch arguments."
:group 'magit-faces)
;;; Keygroups
;;;###autoload
(defvar magit-key-mode-groups
'((dispatch
(actions
("b" "Branching" magit-key-mode-popup-branching)
("B" "Bisecting" magit-key-mode-popup-bisecting)
("c" "Committing" magit-key-mode-popup-committing)
("d" "Diff worktree" magit-diff-working-tree)
("D" "Diff" magit-diff)
("f" "Fetching" magit-key-mode-popup-fetching)
("F" "Pulling" magit-key-mode-popup-pulling)
("g" "Refresh Buffers" magit-refresh-all)
("l" "Logging" magit-key-mode-popup-logging)
("m" "Merging" magit-key-mode-popup-merging)
("M" "Remoting" magit-key-mode-popup-remoting)
("P" "Pushing" magit-key-mode-popup-pushing)
("o" "Submoduling" magit-key-mode-popup-submodule)
("r" "Rewriting" magit-key-mode-popup-rewriting)
("R" "Rebasing" magit-rebase-step)
("s" "Show Status" magit-status)
("S" "Stage all" magit-stage-all)
("t" "Tagging" magit-key-mode-popup-tagging)
("U" "Unstage all" magit-unstage-all)
("v" "Show Commit" magit-show-commit)
("V" "Show File" magit-show)
("w" "Wazzup" magit-wazzup)
("X" "Reset worktree" magit-reset-working-tree)
("y" "Cherry" magit-cherry)
("z" "Stashing" magit-key-mode-popup-stashing)
("!" "Running" magit-key-mode-popup-running)
("$" "Show Process" magit-process)))
(logging
(man-page "git-log")
(actions
("l" "Short" magit-log)
("L" "Long" magit-log-long)
("h" "Head Reflog" magit-reflog-head)
("f" "File log" magit-file-log)
("rl" "Ranged short" magit-log-ranged)
("rL" "Ranged long" magit-log-long-ranged)
("rh" "Reflog" magit-reflog))
(switches
("-m" "Only merge commits" "--merges")
("-s" "No merge commits" "--no-merges")
("-do" "Date Order" "--date-order")
("-f" "First parent" "--first-parent")
("-i" "Case insensitive patterns" "-i")
("-pr" "Pickaxe regex" "--pickaxe-regex")
("-g" "Show Graph" "--graph")
("-n" "Name only" "--name-only")
("-am" "All match" "--all-match")
("-al" "All" "--all"))
(arguments
("=r" "Relative" "--relative=" read-directory-name)
("=c" "Committer" "--committer=" read-from-minibuffer)
("=>" "Since" "--since=" read-from-minibuffer)
("=<" "Before" "--before=" read-from-minibuffer)
("=a" "Author" "--author=" read-from-minibuffer)
("=g" "Grep messages" "--grep=" read-from-minibuffer)
("=G" "Grep patches" "-G" read-from-minibuffer)
("=L" "Trace evolution of line range [long log only]"
"-L" magit-read-file-trace)
("=s" "Pickaxe search" "-S" read-from-minibuffer)
("=b" "Branches" "--branches=" read-from-minibuffer)
("=R" "Remotes" "--remotes=" read-from-minibuffer)))
(running
(actions
("!" "Git Subcommand (from root)" magit-git-command-topdir)
(":" "Git Subcommand (from pwd)" magit-git-command)
("g" "Git Gui" magit-run-git-gui)
("k" "Gitk" magit-run-gitk)))
(fetching
(man-page "git-fetch")
(actions
("f" "Current" magit-fetch-current)
("a" "All" magit-remote-update)
("o" "Other" magit-fetch))
(switches
("-p" "Prune" "--prune")))
(pushing
(man-page "git-push")
(actions
("P" "Push" magit-push)
("t" "Push tags" magit-push-tags))
(switches
("-f" "Force" "--force")
("-d" "Dry run" "-n")
("-u" "Set upstream" "-u")))
(pulling
(man-page "git-pull")
(actions
("F" "Pull" magit-pull))
(switches
("-f" "Force" "--force")
("-r" "Rebase" "--rebase")))
(branching
(man-page "git-branch")
(actions
("v" "Branch manager" magit-branch-manager)
("b" "Checkout" magit-checkout)
("c" "Create" magit-create-branch)
("r" "Rename" magit-rename-branch)
("k" "Delete" magit-delete-branch))
(switches
("-t" "Set upstream configuration" "--track")
("-m" "Merged to HEAD" "--merged")
("-M" "Merged to master" "--merged=master")
("-n" "Not merged to HEAD" "--no-merged")
("-N" "Not merged to master" "--no-merged=master"))
(arguments
("=c" "Contains" "--contains=" magit-read-rev-with-default)
("=m" "Merged" "--merged=" magit-read-rev-with-default)
("=n" "Not merged" "--no-merged=" magit-read-rev-with-default)))
(remoting
(man-page "git-remote")
(actions
("v" "Remote manager" magit-branch-manager)
("a" "Add" magit-add-remote)
("r" "Rename" magit-rename-remote)
("k" "Remove" magit-remove-remote)))
(tagging
(man-page "git-tag")
(actions
("t" "Create" magit-tag)
("k" "Delete" magit-delete-tag))
(switches
("-a" "Annotate" "--annotate")
("-f" "Force" "--force")
("-s" "Sign" "--sign")))
(stashing
(man-page "git-stash")
(actions
("v" "View" magit-diff-stash)
("z" "Save" magit-stash)
("s" "Snapshot" magit-stash-snapshot)
("a" "Apply" magit-stash-apply)
("p" "Pop" magit-stash-pop)
("k" "Drop" magit-stash-drop))
(switches
("-k" "Keep index" "--keep-index")
("-u" "Include untracked files" "--include-untracked")
("-a" "Include all files" "--all")))
(committing
(man-page "git-commit")
(actions
("c" "Commit" magit-commit)
("a" "Amend" magit-commit-amend)
("e" "Extend" magit-commit-extend)
("r" "Reword" magit-commit-reword)
("f" "Fixup" magit-commit-fixup)
("s" "Squash" magit-commit-squash))
(switches
("-a" "Stage all modified and deleted files" "--all")
("-e" "Allow empty commit" "--allow-empty")
("-v" "Show diff of changes to be committed" "--verbose")
("-n" "Bypass git hooks" "--no-verify")
("-s" "Add Signed-off-by line" "--signoff")
("-R" "Claim authorship and reset author date" "--reset-author"))
(arguments
("=A" "Override the author" "--author=" read-from-minibuffer)
("=S" "Sign using gpg" "--gpg-sign=" magit-read-gpg-secret-key)))
(merging
(man-page "git-merge")
(actions
("m" "Merge" magit-merge)
("A" "Abort" magit-merge-abort))
(switches
("-ff" "Fast-forward only" "--ff-only")
("-nf" "No fast-forward" "--no-ff")
("-sq" "Squash" "--squash"))
(arguments
("-st" "Strategy" "--strategy=" read-from-minibuffer)))
(rewriting
(actions
("b" "Begin" magit-rewrite-start)
("s" "Stop" magit-rewrite-stop)
("a" "Abort" magit-rewrite-abort)
("f" "Finish" magit-rewrite-finish)
("d" "Diff pending" magit-rewrite-diff-pending)
("*" "Set unused" magit-rewrite-set-unused)
("." "Set used" magit-rewrite-set-used)))
(apply-mailbox
(man-page "git-am")
(actions
("J" "Apply Mailbox" magit-apply-mailbox))
(switches
("-s" "add a Signed-off-by line to the commit message" "--signoff")
("-3" "allow fall back on 3way merging if needed" "--3way")
("-k" "pass -k flag to git-mailinfo" "--keep")
("-c" "strip everything before a scissors line" "--scissors")
("-p" "pass it through git-apply" "-p")
("-r" "override error message when patch failure occurs" "--resolvemsg")
("-d" "lie about committer date" "--committer-date-is-author-date")
("-D" "use current timestamp for author date" "--ignore-date")
("-b" "pass -b flag to git-mailinfo" "--keep-non-patch"))
(arguments
("=p" "format the patch(es) are in" "--patch-format=" read-from-minibuffer)))
(submodule
(man-page "git-submodule")
(actions
("u" "Update" magit-submodule-update)
("b" "Both update and init" magit-submodule-update-init)
("i" "Init" magit-submodule-init)
("s" "Sync" magit-submodule-sync)))
(bisecting
(man-page "git-bisect")
(actions
("b" "Bad" magit-bisect-bad)
("g" "Good" magit-bisect-good)
("k" "Skip" magit-bisect-skip)
("r" "Reset" magit-bisect-reset)
("s" "Start" magit-bisect-start)
("u" "Run" magit-bisect-run)))
(diff-options
(actions
("s" "Set" magit-set-diff-options)
("d" "Set default" magit-set-default-diff-options)
("c" "Save default" magit-save-default-diff-options)
("r" "Reset to default" magit-reset-diff-options)
("h" "Toggle Hunk Refinement" magit-diff-toggle-refine-hunk))
(switches
("-m" "Show smallest possible diff" "--minimal")
("-p" "Use patience diff algorithm" "--patience")
("-h" "Use histogram diff algorithm" "--histogram")
("-b" "Ignore whitespace changes" "--ignore-space-change")
("-w" "Ignore all whitespace" "--ignore-all-space")
("-W" "Show surrounding functions" "--function-context"))
))
"Holds the key, help, function mapping for the log-mode.
If you modify this make sure you reset `magit-key-mode-keymaps'
to nil.")
(defun magit-key-mode-delete-group (group)
"Delete a group from `magit-key-mode-keymaps'."
(let ((items (assoc group magit-key-mode-groups)))
(when items
;; reset the cache
(setq magit-key-mode-keymaps nil)
;; delete the whole group
(setq magit-key-mode-groups
(delq items magit-key-mode-groups))
;; unbind the defun
(magit-key-mode-de-generate group))
magit-key-mode-groups))
(defun magit-key-mode-add-group (group)
"Add a new group to `magit-key-mode-keymaps'.
If there already is a group of that name then this will
completely remove it and put in its place an empty one of the
same name."
(when (assoc group magit-key-mode-groups)
(magit-key-mode-delete-group group))
(setq magit-key-mode-groups
(cons (list group (list 'actions) (list 'switches) (list 'arguments))
magit-key-mode-groups)))
(defun magit-key-mode-key-defined-p (for-group key)
"Return t if KEY is defined as any option within FOR-GROUP.
The option may be a switch, argument or action."
(catch 'result
(let ((options (magit-key-mode-options-for-group for-group)))
(dolist (type '(actions switches arguments))
(when (assoc key (assoc type options))
(throw 'result t))))))
(defun magit-key-mode-update-group (for-group thing &rest args)
"Abstraction for setting values in `magit-key-mode-keymaps'."
(let* ((options (magit-key-mode-options-for-group for-group))
(things (assoc thing options))
(key (car args)))
(if (cdr things)
(if (magit-key-mode-key-defined-p for-group key)
(error "%s is already defined in the %s group." key for-group)
(setcdr (cdr things) (cons args (cddr things))))
(setcdr things (list args)))
(setq magit-key-mode-keymaps nil)
things))
(defun magit-key-mode-insert-argument (for-group key desc arg read-func)
"Add a new binding KEY in FOR-GROUP which will use READ-FUNC
to receive input to apply to argument ARG git is run. DESC should
be a brief description of the binding."
(magit-key-mode-update-group for-group 'arguments key desc arg read-func))
(defun magit-key-mode-insert-switch (for-group key desc switch)
"Add a new binding KEY in FOR-GROUP which will add SWITCH to git's
command line when it runs. DESC should be a brief description of
the binding."
(magit-key-mode-update-group for-group 'switches key desc switch))
(defun magit-key-mode-insert-action (for-group key desc func)
"Add a new binding KEY in FOR-GROUP which will run command FUNC.
DESC should be a brief description of the binding."
(magit-key-mode-update-group for-group 'actions key desc func))
(defun magit-key-mode-options-for-group (for-group)
"Retrieve the options for the group FOR-GROUP.
This includes switches, commands and arguments."
(or (cdr (assoc for-group magit-key-mode-groups))
(error "Unknown group '%s'" for-group)))
;;; Commands
(defun magit-key-mode-help (for-group)
"Provide help for a key within FOR-GROUP.
The user is prompted for the key."
(let* ((opts (magit-key-mode-options-for-group for-group))
(man-page (cadr (assoc 'man-page opts)))
(seq (read-key-sequence
(format "Enter command prefix%s: "
(if man-page
(format ", `?' for man `%s'" man-page)
""))))
(actions (cdr (assoc 'actions opts))))
(cond
;; if it is an action popup the help for the to-be-run function
((assoc seq actions) (describe-function (nth 2 (assoc seq actions))))
;; if there is "?" show a man page if there is one
((equal seq "?")
(if man-page
(man man-page)
(error "No man page associated with `%s'" for-group)))
(t (error "No help associated with `%s'" seq)))))
(defun magit-key-mode-exec-at-point ()
"Run action/args/option at point."
(interactive)
(let ((key (or (get-text-property (point) 'key-group-executor)
(error "Nothing at point to do."))))
(call-interactively (lookup-key (current-local-map) key))))
(defun magit-key-mode-jump-to-next-exec ()
"Jump to the next action/args/option point."
(interactive)
(let* ((oldp (point))
(old (get-text-property oldp 'key-group-executor))
(p (if (= oldp (point-max)) (point-min) (1+ oldp))))
(while (let ((new (get-text-property p 'key-group-executor)))
(and (not (= p oldp)) (or (not new) (eq new old))))
(setq p (if (= p (point-max)) (point-min) (1+ p))))
(goto-char p)
(skip-chars-forward " ")))
;;; Keymaps
(defvar magit-key-mode-keymaps nil
"This will be filled lazily with proper keymaps.
These keymaps are created using `define-key' as they're requested.")
(defun magit-key-mode-build-keymap (for-group)
"Construct a normal looking keymap for the key mode to use.
Put it in `magit-key-mode-keymaps' for fast lookup."
(let* ((options (magit-key-mode-options-for-group for-group))
(actions (cdr (assoc 'actions options)))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(map (make-sparse-keymap)))
(suppress-keymap map 'nodigits)
;; ret dwim
(define-key map (kbd "RET") 'magit-key-mode-exec-at-point)
;; tab jumps to the next "button"
(define-key map (kbd "TAB") 'magit-key-mode-jump-to-next-exec)
;; all maps should `quit' with `C-g' or `q'
(define-key map (kbd "C-g") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
(define-key map (kbd "q") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
;; run help
(define-key map (kbd "?") `(lambda ()
(interactive)
(magit-key-mode-help ',for-group)))
(let ((defkey (lambda (k action)
(when (and (lookup-key map (car k))
(not (numberp (lookup-key map (car k)))))
(message "Warning: overriding binding for `%s' in %S"
(car k) for-group)
(ding)
(sit-for 2))
(define-key map (car k)
`(lambda () (interactive) ,action)))))
(dolist (k actions)
(funcall defkey k `(magit-key-mode-command ',(nth 2 k))))
(dolist (k switches)
(funcall defkey k `(magit-key-mode-toggle-option ',for-group ,(nth 2 k))))
(dolist (k arguments)
(funcall defkey k `(magit-key-mode-add-argument
',for-group ,(nth 2 k) ',(nth 3 k)))))
(push (cons for-group map) magit-key-mode-keymaps)
map))
;;; Toggling and Running
(defvar magit-key-mode-prefix nil
"Prefix argument to the command that brought up the key-mode window.
For internal use. Used by the command that's eventually invoked.")
(defvar magit-key-mode-current-args nil
"A hash-table of current argument set.
These will eventually make it to the git command-line.")
(defvar magit-key-mode-current-options nil
"Current option set.
These will eventually make it to the git command-line.")
(defvar magit-custom-options nil
"List of custom options to pass to Git.
Do not customize this (used in the `magit-key-mode' implementation).")
(defun magit-key-mode-command (func)
(let ((current-prefix-arg (or current-prefix-arg magit-key-mode-prefix))
(magit-custom-options magit-key-mode-current-options))
(maphash (lambda (k v)
(push (concat k v) magit-custom-options))
magit-key-mode-current-args)
(set-window-configuration magit-pre-key-mode-window-conf)
(kill-buffer magit-key-mode-last-buffer)
(when func
(setq this-command func)
(call-interactively this-command))))
(defun magit-key-mode-add-argument (for-group arg-name input-func)
(let ((input (funcall input-func (concat arg-name ": "))))
(puthash arg-name input magit-key-mode-current-args)
(magit-key-mode-redraw for-group)))
(defun magit-key-mode-toggle-option (for-group option-name)
"Toggles the appearance of OPTION-NAME in `magit-key-mode-current-options'."
(if (member option-name magit-key-mode-current-options)
(setq magit-key-mode-current-options
(delete option-name magit-key-mode-current-options))
(add-to-list 'magit-key-mode-current-options option-name))
(magit-key-mode-redraw for-group))
;;; Mode
(defvar magit-key-mode-buf-name "*magit-key: %s*"
"Format string to create the name of the magit-key buffer.")
(defvar magit-key-mode-last-buffer nil
"Store the last magit-key buffer used.")
(defvar magit-pre-key-mode-window-conf nil
"Will hold the pre-menu configuration of magit.")
(defun magit-key-mode (for-group &optional original-opts)
"Mode for magit key selection.
All commands, switches and options can be toggled/actioned with
the key combination highlighted before the description."
(interactive)
;; save the window config to restore it as was (no need to make this
;; buffer local)
(setq magit-pre-key-mode-window-conf
(current-window-configuration))
;; setup the mode, draw the buffer
(let ((buf (get-buffer-create (format magit-key-mode-buf-name
(symbol-name for-group)))))
(setq magit-key-mode-last-buffer buf)
(split-window-vertically)
(other-window 1)
(switch-to-buffer buf)
(kill-all-local-variables)
(set (make-local-variable 'scroll-margin) 0)
(set (make-local-variable
'magit-key-mode-current-options)
original-opts)
(set (make-local-variable
'magit-key-mode-current-args)
(make-hash-table))
(set (make-local-variable 'magit-key-mode-prefix) current-prefix-arg)
(magit-key-mode-redraw for-group))
(when magit-key-mode-show-usage
(message (concat "Type a prefix key to toggle it. "
"Run 'actions' with their prefixes. "
"'?' for more help."))))
(defun magit-key-mode-get-key-map (for-group)
"Get or build the keymap for FOR-GROUP."
(or (cdr (assoc for-group magit-key-mode-keymaps))
(magit-key-mode-build-keymap for-group)))
(defun magit-key-mode-redraw (for-group)
"(re)draw the magit key buffer."
(let ((buffer-read-only nil)
(current-exec (get-text-property (point) 'key-group-executor))
(new-exec-pos)
(old-point (point))
(is-first (zerop (buffer-size)))
(actions-p nil))
(erase-buffer)
(make-local-variable 'font-lock-defaults)
(use-local-map (magit-key-mode-get-key-map for-group))
(setq actions-p (magit-key-mode-draw for-group))
(delete-trailing-whitespace)
(setq mode-name "magit-key-mode" major-mode 'magit-key-mode)
(when current-exec
(setq new-exec-pos
(cdr (assoc current-exec
(magit-key-mode-build-exec-point-alist)))))
(cond ((and is-first actions-p)
(goto-char actions-p)
(magit-key-mode-jump-to-next-exec))
(new-exec-pos
(goto-char new-exec-pos)
(skip-chars-forward " "))
(t
(goto-char old-point))))
(setq buffer-read-only t)
(fit-window-to-buffer))
(defun magit-key-mode-build-exec-point-alist ()
(save-excursion
(goto-char (point-min))
(let* ((exec (get-text-property (point) 'key-group-executor))
(exec-alist (and exec `((,exec . ,(point))))))
(cl-do nil ((eobp) (nreverse exec-alist))
(when (not (eq exec (get-text-property (point) 'key-group-executor)))
(setq exec (get-text-property (point) 'key-group-executor))
(when exec (push (cons exec (point)) exec-alist)))
(forward-char)))))
;;; Draw Buffer
(defun magit-key-mode-draw-header (header)
"Draw a header with the correct face."
(insert (propertize header 'face 'magit-key-mode-header-face) "\n"))
(defvar magit-key-mode-args-in-cols nil
"When true, draw arguments in columns as with switches and options.")
(defun magit-key-mode-draw-args (args)
"Draw the args part of the menu."
(magit-key-mode-draw-buttons
"Args"
args
(lambda (x)
(format "(%s) %s"
(nth 2 x)
(propertize (gethash (nth 2 x) magit-key-mode-current-args "")
'face 'magit-key-mode-args-face)))
(not magit-key-mode-args-in-cols)))
(defun magit-key-mode-draw-switches (switches)
"Draw the switches part of the menu."
(magit-key-mode-draw-buttons
"Switches"
switches
(lambda (x)
(format "(%s)" (let ((s (nth 2 x)))
(if (member s magit-key-mode-current-options)
(propertize s 'face 'magit-key-mode-switch-face)
s))))))
(defun magit-key-mode-draw-actions (actions)
"Draw the actions part of the menu."
(magit-key-mode-draw-buttons "Actions" actions nil))
(defun magit-key-mode-draw-buttons (section xs maker
&optional one-col-each)
(when xs
(magit-key-mode-draw-header section)
(magit-key-mode-draw-in-cols
(mapcar (lambda (x)
(let* ((head (propertize (car x) 'face 'magit-key-mode-button-face))
(desc (nth 1 x))
(more (and maker (funcall maker x)))
(text (format " %s: %s%s%s"
head desc (if more " " "") (or more ""))))
(propertize text 'key-group-executor (car x))))
xs)
one-col-each)))
(defun magit-key-mode-draw-in-cols (strings one-col-each)
"Given a list of strings, print in columns (using `insert').
If ONE-COL-EACH is true then don't columify, but rather, draw
each item on one line."
(let ((longest-act (apply 'max (mapcar 'length strings))))
(while strings
(let ((str (car strings)))
(let ((padding (make-string (- (+ longest-act 3) (length str)) ? )))
(insert str)
(if (or one-col-each
(and (> (+ (length padding) ;
(current-column)
longest-act)
(window-width))
(cdr strings)))
(insert "\n")
(insert padding))))
(setq strings (cdr strings))))
(insert "\n"))
(defun magit-key-mode-draw (for-group)
"Draw actions, switches and parameters.
Return the point before the actions part, if any, nil otherwise."
(let* ((options (magit-key-mode-options-for-group for-group))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(actions (cdr (assoc 'actions options)))
(p nil))
(magit-key-mode-draw-switches switches)
(magit-key-mode-draw-args arguments)
(when actions (setq p (point-marker)))
(magit-key-mode-draw-actions actions)
(insert "\n")
p))
;;; Generate Groups
(defun magit-key-mode-de-generate (group)
"Unbind the function for GROUP."
(fmakunbound
(intern (concat "magit-key-mode-popup-" (symbol-name group)))))
(defun magit-key-mode-generate (group)
"Generate the key-group menu for GROUP."
(let ((opts (magit-key-mode-options-for-group group)))
(eval
`(defun ,(intern (concat "magit-key-mode-popup-" (symbol-name group))) nil
,(concat "Key menu for " (symbol-name group))
(interactive)
(magit-key-mode
(quote ,group)
;; As a tempory kludge it is okay to do this here.
,(cl-case group
(logging
'(list "--graph"))
(diff-options
'(when (local-variable-p 'magit-diff-options)
magit-diff-options))))))))
;; create the interactive functions for the key mode popups (which are
;; applied in the top-level key maps)
(mapc (lambda (g)
(magit-key-mode-generate (car g)))
magit-key-mode-groups)
;;;###autoload (mapc (lambda (g) (eval `(autoload ',(intern (concat "magit-key-mode-popup-" (symbol-name (car g)))) "magit-key-mode" ,(concat "Key menu for " (symbol-name (car g))) t))) magit-key-mode-groups)
(provide 'magit-key-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-key-mode.el ends here

View File

@ -0,0 +1,5 @@
(define-package "magit" "1.4.1"
"Control Git from Emacs."
'((cl-lib "0.5")
(git-commit-mode "1.0.0")
(git-rebase-mode "1.0.0")))

View File

@ -0,0 +1,143 @@
;;; magit-wip.el --- git-wip plug-in for Magit
;; Copyright (C) 2012-2015 The Magit Project Developers
;;
;; For a full list of contributors, see the AUTHORS.md file
;; at the top-level directory of this distribution and at
;; https://raw.github.com/magit/magit/master/AUTHORS.md
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Keywords: vc tools
;; Package: magit
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides support for special work-in-progress refs.
;; This requires the third-party git command "git wip" which is available
;; from https://github.com/bartman/git-wip.
;; To enable `magit-wip-save-mode' enable `global-magit-wip-save-mode'
;; and use the Magit extension mechanism to select the repositories in
;; which you want to use a work-in-progress ref.
;;
;; (global-magit-wip-save-mode 1)
;;
;; $ git config --add magit.extension wip-save # or
;; $ git config --global --add magit.extension wip-save
;; Note that `global-magit-wip-save-mode' is the only mode that uses the
;; extension mechanism for file-visiting buffers all other global modes
;; making use of it to turn on local modes in Magit buffers.
;;; Code:
(require 'magit)
(require 'format-spec)
(defun magit-wip-mode (&rest ignore)
(message "magit-wip-mode is obsolete and doesn't do anything"))
(make-obsolete 'magit-wip-mode "This mode is a noop now" "1.4.0")
;;; Options
(defgroup magit-wip nil
"Git-Wip support for Magit."
:group 'magit-extensions)
(defcustom magit-wip-commit-message "WIP %r"
"Commit message for git-wip commits.
The following `format'-like specs are supported:
%f the full name of the file being saved
%g the root of the git repository
%r the name of the file being saved,
relative to the repository root."
:group 'magit-wip
:type 'string)
(defcustom magit-wip-echo-area-message "Wrote %f (wip)"
"Message shown in the echo area after creating a git-wip commit.
The following `format'-like specs are supported:
%f the full name of the file being saved
%g the root of the git repository
%r the name of the file being saved,
relative to the repository root."
:group 'magit-wip
:type '(choice (const :tag "No message" nil) string))
(defvar magit-wip-save-mode-lighter " Wip")
;;; Mode
;;;###autoload
(define-minor-mode magit-wip-save-mode
"Magit support for committing to a work-in-progress ref.
When this minor mode is turned on and a file is saved inside a
writable git repository then it is also committed to a special
work-in-progress ref."
:lighter magit-wip-save-mode-lighter
(if magit-wip-save-mode
(add-hook 'after-save-hook 'magit-wip-save t t)
(remove-hook 'after-save-hook 'magit-wip-save t)))
;;;###autoload
(define-globalized-minor-mode global-magit-wip-save-mode
magit-wip-save-mode turn-on-magit-wip-save
:group 'magit-wip)
(defun turn-on-magit-wip-save ()
"Conditionally turn on magit-wip-save-mode.
Turn on magit-wip-save-mode if the buffer is a file in a git
repository where wip-save is enabled in git config.
You can activate it with git config magit.extension wip-save."
(when (and (buffer-file-name)
(magit-get-top-dir)
(magit-git-true "rev-parse" "--is-inside-work-tree")
(member "wip-save" (magit-get-all "magit.extension")))
(if (magit-git-success "wip" "-h")
(magit-wip-save-mode 1)
(message "Git command 'git wip' cannot be found"))))
(defun magit-wip-save ()
(let* ((filename (expand-file-name (file-truename (buffer-file-name))))
(filedir (file-name-directory filename))
(toplevel (magit-get-top-dir filedir))
(blobname (file-relative-name filename toplevel))
(spec `((?f . ,filename)
(?r . ,blobname)
(?g . ,toplevel))))
(when (and toplevel (file-writable-p toplevel)
(not (member blobname
(let ((default-directory filedir))
(magit-git-lines
"ls-files" "--other" "--ignored"
"--exclude-standard" "--full-name")))))
(magit-run-git "wip" "save"
(format-spec magit-wip-commit-message spec)
"--editor" "--" filename)
(when magit-wip-echo-area-message
(message (format-spec magit-wip-echo-area-message spec))))))
(provide 'magit-wip)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-wip.el ends here

7838
elpa/magit-1.4.1/magit.el Normal file

File diff suppressed because it is too large Load Diff

1596
elpa/magit-1.4.1/magit.info Normal file

File diff suppressed because it is too large Load Diff