Upgrade packages
This commit is contained in:
parent
4cef57c82e
commit
a3caedf27d
@ -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
|
|
@ -1 +0,0 @@
|
|||||||
(define-package "buffer-move" "0.4" "swap buffers between windows" (quote nil))
|
|
@ -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
|
|
45
elpa/buffer-move-0.6.1/buffer-move-autoloads.el
Normal file
45
elpa/buffer-move-0.6.1/buffer-move-autoloads.el
Normal 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
|
1
elpa/buffer-move-0.6.1/buffer-move-pkg.el
Normal file
1
elpa/buffer-move-0.6.1/buffer-move-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "buffer-move" "0.6.1" "" 'nil)
|
152
elpa/buffer-move-0.6.1/buffer-move.el
Normal file
152
elpa/buffer-move-0.6.1/buffer-move.el
Normal 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
|
1
elpa/company-0.8.12.signed
Normal file
1
elpa/company-0.8.12.signed
Normal 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
|
5
elpa/company-0.8.12/.elpaignore
Normal file
5
elpa/company-0.8.12/.elpaignore
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
.travis.yml
|
||||||
|
.gitignore
|
||||||
|
Makefile
|
||||||
|
test/
|
||||||
|
company-tests.el
|
@ -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
|
@ -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)
|
||||||
|
|
@ -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
|
@ -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)))
|
||||||
|
|
@ -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)
|
@ -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
|
198
elpa/company-0.8.12/company-cmake.el
Normal file
198
elpa/company-0.8.12/company-cmake.el
Normal 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
|
@ -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)
|
@ -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
|
@ -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 ()
|
@ -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)
|
@ -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)
|
@ -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)))
|
||||||
|
|
2
elpa/company-0.8.12/company-pkg.el
Normal file
2
elpa/company-0.8.12/company-pkg.el
Normal 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"))
|
@ -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.
|
@ -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
|
@ -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))))
|
||||||
|
|
@ -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
|
@ -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
|
28
elpa/company-0.8.12/test/all.el
Normal file
28
elpa/company-0.8.12/test/all.el
Normal 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))
|
217
elpa/company-0.8.12/test/async-tests.el
Normal file
217
elpa/company-0.8.12/test/async-tests.el
Normal 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"))))))
|
46
elpa/company-0.8.12/test/clang-tests.el
Normal file
46
elpa/company-0.8.12/test/clang-tests.el
Normal 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...)"))))
|
481
elpa/company-0.8.12/test/core-tests.el
Normal file
481
elpa/company-0.8.12/test/core-tests.el
Normal 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)))))
|
@ -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)
|
332
elpa/company-0.8.12/test/frontends-tests.el
Normal file
332
elpa/company-0.8.12/test/frontends-tests.el
Normal 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))))
|
32
elpa/company-0.8.12/test/keywords-tests.el
Normal file
32
elpa/company-0.8.12/test/keywords-tests.el
Normal 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))))))
|
91
elpa/company-0.8.12/test/template-tests.el
Normal file
91
elpa/company-0.8.12/test/template-tests.el
Normal 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))))))
|
58
elpa/company-0.8.12/test/transformers-tests.el
Normal file
58
elpa/company-0.8.12/test/transformers-tests.el
Normal 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"))))))))
|
@ -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}
|
|
@ -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
|
|
@ -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
|
|
@ -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"))
|
|
@ -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))))))
|
|
@ -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
|
|
@ -1 +0,0 @@
|
|||||||
(define-package "git-commit-mode" "0.13" "Major mode for editing git commit messages" 'nil)
|
|
@ -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
|
|
35
elpa/git-commit-mode-1.0.0/git-commit-mode-autoloads.el
Normal file
35
elpa/git-commit-mode-1.0.0/git-commit-mode-autoloads.el
Normal 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
|
1
elpa/git-commit-mode-1.0.0/git-commit-mode-pkg.el
Normal file
1
elpa/git-commit-mode-1.0.0/git-commit-mode-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "git-commit-mode" "1.0.0" "Major mode for editing git commit messages" 'nil)
|
668
elpa/git-commit-mode-1.0.0/git-commit-mode.el
Normal file
668
elpa/git-commit-mode-1.0.0/git-commit-mode.el
Normal 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
|
29
elpa/git-rebase-mode-1.0.0/git-rebase-mode-autoloads.el
Normal file
29
elpa/git-rebase-mode-1.0.0/git-rebase-mode-autoloads.el
Normal 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
|
1
elpa/git-rebase-mode-1.0.0/git-rebase-mode-pkg.el
Normal file
1
elpa/git-rebase-mode-1.0.0/git-rebase-mode-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "git-rebase-mode" "1.0.0" "Major mode for editing git rebase files" 'nil)
|
393
elpa/git-rebase-mode-1.0.0/git-rebase-mode.el
Normal file
393
elpa/git-rebase-mode-1.0.0/git-rebase-mode.el
Normal 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
|
@ -1 +0,0 @@
|
|||||||
(define-package "gitignore-mode" "0.1" "Major mode for editing .gitconfig files" 'nil)
|
|
@ -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
|
|
@ -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)))
|
||||||
|
|
||||||
;;;***
|
;;;***
|
||||||
|
|
1
elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el
Normal file
1
elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "gitignore-mode" "1.1.0" "Major mode for editing .gitignore files" 'nil)
|
61
elpa/gitignore-mode-1.1.0/gitignore-mode.el
Normal file
61
elpa/gitignore-mode-1.1.0/gitignore-mode.el
Normal 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
|
@ -1 +0,0 @@
|
|||||||
(define-package "haml-mode" "3.1.5" "Major mode for editing Haml files" (quote ((ruby-mode "1.0"))))
|
|
@ -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
|
1
elpa/haml-mode-3.1.8/haml-mode-pkg.el
Normal file
1
elpa/haml-mode-3.1.8/haml-mode-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "haml-mode" "3.1.8" "Major mode for editing Haml files" '((ruby-mode "1.0")))
|
@ -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)
|
@ -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
|
|
@ -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)
|
|
@ -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)
|
|
@ -1 +0,0 @@
|
|||||||
(define-package "magit" "1.2.1" "Control Git from Emacs.")
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
@ -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
184
elpa/magit-1.4.1/AUTHORS.md
Normal 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>
|
@ -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)
|
579
elpa/magit-1.4.1/magit-autoloads.el
Normal file
579
elpa/magit-1.4.1/magit-autoloads.el
Normal file
File diff suppressed because one or more lines are too long
@ -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
|
735
elpa/magit-1.4.1/magit-key-mode.el
Normal file
735
elpa/magit-1.4.1/magit-key-mode.el
Normal 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
|
5
elpa/magit-1.4.1/magit-pkg.el
Normal file
5
elpa/magit-1.4.1/magit-pkg.el
Normal 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")))
|
143
elpa/magit-1.4.1/magit-wip.el
Normal file
143
elpa/magit-1.4.1/magit-wip.el
Normal 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
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
1596
elpa/magit-1.4.1/magit.info
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user