mirror of https://tildegit.org/ben/dotfiles
import sublime and vscode settings
parent
54ed1fc297
commit
db4a4fa9b7
81
Makefile
81
Makefile
|
@ -16,28 +16,43 @@ endif
|
|||
install:
|
||||
@make $(UNAME)
|
||||
|
||||
Linux: bash fish git mutt byobu weechat vim nvim gnupg bin emacs
|
||||
Linux: bash fish git mutt byobu weechat vim nvim gnupg bin emacs vscode sublime
|
||||
Windows: bash git vim
|
||||
Other: bash git vim
|
||||
|
||||
clean:
|
||||
@printf "$(RED)--- clean -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" -D bash
|
||||
stow -t "$$HOME" -D bin
|
||||
stow -t "$$HOME" -D byobu
|
||||
stow -t "$$HOME" -D emacs
|
||||
stow -t "$$HOME" -D fish
|
||||
stow -t "$$HOME" -D git
|
||||
stow -t "$$HOME" -D vim
|
||||
stow -t "$$HOME" -D nvim
|
||||
stow -t "$$HOME" -D mutt
|
||||
stow -t "$$HOME" -D byobu
|
||||
stow -t "$$HOME" -D weechat
|
||||
stow -t "$$HOME" -D gnupg
|
||||
stow -t "$$HOME" -D bin
|
||||
stow -t "$$HOME" -D emacs
|
||||
stow -t "$$HOME" -D mutt
|
||||
stow -t "$$HOME" -D nvim
|
||||
stow -t "$$HOME" -D sublime
|
||||
stow -t "$$HOME" -D vim
|
||||
stow -t "$$HOME" -D vscode
|
||||
stow -t "$$HOME" -D weechat
|
||||
|
||||
bash:
|
||||
@printf "$(YELLOW)--- bash -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" bash
|
||||
|
||||
bin:
|
||||
@printf "$(YELLOW)--- bin ------------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" bin
|
||||
|
||||
byobu:
|
||||
@printf "$(YELLOW)--- byobu ----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" byobu
|
||||
|
||||
emacs:
|
||||
@printf "$(YELLOW)--- emacs ----------------------------------------------\n$(RESET)"
|
||||
git submodule update --init -- emacs/.emacs.d/evil
|
||||
stow -t "$$HOME" emacs
|
||||
|
||||
fish:
|
||||
@printf "$(YELLOW)--- fish -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" fish
|
||||
|
@ -47,40 +62,34 @@ git:
|
|||
@printf "$(YELLOW)--- git ------------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" git
|
||||
|
||||
vim:
|
||||
@printf "$(YELLOW)--- vim ------------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" vim
|
||||
|
||||
nvim:
|
||||
@printf "$(YELLOW)--- nvim -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" nvim
|
||||
|
||||
mutt:
|
||||
@printf "$(YELLOW)--- mutt -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" mutt
|
||||
|
||||
byobu:
|
||||
@printf "$(YELLOW)--- byobu ----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" byobu
|
||||
|
||||
weechat:
|
||||
@printf "$(YELLOW)--- weechat --------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" weechat
|
||||
|
||||
gnupg:
|
||||
@printf "$(YELLOW)--- gnupg ----------------------------------------------\n$(RESET)"
|
||||
mkdir -p "$$HOME/.gnupg"
|
||||
chmod 700 "$$HOME/.gnupg"
|
||||
stow -t "$$HOME" gnupg
|
||||
|
||||
bin:
|
||||
@printf "$(YELLOW)--- bin ------------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" bin
|
||||
mutt:
|
||||
@printf "$(YELLOW)--- mutt -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" mutt
|
||||
|
||||
emacs:
|
||||
@printf "$(YELLOW)--- emacs ----------------------------------------------\n$(RESET)"
|
||||
git submodule update --init -- emacs/.emacs.d/evil
|
||||
stow -t "$$HOME" emacs
|
||||
nvim:
|
||||
@printf "$(YELLOW)--- nvim -----------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" nvim
|
||||
|
||||
.PHONY: bash fish git vim nvim mutt byobu weechat gnupg bin emacs clean install Windows Linux Other
|
||||
sublime:
|
||||
@printf "$(YELLOW)--- sublime --------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" sublime
|
||||
|
||||
vim:
|
||||
@printf "$(YELLOW)--- vim ------------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" vim
|
||||
|
||||
vscode:
|
||||
@printf "$(YELLOW)--- vscode ---------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" vscode
|
||||
|
||||
weechat:
|
||||
@printf "$(YELLOW)--- weechat --------------------------------------------\n$(RESET)"
|
||||
stow -t "$$HOME" weechat
|
||||
|
||||
.PHONY: bash fish git vim nvim mutt byobu weechat gnupg bin emacs vscode sublime clean install Windows Linux Other
|
||||
|
|
18
emacs/.emacs
18
emacs/.emacs
|
@ -1,4 +1,22 @@
|
|||
(package-initialize)
|
||||
|
||||
(add-to-list 'load-path "~/.emacs.d/evil")
|
||||
(require 'evil)
|
||||
(evil-mode 1)
|
||||
|
||||
(require 'package)
|
||||
(add-to-list 'package-archives
|
||||
'("melpa" . "http://melpa.org/packages/") t)
|
||||
|
||||
(custom-set-variables
|
||||
;; custom-set-variables was added by Custom.
|
||||
;; If you edit it by hand, you could mess it up, so be careful.
|
||||
;; Your init file should contain only one such instance.
|
||||
;; If there is more than one, they won't work right.
|
||||
'(package-selected-packages (quote (magit))))
|
||||
(custom-set-faces
|
||||
;; custom-set-faces was added by Custom.
|
||||
;; If you edit it by hand, you could mess it up, so be careful.
|
||||
;; Your init file should contain only one such instance.
|
||||
;; If there is more than one, they won't work right.
|
||||
)
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1 @@
|
|||
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2018-09-30T17:10:03-0400 using DSA
|
File diff suppressed because one or more lines are too long
|
@ -0,0 +1,158 @@
|
|||
;;; async-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "async" "async.el" (23473 23419 103774 700000))
|
||||
;;; Generated autoloads from async.el
|
||||
|
||||
(autoload 'async-start-process "async" "\
|
||||
Start the executable PROGRAM asynchronously. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory.
|
||||
|
||||
\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil)
|
||||
|
||||
(autoload 'async-start "async" "\
|
||||
Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
'ignore)
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'.
|
||||
|
||||
\(fn START-FUNC &optional FINISH-FUNC)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (23473
|
||||
;;;;;; 23419 119772 996000))
|
||||
;;; Generated autoloads from async-bytecomp.el
|
||||
|
||||
(autoload 'async-byte-recompile-directory "async-bytecomp" "\
|
||||
Compile all *.el files in DIRECTORY asynchronously.
|
||||
All *.elc files are systematically deleted before proceeding.
|
||||
|
||||
\(fn DIRECTORY &optional QUIET)" nil nil)
|
||||
|
||||
(defvar async-bytecomp-package-mode nil "\
|
||||
Non-nil if Async-Bytecomp-Package mode is enabled.
|
||||
See the `async-bytecomp-package-mode' command
|
||||
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 `async-bytecomp-package-mode'.")
|
||||
|
||||
(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil)
|
||||
|
||||
(autoload 'async-bytecomp-package-mode "async-bytecomp" "\
|
||||
Byte compile asynchronously packages installed with package.el.
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'async-byte-compile-file "async-bytecomp" "\
|
||||
Byte compile Lisp code FILE asynchronously.
|
||||
|
||||
Same as `byte-compile-file' but asynchronous.
|
||||
|
||||
\(fn FILE)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "dired-async" "dired-async.el" (23473 23419
|
||||
;;;;;; 115773 422000))
|
||||
;;; Generated autoloads from dired-async.el
|
||||
|
||||
(defvar dired-async-mode nil "\
|
||||
Non-nil if Dired-Async mode is enabled.
|
||||
See the `dired-async-mode' command
|
||||
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 `dired-async-mode'.")
|
||||
|
||||
(custom-autoload 'dired-async-mode "dired-async" nil)
|
||||
|
||||
(autoload 'dired-async-mode "dired-async" "\
|
||||
Do dired actions asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'dired-async-do-copy "dired-async" "\
|
||||
Run ‘dired-do-copy’ asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'dired-async-do-symlink "dired-async" "\
|
||||
Run ‘dired-do-symlink’ asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'dired-async-do-hardlink "dired-async" "\
|
||||
Run ‘dired-do-hardlink’ asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'dired-async-do-rename "dired-async" "\
|
||||
Run ‘dired-do-rename’ asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (23473
|
||||
;;;;;; 23419 123772 569000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; async-autoloads.el ends here
|
|
@ -0,0 +1,219 @@
|
|||
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
||||
|
||||
;; Keywords: dired async byte-compile
|
||||
;; X-URL: https://github.com/jwiegley/dired-async
|
||||
|
||||
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This package provide the `async-byte-recompile-directory' function
|
||||
;; which allows, as the name says to recompile a directory outside of
|
||||
;; your running emacs.
|
||||
;; The benefit is your files will be compiled in a clean environment without
|
||||
;; the old *.el files loaded.
|
||||
;; Among other things, this fix a bug in package.el which recompile
|
||||
;; the new files in the current environment with the old files loaded, creating
|
||||
;; errors in most packages after upgrades.
|
||||
;;
|
||||
;; NB: This package is advicing the function `package--compile'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'async)
|
||||
|
||||
(defcustom async-bytecomp-allowed-packages
|
||||
'(async helm helm-core helm-ls-git helm-ls-hg magit)
|
||||
"Packages in this list will be compiled asynchronously by `package--compile'.
|
||||
All the dependencies of these packages will be compiled async too,
|
||||
so no need to add dependencies to this list.
|
||||
The value of this variable can also be a list with a single element,
|
||||
the symbol `all', in this case packages are always compiled asynchronously."
|
||||
:group 'async
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defvar async-byte-compile-log-file
|
||||
(concat user-emacs-directory "async-bytecomp.log"))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-byte-recompile-directory (directory &optional quiet)
|
||||
"Compile all *.el files in DIRECTORY asynchronously.
|
||||
All *.elc files are systematically deleted before proceeding."
|
||||
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
|
||||
unless dir return nil
|
||||
for f in dir
|
||||
when (file-exists-p f) do (delete-file f))
|
||||
;; Ensure async is reloaded when async.elc is deleted.
|
||||
;; This happen when recompiling its own directory.
|
||||
(load "async")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
(n 0))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-max))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents async-byte-compile-log-file)
|
||||
(compilation-mode))
|
||||
(display-buffer buf)
|
||||
(delete-file async-byte-compile-log-file)
|
||||
(unless quiet
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^.*:Error:" nil t)
|
||||
(cl-incf n)))
|
||||
(if (> n 0)
|
||||
(message "Failed to compile %d files in directory `%s'" n directory)
|
||||
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
|
||||
(unless quiet
|
||||
(message "Directory `%s' compiled asynchronously with success" directory))))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
|
||||
(let ((default-directory (file-name-as-directory ,directory))
|
||||
error-data)
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-recompile-directory ,directory 0 t)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
(setq error-data (with-current-buffer byte-compile-log-buffer
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
(unless (string= error-data "")
|
||||
(with-temp-file ,async-byte-compile-log-file
|
||||
(erase-buffer)
|
||||
(insert error-data))))))
|
||||
call-back)
|
||||
(unless quiet (message "Started compiling asynchronously directory %s" directory))))
|
||||
|
||||
(defvar package-archive-contents)
|
||||
(defvar package-alist)
|
||||
(declare-function package-desc-reqs "package.el" (cl-x))
|
||||
|
||||
(defun async-bytecomp--get-package-deps (pkg &optional only)
|
||||
;; Same as `package--get-deps' but parse instead `package-archive-contents'
|
||||
;; because PKG is not already installed and not present in `package-alist'.
|
||||
;; However fallback to `package-alist' in case PKG no more present
|
||||
;; in `package-archive-contents' due to modification to `package-archives'.
|
||||
;; See issue #58.
|
||||
(let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
|
||||
(assq pkg package-alist))))
|
||||
(direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
|
||||
for name = (car p)
|
||||
when (or (assq name package-archive-contents)
|
||||
(assq name package-alist))
|
||||
collect name))
|
||||
(indirect-deps (unless (eq only 'direct)
|
||||
(delete-dups
|
||||
(cl-loop for p in direct-deps append
|
||||
(async-bytecomp--get-package-deps p))))))
|
||||
(cl-case only
|
||||
(direct direct-deps)
|
||||
(separate (list direct-deps indirect-deps))
|
||||
(indirect indirect-deps)
|
||||
(t (delete-dups (append direct-deps indirect-deps))))))
|
||||
|
||||
(defun async-bytecomp-get-allowed-pkgs ()
|
||||
(when (and async-bytecomp-allowed-packages
|
||||
(listp async-bytecomp-allowed-packages))
|
||||
(if package-archive-contents
|
||||
(cl-loop for p in async-bytecomp-allowed-packages
|
||||
when (assq p package-archive-contents)
|
||||
append (async-bytecomp--get-package-deps p) into reqs
|
||||
finally return
|
||||
(delete-dups
|
||||
(append async-bytecomp-allowed-packages reqs)))
|
||||
async-bytecomp-allowed-packages)))
|
||||
|
||||
(defadvice package--compile (around byte-compile-async)
|
||||
(let ((cur-package (package-desc-name pkg-desc))
|
||||
(pkg-dir (package-desc-dir pkg-desc)))
|
||||
(if (or (equal async-bytecomp-allowed-packages '(all))
|
||||
(memq cur-package (async-bytecomp-get-allowed-pkgs)))
|
||||
(progn
|
||||
(when (eq cur-package 'async)
|
||||
(fmakunbound 'async-byte-recompile-directory))
|
||||
;; Add to `load-path' the latest version of async and
|
||||
;; reload it when reinstalling async.
|
||||
(when (string= cur-package "async")
|
||||
(cl-pushnew pkg-dir load-path)
|
||||
(load "async-bytecomp"))
|
||||
;; `async-byte-recompile-directory' will add directory
|
||||
;; as needed to `load-path'.
|
||||
(async-byte-recompile-directory (package-desc-dir pkg-desc) t))
|
||||
ad-do-it)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode async-bytecomp-package-mode
|
||||
"Byte compile asynchronously packages installed with package.el.
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'."
|
||||
:group 'async
|
||||
:global t
|
||||
(if async-bytecomp-package-mode
|
||||
(ad-activate 'package--compile)
|
||||
(ad-deactivate 'package--compile)))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-byte-compile-file (file)
|
||||
"Byte compile Lisp code FILE asynchronously.
|
||||
|
||||
Same as `byte-compile-file' but asynchronous."
|
||||
(interactive "fFile: ")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(let ((bn (file-name-nondirectory file)))
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
start)
|
||||
(with-current-buffer buf
|
||||
(goto-char (setq start (point-max)))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents async-byte-compile-log-file)
|
||||
(compilation-mode))
|
||||
(display-buffer buf)
|
||||
(delete-file async-byte-compile-log-file)
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(if (re-search-forward "^.*:Error:" nil t)
|
||||
(message "Failed to compile `%s'" bn)
|
||||
(message "`%s' compiled asynchronously with warnings" bn)))))
|
||||
(message "`%s' compiled asynchronously with success" bn))))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables "\\`load-path\\'")
|
||||
(let ((default-directory ,(file-name-directory file)))
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-compile-file ,file)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
(setq error-data (with-current-buffer byte-compile-log-buffer
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
(unless (string= error-data "")
|
||||
(with-temp-file ,async-byte-compile-log-file
|
||||
(erase-buffer)
|
||||
(insert error-data))))))
|
||||
call-back)))
|
||||
|
||||
(provide 'async-bytecomp)
|
||||
|
||||
;;; async-bytecomp.el ends here
|
Binary file not shown.
|
@ -0,0 +1,6 @@
|
|||
(define-package "async" "20180527.1730" "Asynchronous processing in Emacs" 'nil :keywords
|
||||
'("async")
|
||||
:url "https://github.com/jwiegley/emacs-async")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
|
@ -0,0 +1,392 @@
|
|||
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Created: 18 Jun 2012
|
||||
;; Version: 1.9.3
|
||||
|
||||
;; Keywords: async
|
||||
;; X-URL: https://github.com/jwiegley/emacs-async
|
||||
|
||||
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Adds the ability to call asynchronous functions and process with ease. See
|
||||
;; the documentation for `async-start' and `async-start-process'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defgroup async nil
|
||||
"Simple asynchronous processing in Emacs"
|
||||
:group 'emacs)
|
||||
|
||||
(defcustom async-variables-noprops-function #'async-variables-noprops
|
||||
"Default function to remove text properties in variables."
|
||||
:group 'async
|
||||
:type 'function)
|
||||
|
||||
(defvar async-debug nil)
|
||||
(defvar async-send-over-pipe t)
|
||||
(defvar async-in-child-emacs nil)
|
||||
(defvar async-callback nil)
|
||||
(defvar async-callback-for-process nil)
|
||||
(defvar async-callback-value nil)
|
||||
(defvar async-callback-value-set nil)
|
||||
(defvar async-current-process nil)
|
||||
(defvar async--procvar nil)
|
||||
|
||||
(defun async-variables-noprops (sequence)
|
||||
"Remove text properties in SEQUENCE.
|
||||
|
||||
Argument SEQUENCE may be a list or a string, if anything else it
|
||||
is returned unmodified.
|
||||
|
||||
Note that this is a naive function that doesn't remove text properties
|
||||
in SEQUENCE recursively, only at the first level which suffice in most
|
||||
cases."
|
||||
(cond ((stringp sequence)
|
||||
(substring-no-properties sequence))
|
||||
((listp sequence)
|
||||
(cl-loop for elm in sequence
|
||||
if (stringp elm)
|
||||
collect (substring-no-properties elm)
|
||||
else collect elm))
|
||||
(t sequence)))
|
||||
|
||||
(defun async-inject-variables
|
||||
(include-regexp &optional predicate exclude-regexp noprops)
|
||||
"Return a `setq' form that replicates part of the calling environment.
|
||||
|
||||
It sets the value for every variable matching INCLUDE-REGEXP and
|
||||
also PREDICATE. It will not perform injection for any variable
|
||||
matching EXCLUDE-REGEXP (if present) or representing a syntax-table
|
||||
i.e. ending by \"-syntax-table\".
|
||||
When NOPROPS is non nil it tries to strip out text properties of each
|
||||
variable's value with `async-variables-noprops-function'.
|
||||
|
||||
It is intended to be used as follows:
|
||||
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,(buffer-substring-no-properties (point-min) (point-max)))
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
|
||||
(smtpmail-send-it)))
|
||||
'ignore)"
|
||||
`(setq
|
||||
,@(let (bindings)
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(let* ((sname (and (boundp sym) (symbol-name sym)))
|
||||
(value (and sname (symbol-value sym))))
|
||||
(when (and sname
|
||||
(or (null include-regexp)
|
||||
(string-match include-regexp sname))
|
||||
(or (null exclude-regexp)
|
||||
(not (string-match exclude-regexp sname)))
|
||||
(not (string-match "-syntax-table\\'" sname)))
|
||||
(unless (or (stringp value)
|
||||
(memq value '(nil t))
|
||||
(numberp value)
|
||||
(vectorp value))
|
||||
(setq value `(quote ,value)))
|
||||
(when noprops
|
||||
(setq value (funcall async-variables-noprops-function
|
||||
value)))
|
||||
(when (or (null predicate)
|
||||
(funcall predicate sym))
|
||||
(setq bindings (cons value bindings)
|
||||
bindings (cons sym bindings)))))))
|
||||
bindings)))
|
||||
|
||||
(defalias 'async-inject-environment 'async-inject-variables)
|
||||
|
||||
(defun async-handle-result (func result buf)
|
||||
(if (null func)
|
||||
(progn
|
||||
(set (make-local-variable 'async-callback-value) result)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
(unwind-protect
|
||||
(if (and (listp result)
|
||||
(eq 'async-signal (nth 0 result)))
|
||||
(signal (car (nth 1 result))
|
||||
(cdr (nth 1 result)))
|
||||
(funcall func result))
|
||||
(unless async-debug
|
||||
(kill-buffer buf)))))
|
||||
|
||||
(defun async-when-done (proc &optional _change)
|
||||
"Process sentinel used to retrieve the value from the child process."
|
||||
(when (eq 'exit (process-status proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(let ((async-current-process proc))
|
||||
(if (= 0 (process-exit-status proc))
|
||||
(if async-callback-for-process
|
||||
(if async-callback
|
||||
(prog1
|
||||
(funcall async-callback proc)
|
||||
(unless async-debug
|
||||
(kill-buffer (current-buffer))))
|
||||
(set (make-local-variable 'async-callback-value) proc)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
(goto-char (point-max))
|
||||
(backward-sexp)
|
||||
(async-handle-result async-callback (read (current-buffer))
|
||||
(current-buffer)))
|
||||
(set (make-local-variable 'async-callback-value)
|
||||
(list 'error
|
||||
(format "Async process '%s' failed with exit code %d"
|
||||
(process-name proc) (process-exit-status proc))))
|
||||
(set (make-local-variable 'async-callback-value-set) t))))))
|
||||
|
||||
(defun async--receive-sexp (&optional stream)
|
||||
(let ((sexp (decode-coding-string (base64-decode-string
|
||||
(read stream)) 'utf-8-auto))
|
||||
;; Parent expects UTF-8 encoded text.
|
||||
(coding-system-for-write 'utf-8-auto))
|
||||
(if async-debug
|
||||
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(setq sexp (read sexp))
|
||||
(if async-debug
|
||||
(message "Read sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(eval sexp)))
|
||||
|
||||
(defun async--insert-sexp (sexp)
|
||||
(let (print-level
|
||||
print-length
|
||||
(print-escape-nonascii t)
|
||||
(print-circle t))
|
||||
(prin1 sexp (current-buffer))
|
||||
;; Just in case the string we're sending might contain EOF
|
||||
(encode-coding-region (point-min) (point-max) 'utf-8-auto)
|
||||
(base64-encode-region (point-min) (point-max) t)
|
||||
(goto-char (point-min)) (insert ?\")
|
||||
(goto-char (point-max)) (insert ?\" ?\n)))
|
||||
|
||||
(defun async--transmit-sexp (process sexp)
|
||||
(with-temp-buffer
|
||||
(if async-debug
|
||||
(message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(async--insert-sexp sexp)
|
||||
(process-send-region process (point-min) (point-max))))
|
||||
|
||||
(defun async-batch-invoke ()
|
||||
"Called from the child Emacs process' command-line."
|
||||
;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
|
||||
;; process expects.
|
||||
(let ((coding-system-for-write 'utf-8-auto))
|
||||
(setq async-in-child-emacs t
|
||||
debug-on-error async-debug)
|
||||
(if debug-on-error
|
||||
(prin1 (funcall
|
||||
(async--receive-sexp (unless async-send-over-pipe
|
||||
command-line-args-left))))
|
||||
(condition-case err
|
||||
(prin1 (funcall
|
||||
(async--receive-sexp (unless async-send-over-pipe
|
||||
command-line-args-left))))
|
||||
(error
|
||||
(prin1 (list 'async-signal err)))))))
|
||||
|
||||
(defun async-ready (future)
|
||||
"Query a FUTURE to see if it is ready.
|
||||
|
||||
I.e., if no blocking
|
||||
would result from a call to `async-get' on that FUTURE."
|
||||
(and (memq (process-status future) '(exit signal))
|
||||
(let ((buf (process-buffer future)))
|
||||
(if (buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
async-callback-value-set)
|
||||
t))))
|
||||
|
||||
(defun async-wait (future)
|
||||
"Wait for FUTURE to become ready."
|
||||
(while (not (async-ready future))
|
||||
(sleep-for 0.05)))
|
||||
|
||||
(defun async-get (future)
|
||||
"Get the value from process FUTURE when it is ready.
|
||||
FUTURE is returned by `async-start' or `async-start-process' when
|
||||
its FINISH-FUNC is nil."
|
||||
(and future (async-wait future))
|
||||
(let ((buf (process-buffer future)))
|
||||
(when (buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
(async-handle-result
|
||||
#'identity async-callback-value (current-buffer))))))
|
||||
|
||||
(defun async-message-p (value)
|
||||
"Return true of VALUE is an async.el message packet."
|
||||
(and (listp value)
|
||||
(plist-get value :async-message)))
|
||||
|
||||
(defun async-send (&rest args)
|
||||
"Send the given messages to the asychronous Emacs PROCESS."
|
||||
(let ((args (append args '(:async-message t))))
|
||||
(if async-in-child-emacs
|
||||
(if async-callback
|
||||
(funcall async-callback args))
|
||||
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
|
||||
|
||||
(defun async-receive ()
|
||||
"Send the given messages to the asychronous Emacs PROCESS."
|
||||
(async--receive-sexp))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start-process (name program finish-func &rest program-args)
|
||||
"Start the executable PROGRAM asynchronously. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory."
|
||||
(let* ((buf (generate-new-buffer (concat "*" name "*")))
|
||||
(proc (let ((process-connection-type nil))
|
||||
(apply #'start-process name buf program program-args))))
|
||||
(with-current-buffer buf
|
||||
(set (make-local-variable 'async-callback) finish-func)
|
||||
(set-process-sentinel proc #'async-when-done)
|
||||
(unless (string= name "emacs")
|
||||
(set (make-local-variable 'async-callback-for-process) t))
|
||||
proc)))
|
||||
|
||||
(defvar async-quiet-switch "-Q"
|
||||
"The Emacs parameter to use to call emacs without config.
|
||||
Can be one of \"-Q\" or \"-q\".
|
||||
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
|
||||
enhanced config or some more variables loaded.")
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start (start-func &optional finish-func)
|
||||
"Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
'ignore)
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'."
|
||||
(let ((sexp start-func)
|
||||
;; Subordinate Emacs will send text encoded in UTF-8.
|
||||
(coding-system-for-read 'utf-8-auto))
|
||||
(setq async--procvar
|
||||
(async-start-process
|
||||
"emacs" (file-truename
|
||||
(expand-file-name invocation-name
|
||||
invocation-directory))
|
||||
finish-func
|
||||
async-quiet-switch "-l"
|
||||
;; Using `locate-library' ensure we use the right file
|
||||
;; when the .elc have been deleted.
|
||||
(locate-library "async")
|
||||
"-batch" "-f" "async-batch-invoke"
|
||||
(if async-send-over-pipe
|
||||
"<none>"
|
||||
(with-temp-buffer
|
||||
(async--insert-sexp (list 'quote sexp))
|
||||
(buffer-string)))))
|
||||
(if async-send-over-pipe
|
||||
(async--transmit-sexp async--procvar (list 'quote sexp)))
|
||||
async--procvar))
|
||||
|
||||
(defmacro async-sandbox(func)
|
||||
"Evaluate FUNC in a separate Emacs process, synchronously."
|
||||
`(async-get (async-start ,func)))
|
||||
|
||||
(defun async--fold-left (fn forms bindings)
|
||||
(let ((res forms))
|
||||
(dolist (binding bindings)
|
||||
(setq res (funcall fn res
|
||||
(if (listp binding)
|
||||
binding
|
||||
(list binding)))))
|
||||
res))
|
||||
|
||||
(defmacro async-let (bindings &rest forms)
|
||||
"Implements `let', but each binding is established asynchronously.
|
||||
For example:
|
||||
|
||||
(async-let ((x (foo))
|
||||
(y (bar)))
|
||||
(message \"%s %s\" x y))
|
||||
|
||||
expands to ==>
|
||||
|
||||
(async-start (foo)
|
||||
(lambda (x)
|
||||
(async-start (bar)
|
||||
(lambda (y)
|
||||
(message \"%s %s\" x y)))))"
|
||||
(declare (indent 1))
|
||||
(async--fold-left
|
||||
(lambda (acc binding)
|
||||
(let ((fun (pcase (cadr binding)
|
||||
((and (pred functionp) f) f)
|
||||
(f `(lambda () ,f)))))
|
||||
`(async-start ,fun
|
||||
(lambda (,(car binding))
|
||||
,acc))))
|
||||
`(progn ,@forms)
|
||||
(reverse bindings)))
|
||||
|
||||
(provide 'async)
|
||||
|
||||
;;; async.el ends here
|
Binary file not shown.
|
@ -0,0 +1,405 @@
|
|||
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
||||
|
||||
;; Keywords: dired async network
|
||||
;; X-URL: https://github.com/jwiegley/dired-async
|
||||
|
||||
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provide a redefinition of `dired-create-file' function,
|
||||
;; performs copies, moves and all what is handled by `dired-create-file'
|
||||
;; in the background using a slave Emacs process,
|
||||
;; by means of the async.el module.
|
||||
;; To use it, put this in your .emacs:
|
||||
|
||||
;; (dired-async-mode 1)
|
||||
|
||||
;; This will enable async copy/rename etc...
|
||||
;; in dired and helm.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'dired-aux)
|
||||
(require 'async)
|
||||
|
||||
(eval-when-compile
|
||||
(defvar async-callback))
|
||||
|
||||
(defgroup dired-async nil
|
||||
"Copy rename files asynchronously from dired."
|
||||
:group 'dired)
|
||||
|
||||
(defcustom dired-async-env-variables-regexp
|
||||
"\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
|
||||
"Variables matching this regexp will be loaded on Child Emacs."
|
||||
:type 'regexp
|
||||
:group 'dired-async)
|
||||
|
||||
(defcustom dired-async-message-function 'dired-async-mode-line-message
|
||||
"Function to use to notify result when operation finish.
|
||||
Should take same args as `message'."
|
||||
:group 'dired-async
|
||||
:type 'function)
|
||||
|
||||
(defcustom dired-async-log-file "/tmp/dired-async.log"
|
||||
"File use to communicate errors from Child Emacs to host Emacs."
|
||||
:group 'dired-async
|
||||
:type 'string)
|
||||
|
||||
(defcustom dired-async-mode-lighter '(:eval
|
||||
(when (eq major-mode 'dired-mode)
|
||||
" Async"))
|
||||
"Mode line lighter used for `dired-async-mode'."
|
||||
:group 'dired-async
|
||||
:risky t
|
||||
:type 'sexp)
|
||||
|
||||
(defface dired-async-message
|
||||
'((t (:foreground "yellow")))
|
||||
"Face used for mode-line message."
|
||||
:group 'dired-async)
|
||||
|
||||
(defface dired-async-failures
|
||||
'((t (:foreground "red")))
|
||||
"Face used for mode-line message."
|
||||
:group 'dired-async)
|
||||
|
||||
(defface dired-async-mode-message
|
||||
'((t (:foreground "Gold")))
|
||||
"Face used for `dired-async--modeline-mode' lighter."
|
||||
:group 'dired-async)
|
||||
|
||||
(define-minor-mode dired-async--modeline-mode
|
||||
"Notify mode-line that an async process run."
|
||||
:group 'dired-async
|
||||
:global t
|
||||
:lighter (:eval (propertize (format " [%s Async job(s) running]"
|
||||
(length (dired-async-processes)))
|
||||
'face 'dired-async-mode-message))
|
||||
(unless dired-async--modeline-mode
|
||||
(let ((visible-bell t)) (ding))))
|
||||
|
||||
(defun dired-async-mode-line-message (text face &rest args)
|
||||
"Notify end of operation in `mode-line'."
|
||||
(message nil)
|
||||
(let ((mode-line-format (concat
|
||||
" " (propertize
|
||||
(if args
|
||||
(apply #'format text args)
|
||||
text)
|
||||
'face face))))
|
||||
(force-mode-line-update)
|
||||
(sit-for 3)
|
||||
(force-mode-line-update)))
|
||||
|
||||
(defun dired-async-processes ()
|
||||
(cl-loop for p in (process-list)
|
||||
when (cl-loop for c in (process-command p) thereis
|
||||
(string= "async-batch-invoke" c))
|
||||
collect p))
|
||||
|
||||
(defun dired-async-kill-process ()
|
||||
(interactive)
|
||||
(let* ((processes (dired-async-processes))
|
||||
(proc (car (last processes))))
|
||||
(and proc (delete-process proc))
|
||||
(unless (> (length processes) 1)
|
||||
(dired-async--modeline-mode -1))))
|
||||
|
||||
(defun dired-async-after-file-create (total operation failures skipped)
|
||||
"Callback function used for operation handled by `dired-create-file'."
|
||||
(unless (dired-async-processes)
|
||||
;; Turn off mode-line notification
|
||||
;; only when last process end.
|
||||
(dired-async--modeline-mode -1))
|
||||
(when operation
|
||||
(if (file-exists-p dired-async-log-file)
|
||||
(progn
|
||||
(pop-to-buffer (get-buffer-create dired-log-buffer))
|
||||
(goto-char (point-max))
|
||||
(setq inhibit-read-only t)
|
||||
(insert "Error: ")
|
||||
(insert-file-contents dired-async-log-file)
|
||||
(special-mode)
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(delete-file dired-async-log-file))
|
||||
(run-with-timer
|
||||
0.1 nil
|
||||
(lambda ()
|
||||
;; First send error messages.
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length skipped) total
|
||||
(dired-plural-s total))))
|
||||
(when dired-buffers
|
||||
(cl-loop for (_f . b) in dired-buffers
|
||||
when (buffer-live-p b)
|
||||
do (with-current-buffer b (revert-buffer nil t))))
|
||||
;; Finally send the success message.
|
||||
(funcall dired-async-message-function
|
||||
"Asynchronous %s of %s on %s file%s done"
|
||||
'dired-async-message
|
||||
(car operation) (cadr operation)
|
||||
total (dired-plural-s total)))))))
|
||||
|
||||
(defun dired-async-maybe-kill-ftp ()
|
||||
"Return a form to kill ftp process in child emacs."
|
||||
(quote
|
||||
(progn
|
||||
(require 'cl-lib)
|
||||
(let ((buf (cl-loop for b in (buffer-list)
|
||||
thereis (and (string-match
|
||||
"\\`\\*ftp.*"
|
||||
(buffer-name b)) b))))
|
||||
(when buf (kill-buffer buf))))))
|
||||
|
||||
(defvar overwrite-query)
|
||||
(defun dired-async-create-files (file-creator operation fn-list name-constructor
|
||||
&optional _marker-char)
|
||||
"Same as `dired-create-files' but asynchronous.
|
||||
|
||||
See `dired-create-files' for the behavior of arguments."
|
||||
(setq overwrite-query nil)
|
||||
(let ((total (length fn-list))
|
||||
failures async-fn-list skipped callback
|
||||
async-quiet-switch)
|
||||
(let (to)
|
||||
(dolist (from fn-list)
|
||||
(setq to (funcall name-constructor from))
|
||||
(if (and (equal to from)
|
||||
(null (eq file-creator 'backup-file)))
|
||||
(progn
|
||||
(setq to nil)
|
||||
(dired-log "Cannot %s to same file: %s\n"
|
||||
(downcase operation) from)))
|
||||
(if (not to)
|
||||
(setq skipped (cons (dired-make-relative from) skipped))
|
||||
(let* ((overwrite (and (null (eq file-creator 'backup-file))
|
||||
(file-exists-p to)))
|
||||
(dired-overwrite-confirmed ; for dired-handle-overwrite
|
||||
(and overwrite
|
||||
(let ((help-form `(format "\
|
||||
Type SPC or `y' to overwrite file `%s',
|
||||
DEL or `n' to skip to next,
|
||||
ESC or `q' to not overwrite any of the remaining files,
|
||||
`!' to overwrite all remaining files with no more questions." ,to)))
|
||||
(dired-query 'overwrite-query "Overwrite `%s'?" to)))))
|
||||
;; Handle the `dired-copy-file' file-creator specially
|
||||
;; When copying a directory to another directory or
|
||||
;; possibly to itself or one of its subdirectories.
|
||||
;; e.g "~/foo/" => "~/test/"
|
||||
;; or "~/foo/" =>"~/foo/"
|
||||
;; or "~/foo/ => ~/foo/bar/")
|
||||
;; In this case the 'name-constructor' have set the destination
|
||||
;; TO to "~/test/foo" because the old emacs23 behavior
|
||||
;; of `copy-directory' was to not create the subdirectory
|
||||
;; and instead copy the contents.
|
||||
;; With the new behavior of `copy-directory'
|
||||
;; (similar to the `cp' shell command) we don't
|
||||
;; need such a construction of the target directory,
|
||||
;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
|
||||
(let ((destname (file-name-directory to)))
|
||||
(when (and (file-directory-p from)
|
||||
(file-directory-p to)
|
||||
(eq file-creator 'dired-copy-file))
|
||||
(setq to destname))
|
||||
;; If DESTNAME is a subdirectory of FROM, not a symlink,
|
||||
;; and the method in use is copying, signal an error.
|
||||
(and (eq t (car (file-attributes destname)))
|
||||
(eq file-creator 'dired-copy-file)
|
||||
(file-in-directory-p destname from)
|
||||
(error "Cannot copy `%s' into its subdirectory `%s'"
|
||||
from to)))
|
||||
(if overwrite
|
||||
(or (and dired-overwrite-confirmed
|
||||
(push (cons from to) async-fn-list))
|
||||
(progn
|
||||
(push (dired-make-relative from) failures)
|
||||
(dired-log "%s `%s' to `%s' failed\n"
|
||||
operation from to)))
|
||||
(push (cons from to) async-fn-list)))))
|
||||
;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
|
||||
(setq async-quiet-switch
|
||||
(if (and (boundp 'tramp-cache-read-persistent-data)
|
||||
async-fn-list
|
||||
(cl-loop for (_from . to) in async-fn-list
|
||||
thereis (file-remote-p to)))
|
||||
"-q" "-Q"))
|
||||
;; When failures have been printed to dired log add the date at bob.
|
||||
(when (or failures skipped) (dired-log t))
|
||||
;; When async-fn-list is empty that's mean only one file
|
||||
;; had to be copied and user finally answer NO.
|
||||
;; In this case async process will never start and callback
|
||||
;; will have no chance to run, so notify failures here.
|
||||
(unless async-fn-list
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length skipped) total
|
||||
(dired-plural-s total)))))
|
||||
;; Setup callback.
|
||||
(setq callback
|
||||
(lambda (&optional _ignore)
|
||||
(dired-async-after-file-create
|
||||
total (list operation (length async-fn-list)) failures skipped)
|
||||
(when (string= (downcase operation) "rename")
|
||||
(cl-loop for (file . to) in async-fn-list
|
||||
for bf = (get-file-buffer file)
|
||||
for destp = (file-exists-p to)
|
||||
do (and bf destp
|
||||
(with-current-buffer bf
|
||||
(set-visited-file-name to t t))))))))
|
||||
;; Start async process.
|
||||
(when async-fn-list
|
||||
(async-start `(lambda ()
|
||||
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
|
||||
,(async-inject-variables dired-async-env-variables-regexp)
|
||||
(let ((dired-recursive-copies (quote always))
|
||||
(dired-copy-preserve-time
|
||||
,dired-copy-preserve-time))
|
||||
(setq overwrite-backup-query nil)
|
||||
;; Inline `backup-file' as long as it is not
|
||||
;; available in emacs.
|
||||
(defalias 'backup-file
|
||||
;; Same feature as "cp -f --backup=numbered from to"
|
||||
;; Symlinks are copied as file from source unlike
|
||||
;; `dired-copy-file' which is same as cp -d.
|
||||
;; Directories are omitted.
|
||||
(lambda (from to ok)
|
||||
(cond ((file-directory-p from) (ignore))
|
||||
(t (let ((count 0))
|
||||
(while (let ((attrs (file-attributes to)))
|
||||
(and attrs (null (nth 0 attrs))))
|
||||
(cl-incf count)
|
||||
(setq to (concat (file-name-sans-versions to)
|
||||
(format ".~%s~" count)))))
|
||||
(condition-case err
|
||||
(copy-file from to ok dired-copy-preserve-time)
|
||||
(file-date-error
|
||||
(dired-log "Can't set date on %s:\n%s\n" from err)))))))
|
||||
;; Now run the FILE-CREATOR function on files.
|
||||
(cl-loop with fn = (quote ,file-creator)
|
||||
for (from . dest) in (quote ,async-fn-list)
|
||||
do (condition-case err
|
||||
(funcall fn from dest t)
|
||||
(file-error
|
||||
(dired-log "%s: %s\n" (car err) (cdr err)))
|
||||
nil))
|
||||
(when (get-buffer dired-log-buffer)
|
||||
(dired-log t)
|
||||
(with-current-buffer dired-log-buffer
|
||||
(write-region (point-min) (point-max)
|
||||
,dired-async-log-file))))
|
||||
,(dired-async-maybe-kill-ftp))
|
||||
callback)
|
||||
;; Run mode-line notifications while process running.
|
||||
(dired-async--modeline-mode 1)
|
||||
(message "%s proceeding asynchronously..." operation))))
|
||||
|
||||
(defvar wdired-use-interactive-rename)
|
||||
(defun dired-async-wdired-do-renames (old-fn &rest args)
|
||||
;; Perhaps a better fix would be to ask for renaming BEFORE starting
|
||||
;; OLD-FN when `wdired-use-interactive-rename' is non-nil. For now
|
||||
;; just bind it to nil to ensure no questions will be asked between
|
||||
;; each rename.
|
||||
(let (wdired-use-interactive-rename)
|
||||
(apply old-fn args)))
|
||||
|
||||
(defadvice wdired-do-renames (around wdired-async)
|
||||
(let (wdired-use-interactive-rename)
|
||||
ad-do-it))
|
||||
|
||||
(defadvice dired-create-files (around dired-async)
|
||||
(dired-async-create-files file-creator operation fn-list
|
||||
name-constructor marker-char))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode dired-async-mode
|
||||
"Do dired actions asynchronously."
|
||||
:group 'dired-async
|
||||
:lighter dired-async-mode-lighter
|
||||
:global t
|
||||
(if dired-async-mode
|
||||
(if (fboundp 'advice-add)
|
||||
(progn (advice-add 'dired-create-files :override #'dired-async-create-files)
|
||||
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
|
||||
(ad-activate 'dired-create-files)
|
||||
(ad-activate 'wdired-do-renames))
|
||||
(if (fboundp 'advice-remove)
|
||||
(progn (advice-remove 'dired-create-files #'dired-async-create-files)
|
||||
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
|
||||
(ad-deactivate 'dired-create-files)
|
||||
(ad-deactivate 'wdired-do-renames))))
|
||||
|
||||
(defmacro dired-async--with-async-create-files (&rest body)
|
||||
"Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."
|
||||
(declare (indent 0))
|
||||
`(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-copy (&optional arg)
|
||||
"Run ‘dired-do-copy’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-copy arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-symlink (&optional arg)
|
||||
"Run ‘dired-do-symlink’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-symlink arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-hardlink (&optional arg)
|
||||
"Run ‘dired-do-hardlink’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-hardlink arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-rename (&optional arg)
|
||||
"Run ‘dired-do-rename’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-rename arg)))
|
||||
|
||||
(provide 'dired-async)
|
||||
|
||||
;;; dired-async.el ends here
|
Binary file not shown.
|
@ -0,0 +1,73 @@
|
|||
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Created: 18 Jun 2012
|
||||
|
||||
;; Keywords: email async
|
||||
;; X-URL: https://github.com/jwiegley/emacs-async
|
||||
|
||||
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Send e-mail with smtpmail.el asynchronously. To use:
|
||||
;;
|
||||
;; (require 'smtpmail-async)
|
||||
;;
|
||||
;; (setq send-mail-function 'async-smtpmail-send-it
|
||||
;; message-send-mail-function 'async-smtpmail-send-it)
|
||||
;;
|
||||
;; This assumes you already have smtpmail.el working.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup smtpmail-async nil
|
||||
"Send e-mail with smtpmail.el asynchronously"
|
||||
:group 'smptmail)
|
||||
|
||||
(require 'async)
|
||||
(require 'smtpmail)
|
||||
(require 'message)
|
||||
|
||||
(defvar async-smtpmail-before-send-hook nil
|
||||
"Hook running in the child emacs in `async-smtpmail-send-it'.
|
||||
It is called just before calling `smtpmail-send-it'.")
|
||||
|
||||
(defun async-smtpmail-send-it ()
|
||||
(let ((to (message-field-value "To"))
|
||||
(buf-content (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(message "Delivering message to %s..." to)
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,buf-content)
|
||||
(set-buffer-multibyte nil)
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables
|
||||
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
|
||||
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
|
||||
(run-hooks 'async-smtpmail-before-send-hook)
|
||||
(smtpmail-send-it)))
|
||||
(lambda (&optional _ignore)
|
||||
(message "Delivering message to %s...done" to)))))
|
||||
|
||||
(provide 'smtpmail-async)
|
||||
|
||||
;;; smtpmail-async.el ends here
|
Binary file not shown.
|
@ -0,0 +1,15 @@
|
|||
;;; dash-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil nil ("dash.el") (23473 23422 155453 103000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; dash-autoloads.el ends here
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "dash" "20180910.1856" "A modern list library for Emacs" 'nil :commit "6514359b8606a6a9a94068ccd601fcd6379d6584" :keywords '("lists") :authors '(("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Magnar Sveen" . "magnars@gmail.com"))
|
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,35 @@
|
|||
Overview
|
||||
--------
|
||||
EXWM (Emacs X Window Manager) is a full-featured tiling X window manager
|
||||
for Emacs built on top of [XELB](https://github.com/ch11ng/xelb).
|
||||
It features:
|
||||
+ Fully keyboard-driven operations
|
||||
+ Hybrid layout modes (tiling & stacking)
|
||||
+ Dynamic workspace support
|
||||
+ ICCCM/EWMH compliance
|
||||
+ (Optional) RandR (multi-monitor) support
|
||||
+ (Optional) Built-in system tray
|
||||
|
||||
Installation & configuration
|
||||
----------------------------
|
||||
Here are the minimal steps to get EXWM working:
|
||||
1. Install XELB and EXWM, and make sure they are in `load-path'.
|
||||
2. In '~/.emacs', add following lines (please modify accordingly):
|
||||
|
||||
(require 'exwm)
|
||||
(require 'exwm-config)
|
||||
(exwm-config-default)
|
||||
|
||||
3. Link or copy the file 'xinitrc' to '~/.xinitrc'.
|
||||
4. Launch EXWM in a console (e.g. tty1) with
|
||||
|
||||
xinit -- vt01
|
||||
|
||||
You should additionally hide the menu-bar, tool-bar, etc to increase the
|
||||
usable space. Please check the wiki (https://github.com/ch11ng/exwm/wiki)
|
||||
for more detailed instructions on installation, configuration, usage, etc.
|
||||
|
||||
References:
|
||||
+ dwm (http://dwm.suckless.org/)
|
||||
+ i3 wm (https://i3wm.org/)
|
||||
+ Also see references within each required library.
|
|
@ -0,0 +1,128 @@
|
|||
;;; buck.el --- minuscule client library for the Bitbucket API -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Buck is a library that provides basic support for using the Bitbucket API
|
||||
;; from Emacs packages. It abstracts access to API resources using only
|
||||
;; a handful of functions that are not resource-specific.
|
||||
|
||||
;; This library is implemented on top of Ghub. Unlike Ghub, Buck does
|
||||
;; not support the guided creation of tokens because Bitbucket lacks the
|
||||
;; features that would be necessary to implement that. Users have to
|
||||
;; create tokens through the web interface.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ghub)
|
||||
|
||||
(defconst buck-default-host "api.bitbucket.org/2.0"
|
||||
"The default host that is used if `buck.host' is not set.")
|
||||
|
||||
;; HEAD and PATCH are not supported according to
|
||||
;; https://developer.atlassian.com/bitbucket/api/2/reference/meta/uri-uuid
|
||||
|
||||
(cl-defun buck-get (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `GET' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"GET\" as METHOD
|
||||
and `bitbucket' as FORGE."
|
||||
(ghub-request "GET" resource params :forge 'bitbucket
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun buck-put (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PUT' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PUT\" as METHOD
|
||||
and `bitbucket' as FORGE."
|
||||
(ghub-request "PUT" resource params :forge 'bitbucket
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun buck-post (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `POST' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"POST\" as METHOD
|
||||
and `bitbucket' as FORGE."
|
||||
(ghub-request "POST" resource params :forge 'bitbucket
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun buck-delete (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
|
||||
and `bitbucket' as FORGE."
|
||||
(ghub-request "DELETE" resource params :forge 'bitbucket
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun buck-request (method resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a request for RESOURCE and return the response body.
|
||||
Like calling `ghub-request' (which see) with `bitbucket' as FORGE."
|
||||
(ghub-request method resource params :forge 'bitbucket
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun buck-repository-id (owner name &key username auth host)
|
||||
"Return the id of the repository specified by OWNER, NAME and HOST."
|
||||
(substring (cdr (assq 'uuid
|
||||
(buck-get (format "/repositories/%s/%s" owner name)
|
||||
nil
|
||||
:username username :auth auth :host host)))
|
||||
1 -1))
|
||||
|
||||
;;; _
|
||||
(provide 'buck)
|
||||
;;; buck.el ends here
|
Binary file not shown.
|
@ -0,0 +1,18 @@
|
|||
This is the file .../info/dir, which contains the
|
||||
topmost node of the Info hierarchy, called (dir)Top.
|
||||
The first time you invoke Info you start off looking at this node.
|
||||
|
||||
File: dir, Node: Top This is the top of the INFO tree
|
||||
|
||||
This (the Directory node) gives a menu of major topics.
|
||||
Typing "q" exits, "H" lists all Info commands, "d" returns here,
|
||||
"h" gives a primer for first-timers,
|
||||
"mEmacs<Return>" visits the Emacs manual, etc.
|
||||
|
||||
In Emacs, you can click mouse button 2 on a menu item or cross reference
|
||||
to select it.
|
||||
|
||||
* Menu:
|
||||
|
||||
Emacs
|
||||
* Ghub: (ghub). Minuscule client library for the Github API.
|
|
@ -0,0 +1,50 @@
|
|||
;;; ghub-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "ghub" "ghub.el" (23473 23427 386924 364000))
|
||||
;;; Generated autoloads from ghub.el
|
||||
|
||||
(autoload 'ghub-create-token "ghub" "\
|
||||
Create, store and return a new token.
|
||||
|
||||
HOST is the Github instance, usually \"api.github.com\".
|
||||
USERNAME is the name of a user on that instance.
|
||||
PACKAGE is the package that will use the token.
|
||||
SCOPES are the scopes the token is given access to.
|
||||
|
||||
\(fn HOST USERNAME PACKAGE SCOPES)" t nil)
|
||||
|
||||
(autoload 'ghub-token-scopes "ghub" "\
|
||||
Return and echo the scopes of the specified token.
|
||||
This is intended for debugging purposes only. The user
|
||||
has to provide several values including their password.
|
||||
|
||||
\(fn HOST USERNAME PACKAGE)" t nil)
|
||||
|
||||
(autoload 'ghub-clear-caches "ghub" "\
|
||||
Clear all caches that might negatively affect Ghub.
|
||||
|
||||
If a library that is used by Ghub caches incorrect information
|
||||
such as a mistyped password, then that can prevent Ghub from
|
||||
asking the user for the correct information again.
|
||||
|
||||
Set `url-http-real-basic-auth-storage' to nil
|
||||
and call `auth-source-forget+'.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("buck.el" "ghub-graphql.el" "ghub-pkg.el"
|
||||
;;;;;; "glab.el" "gogs.el" "gtea.el") (23473 23427 414921 610000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; ghub-autoloads.el ends here
|
|
@ -0,0 +1,440 @@
|
|||
;;; ghub-graphql.el --- access Github API using GrapthQL -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'ghub)
|
||||
(require 'graphql)
|
||||
(require 'subr-x)
|
||||
(require 'treepy)
|
||||
|
||||
;;; Api
|
||||
|
||||
(cl-defun ghub-graphql (graphql &optional variables
|
||||
&key username auth host
|
||||
silent
|
||||
callback errorback value extra)
|
||||
"Make a GraphQL request using GRAPHQL and VARIABLES.
|
||||
Return the response as a JSON-like alist. Even if the response
|
||||
contains `errors', do not raise an error. GRAPHQL is a GraphQL
|
||||
string. VARIABLES is a JSON-like alist. The other arguments
|
||||
behave as for `ghub-request' (which see)."
|
||||
(cl-assert (stringp graphql))
|
||||
(cl-assert (not (stringp variables)))
|
||||
(ghub-request "POST" "/graphql" nil :payload
|
||||
(json-encode `(("query" . ,graphql)
|
||||
,@(and variables `(("variables" ,@variables)))))
|
||||
:silent silent
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback
|
||||
:extra extra :value value))
|
||||
|
||||
(cl-defun ghub-graphql-rate-limit (&key username auth host)
|
||||
"Return rate limit information."
|
||||
(let-alist (ghub-graphql
|
||||
"query { rateLimit { limit cost remaining resetAt }}"
|
||||
nil :username username :auth auth :host host)
|
||||
.data.rateLimit))
|
||||
|
||||
(cl-defun ghub--repository-id (owner name &key username auth host)
|
||||
"Return the id of the repository specified by OWNER, NAME and HOST."
|
||||
(let-alist (ghub-graphql
|
||||
"query ($owner:String!, $name:String!) {
|
||||
repository(owner:$owner, name:$name) { id }
|
||||
}"
|
||||
`((owner . ,owner)
|
||||
(name . ,name))
|
||||
:username username :auth auth :host host)
|
||||
.data.repository.id))
|
||||
|
||||
;;; Api (drafts)
|
||||
|
||||
(defconst ghub-fetch-repository
|
||||
'(query
|
||||
(repository
|
||||
[(owner $owner String!)
|
||||
(name $name String!)]
|
||||
name
|
||||
id
|
||||
createdAt
|
||||
updatedAt
|
||||
nameWithOwner
|
||||
description
|
||||
(defaultBranchRef name)
|
||||
isArchived
|
||||
isFork
|
||||
isLocked
|
||||
isMirror
|
||||
isPrivate
|
||||
hasIssuesEnabled
|
||||
hasWikiEnabled
|
||||
(licenseInfo name)
|
||||
(stargazers totalCount)
|
||||
(watchers totalCount)
|
||||
(assignableUsers [(:edges t)]
|
||||
id
|
||||
login
|
||||
name)
|
||||
(issues [(:edges t)
|
||||
(:singular issue number)
|
||||
(orderBy ((field . UPDATED_AT) (direction . DESC)))]
|
||||
number
|
||||
state
|
||||
(author login)
|
||||
title
|
||||
createdAt
|
||||
updatedAt
|
||||
closedAt
|
||||
locked
|
||||
(milestone id)
|
||||
body
|
||||
(assignees [(:edges t)]
|
||||
id)
|
||||
(comments [(:edges t)]
|
||||
databaseId
|
||||
(author login)
|
||||
createdAt
|
||||
updatedAt
|
||||
body)
|
||||
(labels [(:edges t)]
|
||||
id))
|
||||
(labels [(:edges t)
|
||||
(:singular label id)]
|
||||
id
|
||||
name
|
||||
color
|
||||
description)
|
||||
(pullRequests [(:edges t)
|
||||
(:singular pullRequest number)
|
||||
(orderBy ((field . UPDATED_AT) (direction . DESC)))]
|
||||
number
|
||||
state
|
||||
(author login)
|
||||
title
|
||||
createdAt
|
||||
updatedAt
|
||||
closedAt
|
||||
mergedAt
|
||||
locked
|
||||
maintainerCanModify
|
||||
isCrossRepository
|
||||
(milestone id)
|
||||
body
|
||||
(baseRef name
|
||||
(repository nameWithOwner))
|
||||
(headRef name
|
||||
(repository (owner login)
|
||||
nameWithOwner))
|
||||
(assignees [(:edges t)]
|
||||
id)
|
||||
(comments [(:edges t)]
|
||||
databaseId
|
||||
(author login)
|
||||
createdAt
|
||||
updatedAt
|
||||
body)
|
||||
(labels [(:edges t)]
|
||||
id)))))
|
||||
|
||||
(cl-defun ghub-fetch-repository (owner name callback
|
||||
&optional until
|
||||
&key username auth host forge)
|
||||
"Asynchronously fetch forge data about the specified repository.
|
||||
Once all data has been collected, CALLBACK is called with the
|
||||
data as the only argument."
|
||||
(ghub--graphql-vacuum ghub-fetch-repository
|
||||
`((owner . ,owner)
|
||||
(name . ,name))
|
||||
callback until
|
||||
:narrow '(repository)
|
||||
:username username
|
||||
:auth auth
|
||||
:host host
|
||||
:forge forge))
|
||||
|
||||
(cl-defun ghub-fetch-issue (owner name number callback
|
||||
&optional until
|
||||
&key username auth host forge)
|
||||
"Asynchronously fetch forge data about the specified issue.
|
||||
Once all data has been collected, CALLBACK is called with the
|
||||
data as the only argument."
|
||||
(ghub--graphql-vacuum (ghub--graphql-prepare-query
|
||||
ghub-fetch-repository
|
||||
`(repository issues (issue . ,number)))
|
||||
`((owner . ,owner)
|
||||
(name . ,name))
|
||||
callback until
|
||||
:narrow '(repository issue)
|
||||
:username username
|
||||
:auth auth
|
||||
:host host
|
||||
:forge forge))
|
||||
|
||||
(cl-defun ghub-fetch-pullreq (owner name number callback
|
||||
&optional until
|
||||
&key username auth host forge)
|
||||
"Asynchronously fetch forge data about the specified pull-request.
|
||||
Once all data has been collected, CALLBACK is called with the
|
||||
data as the only argument."
|
||||
(ghub--graphql-vacuum (ghub--graphql-prepare-query
|
||||
ghub-fetch-repository
|
||||
`(repository pullRequests (pullRequest . ,number)))
|
||||
`((owner . ,owner)
|
||||
(name . ,name))
|
||||
callback until
|
||||
:narrow '(repository pullRequest)
|
||||
:username username
|
||||
:auth auth
|
||||
:host host
|
||||
:forge forge))
|
||||
|
||||
;;; Internal
|
||||
|
||||
(cl-defstruct (ghub--graphql-req
|
||||
(:include ghub--req)
|
||||
(:constructor ghub--make-graphql-req)
|
||||
(:copier nil))
|
||||
(query nil :read-only t)
|
||||
(variables nil :read-only t)
|
||||
(until nil :read-only t)
|
||||
(pages 0 :read-only nil))
|
||||
|
||||
(cl-defun ghub--graphql-vacuum (query variables callback
|
||||
&optional until
|
||||
&key narrow username auth host forge)
|
||||
"Make a GraphQL request using QUERY and VARIABLES.
|
||||
See Info node `(ghub)GraphQL Support'."
|
||||
(unless host
|
||||
(setq host (ghub--host forge)))
|
||||
(unless (or username (stringp auth) (eq auth 'none))
|
||||
(setq username (ghub--username host forge)))
|
||||
(ghub--graphql-retrieve
|
||||
(ghub--make-graphql-req
|
||||
:url (url-generic-parse-url (concat "https://" host "/graphql"))
|
||||
:method "POST"
|
||||
:headers (ghub--headers nil host auth username forge)
|
||||
:handler 'ghub--graphql-handle-response
|
||||
:query query
|
||||
:variables variables
|
||||
:until until
|
||||
:callback (if narrow
|
||||
(lambda (data)
|
||||
(let ((path narrow) key)
|
||||
(while (setq key (pop path))
|
||||
(setq data (cdr (assq key data)))))
|
||||
(funcall callback data))
|
||||
callback))))
|
||||
|
||||
(cl-defun ghub--graphql-retrieve (req &optional lineage cursor)
|
||||
(let ((p (cl-incf (ghub--graphql-req-pages req))))
|
||||
(when (> p 1)
|
||||
(message "Fetching page %s..." p)))
|
||||
(ghub--retrieve
|
||||
(let ((json-false nil))
|
||||
(ghub--encode-payload
|
||||
`((query . ,(ghub--graphql-encode
|
||||
(ghub--graphql-prepare-query
|
||||
(ghub--graphql-req-query req)
|
||||
lineage cursor)))
|
||||
(variables . ,(ghub--graphql-req-variables req)))))
|
||||
req))
|
||||
|
||||
(defun ghub--graphql-prepare-query (query &optional lineage cursor)
|
||||
(when lineage
|
||||
(setq query (ghub--graphql-narrow-query query lineage cursor)))
|
||||
(let ((loc (ghub--alist-zip query))
|
||||
variables)
|
||||
(cl-block nil
|
||||
(while t
|
||||
(let ((node (treepy-node loc)))
|
||||
(when (vectorp node)
|
||||
(let ((alist (cl-coerce node 'list))
|
||||
vars)
|
||||
(when (assq :edges alist)
|
||||
(push (list 'first 100) vars)
|
||||
(setq loc (treepy-up loc))
|
||||
(setq node (treepy-node loc))
|
||||
(setq loc (treepy-replace
|
||||
loc `(,(car node)
|
||||
,(cadr node)
|
||||
(pageInfo endCursor hasNextPage)
|
||||
(edges (node ,@(cddr node))))))
|
||||
(setq loc (treepy-down loc))
|
||||
(setq loc (treepy-next loc)))
|
||||
(dolist (elt alist)
|
||||
(cond ((keywordp (car elt)))
|
||||
((= (length elt) 3)
|
||||
(push (list (nth 0 elt)
|
||||
(nth 1 elt)) vars)
|
||||
(push (list (nth 1 elt)
|
||||
(nth 2 elt)) variables))
|
||||
((= (length elt) 2)
|
||||
(push elt vars))))
|
||||
(setq loc (treepy-replace loc (cl-coerce vars 'vector))))))
|
||||
(if (treepy-end-p loc)
|
||||
(let ((node (copy-sequence (treepy-node loc))))
|
||||
(when variables
|
||||
(push (cl-coerce variables 'vector)
|
||||
(cdr node)))
|
||||
(cl-return node))
|
||||
(setq loc (treepy-next loc)))))))
|
||||
|
||||
(defun ghub--graphql-handle-response (status req)
|
||||
(let ((buffer (current-buffer)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-buffer-multibyte t)
|
||||
(let* ((headers (ghub--handle-response-headers status req))
|
||||
(payload (ghub--handle-response-payload req))
|
||||
(payload (ghub--handle-response-error status payload req))
|
||||
(err (plist-get status :error))
|
||||
(errors (cdr (assq 'errors payload)))
|
||||
(errors (and errors
|
||||
(cons 'ghub-graphql-error errors)))
|
||||
(data (assq 'data payload))
|
||||
(value (ghub--req-value req)))
|
||||
(setf (ghub--req-value req) value)
|
||||
(if (or err errors)
|
||||
(if-let ((errorback (ghub--req-errorback req)))
|
||||
(funcall errorback (or err errors) headers status req)
|
||||
(ghub--signal-error (or err errors)))
|
||||
(ghub--graphql-walk-response value data req))))
|
||||
(when (buffer-live-p buffer)
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(defun ghub--graphql-walk-response (loc data req)
|
||||
(if (not loc)
|
||||
(setf (ghub--req-value req)
|
||||
(setq loc (ghub--alist-zip data)))
|
||||
(setq data (ghub--graphql-narrow-data data (ghub--graphql-lineage loc)))
|
||||
(setf (alist-get 'edges data)
|
||||
(append (alist-get 'edges (treepy-node loc))
|
||||
(or (alist-get 'edges data)
|
||||
(error "BUG: Expected new nodes"))))
|
||||
(setq loc (treepy-replace loc data)))
|
||||
(cl-block nil
|
||||
(while t
|
||||
(when (eq (car-safe (treepy-node loc)) 'edges)
|
||||
(setq loc (treepy-up loc))
|
||||
(pcase-let ((`(,key . ,val) (treepy-node loc)))
|
||||
(let-alist val
|
||||
(let* ((cursor (and .pageInfo.hasNextPage
|
||||
.pageInfo.endCursor))
|
||||
(until (cdr (assq (intern (format "%s-until" key))
|
||||
(ghub--graphql-req-until req))))
|
||||
(nodes (mapcar #'cdar .edges))
|
||||
(nodes (if until
|
||||
(--take-while
|
||||
(or (string> (cdr (assq 'updatedAt it)) until)
|
||||
(setq cursor nil))
|
||||
nodes)
|
||||
nodes)))
|
||||
(if cursor
|
||||
(progn
|
||||
(setf (ghub--req-value req) loc)
|
||||
(ghub--graphql-retrieve req
|
||||
(ghub--graphql-lineage loc)
|
||||
cursor)
|
||||
(cl-return))
|
||||
(setq loc (treepy-replace loc (cons key nodes))))))))
|
||||
(if (not (treepy-end-p loc))
|
||||
(setq loc (treepy-next loc))
|
||||
(funcall (ghub--req-callback req)
|
||||
(treepy-root loc))
|
||||
(cl-return)))))
|
||||
|
||||
(defun ghub--graphql-lineage (loc)
|
||||
(let (lineage)
|
||||
(while (treepy-up loc)
|
||||
(push (car (treepy-node loc)) lineage)
|
||||
(setq loc (treepy-up loc)))
|
||||
lineage))
|
||||
|
||||
(defun ghub--graphql-narrow-data (data lineage)
|
||||
(let (key)
|
||||
(while (setq key (pop lineage))
|
||||
(if (consp (car lineage))
|
||||
(progn (pop lineage)
|
||||
(setf data (cadr data)))
|
||||
(setq data (assq key (cdr data))))))
|
||||
data)
|
||||
|
||||
(defun ghub--graphql-narrow-query (query lineage cursor)
|
||||
(if (consp (car lineage))
|
||||
(let* ((child (cddr query))
|
||||
(alist (cl-coerce (cadr query) 'list))
|
||||
(single (cdr (assq :singular alist))))
|
||||
`(,(car single)
|
||||
,(vector (list (cadr single) (cdr (car lineage))))
|
||||
,@(if (cdr lineage)
|
||||
(ghub--graphql-narrow-query child (cdr lineage) cursor)
|
||||
child)))
|
||||
(let* ((child (or (assq (car lineage) (cdr query))
|
||||
(cl-find-if (lambda (c)
|
||||
(and (listp c)
|
||||
(vectorp (cadr c))
|
||||
(eq (cadr (assq :singular
|
||||
(cl-coerce (cadr c)
|
||||
'list)))
|
||||
(car lineage))))
|
||||
(cdr query))))
|
||||
(object (car query))
|
||||
(args (and (vectorp (cadr query))
|
||||
(cadr query))))
|
||||
`(,object
|
||||
,@(and args (list args))
|
||||
,(cond ((cdr lineage)
|
||||
(ghub--graphql-narrow-query child (cdr lineage) cursor))
|
||||
(cursor
|
||||
`(,(car child)
|
||||
,(vconcat `((after ,cursor))
|
||||
(cadr child))
|
||||
,@(cddr child)))
|
||||
(t
|
||||
child))))))
|
||||
|
||||
(defun ghub--graphql-encode (g)
|
||||
(if (symbolp g)
|
||||
(symbol-name g)
|
||||
(let* ((object (car g))
|
||||
(args (and (vectorp (cadr g))
|
||||
(cl-coerce (cadr g) 'list)))
|
||||
(fields (if args (cddr g) (cdr g))))
|
||||
(concat
|
||||
(graphql--encode-object object)
|
||||
(and args
|
||||
(format " (\n%s)"
|
||||
(mapconcat (pcase-lambda (`(,key ,val))
|
||||
(graphql--encode-argument key val))
|
||||
args ",\n")))
|
||||
(and fields
|
||||
(format " {\n%s\n}"
|
||||
(mapconcat #'ghub--graphql-encode fields "\n")))))))
|
||||
|
||||
(defun ghub--alist-zip (root)
|
||||
(let ((branchp (lambda (elt) (and (listp elt) (listp (cdr elt)))))
|
||||
(make-node (lambda (_ children) children)))
|
||||
(treepy-zipper branchp #'identity make-node root)))
|
||||
|
||||
;;; _
|
||||
(provide 'ghub-graphql)
|
||||
;;; ghub-graphql.el ends here
|
Binary file not shown.
|
@ -0,0 +1,9 @@
|
|||
(define-package "ghub" "20180924.713" "Minuscule client libraries for Git forge APIs."
|
||||
'((emacs "24.4")
|
||||
(dash "2.14.1")
|
||||
(graphql "0.1")
|
||||
(let-alist "1.0.5")
|
||||
(treepy "0.1.0")))
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
|
@ -0,0 +1,929 @@
|
|||
;;; ghub.el --- minuscule client libraries for Git forge APIs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Ghub provides basic support for using the APIs of various Git forges
|
||||
;; from Emacs packages. Originally it only supported the Github REST
|
||||
;; API, but now it also supports the Github GraphQL API as well as the
|
||||
;; REST APIs of Gitlab, Gitea, Gogs and Bitbucket.
|
||||
|
||||
;; Ghub abstracts access to API resources using only a handful of basic
|
||||
;; functions such as `ghub-get'. These are convenience wrappers around
|
||||
;; `ghub-request'. Additional forge-specific wrappers like `glab-put',
|
||||
;; `gtea-put', `gogs-post' and `buck-delete' are also available. Ghub
|
||||
;; does not provide any resource-specific functions, with the exception
|
||||
;; of `FORGE-repository-id'.
|
||||
|
||||
;; When accessing Github, then Ghub handles the creation and storage of
|
||||
;; access tokens using a setup wizard to make it easier for users to get
|
||||
;; started. The tokens for other forges have to be created manually.
|
||||
|
||||
;; Ghub is intentionally limited to only provide these two essential
|
||||
;; features — basic request functions and guided setup — to avoid being
|
||||
;; too opinionated, which would hinder wide adoption. It is assumed that
|
||||
;; wide adoption would make life easier for users and maintainers alike,
|
||||
;; because then all packages that talk to forge APIs could be configured
|
||||
;; the same way.
|
||||
|
||||
;; Please consult the manual (info "ghub") for more information.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'auth-source)
|
||||
(require 'cl-lib)
|
||||
(require 'json)
|
||||
(require 'let-alist)
|
||||
(require 'url)
|
||||
(require 'url-auth)
|
||||
(require 'url-http)
|
||||
|
||||
(eval-when-compile (require 'subr-x))
|
||||
|
||||
(defvar url-callback-arguments)
|
||||
(defvar url-http-end-of-headers)
|
||||
(defvar url-http-extra-headers)
|
||||
(defvar url-http-response-status)
|
||||
|
||||
;;; Settings
|
||||
|
||||
(defconst ghub-default-host "api.github.com"
|
||||
"The default host that is used if `ghub.host' is not set.")
|
||||
|
||||
(defvar ghub-github-token-scopes '(repo)
|
||||
"The Github API scopes that your private tools need.
|
||||
|
||||
The token that is created based on the value of this variable
|
||||
is used when `ghub-request' (or one of its wrappers) is called
|
||||
without providing a value for AUTH. Packages should always
|
||||
identify themselves using that argument, but when you use Ghub
|
||||
directly in private tools, then that is not necessary and the
|
||||
request is made on behalf of the `ghub' package itself, aka on
|
||||
behalf of some private tool.
|
||||
|
||||
By default the only requested scope is `repo' because that is
|
||||
sufficient as well as required for most common uses. This and
|
||||
other scopes are documented at URL `https://magit.vc/goto/2e586d36'.
|
||||
|
||||
If your private tools need other scopes, then you have to add
|
||||
them here *before* creating the token. Alternatively you can
|
||||
edit the scopes of an existing token using the web interface
|
||||
at URL `https://github.com/settings/tokens'.")
|
||||
|
||||
(defvar ghub-override-system-name nil
|
||||
"If non-nil, the string used to identify the local machine.
|
||||
If this is nil, then the value returned by `system-name' is
|
||||
used instead.")
|
||||
|
||||
;;; Request
|
||||
;;;; Object
|
||||
|
||||
(cl-defstruct (ghub--req
|
||||
(:constructor ghub--make-req)
|
||||
(:copier nil))
|
||||
(url nil :read-only nil)
|
||||
(forge nil :read-only t)
|
||||
(silent nil :read-only t)
|
||||
(method nil :read-only t)
|
||||
(headers nil :read-only t)
|
||||
(handler nil :read-only t)
|
||||
(unpaginate nil :read-only nil)
|
||||
(noerror nil :read-only t)
|
||||
(reader nil :read-only t)
|
||||
(callback nil :read-only t)
|
||||
(errorback nil :read-only t)
|
||||
(value nil :read-only nil)
|
||||
(extra nil :read-only nil))
|
||||
|
||||
(defalias 'ghub-req-extra 'ghub--req-extra)
|
||||
|
||||
;;;; API
|
||||
|
||||
(define-error 'ghub-error "Ghub/Url Error" 'error)
|
||||
(define-error 'ghub-http-error "HTTP Error" 'ghub-error)
|
||||
|
||||
(defvar ghub-response-headers nil
|
||||
"The headers returned in response to the last request.
|
||||
`ghub-request' returns the response body and stores the
|
||||
response headers in this variable.")
|
||||
|
||||
(cl-defun ghub-head (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `HEAD' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"HEAD\" as METHOD."
|
||||
(ghub-request "HEAD" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-get (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `GET' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"GET\" as METHOD."
|
||||
(ghub-request "GET" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-put (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PUT' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PUT\" as METHOD."
|
||||
(ghub-request "PUT" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-post (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `POST' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"POST\" as METHOD."
|
||||
(ghub-request "POST" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-patch (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PATCH\" as METHOD."
|
||||
(ghub-request "PATCH" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-delete (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"DELETE\" as METHOD."
|
||||
(ghub-request "DELETE" resource params
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun ghub-request (method resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host forge
|
||||
callback errorback value extra)
|
||||
"Make a request for RESOURCE and return the response body.
|
||||
|
||||
Also place the response header in `ghub-response-headers'.
|
||||
|
||||
METHOD is the HTTP method, given as a string.
|
||||
RESOURCE is the resource to access, given as a string beginning
|
||||
with a slash.
|
||||
|
||||
PARAMS, QUERY, PAYLOAD and HEADERS are alists used to specify
|
||||
data. The Github API documentation is vague on how data has
|
||||
to be transmitted and for a particular resource usually just
|
||||
talks about \"parameters\". Generally speaking when the METHOD
|
||||
is \"HEAD\" or \"GET\", then they have to be transmitted as a
|
||||
query, otherwise as a payload.
|
||||
Use PARAMS to automatically transmit like QUERY or PAYLOAD would
|
||||
depending on METHOD.
|
||||
Use QUERY to explicitly transmit data as a query.
|
||||
Use PAYLOAD to explicitly transmit data as a payload.
|
||||
Instead of an alist, PAYLOAD may also be a string, in which
|
||||
case it gets encoded as UTF-8 but is otherwise transmitted as-is.
|
||||
Use HEADERS for those rare resources that require that the data
|
||||
is transmitted as headers instead of as a query or payload.
|
||||
When that is the case, then the API documentation usually
|
||||
mentions it explicitly.
|
||||
|
||||
If SILENT is non-nil, then don't message progress reports and
|
||||
the like.
|
||||
|
||||
If UNPAGINATE is t, then make as many requests as necessary to
|
||||
get all values. If UNPAGINATE is a natural number, then get
|
||||
at most that many pages. For any other non-nil value raise
|
||||
an error.
|
||||
If NOERROR is non-nil, then do not raise an error if the request
|
||||
fails and return nil instead. If NOERROR is `return', then
|
||||
return the error payload instead of nil.
|
||||
If READER is non-nil, then it is used to read and return from the
|
||||
response buffer. The default is `ghub--read-json-payload'.
|
||||
For the very few resources that do not return JSON, you might
|
||||
want to use `ghub--decode-payload'.
|
||||
|
||||
If USERNAME is non-nil, then make a request on behalf of that
|
||||
user. It is better to specify the user using the Git variable
|
||||
`github.user' for \"api.github.com\", or `github.HOST.user' if
|
||||
connecting to a Github Enterprise instance.
|
||||
|
||||
Each package that uses `ghub' should use its own token. If AUTH
|
||||
is nil, then the generic `ghub' token is used instead. This
|
||||
is only acceptable for personal utilities. A packages that
|
||||
is distributed to other users should always use this argument
|
||||
to identify itself, using a symbol matching its name.
|
||||
|
||||
Package authors who find this inconvenient should write a
|
||||
wrapper around this function and possibly for the
|
||||
method-specific functions as well.
|
||||
|
||||
Some symbols have a special meaning. `none' means to make an
|
||||
unauthorized request. `basic' means to make a password based
|
||||
request. If the value is a string, then it is assumed to be
|
||||
a valid token. `basic' and an explicit token string are only
|
||||
intended for internal and debugging uses.
|
||||
|
||||
If AUTH is a package symbol, then the scopes are specified
|
||||
using the variable `AUTH-github-token-scopes'. It is an error
|
||||
if that is not specified. See `ghub-github-token-scopes' for
|
||||
an example.
|
||||
|
||||
If HOST is non-nil, then connect to that Github instance. This
|
||||
defaults to \"api.github.com\". When a repository is connected
|
||||
to a Github Enterprise instance, then it is better to specify
|
||||
that using the Git variable `github.host' instead of using this
|
||||
argument.
|
||||
|
||||
If FORGE is `gitlab', then connect to Gitlab.com or, depending
|
||||
on HOST, to another Gitlab instance. This is only intended for
|
||||
internal use. Instead of using this argument you should use
|
||||
function `glab-request' and other `glab-*' functions.
|
||||
|
||||
If CALLBACK and/or ERRORBACK is non-nil, then make one or more
|
||||
asynchronous requests and call CALLBACK or ERRORBACK when
|
||||
finished. If an error occurred, then call ERRORBACK, or if
|
||||
that is nil, then CALLBACK. When no error occurred then call
|
||||
CALLBACK. When making asynchronous requests, then no errors
|
||||
are signaled, regardless of the value of NOERROR.
|
||||
|
||||
Both callbacks are called with four arguments.
|
||||
1. For CALLBACK, the combined value of the retrieved pages.
|
||||
For ERRORBACK, the error that occured when retrieving the
|
||||
last page.
|
||||
2. The headers of the last page as an alist.
|
||||
3. Status information provided by `url-retrieve'. Its `:error'
|
||||
property holds the same information as ERRORBACK's first
|
||||
argument.
|
||||
4. A `ghub--req' struct, which can be passed to `ghub-continue'
|
||||
(which see) to retrieve the next page, if any."
|
||||
(cl-assert (or (booleanp unpaginate) (natnump unpaginate)))
|
||||
(unless (string-prefix-p "/" resource)
|
||||
(setq resource (concat "/" resource)))
|
||||
(unless host
|
||||
(setq host (ghub--host forge)))
|
||||
(unless (or username (stringp auth) (eq auth 'none))
|
||||
(setq username (ghub--username host forge)))
|
||||
(cond ((not params))
|
||||
((member method '("GET" "HEAD"))
|
||||
(when query
|
||||
(error "PARAMS and QUERY are mutually exclusive for METHOD %S"
|
||||
method))
|
||||
(setq query params))
|
||||
(t
|
||||
(when payload
|
||||
(error "PARAMS and PAYLOAD are mutually exclusive for METHOD %S"
|
||||
method))
|
||||
(setq payload params)))
|
||||
(when (or callback errorback)
|
||||
(setq noerror t))
|
||||
(ghub--retrieve
|
||||
(ghub--encode-payload payload)
|
||||
(ghub--make-req
|
||||
:url (url-generic-parse-url
|
||||
(concat "https://" host resource
|
||||
(and query (concat "?" (ghub--url-encode-params query)))))
|
||||
:forge forge
|
||||
:silent silent
|
||||
;; Encode in case caller used (symbol-name 'GET). #35
|
||||
:method (encode-coding-string method 'utf-8)
|
||||
:headers (ghub--headers headers host auth username forge)
|
||||
:handler 'ghub--handle-response
|
||||
:unpaginate unpaginate
|
||||
:noerror noerror
|
||||
:reader reader
|
||||
:callback callback
|
||||
:errorback errorback
|
||||
:value value
|
||||
:extra extra)))
|
||||
|
||||
(defun ghub-continue (req)
|
||||
"If there is a next page, then retrieve that.
|
||||
|
||||
This function is only intended to be called from callbacks. If
|
||||
there is a next page, then retrieve that and return the buffer
|
||||
that the result will be loaded into, or t if the process has
|
||||
already completed. If there is no next page, then return nil.
|
||||
|
||||
Callbacks are called with four arguments (see `ghub-request').
|
||||
The forth argument is a `ghub--req' struct, intended to be passed
|
||||
to this function. A callback may use the struct's `extra' slot
|
||||
to pass additional information to the callback that will be
|
||||
called after the next request has finished. Use the function
|
||||
`ghub-req-extra' to get and set the value of this slot."
|
||||
(and (assq 'next (ghub-response-link-relations req))
|
||||
(or (ghub--retrieve nil req) t)))
|
||||
|
||||
(cl-defun ghub-wait (resource &optional duration &key username auth host)
|
||||
"Busy-wait up to DURATION seconds for RESOURCE to become available.
|
||||
|
||||
DURATION specifies how many seconds to wait at most. It defaults
|
||||
to 64 seconds. The first attempt is made immediately, the second
|
||||
after two seconds, and each subsequent attempt is made after
|
||||
waiting as long again as we already waited between all preceding
|
||||
attempts combined.
|
||||
|
||||
See `ghub-request' for information about the other arguments."
|
||||
(unless duration
|
||||
(setq duration 64))
|
||||
(with-local-quit
|
||||
(let ((total 0))
|
||||
(while (not (ghub-get resource nil
|
||||
:noerror t
|
||||
:username username
|
||||
:auth auth
|
||||
:host host))
|
||||
(message "Waited (%3ss of %ss) for %s..." total duration resource)
|
||||
(if (= total duration)
|
||||
(error "Github is taking too long to create %s" resource)
|
||||
(if (> total 0)
|
||||
(let ((wait (min total (- duration total))))
|
||||
(sit-for wait)
|
||||
(cl-incf total wait))
|
||||
(sit-for (setq total 2))))))))
|
||||
|
||||
(defun ghub-response-link-relations (req &optional headers payload)
|
||||
"Return an alist of link relations in HEADERS.
|
||||
If optional HEADERS is nil, then return those that were
|
||||
previously stored in the variable `ghub-response-headers'.
|
||||
|
||||
When accessing a Bitbucket instance then the link relations
|
||||
are in PAYLOAD instead of HEADERS, making their API merely
|
||||
RESTish and forcing this function to append those relations
|
||||
to the value of `ghub-response-headers', for later use when
|
||||
this function is called with nil for PAYLOAD."
|
||||
(if (eq (ghub--req-forge req) 'bitbucket)
|
||||
(if payload
|
||||
(let* ((page (cl-mapcan (lambda (key)
|
||||
(when-let ((elt (assq key payload)))
|
||||
(list elt)))
|
||||
'(size page pagelen next previous)))
|
||||
(headers (cons (cons 'link-alist page) headers)))
|
||||
(if (and req (or (ghub--req-callback req)
|
||||
(ghub--req-errorback req)))
|
||||
(setq-local ghub-response-headers headers)
|
||||
(setq-default ghub-response-headers headers))
|
||||
page)
|
||||
(cdr (assq 'link-alist ghub-response-headers)))
|
||||
(when-let ((rels (cdr (assoc "Link" (or headers ghub-response-headers)))))
|
||||
(mapcar (lambda (elt)
|
||||
(pcase-let ((`(,url ,rel) (split-string elt "; ")))
|
||||
(cons (intern (substring rel 5 -1))
|
||||
(substring url 1 -1))))
|
||||
(split-string rels ", ")))))
|
||||
|
||||
(cl-defun ghub-repository-id (owner name &key username auth host forge)
|
||||
"Return the id of the specified repository."
|
||||
(let ((fn (intern (format "%s-repository-id" (or forge 'ghub)))))
|
||||
(funcall (if (eq fn 'ghub-repository-id) 'ghub--repository-id fn)
|
||||
owner name :username username :auth auth :host host)))
|
||||
|
||||
;;;; Internal
|
||||
|
||||
(cl-defun ghub--retrieve (payload req)
|
||||
(let ((url-request-extra-headers
|
||||
(let ((headers (ghub--req-headers req)))
|
||||
(if (functionp headers) (funcall headers) headers)))
|
||||
(url-request-method (ghub--req-method req))
|
||||
(url-request-data payload)
|
||||
(url-show-status nil)
|
||||
(url (ghub--req-url req))
|
||||
(handler (ghub--req-handler req))
|
||||
(silent (ghub--req-silent req)))
|
||||
(if (or (ghub--req-callback req)
|
||||
(ghub--req-errorback req))
|
||||
(url-retrieve url handler (list req) silent)
|
||||
;; When this function has already been called, then it is a
|
||||
;; no-op. Otherwise it sets `url-registered-auth-schemes' among
|
||||
;; other things. If we didn't ensure that it has been run, then
|
||||
;; `url-retrieve-synchronously' would do it, which would cause
|
||||
;; the value that we let-bind below to be overwritten, and the
|
||||
;; "default" value to be lost outside the let-binding.
|
||||
(url-do-setup)
|
||||
(with-current-buffer
|
||||
(let ((url-registered-auth-schemes
|
||||
'(("basic" ghub--basic-auth-errorback . 10))))
|
||||
(url-retrieve-synchronously url silent))
|
||||
(funcall handler (car url-callback-arguments) req)))))
|
||||
|
||||
(defun ghub--handle-response (status req)
|
||||
(let ((buffer (current-buffer)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-buffer-multibyte t)
|
||||
(let* ((unpaginate (ghub--req-unpaginate req))
|
||||
(headers (ghub--handle-response-headers status req))
|
||||
(payload (ghub--handle-response-payload req))
|
||||
(payload (ghub--handle-response-error status payload req))
|
||||
(value (ghub--handle-response-value payload req))
|
||||
(next (cdr (assq 'next (ghub-response-link-relations
|
||||
req headers payload)))))
|
||||
(when (numberp unpaginate)
|
||||
(cl-decf unpaginate))
|
||||
(setf (ghub--req-url req)
|
||||
(url-generic-parse-url next))
|
||||
(setf (ghub--req-unpaginate req) unpaginate)
|
||||
(or (and next
|
||||
unpaginate
|
||||
(or (eq unpaginate t)
|
||||
(> unpaginate 0))
|
||||
(ghub-continue req))
|
||||
(let ((callback (ghub--req-callback req))
|
||||
(errorback (ghub--req-errorback req))
|
||||
(err (plist-get status :error)))
|
||||
(cond ((and err errorback)
|
||||
(funcall errorback err headers status req))
|
||||
(callback
|
||||
(funcall callback value headers status req))
|
||||
(t value))))))
|
||||
(when (buffer-live-p buffer)
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(defun ghub--handle-response-headers (status req)
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(let (headers)
|
||||
(while (re-search-forward "^\\([^:]*\\): \\(.+\\)"
|
||||
url-http-end-of-headers t)
|
||||
(push (cons (match-string 1)
|
||||
(match-string 2))
|
||||
headers))
|
||||
(setq headers (nreverse headers))
|
||||
(unless url-http-end-of-headers
|
||||
(error "BUG: missing headers %s" (plist-get status :error)))
|
||||
(goto-char (1+ url-http-end-of-headers))
|
||||
(if (and req (or (ghub--req-callback req)
|
||||
(ghub--req-errorback req)))
|
||||
(setq-local ghub-response-headers headers)
|
||||
(setq-default ghub-response-headers headers))
|
||||
headers))
|
||||
|
||||
(defun ghub--handle-response-error (status payload req)
|
||||
(let ((noerror (ghub--req-noerror req))
|
||||
(err (plist-get status :error)))
|
||||
(if err
|
||||
(if noerror
|
||||
(if (eq noerror 'return)
|
||||
payload
|
||||
(setcdr (last err) (list payload))
|
||||
nil)
|
||||
(ghub--signal-error err payload))
|
||||
payload)))
|
||||
|
||||
(defun ghub--signal-error (err &optional payload)
|
||||
(pcase-let ((`(,symb . ,data) err))
|
||||
(if (eq symb 'error)
|
||||
(if (eq (car-safe data) 'http)
|
||||
(signal 'ghub-http-error
|
||||
(let ((code (car (cdr-safe data))))
|
||||
(list code
|
||||
(nth 2 (assq code url-http-codes))
|
||||
payload)))
|
||||
(signal 'ghub-error data))
|
||||
(signal symb data))))
|
||||
|
||||
(defun ghub--handle-response-value (payload req)
|
||||
(setf (ghub--req-value req)
|
||||
(nconc (ghub--req-value req)
|
||||
(if-let ((nested (and (eq (ghub--req-forge req) 'bitbucket)
|
||||
(assq 'values payload))))
|
||||
(cdr nested)
|
||||
payload))))
|
||||
|
||||
(defun ghub--handle-response-payload (req)
|
||||
(funcall (or (ghub--req-reader req)
|
||||
'ghub--read-json-payload)
|
||||
url-http-response-status))
|
||||
|
||||
(defun ghub--read-json-payload (_status)
|
||||
(let ((raw (ghub--decode-payload)))
|
||||
(and raw
|
||||
(condition-case nil
|
||||
(let ((json-object-type 'alist)
|
||||
(json-array-type 'list)
|
||||
(json-key-type 'symbol)
|
||||
(json-false nil)
|
||||
(json-null nil))
|
||||
(json-read-from-string raw))
|
||||
(json-readtable-error
|
||||
`((message
|
||||
. ,(if (looking-at "<!DOCTYPE html>")
|
||||
(if (re-search-forward
|
||||
"<p>\\(?:<strong>\\)?\\([^<]+\\)" nil t)
|
||||
(match-string 1)
|
||||
"error description missing")
|
||||
(string-trim (buffer-substring (point) (point-max)))))
|
||||
(documentation_url
|
||||
. "https://github.com/magit/ghub/wiki/Github-Errors")))))))
|
||||
|
||||
(defun ghub--decode-payload (&optional _status)
|
||||
(and (not (eobp))
|
||||
(decode-coding-string
|
||||
(buffer-substring-no-properties (point) (point-max))
|
||||
'utf-8)))
|
||||
|
||||
(defun ghub--encode-payload (payload)
|
||||
(and payload
|
||||
(progn
|
||||
(unless (stringp payload)
|
||||
(setq payload (json-encode-list payload)))
|
||||
(encode-coding-string payload 'utf-8))))
|
||||
|
||||
(defun ghub--url-encode-params (params)
|
||||
(mapconcat (lambda (param)
|
||||
(pcase-let ((`(,key . ,val) param))
|
||||
(concat (url-hexify-string (symbol-name key)) "="
|
||||
(if (integerp val)
|
||||
(number-to-string val)
|
||||
(url-hexify-string val)))))
|
||||
params "&"))
|
||||
|
||||
;;; Authentication
|
||||
;;;; API
|
||||
|
||||
;;;###autoload
|
||||
(defun ghub-create-token (host username package scopes)
|
||||
"Create, store and return a new token.
|
||||
|
||||
HOST is the Github instance, usually \"api.github.com\".
|
||||
USERNAME is the name of a user on that instance.
|
||||
PACKAGE is the package that will use the token.
|
||||
SCOPES are the scopes the token is given access to."
|
||||
(interactive
|
||||
(pcase-let ((`(,host ,username ,package)
|
||||
(ghub--read-triplet)))
|
||||
(list host username package
|
||||
(split-string
|
||||
(read-string
|
||||
"Scopes (separated by commas): "
|
||||
(mapconcat #'symbol-name
|
||||
(symbol-value
|
||||
(intern (format "%s-github-token-scopes" package)))
|
||||
","))
|
||||
"," t "[\s\t]+"))))
|
||||
(let ((user (ghub--ident username package)))
|
||||
(cl-destructuring-bind (save token)
|
||||
(ghub--auth-source-get (list :save-function :secret)
|
||||
:create t :host host :user user
|
||||
:secret
|
||||
(cdr (assq 'token
|
||||
(ghub-post
|
||||
"/authorizations"
|
||||
`((scopes . ,scopes)
|
||||
(note . ,(ghub--ident-github package)))
|
||||
:username username :auth 'basic :host host))))
|
||||
;; Build-in back-ends return a function that does the actual
|
||||
;; saving, while for some third-party back-ends ":create t"
|
||||
;; is enough.
|
||||
(when (functionp save)
|
||||
(funcall save))
|
||||
;; If the Auth-Source cache contains the information that there
|
||||
;; is no value, then setting the value does not invalidate that
|
||||
;; now incorrect information.
|
||||
(auth-source-forget (list :host host :user user))
|
||||
token)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ghub-token-scopes (host username package)
|
||||
"Return and echo the scopes of the specified token.
|
||||
This is intended for debugging purposes only. The user
|
||||
has to provide several values including their password."
|
||||
(interactive (ghub--read-triplet))
|
||||
(let ((scopes
|
||||
(cdr (assq 'scopes (ghub--get-token-plist host username package)))))
|
||||
(when (called-interactively-p 'any)
|
||||
;; Also show the input values to make it easy for package
|
||||
;; authors to verify that the user has done it correctly.
|
||||
(message "Scopes for %s@%s: %S"
|
||||
(ghub--ident username package)
|
||||
host scopes))
|
||||
scopes))
|
||||
|
||||
;;;###autoload
|
||||
(defun ghub-clear-caches ()
|
||||
"Clear all caches that might negatively affect Ghub.
|
||||
|
||||
If a library that is used by Ghub caches incorrect information
|
||||
such as a mistyped password, then that can prevent Ghub from
|
||||
asking the user for the correct information again.
|
||||
|
||||
Set `url-http-real-basic-auth-storage' to nil
|
||||
and call `auth-source-forget+'."
|
||||
(interactive)
|
||||
(setq url-http-real-basic-auth-storage nil)
|
||||
(auth-source-forget+))
|
||||
|
||||
;;;; Internal
|
||||
|
||||
(defun ghub--headers (headers host auth username forge)
|
||||
(push (cons "Content-Type" "application/json") headers)
|
||||
(if (eq auth 'none)
|
||||
headers
|
||||
(unless (or username (stringp auth))
|
||||
(setq username (ghub--username host forge)))
|
||||
(lambda ()
|
||||
(if (eq auth 'basic)
|
||||
(cons (cons "Authorization" (ghub--basic-auth host username))
|
||||
headers)
|
||||
(cons (ghub--auth host auth username forge) headers)))))
|
||||
|
||||
(defun ghub--auth (host auth &optional username forge)
|
||||
(unless username
|
||||
(setq username (ghub--username host)))
|
||||
(if (eq auth 'basic)
|
||||
(cl-ecase forge
|
||||
((nil github gitea gogs bitbucket)
|
||||
(cons "Authorization" (ghub--basic-auth host username)))
|
||||
(gitlab
|
||||
(error "Gitlab does not support basic authentication")))
|
||||
(cons (cl-ecase forge
|
||||
((nil github gitea gogs bitbucket)
|
||||
"Authorization")
|
||||
(gitlab
|
||||
"Private-Token"))
|
||||
(concat
|
||||
(and (not (eq forge 'gitlab)) "token ")
|
||||
(encode-coding-string
|
||||
(cl-typecase auth
|
||||
(string auth)
|
||||
(null (ghub--token host username 'ghub nil forge))
|
||||
(symbol (ghub--token host username auth nil forge))
|
||||
(t (signal 'wrong-type-argument
|
||||
`((or stringp symbolp) ,auth))))
|
||||
'utf-8)))))
|
||||
|
||||
(defun ghub--basic-auth (host username)
|
||||
(let ((url (url-generic-parse-url (concat "https://" host))))
|
||||
(setf (url-user url) username)
|
||||
(url-basic-auth url t)))
|
||||
|
||||
(defun ghub--basic-auth-errorback (url &optional prompt _overwrite _realm _args)
|
||||
;; This gets called twice. Do nothing the first time,
|
||||
;; when PROMPT is nil. See `url-get-authentication'.
|
||||
(when prompt
|
||||
(if (assoc "X-GitHub-OTP" (ghub--handle-response-headers nil nil))
|
||||
(progn
|
||||
(setq url-http-extra-headers
|
||||
`(("Content-Type" . "application/json")
|
||||
("X-GitHub-OTP" . ,(ghub--read-2fa-code))
|
||||
;; Without "Content-Type" and "Authorization".
|
||||
;; The latter gets re-added from the return value.
|
||||
,@(cddr url-http-extra-headers)))
|
||||
;; Return the cached values, they are correct.
|
||||
(url-basic-auth url nil nil nil))
|
||||
;; Remove the invalid cached values and fail, which
|
||||
;; is better than the invalid values sticking around.
|
||||
(setq url-http-real-basic-auth-storage
|
||||
(cl-delete (format "%s:%d" (url-host url) (url-port url))
|
||||
url-http-real-basic-auth-storage
|
||||
:test #'equal :key #'car))
|
||||
nil)))
|
||||
|
||||
(defun ghub--token (host username package &optional nocreate forge)
|
||||
(let* ((user (ghub--ident username package))
|
||||
(token
|
||||
(or (car (ghub--auth-source-get (list :secret)
|
||||
:host host :user user))
|
||||
(progn
|
||||
;; Auth-Source caches the information that there is no
|
||||
;; value, but in our case that is a situation that needs
|
||||
;; fixing so we want to keep trying by invalidating that
|
||||
;; information.
|
||||
;; The (:max 1) is needed and has to be placed at the
|
||||
;; end for Emacs releases before 26.1. See #24, #64.
|
||||
(auth-source-forget (list :host host :user user :max 1))
|
||||
(and (not nocreate)
|
||||
(cl-ecase forge
|
||||
((nil github)
|
||||
(ghub--confirm-create-token host username package))
|
||||
((gitlab gitea gogs bitbucket)
|
||||
(error "Required %s token (%S for %S) does not exist.
|
||||
See https://magit.vc/manual/ghub/Support-for-Other-Forges.html for instructions."
|
||||
(capitalize (symbol-name forge))
|
||||
user host))))))))
|
||||
(if (functionp token) (funcall token) token)))
|
||||
|
||||
(defun ghub--host (&optional forge)
|
||||
(cl-ecase forge
|
||||
((nil github)
|
||||
(or (ignore-errors (car (process-lines "git" "config" "github.host")))
|
||||
ghub-default-host))
|
||||
(gitlab
|
||||
(or (ignore-errors (car (process-lines "git" "config" "gitlab.host")))
|
||||
(bound-and-true-p glab-default-host)))
|
||||
(gitea
|
||||
(or (ignore-errors (car (process-lines "git" "config" "gitea.host")))
|
||||
(bound-and-true-p gtea-default-host)))
|
||||
(gogs
|
||||
(or (ignore-errors (car (process-lines "git" "config" "gogs.host")))
|
||||
(bound-and-true-p gogs-default-host)))
|
||||
(bitbucket
|
||||
(or (ignore-errors (car (process-lines "git" "config" "bitbucket.host")))
|
||||
(bound-and-true-p buck-default-host)))))
|
||||
|
||||
(defun ghub--username (host &optional forge)
|
||||
(let ((var
|
||||
(cl-ecase forge
|
||||
((nil github)
|
||||
(if (equal host ghub-default-host)
|
||||
"github.user"
|
||||
(format "github.%s.user" host)))
|
||||
(gitlab
|
||||
(if (equal host "gitlab.com/api/v4")
|
||||
"gitlab.user"
|
||||
(format "gitlab.%s.user" host)))
|
||||
(bitbucket
|
||||
(if (equal host "api.bitbucket.org/2.0")
|
||||
"bitbucket.user"
|
||||
(format "bitbucket.%s.user" host)))
|
||||
(gitea
|
||||
(when (zerop (call-process "git" nil nil nil "config" "gitea.host"))
|
||||
(error "gitea.host is set but always ignored"))
|
||||
(format "gitea.%s.user" host))
|
||||
(gogs
|
||||
(when (zerop (call-process "git" nil nil nil "config" "gogs.host"))
|
||||
(error "gogs.host is set but always ignored"))
|
||||
(format "gogs.%s.user" host)))))
|
||||
(condition-case nil
|
||||
(car (process-lines "git" "config" var))
|
||||
(error
|
||||
(let ((user (read-string
|
||||
(format "Git variable `%s' is unset. Set to: " var))))
|
||||
(or (and user (progn (call-process "git" nil nil nil
|
||||
"config" "--global" var user)
|
||||
user))
|
||||
(user-error "Abort")))))))
|
||||
|
||||
(defun ghub--ident (username package)
|
||||
(format "%s^%s" username package))
|
||||
|
||||
(defun ghub--ident-github (package)
|
||||
(format "Emacs package %s @ %s"
|
||||
package
|
||||
(or ghub-override-system-name (system-name))))
|
||||
|
||||
(defun ghub--package-scopes (package)
|
||||
(let ((var (intern (format "%s-github-token-scopes" package))))
|
||||
(if (boundp var)
|
||||
(symbol-value var)
|
||||
(error "%s fails to define %s" package var))))
|
||||
|
||||
(defun ghub--confirm-create-token (host username package)
|
||||
(let* ((ident (ghub--ident-github package))
|
||||
(scopes (ghub--package-scopes package))
|
||||
(max-mini-window-height 40))
|
||||
(if (let ((message-log-max nil))
|
||||
(yes-or-no-p
|
||||
(format
|
||||
"Such a Github API token is not available:
|
||||
|
||||
Host: %s
|
||||
User: %s
|
||||
Package: %s
|
||||
|
||||
Scopes requested in `%s-github-token-scopes':\n%s
|
||||
Store on Github as:\n %S
|
||||
Store locally according to option `auth-sources':\n %S
|
||||
%s
|
||||
If in doubt, then abort and first view the section of the Ghub
|
||||
documentation called \"Manually Creating and Storing a Token\".
|
||||
|
||||
Otherwise confirm and then provide your Github username and
|
||||
password at the next two prompts. Depending on the backend
|
||||
you might have to provide a passphrase and confirm that you
|
||||
really want to save the token.
|
||||
|
||||
Create and store such a token? "
|
||||
host username package package
|
||||
(mapconcat (lambda (scope) (format " %s" scope)) scopes "\n")
|
||||
ident auth-sources
|
||||
(if (and (stringp (car auth-sources))
|
||||
(not (string-suffix-p ".gpg" (car auth-sources))))
|
||||
(format "
|
||||
WARNING: The token will be stored unencrypted in %S.
|
||||
If you don't want that, you have to abort and customize
|
||||
the `auth-sources' option.\n" (car auth-sources))
|
||||
""))))
|
||||
(progn
|
||||
(when (ghub--get-token-id host username package)
|
||||
(if (yes-or-no-p
|
||||
(format
|
||||
"A token named %S\nalready exists on Github. Replace it?"
|
||||
ident))
|
||||
(ghub--delete-token host username package)
|
||||
(user-error "Abort")))
|
||||
(ghub-create-token host username package scopes))
|
||||
(user-error "Abort"))))
|
||||
|
||||
(defun ghub--get-token-id (host username package)
|
||||
(let ((ident (ghub--ident-github package)))
|
||||
(cl-some (lambda (x)
|
||||
(let-alist x
|
||||
(and (equal .app.name ident) .id)))
|
||||
(ghub-get "/authorizations"
|
||||
'((per_page . 100))
|
||||
:unpaginate t
|
||||
:username username :auth 'basic :host host))))
|
||||
|
||||
(defun ghub--get-token-plist (host username package)
|
||||
(ghub-get (format "/authorizations/%s"
|
||||
(ghub--get-token-id host username package))
|
||||
nil :username username :auth 'basic :host host))
|
||||
|
||||
(defun ghub--delete-token (host username package)
|
||||
(ghub-delete (format "/authorizations/%s"
|
||||
(ghub--get-token-id host username package))
|
||||
nil :username username :auth 'basic :host host))
|
||||
|
||||
(defun ghub--read-triplet ()
|
||||
(let ((host (read-string "Host: " (ghub--host))))
|
||||
(list host
|
||||
(read-string "Username: " (ghub--username host))
|
||||
(intern (read-string "Package: " "ghub")))))
|
||||
|
||||
(defvar ghub--2fa-cache nil)
|
||||
|
||||
(defun ghub--read-2fa-code ()
|
||||
(let ((code (read-number "Two-factor authentication code: "
|
||||
(and ghub--2fa-cache
|
||||
(< (float-time (time-subtract
|
||||
(current-time)
|
||||
(cdr ghub--2fa-cache)))
|
||||
25)
|
||||
(car ghub--2fa-cache)))))
|
||||
(setq ghub--2fa-cache (cons code (current-time)))
|
||||
(number-to-string code)))
|
||||
|
||||
(defun ghub--auth-source-get (keys &rest spec)
|
||||
(declare (indent 1))
|
||||
(let ((plist (car (apply #'auth-source-search
|
||||
(append spec (list :max 1))))))
|
||||
(mapcar (lambda (k)
|
||||
(plist-get plist k))
|
||||
keys)))
|
||||
|
||||
(advice-add 'auth-source-netrc-parse-next-interesting :around
|
||||
'auth-source-netrc-parse-next-interesting@save-match-data)
|
||||
(defun auth-source-netrc-parse-next-interesting@save-match-data (fn)
|
||||
"Save match-data for the benefit of caller `auth-source-netrc-parse-one'.
|
||||
Without wrapping this function in `save-match-data' the caller
|
||||
won't see the secret from a line that is followed by a commented
|
||||
line."
|
||||
(save-match-data (funcall fn)))
|
||||
|
||||
;;; _
|
||||
(provide 'ghub)
|
||||
(require 'ghub-graphql)
|
||||
;;; ghub.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,153 @@
|
|||
;;; glab.el --- minuscule client library for the Gitlab API -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Glab is a library that provides basic support for using the Gitlab API
|
||||
;; from Emacs packages. It abstracts access to API resources using only
|
||||
;; a handful of functions that are not resource-specific.
|
||||
|
||||
;; This library is implemented on top of Ghub. Unlike Ghub, Glab does
|
||||
;; not support the guided creation of tokens because Gitlab lacks the
|
||||
;; features that would be necessary to implement that. Users have to
|
||||
;; create tokens through the web interface.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ghub)
|
||||
|
||||
(defconst glab-default-host "gitlab.com/api/v4"
|
||||
"The default host that is used if `glab.host' is not set.")
|
||||
|
||||
(cl-defun glab-head (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `HEAD' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"HEAD\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "HEAD" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-get (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `GET' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"GET\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "GET" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-put (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PUT' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PUT\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "PUT" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-post (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `POST' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"POST\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "POST" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-patch (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "PATCH" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-delete (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
|
||||
and `gitlab' as FORGE."
|
||||
(ghub-request "DELETE" resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-request (method resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a request for RESOURCE and return the response body.
|
||||
Like calling `ghub-request' (which see) with `gitlab' as FORGE."
|
||||
(ghub-request method resource params :forge 'gitlab
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun glab-repository-id (owner name &key username auth host)
|
||||
"Return the id of the repository specified by OWNER, NAME and HOST."
|
||||
(number-to-string
|
||||
(cdr (assq 'id (glab-get (format "/projects/%s%%2F%s" owner name)
|
||||
nil :username username :auth auth :host host)))))
|
||||
|
||||
;;; _
|
||||
(provide 'glab)
|
||||
;;; glab.el ends here
|
Binary file not shown.
|
@ -0,0 +1,140 @@
|
|||
;;; gogs.el --- minuscule client library for the Gogs API -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Gogs is a library that provides basic support for using the Gogs API
|
||||
;; from Emacs packages. It abstracts access to API resources using only
|
||||
;; a handful of functions that are not resource-specific.
|
||||
|
||||
;; This library is implemented on top of Ghub. Unlike Ghub, Gogs does
|
||||
;; not support the guided creation of tokens because Gogs lacks the
|
||||
;; features that would be necessary to implement that. Users have to
|
||||
;; create tokens through the web interface.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ghub)
|
||||
|
||||
(defconst gogs-default-host "localhost:3000/api/v1"
|
||||
"The default host that is used if `gogs.host' is not set.")
|
||||
|
||||
;; HEAD does not appear to be supported.
|
||||
|
||||
(cl-defun gogs-get (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `GET' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"GET\" as METHOD
|
||||
and `gogs' as FORGE."
|
||||
(ghub-request "GET" resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-put (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PUT' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PUT\" as METHOD
|
||||
and `gogs' as FORGE."
|
||||
(ghub-request "PUT" resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-post (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `POST' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"POST\" as METHOD
|
||||
and `gogs' as FORGE."
|
||||
(ghub-request "POST" resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-patch (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
|
||||
and `gogs' as FORGE."
|
||||
(ghub-request "PATCH" resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-delete (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
|
||||
and `gogs' as FORGE."
|
||||
(ghub-request "DELETE" resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-request (method resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a request for RESOURCE and return the response body.
|
||||
Like calling `ghub-request' (which see) with `gogs' as FORGE."
|
||||
(ghub-request method resource params :forge 'gogs
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gogs-repository-id (owner name &key username auth host)
|
||||
"Return the id of the repository specified by OWNER, NAME and HOST."
|
||||
(number-to-string
|
||||
(cdr (assq 'id (gogs-get (format "/repos/%s/%s" owner name)
|
||||
nil :username username :auth auth :host host)))))
|
||||
|
||||
;;; _
|
||||
(provide 'gogs)
|
||||
;;; gogs.el ends here
|
Binary file not shown.
|
@ -0,0 +1,140 @@
|
|||
;;; gtea.el --- minuscule client library for the Gitea API -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2018 Jonas Bernoulli
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Homepage: https://github.com/magit/ghub
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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.
|
||||
|
||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Gtea is a library that provides basic support for using the Gitea API
|
||||
;; from Emacs packages. It abstracts access to API resources using only
|
||||
;; a handful of functions that are not resource-specific.
|
||||
|
||||
;; This library is implemented on top of Ghub. Unlike Ghub, Gtea does
|
||||
;; not support the guided creation of tokens because Gitea lacks the
|
||||
;; features that would be necessary to implement that. Users have to
|
||||
;; create tokens through the web interface.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ghub)
|
||||
|
||||
(defconst gtea-default-host "localhost:3000/api/v1"
|
||||
"The default host that is used if `gtea.host' is not set.")
|
||||
|
||||
;; HEAD does not appear to be supported.
|
||||
|
||||
(cl-defun gtea-get (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `GET' request for RESOURCE, with optional query PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"GET\" as METHOD
|
||||
and `gitea' as FORGE."
|
||||
(ghub-request "GET" resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-put (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PUT' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PUT\" as METHOD
|
||||
and `gitea' as FORGE."
|
||||
(ghub-request "PUT" resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-post (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `POST' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"POST\" as METHOD
|
||||
and `gitea' as FORGE."
|
||||
(ghub-request "POST" resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-patch (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
|
||||
and `gitea' as FORGE."
|
||||
(ghub-request "PATCH" resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-delete (resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
|
||||
Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
|
||||
and `gitea' as FORGE."
|
||||
(ghub-request "DELETE" resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-request (method resource &optional params
|
||||
&key query payload headers
|
||||
silent unpaginate noerror reader
|
||||
username auth host
|
||||
callback errorback extra)
|
||||
"Make a request for RESOURCE and return the response body.
|
||||
Like calling `ghub-request' (which see) with `gitea' as FORGE."
|
||||
(ghub-request method resource params :forge 'gitea
|
||||
:query query :payload payload :headers headers
|
||||
:silent silent :unpaginate unpaginate
|
||||
:noerror noerror :reader reader
|
||||
:username username :auth auth :host host
|
||||
:callback callback :errorback errorback :extra extra))
|
||||
|
||||
(cl-defun gtea-repository-id (owner name &key username auth host)
|
||||
"Return the id of the repository specified by OWNER, NAME and HOST."
|
||||
(number-to-string
|
||||
(cdr (assq 'id (gtea-get (format "/repos/%s/%s" owner name)
|
||||
nil :username username :auth auth :host host)))))
|
||||
|
||||
;;; _
|
||||
(provide 'gtea)
|
||||
;;; gtea.el ends here
|
Binary file not shown.
|
@ -0,0 +1,48 @@
|
|||
;;; git-commit-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "git-commit" "git-commit.el" (23473 23424 423220
|
||||
;;;;;; 537000))
|
||||
;;; Generated autoloads from git-commit.el
|
||||
|
||||
(defvar global-git-commit-mode t "\
|
||||
Non-nil if Global Git-Commit mode is enabled.
|
||||
See the `global-git-commit-mode' command
|
||||
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-git-commit-mode'.")
|
||||
|
||||
(custom-autoload 'global-git-commit-mode "git-commit" nil)
|
||||
|
||||
(autoload 'global-git-commit-mode "git-commit" "\
|
||||
Edit Git commit messages.
|
||||
This global mode arranges for `git-commit-setup' to be called
|
||||
when a Git commit message file is opened. That usually happens
|
||||
when Git uses the Emacsclient as $GIT_EDITOR to have the user
|
||||
provide such a commit message.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(defconst git-commit-filename-regexp "/\\(\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'")
|
||||
|
||||
(autoload 'git-commit-setup-check-buffer "git-commit" "\
|
||||
|
||||
|
||||
\(fn)" nil nil)
|
||||
|
||||
(autoload 'git-commit-setup "git-commit" "\
|
||||
|
||||
|
||||
\(fn)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; git-commit-autoloads.el ends here
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "git-commit" "20180912.1012" "Edit Git commit messages" '((emacs "25.1") (dash "20180413") (with-editor "20180414")) :commit "a486819423bb7d28a36d52628016704fd9fb09d4" :keywords '("git" "tools" "vc") :maintainer '("Jonas Bernoulli" . "jonas@bernoul.li") :url "https://github.com/magit/magit")
|
|
@ -0,0 +1,900 @@
|
|||
;;; git-commit.el --- Edit Git commit messages -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Authors: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; Sebastian Wiesner <lunaryorn@gmail.com>
|
||||
;; Florian Ragwitz <rafl@debian.org>
|
||||
;; Marius Vollmer <marius.vollmer@gmail.com>
|
||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
|
||||
|
||||
;; Package-Requires: ((emacs "25.1") (dash "20180413") (with-editor "20180414"))
|
||||
;; Package-Version: 20180912.1012
|
||||
;; Keywords: git tools vc
|
||||
;; Homepage: https://github.com/magit/magit
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This package assists the user in writing good Git commit messages.
|
||||
|
||||
;; While Git allows for the message to be provided on the command
|
||||
;; line, it is preferable to tell Git to create the commit without
|
||||
;; actually passing it a message. Git then invokes the `$GIT_EDITOR'
|
||||
;; (or if that is undefined `$EDITOR') asking the user to provide the
|
||||
;; message by editing the file ".git/COMMIT_EDITMSG" (or another file
|
||||
;; in that directory, e.g. ".git/MERGE_MSG" for merge commits).
|
||||
|
||||
;; When `global-git-commit-mode' is enabled, which it is by default,
|
||||
;; then opening such a file causes the features described below, to
|
||||
;; be enabled in that buffer. Normally this would be done using a
|
||||
;; major-mode but to allow the use of any major-mode, as the user sees
|
||||
;; fit, it is done here by running a setup function, which among other
|
||||
;; things turns on the preferred major-mode, by default `text-mode'.
|
||||
|
||||
;; Git waits for the `$EDITOR' to finish and then either creates the
|
||||
;; commit using the contents of the file as commit message, or, if the
|
||||
;; editor process exited with a non-zero exit status, aborts without
|
||||
;; creating a commit. Unfortunately Emacsclient (which is what Emacs
|
||||
;; users should be using as `$EDITOR' or at least as `$GIT_EDITOR')
|
||||
;; does not differentiate between "successfully" editing a file and
|
||||
;; aborting; not out of the box that is.
|
||||
|
||||
;; By making use of the `with-editor' package this package provides
|
||||
;; both ways of finish an editing session. In either case the file
|
||||
;; is saved, but Emacseditor's exit code differs.
|
||||
;;
|
||||
;; C-c C-c Finish the editing session successfully by returning
|
||||
;; with exit code 0. Git then creates the commit using
|
||||
;; the message it finds in the file.
|
||||
;;
|
||||
;; C-c C-k Aborts the edit editing session by returning with exit
|
||||
;; code 1. Git then aborts the commit.
|
||||
|
||||
;; Aborting the commit does not cause the message to be lost, but
|
||||
;; relying solely on the file not being tampered with is risky. This
|
||||
;; package additionally stores all aborted messages for the duration
|
||||
;; of the current session (i.e. until you close Emacs). To get back
|
||||
;; an aborted message use M-p and M-n while editing a message.
|
||||
;;
|
||||
;; M-p Replace the buffer contents with the previous message
|
||||
;; from the message ring. Of course only after storing
|
||||
;; the current content there too.
|
||||
;;
|
||||
;; M-n Replace the buffer contents with the next message from
|
||||
;; the message ring, after storing the current content.
|
||||
|
||||
;; Some support for pseudo headers as used in some projects is
|
||||
;; provided by these commands:
|
||||
;;
|
||||
;; C-c C-s Insert a Signed-off-by header.
|
||||
;; C-c C-a Insert a Acked-by header.
|
||||
;; C-c C-m Insert a Modified-by header.
|
||||
;; C-c C-t Insert a Tested-by header.
|
||||
;; C-c C-r Insert a Reviewed-by header.
|
||||
;; C-c C-o Insert a Cc header.
|
||||
;; C-c C-p Insert a Reported-by header.
|
||||
;; C-c M-s Insert a Suggested-by header.
|
||||
|
||||
;; When Git requests a commit message from the user, it does so by
|
||||
;; having her edit a file which initially contains some comments,
|
||||
;; instructing her what to do, and providing useful information, such
|
||||
;; as which files were modified. These comments, even when left
|
||||
;; intact by the user, do not become part of the commit message. This
|
||||
;; package ensures these comments are propertizes as such and further
|
||||
;; prettifies them by using different faces for various parts, such as
|
||||
;; files.
|
||||
|
||||
;; Finally this package highlights style errors, like lines that are
|
||||
;; too long, or when the second line is not empty. It may even nag
|
||||
;; you when you attempt to finish the commit without having fixed
|
||||
;; these issues. The style checks and many other settings can easily
|
||||
;; be configured:
|
||||
;;
|
||||
;; M-x customize-group RET git-commit RET
|
||||
|
||||
;;; Code:
|
||||
;;;; Dependencies
|
||||
|
||||
(require 'dash)
|
||||
(require 'log-edit)
|
||||
(require 'magit-git nil t)
|
||||
(require 'magit-utils nil t)
|
||||
(require 'ring)
|
||||
(require 'server)
|
||||
(require 'with-editor)
|
||||
|
||||
(eval-when-compile (require 'recentf))
|
||||
|
||||
;;;; Declarations
|
||||
|
||||
(defvar diff-default-read-only)
|
||||
(defvar flyspell-generic-check-word-predicate)
|
||||
(defvar font-lock-beg)
|
||||
(defvar font-lock-end)
|
||||
|
||||
(declare-function magit-expand-git-file-name "magit-git" (filename))
|
||||
(declare-function magit-list-local-branch-names "magit-git" ())
|
||||
(declare-function magit-list-remote-branch-names "magit-git"
|
||||
(&optional remote relative))
|
||||
|
||||
;;; Options
|
||||
;;;; Variables
|
||||
|
||||
(defgroup git-commit nil
|
||||
"Edit Git commit messages."
|
||||
:prefix "git-commit-"
|
||||
:link '(info-link "(magit)Editing Commit Messages")
|
||||
:group 'tools)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode global-git-commit-mode
|
||||
"Edit Git commit messages.
|
||||
This global mode arranges for `git-commit-setup' to be called
|
||||
when a Git commit message file is opened. That usually happens
|
||||
when Git uses the Emacsclient as $GIT_EDITOR to have the user
|
||||
provide such a commit message."
|
||||
:group 'git-commit
|
||||
:type 'boolean
|
||||
:global t
|
||||
:init-value t
|
||||
:initialize (lambda (symbol exp)
|
||||
(custom-initialize-default symbol exp)
|
||||
(when global-git-commit-mode
|
||||
(add-hook 'find-file-hook 'git-commit-setup-check-buffer)))
|
||||
(if global-git-commit-mode
|
||||
(add-hook 'find-file-hook 'git-commit-setup-check-buffer)
|
||||
(remove-hook 'find-file-hook 'git-commit-setup-check-buffer)))
|
||||
|
||||
(defcustom git-commit-major-mode 'text-mode
|
||||
"Major mode used to edit Git commit messages.
|
||||
The major mode configured here is turned on by the minor mode
|
||||
`git-commit-mode'."
|
||||
:group 'git-commit
|
||||
:type '(choice (function-item text-mode)
|
||||
(const :tag "No major mode")))
|
||||
|
||||
(defcustom git-commit-setup-hook
|
||||
'(git-commit-save-message
|
||||
git-commit-setup-changelog-support
|
||||
git-commit-turn-on-auto-fill
|
||||
git-commit-propertize-diff
|
||||
with-editor-usage-message)
|
||||
"Hook run at the end of `git-commit-setup'."
|
||||
:group 'git-commit
|
||||
:type 'hook
|
||||
:get (and (featurep 'magit-utils) 'magit-hook-custom-get)
|
||||
:options '(git-commit-save-message
|
||||
git-commit-setup-changelog-support
|
||||
git-commit-turn-on-auto-fill
|
||||
git-commit-turn-on-flyspell
|
||||
git-commit-propertize-diff
|
||||
bug-reference-mode
|
||||
with-editor-usage-message))
|
||||
|
||||
(defcustom git-commit-finish-query-functions
|
||||
'(git-commit-check-style-conventions)
|
||||
"List of functions called to query before performing commit.
|
||||
|
||||
The commit message buffer is current while the functions are
|
||||
called. If any of them returns nil, then the commit is not
|
||||
performed and the buffer is not killed. The user should then
|
||||
fix the issue and try again.
|
||||
|
||||
The functions are called with one argument. If it is non-nil,
|
||||
then that indicates that the user used a prefix argument to
|
||||
force finishing the session despite issues. Functions should
|
||||
usually honor this wish and return non-nil."
|
||||
:options '(git-commit-check-style-conventions)
|
||||
:type 'hook
|
||||
:group 'git-commit)
|
||||
|
||||
(defcustom git-commit-style-convention-checks '(non-empty-second-line)
|
||||
"List of checks performed by `git-commit-check-style-conventions'.
|
||||
Valid members are `non-empty-second-line' and `overlong-summary-line'.
|
||||
That function is a member of `git-commit-finish-query-functions'."
|
||||
:options '(non-empty-second-line overlong-summary-line)
|
||||
:type '(list :convert-widget custom-hook-convert-widget)
|
||||
:group 'git-commit)
|
||||
|
||||
(defcustom git-commit-summary-max-length 68
|
||||
"Column beyond which characters in the summary lines are highlighted.
|
||||
|
||||
The highlighting indicates that the summary is getting too long
|
||||
by some standards. It does in no way imply that going over the
|
||||
limit a few characters or in some cases even many characters is
|
||||
anything that deserves shaming. It's just a friendly reminder
|
||||
that if you can make the summary shorter, then you might want
|
||||
to consider doing so."
|
||||
:group 'git-commit
|
||||
:safe 'numberp
|
||||
:type 'number)
|
||||
|
||||
(defcustom git-commit-fill-column nil
|
||||
"Override `fill-column' in commit message buffers.
|
||||
|
||||
If this is non-nil, then it should be an integer. If that is the
|
||||
case and the buffer-local value of `fill-column' is not already
|
||||
set by the time `git-commit-turn-on-auto-fill' is called as a
|
||||
member of `git-commit-setup-hook', then that function sets the
|
||||
buffer-local value of `fill-column' to the value of this option.
|
||||
|
||||
This option exists mostly for historic reasons. If you are not
|
||||
already using it, then you probably shouldn't start doing so."
|
||||
:group 'git-commit
|
||||
:safe 'numberp
|
||||
:type '(choice (const :tag "use regular fill-column")
|
||||
number))
|
||||
|
||||
(make-obsolete-variable 'git-commit-fill-column 'fill-column
|
||||
"Magit 2.11.0" 'set)
|
||||
|
||||
(defcustom git-commit-known-pseudo-headers
|
||||
'("Signed-off-by" "Acked-by" "Modified-by" "Cc"
|
||||
"Suggested-by" "Reported-by" "Tested-by" "Reviewed-by")
|
||||
"A list of Git pseudo headers to be highlighted."
|
||||
:group 'git-commit
|
||||
:safe (lambda (val) (and (listp val) (-all-p 'stringp val)))
|
||||
:type '(repeat string))
|
||||
|
||||
;;;; Faces
|
||||
|
||||
(defgroup git-commit-faces nil
|
||||
"Faces used for highlighting Git commit messages."
|
||||
:prefix "git-commit-"
|
||||
:group 'git-commit
|
||||
:group 'faces)
|
||||
|
||||
(defface git-commit-summary
|
||||
'((t :inherit font-lock-type-face))
|
||||
"Face used for the summary in commit messages."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-overlong-summary
|
||||
'((t :inherit font-lock-warning-face))
|
||||
"Face used for the tail of overlong commit message summaries."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-nonempty-second-line
|
||||
'((t :inherit font-lock-warning-face))
|
||||
"Face used for non-whitespace on the second line of commit messages."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-note
|
||||
'((t :inherit font-lock-string-face))
|
||||
"Face used for notes in commit messages."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-pseudo-header
|
||||
'((t :inherit font-lock-string-face))
|
||||
"Face used for pseudo headers in commit messages."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-known-pseudo-header
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face used for the keywords of known pseudo headers in commit messages."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-comment-branch-local
|
||||
(if (featurep 'magit)
|
||||
'((t :inherit magit-branch-local))
|
||||
'((t :inherit font-lock-variable-name-face)))
|
||||
"Face used for names of local branches in commit message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(define-obsolete-face-alias 'git-commit-comment-branch
|
||||
'git-commit-comment-branch-local "Git-Commit 2.12.0")
|
||||
|
||||
(defface git-commit-comment-branch-remote
|
||||
(if (featurep 'magit)
|
||||
'((t :inherit magit-branch-remote))
|
||||
'((t :inherit font-lock-variable-name-face)))
|
||||
"Face used for names of remote branches in commit message comments.
|
||||
This is only used if Magit is available."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-comment-detached
|
||||
'((t :inherit git-commit-comment-branch-local))
|
||||
"Face used for detached `HEAD' in commit message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-comment-heading
|
||||
'((t :inherit git-commit-known-pseudo-header))
|
||||
"Face used for headings in commit message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-comment-file
|
||||
'((t :inherit git-commit-pseudo-header))
|
||||
"Face used for file names in commit message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
(defface git-commit-comment-action
|
||||
'((t :inherit bold))
|
||||
"Face used for actions in commit message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
;;; Keymap
|
||||
|
||||
(defvar git-commit-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(cond ((featurep 'jkl)
|
||||
(define-key map (kbd "C-M-i") 'git-commit-prev-message)
|
||||
(define-key map (kbd "C-M-k") 'git-commit-next-message))
|
||||
(t
|
||||
(define-key map (kbd "M-p") 'git-commit-prev-message)
|
||||
(define-key map (kbd "M-n") 'git-commit-next-message)
|
||||
;; Old bindings to avoid confusion
|
||||
(define-key map (kbd "C-c C-x a") 'git-commit-ack)
|
||||
(define-key map (kbd "C-c C-x i") 'git-commit-suggested)
|
||||
(define-key map (kbd "C-c C-x m") 'git-commit-modified)
|
||||
(define-key map (kbd "C-c C-x o") 'git-commit-cc)
|
||||
(define-key map (kbd "C-c C-x p") 'git-commit-reported)
|
||||
(define-key map (kbd "C-c C-x r") 'git-commit-review)
|
||||
(define-key map (kbd "C-c C-x s") 'git-commit-signoff)
|
||||
(define-key map (kbd "C-c C-x t") 'git-commit-test)))
|
||||
(define-key map (kbd "C-c C-a") 'git-commit-ack)
|
||||
(define-key map (kbd "C-c C-i") 'git-commit-suggested)
|
||||
(define-key map (kbd "C-c C-m") 'git-commit-modified)
|
||||
(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-r") 'git-commit-review)
|
||||
(define-key map (kbd "C-c C-s") 'git-commit-signoff)
|
||||
(define-key map (kbd "C-c C-t") 'git-commit-test)
|
||||
(define-key map (kbd "C-c M-s") 'git-commit-save-message)
|
||||
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"]
|
||||
["Modified-by" git-commit-modified :active t
|
||||
:help "Insert a 'Modified-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" with-editor-cancel t]
|
||||
["Commit" with-editor-finish t]))
|
||||
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defconst git-commit-filename-regexp "/\\(\
|
||||
\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\
|
||||
\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'")
|
||||
|
||||
(eval-after-load 'recentf
|
||||
'(add-to-list 'recentf-exclude git-commit-filename-regexp))
|
||||
|
||||
(add-to-list 'with-editor-file-name-history-exclude git-commit-filename-regexp)
|
||||
|
||||
(defun git-commit-setup-font-lock-in-buffer ()
|
||||
(and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name)
|
||||
(git-commit-setup-font-lock)))
|
||||
|
||||
(add-hook 'after-change-major-mode-hook 'git-commit-setup-font-lock-in-buffer)
|
||||
|
||||
;;;###autoload
|
||||
(defun git-commit-setup-check-buffer ()
|
||||
(and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name)
|
||||
(git-commit-setup)))
|
||||
|
||||
(defvar git-commit-mode)
|
||||
|
||||
(defun git-commit-file-not-found ()
|
||||
;; cygwin git will pass a cygwin path (/cygdrive/c/foo/.git/...),
|
||||
;; try to handle this in window-nt Emacs.
|
||||
(--when-let
|
||||
(and (or (string-match-p git-commit-filename-regexp buffer-file-name)
|
||||
(if (boundp 'git-rebase-filename-regexp)
|
||||
(string-match-p git-rebase-filename-regexp buffer-file-name)))
|
||||
(not (file-accessible-directory-p
|
||||
(file-name-directory buffer-file-name)))
|
||||
(if (require 'magit-git nil t)
|
||||
;; Emacs prepends a "c:".
|
||||
(magit-expand-git-file-name (substring buffer-file-name 2))
|
||||
;; Fallback if we can't load `magit-git'.
|
||||
(and (string-match "\\`[a-z]:/\\(cygdrive/\\)?\\([a-z]\\)/\\(.*\\)"
|
||||
buffer-file-name)
|
||||
(concat (match-string 2 buffer-file-name) ":/"
|
||||
(match-string 3 buffer-file-name)))))
|
||||
(when (file-accessible-directory-p (file-name-directory it))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents it t)
|
||||
t))))
|
||||
|
||||
(when (eq system-type 'windows-nt)
|
||||
(add-hook 'find-file-not-found-functions #'git-commit-file-not-found))
|
||||
|
||||
;;;###autoload
|
||||
(defun git-commit-setup ()
|
||||
;; Pretend that git-commit-mode is a major-mode,
|
||||
;; so that directory-local settings can be used.
|
||||
(let ((default-directory
|
||||
(if (or (file-exists-p ".dir-locals.el")
|
||||
(not (fboundp 'magit-toplevel)))
|
||||
default-directory
|
||||
;; When $GIT_DIR/.dir-locals.el doesn't exist,
|
||||
;; fallback to $GIT_WORK_TREE/.dir-locals.el,
|
||||
;; because the maintainer can use the latter
|
||||
;; to enforce conventions, while s/he has no
|
||||
;; control over the former.
|
||||
(and (fboundp 'magit-toplevel) ; silence byte-compiler
|
||||
(magit-toplevel)))))
|
||||
(let ((buffer-file-name nil) ; trick hack-dir-local-variables
|
||||
(major-mode 'git-commit-mode)) ; trick dir-locals-collect-variables
|
||||
(hack-dir-local-variables)
|
||||
(hack-local-variables-apply)))
|
||||
(when git-commit-major-mode
|
||||
(let ((auto-mode-alist (list (cons (concat "\\`"
|
||||
(regexp-quote buffer-file-name)
|
||||
"\\'")
|
||||
git-commit-major-mode)))
|
||||
;; The major-mode hook might want to consult these minor
|
||||
;; modes, while the minor-mode hooks might want to consider
|
||||
;; the major mode.
|
||||
(git-commit-mode t)
|
||||
(with-editor-mode t))
|
||||
(normal-mode t)))
|
||||
(setq with-editor-show-usage nil)
|
||||
(unless with-editor-mode
|
||||
;; Maybe already enabled when using `shell-command' or an Emacs shell.
|
||||
(with-editor-mode 1))
|
||||
(add-hook 'with-editor-finish-query-functions
|
||||
'git-commit-finish-query-functions nil t)
|
||||
(add-hook 'with-editor-pre-finish-hook
|
||||
'git-commit-save-message nil t)
|
||||
(add-hook 'with-editor-pre-cancel-hook
|
||||
'git-commit-save-message nil t)
|
||||
(when (bound-and-true-p magit-wip-merge-branch)
|
||||
(add-hook 'with-editor-post-finish-hook
|
||||
'magit-wip-commit nil t))
|
||||
(setq with-editor-cancel-message
|
||||
'git-commit-cancel-message)
|
||||
(make-local-variable 'log-edit-comment-ring-index)
|
||||
(git-commit-mode 1)
|
||||
(git-commit-setup-font-lock)
|
||||
(when (boundp 'save-place)
|
||||
(setq save-place nil))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "\\`\\(\\'\\|\n[^\n]\\)")
|
||||
(open-line 1)))
|
||||
(run-hooks 'git-commit-setup-hook)
|
||||
(set-buffer-modified-p nil))
|
||||
|
||||
(define-minor-mode git-commit-mode
|
||||
"Auxiliary minor mode used when editing Git commit messages.
|
||||
This mode is only responsible for setting up some key bindings.
|
||||
Don't use it directly, instead enable `global-git-commit-mode'."
|
||||
:lighter "")
|
||||
|
||||
(put 'git-commit-mode 'permanent-local t)
|
||||
|
||||
(defun git-commit-setup-changelog-support ()
|
||||
"Treat ChangeLog entries as paragraphs."
|
||||
(setq-local paragraph-start (concat paragraph-start "\\|\\*\\|(")))
|
||||
|
||||
(defun git-commit-turn-on-auto-fill ()
|
||||
"Unconditionally turn on Auto Fill mode.
|
||||
If `git-commit-fill-column' is non-nil, and `fill-column'
|
||||
doesn't already have a buffer-local value, then set that
|
||||
to `git-commit-fill-column'."
|
||||
(when (and (numberp git-commit-fill-column)
|
||||
(not (local-variable-p 'fill-column)))
|
||||
(setq fill-column git-commit-fill-column))
|
||||
(setq-local comment-auto-fill-only-comments nil)
|
||||
(turn-on-auto-fill))
|
||||
|
||||
(defun git-commit-turn-on-flyspell ()
|
||||
"Unconditionally turn on Flyspell mode.
|
||||
Also prevent comments from being checked and
|
||||
finally check current non-comment text."
|
||||
(require 'flyspell)
|
||||
(turn-on-flyspell)
|
||||
(setq flyspell-generic-check-word-predicate
|
||||
'git-commit-flyspell-verify)
|
||||
(let ((end)
|
||||
(comment-start-regex (format "^\\(%s\\|$\\)" comment-start)))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(while (and (not (bobp)) (looking-at comment-start-regex))
|
||||
(forward-line -1))
|
||||
(unless (looking-at comment-start-regex)
|
||||
(forward-line))
|
||||
(setq end (point)))
|
||||
(flyspell-region (point-min) end)))
|
||||
|
||||
(defun git-commit-flyspell-verify ()
|
||||
(not (= (char-after (line-beginning-position))
|
||||
(aref comment-start 0))))
|
||||
|
||||
(defun git-commit-finish-query-functions (force)
|
||||
(run-hook-with-args-until-failure
|
||||
'git-commit-finish-query-functions force))
|
||||
|
||||
(defun git-commit-check-style-conventions (force)
|
||||
"Check for violations of certain basic style conventions.
|
||||
|
||||
For each violation ask the user if she wants to proceed anyway.
|
||||
Option `git-commit-check-style-conventions' controls which
|
||||
conventions are checked."
|
||||
(or force
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(re-search-forward (git-commit-summary-regexp) nil t)
|
||||
(if (equal (match-string 1) "")
|
||||
t ; Just try; we don't know whether --allow-empty-message was used.
|
||||
(and (or (not (memq 'overlong-summary-line
|
||||
git-commit-style-convention-checks))
|
||||
(equal (match-string 2) "")
|
||||
(y-or-n-p "Summary line is too long. Commit anyway? "))
|
||||
(or (not (memq 'non-empty-second-line
|
||||
git-commit-style-convention-checks))
|
||||
(not (match-string 3))
|
||||
(y-or-n-p "Second line is not empty. Commit anyway? ")))))))
|
||||
|
||||
(defun git-commit-cancel-message ()
|
||||
(message
|
||||
(concat "Commit canceled"
|
||||
(and (memq 'git-commit-save-message with-editor-pre-cancel-hook)
|
||||
". Message saved to `log-edit-comment-ring'"))))
|
||||
|
||||
;;; History
|
||||
|
||||
(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
|
||||
(goto-char (point-min))
|
||||
(narrow-to-region (point)
|
||||
(if (re-search-forward (concat "^" comment-start) nil t)
|
||||
(max 1 (- (point) 2))
|
||||
(point-max)))
|
||||
(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)))
|
||||
|
||||
(defun git-commit-save-message ()
|
||||
"Save current message to `log-edit-comment-ring'."
|
||||
(interactive)
|
||||
(--when-let (git-commit-buffer-message)
|
||||
(unless (ring-member log-edit-comment-ring it)
|
||||
(ring-insert log-edit-comment-ring it))))
|
||||
|
||||
(defun git-commit-buffer-message ()
|
||||
(let ((flush (concat "^" comment-start))
|
||||
(str (buffer-substring-no-properties (point-min) (point-max))))
|
||||
(with-temp-buffer
|
||||
(insert str)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (concat flush " -+ >8 -+$") nil t)
|
||||
(delete-region (point-at-bol) (point-max)))
|
||||
(goto-char (point-min))
|
||||
(flush-lines flush)
|
||||
(goto-char (point-max))
|
||||
(unless (eq (char-before) ?\n)
|
||||
(insert ?\n))
|
||||
(setq str (buffer-string)))
|
||||
(unless (string-match "\\`[ \t\n\r]*\\'" str)
|
||||
(when (string-match "\\`\n\\{2,\\}" str)
|
||||
(setq str (replace-match "\n" t t str)))
|
||||
(when (string-match "\n\\{2,\\}\\'" str)
|
||||
(setq str (replace-match "\n" t t str)))
|
||||
str)))
|
||||
|
||||
;;; Headers
|
||||
|
||||
(defun git-commit-ack (name mail)
|
||||
"Insert a header acknowledging that you have looked at the commit."
|
||||
(interactive (git-commit-self-ident))
|
||||
(git-commit-insert-header "Acked-by" name mail))
|
||||
|
||||
(defun git-commit-modified (name mail)
|
||||
"Insert a header to signal that you have modified the commit."
|
||||
(interactive (git-commit-self-ident))
|
||||
(git-commit-insert-header "Modified-by" name mail))
|
||||
|
||||
(defun git-commit-review (name mail)
|
||||
"Insert a header acknowledging that you have reviewed the commit."
|
||||
(interactive (git-commit-self-ident))
|
||||
(git-commit-insert-header "Reviewed-by" name mail))
|
||||
|
||||
(defun git-commit-signoff (name mail)
|
||||
"Insert a header to sign off the commit."
|
||||
(interactive (git-commit-self-ident))
|
||||
(git-commit-insert-header "Signed-off-by" name mail))
|
||||
|
||||
(defun git-commit-test (name mail)
|
||||
"Insert a header acknowledging that you have tested the commit."
|
||||
(interactive (git-commit-self-ident))
|
||||
(git-commit-insert-header "Tested-by" name mail))
|
||||
|
||||
(defun git-commit-cc (name mail)
|
||||
"Insert a header mentioning someone who might be interested."
|
||||
(interactive (git-commit-read-ident))
|
||||
(git-commit-insert-header "Cc" name mail))
|
||||
|
||||
(defun git-commit-reported (name mail)
|
||||
"Insert a header mentioning the person who reported the issue."
|
||||
(interactive (git-commit-read-ident))
|
||||
(git-commit-insert-header "Reported-by" name mail))
|
||||
|
||||
(defun git-commit-suggested (name mail)
|
||||
"Insert a header mentioning the person who suggested the change."
|
||||
(interactive (git-commit-read-ident))
|
||||
(git-commit-insert-header "Suggested-by" name mail))
|
||||
|
||||
(defun git-commit-self-ident ()
|
||||
(list (or (getenv "GIT_AUTHOR_NAME")
|
||||
(getenv "GIT_COMMITTER_NAME")
|
||||
(ignore-errors (car (process-lines "git" "config" "user.name")))
|
||||
user-full-name
|
||||
(read-string "Name: "))
|
||||
(or (getenv "GIT_AUTHOR_EMAIL")
|
||||
(getenv "GIT_COMMITTER_EMAIL")
|
||||
(getenv "EMAIL")
|
||||
(ignore-errors (car (process-lines "git" "config" "user.email")))
|
||||
(read-string "Email: "))))
|
||||
|
||||
(defun git-commit-read-ident ()
|
||||
(list (read-string "Name: ")
|
||||
(read-string "Email: ")))
|
||||
|
||||
(defun git-commit-insert-header (header name email)
|
||||
(setq header (format "%s: %s <%s>" header name email))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(cond ((re-search-backward "^[-a-zA-Z]+: [^<]+? <[^>]+>" nil t)
|
||||
(end-of-line)
|
||||
(insert ?\n header)
|
||||
(unless (= (char-after) ?\n)
|
||||
(insert ?\n)))
|
||||
(t
|
||||
(while (re-search-backward (concat "^" comment-start) nil t))
|
||||
(unless (looking-back "\n\n" nil)
|
||||
(insert ?\n))
|
||||
(insert header ?\n)))
|
||||
(unless (or (eobp) (= (char-after) ?\n))
|
||||
(insert ?\n))))
|
||||
|
||||
;;; Font-Lock
|
||||
|
||||
(defun git-commit-summary-regexp ()
|
||||
(concat
|
||||
;; Leading empty lines and comments
|
||||
(format "\\`\\(?:^\\(?:\\s-*\\|%s.*\\)\n\\)*" comment-start)
|
||||
;; Summary line
|
||||
(format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length)
|
||||
;; Non-empty non-comment second line
|
||||
(format "\\(?:\n%s\\|\n\\(.+\\)\\)?" comment-start)))
|
||||
|
||||
(defun git-commit-extend-region-summary-line ()
|
||||
"Identify the multiline summary-regexp construct.
|
||||
Added to `font-lock-extend-region-functions'."
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(goto-char (point-min))
|
||||
(when (looking-at (git-commit-summary-regexp))
|
||||
(let ((summary-beg (match-beginning 0))
|
||||
(summary-end (match-end 0)))
|
||||
(when (or (< summary-beg font-lock-beg summary-end)
|
||||
(< summary-beg font-lock-end summary-end))
|
||||
(setq font-lock-beg (min font-lock-beg summary-beg))
|
||||
(setq font-lock-end (max font-lock-end summary-end))))))))
|
||||
|
||||
(defvar-local git-commit--branch-name-regexp nil)
|
||||
|
||||
(defconst git-commit-comment-headings
|
||||
'("Changes to be committed:"
|
||||
"Untracked files:"
|
||||
"Changed but not updated:"
|
||||
"Changes not staged for commit:"
|
||||
"Unmerged paths:"
|
||||
"Author:"
|
||||
"Date:"))
|
||||
|
||||
(defconst git-commit-font-lock-keywords-1
|
||||
'(;; Pseudo headers
|
||||
(eval . `(,(format "^\\(%s:\\)\\( .*\\)"
|
||||
(regexp-opt git-commit-known-pseudo-headers))
|
||||
(1 'git-commit-known-pseudo-header)
|
||||
(2 'git-commit-pseudo-header)))
|
||||
("^[-a-zA-Z]+: [^<]+? <[^>]+>"
|
||||
(0 'git-commit-pseudo-header))
|
||||
;; Summary
|
||||
(eval . `(,(git-commit-summary-regexp)
|
||||
(1 'git-commit-summary)))
|
||||
;; - Note (overrides summary)
|
||||
("\\[.+?\\]"
|
||||
(0 'git-commit-note t))
|
||||
;; - Non-empty second line (overrides summary and note)
|
||||
(eval . `(,(git-commit-summary-regexp)
|
||||
(2 'git-commit-overlong-summary t t)
|
||||
(3 'git-commit-nonempty-second-line t t)))))
|
||||
|
||||
(defconst git-commit-font-lock-keywords-2
|
||||
`(,@git-commit-font-lock-keywords-1
|
||||
;; Comments
|
||||
(eval . `(,(format "^%s.*" comment-start)
|
||||
(0 'font-lock-comment-face)))
|
||||
(eval . `(,(format "^%s On branch \\(.*\\)" comment-start)
|
||||
(1 'git-commit-comment-branch-local t)))
|
||||
(eval . `(,(format "^%s \\(HEAD\\) detached at" comment-start)
|
||||
(1 'git-commit-comment-detached t)))
|
||||
(eval . `(,(format "^%s %s" comment-start
|
||||
(regexp-opt git-commit-comment-headings t))
|
||||
(1 'git-commit-comment-heading t)))
|
||||
(eval . `(,(format "^%s\t\\(?:\\([^:\n]+\\):\\s-+\\)?\\(.*\\)" comment-start)
|
||||
(1 'git-commit-comment-action t t)
|
||||
(2 'git-commit-comment-file t)))))
|
||||
|
||||
(defconst git-commit-font-lock-keywords-3
|
||||
`(,@git-commit-font-lock-keywords-2
|
||||
;; More comments
|
||||
(eval
|
||||
;; Your branch is ahead of 'master' by 3 commits.
|
||||
;; Your branch is behind 'master' by 2 commits, and can be fast-forwarded.
|
||||
. `(,(format
|
||||
"^%s Your branch is \\(?:ahead\\|behind\\) of '%s' by \\([0-9]*\\)"
|
||||
comment-start git-commit--branch-name-regexp)
|
||||
(1 'git-commit-comment-branch-local t)
|
||||
(2 'git-commit-comment-branch-remote t)
|
||||
(3 'bold t)))
|
||||
(eval
|
||||
;; Your branch is up to date with 'master'.
|
||||
;; Your branch and 'master' have diverged,
|
||||
. `(,(format
|
||||
"^%s Your branch \\(?:is up-to-date with\\|and\\) '%s'"
|
||||
comment-start git-commit--branch-name-regexp)
|
||||
(1 'git-commit-comment-branch-local t)
|
||||
(2 'git-commit-comment-branch-remote t)))
|
||||
(eval
|
||||
;; and have 1 and 2 different commits each, respectively.
|
||||
. `(,(format
|
||||
"^%s and have \\([0-9]*\\) and \\([0-9]*\\) commits each"
|
||||
comment-start)
|
||||
(1 'bold t)
|
||||
(2 'bold t)))))
|
||||
|
||||
(defvar git-commit-font-lock-keywords git-commit-font-lock-keywords-2
|
||||
"Font-Lock keywords for Git-Commit mode.")
|
||||
|
||||
(defun git-commit-setup-font-lock ()
|
||||
(let ((table (make-syntax-table (syntax-table))))
|
||||
(when comment-start
|
||||
(modify-syntax-entry (string-to-char comment-start) "." table))
|
||||
(modify-syntax-entry ?# "." table)
|
||||
(modify-syntax-entry ?\" "." table)
|
||||
(modify-syntax-entry ?\' "." table)
|
||||
(modify-syntax-entry ?` "." table)
|
||||
(set-syntax-table table))
|
||||
(setq-local comment-start
|
||||
(or (ignore-errors
|
||||
(car (process-lines "git" "config" "core.commentchar")))
|
||||
"#"))
|
||||
(setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start))
|
||||
(setq-local comment-end-skip "\n")
|
||||
(setq-local comment-use-syntax nil)
|
||||
(setq-local git-commit--branch-name-regexp
|
||||
(if (and (featurep 'magit-git)
|
||||
;; When using cygwin git, we may end up in a
|
||||
;; non-existing directory, which would cause
|
||||
;; any git calls to signal an error.
|
||||
(file-accessible-directory-p default-directory))
|
||||
(progn
|
||||
;; Make sure the below functions are available.
|
||||
(require 'magit)
|
||||
;; Font-Lock wants every submatch to succeed,
|
||||
;; so also match the empty string. Do not use
|
||||
;; `regexp-quote' because that is slow if there
|
||||
;; are thousands of branches outweighing the
|
||||
;; benefit of an efficient regep.
|
||||
(format "\\(\\(?:%s\\)\\|\\)\\(\\(?:%s\\)\\|\\)"
|
||||
(mapconcat #'identity
|
||||
(magit-list-local-branch-names)
|
||||
"\\|")
|
||||
(mapconcat #'identity
|
||||
(magit-list-remote-branch-names)
|
||||
"\\|")))
|
||||
"\\([^']*\\)"))
|
||||
(setq-local font-lock-multiline t)
|
||||
(add-hook 'font-lock-extend-region-functions
|
||||
#'git-commit-extend-region-summary-line
|
||||
t t)
|
||||
(font-lock-add-keywords nil git-commit-font-lock-keywords t))
|
||||
|
||||
(defun git-commit-propertize-diff ()
|
||||
(require 'diff-mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^diff --git" nil t)
|
||||
(beginning-of-line)
|
||||
(let ((buffer (current-buffer)))
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(insert
|
||||
(with-current-buffer buffer
|
||||
(prog1 (buffer-substring-no-properties (point) (point-max))
|
||||
(delete-region (point) (point-max)))))
|
||||
(let ((diff-default-read-only nil))
|
||||
(diff-mode))
|
||||
(let (font-lock-verbose font-lock-support-mode)
|
||||
(if (fboundp 'font-lock-ensure)
|
||||
(font-lock-ensure)
|
||||
(with-no-warnings
|
||||
(font-lock-fontify-buffer))))
|
||||
(let (next (pos (point-min)))
|
||||
(while (setq next (next-single-property-change pos 'face))
|
||||
(put-text-property pos next 'font-lock-face
|
||||
(get-text-property pos 'face))
|
||||
(setq pos next))
|
||||
(put-text-property pos (point-max) 'font-lock-face
|
||||
(get-text-property pos 'face)))
|
||||
(buffer-string)))))))
|
||||
|
||||
;;; Elisp Text Mode
|
||||
|
||||
(define-derived-mode git-commit-elisp-text-mode text-mode "ElText"
|
||||
"Major mode for editing commit messages of elisp projects.
|
||||
This is intended for use as `git-commit-major-mode' for projects
|
||||
that expect `symbols' to look like this. I.e. like they look in
|
||||
Elisp doc-strings, including this one. Unlike in doc-strings,
|
||||
\"strings\" also look different than the other text."
|
||||
(setq font-lock-defaults '(git-commit-elisp-text-mode-keywords)))
|
||||
|
||||
(defvar git-commit-elisp-text-mode-keywords
|
||||
`((,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
|
||||
lisp-mode-symbol-regexp "\\)['’]")
|
||||
(1 font-lock-constant-face prepend))
|
||||
("\"[^\"]*\"" (0 font-lock-string-face prepend))))
|
||||
|
||||
;;; _
|
||||
(provide 'git-commit)
|
||||
;;; git-commit.el ends here
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -0,0 +1,15 @@
|
|||
;;; graphql-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil nil ("graphql.el") (23473 23426 195042 383000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; graphql-autoloads.el ends here
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "graphql" "20180912.31" "GraphQL utilities" '((emacs "25")) :commit "e2b309689f4faf9225f290080f836e988c5a576d" :keywords '("hypermedia" "tools" "lisp") :authors '(("Sean Allred" . "code@seanallred.com")) :maintainer '("Sean Allred" . "code@seanallred.com") :url "https://github.com/vermiculus/graphql.el")
|
|
@ -0,0 +1,220 @@
|
|||
;;; graphql.el --- GraphQL utilities -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2017 Sean Allred
|
||||
|
||||
;; Author: Sean Allred <code@seanallred.com>
|
||||
;; Keywords: hypermedia, tools, lisp
|
||||
;; Homepage: https://github.com/vermiculus/graphql.el
|
||||
;; Package-Version: 20180912.31
|
||||
;; Package-X-Original-Version: 0.1.1
|
||||
;; Package-Requires: ((emacs "25"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; GraphQL.el provides a generally-applicable domain-specific language
|
||||
;; for creating and executing GraphQL queries against your favorite
|
||||
;; web services.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'pcase)
|
||||
|
||||
(defun graphql--encode-object (obj)
|
||||
"Encode OBJ as a GraphQL string."
|
||||
(cond
|
||||
((stringp obj)
|
||||
obj)
|
||||
((symbolp obj)
|
||||
(symbol-name obj))
|
||||
((numberp obj)
|
||||
(number-to-string obj))
|
||||
((and (consp obj)
|
||||
(not (consp (cdr obj))))
|
||||
(symbol-name (car obj)))))
|
||||
|
||||
(defun graphql--encode-argument-spec (spec)
|
||||
"Encode an argument spec SPEC.
|
||||
SPEC is of the form..."
|
||||
(graphql--encode-argument (car spec) (cdr spec)))
|
||||
|
||||
(defun graphql--encode-argument (key value)
|
||||
"Encode an argument KEY with value VALUE."
|
||||
(format "%s:%s" key (graphql--encode-argument-value value)))
|
||||
|
||||
(defun graphql--encode-argument-value (value)
|
||||
"Encode an argument value VALUE.
|
||||
VALUE is expected to be one of the following:
|
||||
|
||||
* a symbol
|
||||
* a 'variable', i.e. \\='($ variableName)
|
||||
* an object (as a list)
|
||||
* a string
|
||||
* a vector of values (e.g., symbols)
|
||||
* a number
|
||||
* something encode-able by `graphql-encode'."
|
||||
(cond
|
||||
((symbolp value)
|
||||
(symbol-name value))
|
||||
((eq '$ (car-safe value))
|
||||
(format "$%s" (cadr value)))
|
||||
((listp value)
|
||||
(format "{%s}" (mapconcat #'graphql--encode-argument-spec value ",")))
|
||||
((stringp value)
|
||||
(format "\"%s\"" value))
|
||||
((vectorp value)
|
||||
(format "[%s]" (mapconcat #'graphql-encode value ",")))
|
||||
((numberp value)
|
||||
(number-to-string value))
|
||||
(t
|
||||
(graphql-encode value))))
|
||||
|
||||
(defun graphql--encode-parameter-spec (spec)
|
||||
"Encode a parameter SPEC.
|
||||
SPEC is expected to be of the following form:
|
||||
|
||||
(NAME TYPE [REQUIRED] . [DEFAULT])
|
||||
|
||||
NAME is the name of the parameter.
|
||||
|
||||
TYPE is the parameter's type.
|
||||
|
||||
A non-nil value for REQUIRED will indicate the parameter is
|
||||
required. A value of `!' is recommended.
|
||||
|
||||
A non-nil value for DEFAULT will provide a default value for the
|
||||
parameter."
|
||||
;; Unfortunately can't use `pcase' here because the first DEFAULT
|
||||
;; value (in the case of a complex value) might be misunderstood as
|
||||
;; the value for REQUIRED. We need to know if the third cons is the
|
||||
;; very last one; not just that the list has at least three
|
||||
;; elements.
|
||||
(if (eq (last spec) (nthcdr 2 spec))
|
||||
(graphql--encode-parameter (nth 0 spec)
|
||||
(nth 1 spec)
|
||||
(car (last spec))
|
||||
(cdr (last spec)))
|
||||
(graphql--encode-parameter (nth 0 spec)
|
||||
(nth 1 spec)
|
||||
nil
|
||||
(nthcdr 2 spec))))
|
||||
|
||||
(defun graphql--encode-parameter (name type &optional required default)
|
||||
"Encode a GraphQL parameter with a NAME and TYPE.
|
||||
If REQUIRED is non-nil, mark the parameter as required.
|
||||
If DEFAULT is non-nil, is the default value of the parameter."
|
||||
(format "$%s:%s%s%s"
|
||||
(symbol-name name)
|
||||
(symbol-name type)
|
||||
(if required "!" "")
|
||||
(if default
|
||||
(concat "=" (graphql--encode-argument-value default))
|
||||
"")))
|
||||
|
||||
(defun graphql--get-keys (g)
|
||||
"Get the keyword arguments from a graph G.
|
||||
Returns a list where the first element is a plist of arguments
|
||||
and the second is a 'clean' copy of G."
|
||||
(or (and (not (consp g))
|
||||
(list nil g))
|
||||
(let (graph keys)
|
||||
(while g
|
||||
(if (keywordp (car g))
|
||||
(let* ((param (pop g))
|
||||
(value (pop g)))
|
||||
(push (cons param value) keys))
|
||||
(push (pop g) graph)))
|
||||
(list keys (nreverse graph)))))
|
||||
|
||||
(defun graphql-encode (g)
|
||||
"Encode graph G as a GraphQL string."
|
||||
(pcase (graphql--get-keys g)
|
||||
(`(,keys ,graph)
|
||||
(let ((object (or (car-safe graph) graph))
|
||||
(name (alist-get :op-name keys))
|
||||
(params (alist-get :op-params keys))
|
||||
(arguments (alist-get :arguments keys))
|
||||
(fields (cdr-safe graph)))
|
||||
(concat
|
||||
(graphql--encode-object object)
|
||||
(when name
|
||||
(format " %S" name))
|
||||
(when arguments
|
||||
;; Format arguments "key:value,key:value,..."
|
||||
(format "(%s)"
|
||||
(mapconcat #'graphql--encode-argument-spec arguments ",")))
|
||||
(when params
|
||||
(format "(%s)"
|
||||
(mapconcat #'graphql--encode-parameter-spec params ",")))
|
||||
(when fields
|
||||
(format "{%s}"
|
||||
(mapconcat #'graphql-encode fields " "))))))))
|
||||
|
||||
(defun graphql-simplify-response-edges (data)
|
||||
"Simplify DATA to collapse edges into their nodes."
|
||||
(pcase data
|
||||
;; When we encounter a collection of edges, simplify those edges
|
||||
;; into their nodes
|
||||
(`(,object (edges . ,edges))
|
||||
(cons object (mapcar #'graphql-simplify-response-edges
|
||||
(mapcar (lambda (edge) (alist-get 'node edge))
|
||||
edges))))
|
||||
;; When we encounter a plain cons cell (not a list), let it pass
|
||||
(`(,(and key (guard (not (consp key)))) . ,(and value (guard (not (consp value)))))
|
||||
(cons key value))
|
||||
;; symbols should pass unaltered
|
||||
(`,(and symbol (guard (symbolp symbol)))
|
||||
symbol)
|
||||
;; everything else should be mapped
|
||||
(_ (mapcar #'graphql-simplify-response-edges data))))
|
||||
|
||||
(defun graphql--genform-operation (args kind)
|
||||
"Generate the Lisp form for an operation.
|
||||
ARGS is is a list ([NAME [PARAMETERS]] GRAPH) where NAME is the
|
||||
name of the operation, PARAMETERS are its parameters, and GRAPH
|
||||
is the form of the actual operation.
|
||||
|
||||
KIND can be `query' or `mutation'."
|
||||
(pcase args
|
||||
(`(,name ,parameters ,graph)
|
||||
`(graphql-encode '(,kind :op-name ,name
|
||||
:op-params ,parameters
|
||||
,@graph)))
|
||||
|
||||
(`(,name ,graph)
|
||||
`(graphql-encode '(,kind :op-name ,name
|
||||
,@graph)))
|
||||
|
||||
(`(,graph)
|
||||
`(graphql-encode '(,kind ,@graph)))
|
||||
|
||||
(_ (error "Bad form"))))
|
||||
|
||||
(defmacro graphql-query (&rest args)
|
||||
"Construct a Query object.
|
||||
ARGS is a listof the form described by `graphql--genform-operation'.
|
||||
|
||||
\(fn [NAME] [(PARAMETER-SPEC...)] GRAPH)"
|
||||
(graphql--genform-operation args 'query))
|
||||
|
||||
(defmacro graphql-mutation (&rest args)
|
||||
"Construct a Mutation object.
|
||||
ARGS is a listof the form described by `graphql--genform-operation'.
|
||||
|
||||
\(fn [NAME] [(PARAMETER-SPEC...)] GRAPH)"
|
||||
(graphql--genform-operation args 'mutation))
|
||||
|
||||
(provide 'graphql)
|
||||
;;; graphql.el ends here
|
Binary file not shown.
|
@ -0,0 +1 @@
|
|||
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2017-02-01T05:05:02-0500 using DSA
|
|
@ -0,0 +1,50 @@
|
|||
;;; let-alist-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "let-alist" "let-alist.el" (23473 23425 443117
|
||||
;;;;;; 629000))
|
||||
;;; Generated autoloads from let-alist.el
|
||||
|
||||
(autoload 'let-alist "let-alist" "\
|
||||
Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
|
||||
Dotted symbol is any symbol starting with a `.'. Only those present
|
||||
in BODY are let-bound and this search is done at compile time.
|
||||
|
||||
For instance, the following code
|
||||
|
||||
(let-alist alist
|
||||
(if (and .title .body)
|
||||
.body
|
||||
.site
|
||||
.site.contents))
|
||||
|
||||
essentially expands to
|
||||
|
||||
(let ((.title (cdr (assq \\='title alist)))
|
||||
(.body (cdr (assq \\='body alist)))
|
||||
(.site (cdr (assq \\='site alist)))
|
||||
(.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
|
||||
(if (and .title .body)
|
||||
.body
|
||||
.site
|
||||
.site.contents))
|
||||
|
||||
If you nest `let-alist' invocations, the inner one can't access
|
||||
the variables of the outer one. You can, however, access alists
|
||||
inside the original alist by using dots inside the symbol, as
|
||||
displayed in the example above.
|
||||
|
||||
\(fn ALIST &rest BODY)" nil t)
|
||||
|
||||
(function-put 'let-alist 'lisp-indent-function '1)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; let-alist-autoloads.el ends here
|
|
@ -0,0 +1,2 @@
|
|||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "let-alist" "1.0.5" "Easily let-bind values of an assoc-list by their names" '((emacs "24.1")) :url "http://elpa.gnu.org/packages/let-alist.html" :keywords '("extensions" "lisp"))
|
|
@ -0,0 +1,182 @@
|
|||
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
|
||||
;; Package-Requires: ((emacs "24.1"))
|
||||
;; Version: 1.0.5
|
||||
;; Keywords: extensions lisp
|
||||
;; Prefix: let-alist
|
||||
;; Separator: -
|
||||
|
||||
;; This is an Elpa :core package. Don't use functionality that is not
|
||||
;; compatible with Emacs 24.1.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This package offers a single macro, `let-alist'. This macro takes a
|
||||
;; first argument (whose value must be an alist) and a body.
|
||||
;;
|
||||
;; The macro expands to a let form containing body, where each dotted
|
||||
;; symbol inside body is let-bound to their cdrs in the alist. Dotted
|
||||
;; symbol is any symbol starting with a `.'. Only those present in
|
||||
;; the body are let-bound and this search is done at compile time.
|
||||
;;
|
||||
;; For instance, the following code
|
||||
;;
|
||||
;; (let-alist alist
|
||||
;; (if (and .title .body)
|
||||
;; .body
|
||||
;; .site
|
||||
;; .site.contents))
|
||||
;;
|
||||
;; essentially expands to
|
||||
;;
|
||||
;; (let ((.title (cdr (assq 'title alist)))
|
||||
;; (.body (cdr (assq 'body alist)))
|
||||
;; (.site (cdr (assq 'site alist)))
|
||||
;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
|
||||
;; (if (and .title .body)
|
||||
;; .body
|
||||
;; .site
|
||||
;; .site.contents))
|
||||
;;
|
||||
;; If you nest `let-alist' invocations, the inner one can't access
|
||||
;; the variables of the outer one. You can, however, access alists
|
||||
;; inside the original alist by using dots inside the symbol, as
|
||||
;; displayed in the example above by the `.site.contents'.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
(defun let-alist--deep-dot-search (data)
|
||||
"Return alist of symbols inside DATA that start with a `.'.
|
||||
Perform a deep search and return an alist where each car is the
|
||||
symbol, and each cdr is the same symbol without the `.'."
|
||||
(cond
|
||||
((symbolp data)
|
||||
(let ((name (symbol-name data)))
|
||||
(when (string-match "\\`\\." name)
|
||||
;; Return the cons cell inside a list, so it can be appended
|
||||
;; with other results in the clause below.
|
||||
(list (cons data (intern (replace-match "" nil nil name)))))))
|
||||
((not (consp data)) nil)
|
||||
((eq (car data) 'let-alist)
|
||||
;; For nested ‘let-alist’ forms, ignore symbols appearing in the
|
||||
;; inner body because they don’t refer to the alist currently
|
||||
;; being processed. See Bug#24641.
|
||||
(let-alist--deep-dot-search (cadr data)))
|
||||
(t (append (let-alist--deep-dot-search (car data))
|
||||
(let-alist--deep-dot-search (cdr data))))))
|
||||
|
||||
(defun let-alist--access-sexp (symbol variable)
|
||||
"Return a sexp used to access SYMBOL inside VARIABLE."
|
||||
(let* ((clean (let-alist--remove-dot symbol))
|
||||
(name (symbol-name clean)))
|
||||
(if (string-match "\\`\\." name)
|
||||
clean
|
||||
(let-alist--list-to-sexp
|
||||
(mapcar #'intern (nreverse (split-string name "\\.")))
|
||||
variable))))
|
||||
|
||||
(defun let-alist--list-to-sexp (list var)
|
||||
"Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
|
||||
`(cdr (assq ',(car list)
|
||||
,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
|
||||
var))))
|
||||
|
||||
(defun let-alist--remove-dot (symbol)
|
||||
"Return SYMBOL, sans an initial dot."
|
||||
(let ((name (symbol-name symbol)))
|
||||
(if (string-match "\\`\\." name)
|
||||
(intern (replace-match "" nil nil name))
|
||||
symbol)))
|
||||
|
||||
|
||||
;;; The actual macro.
|
||||
;;;###autoload
|
||||
(defmacro let-alist (alist &rest body)
|
||||
"Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
|
||||
Dotted symbol is any symbol starting with a `.'. Only those present
|
||||
in BODY are let-bound and this search is done at compile time.
|
||||
|
||||
For instance, the following code
|
||||
|
||||
(let-alist alist
|
||||
(if (and .title .body)
|
||||
.body
|
||||
.site
|
||||
.site.contents))
|
||||
|
||||
essentially expands to
|
||||
|
||||
(let ((.title (cdr (assq \\='title alist)))
|
||||
(.body (cdr (assq \\='body alist)))
|
||||
(.site (cdr (assq \\='site alist)))
|
||||
(.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
|
||||
(if (and .title .body)
|
||||
.body
|
||||
.site
|
||||
.site.contents))
|
||||
|
||||
If you nest `let-alist' invocations, the inner one can't access
|
||||
the variables of the outer one. You can, however, access alists
|
||||
inside the original alist by using dots inside the symbol, as
|
||||
displayed in the example above."
|
||||
(declare (indent 1) (debug t))
|
||||
(let ((var (make-symbol "alist")))
|
||||
`(let ((,var ,alist))
|
||||
(let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
|
||||
(delete-dups (let-alist--deep-dot-search body)))
|
||||
,@body))))
|
||||
|
||||
;;;; ChangeLog:
|
||||
|
||||
;; 2015-12-01 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; packages/let-alist: Define it as a :core package
|
||||
;;
|
||||
;; 2015-06-11 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; * let-alist (let-alist--deep-dot-search): Fix cons
|
||||
;;
|
||||
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; let-alist: Update copyright
|
||||
;;
|
||||
;; 2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; packages/let-alist: Use `make-symbol' instead of `gensym'.
|
||||
;;
|
||||
;; 2014-12-20 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; packages/let-alist: Enable access to deeper alists
|
||||
;;
|
||||
;; 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; let-alist.el: Add lexical binding. Version bump.
|
||||
;;
|
||||
;; 2014-12-11 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;;
|
||||
;; let-alist: New package
|
||||
;;
|
||||
|
||||
|
||||
(provide 'let-alist)
|
||||
|
||||
;;; let-alist.el ends here
|
Binary file not shown.
|
@ -0,0 +1,311 @@
|
|||
Authors
|
||||
=======
|
||||
|
||||
The following people have contributed to Magit, including the
|
||||
libraries `git-commit.el`, `magit-popup.el`, and `with-editor.el`
|
||||
which are distributed as separate Elpa packages.
|
||||
|
||||
For statistics see https://magit.vc/stats/authors.html.
|
||||
|
||||
Names below are sorted alphabetically.
|
||||
|
||||
Author
|
||||
------
|
||||
|
||||
- Marius Vollmer <marius.vollmer@gmail.com>
|
||||
|
||||
Maintainer
|
||||
----------
|
||||
|
||||
- Jonas Bernoulli <jonas@bernoul.li>
|
||||
|
||||
Developers
|
||||
----------
|
||||
|
||||
- Kyle Meyer <kyle@kyleam.com>
|
||||
- Noam Postavsky <npostavs@users.sourceforge.net>
|
||||
|
||||
Retired Maintainers and Developers
|
||||
----------------------------------
|
||||
|
||||
- Nicolas Dudebout <nicolas.dudebout@gatech.edu>
|
||||
- Peter J. Weisberg <pj@irregularexpressions.net>
|
||||
- Pieter Praet <pieter@praet.org>
|
||||
- Phil Jackson <phil@shellarchive.co.uk>
|
||||
- Rémi Vanicat <vanicat@debian.org>
|
||||
- Yann Hodique <yann.hodique@gmail.com>
|
||||
|
||||
Contributors
|
||||
------------
|
||||
|
||||
- Aaron Culich <aculich@gmail.com>
|
||||
- Aaron Madlon-Kay <aaron@madlon-kay.com>
|
||||
- Abdo Roig-Maranges <abdo.roig@gmail.com>
|
||||
- Adam Benanti <0entropy@protonmail.com>
|
||||
- Adam Porter <adam@alphapapa.net>
|
||||
- Adam Spiers <emacs@adamspiers.org>
|
||||
- Adeodato Simó <dato@net.com.org.es>
|
||||
- Ævar Arnfjörð Bjarmason <avarab@gmail.com>
|
||||
- Alan Falloon <alan.falloon@gmail.com>
|
||||
- Alban Gruin <alban@pa1ch.fr>
|
||||
- Aleksey Uimanov <s9gf4ult@gmail.com>
|
||||
- Alexander Gramiak <fice-t@protonmail.com>
|
||||
- Alex Dunn <adunn@ucsb.edu>
|
||||
- Alexey Voinov <alexey.v.voinov@gmail.com>
|
||||
- Alex Kost <alezost@gmail.com>
|
||||
- Alex Ott <alexott@gmail.com>
|
||||
- Allen <darkfeline@felesatra.moe>
|
||||
- Allen Li <darkfeline@felesatra.moe>
|
||||
- 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>
|
||||
- Andriy Kmit' <dev@madand.net>
|
||||
- Andy Sawyer <git@pureabstract.org>
|
||||
- Aria Edmonds <aria@ar1as.space>
|
||||
- Barak A. Pearlmutter <barak+git@pearlmutter.net>
|
||||
- Bar Magal <bmagamb@gmail.com>
|
||||
- Bart Bakker <bart@thesoftwarecraft.com>
|
||||
- Basil L. Contovounesios <contovob@tcd.ie>
|
||||
- Bastian Beischer <beischer@physik.rwth-aachen.de>
|
||||
- Benjamin Motz <benjamin.motz@mailbox.org>
|
||||
- Ben North <ben@redfrontdoor.org>
|
||||
- Ben Walton <bwalton@artsci.utoronto.ca>
|
||||
- Bob Uhl <buhl@zvelo.com>
|
||||
- Bradley Wright <brad@intranation.com>
|
||||
- Brandon W Maister <quodlibetor@gmail.com>
|
||||
- Brian Warner <warner@lothar.com>
|
||||
- Bryan Shell <bryan.shell@orbitz.com>
|
||||
- Buster Copley <buster@buster.me.uk>
|
||||
- Carl Lieberman <liebermancarl@gmail.com>
|
||||
- Chillar Anand <anand21nanda@gmail.com>
|
||||
- Chris Bernard <cebernard@gmail.com>
|
||||
- Chris Done <chrisdone@gmail.com>
|
||||
- Chris LaRose <cjlarose@gmail.com>
|
||||
- Chris Moore <dooglus@gmail.com>
|
||||
- Chris Ring <chris@ringthis.com>
|
||||
- Chris Shoemaker <chris@mojotech.com>
|
||||
- Christian Dietrich <christian.dietrich@informatik.uni-erlangen.de>
|
||||
- Christian Kluge <ckfrakturfreak@web.de>
|
||||
- Christophe Junke <junke.christophe@gmail.com>
|
||||
- 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.me>
|
||||
- Dan Erikson <derikson3@gmail.com>
|
||||
- Daniel Brockman <daniel@gointeractive.se>
|
||||
- Daniel Farina <drfarina@acm.org>
|
||||
- Daniel Gröber <daniel@dps.uibk.ac.at>
|
||||
- Daniel Hackney <dan@haxney.org>
|
||||
- Daniel Kraus <daniel@kraus.my>
|
||||
- Daniel Mai <daniel@danielmai.net>
|
||||
- Dan LaManna <dan.lamanna@gmail.com>
|
||||
- Dato Simó <dato@net.com.org.es>
|
||||
- David Abrahams <dave@boostpro.com>
|
||||
- David Ellison <davide@voicebox.com>
|
||||
- David Hull <david.hull@openx.com>
|
||||
- David L. Rager <ragerdl@gmail.com>
|
||||
- David Wallin <david.wallin@gmail.com>
|
||||
- Dean Kariniemi <8913263+d3k4r@users.noreply.github.com>
|
||||
- Dennis Paskorz <dennis@walltowall.com>
|
||||
- Divye Kapoor <divye@google.com>
|
||||
- Dominique Quatravaux <domq@google.com>
|
||||
- Duianto Vebotci <vebotci@openmailbox.org>
|
||||
- Eli Barzilay <eli@barzilay.org>
|
||||
- Eric Davis <ed@npri.org>
|
||||
- Eric Prud'hommeaux <eric@w3.org>
|
||||
- Eric Schulte <schulte.eric@gmail.com>
|
||||
- Erik Anderson <erikbpanderson@gmail.com>
|
||||
- Evgkeni Sampelnikof <esabof@gmail.com>
|
||||
- Eyal Lotem <eyal.lotem@gmail.com>
|
||||
- Fabian Wiget <fabacino@gmail.com>
|
||||
- Felix Geller <fgeller@gmail.com>
|
||||
- Felix Yan <felixonmars@archlinux.org>
|
||||
- Feng Li <fengli@blackmagicdesign.com>
|
||||
- Florian Ragwitz <rafl@debian.org>
|
||||
- Fritz Grabo <fritz.grabo@gmail.com>
|
||||
- Fritz Stelzer <brotzeitmacher@gmail.com>
|
||||
- Geoff Shannon <geoffpshannon@gmail.com>
|
||||
- George Kadianakis <desnacked@gmail.com>
|
||||
- Graham Clark <grclark@gmail.com>
|
||||
- Graham Dobbins <gdobbins@protonmail.com>
|
||||
- Greg A. Woods <woods@planix.com>
|
||||
- Greg Lucas <greg@glucas.net>
|
||||
- Greg Sexton <gregsexton@gmail.com>
|
||||
- Guillaume Martres <smarter@ubuntu.com>
|
||||
- Hannu Koivisto <azure@iki.fi>
|
||||
- Hans-Peter Deifel <hpdeifel@gmx.de>
|
||||
- Ian Eure <ian.eure@gmail.com>
|
||||
- Ingo Lohmar <i.lohmar@gmail.com>
|
||||
- Ioan-Adrian Ratiu <adi@adirat.com>
|
||||
- Ivan Brennan <ivan.brennan@gmail.com>
|
||||
- Jan Tatarik <jan.tatarik@xing.com>
|
||||
- Jasper St. Pierre <jstpierre@mecheye.net>
|
||||
- Jeff Bellegarde <jbellegarde@whitepages.com>
|
||||
- Jeff Dairiki <dairiki@dairiki.org>
|
||||
- Jeremy Meng <yumeng@microsoft.com>
|
||||
- Jesse Alama <jesse.alama@gmail.com>
|
||||
- Jim Blandy <jimb@red-bean.com>
|
||||
- Joakim Jalap <JOJA@stoneridge.com>
|
||||
- Johann Klähn <kljohann@gmail.com>
|
||||
- John Mastro <john.b.mastro@gmail.com>
|
||||
- John Wiegley <johnw@newartisans.com>
|
||||
- Jonas Bernoulli <jonas@bernoul.li>
|
||||
- Jonathan Leech-Pepin <jonathan.leechpepin@gmail.com>
|
||||
- Jonathan Roes <jroes@jroes.net>
|
||||
- Jon Vanderwijk <jonathn@github.com>
|
||||
- Jordan Greenberg <jordan@softwareslave.com>
|
||||
- Josiah Schwab <jschwab@gmail.com>
|
||||
- Julien Danjou <julien@danjou.info>
|
||||
- Justin Burkett <justin@burkett.cc>
|
||||
- Justin Caratzas <justin.caratzas@gmail.com>
|
||||
- Justin Guenther <jguenther@gmail.com>
|
||||
- Justin Thomas <justin.thomas1@gmail.com>
|
||||
- Kan-Ru Chen <kanru@kanru.info>
|
||||
- Kenny Ballou <kballou@devnulllabs.io>
|
||||
- Keshav Kini <keshav.kini@gmail.com>
|
||||
- Kévin Le Gouguec <kevin.legouguec@gmail.com>
|
||||
- Kimberly Wolk <kimwolk@hotmail.com>
|
||||
- Kyle Meyer <kyle@kyleam.com>
|
||||
- Laurent Laffont <laurent.laffont@gmail.com>
|
||||
- Laverne Schrock <laverne@schrock.email>
|
||||
- Leandro Facchinetti <me@leafac.com>
|
||||
- Lele Gaifax <lele@metapensiero.it>
|
||||
- Leo Liu <sdl.web@gmail.com>
|
||||
- Leonardo Etcheverry <leo@kalio.net>
|
||||
- Lingchao Xin <douglarek@users.noreply.github.com>
|
||||
- Li-Yun Chang <michael142536@gmail.com>
|
||||
- Lluís Vilanova <vilanova@ac.upc.edu>
|
||||
- Loic Dachary <loic@dachary.org>
|
||||
- Luís Oliveira <luismbo@gmail.com>
|
||||
- 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>
|
||||
- Marco Wahl <marcowahlsoft@gmail.com>
|
||||
- Marc Sherry <msherry@gmail.com>
|
||||
- Marian Schubert <marian.schubert@gmail.com>
|
||||
- Mario Rodas <marsam@users.noreply.github.com>
|
||||
- Marius Vollmer <marius.vollmer@gmail.com>
|
||||
- Mark Hepburn <Mark.Hepburn@csiro.au>
|
||||
- Mark Karpov <markkarpov@opmbx.org>
|
||||
- Mark Oteiza <mvoteiza@udel.edu>
|
||||
- Matthew Fluet <matthew.fluet@gmail.com>
|
||||
- Matthieu Hauglustaine <matt.hauglustaine@gmail.com>
|
||||
- Matus Goljer <dota.keys@gmail.com>
|
||||
- Michael Fogleman <michaelwfogleman@gmail.com>
|
||||
- Michael Griffiths <mikey@cich.li>
|
||||
- Michael Heerdegen <michael_heerdegen@web.de>
|
||||
- Michal Sojka <sojkam1@fel.cvut.cz>
|
||||
- Miciah Masters <miciah.masters@gmail.com>
|
||||
- Miles Bader <miles@gnu.org>
|
||||
- Miloš Mošić <mosic.milos@gmail.com>
|
||||
- Mitchel Humpherys <mitch.special@gmail.com>
|
||||
- Moritz Bunkus <moritz@bunkus.org>
|
||||
- Natalie 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>
|
||||
- Nicklas Lindgren <nili@gulmohar.se>
|
||||
- Nicolas Dudebout <nicolas.dudebout@gatech.edu>
|
||||
- Nicolas Petton <nicolas@petton.fr>
|
||||
- Nicolas Richard <theonewiththeevillook@yahoo.fr>
|
||||
- Nikolay Martynov <mar.kolya@gmail.com>
|
||||
- Noam Postavsky <npostavs@users.sourceforge.net>
|
||||
- N. Troy de Freitas <me@ntdef.com>
|
||||
- Ole Arndt <oliver.arndt@cegedim.com>
|
||||
- Oleh Krehel <ohwoeowho@gmail.com>
|
||||
- Orivej Desh <orivej@gmx.fr>
|
||||
- Óscar Fuentes <ofv@wanadoo.es>
|
||||
- Paul Stadig <paul@stadig.name>
|
||||
- Pavel Holejsovsky <pavel.holejsovsky@upek.com>
|
||||
- Pekka Pessi <nospam@pessi.fi>
|
||||
- Peter Eisentraut <peter@eisentraut.org>
|
||||
- Peter Jaros <peter.a.jaros@gmail.com>
|
||||
- Peter J. Weisberg <pj@irregularexpressions.net>
|
||||
- Peter Vasil <mail@petervasil.net>
|
||||
- Philippe Vaucher <philippe.vaucher@gmail.com>
|
||||
- Philipp Haselwarter <philipp@haselwarter.org>
|
||||
- Philipp Stephani <phst@google.com>
|
||||
- Philip Weaver <philip.weaver@gmail.com>
|
||||
- Phil Jackson <phil@shellarchive.co.uk>
|
||||
- Phil Sainty <phil@catalyst.net.nz>
|
||||
- Pierre Neidhardt <ambrevar@gmail.com>
|
||||
- Pieter Praet <pieter@praet.org>
|
||||
- Prathamesh Sonpatki <csonpatki@gmail.com>
|
||||
- rabio <rabiodev@o2.pl>
|
||||
- Radon Rosborough <radon.neon@gmail.com>
|
||||
- Rafael Laboissiere <rafael@laboissiere.net>
|
||||
- Raimon Grau <raimon@3scale.net>
|
||||
- Ramkumar Ramachandra <artagnon@gmail.com>
|
||||
- Remco van 't Veer <rwvtveer@xs4all.nl>
|
||||
- Rémi Vanicat <vanicat@debian.org>
|
||||
- René Stadler <mail@renestadler.de>
|
||||
- Richard Kim <emacs18@gmail.com>
|
||||
- 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.net>
|
||||
- Russell Black <black.russell@gmail.com>
|
||||
- Ryan C. Thompson <rct@thompsonclan.org>
|
||||
- Samuel Bronson <naesten@gmail.com>
|
||||
- Samuel W. Flint <swflint@flintfam.org>
|
||||
- Sanjoy Das <sanjoy@playingwithpointers.com>
|
||||
- Sean Allred <code@seanallred.com>
|
||||
- Sean Bryant <sbryant@hackinggibsons.com>
|
||||
- Sean Whitton <spwhitton@spwhitton.name>
|
||||
- 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>
|
||||
- Silent Sphere <silentsphere110@gmail.com>
|
||||
- Štěpán Němec <stepnem@gmail.com>
|
||||
- Steven Chow <steve@myfreestuffapp.com>
|
||||
- Steven E. Harris <seh@panix.com>
|
||||
- Steven Thomas <sthomas314@gmail.com>
|
||||
- Steven Vancoillie <steven.vancoillie@runbox.com>
|
||||
- Steve Purcell <steve@sanityinc.com>
|
||||
- Suhail Shergill <suhailshergill@gmail.com>
|
||||
- Sylvain Rousseau <thisirs@gmail.com>
|
||||
- Syohei Yoshida <syohex@gmail.com>
|
||||
- Takafumi Arakaki <aka.tkf@gmail.com>
|
||||
- Teemu Likonen <tlikonen@iki.fi>
|
||||
- Teruki Shigitani <teruki.shigitani@gmail.com>
|
||||
- Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
||||
- Thomas A Caswell <tcaswell@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>
|
||||
- Tim Perkins <tprk77@gmail.com>
|
||||
- Tim Wraight <tim@wraight.net>
|
||||
- Ting-Yu Lin <aethanyc@gmail.com>
|
||||
- Tom Feist <shabble@metavore.org>
|
||||
- Tunc Uzlu <bb2020@users.noreply.github.com>
|
||||
- Vineet Naik <vineet@helpshift.com>
|
||||
- Vladimir Panteleev <git@thecybershadow.net>
|
||||
- Wei Huang <weih@opera.com>
|
||||
- Wilfred Hughes <me@wilfred.me.uk>
|
||||
- Win Treese <treese@acm.org>
|
||||
- Wouter Bolsterlee <wouter@bolsterl.ee>
|
||||
- Xavier Noria <fxn@hashref.com>
|
||||
- Xu Chunyang <mail@xuchunyang.me>
|
||||
- Yann Hodique <yann.hodique@gmail.com>
|
||||
- York Zhao <gtdplatform@gmail.com>
|
||||
- Yuichi Higashi <aaa707b@gmail.com>
|
||||
- Yuri Khan <yurivkhan@gmail.com>
|
||||
- Zach Latta <zach@zachlatta.com>
|
|
@ -0,0 +1,676 @@
|
|||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The GNU General Public License is a free, copyleft license for
|
||||
software and other kinds of works.
|
||||
|
||||
The licenses for most software and other practical works are designed
|
||||
to take away your freedom to share and change the works. By contrast,
|
||||
the GNU General Public License is intended to guarantee your freedom to
|
||||
share and change all versions of a program--to make sure it remains free
|
||||
software for all its users. We, the Free Software Foundation, use the
|
||||
GNU General Public License for most of our software; it applies also to
|
||||
any other work released this way by its authors. You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
them if you wish), that you receive source code or can get it if you
|
||||
want it, that you can change the software or use pieces of it in new
|
||||
free programs, and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to prevent others from denying you
|
||||
these rights or asking you to surrender the rights. Therefore, you have
|
||||
certain responsibilities if you distribute copies of the software, or if
|
||||
you modify it: responsibilities to respect the freedom of others.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must pass on to the recipients the same
|
||||
freedoms that you received. You must make sure that they, too, receive
|
||||
or can get the source code. And you must show them these terms so they
|
||||
know their rights.
|
||||
|
||||
Developers that use the GNU GPL protect your rights with two steps:
|
||||
(1) assert copyright on the software, and (2) offer you this License
|
||||
giving you legal permission to copy, distribute and/or modify it.
|
||||
|
||||
For the developers' and authors' protection, the GPL clearly explains
|
||||
that there is no warranty for this free software. For both users' and
|
||||
authors' sake, the GPL requires that modified versions be marked as
|
||||
changed, so that their problems will not be attributed erroneously to
|
||||
authors of previous versions.
|
||||
|
||||
Some devices are designed to deny users access to install or run
|
||||
modified versions of the software inside them, although the manufacturer
|
||||
can do so. This is fundamentally incompatible with the aim of
|
||||
protecting users' freedom to change the software. The systematic
|
||||
pattern of such abuse occurs in the area of products for individuals to
|
||||
use, which is precisely where it is most unacceptable. Therefore, we
|
||||
have designed this version of the GPL to prohibit the practice for those
|
||||
products. If such problems arise substantially in other domains, we
|
||||
stand ready to extend this provision to those domains in future versions
|
||||
of the GPL, as needed to protect the freedom of users.
|
||||
|
||||
Finally, every program is threatened constantly by software patents.
|
||||
States should not allow patents to restrict development and use of
|
||||
software on general-purpose computers, but in those that do, we wish to
|
||||
avoid the special danger that patents applied to a free program could
|
||||
make it effectively proprietary. To prevent this, the GPL assures that
|
||||
patents cannot be used to render the program non-free.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
TERMS AND CONDITIONS
|
||||
|
||||
0. Definitions.
|
||||
|
||||
"This License" refers to version 3 of the GNU General Public License.
|
||||
|
||||
"Copyright" also means copyright-like laws that apply to other kinds of
|
||||
works, such as semiconductor masks.
|
||||
|
||||
"The Program" refers to any copyrightable work licensed under this
|
||||
License. Each licensee is addressed as "you". "Licensees" and
|
||||
"recipients" may be individuals or organizations.
|
||||
|
||||
To "modify" a work means to copy from or adapt all or part of the work
|
||||
in a fashion requiring copyright permission, other than the making of an
|
||||
exact copy. The resulting work is called a "modified version" of the
|
||||
earlier work or a work "based on" the earlier work.
|
||||
|
||||
A "covered work" means either the unmodified Program or a work based
|
||||
on the Program.
|
||||
|
||||
To "propagate" a work means to do anything with it that, without
|
||||
permission, would make you directly or secondarily liable for
|
||||
infringement under applicable copyright law, except executing it on a
|
||||
computer or modifying a private copy. Propagation includes copying,
|
||||
distribution (with or without modification), making available to the
|
||||
public, and in some countries other activities as well.
|
||||
|
||||
To "convey" a work means any kind of propagation that enables other
|
||||
parties to make or receive copies. Mere interaction with a user through
|
||||
a computer network, with no transfer of a copy, is not conveying.
|
||||
|
||||
An interactive user interface displays "Appropriate Legal Notices"
|
||||
to the extent that it includes a convenient and prominently visible
|
||||
feature that (1) displays an appropriate copyright notice, and (2)
|
||||
tells the user that there is no warranty for the work (except to the
|
||||
extent that warranties are provided), that licensees may convey the
|
||||
work under this License, and how to view a copy of this License. If
|
||||
the interface presents a list of user commands or options, such as a
|
||||
menu, a prominent item in the list meets this criterion.
|
||||
|
||||
1. Source Code.
|
||||
|
||||
The "source code" for a work means the preferred form of the work
|
||||
for making modifications to it. "Object code" means any non-source
|
||||
form of a work.
|
||||
|
||||
A "Standard Interface" means an interface that either is an official
|
||||
standard defined by a recognized standards body, or, in the case of
|
||||
interfaces specified for a particular programming language, one that
|
||||
is widely used among developers working in that language.
|
||||
|
||||
The "System Libraries" of an executable work include anything, other
|
||||
than the work as a whole, that (a) is included in the normal form of
|
||||
packaging a Major Component, but which is not part of that Major
|
||||
Component, and (b) serves only to enable use of the work with that
|
||||
Major Component, or to implement a Standard Interface for which an
|
||||
implementation is available to the public in source code form. A
|
||||
"Major Component", in this context, means a major essential component
|
||||
(kernel, window system, and so on) of the specific operating system
|
||||
(if any) on which the executable work runs, or a compiler used to
|
||||
produce the work, or an object code interpreter used to run it.
|
||||
|
||||
The "Corresponding Source" for a work in object code form means all
|
||||
the source code needed to generate, install, and (for an executable
|
||||
work) run the object code and to modify the work, including scripts to
|
||||
control those activities. However, it does not include the work's
|
||||
System Libraries, or general-purpose tools or generally available free
|
||||
programs which are used unmodified in performing those activities but
|
||||
which are not part of the work. For example, Corresponding Source
|
||||
includes interface definition files associated with source files for
|
||||
the work, and the source code for shared libraries and dynamically
|
||||
linked subprograms that the work is specifically designed to require,
|
||||
such as by intimate data communication or control flow between those
|
||||
subprograms and other parts of the work.
|
||||
|
||||
The Corresponding Source need not include anything that users
|
||||
can regenerate automatically from other parts of the Corresponding
|
||||
Source.
|
||||
|
||||
The Corresponding Source for a work in source code form is that
|
||||
same work.
|
||||
|
||||
2. Basic Permissions.
|
||||
|
||||
All rights granted under this License are granted for the term of
|
||||
copyright on the Program, and are irrevocable provided the stated
|
||||
conditions are met. This License explicitly affirms your unlimited
|
||||
permission to run the unmodified Program. The output from running a
|
||||
covered work is covered by this License only if the output, given its
|
||||
content, constitutes a covered work. This License acknowledges your
|
||||
rights of fair use or other equivalent, as provided by copyright law.
|
||||
|
||||
You may make, run and propagate covered works that you do not
|
||||
convey, without conditions so long as your license otherwise remains
|
||||
in force. You may convey covered works to others for the sole purpose
|
||||
of having them make modifications exclusively for you, or provide you
|
||||
with facilities for running those works, provided that you comply with
|
||||
the terms of this License in conveying all material for which you do
|
||||
not control copyright. Those thus making or running the covered works
|
||||
for you must do so exclusively on your behalf, under your direction
|
||||
and control, on terms that prohibit them from making any copies of
|
||||
your copyrighted material outside their relationship with you.
|
||||
|
||||
Conveying under any other circumstances is permitted solely under
|
||||
the conditions stated below. Sublicensing is not allowed; section 10
|
||||
makes it unnecessary.
|
||||
|
||||
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
|
||||
|
||||
No covered work shall be deemed part of an effective technological
|
||||
measure under any applicable law fulfilling obligations under article
|
||||
11 of the WIPO copyright treaty adopted on 20 December 1996, or
|
||||
similar laws prohibiting or restricting circumvention of such
|
||||
measures.
|
||||
|
||||
When you convey a covered work, you waive any legal power to forbid
|
||||
circumvention of technological measures to the extent such circumvention
|
||||
is effected by exercising rights under this License with respect to
|
||||
the covered work, and you disclaim any intention to limit operation or
|
||||
modification of the work as a means of enforcing, against the work's
|
||||
users, your or third parties' legal rights to forbid circumvention of
|
||||
technological measures.
|
||||
|
||||
4. Conveying Verbatim Copies.
|
||||
|
||||
You may convey verbatim copies of the Program's source code as you
|
||||
receive it, in any medium, provided that you conspicuously and
|
||||
appropriately publish on each copy an appropriate copyright notice;
|
||||
keep intact all notices stating that this License and any
|
||||
non-permissive terms added in accord with section 7 apply to the code;
|
||||
keep intact all notices of the absence of any warranty; and give all
|
||||
recipients a copy of this License along with the Program.
|
||||
|
||||
You may charge any price or no price for each copy that you convey,
|
||||
and you may offer support or warranty protection for a fee.
|
||||
|
||||
5. Conveying Modified Source Versions.
|
||||
|
||||
You may convey a work based on the Program, or the modifications to
|
||||
produce it from the Program, in the form of source code under the
|
||||
terms of section 4, provided that you also meet all of these conditions:
|
||||
|
||||
a) The work must carry prominent notices stating that you modified
|
||||
it, and giving a relevant date.
|
||||
|
||||
b) The work must carry prominent notices stating that it is
|
||||
released under this License and any conditions added under section
|
||||
7. This requirement modifies the requirement in section 4 to
|
||||
"keep intact all notices".
|
||||
|
||||
c) You must license the entire work, as a whole, under this
|
||||
License to anyone who comes into possession of a copy. This
|
||||
License will therefore apply, along with any applicable section 7
|
||||
additional terms, to the whole of the work, and all its parts,
|
||||
regardless of how they are packaged. This License gives no
|
||||
permission to license the work in any other way, but it does not
|
||||
invalidate such permission if you have separately received it.
|
||||
|
||||
d) If the work has interactive user interfaces, each must display
|
||||
Appropriate Legal Notices; however, if the Program has interactive
|
||||
interfaces that do not display Appropriate Legal Notices, your
|
||||
work need not make them do so.
|
||||
|
||||
A compilation of a covered work with other separate and independent
|
||||
works, which are not by their nature extensions of the covered work,
|
||||
and which are not combined with it such as to form a larger program,
|
||||
in or on a volume of a storage or distribution medium, is called an
|
||||
"aggregate" if the compilation and its resulting copyright are not
|
||||
used to limit the access or legal rights of the compilation's users
|
||||
beyond what the individual works permit. Inclusion of a covered work
|
||||
in an aggregate does not cause this License to apply to the other
|
||||
parts of the aggregate.
|
||||
|
||||
6. Conveying Non-Source Forms.
|
||||
|
||||
You may convey a covered work in object code form under the terms
|
||||
of sections 4 and 5, provided that you also convey the
|
||||
machine-readable Corresponding Source under the terms of this License,
|
||||
in one of these ways:
|
||||
|
||||
a) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by the
|
||||
Corresponding Source fixed on a durable physical medium
|
||||
customarily used for software interchange.
|
||||
|
||||
b) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by a
|
||||
written offer, valid for at least three years and valid for as
|
||||
long as you offer spare parts or customer support for that product
|
||||
model, to give anyone who possesses the object code either (1) a
|
||||
copy of the Corresponding Source for all the software in the
|
||||
product that is covered by this License, on a durable physical
|
||||
medium customarily used for software interchange, for a price no
|
||||
more than your reasonable cost of physically performing this
|
||||
conveying of source, or (2) access to copy the
|
||||
Corresponding Source from a network server at no charge.
|
||||
|
||||
c) Convey individual copies of the object code with a copy of the
|
||||
written offer to provide the Corresponding Source. This
|
||||
alternative is allowed only occasionally and noncommercially, and
|
||||
only if you received the object code with such an offer, in accord
|
||||
with subsection 6b.
|
||||
|
||||
d) Convey the object code by offering access from a designated
|
||||
place (gratis or for a charge), and offer equivalent access to the
|
||||
Corresponding Source in the same way through the same place at no
|
||||
further charge. You need not require recipients to copy the
|
||||
Corresponding Source along with the object code. If the place to
|
||||
copy the object code is a network server, the Corresponding Source
|
||||
may be on a different server (operated by you or a third party)
|
||||
that supports equivalent copying facilities, provided you maintain
|
||||
clear directions next to the object code saying where to find the
|
||||
Corresponding Source. Regardless of what server hosts the
|
||||
Corresponding Source, you remain obligated to ensure that it is
|
||||
available for as long as needed to satisfy these requirements.
|
||||
|
||||
e) Convey the object code using peer-to-peer transmission, provided
|
||||
you inform other peers where the object code and Corresponding
|
||||
Source of the work are being offered to the general public at no
|
||||
charge under subsection 6d.
|
||||
|
||||
A separable portion of the object code, whose source code is excluded
|
||||
from the Corresponding Source as a System Library, need not be
|
||||
included in conveying the object code work.
|
||||
|
||||
A "User Product" is either (1) a "consumer product", which means any
|
||||
tangible personal property which is normally used for personal, family,
|
||||
or household purposes, or (2) anything designed or sold for incorporation
|
||||
into a dwelling. In determining whether a product is a consumer product,
|
||||
doubtful cases shall be resolved in favor of coverage. For a particular
|
||||
product received by a particular user, "normally used" refers to a
|
||||
typical or common use of that class of product, regardless of the status
|
||||
of the particular user or of the way in which the particular user
|
||||
actually uses, or expects or is expected to use, the product. A product
|
||||
is a consumer product regardless of whether the product has substantial
|
||||
commercial, industrial or non-consumer uses, unless such uses represent
|
||||
the only significant mode of use of the product.
|
||||
|
||||
"Installation Information" for a User Product means any methods,
|
||||
procedures, authorization keys, or other information required to install
|
||||
and execute modified versions of a covered work in that User Product from
|
||||
a modified version of its Corresponding Source. The information must
|
||||
suffice to ensure that the continued functioning of the modified object
|
||||
code is in no case prevented or interfered with solely because
|
||||
modification has been made.
|
||||
|
||||
If you convey an object code work under this section in, or with, or
|
||||
specifically for use in, a User Product, and the conveying occurs as
|
||||
part of a transaction in which the right of possession and use of the
|
||||
User Product is transferred to the recipient in perpetuity or for a
|
||||
fixed term (regardless of how the transaction is characterized), the
|
||||
Corresponding Source conveyed under this section must be accompanied
|
||||
by the Installation Information. But this requirement does not apply
|
||||
if neither you nor any third party retains the ability to install
|
||||
modified object code on the User Product (for example, the work has
|
||||
been installed in ROM).
|
||||
|
||||
The requirement to provide Installation Information does not include a
|
||||
requirement to continue to provide support service, warranty, or updates
|
||||
for a work that has been modified or installed by the recipient, or for
|
||||
the User Product in which it has been modified or installed. Access to a
|
||||
network may be denied when the modification itself materially and
|
||||
adversely affects the operation of the network or violates the rules and
|
||||
protocols for communication across the network.
|
||||
|
||||
Corresponding Source conveyed, and Installation Information provided,
|
||||
in accord with this section must be in a format that is publicly
|
||||
documented (and with an implementation available to the public in
|
||||
source code form), and must require no special password or key for
|
||||
unpacking, reading or copying.
|
||||
|
||||
7. Additional Terms.
|
||||
|
||||
"Additional permissions" are terms that supplement the terms of this
|
||||
License by making exceptions from one or more of its conditions.
|
||||
Additional permissions that are applicable to the entire Program shall
|
||||
be treated as though they were included in this License, to the extent
|
||||
that they are valid under applicable law. If additional permissions
|
||||
apply only to part of the Program, that part may be used separately
|
||||
under those permissions, but the entire Program remains governed by
|
||||
this License without regard to the additional permissions.
|
||||
|
||||
When you convey a copy of a covered work, you may at your option
|
||||
remove any additional permissions from that copy, or from any part of
|
||||
it. (Additional permissions may be written to require their own
|
||||
removal in certain cases when you modify the work.) You may place
|
||||
additional permissions on material, added by you to a covered work,
|
||||
for which you have or can give appropriate copyright permission.
|
||||
|
||||
Notwithstanding any other provision of this License, for material you
|
||||
add to a covered work, you may (if authorized by the copyright holders of
|
||||
that material) supplement the terms of this License with terms:
|
||||
|
||||
a) Disclaiming warranty or limiting liability differently from the
|
||||
terms of sections 15 and 16 of this License; or
|
||||
|
||||
b) Requiring preservation of specified reasonable legal notices or
|
||||
author attributions in that material or in the Appropriate Legal
|
||||
Notices displayed by works containing it; or
|
||||
|
||||
c) Prohibiting misrepresentation of the origin of that material, or
|
||||
requiring that modified versions of such material be marked in
|
||||
reasonable ways as different from the original version; or
|
||||
|
||||
d) Limiting the use for publicity purposes of names of licensors or
|
||||
authors of the material; or
|
||||
|
||||
e) Declining to grant rights under trademark law for use of some
|
||||
trade names, trademarks, or service marks; or
|
||||
|
||||
f) Requiring indemnification of licensors and authors of that
|
||||
material by anyone who conveys the material (or modified versions of
|
||||
it) with contractual assumptions of liability to the recipient, for
|
||||
any liability that these contractual assumptions directly impose on
|
||||
those licensors and authors.
|
||||
|
||||
All other non-permissive additional terms are considered "further
|
||||
restrictions" within the meaning of section 10. If the Program as you
|
||||
received it, or any part of it, contains a notice stating that it is
|
||||
governed by this License along with a term that is a further
|
||||
restriction, you may remove that term. If a license document contains
|
||||
a further restriction but permits relicensing or conveying under this
|
||||
License, you may add to a covered work material governed by the terms
|
||||
of that license document, provided that the further restriction does
|
||||
not survive such relicensing or conveying.
|
||||
|
||||
If you add terms to a covered work in accord with this section, you
|
||||
must place, in the relevant source files, a statement of the
|
||||
additional terms that apply to those files, or a notice indicating
|
||||
where to find the applicable terms.
|
||||
|
||||
Additional terms, permissive or non-permissive, may be stated in the
|
||||
form of a separately written license, or stated as exceptions;
|
||||
the above requirements apply either way.
|
||||
|
||||
8. Termination.
|
||||
|
||||
You may not propagate or modify a covered work except as expressly
|
||||
provided under this License. Any attempt otherwise to propagate or
|
||||
modify it is void, and will automatically terminate your rights under
|
||||
this License (including any patent licenses granted under the third
|
||||
paragraph of section 11).
|
||||
|
||||
However, if you cease all violation of this License, then your
|
||||
license from a particular copyright holder is reinstated (a)
|
||||
provisionally, unless and until the copyright holder explicitly and
|
||||
finally terminates your license, and (b) permanently, if the copyright
|
||||
holder fails to notify you of the violation by some reasonable means
|
||||
prior to 60 days after the cessation.
|
||||
|
||||
Moreover, your license from a particular copyright holder is
|
||||
reinstated permanently if the copyright holder notifies you of the
|
||||
violation by some reasonable means, this is the first time you have
|
||||
received notice of violation of this License (for any work) from that
|
||||
copyright holder, and you cure the violation prior to 30 days after
|
||||
your receipt of the notice.
|
||||
|
||||
Termination of your rights under this section does not terminate the
|
||||
licenses of parties who have received copies or rights from you under
|
||||
this License. If your rights have been terminated and not permanently
|
||||
reinstated, you do not qualify to receive new licenses for the same
|
||||
material under section 10.
|
||||
|
||||
9. Acceptance Not Required for Having Copies.
|
||||
|
||||
You are not required to accept this License in order to receive or
|
||||
run a copy of the Program. Ancillary propagation of a covered work
|
||||
occurring solely as a consequence of using peer-to-peer transmission
|
||||
to receive a copy likewise does not require acceptance. However,
|
||||
nothing other than this License grants you permission to propagate or
|
||||
modify any covered work. These actions infringe copyright if you do
|
||||
not accept this License. Therefore, by modifying or propagating a
|
||||
covered work, you indicate your acceptance of this License to do so.
|
||||
|
||||
10. Automatic Licensing of Downstream Recipients.
|
||||
|
||||
Each time you convey a covered work, the recipient automatically
|
||||
receives a license from the original licensors, to run, modify and
|
||||
propagate that work, subject to this License. You are not responsible
|
||||
for enforcing compliance by third parties with this License.
|
||||
|
||||
An "entity transaction" is a transaction transferring control of an
|
||||
organization, or substantially all assets of one, or subdividing an
|
||||
organization, or merging organizations. If propagation of a covered
|
||||
work results from an entity transaction, each party to that
|
||||
transaction who receives a copy of the work also receives whatever
|
||||
licenses to the work the party's predecessor in interest had or could
|
||||
give under the previous paragraph, plus a right to possession of the
|
||||
Corresponding Source of the work from the predecessor in interest, if
|
||||
the predecessor has it or can get it with reasonable efforts.
|
||||
|
||||
You may not impose any further restrictions on the exercise of the
|
||||
rights granted or affirmed under this License. For example, you may
|
||||
not impose a license fee, royalty, or other charge for exercise of
|
||||
rights granted under this License, and you may not initiate litigation
|
||||
(including a cross-claim or counterclaim in a lawsuit) alleging that
|
||||
any patent claim is infringed by making, using, selling, offering for
|
||||
sale, or importing the Program or any portion of it.
|
||||
|
||||
11. Patents.
|
||||
|
||||
A "contributor" is a copyright holder who authorizes use under this
|
||||
License of the Program or a work on which the Program is based. The
|
||||
work thus licensed is called the contributor's "contributor version".
|
||||
|
||||
A contributor's "essential patent claims" are all patent claims
|
||||
owned or controlled by the contributor, whether already acquired or
|
||||
hereafter acquired, that would be infringed by some manner, permitted
|
||||
by this License, of making, using, or selling its contributor version,
|
||||
but do not include claims that would be infringed only as a
|
||||
consequence of further modification of the contributor version. For
|
||||
purposes of this definition, "control" includes the right to grant
|
||||
patent sublicenses in a manner consistent with the requirements of
|
||||
this License.
|
||||
|
||||
Each contributor grants you a non-exclusive, worldwide, royalty-free
|
||||
patent license under the contributor's essential patent claims, to
|
||||
make, use, sell, offer for sale, import and otherwise run, modify and
|
||||
propagate the contents of its contributor version.
|
||||
|
||||
In the following three paragraphs, a "patent license" is any express
|
||||
agreement or commitment, however denominated, not to enforce a patent
|
||||
(such as an express permission to practice a patent or covenant not to
|
||||
sue for patent infringement). To "grant" such a patent license to a
|
||||
party means to make such an agreement or commitment not to enforce a
|
||||
patent against the party.
|
||||
|
||||
If you convey a covered work, knowingly relying on a patent license,
|
||||
and the Corresponding Source of the work is not available for anyone
|
||||
to copy, free of charge and under the terms of this License, through a
|
||||
publicly available network server or other readily accessible means,
|
||||
then you must either (1) cause the Corresponding Source to be so
|
||||
available, or (2) arrange to deprive yourself of the benefit of the
|
||||
patent license for this particular work, or (3) arrange, in a manner
|
||||
consistent with the requirements of this License, to extend the patent
|
||||
license to downstream recipients. "Knowingly relying" means you have
|
||||
actual knowledge that, but for the patent license, your conveying the
|
||||
covered work in a country, or your recipient's use of the covered work
|
||||
in a country, would infringe one or more identifiable patents in that
|
||||
country that you have reason to believe are valid.
|
||||
|
||||
If, pursuant to or in connection with a single transaction or
|
||||
arrangement, you convey, or propagate by procuring conveyance of, a
|
||||
covered work, and grant a patent license to some of the parties
|
||||
receiving the covered work authorizing them to use, propagate, modify
|
||||
or convey a specific copy of the covered work, then the patent license
|
||||
you grant is automatically extended to all recipients of the covered
|
||||
work and works based on it.
|
||||
|
||||
A patent license is "discriminatory" if it does not include within
|
||||
the scope of its coverage, prohibits the exercise of, or is
|
||||
conditioned on the non-exercise of one or more of the rights that are
|
||||
specifically granted under this License. You may not convey a covered
|
||||
work if you are a party to an arrangement with a third party that is
|
||||
in the business of distributing software, under which you make payment
|
||||
to the third party based on the extent of your activity of conveying
|
||||
the work, and under which the third party grants, to any of the
|
||||
parties who would receive the covered work from you, a discriminatory
|
||||
patent license (a) in connection with copies of the covered work
|
||||
conveyed by you (or copies made from those copies), or (b) primarily
|
||||
for and in connection with specific products or compilations that
|
||||
contain the covered work, unless you entered into that arrangement,
|
||||
or that patent license was granted, prior to 28 March 2007.
|
||||
|
||||
Nothing in this License shall be construed as excluding or limiting
|
||||
any implied license or other defenses to infringement that may
|
||||
otherwise be available to you under applicable patent law.
|
||||
|
||||
12. No Surrender of Others' Freedom.
|
||||
|
||||
If conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot convey a
|
||||
covered work so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you may
|
||||
not convey it at all. For example, if you agree to terms that obligate you
|
||||
to collect a royalty for further conveying from those to whom you convey
|
||||
the Program, the only way you could satisfy both those terms and this
|
||||
License would be to refrain entirely from conveying the Program.
|
||||
|
||||
13. Use with the GNU Affero General Public License.
|
||||
|
||||
Notwithstanding any other provision of this License, you have
|
||||
permission to link or combine any covered work with a work licensed
|
||||
under version 3 of the GNU Affero General Public License into a single
|
||||
combined work, and to convey the resulting work. The terms of this
|
||||
License will continue to apply to the part which is the covered work,
|
||||
but the special requirements of the GNU Affero General Public License,
|
||||
section 13, concerning interaction through a network will apply to the
|
||||
combination as such.
|
||||
|
||||
14. Revised Versions of this License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions of
|
||||
the GNU General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Program specifies that a certain numbered version of the GNU General
|
||||
Public License "or any later version" applies to it, you have the
|
||||
option of following the terms and conditions either of that numbered
|
||||
version or of any later version published by the Free Software
|
||||
Foundation. If the Program does not specify a version number of the
|
||||
GNU General Public License, you may choose any version ever published
|
||||
by the Free Software Foundation.
|
||||
|
||||
If the Program specifies that a proxy can decide which future
|
||||
versions of the GNU General Public License can be used, that proxy's
|
||||
public statement of acceptance of a version permanently authorizes you
|
||||
to choose that version for the Program.
|
||||
|
||||
Later license versions may give you additional or different
|
||||
permissions. However, no additional obligations are imposed on any
|
||||
author or copyright holder as a result of your choosing to follow a
|
||||
later version.
|
||||
|
||||
15. Disclaimer of Warranty.
|
||||
|
||||
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
|
||||
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
|
||||
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
|
||||
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
|
||||
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
|
||||
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||
|
||||
16. Limitation of Liability.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
|
||||
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
|
||||
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
|
||||
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
|
||||
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
|
||||
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
|
||||
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGES.
|
||||
|
||||
17. Interpretation of Sections 15 and 16.
|
||||
|
||||
If the disclaimer of warranty and limitation of liability provided
|
||||
above cannot be given local legal effect according to their terms,
|
||||
reviewing courts shall apply local law that most closely approximates
|
||||
an absolute waiver of all civil liability in connection with the
|
||||
Program, unless a warranty or assumption of liability accompanies a
|
||||
copy of the Program in return for a fee.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
state the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
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/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program does terminal interaction, make it output a short
|
||||
notice like this when it starts in an interactive mode:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, your program's commands
|
||||
might be different; for a GUI interface, you would use an "about box".
|
||||
|
||||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<http://www.gnu.org/licenses/>.
|
||||
|
||||
The GNU General Public License does not permit incorporating your program
|
||||
into proprietary programs. If your program is a subroutine library, you
|
||||
may consider it more useful to permit linking proprietary applications with
|
||||
the library. If this is what you want to do, use the GNU Lesser General
|
||||
Public License instead of this License. But first, please read
|
||||
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
This is the file .../info/dir, which contains the
|
||||
topmost node of the Info hierarchy, called (dir)Top.
|
||||
The first time you invoke Info you start off looking at this node.
|
||||
|
||||
File: dir, Node: Top This is the top of the INFO tree
|
||||
|
||||
This (the Directory node) gives a menu of major topics.
|
||||
Typing "q" exits, "H" lists all Info commands, "d" returns here,
|
||||
"h" gives a primer for first-timers,
|
||||
"mEmacs<Return>" visits the Emacs manual, etc.
|
||||
|
||||
In Emacs, you can click mouse button 2 on a menu item or cross reference
|
||||
to select it.
|
||||
|
||||
* Menu:
|
||||
|
||||
Emacs
|
||||
* Magit: (magit). Using Git from Emacs with Magit.
|
|
@ -0,0 +1,592 @@
|
|||
;;; git-rebase.el --- Edit Git rebase files -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Phil Jackson <phil@shellarchive.co.uk>
|
||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This package assists the user in editing the list of commits to be
|
||||
;; rewritten during an interactive rebase.
|
||||
|
||||
;; When the user initiates an interactive rebase, e.g. using "r e" in
|
||||
;; a Magit buffer or on the command line using "git rebase -i REV",
|
||||
;; Git invokes the `$GIT_SEQUENCE_EDITOR' (or if that is undefined
|
||||
;; `$GIT_EDITOR' or even `$EDITOR') letting the user rearrange, drop,
|
||||
;; reword, edit, and squash commits.
|
||||
|
||||
;; This package provides the major-mode `git-rebase-mode' which makes
|
||||
;; doing so much more fun, by making the buffer more colorful and
|
||||
;; providing the following commands:
|
||||
;;
|
||||
;; C-c C-c Tell Git to make it happen.
|
||||
;; C-c C-k Tell Git that you changed your mind, i.e. abort.
|
||||
;;
|
||||
;; p Move point to previous line.
|
||||
;; n Move point to next line.
|
||||
;;
|
||||
;; M-p Move the commit at point up.
|
||||
;; M-n Move the commit at point down.
|
||||
;;
|
||||
;; k Drop the commit at point.
|
||||
;; c Don't drop the commit at point.
|
||||
;; r Change the message of the commit at point.
|
||||
;; e Edit the commit at point.
|
||||
;; s Squash the commit at point, into the one above.
|
||||
;; f Like "s" but don't also edit the commit message.
|
||||
;; x Add a script to be run with the commit at point
|
||||
;; being checked out.
|
||||
;; z Add noop action at point.
|
||||
;;
|
||||
;; SPC Show the commit at point in another buffer.
|
||||
;; RET Show the commit at point in another buffer and
|
||||
;; select its window.
|
||||
;; C-/ Undo last change.
|
||||
|
||||
;; You should probably also read the `git-rebase' manpage.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'easymenu)
|
||||
(require 'server)
|
||||
(require 'with-editor)
|
||||
(require 'magit)
|
||||
|
||||
(and (require 'async-bytecomp nil t)
|
||||
(memq 'magit (bound-and-true-p async-bytecomp-allowed-packages))
|
||||
(fboundp 'async-bytecomp-package-mode)
|
||||
(async-bytecomp-package-mode 1))
|
||||
|
||||
(eval-when-compile (require 'recentf))
|
||||
|
||||
;;; Options
|
||||
;;;; Variables
|
||||
|
||||
(defgroup git-rebase nil
|
||||
"Edit Git rebase sequences."
|
||||
:link '(info-link "(magit)Editing Rebase Sequences")
|
||||
:group 'tools)
|
||||
|
||||
(defcustom git-rebase-auto-advance t
|
||||
"Whether to move to next line after changing a line."
|
||||
:group 'git-rebase
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom git-rebase-show-instructions t
|
||||
"Whether to show usage instructions inside the rebase buffer."
|
||||
:group 'git-rebase
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom git-rebase-confirm-cancel t
|
||||
"Whether confirmation is required to cancel."
|
||||
: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 '((t (:inherit magit-hash)))
|
||||
"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
|
||||
'((t (:inherit font-lock-comment-face :strike-through t)))
|
||||
"Face for commented action and exec lines."
|
||||
:group 'git-rebase-faces)
|
||||
|
||||
(defface git-rebase-comment-hash
|
||||
'((t (:inherit git-rebase-hash :weight bold)))
|
||||
"Face for commit hashes in commit message comments."
|
||||
:group 'git-rebase-faces)
|
||||
|
||||
(defface git-rebase-comment-heading
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face for headings in rebase message comments."
|
||||
:group 'git-commit-faces)
|
||||
|
||||
;;; Keymaps
|
||||
|
||||
(defvar git-rebase-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map special-mode-map)
|
||||
(cond ((featurep 'jkl)
|
||||
(define-key map [return] 'git-rebase-show-commit)
|
||||
(define-key map (kbd "i") 'git-rebase-backward-line)
|
||||
(define-key map (kbd "k") 'forward-line)
|
||||
(define-key map (kbd "M-i") 'git-rebase-move-line-up)
|
||||
(define-key map (kbd "M-k") 'git-rebase-move-line-down)
|
||||
(define-key map (kbd "p") 'git-rebase-pick)
|
||||
(define-key map (kbd ",") 'git-rebase-kill-line))
|
||||
(t
|
||||
(define-key map (kbd "C-m") 'git-rebase-show-commit)
|
||||
(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 "c") 'git-rebase-pick)
|
||||
(define-key map (kbd "k") 'git-rebase-kill-line)
|
||||
(define-key map (kbd "C-k") 'git-rebase-kill-line)))
|
||||
(define-key map (kbd "e") 'git-rebase-edit)
|
||||
(define-key map (kbd "m") 'git-rebase-edit)
|
||||
(define-key map (kbd "f") 'git-rebase-fixup)
|
||||
(define-key map (kbd "q") 'undefined)
|
||||
(define-key map (kbd "r") 'git-rebase-reword)
|
||||
(define-key map (kbd "w") 'git-rebase-reword)
|
||||
(define-key map (kbd "s") 'git-rebase-squash)
|
||||
(define-key map (kbd "x") 'git-rebase-exec)
|
||||
(define-key map (kbd "y") 'git-rebase-insert)
|
||||
(define-key map (kbd "z") 'git-rebase-noop)
|
||||
(define-key map (kbd "SPC") 'git-rebase-show-or-scroll-up)
|
||||
(define-key map (kbd "DEL") 'git-rebase-show-or-scroll-down)
|
||||
(define-key map (kbd "C-x C-t") 'git-rebase-move-line-up)
|
||||
(define-key map [M-up] 'git-rebase-move-line-up)
|
||||
(define-key map [M-down] 'git-rebase-move-line-down)
|
||||
(define-key map [remap undo] 'git-rebase-undo)
|
||||
map)
|
||||
"Keymap for Git-Rebase mode.")
|
||||
|
||||
(cond ((featurep 'jkl)
|
||||
(put 'git-rebase-reword :advertised-binding "r")
|
||||
(put 'git-rebase-move-line-up :advertised-binding (kbd "M-i"))
|
||||
(put 'git-rebase-kill-line :advertised-binding ","))
|
||||
(t
|
||||
(put 'git-rebase-reword :advertised-binding "r")
|
||||
(put 'git-rebase-move-line-up :advertised-binding (kbd "M-p"))
|
||||
(put 'git-rebase-kill-line :advertised-binding "k")))
|
||||
|
||||
(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]
|
||||
["Noop" git-rebase-noop t]
|
||||
["Execute" git-rebase-exec t]
|
||||
["Move Down" git-rebase-move-line-down t]
|
||||
["Move Up" git-rebase-move-line-up t]
|
||||
"---"
|
||||
["Cancel" with-editor-cancel t]
|
||||
["Finish" with-editor-finish t]))
|
||||
|
||||
(defvar git-rebase-command-descriptions
|
||||
'((with-editor-finish . "tell Git to make it happen")
|
||||
(with-editor-cancel . "tell Git that you changed your mind, i.e. abort")
|
||||
(git-rebase-backward-line . "move point to previous line")
|
||||
(forward-line . "move point to next line")
|
||||
(git-rebase-move-line-up . "move the commit at point up")
|
||||
(git-rebase-move-line-down . "move the commit at point down")
|
||||
(git-rebase-show-or-scroll-up . "show the commit at point in another buffer")
|
||||
(git-rebase-show-commit
|
||||
. "show the commit at point in another buffer and select its window")
|
||||
(undo . "undo last change")
|
||||
(git-rebase-kill-line . "drop the commit at point")
|
||||
(git-rebase-insert . "insert a line for an arbitrary commit")
|
||||
(git-rebase-noop . "add noop action at point")))
|
||||
|
||||
;;; Commands
|
||||
|
||||
(defun git-rebase-pick ()
|
||||
"Use commit on current line."
|
||||
(interactive)
|
||||
(git-rebase-set-action "pick"))
|
||||
|
||||
(defun git-rebase-reword ()
|
||||
"Edit message of commit on current line."
|
||||
(interactive)
|
||||
(git-rebase-set-action "reword"))
|
||||
|
||||
(defun git-rebase-edit ()
|
||||
"Stop at the commit on the current line."
|
||||
(interactive)
|
||||
(git-rebase-set-action "edit"))
|
||||
|
||||
(defun git-rebase-squash ()
|
||||
"Meld commit on current line into previous commit, edit message."
|
||||
(interactive)
|
||||
(git-rebase-set-action "squash"))
|
||||
|
||||
(defun git-rebase-fixup ()
|
||||
"Meld commit on current line into previous commit, discard its message."
|
||||
(interactive)
|
||||
(git-rebase-set-action "fixup"))
|
||||
|
||||
(defvar-local git-rebase-line nil)
|
||||
(defvar-local git-rebase-comment-re nil)
|
||||
|
||||
(defun git-rebase-set-action (action)
|
||||
(goto-char (line-beginning-position))
|
||||
(if (and (looking-at git-rebase-line)
|
||||
(not (string-match-p "\\(e\\|exec\\|noop\\)$" (match-string 1))))
|
||||
(let ((inhibit-read-only t))
|
||||
(replace-match action t t nil 1)
|
||||
(when git-rebase-auto-advance
|
||||
(forward-line)))
|
||||
(ding)))
|
||||
|
||||
(defun git-rebase-line-p (&optional pos)
|
||||
(save-excursion
|
||||
(when pos (goto-char pos))
|
||||
(goto-char (line-beginning-position))
|
||||
(looking-at-p git-rebase-line)))
|
||||
|
||||
(defun git-rebase-region-bounds ()
|
||||
(when (use-region-p)
|
||||
(let ((beg (save-excursion (goto-char (region-beginning))
|
||||
(line-beginning-position)))
|
||||
(end (save-excursion (goto-char (region-end))
|
||||
(line-end-position))))
|
||||
(when (and (git-rebase-line-p beg)
|
||||
(git-rebase-line-p end))
|
||||
(list beg (1+ end))))))
|
||||
|
||||
(defun git-rebase-move-line-down (n)
|
||||
"Move the current commit (or command) N lines down.
|
||||
If N is negative, move the commit up instead. With an active
|
||||
region, move all the lines that the region touches, not just the
|
||||
current line."
|
||||
(interactive "p")
|
||||
(pcase-let* ((`(,beg ,end)
|
||||
(or (git-rebase-region-bounds)
|
||||
(list (line-beginning-position)
|
||||
(1+ (line-end-position)))))
|
||||
(pt-offset (- (point) beg))
|
||||
(mark-offset (and mark-active (- (mark) beg))))
|
||||
(save-restriction
|
||||
(narrow-to-region
|
||||
(point-min)
|
||||
(1+ (save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward git-rebase-line nil t))
|
||||
(point))))
|
||||
(if (or (and (< n 0) (= beg (point-min)))
|
||||
(and (> n 0) (= end (point-max)))
|
||||
(> end (point-max)))
|
||||
(ding)
|
||||
(goto-char (if (< n 0) beg end))
|
||||
(forward-line n)
|
||||
(atomic-change-group
|
||||
(let ((inhibit-read-only t))
|
||||
(insert (delete-and-extract-region beg end)))
|
||||
(let ((new-beg (- (point) (- end beg))))
|
||||
(when (use-region-p)
|
||||
(setq deactivate-mark nil)
|
||||
(set-mark (+ new-beg mark-offset)))
|
||||
(goto-char (+ new-beg pt-offset))))))))
|
||||
|
||||
(defun git-rebase-move-line-up (n)
|
||||
"Move the current commit (or command) N lines up.
|
||||
If N is negative, move the commit down instead. With an active
|
||||
region, move all the lines that the region touches, not just the
|
||||
current line."
|
||||
(interactive "p")
|
||||
(git-rebase-move-line-down (- n)))
|
||||
|
||||
(defun git-rebase-highlight-region (start end window rol)
|
||||
(let ((inhibit-read-only t)
|
||||
(deactivate-mark nil)
|
||||
(bounds (git-rebase-region-bounds)))
|
||||
(mapc #'delete-overlay magit-section-highlight-overlays)
|
||||
(when bounds
|
||||
(magit-section-make-overlay (car bounds) (cadr bounds)
|
||||
'magit-section-heading-selection))
|
||||
(if (and bounds (not magit-keep-region-overlay))
|
||||
(funcall (default-value 'redisplay-unhighlight-region-function) rol)
|
||||
(funcall (default-value 'redisplay-highlight-region-function)
|
||||
start end window rol))))
|
||||
|
||||
(defun git-rebase-unhighlight-region (rol)
|
||||
(mapc #'delete-overlay magit-section-highlight-overlays)
|
||||
(funcall (default-value 'redisplay-unhighlight-region-function) rol))
|
||||
|
||||
(defun git-rebase-kill-line ()
|
||||
"Kill the current action line."
|
||||
(interactive)
|
||||
(goto-char (line-beginning-position))
|
||||
(when (and (looking-at git-rebase-line)
|
||||
(not (eq (char-after) (string-to-char comment-start))))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert comment-start)
|
||||
(insert " "))
|
||||
(when git-rebase-auto-advance
|
||||
(forward-line))))
|
||||
|
||||
(defun git-rebase-insert (rev)
|
||||
"Read an arbitrary commit and insert it below current line."
|
||||
(interactive (list (magit-read-branch-or-commit "Insert revision")))
|
||||
(forward-line)
|
||||
(--if-let (magit-rev-format "%h %s" rev)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert "pick " it ?\n))
|
||||
(user-error "Unknown revision")))
|
||||
|
||||
(defun git-rebase-exec (arg)
|
||||
"Insert a shell command to be run after the proceeding commit.
|
||||
|
||||
If there already is such a command on the current line, then edit
|
||||
that instead. With a prefix argument insert a new command even
|
||||
when there already is one on the current line. With empty input
|
||||
remove the command on the current line, if any."
|
||||
(interactive "P")
|
||||
(let ((inhibit-read-only t) initial command)
|
||||
(unless arg
|
||||
(goto-char (line-beginning-position))
|
||||
(when (looking-at (concat git-rebase-comment-re "?"
|
||||
"\\(e\\|exec\\) \\(.*\\)"))
|
||||
(setq initial (match-string-no-properties 2))))
|
||||
(setq command (read-shell-command "Execute: " initial))
|
||||
(pcase (list command initial)
|
||||
(`("" nil) (ding))
|
||||
(`("" ,_)
|
||||
(delete-region (match-beginning 0) (1+ (match-end 0))))
|
||||
(`(,_ nil)
|
||||
(forward-line)
|
||||
(insert (concat "exec " command "\n"))
|
||||
(unless git-rebase-auto-advance
|
||||
(forward-line -1)))
|
||||
(_
|
||||
(replace-match (concat "exec " command) t t)
|
||||
(if git-rebase-auto-advance
|
||||
(forward-line)
|
||||
(goto-char (line-beginning-position)))))))
|
||||
|
||||
(defun git-rebase-noop (&optional arg)
|
||||
"Add noop action at point.
|
||||
|
||||
If the current line already contains a a noop action, leave it
|
||||
unchanged. If there is a commented noop action present, remove
|
||||
the comment. Otherwise add a new noop action. With a prefix
|
||||
argument insert a new noop action regardless what is already
|
||||
present on the current line.
|
||||
|
||||
A noop action can be used to make git perform a rebase even if
|
||||
no commits are selected. Without the noop action present, git
|
||||
would see an empty file and therefore do nothing."
|
||||
(interactive "P")
|
||||
(goto-char (line-beginning-position))
|
||||
;; The extra space at the end is only there to make the action
|
||||
;; consistent with the others (action argument). This keeps
|
||||
;; the regexp `git-rebase-line' from getting complicated.
|
||||
(let ((noop-string "noop \n"))
|
||||
(when (or arg (not (looking-at noop-string)))
|
||||
(let ((inhibit-read-only t))
|
||||
(if (and (not arg)
|
||||
(looking-at (concat comment-start noop-string)))
|
||||
(delete-char 1)
|
||||
(insert noop-string))))))
|
||||
|
||||
(defun git-rebase-undo (&optional arg)
|
||||
"Undo some previous changes.
|
||||
Like `undo' but works in read-only buffers."
|
||||
(interactive "P")
|
||||
(let ((inhibit-read-only t))
|
||||
(undo arg)))
|
||||
|
||||
(defun git-rebase--show-commit (&optional scroll)
|
||||
(let ((disable-magit-save-buffers t))
|
||||
(save-excursion
|
||||
(goto-char (line-beginning-position))
|
||||
(--if-let (and (looking-at git-rebase-line)
|
||||
(match-string 2))
|
||||
(pcase scroll
|
||||
(`up (magit-diff-show-or-scroll-up))
|
||||
(`down (magit-diff-show-or-scroll-down))
|
||||
(_ (apply #'magit-show-commit it (magit-diff-arguments))))
|
||||
(ding)))))
|
||||
|
||||
(defun git-rebase-show-commit ()
|
||||
"Show the commit on the current line if any."
|
||||
(interactive)
|
||||
(git-rebase--show-commit))
|
||||
|
||||
(defun git-rebase-show-or-scroll-up ()
|
||||
"Update the commit buffer for commit on current line.
|
||||
|
||||
Either show the commit at point in the appropriate buffer, or if
|
||||
that buffer is already being displayed in the current frame and
|
||||
contains information about that commit, then instead scroll the
|
||||
buffer up."
|
||||
(interactive)
|
||||
(git-rebase--show-commit 'up))
|
||||
|
||||
(defun git-rebase-show-or-scroll-down ()
|
||||
"Update the commit buffer for commit on current line.
|
||||
|
||||
Either show the commit at point in the appropriate buffer, or if
|
||||
that buffer is already being displayed in the current frame and
|
||||
contains information about that commit, then instead scroll the
|
||||
buffer down."
|
||||
(interactive)
|
||||
(git-rebase--show-commit 'down))
|
||||
|
||||
(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 (- (or 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."
|
||||
:group 'git-rebase
|
||||
(setq comment-start (or (magit-get "core.commentChar") "#"))
|
||||
(setq git-rebase-comment-re (concat "^" (regexp-quote comment-start)))
|
||||
(setq git-rebase-line
|
||||
(concat "^\\(" (regexp-quote comment-start) "? *"
|
||||
"\\(?:[fprse]\\|pick\\|reword\\|edit\\|squash\\|fixup\\|exec\\|noop\\)\\) "
|
||||
"\\(?:\\([^ \n]+\\) \\(.*\\)\\)?"))
|
||||
(setq font-lock-defaults (list (git-rebase-mode-font-lock-keywords) t t))
|
||||
(unless git-rebase-show-instructions
|
||||
(let ((inhibit-read-only t))
|
||||
(flush-lines git-rebase-comment-re)))
|
||||
(unless with-editor-mode
|
||||
;; Maybe already enabled when using `shell-command' or an Emacs shell.
|
||||
(with-editor-mode 1))
|
||||
(when git-rebase-confirm-cancel
|
||||
(add-hook 'with-editor-cancel-query-functions
|
||||
'git-rebase-cancel-confirm nil t))
|
||||
(setq-local redisplay-highlight-region-function 'git-rebase-highlight-region)
|
||||
(setq-local redisplay-unhighlight-region-function 'git-rebase-unhighlight-region)
|
||||
(add-hook 'with-editor-pre-cancel-hook 'git-rebase-autostash-save nil t)
|
||||
(add-hook 'with-editor-post-cancel-hook 'git-rebase-autostash-apply nil t)
|
||||
(setq imenu-prev-index-position-function
|
||||
#'magit-imenu--rebase-prev-index-position-function)
|
||||
(setq imenu-extract-index-name-function
|
||||
#'magit-imenu--rebase-extract-index-name-function)
|
||||
(when (boundp 'save-place)
|
||||
(setq save-place nil)))
|
||||
|
||||
(defun git-rebase-cancel-confirm (force)
|
||||
(or (not (buffer-modified-p))
|
||||
force
|
||||
(magit-confirm 'abort-rebase "Abort this rebase" nil 'noabort)))
|
||||
|
||||
(defun git-rebase-autostash-save ()
|
||||
(--when-let (magit-file-line (magit-git-dir "rebase-merge/autostash"))
|
||||
(push (cons 'stash it) with-editor-cancel-alist)))
|
||||
|
||||
(defun git-rebase-autostash-apply ()
|
||||
(--when-let (cdr (assq 'stash with-editor-cancel-alist))
|
||||
(magit-stash-apply it)))
|
||||
|
||||
(defun git-rebase-match-comment-line (limit)
|
||||
(re-search-forward (concat git-rebase-comment-re ".*") limit t))
|
||||
|
||||
(defun git-rebase-mode-font-lock-keywords ()
|
||||
"Font lock keywords for Git-Rebase mode."
|
||||
(let ((action-re "\
|
||||
\\([efprs]\\|pick\\|reword\\|edit\\|squash\\|fixup\\) \\([^ \n]+\\) \\(.*\\)"))
|
||||
`((,(concat "^" action-re)
|
||||
(1 'font-lock-keyword-face)
|
||||
(2 'git-rebase-hash)
|
||||
(3 'git-rebase-description))
|
||||
("^\\(exec\\) \\(.*\\)"
|
||||
(1 'font-lock-keyword-face)
|
||||
(2 'git-rebase-description))
|
||||
("^\\(noop\\)"
|
||||
(1 'font-lock-keyword-face))
|
||||
(git-rebase-match-comment-line 0 'font-lock-comment-face)
|
||||
(,(concat git-rebase-comment-re " *" action-re)
|
||||
0 'git-rebase-killed-action t)
|
||||
("\\[[^[]*\\]"
|
||||
0 'magit-keyword t)
|
||||
(,(format "^%s Rebase \\([^ ]*\\) onto \\([^ ]*\\)" comment-start)
|
||||
(1 'git-rebase-comment-hash t)
|
||||
(2 'git-rebase-comment-hash t))
|
||||
(,(format "^%s \\(Commands:\\)" comment-start)
|
||||
(1 'git-rebase-comment-heading t)))))
|
||||
|
||||
(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."
|
||||
(let ((inhibit-read-only t))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (and git-rebase-show-instructions
|
||||
(re-search-forward
|
||||
(concat git-rebase-comment-re "\\s-+p, pick")
|
||||
nil t))
|
||||
(goto-char (line-beginning-position))
|
||||
(pcase-dolist (`(,cmd . ,desc) git-rebase-command-descriptions)
|
||||
(insert (format "%s %-8s %s\n"
|
||||
comment-start
|
||||
(substitute-command-keys (format "\\[%s]" cmd))
|
||||
desc)))
|
||||
(while (re-search-forward (concat git-rebase-comment-re
|
||||
"\\( ?\\)\\([^\n,],\\) "
|
||||
"\\([^\n ]+\\) ")
|
||||
nil t)
|
||||
(let ((cmd (intern (concat "git-rebase-" (match-string 3)))))
|
||||
(if (not (fboundp cmd))
|
||||
(delete-region (line-beginning-position) (1+ (line-end-position)))
|
||||
(replace-match " " t t nil 1)
|
||||
(replace-match
|
||||
(format "%-8s"
|
||||
(mapconcat #'key-description
|
||||
(--remove (eq (elt it 0) 'menu-bar)
|
||||
(reverse (where-is-internal cmd)))
|
||||
", "))
|
||||
t t nil 2))))))))
|
||||
|
||||
(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
|
||||
(defconst git-rebase-filename-regexp "/git-rebase-todo\\'")
|
||||
;;;###autoload
|
||||
(add-to-list 'auto-mode-alist
|
||||
(cons git-rebase-filename-regexp 'git-rebase-mode))
|
||||
|
||||
(add-to-list 'with-editor-server-window-alist
|
||||
(cons git-rebase-filename-regexp 'switch-to-buffer))
|
||||
|
||||
(eval-after-load 'recentf
|
||||
'(add-to-list 'recentf-exclude git-rebase-filename-regexp))
|
||||
|
||||
(add-to-list 'with-editor-file-name-history-exclude git-rebase-filename-regexp)
|
||||
|
||||
(provide 'git-rebase)
|
||||
;;; git-rebase.el ends here
|
Binary file not shown.
|
@ -0,0 +1,658 @@
|
|||
;;; magit-apply.el --- apply Git diffs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements commands for applying Git diffs or parts
|
||||
;; of such a diff. The supported "apply variants" are apply, stage,
|
||||
;; unstage, discard, and reverse - more than Git itself knows about,
|
||||
;; at least at the porcelain level.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit-core)
|
||||
(require 'magit-diff)
|
||||
(require 'magit-wip)
|
||||
|
||||
;; For `magit-apply'
|
||||
(declare-function magit-am-popup "magit-sequence" (&optional arg))
|
||||
(declare-function magit-patch-apply-popup "magit-files" (&optional arg))
|
||||
;; For `magit-discard-files'
|
||||
(declare-function magit-checkout-stage "magit-merge" (file arg))
|
||||
(declare-function magit-checkout-read-stage "magit-merge" (file))
|
||||
(defvar auto-revert-verbose)
|
||||
;; For `magit-stage-untracked'
|
||||
(declare-function magit-submodule-add "magit-submodule"
|
||||
(url &optional path name args))
|
||||
(declare-function magit-submodule-read-name-for-path "magit-submodule"
|
||||
(path &optional prefer-short))
|
||||
(declare-function borg--maybe-absorb-gitdir "borg" (pkg))
|
||||
(declare-function borg--sort-submodule-sections "borg" (file))
|
||||
(defvar borg-user-emacs-directory)
|
||||
|
||||
;;; Options
|
||||
|
||||
(defcustom magit-delete-by-moving-to-trash t
|
||||
"Whether Magit uses the system's trash can.
|
||||
|
||||
You should absolutely not disable this and also remove `discard'
|
||||
from `magit-no-confirm'. You shouldn't do that even if you have
|
||||
all of the Magit-Wip modes enabled, because those modes do not
|
||||
track any files that are not tracked in the proper branch."
|
||||
:package-version '(magit . "2.1.0")
|
||||
:group 'magit-essentials
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-unstage-committed t
|
||||
"Whether unstaging a committed change reverts it instead.
|
||||
|
||||
A committed change cannot be unstaged, because staging and
|
||||
unstaging are actions that are concerned with the differences
|
||||
between the index and the working tree, not with committed
|
||||
changes.
|
||||
|
||||
If this option is non-nil (the default), then typing \"u\"
|
||||
\(`magit-unstage') on a committed change, causes it to be
|
||||
reversed in the index but not the working tree. For more
|
||||
information see command `magit-reverse-in-index'."
|
||||
:package-version '(magit . "2.4.1")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-reverse-atomically nil
|
||||
"Whether to reverse changes atomically.
|
||||
|
||||
If some changes can be reversed while others cannot, then nothing
|
||||
is reversed if the value of this option is non-nil. But when it
|
||||
is nil, then the changes that can be reversed are reversed and
|
||||
for the other changes diff files are created that contain the
|
||||
rejected reversals."
|
||||
:package-version '(magit . "2.7.0")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
;;; Commands
|
||||
;;;; Apply
|
||||
|
||||
(defun magit-apply (&rest args)
|
||||
"Apply the change at point to the working tree.
|
||||
With a prefix argument fallback to a 3-way merge. Doing
|
||||
so causes the change to be applied to the index as well."
|
||||
(interactive (and current-prefix-arg (list "--3way")))
|
||||
(--when-let (magit-apply--get-selection)
|
||||
(pcase (list (magit-diff-type) (magit-diff-scope))
|
||||
(`(,(or `unstaged `staged) ,_)
|
||||
(user-error "Change is already in the working tree"))
|
||||
(`(untracked ,(or `file `files))
|
||||
(magit-am-popup))
|
||||
(`(,_ region) (magit-apply-region it args))
|
||||
(`(,_ hunk) (magit-apply-hunk it args))
|
||||
(`(,_ hunks) (magit-apply-hunks it args))
|
||||
(`(rebase-sequence file) (magit-patch-apply-popup))
|
||||
(`(,_ file) (magit-apply-diff it args))
|
||||
(`(,_ files) (magit-apply-diffs it args)))))
|
||||
|
||||
(defun magit-apply--section-content (section)
|
||||
(buffer-substring-no-properties (if (magit-hunk-section-p section)
|
||||
(oref section start)
|
||||
(oref section content))
|
||||
(oref section end)))
|
||||
|
||||
(defun magit-apply-diffs (sections &rest args)
|
||||
(setq sections (magit-apply--get-diffs sections))
|
||||
(magit-apply-patch sections args
|
||||
(mapconcat
|
||||
(lambda (s)
|
||||
(concat (magit-diff-file-header s)
|
||||
(magit-apply--section-content s)))
|
||||
sections "")))
|
||||
|
||||
(defun magit-apply-diff (section &rest args)
|
||||
(setq section (car (magit-apply--get-diffs (list section))))
|
||||
(magit-apply-patch section args
|
||||
(concat (magit-diff-file-header section)
|
||||
(magit-apply--section-content section))))
|
||||
|
||||
(defun magit-apply-hunks (sections &rest args)
|
||||
(let ((section (oref (car sections) parent)))
|
||||
(when (string-match "^diff --cc" (oref section value))
|
||||
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
|
||||
(magit-apply-patch section args
|
||||
(concat (oref section header)
|
||||
(mapconcat 'magit-apply--section-content
|
||||
sections "")))))
|
||||
|
||||
(defun magit-apply-hunk (section &rest args)
|
||||
(when (string-match "^diff --cc" (magit-section-parent-value section))
|
||||
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
|
||||
(magit-apply-patch (oref section parent) args
|
||||
(concat (magit-diff-file-header section)
|
||||
(magit-apply--section-content section))))
|
||||
|
||||
(defun magit-apply-region (section &rest args)
|
||||
(unless (magit-diff-context-p)
|
||||
(user-error "Not enough context to apply region. Increase the context"))
|
||||
(when (string-match "^diff --cc" (magit-section-parent-value section))
|
||||
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
|
||||
(magit-apply-patch (oref section parent) args
|
||||
(concat (magit-diff-file-header section)
|
||||
(magit-diff-hunk-region-patch section args))))
|
||||
|
||||
(defun magit-apply-patch (section:s args patch)
|
||||
(let* ((files (if (atom section:s)
|
||||
(list (oref section:s value))
|
||||
(--map (oref it value) section:s)))
|
||||
(command (symbol-name this-command))
|
||||
(command (if (and command (string-match "^magit-\\([^-]+\\)" command))
|
||||
(match-string 1 command)
|
||||
"apply")))
|
||||
(when (and magit-wip-before-change-mode (not inhibit-magit-refresh))
|
||||
(magit-wip-commit-before-change files (concat " before " command)))
|
||||
(with-temp-buffer
|
||||
(insert patch)
|
||||
(magit-run-git-with-input
|
||||
"apply" args "-p0"
|
||||
(unless (magit-diff-context-p) "--unidiff-zero")
|
||||
"--ignore-space-change" "-"))
|
||||
(unless inhibit-magit-refresh
|
||||
(when magit-wip-after-apply-mode
|
||||
(magit-wip-commit-after-apply files (concat " after " command)))
|
||||
(magit-refresh))))
|
||||
|
||||
(defun magit-apply--get-selection ()
|
||||
(or (magit-region-sections '(hunk file) t)
|
||||
(let ((section (magit-current-section)))
|
||||
(pcase (oref section type)
|
||||
((or `hunk `file) section)
|
||||
((or `staged `unstaged `untracked
|
||||
`stashed-index `stashed-worktree `stashed-untracked)
|
||||
(oref section children))
|
||||
(_ (user-error "Cannot apply this, it's not a change"))))))
|
||||
|
||||
(defun magit-apply--get-diffs (sections)
|
||||
(magit-section-case
|
||||
([file diffstat]
|
||||
(--map (or (magit-get-section
|
||||
(append `((file . ,(oref it value)))
|
||||
(magit-section-ident magit-root-section)))
|
||||
(error "Cannot get required diff headers"))
|
||||
sections))
|
||||
(t sections)))
|
||||
|
||||
(defun magit-apply--diff-ignores-whitespace-p ()
|
||||
(and (cl-intersection (if (derived-mode-p 'magit-diff-mode)
|
||||
(nth 2 magit-refresh-args)
|
||||
magit-diff-section-arguments)
|
||||
'("--ignore-space-at-eol"
|
||||
"--ignore-space-change"
|
||||
"--ignore-all-space"
|
||||
"--ignore-blank-lines")
|
||||
:test #'equal)
|
||||
t))
|
||||
|
||||
;;;; Stage
|
||||
|
||||
(defun magit-stage (&optional intent)
|
||||
"Add the change at point to the staging area.
|
||||
With a prefix argument, INTENT, and an untracked file (or files)
|
||||
at point, stage the file but not its content."
|
||||
(interactive "P")
|
||||
(--if-let (and (derived-mode-p 'magit-mode) (magit-apply--get-selection))
|
||||
(pcase (list (magit-diff-type)
|
||||
(magit-diff-scope)
|
||||
(magit-apply--diff-ignores-whitespace-p))
|
||||
(`(untracked ,_ ,_) (magit-stage-untracked intent))
|
||||
(`(unstaged region ,_) (magit-apply-region it "--cached"))
|
||||
(`(unstaged hunk ,_) (magit-apply-hunk it "--cached"))
|
||||
(`(unstaged hunks ,_) (magit-apply-hunks it "--cached"))
|
||||
(`(unstaged file t) (magit-apply-diff it "--cached"))
|
||||
(`(unstaged files t) (magit-apply-diffs it "--cached"))
|
||||
(`(unstaged list t) (magit-apply-diffs it "--cached"))
|
||||
(`(unstaged file nil) (magit-stage-1 "-u" (list (oref it value))))
|
||||
(`(unstaged files nil) (magit-stage-1 "-u" (magit-region-values nil t)))
|
||||
(`(unstaged list nil) (magit-stage-modified))
|
||||
(`(staged ,_ ,_) (user-error "Already staged"))
|
||||
(`(committed ,_ ,_) (user-error "Cannot stage committed changes"))
|
||||
(`(undefined ,_ ,_) (user-error "Cannot stage this change")))
|
||||
(call-interactively 'magit-stage-file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-stage-file (file)
|
||||
"Stage all changes to FILE.
|
||||
With a prefix argument or when there is no file at point ask for
|
||||
the file to be staged. Otherwise stage the file at point without
|
||||
requiring confirmation."
|
||||
(interactive
|
||||
(let* ((atpoint (magit-section-value-if 'file))
|
||||
(current (magit-file-relative-name))
|
||||
(choices (nconc (magit-unstaged-files)
|
||||
(magit-untracked-files)))
|
||||
(default (car (member (or atpoint current) choices))))
|
||||
(list (if (or current-prefix-arg (not default))
|
||||
(magit-completing-read "Stage file" choices
|
||||
nil t nil nil default)
|
||||
default))))
|
||||
(magit-with-toplevel
|
||||
(magit-stage-1 nil (list file))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-stage-modified (&optional all)
|
||||
"Stage all changes to files modified in the worktree.
|
||||
Stage all new content of tracked files and remove tracked files
|
||||
that no longer exist in the working tree from the index also.
|
||||
With a prefix argument also stage previously untracked (but not
|
||||
ignored) files."
|
||||
(interactive "P")
|
||||
(when (magit-anything-staged-p)
|
||||
(magit-confirm 'stage-all-changes))
|
||||
(magit-with-toplevel
|
||||
(magit-stage-1 (if all "--all" "-u"))))
|
||||
|
||||
(defun magit-stage-1 (arg &optional files)
|
||||
(magit-wip-commit-before-change files " before stage")
|
||||
(magit-run-git "add" arg (if files (cons "--" files) "."))
|
||||
(when magit-auto-revert-mode
|
||||
(mapc #'magit-turn-on-auto-revert-mode-if-desired files))
|
||||
(magit-wip-commit-after-apply files " after stage"))
|
||||
|
||||
(defun magit-stage-untracked (&optional intent)
|
||||
(let* ((section (magit-current-section))
|
||||
(files (pcase (magit-diff-scope)
|
||||
(`file (list (oref section value)))
|
||||
(`files (magit-region-values nil t))
|
||||
(`list (magit-untracked-files))))
|
||||
plain repos)
|
||||
(dolist (file files)
|
||||
(if (and (not (file-symlink-p file))
|
||||
(magit-git-repo-p file t))
|
||||
(push file repos)
|
||||
(push file plain)))
|
||||
(magit-wip-commit-before-change files " before stage")
|
||||
(when plain
|
||||
(magit-run-git "add" (and intent "--intent-to-add")
|
||||
"--" plain)
|
||||
(when magit-auto-revert-mode
|
||||
(mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
|
||||
(dolist (repo repos)
|
||||
(save-excursion
|
||||
(goto-char (oref (magit-get-section
|
||||
`((file . ,repo) (untracked) (status)))
|
||||
start))
|
||||
(let* ((topdir (magit-toplevel))
|
||||
(package
|
||||
(and (equal (bound-and-true-p borg-user-emacs-directory)
|
||||
topdir)
|
||||
(file-name-nondirectory (directory-file-name repo)))))
|
||||
(magit-submodule-add
|
||||
(let ((default-directory
|
||||
(file-name-as-directory (expand-file-name repo))))
|
||||
(or (magit-get "remote" (magit-get-some-remote) "url")
|
||||
(concat (file-name-as-directory ".") repo)))
|
||||
repo
|
||||
(magit-submodule-read-name-for-path repo package))
|
||||
(when package
|
||||
(borg--sort-submodule-sections
|
||||
(expand-file-name ".gitmodules" topdir))
|
||||
(let ((default-directory borg-user-emacs-directory))
|
||||
(borg--maybe-absorb-gitdir package))
|
||||
(when (and (y-or-n-p
|
||||
(format "Also build and activate `%s' drone?" package))
|
||||
(fboundp 'borg-build)
|
||||
(fboundp 'borg-activate))
|
||||
(borg-build package)
|
||||
(borg-activate package))))))
|
||||
(magit-wip-commit-after-apply files " after stage")))
|
||||
|
||||
;;;; Unstage
|
||||
|
||||
(defun magit-unstage ()
|
||||
"Remove the change at point from the staging area."
|
||||
(interactive)
|
||||
(--when-let (magit-apply--get-selection)
|
||||
(pcase (list (magit-diff-type)
|
||||
(magit-diff-scope)
|
||||
(magit-apply--diff-ignores-whitespace-p))
|
||||
(`(untracked ,_ ,_) (user-error "Cannot unstage untracked changes"))
|
||||
(`(unstaged ,_ ,_) (user-error "Already unstaged"))
|
||||
(`(staged region ,_) (magit-apply-region it "--reverse" "--cached"))
|
||||
(`(staged hunk ,_) (magit-apply-hunk it "--reverse" "--cached"))
|
||||
(`(staged hunks ,_) (magit-apply-hunks it "--reverse" "--cached"))
|
||||
(`(staged file t) (magit-apply-diff it "--reverse" "--cached"))
|
||||
(`(staged files t) (magit-apply-diffs it "--reverse" "--cached"))
|
||||
(`(staged list t) (magit-apply-diffs it "--reverse" "--cached"))
|
||||
(`(staged file nil) (magit-unstage-1 (list (oref it value))))
|
||||
(`(staged files nil) (magit-unstage-1 (magit-region-values nil t)))
|
||||
(`(staged list nil) (magit-unstage-all))
|
||||
(`(committed ,_ ,_) (if magit-unstage-committed
|
||||
(magit-reverse-in-index)
|
||||
(user-error "Cannot unstage committed changes")))
|
||||
(`(undefined ,_ ,_) (user-error "Cannot unstage this change")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-unstage-file (file)
|
||||
"Unstage all changes to FILE.
|
||||
With a prefix argument or when there is no file at point ask for
|
||||
the file to be unstaged. Otherwise unstage the file at point
|
||||
without requiring confirmation."
|
||||
(interactive
|
||||
(let* ((atpoint (magit-section-value-if 'file))
|
||||
(current (magit-file-relative-name))
|
||||
(choices (magit-staged-files))
|
||||
(default (car (member (or atpoint current) choices))))
|
||||
(list (if (or current-prefix-arg (not default))
|
||||
(magit-completing-read "Unstage file" choices
|
||||
nil t nil nil default)
|
||||
default))))
|
||||
(magit-with-toplevel
|
||||
(magit-unstage-1 (list file))))
|
||||
|
||||
(defun magit-unstage-1 (files)
|
||||
(magit-wip-commit-before-change files " before unstage")
|
||||
(if (magit-no-commit-p)
|
||||
(magit-run-git "rm" "--cached" "--" files)
|
||||
(magit-run-git "reset" "HEAD" "--" files))
|
||||
(magit-wip-commit-after-apply files " after unstage"))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-unstage-all ()
|
||||
"Remove all changes from the staging area."
|
||||
(interactive)
|
||||
(when (or (magit-anything-unstaged-p)
|
||||
(magit-untracked-files))
|
||||
(magit-confirm 'unstage-all-changes))
|
||||
(magit-wip-commit-before-change nil " before unstage")
|
||||
(magit-run-git "reset" "HEAD" "--")
|
||||
(magit-wip-commit-after-apply nil " after unstage"))
|
||||
|
||||
;;;; Discard
|
||||
|
||||
(defun magit-discard ()
|
||||
"Remove the change at point."
|
||||
(interactive)
|
||||
(--when-let (magit-apply--get-selection)
|
||||
(pcase (list (magit-diff-type) (magit-diff-scope))
|
||||
(`(committed ,_) (user-error "Cannot discard committed changes"))
|
||||
(`(undefined ,_) (user-error "Cannot discard this change"))
|
||||
(`(,_ region) (magit-discard-region it))
|
||||
(`(,_ hunk) (magit-discard-hunk it))
|
||||
(`(,_ hunks) (magit-discard-hunks it))
|
||||
(`(,_ file) (magit-discard-file it))
|
||||
(`(,_ files) (magit-discard-files it))
|
||||
(`(,_ list) (magit-discard-files it)))))
|
||||
|
||||
(defun magit-discard-region (section)
|
||||
(magit-confirm 'discard "Discard region")
|
||||
(magit-discard-apply section 'magit-apply-region))
|
||||
|
||||
(defun magit-discard-hunk (section)
|
||||
(magit-confirm 'discard "Discard hunk")
|
||||
(magit-discard-apply section 'magit-apply-hunk))
|
||||
|
||||
(defun magit-discard-apply (section apply)
|
||||
(if (eq (magit-diff-type section) 'unstaged)
|
||||
(funcall apply section "--reverse")
|
||||
(if (magit-anything-unstaged-p
|
||||
nil (if (magit-file-section-p section)
|
||||
(oref section value)
|
||||
(magit-section-parent-value section)))
|
||||
(progn (let ((inhibit-magit-refresh t))
|
||||
(funcall apply section "--reverse" "--cached")
|
||||
(funcall apply section "--reverse" "--reject"))
|
||||
(magit-refresh))
|
||||
(funcall apply section "--reverse" "--index"))))
|
||||
|
||||
(defun magit-discard-hunks (sections)
|
||||
(magit-confirm 'discard (format "Discard %s hunks from %s"
|
||||
(length sections)
|
||||
(magit-section-parent-value (car sections))))
|
||||
(magit-discard-apply-n sections 'magit-apply-hunks))
|
||||
|
||||
(defun magit-discard-apply-n (sections apply)
|
||||
(let ((section (car sections)))
|
||||
(if (eq (magit-diff-type section) 'unstaged)
|
||||
(funcall apply sections "--reverse")
|
||||
(if (magit-anything-unstaged-p
|
||||
nil (if (magit-file-section-p section)
|
||||
(oref section value)
|
||||
(magit-section-parent-value section)))
|
||||
(progn (let ((inhibit-magit-refresh t))
|
||||
(funcall apply sections "--reverse" "--cached")
|
||||
(funcall apply sections "--reverse" "--reject"))
|
||||
(magit-refresh))
|
||||
(funcall apply sections "--reverse" "--index")))))
|
||||
|
||||
(defun magit-discard-file (section)
|
||||
(magit-discard-files (list section)))
|
||||
|
||||
(defun magit-discard-files (sections)
|
||||
(let ((auto-revert-verbose nil)
|
||||
(type (magit-diff-type (car sections)))
|
||||
(status (magit-file-status))
|
||||
files delete resurrect rename discard discard-new resolve)
|
||||
(dolist (section sections)
|
||||
(let ((file (oref section value)))
|
||||
(push file files)
|
||||
(pcase (cons (pcase type
|
||||
(`staged ?X)
|
||||
(`unstaged ?Y)
|
||||
(`untracked ?Z))
|
||||
(cddr (assoc file status)))
|
||||
(`(?Z) (dolist (f (magit-untracked-files nil file))
|
||||
(push f delete)))
|
||||
((or `(?Z ?? ??) `(?Z ?! ?!)) (push file delete))
|
||||
((or `(?Z ?D ? ) `(,_ ?D ?D)) (push file delete))
|
||||
((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve))
|
||||
(`(,_ ?A ?A) (push file resolve))
|
||||
(`(?X ?M ,(or ? ?M ?D)) (push section discard))
|
||||
(`(?Y ,_ ?M ) (push section discard))
|
||||
(`(?X ?A ?M ) (push file discard-new))
|
||||
(`(?X ?C ?M ) (push file discard-new))
|
||||
(`(?X ?A ,(or ? ?D)) (push file delete))
|
||||
(`(?X ?C ,(or ? ?D)) (push file delete))
|
||||
(`(?X ?D ,(or ? ?M )) (push file resurrect))
|
||||
(`(?Y ,_ ?D ) (push file resurrect))
|
||||
(`(?X ?R ,(or ? ?M ?D)) (push file rename)))))
|
||||
(unwind-protect
|
||||
(let ((inhibit-magit-refresh t))
|
||||
(magit-wip-commit-before-change files " before discard")
|
||||
(when resolve
|
||||
(magit-discard-files--resolve (nreverse resolve)))
|
||||
(when resurrect
|
||||
(magit-discard-files--resurrect (nreverse resurrect)))
|
||||
(when delete
|
||||
(magit-discard-files--delete (nreverse delete) status))
|
||||
(when rename
|
||||
(magit-discard-files--rename (nreverse rename) status))
|
||||
(when (or discard discard-new)
|
||||
(magit-discard-files--discard (nreverse discard)
|
||||
(nreverse discard-new)))
|
||||
(magit-wip-commit-after-apply files " after discard"))
|
||||
(magit-refresh))))
|
||||
|
||||
(defun magit-discard-files--resolve (files)
|
||||
(if-let ((arg (and (cdr files)
|
||||
(magit-read-char-case
|
||||
(format "For these %i files\n%s\ncheckout:\n"
|
||||
(length files)
|
||||
(mapconcat (lambda (file)
|
||||
(concat " " file))
|
||||
files "\n"))
|
||||
t
|
||||
(?o "[o]ur stage" "--ours")
|
||||
(?t "[t]heir stage" "--theirs")
|
||||
(?c "[c]onflict" "--merge")
|
||||
(?i "decide [i]ndividually" nil)))))
|
||||
(dolist (file files)
|
||||
(magit-checkout-stage file arg))
|
||||
(dolist (file files)
|
||||
(magit-checkout-stage file (magit-checkout-read-stage file)))))
|
||||
|
||||
(defun magit-discard-files--resurrect (files)
|
||||
(magit-confirm-files 'resurrect files)
|
||||
(if (eq (magit-diff-type) 'staged)
|
||||
(magit-call-git "reset" "--" files)
|
||||
(magit-call-git "checkout" "--" files)))
|
||||
|
||||
(defun magit-discard-files--delete (files status)
|
||||
(magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
|
||||
files)
|
||||
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
|
||||
(dolist (file files)
|
||||
(if (memq (magit-diff-type) '(unstaged untracked))
|
||||
(progn (dired-delete-file file dired-recursive-deletes
|
||||
magit-delete-by-moving-to-trash)
|
||||
(dired-clean-up-after-deletion file))
|
||||
(pcase (nth 3 (assoc file status))
|
||||
(? (delete-file file t)
|
||||
(magit-call-git "rm" "--cached" "--" file))
|
||||
(?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
|
||||
(string-match
|
||||
(format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
|
||||
(rename-file (match-string 1 temp)
|
||||
(setq temp (concat file ".~{index}~")))
|
||||
(delete-file temp t))
|
||||
(magit-call-git "rm" "--cached" "--force" "--" file))
|
||||
(?D (magit-call-git "checkout" "--" file)
|
||||
(delete-file file t)
|
||||
(magit-call-git "rm" "--cached" "--force" "--" file)))))))
|
||||
|
||||
(defun magit-discard-files--rename (files status)
|
||||
(magit-confirm 'rename "Undo rename %s" "Undo %i renames" nil
|
||||
(mapcar (lambda (file)
|
||||
(setq file (assoc file status))
|
||||
(format "%s -> %s" (cadr file) (car file)))
|
||||
files))
|
||||
(dolist (file files)
|
||||
(let ((orig (cadr (assoc file status))))
|
||||
(if (file-exists-p file)
|
||||
(progn
|
||||
(--when-let (file-name-directory orig)
|
||||
(make-directory it t))
|
||||
(magit-call-git "mv" file orig))
|
||||
(magit-call-git "rm" "--cached" "--" file)
|
||||
(magit-call-git "reset" "--" orig)))))
|
||||
|
||||
(defun magit-discard-files--discard (sections new-files)
|
||||
(let ((files (--map (oref it value) sections)))
|
||||
(magit-confirm-files 'discard (append files new-files)
|
||||
(format "Discard %s changes in" (magit-diff-type)))
|
||||
(if (eq (magit-diff-type (car sections)) 'unstaged)
|
||||
(magit-call-git "checkout" "--" files)
|
||||
(when new-files
|
||||
(magit-call-git "add" "--" new-files)
|
||||
(magit-call-git "reset" "--" new-files))
|
||||
(let ((binaries (magit-staged-binary-files)))
|
||||
(when binaries
|
||||
(setq sections
|
||||
(--remove (member (oref it value) binaries)
|
||||
sections)))
|
||||
(cond ((= (length sections) 1)
|
||||
(magit-discard-apply (car sections) 'magit-apply-diff))
|
||||
(sections
|
||||
(magit-discard-apply-n sections 'magit-apply-diffs)))
|
||||
(when binaries
|
||||
(let ((modified (magit-unstaged-files t)))
|
||||
(setq binaries (--separate (member it modified) binaries)))
|
||||
(when (cadr binaries)
|
||||
(magit-call-git "reset" "--" (cadr binaries)))
|
||||
(when (car binaries)
|
||||
(user-error
|
||||
(concat
|
||||
"Cannot discard staged changes to binary files, "
|
||||
"which also have unstaged changes. Unstage instead."))))))))
|
||||
|
||||
;;;; Reverse
|
||||
|
||||
(defun magit-reverse (&rest args)
|
||||
"Reverse the change at point in the working tree.
|
||||
With a prefix argument fallback to a 3-way merge. Doing
|
||||
so causes the change to be applied to the index as well."
|
||||
(interactive (and current-prefix-arg (list "--3way")))
|
||||
(--when-let (magit-apply--get-selection)
|
||||
(pcase (list (magit-diff-type) (magit-diff-scope))
|
||||
(`(untracked ,_) (user-error "Cannot reverse untracked changes"))
|
||||
(`(unstaged ,_) (user-error "Cannot reverse unstaged changes"))
|
||||
(`(,_ region) (magit-reverse-region it args))
|
||||
(`(,_ hunk) (magit-reverse-hunk it args))
|
||||
(`(,_ hunks) (magit-reverse-hunks it args))
|
||||
(`(,_ file) (magit-reverse-file it args))
|
||||
(`(,_ files) (magit-reverse-files it args))
|
||||
(`(,_ list) (magit-reverse-files it args)))))
|
||||
|
||||
(defun magit-reverse-region (section args)
|
||||
(magit-confirm 'reverse "Reverse region")
|
||||
(magit-reverse-apply section 'magit-apply-region args))
|
||||
|
||||
(defun magit-reverse-hunk (section args)
|
||||
(magit-confirm 'reverse "Reverse hunk")
|
||||
(magit-reverse-apply section 'magit-apply-hunk args))
|
||||
|
||||
(defun magit-reverse-hunks (sections args)
|
||||
(magit-confirm 'reverse
|
||||
(format "Reverse %s hunks from %s"
|
||||
(length sections)
|
||||
(magit-section-parent-value (car sections))))
|
||||
(magit-reverse-apply sections 'magit-apply-hunks args))
|
||||
|
||||
(defun magit-reverse-file (section args)
|
||||
(magit-reverse-files (list section) args))
|
||||
|
||||
(defun magit-reverse-files (sections args)
|
||||
(pcase-let ((`(,binaries ,sections)
|
||||
(let ((bs (magit-staged-binary-files)))
|
||||
(--separate (member (oref it value) bs)
|
||||
sections))))
|
||||
(magit-confirm-files 'reverse (--map (oref it value) sections))
|
||||
(if (= (length sections) 1)
|
||||
(magit-reverse-apply (car sections) 'magit-apply-diff args)
|
||||
(magit-reverse-apply sections 'magit-apply-diffs args))
|
||||
(when binaries
|
||||
(user-error "Cannot reverse binary files"))))
|
||||
|
||||
(defun magit-reverse-apply (section:s apply args)
|
||||
(funcall apply section:s "--reverse" args
|
||||
(and (not magit-reverse-atomically)
|
||||
(not (member "--3way" args))
|
||||
"--reject")))
|
||||
|
||||
(defun magit-reverse-in-index (&rest args)
|
||||
"Reverse the change at point in the index but not the working tree.
|
||||
|
||||
Use this command to extract a change from `HEAD', while leaving
|
||||
it in the working tree, so that it can later be committed using
|
||||
a separate commit. A typical workflow would be:
|
||||
|
||||
0. Optionally make sure that there are no uncommitted changes.
|
||||
1. Visit the `HEAD' commit and navigate to the change that should
|
||||
not have been included in that commit.
|
||||
2. Type \"u\" (`magit-unstage') to reverse it in the index.
|
||||
This assumes that `magit-unstage-committed-changes' is non-nil.
|
||||
3. Type \"c e\" to extend `HEAD' with the staged changes,
|
||||
including those that were already staged before.
|
||||
4. Optionally stage the remaining changes using \"s\" or \"S\"
|
||||
and then type \"c c\" to create a new commit."
|
||||
(interactive)
|
||||
(magit-reverse (cons "--cached" args)))
|
||||
|
||||
(provide 'magit-apply)
|
||||
;;; magit-apply.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,260 @@
|
|||
;;; magit-autorevert.el --- revert buffers when files in repository change -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'dash)
|
||||
|
||||
(require 'magit-git)
|
||||
|
||||
(require 'autorevert)
|
||||
|
||||
;;; Options
|
||||
|
||||
(defgroup magit-auto-revert nil
|
||||
"Revert buffers when files in repository change."
|
||||
:link '(custom-group-link auto-revert)
|
||||
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
|
||||
:group 'auto-revert
|
||||
:group 'magit-essentials
|
||||
:group 'magit-modes)
|
||||
|
||||
(defcustom auto-revert-buffer-list-filter nil
|
||||
"Filter that determines which buffers `auto-revert-buffers' reverts.
|
||||
|
||||
This option is provided by `magit', which also redefines
|
||||
`auto-revert-buffers' to respect it. Magit users who do not turn
|
||||
on the local mode `auto-revert-mode' themselves, are best served
|
||||
by setting the value to `magit-auto-revert-repository-buffers-p'.
|
||||
|
||||
However the default is nil, to not disturb users who do use the
|
||||
local mode directly. If you experience delays when running Magit
|
||||
commands, then you should consider using one of the predicates
|
||||
provided by Magit - especially if you also use Tramp.
|
||||
|
||||
Users who do turn on `auto-revert-mode' in buffers in which Magit
|
||||
doesn't do that for them, should likely not use any filter.
|
||||
Users who turn on `global-auto-revert-mode', do not have to worry
|
||||
about this option, because it is disregarded if the global mode
|
||||
is enabled."
|
||||
:package-version '(magit . "2.4.2")
|
||||
:group 'auto-revert
|
||||
:group 'magit-auto-revert
|
||||
:group 'magit-related
|
||||
:type '(radio (const :tag "no filter" nil)
|
||||
(function-item magit-auto-revert-buffer-p)
|
||||
(function-item magit-auto-revert-repository-buffer-p)
|
||||
function))
|
||||
|
||||
(defcustom magit-auto-revert-tracked-only t
|
||||
"Whether `magit-auto-revert-mode' only reverts tracked files."
|
||||
:package-version '(magit . "2.4.0")
|
||||
:group 'magit-auto-revert
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(when (and (bound-and-true-p magit-auto-revert-mode)
|
||||
(featurep 'magit-autorevert))
|
||||
(magit-auto-revert-mode -1)
|
||||
(magit-auto-revert-mode))))
|
||||
|
||||
(defcustom magit-auto-revert-immediately t
|
||||
"Whether Magit reverts buffers immediately.
|
||||
|
||||
If this is non-nil and either `global-auto-revert-mode' or
|
||||
`magit-auto-revert-mode' is enabled, then Magit immediately
|
||||
reverts buffers by explicitly calling `auto-revert-buffers'
|
||||
after running git for side-effects.
|
||||
|
||||
If `auto-revert-use-notify' is non-nil (and file notifications
|
||||
are actually supported), then `magit-auto-revert-immediately'
|
||||
does not have to be non-nil, because the reverts happen
|
||||
immediately anyway.
|
||||
|
||||
If `magit-auto-revert-immediately' and `auto-revert-use-notify'
|
||||
are both nil, then reverts happen after `auto-revert-interval'
|
||||
seconds of user inactivity. That is not desirable."
|
||||
:package-version '(magit . "2.4.0")
|
||||
:group 'magit-auto-revert
|
||||
:type 'boolean)
|
||||
|
||||
;;; Mode
|
||||
|
||||
(defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
|
||||
(if file
|
||||
(--when-let (find-buffer-visiting file)
|
||||
(with-current-buffer it
|
||||
(magit-turn-on-auto-revert-mode-if-desired)))
|
||||
(when (and buffer-file-name
|
||||
(file-readable-p buffer-file-name)
|
||||
(magit-toplevel)
|
||||
(or (not magit-auto-revert-tracked-only)
|
||||
(magit-file-tracked-p buffer-file-name))
|
||||
(not auto-revert-mode) ; see #3014
|
||||
(not global-auto-revert-mode)) ; see #3460
|
||||
(auto-revert-mode 1))))
|
||||
|
||||
;;;###autoload
|
||||
(define-globalized-minor-mode magit-auto-revert-mode auto-revert-mode
|
||||
magit-turn-on-auto-revert-mode-if-desired
|
||||
:package-version '(magit . "2.4.0")
|
||||
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
|
||||
:group 'magit-auto-revert
|
||||
:group 'magit-essentials
|
||||
;; - When `global-auto-revert-mode' is enabled, then this mode is
|
||||
;; redundant.
|
||||
;; - In all other cases enable the mode because if buffers are not
|
||||
;; automatically reverted that would make many very common tasks
|
||||
;; much more cumbersome.
|
||||
;; - When `magit-revert-buffers' is nil, then the user has opted out
|
||||
;; of the automatic reverts while a very old implementation was
|
||||
;; still in use. We continued to respect that setting for another
|
||||
;; two and a half years, but no longer do so now.
|
||||
:init-value (and (not global-auto-revert-mode)
|
||||
(not noninteractive)))
|
||||
;; - Unfortunately `:init-value t' only sets the value of the mode
|
||||
;; variable but does not cause the mode function to be called.
|
||||
;; - I don't think it works like this on purpose, but since one usually
|
||||
;; should not enable global modes by default, it is understandable.
|
||||
;; - If the user has set the variable `magit-auto-revert-mode' to nil
|
||||
;; after loading magit (instead of doing so before loading magit or
|
||||
;; by using the function), then we should still respect that setting.
|
||||
;; - If the user has set the obsolete variable `magit-revert-buffers'
|
||||
;; to nil before or after loading magit, then we should still respect
|
||||
;; that setting.
|
||||
;; - If the user sets one of these variables after loading magit and
|
||||
;; after `after-init-hook' has run, then that won't have an effect
|
||||
;; and there is nothing we can do about it.
|
||||
(defun magit-auto-revert-mode--init-kludge ()
|
||||
"This is an internal kludge to be used on `after-init-hook'.
|
||||
Do not use this function elsewhere, and don't remove it from
|
||||
the `after-init-hook'. For more information see the comments
|
||||
and code surrounding the definition of this function."
|
||||
(if magit-auto-revert-mode
|
||||
(let ((start (current-time)))
|
||||
(magit-message "Turning on magit-auto-revert-mode...")
|
||||
(magit-auto-revert-mode 1)
|
||||
(magit-message
|
||||
"Turning on magit-auto-revert-mode...done%s"
|
||||
(let ((elapsed (float-time (time-subtract (current-time) start))))
|
||||
(if (> elapsed 0.2)
|
||||
(format " (%.3fs, %s buffers checked)" elapsed
|
||||
(length (buffer-list)))
|
||||
""))))
|
||||
(magit-auto-revert-mode -1)))
|
||||
(if after-init-time
|
||||
;; Since `after-init-hook' has already been
|
||||
;; run, turn the mode on or off right now.
|
||||
(magit-auto-revert-mode--init-kludge)
|
||||
;; By the time the init file has been fully loaded the
|
||||
;; values of the relevant variables might have changed.
|
||||
(add-hook 'after-init-hook #'magit-auto-revert-mode--init-kludge t))
|
||||
|
||||
(put 'magit-auto-revert-mode 'function-documentation
|
||||
"Toggle Magit Auto Revert mode.
|
||||
With a prefix argument ARG, enable Magit Auto Revert mode if ARG
|
||||
is positive, and disable it otherwise. If called from Lisp,
|
||||
enable the mode if ARG is omitted or nil.
|
||||
|
||||
Magit Auto Revert mode is a global minor mode that reverts
|
||||
buffers associated with a file that is located inside a Git
|
||||
repository when the file changes on disk. Use `auto-revert-mode'
|
||||
to revert a particular buffer. Or use `global-auto-revert-mode'
|
||||
to revert all file-visiting buffers, not just those that visit
|
||||
a file located inside a Git repository.
|
||||
|
||||
This global mode works by turning on the buffer-local mode
|
||||
`auto-revert-mode' at the time a buffer is first created. The
|
||||
local mode is turned on if the visited file is being tracked in
|
||||
a Git repository at the time when the buffer is created.
|
||||
|
||||
If `magit-auto-revert-tracked-only' is non-nil (the default),
|
||||
then only tracked files are reverted. But if you stage a
|
||||
previously untracked file using `magit-stage', then this mode
|
||||
notices that.
|
||||
|
||||
Unlike `global-auto-revert-mode', this mode never reverts any
|
||||
buffers that are not visiting files.
|
||||
|
||||
The behavior of this mode can be customized using the options
|
||||
in the `autorevert' and `magit-autorevert' groups.
|
||||
|
||||
This function calls the hook `magit-auto-revert-mode-hook'.")
|
||||
|
||||
(defun magit-auto-revert-buffers ()
|
||||
(when (and magit-auto-revert-immediately
|
||||
(or global-auto-revert-mode
|
||||
(and magit-auto-revert-mode auto-revert-buffer-list)))
|
||||
(let ((auto-revert-buffer-list-filter
|
||||
(or auto-revert-buffer-list-filter
|
||||
'magit-auto-revert-repository-buffer-p)))
|
||||
(auto-revert-buffers))))
|
||||
|
||||
(defvar magit-auto-revert-toplevel nil)
|
||||
|
||||
(when (< emacs-major-version 25)
|
||||
(defvar auto-revert-buffers-counter 1
|
||||
"Incremented each time `auto-revert-buffers' is called"))
|
||||
|
||||
(defun magit-auto-revert-buffer-p (buffer)
|
||||
"Return t if BUFFER visits a file inside the current repository.
|
||||
The current repository is the one in which `default-directory' is
|
||||
located. If there is no current repository, then return t for
|
||||
any BUFFER."
|
||||
(magit-auto-revert-repository-buffer-p buffer t))
|
||||
|
||||
(defun magit-auto-revert-repository-buffer-p (buffer &optional fallback)
|
||||
"Return t if BUFFER visits a file inside the current repository.
|
||||
The current repository is the one in which `default-directory' is
|
||||
located. If there is no current repository, then return FALLBACK
|
||||
\(which defaults to nil) for any BUFFER."
|
||||
;; Call `magit-toplevel' just once per cycle.
|
||||
(unless (and magit-auto-revert-toplevel
|
||||
(= (cdr magit-auto-revert-toplevel)
|
||||
auto-revert-buffers-counter))
|
||||
(setq magit-auto-revert-toplevel
|
||||
(cons (or (magit-toplevel) 'no-repo)
|
||||
auto-revert-buffers-counter)))
|
||||
(let ((top (car magit-auto-revert-toplevel)))
|
||||
(if (eq top 'no-repo)
|
||||
fallback
|
||||
(let ((dir (with-current-buffer buffer default-directory)))
|
||||
(and (equal (file-remote-p dir)
|
||||
(file-remote-p top))
|
||||
;; ^ `tramp-handle-file-in-directory-p' lacks this optimization.
|
||||
(file-in-directory-p dir top))))))
|
||||
|
||||
(defun auto-revert-buffers--buffer-list-filter ()
|
||||
(when (< emacs-major-version 25)
|
||||
(cl-incf auto-revert-buffers-counter))
|
||||
(when auto-revert-buffer-list-filter
|
||||
(setq auto-revert-buffer-list
|
||||
(--filter auto-revert-buffer-list-filter
|
||||
auto-revert-buffer-list))))
|
||||
|
||||
(advice-add 'auto-revert-buffers :before
|
||||
'auto-revert-buffers--buffer-list-filter)
|
||||
|
||||
(provide 'magit-autorevert)
|
||||
;;; magit-autorevert.el ends here
|
Binary file not shown.
|
@ -0,0 +1,216 @@
|
|||
;;; magit-bisect.el --- bisect support for Magit -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2011-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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:
|
||||
|
||||
;; Use a binary search to find the commit that introduced a bug.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
;;; Options
|
||||
|
||||
(defcustom magit-bisect-show-graph t
|
||||
"Whether to use `--graph' in the log showing commits yet to be bisected."
|
||||
:package-version '(magit . "2.8.0")
|
||||
:group 'magit-status
|
||||
:type 'boolean)
|
||||
|
||||
(defface magit-bisect-good
|
||||
'((t :foreground "DarkOliveGreen"))
|
||||
"Face for good bisect revisions."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-bisect-skip
|
||||
'((t :foreground "DarkGoldenrod"))
|
||||
"Face for skipped bisect revisions."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-bisect-bad
|
||||
'((t :foreground "IndianRed4"))
|
||||
"Face for bad bisect revisions."
|
||||
:group 'magit-faces)
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload (autoload 'magit-bisect-popup "magit-bisect" nil t)
|
||||
(magit-define-popup magit-bisect-popup
|
||||
"Popup console for bisect commands."
|
||||
:man-page "git-bisect"
|
||||
:actions '((?B "Start" magit-bisect-start)
|
||||
(?s "Start script" magit-bisect-run))
|
||||
:sequence-actions '((?b "Bad" magit-bisect-bad)
|
||||
(?g "Good" magit-bisect-good)
|
||||
(?k "Skip" magit-bisect-skip)
|
||||
(?r "Reset" magit-bisect-reset)
|
||||
(?s "Run script" magit-bisect-run))
|
||||
:sequence-predicate 'magit-bisect-in-progress-p)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-start (bad good)
|
||||
"Start a bisect session.
|
||||
|
||||
Bisecting a bug means to find the commit that introduced it.
|
||||
This command starts such a bisect session by asking for a know
|
||||
good and a bad commit. To move the session forward use the
|
||||
other actions from the bisect popup (\
|
||||
\\<magit-status-mode-map>\\[magit-bisect-popup])."
|
||||
(interactive (if (magit-bisect-in-progress-p)
|
||||
(user-error "Already bisecting")
|
||||
(magit-bisect-start-read-args)))
|
||||
(unless (magit-rev-ancestor-p good bad)
|
||||
(user-error
|
||||
"The good revision (%s) has to be an ancestor of the bad one (%s)"
|
||||
good bad))
|
||||
(when (magit-anything-modified-p)
|
||||
(user-error "Cannot bisect with uncommitted changes"))
|
||||
(magit-git-bisect "start" (list bad good) t))
|
||||
|
||||
(defun magit-bisect-start-read-args ()
|
||||
(let ((b (magit-read-branch-or-commit "Start bisect with bad revision")))
|
||||
(list b (magit-read-other-branch-or-commit "Good revision" b))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-reset ()
|
||||
"After bisecting, cleanup bisection state and return to original `HEAD'."
|
||||
(interactive)
|
||||
(magit-confirm 'reset-bisect)
|
||||
(magit-run-git "bisect" "reset")
|
||||
(ignore-errors (delete-file (magit-git-dir "BISECT_CMD_OUTPUT"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-good ()
|
||||
"While bisecting, mark the current commit as good.
|
||||
Use this after you have asserted that the commit does not contain
|
||||
the bug in question."
|
||||
(interactive)
|
||||
(magit-git-bisect "good"))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-bad ()
|
||||
"While bisecting, mark the current commit as bad.
|
||||
Use this after you have asserted that the commit does contain the
|
||||
bug in question."
|
||||
(interactive)
|
||||
(magit-git-bisect "bad"))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-skip ()
|
||||
"While bisecting, skip the current commit.
|
||||
Use this if for some reason the current commit is not a good one
|
||||
to test. This command lets Git choose a different one."
|
||||
(interactive)
|
||||
(magit-git-bisect "skip"))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bisect-run (cmdline &optional bad good)
|
||||
"Bisect automatically by running commands after each step.
|
||||
|
||||
Unlike `git bisect run' this can be used before bisecting has
|
||||
begun. In that case it behaves like `git bisect start; git
|
||||
bisect run'."
|
||||
(interactive (let ((args (and (not (magit-bisect-in-progress-p))
|
||||
(magit-bisect-start-read-args))))
|
||||
(cons (read-shell-command "Bisect shell command: ") args)))
|
||||
(when (and bad good)
|
||||
(magit-bisect-start bad good))
|
||||
(magit-git-bisect "run" (list shell-file-name shell-command-switch cmdline)))
|
||||
|
||||
(defun magit-git-bisect (subcommand &optional args no-assert)
|
||||
(unless (or no-assert (magit-bisect-in-progress-p))
|
||||
(user-error "Not bisecting"))
|
||||
(magit-with-toplevel
|
||||
(magit-run-git-with-logfile
|
||||
(magit-git-dir "BISECT_CMD_OUTPUT") "bisect" subcommand args)))
|
||||
|
||||
;;; Sections
|
||||
|
||||
(defun magit-bisect-in-progress-p ()
|
||||
(file-exists-p (magit-git-dir "BISECT_LOG")))
|
||||
|
||||
(defun magit-insert-bisect-output ()
|
||||
"While bisecting, insert section with output from `git bisect'."
|
||||
(when (magit-bisect-in-progress-p)
|
||||
(let* ((lines
|
||||
(or (magit-file-lines (magit-git-dir "BISECT_CMD_OUTPUT"))
|
||||
(list "Bisecting: (no saved bisect output)"
|
||||
"It appears you have invoked `git bisect' from a shell."
|
||||
"There is nothing wrong with that, we just cannot display"
|
||||
"anything useful here. Consult the shell output instead.")))
|
||||
(done-re "^\\([a-z0-9]\\{40\\}\\) is the first bad commit$")
|
||||
(bad-line (or (and (string-match done-re (car lines))
|
||||
(pop lines))
|
||||
(--first (string-match done-re it) lines))))
|
||||
(magit-insert-section ((eval (if bad-line 'commit 'bisect-output))
|
||||
(and bad-line (match-string 1 bad-line)))
|
||||
(magit-insert-heading
|
||||
(propertize (or bad-line (pop lines))
|
||||
'face 'magit-section-heading))
|
||||
(dolist (line lines)
|
||||
(insert line "\n"))))
|
||||
(insert "\n")))
|
||||
|
||||
(defun magit-insert-bisect-rest ()
|
||||
"While bisecting, insert section visualizing the bisect state."
|
||||
(when (magit-bisect-in-progress-p)
|
||||
(magit-insert-section (bisect-view)
|
||||
(magit-insert-heading "Bisect Rest:")
|
||||
(magit-git-wash (apply-partially 'magit-log-wash-log 'bisect-vis)
|
||||
"bisect" "visualize" "git" "log"
|
||||
"--format=%h%d%x00%s" "--decorate=full"
|
||||
(and magit-bisect-show-graph "--graph")))))
|
||||
|
||||
(defun magit-insert-bisect-log ()
|
||||
"While bisecting, insert section logging bisect progress."
|
||||
(when (magit-bisect-in-progress-p)
|
||||
(magit-insert-section (bisect-log)
|
||||
(magit-insert-heading "Bisect Log:")
|
||||
(magit-git-wash #'magit-wash-bisect-log "bisect" "log")
|
||||
(insert ?\n))))
|
||||
|
||||
(defun magit-wash-bisect-log (_args)
|
||||
(let (beg)
|
||||
(while (progn (setq beg (point-marker))
|
||||
(re-search-forward "^\\(git bisect [^\n]+\n\\)" nil t))
|
||||
(magit-bind-match-strings (heading) nil
|
||||
(magit-delete-match)
|
||||
(save-restriction
|
||||
(narrow-to-region beg (point))
|
||||
(goto-char (point-min))
|
||||
(magit-insert-section (bisect-item heading t)
|
||||
(insert (propertize heading 'face 'magit-section-secondary-heading))
|
||||
(magit-insert-heading)
|
||||
(magit-wash-sequence
|
||||
(apply-partially 'magit-log-wash-rev 'bisect-log
|
||||
(magit-abbrev-length)))
|
||||
(insert ?\n)))))
|
||||
(when (re-search-forward
|
||||
"# first bad commit: \\[\\([a-z0-9]\\{40\\}\\)\\] [^\n]+\n" nil t)
|
||||
(magit-bind-match-strings (hash) nil
|
||||
(magit-delete-match)
|
||||
(magit-insert-section (bisect-item)
|
||||
(insert hash " is the first bad commit\n"))))))
|
||||
|
||||
(provide 'magit-bisect)
|
||||
;;; magit-bisect.el ends here
|
Binary file not shown.
|
@ -0,0 +1,926 @@
|
|||
;;; magit-blame.el --- blame support for Magit -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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:
|
||||
|
||||
;; Annotates each line in file-visiting buffer with information from
|
||||
;; the revision which last modified the line.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
;;; Options
|
||||
|
||||
(defgroup magit-blame nil
|
||||
"Blame support for Magit."
|
||||
:link '(info-link "(magit)Blaming")
|
||||
:group 'magit-modes)
|
||||
|
||||
(defcustom magit-blame-styles
|
||||
'((headings
|
||||
(heading-format . "%-20a %C %s\n"))
|
||||
(margin
|
||||
(margin-format . (" %s%f" " %C %a" " %H"))
|
||||
(margin-width . 42)
|
||||
(margin-face . magit-blame-margin)
|
||||
(margin-body-face . (magit-blame-dimmed)))
|
||||
(highlight
|
||||
(highlight-face . magit-blame-highlight))
|
||||
(lines
|
||||
(show-lines . t)))
|
||||
"List of styles used to visualize blame information.
|
||||
|
||||
Each entry has the form (IDENT (KEY . VALUE)...). IDENT has
|
||||
to be a symbol uniquely identifing the style. The following
|
||||
KEYs are recognized:
|
||||
|
||||
`show-lines'
|
||||
Whether to prefix each chunk of lines with a thin line.
|
||||
This has no effect if `heading-format' is non-nil.
|
||||
`highlight-face'
|
||||
Face used to highlight the first line of each chunk.
|
||||
If this is nil, then those lines are not highlighted.
|
||||
`heading-format'
|
||||
String specifing the information to be shown above each
|
||||
chunk of lines. It must end with a newline character.
|
||||
`margin-format'
|
||||
String specifing the information to be shown in the left
|
||||
buffer margin. It must NOT end with a newline character.
|
||||
This can also be a list of formats used for the lines at
|
||||
the same positions within the chunk. If the chunk has
|
||||
more lines than formats are specified, then the last is
|
||||
repeated.
|
||||
`margin-width'
|
||||
Width of the margin, provided `margin-format' is non-nil.
|
||||
`margin-face'
|
||||
Face used in the margin, provided `margin-format' is
|
||||
non-nil. This face is used in combination with the faces
|
||||
that are specific to the used %-specs. If this is nil,
|
||||
then `magit-blame-margin' is used.
|
||||
`margin-body-face'
|
||||
Face used in the margin for all but first line of a chunk.
|
||||
This face is used in combination with the faces that are
|
||||
specific to the used %-specs. This can also be a list of
|
||||
faces (usually one face), in which case only these faces
|
||||
are used and the %-spec faces are ignored. A good value
|
||||
might be `(magit-blame-dimmed)'. If this is nil, then
|
||||
the same face as for the first line is used.
|
||||
|
||||
The following %-specs can be used in `heading-format' and
|
||||
`margin-format':
|
||||
|
||||
%H hash using face `magit-blame-hash'
|
||||
%s summary using face `magit-blame-summary'
|
||||
%a author using face `magit-blame-name'
|
||||
%A author time using face `magit-blame-date'
|
||||
%c committer using face `magit-blame-name'
|
||||
%C committer time using face `magit-blame-date'
|
||||
|
||||
Additionally if `margin-format' ends with %f, then the string
|
||||
that is displayed in the margin is made at least `margin-width'
|
||||
characters wide, which may be desirable if the used face sets
|
||||
the background color.
|
||||
|
||||
The style used in the current buffer can be cycled from the blame
|
||||
popup. Blame commands (except `magit-blame-echo') use the first
|
||||
style as the initial style when beginning to blame in a buffer."
|
||||
:package-version '(magit . "2.13.0")
|
||||
:group 'magit-blame
|
||||
:type 'string)
|
||||
|
||||
(defcustom magit-blame-echo-style 'lines
|
||||
"The blame visualization style used by `magit-blame-echo'.
|
||||
A symbol that has to be used as the identifier for one of the
|
||||
styles defined in `magit-blame-styles'."
|
||||
:package-version '(magit . "2.13.0")
|
||||
:group 'magit-blame
|
||||
:type 'symbol)
|
||||
|
||||
(defcustom magit-blame-time-format "%F %H:%M"
|
||||
"Format for time strings in blame headings."
|
||||
:group 'magit-blame
|
||||
:type 'string)
|
||||
|
||||
(defcustom magit-blame-read-only t
|
||||
"Whether to initially make the blamed buffer read-only."
|
||||
:package-version '(magit . "2.13.0")
|
||||
:group 'magit-blame
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
|
||||
"List of modes not compatible with Magit-Blame mode.
|
||||
This modes are turned off when Magit-Blame mode is turned on,
|
||||
and then turned on again when turning off the latter."
|
||||
:group 'magit-blame
|
||||
:type '(repeat (symbol :tag "Mode")))
|
||||
|
||||
(defcustom magit-blame-mode-lighter " Blame"
|
||||
"The mode-line lighter of the Magit-Blame mode."
|
||||
:group 'magit-blame
|
||||
:type '(choice (const :tag "No lighter" "") string))
|
||||
|
||||
(defcustom magit-blame-goto-chunk-hook
|
||||
'(magit-blame-maybe-update-revision-buffer
|
||||
magit-blame-maybe-show-message)
|
||||
"Hook run after point entered another chunk."
|
||||
:package-version '(magit . "2.13.0")
|
||||
:group 'magit-blame
|
||||
:type 'hook
|
||||
:get 'magit-hook-custom-get
|
||||
:options '(magit-blame-maybe-update-revision-buffer
|
||||
magit-blame-maybe-show-message))
|
||||
|
||||
;;; Faces
|
||||
|
||||
(defface magit-blame-highlight
|
||||
'((((class color) (background light))
|
||||
:background "grey80"
|
||||
:foreground "black")
|
||||
(((class color) (background dark))
|
||||
:background "grey25"
|
||||
:foreground "white"))
|
||||
"Face used for highlighting when blaming.
|
||||
Also see option `magit-blame-styles'."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-margin
|
||||
'((t :inherit magit-blame-highlight
|
||||
:weight normal
|
||||
:slant normal))
|
||||
"Face used for the blame margin by default when blaming.
|
||||
Also see option `magit-blame-styles'."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-dimmed
|
||||
'((t :inherit magit-dimmed
|
||||
:weight normal
|
||||
:slant normal))
|
||||
"Face used for the blame margin in some cases when blaming.
|
||||
Also see option `magit-blame-styles'."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-heading
|
||||
'((t :inherit magit-blame-highlight
|
||||
:weight normal
|
||||
:slant normal))
|
||||
"Face used for blame headings by default when blaming.
|
||||
Also see option `magit-blame-styles'."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-summary nil
|
||||
"Face used for commit summaries when blaming."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-hash nil
|
||||
"Face used for commit hashes when blaming."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-name nil
|
||||
"Face used for author and committer names when blaming."
|
||||
:group 'magit-faces)
|
||||
|
||||
(defface magit-blame-date nil
|
||||
"Face used for dates when blaming."
|
||||
:group 'magit-faces)
|
||||
|
||||
;;; Chunks
|
||||
|
||||
(defclass magit-blame-chunk ()
|
||||
(;; <orig-rev> <orig-line> <final-line> <num-lines>
|
||||
(orig-rev :initarg :orig-rev)
|
||||
(orig-line :initarg :orig-line)
|
||||
(final-line :initarg :final-line)
|
||||
(num-lines :initarg :num-lines)
|
||||
;; previous <prev-rev> <prev-file>
|
||||
(prev-rev :initform nil)
|
||||
(prev-file :initform nil)
|
||||
;; filename <orig-file>
|
||||
(orig-file)))
|
||||
|
||||
(defun magit-current-blame-chunk (&optional type)
|
||||
(or (and (not (and type (not (eq type magit-blame-type))))
|
||||
(magit-blame-chunk-at (point)))
|
||||
(and type
|
||||
(let ((rev (or magit-buffer-refname magit-buffer-revision))
|
||||
(file (magit-file-relative-name nil (not magit-buffer-file-name)))
|
||||
(line (format "%i,+1" (line-number-at-pos))))
|
||||
(unless file
|
||||
(error "Buffer does not visit a tracked file"))
|
||||
(with-temp-buffer
|
||||
(magit-with-toplevel
|
||||
(magit-git-insert
|
||||
"blame" "--porcelain"
|
||||
(if (memq magit-blame-type '(final removal))
|
||||
(cons "--reverse" (magit-blame-arguments))
|
||||
(magit-blame-arguments))
|
||||
"-L" line rev "--" file)
|
||||
(goto-char (point-min))
|
||||
(car (magit-blame--parse-chunk type))))))))
|
||||
|
||||
(defun magit-blame-chunk-at (pos)
|
||||
(--some (overlay-get it 'magit-blame-chunk)
|
||||
(overlays-at pos)))
|
||||
|
||||
(defun magit-blame--overlay-at (&optional pos key)
|
||||
(unless pos
|
||||
(setq pos (point)))
|
||||
(--first (overlay-get it (or key 'magit-blame-chunk))
|
||||
(nconc (overlays-at pos)
|
||||
(overlays-in pos pos))))
|
||||
|
||||
;;; Keymaps
|
||||
|
||||
(defvar magit-blame-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-q") 'magit-blame-quit)
|
||||
map)
|
||||
"Keymap for `magit-blame-mode'.
|
||||
Note that most blaming key bindings are defined
|
||||
in `magit-blame-read-only-mode-map' instead.")
|
||||
|
||||
(defvar magit-blame-read-only-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(cond ((featurep 'jkl)
|
||||
(define-key map [return] 'magit-show-commit)
|
||||
(define-key map (kbd "i") 'magit-blame-previous-chunk)
|
||||
(define-key map (kbd "I") 'magit-blame-previous-chunk-same-commit)
|
||||
(define-key map (kbd "k") 'magit-blame-next-chunk)
|
||||
(define-key map (kbd "K") 'magit-blame-next-chunk-same-commit)
|
||||
(define-key map (kbd "j") 'magit-blame)
|
||||
(define-key map (kbd "l") 'magit-blame-removal)
|
||||
(define-key map (kbd "f") 'magit-blame-reverse)
|
||||
(define-key map (kbd "b") 'magit-blame-popup))
|
||||
(t
|
||||
(define-key map (kbd "C-m") 'magit-show-commit)
|
||||
(define-key map (kbd "p") 'magit-blame-previous-chunk)
|
||||
(define-key map (kbd "P") 'magit-blame-previous-chunk-same-commit)
|
||||
(define-key map (kbd "n") 'magit-blame-next-chunk)
|
||||
(define-key map (kbd "N") 'magit-blame-next-chunk-same-commit)
|
||||
(define-key map (kbd "b") 'magit-blame)
|
||||
(define-key map (kbd "r") 'magit-blame-removal)
|
||||
(define-key map (kbd "f") 'magit-blame-reverse)
|
||||
(define-key map (kbd "B") 'magit-blame-popup)))
|
||||
(define-key map (kbd "c") 'magit-blame-cycle-style)
|
||||
(define-key map (kbd "q") 'magit-blame-quit)
|
||||
(define-key map (kbd "M-w") 'magit-blame-copy-hash)
|
||||
(define-key map (kbd "SPC") 'magit-diff-show-or-scroll-up)
|
||||
(define-key map (kbd "DEL") 'magit-diff-show-or-scroll-down)
|
||||
map)
|
||||
"Keymap for `magit-blame-read-only-mode'.")
|
||||
|
||||
;;; Modes
|
||||
;;;; Variables
|
||||
|
||||
(defvar-local magit-blame-buffer-read-only nil)
|
||||
(defvar-local magit-blame-cache nil)
|
||||
(defvar-local magit-blame-disabled-modes nil)
|
||||
(defvar-local magit-blame-process nil)
|
||||
(defvar-local magit-blame-recursive-p nil)
|
||||
(defvar-local magit-blame-type nil)
|
||||
(defvar-local magit-blame-separator nil)
|
||||
(defvar-local magit-blame-previous-chunk nil)
|
||||
|
||||
(defvar-local magit-blame--style nil)
|
||||
|
||||
(defsubst magit-blame--style-get (key)
|
||||
(cdr (assoc key (cdr magit-blame--style))))
|
||||
|
||||
;;;; Base Mode
|
||||
|
||||
(define-minor-mode magit-blame-mode
|
||||
"Display blame information inline."
|
||||
:lighter magit-blame-mode-lighter
|
||||
(cond (magit-blame-mode
|
||||
(when (called-interactively-p 'any)
|
||||
(setq magit-blame-mode nil)
|
||||
(user-error
|
||||
(concat "Don't call `magit-blame-mode' directly; "
|
||||
"instead use `magit-blame' or `magit-blame-popup'")))
|
||||
(add-hook 'after-save-hook 'magit-blame--run t t)
|
||||
(add-hook 'post-command-hook 'magit-blame-goto-chunk-hook t t)
|
||||
(add-hook 'before-revert-hook 'magit-blame--remove-overlays t t)
|
||||
(add-hook 'after-revert-hook 'magit-blame--run t t)
|
||||
(add-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t t)
|
||||
(setq magit-blame-buffer-read-only buffer-read-only)
|
||||
(when (or magit-blame-read-only magit-buffer-file-name)
|
||||
(read-only-mode 1))
|
||||
(dolist (mode magit-blame-disable-modes)
|
||||
(when (and (boundp mode) (symbol-value mode))
|
||||
(funcall mode -1)
|
||||
(push mode magit-blame-disabled-modes)))
|
||||
(setq magit-blame-separator (magit-blame--format-separator))
|
||||
(unless magit-blame--style
|
||||
(setq magit-blame--style (car magit-blame-styles)))
|
||||
(magit-blame--update-margin))
|
||||
(t
|
||||
(when (process-live-p magit-blame-process)
|
||||
(kill-process magit-blame-process)
|
||||
(while magit-blame-process
|
||||
(sit-for 0.01))) ; avoid racing the sentinal
|
||||
(remove-hook 'after-save-hook 'magit-blame--run t)
|
||||
(remove-hook 'post-command-hook 'magit-blame-goto-chunk-hook t)
|
||||
(remove-hook 'before-revert-hook 'magit-blame--remove-overlays t)
|
||||
(remove-hook 'after-revert-hook 'magit-blame--run t)
|
||||
(remove-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t)
|
||||
(unless magit-blame-buffer-read-only
|
||||
(read-only-mode -1))
|
||||
(magit-blame-read-only-mode -1)
|
||||
(dolist (mode magit-blame-disabled-modes)
|
||||
(funcall mode 1))
|
||||
(kill-local-variable 'magit-blame-disabled-modes)
|
||||
(kill-local-variable 'magit-blame-type)
|
||||
(kill-local-variable 'magit-blame--style)
|
||||
(magit-blame--update-margin)
|
||||
(magit-blame--remove-overlays))))
|
||||
|
||||
(defun magit-blame-goto-chunk-hook ()
|
||||
(let ((chunk (magit-blame-chunk-at (point))))
|
||||
(when (cl-typep chunk 'magit-blame-chunk)
|
||||
(unless (eq chunk magit-blame-previous-chunk)
|
||||
(run-hooks 'magit-blame-goto-chunk-hook))
|
||||
(setq magit-blame-previous-chunk chunk))))
|
||||
|
||||
(defun magit-blame-toggle-read-only ()
|
||||
(magit-blame-read-only-mode (if buffer-read-only 1 -1)))
|
||||
|
||||
;;;; Read-Only Mode
|
||||
|
||||
(define-minor-mode magit-blame-read-only-mode
|
||||
"Provide keybindings for Magit-Blame mode.
|
||||
|
||||
This minor-mode provides the key bindings for Magit-Blame mode,
|
||||
but only when Read-Only mode is also enabled because these key
|
||||
bindings would otherwise conflict badly with regular bindings.
|
||||
|
||||
When both Magit-Blame mode and Read-Only mode are enabled, then
|
||||
this mode gets automatically enabled too and when one of these
|
||||
modes is toggled, then this mode also gets toggled automatically.
|
||||
|
||||
\\{magit-blame-read-only-mode-map}")
|
||||
|
||||
;;;; Kludges
|
||||
|
||||
(defun magit-blame-put-keymap-before-view-mode ()
|
||||
"Put `magit-blame-read-only-mode' ahead of `view-mode' in `minor-mode-map-alist'."
|
||||
(--when-let (assq 'magit-blame-read-only-mode
|
||||
(cl-member 'view-mode minor-mode-map-alist :key #'car))
|
||||
(setq minor-mode-map-alist
|
||||
(cons it (delq it minor-mode-map-alist))))
|
||||
(remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
|
||||
|
||||
(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
|
||||
|
||||
;;; Process
|
||||
|
||||
(defun magit-blame--run ()
|
||||
(magit-with-toplevel
|
||||
(unless magit-blame-mode
|
||||
(magit-blame-mode 1))
|
||||
(message "Blaming...")
|
||||
(magit-blame-run-process
|
||||
(or magit-buffer-refname magit-buffer-revision)
|
||||
(magit-file-relative-name nil (not magit-buffer-file-name))
|
||||
(if (memq magit-blame-type '(final removal))
|
||||
(cons "--reverse" (magit-blame-arguments))
|
||||
(magit-blame-arguments))
|
||||
(list (line-number-at-pos (window-start))
|
||||
(line-number-at-pos (1- (window-end nil t)))))
|
||||
(set-process-sentinel magit-this-process
|
||||
'magit-blame-process-quickstart-sentinel)))
|
||||
|
||||
(defun magit-blame-run-process (revision file args &optional lines)
|
||||
(let ((process (magit-parse-git-async
|
||||
"blame" "--incremental" args
|
||||
(and lines (list "-L" (apply #'format "%s,%s" lines)))
|
||||
revision "--" file)))
|
||||
(set-process-filter process 'magit-blame-process-filter)
|
||||
(set-process-sentinel process 'magit-blame-process-sentinel)
|
||||
(process-put process 'arguments (list revision file args))
|
||||
(setq magit-blame-cache (make-hash-table :test 'equal))
|
||||
(setq magit-blame-process process)))
|
||||
|
||||
(defun magit-blame-process-quickstart-sentinel (process event)
|
||||
(when (memq (process-status process) '(exit signal))
|
||||
(magit-blame-process-sentinel process event t)
|
||||
(magit-blame-assert-buffer process)
|
||||
(with-current-buffer (process-get process 'command-buf)
|
||||
(when magit-blame-mode
|
||||
(let ((default-directory (magit-toplevel)))
|
||||
(apply #'magit-blame-run-process
|
||||
(process-get process 'arguments)))))))
|
||||
|
||||
(defun magit-blame-process-sentinel (process _event &optional quiet)
|
||||
(let ((status (process-status process)))
|
||||
(when (memq status '(exit signal))
|
||||
(kill-buffer (process-buffer process))
|
||||
(if (and (eq status 'exit)
|
||||
(zerop (process-exit-status process)))
|
||||
(unless quiet
|
||||
(message "Blaming...done"))
|
||||
(magit-blame-assert-buffer process)
|
||||
(with-current-buffer (process-get process 'command-buf)
|
||||
(if magit-blame-mode
|
||||
(progn (magit-blame-mode -1)
|
||||
(message "Blaming...failed"))
|
||||
(message "Blaming...aborted"))))
|
||||
(kill-local-variable 'magit-blame-process))))
|
||||
|
||||
(defun magit-blame-process-filter (process string)
|
||||
(internal-default-process-filter process string)
|
||||
(let ((buf (process-get process 'command-buf))
|
||||
(pos (process-get process 'parsed))
|
||||
(mark (process-mark process))
|
||||
type cache)
|
||||
(with-current-buffer buf
|
||||
(setq type magit-blame-type)
|
||||
(setq cache magit-blame-cache))
|
||||
(with-current-buffer (process-buffer process)
|
||||
(goto-char pos)
|
||||
(while (and (< (point) mark)
|
||||
(save-excursion (re-search-forward "^filename .+\n" nil t)))
|
||||
(pcase-let* ((`(,chunk ,revinfo)
|
||||
(magit-blame--parse-chunk type))
|
||||
(rev (oref chunk orig-rev)))
|
||||
(if revinfo
|
||||
(puthash rev revinfo cache)
|
||||
(setq revinfo
|
||||
(or (gethash rev cache)
|
||||
(puthash rev (magit-blame--commit-alist rev) cache))))
|
||||
(magit-blame--make-overlays buf chunk revinfo))
|
||||
(process-put process 'parsed (point))))))
|
||||
|
||||
(defun magit-blame--parse-chunk (type)
|
||||
(let (chunk revinfo)
|
||||
(looking-at "^\\(.\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)")
|
||||
(with-slots (orig-rev orig-file prev-rev prev-file)
|
||||
(setq chunk (magit-blame-chunk
|
||||
:orig-rev (match-string 1)
|
||||
:orig-line (string-to-number (match-string 2))
|
||||
:final-line (string-to-number (match-string 3))
|
||||
:num-lines (string-to-number (match-string 4))))
|
||||
(forward-line)
|
||||
(let (done)
|
||||
(while (not done)
|
||||
(cond ((looking-at "^filename \\(.+\\)")
|
||||
(setq done t)
|
||||
(setf orig-file (match-string 1)))
|
||||
((looking-at "^previous \\(.\\{40\\}\\) \\(.+\\)")
|
||||
(setf prev-rev (match-string 1))
|
||||
(setf prev-file (match-string 2)))
|
||||
((looking-at "^\\([^ ]+\\) \\(.+\\)")
|
||||
(push (cons (match-string 1)
|
||||
(match-string 2)) revinfo)))
|
||||
(forward-line)))
|
||||
(when (and (eq type 'removal) prev-rev)
|
||||
(cl-rotatef orig-rev prev-rev)
|
||||
(cl-rotatef orig-file prev-file)
|
||||
(setq revinfo nil)))
|
||||
(list chunk revinfo)))
|
||||
|
||||
(defun magit-blame--commit-alist (rev)
|
||||
(cl-mapcar 'cons
|
||||
'("summary"
|
||||
"author" "author-time" "author-tz"
|
||||
"committer" "committer-time" "committer-tz")
|
||||
(split-string (magit-rev-format "%s\v%an\v%ad\v%cn\v%cd" rev
|
||||
"--date=format:%s\v%z")
|
||||
"\v")))
|
||||
|
||||
(defun magit-blame-assert-buffer (process)
|
||||
(unless (buffer-live-p (process-get process 'command-buf))
|
||||
(kill-process process)
|
||||
(user-error "Buffer being blamed has been killed")))
|
||||
|
||||
;;; Display
|
||||
|
||||
(defun magit-blame--make-overlays (buf chunk revinfo)
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- (oref chunk final-line)))
|
||||
(let ((beg (point))
|
||||
(end (save-excursion
|
||||
(forward-line (oref chunk num-lines))
|
||||
(point))))
|
||||
(magit-blame--remove-overlays beg end)
|
||||
(magit-blame--make-margin-overlays chunk revinfo beg end)
|
||||
(magit-blame--make-heading-overlay chunk revinfo beg end)
|
||||
(magit-blame--make-highlight-overlay chunk beg))))))
|
||||
|
||||
(defun magit-blame--make-margin-overlays (chunk revinfo _beg end)
|
||||
(save-excursion
|
||||
(let ((line 0))
|
||||
(while (< (point) end)
|
||||
(magit-blame--make-margin-overlay chunk revinfo line)
|
||||
(forward-line)
|
||||
(cl-incf line)))))
|
||||
|
||||
(defun magit-blame--make-margin-overlay (chunk revinfo line)
|
||||
(let* ((end (line-end-position))
|
||||
;; If possible avoid putting this on the first character
|
||||
;; of the line to avoid a conflict with the line overlay.
|
||||
(beg (min (1+ (line-beginning-position)) end))
|
||||
(ov (make-overlay beg end)))
|
||||
(overlay-put ov 'magit-blame-chunk chunk)
|
||||
(overlay-put ov 'magit-blame-revinfo revinfo)
|
||||
(overlay-put ov 'magit-blame-margin line)
|
||||
(magit-blame--update-margin-overlay ov)))
|
||||
|
||||
(defun magit-blame--make-heading-overlay (chunk revinfo beg end)
|
||||
(let ((ov (make-overlay beg end)))
|
||||
(overlay-put ov 'magit-blame-chunk chunk)
|
||||
(overlay-put ov 'magit-blame-revinfo revinfo)
|
||||
(overlay-put ov 'magit-blame-heading t)
|
||||
(magit-blame--update-heading-overlay ov)))
|
||||
|
||||
(defun magit-blame--make-highlight-overlay (chunk beg)
|
||||
(let ((ov (make-overlay beg (1+ (line-end-position)))))
|
||||
(overlay-put ov 'magit-blame-chunk chunk)
|
||||
(overlay-put ov 'magit-blame-highlight t)
|
||||
(magit-blame--update-highlight-overlay ov)))
|
||||
|
||||
(defun magit-blame--update-margin ()
|
||||
(setq left-margin-width (or (magit-blame--style-get 'margin-width) 0))
|
||||
(set-window-buffer (selected-window) (current-buffer)))
|
||||
|
||||
(defun magit-blame--update-overlays ()
|
||||
(save-restriction
|
||||
(widen)
|
||||
(dolist (ov (overlays-in (point-min) (point-max)))
|
||||
(cond ((overlay-get ov 'magit-blame-heading)
|
||||
(magit-blame--update-heading-overlay ov))
|
||||
((overlay-get ov 'magit-blame-margin)
|
||||
(magit-blame--update-margin-overlay ov))
|
||||
((overlay-get ov 'magit-blame-highlight)
|
||||
(magit-blame--update-highlight-overlay ov))))))
|
||||
|
||||
(defun magit-blame--update-margin-overlay (ov)
|
||||
(overlay-put
|
||||
ov 'before-string
|
||||
(and (magit-blame--style-get 'margin-width)
|
||||
(propertize
|
||||
"o" 'display
|
||||
(list (list 'margin 'left-margin)
|
||||
(let ((line (overlay-get ov 'magit-blame-margin))
|
||||
(format (magit-blame--style-get 'margin-format))
|
||||
(face (magit-blame--style-get 'margin-face)))
|
||||
(magit-blame--format-string
|
||||
ov
|
||||
(or (and (atom format)
|
||||
format)
|
||||
(nth line format)
|
||||
(car (last format)))
|
||||
(or (and (not (zerop line))
|
||||
(magit-blame--style-get 'margin-body-face))
|
||||
face
|
||||
'magit-blame-margin))))))))
|
||||
|
||||
(defun magit-blame--update-heading-overlay (ov)
|
||||
(overlay-put
|
||||
ov 'before-string
|
||||
(--if-let (magit-blame--style-get 'heading-format)
|
||||
(magit-blame--format-string ov it 'magit-blame-heading)
|
||||
(and (magit-blame--style-get 'show-lines)
|
||||
(or (not (magit-blame--style-get 'margin-format))
|
||||
(save-excursion
|
||||
(goto-char (overlay-start ov))
|
||||
;; Special case of the special case described in
|
||||
;; `magit-blame--make-margin-overlay'. For empty
|
||||
;; lines it is not possible to show both overlays
|
||||
;; without the line being to high.
|
||||
(not (= (point) (line-end-position)))))
|
||||
magit-blame-separator))))
|
||||
|
||||
(defun magit-blame--update-highlight-overlay (ov)
|
||||
(overlay-put ov 'face (magit-blame--style-get 'highlight-face)))
|
||||
|
||||
(defun magit-blame--format-string (ov format face)
|
||||
(let* ((chunk (overlay-get ov 'magit-blame-chunk))
|
||||
(revinfo (overlay-get ov 'magit-blame-revinfo))
|
||||
(key (list format face))
|
||||
(string (cdr (assoc key revinfo))))
|
||||
(unless string
|
||||
(setq string
|
||||
(and format
|
||||
(magit-blame--format-string-1 (oref chunk orig-rev)
|
||||
revinfo format face)))
|
||||
(nconc revinfo (list (cons key string))))
|
||||
string))
|
||||
|
||||
(defun magit-blame--format-string-1 (rev revinfo format face)
|
||||
(let ((str
|
||||
(if (equal rev "0000000000000000000000000000000000000000")
|
||||
(propertize (concat (if (string-prefix-p "\s" format) "\s" "")
|
||||
"Not Yet Committed"
|
||||
(if (string-suffix-p "\n" format) "\n" ""))
|
||||
'face face)
|
||||
(magit--format-spec
|
||||
(propertize format 'face face)
|
||||
(cl-flet* ((p0 (s f)
|
||||
(propertize s 'face (if face
|
||||
(if (listp face)
|
||||
face
|
||||
(list f face))
|
||||
f)))
|
||||
(p1 (k f)
|
||||
(p0 (cdr (assoc k revinfo)) f))
|
||||
(p2 (k1 k2 f)
|
||||
(p0 (magit-blame--format-time-string
|
||||
(cdr (assoc k1 revinfo))
|
||||
(cdr (assoc k2 revinfo)))
|
||||
f)))
|
||||
`((?H . ,(p0 rev 'magit-blame-hash))
|
||||
(?s . ,(p1 "summary" 'magit-blame-summary))
|
||||
(?a . ,(p1 "author" 'magit-blame-name))
|
||||
(?c . ,(p1 "committer" 'magit-blame-name))
|
||||
(?A . ,(p2 "author-time" "author-tz" 'magit-blame-date))
|
||||
(?C . ,(p2 "committer-time" "committer-tz" 'magit-blame-date))
|
||||
(?f . "")))))))
|
||||
(if-let ((width (and (string-suffix-p "%f" format)
|
||||
(magit-blame--style-get 'margin-width))))
|
||||
(concat str
|
||||
(propertize (make-string (max 0 (- width (length str))) ?\s)
|
||||
'face face))
|
||||
str)))
|
||||
|
||||
(defun magit-blame--format-separator ()
|
||||
(propertize
|
||||
(concat (propertize "\s" 'display '(space :height (2)))
|
||||
(propertize "\n" 'line-height t))
|
||||
'face (list :background
|
||||
(face-attribute 'magit-blame-heading :background nil t))))
|
||||
|
||||
(defun magit-blame--format-time-string (time tz)
|
||||
(let* ((time-format (or (magit-blame--style-get 'time-format)
|
||||
magit-blame-time-format))
|
||||
(tz-in-second (and (not (version< emacs-version "25"))
|
||||
(string-match "%z" time-format)
|
||||
(car (last (parse-time-string tz))))))
|
||||
(format-time-string time-format
|
||||
(seconds-to-time (string-to-number time))
|
||||
tz-in-second)))
|
||||
|
||||
(defun magit-blame--remove-overlays (&optional beg end)
|
||||
(save-restriction
|
||||
(widen)
|
||||
(dolist (ov (overlays-in (or beg (point-min))
|
||||
(or end (point-max))))
|
||||
(when (overlay-get ov 'magit-blame-chunk)
|
||||
(delete-overlay ov)))))
|
||||
|
||||
(defun magit-blame-maybe-show-message ()
|
||||
(when (magit-blame--style-get 'show-message)
|
||||
(let ((message-log-max 0))
|
||||
(if-let ((msg (cdr (assq 'heading
|
||||
(gethash (oref (magit-current-blame-chunk)
|
||||
orig-rev)
|
||||
magit-blame-cache)))))
|
||||
(progn (setq msg (substring msg 0 -1))
|
||||
(set-text-properties 0 (length msg) nil msg)
|
||||
(message msg))
|
||||
(message "Commit data not available yet. Still blaming.")))))
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-blame-echo ()
|
||||
"For each line show the revision in which it was added.
|
||||
Show the information about the chunk at point in the echo area
|
||||
when moving between chunks. Unlike other blaming commands, do
|
||||
not turn on `read-only-mode'."
|
||||
(interactive)
|
||||
(when magit-buffer-file-name
|
||||
(user-error "Blob buffers aren't supported"))
|
||||
(setq-local magit-blame--style
|
||||
(assq magit-blame-echo-style magit-blame-styles))
|
||||
(setq-local magit-blame-disable-modes
|
||||
(cons 'eldoc-mode magit-blame-disable-modes))
|
||||
(if (not magit-blame-mode)
|
||||
(let ((magit-blame-read-only nil))
|
||||
(magit-blame))
|
||||
(read-only-mode -1)
|
||||
(magit-blame--update-overlays)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-blame ()
|
||||
"For each line show the revision in which it was added."
|
||||
(interactive)
|
||||
(magit-blame--pre-blame-assert 'addition)
|
||||
(magit-blame--pre-blame-setup 'addition)
|
||||
(magit-blame--run))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-blame-removal ()
|
||||
"For each line show the revision in which it was removed."
|
||||
(interactive)
|
||||
(unless magit-buffer-file-name
|
||||
(user-error "Only blob buffers can be blamed in reverse"))
|
||||
(magit-blame--pre-blame-assert 'removal)
|
||||
(magit-blame--pre-blame-setup 'removal)
|
||||
(magit-blame--run))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-blame-reverse ()
|
||||
"For each line show the last revision in which it still exists."
|
||||
(interactive)
|
||||
(unless magit-buffer-file-name
|
||||
(user-error "Only blob buffers can be blamed in reverse"))
|
||||
(magit-blame--pre-blame-assert 'final)
|
||||
(magit-blame--pre-blame-setup 'final)
|
||||
(magit-blame--run))
|
||||
|
||||
(defun magit-blame--pre-blame-assert (type)
|
||||
(unless (magit-toplevel)
|
||||
(magit--not-inside-repository-error))
|
||||
(if (and magit-blame-mode
|
||||
(eq type magit-blame-type))
|
||||
(if-let ((chunk (magit-current-blame-chunk)))
|
||||
(unless (oref chunk prev-rev)
|
||||
(user-error "Chunk has no further history"))
|
||||
(user-error "Commit data not available yet. Still blaming."))
|
||||
(unless (magit-file-relative-name nil (not magit-buffer-file-name))
|
||||
(if buffer-file-name
|
||||
(user-error "Buffer isn't visiting a tracked file")
|
||||
(user-error "Buffer isn't visiting a file")))))
|
||||
|
||||
(defun magit-blame--pre-blame-setup (type)
|
||||
(when magit-blame-mode
|
||||
(if (eq type magit-blame-type)
|
||||
(let ((style magit-blame--style))
|
||||
(magit-blame-visit-other-file)
|
||||
(setq-local magit-blame--style style)
|
||||
(setq-local magit-blame-recursive-p t)
|
||||
;; Set window-start for the benefit of quickstart.
|
||||
(redisplay))
|
||||
(magit-blame--remove-overlays)))
|
||||
(setq magit-blame-type type))
|
||||
|
||||
(defun magit-blame-visit-other-file ()
|
||||
"Visit another blob related to the current chunk."
|
||||
(interactive)
|
||||
(with-slots (prev-rev prev-file orig-line)
|
||||
(magit-current-blame-chunk)
|
||||
(unless prev-rev
|
||||
(user-error "Chunk has no further history"))
|
||||
(magit-with-toplevel
|
||||
(magit-find-file prev-rev prev-file))
|
||||
;; TODO Adjust line like magit-diff-visit-file.
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- orig-line))))
|
||||
|
||||
(defun magit-blame-visit-file ()
|
||||
"Visit the blob related to the current chunk."
|
||||
(interactive)
|
||||
(with-slots (orig-rev orig-file orig-line)
|
||||
(magit-current-blame-chunk)
|
||||
(magit-with-toplevel
|
||||
(magit-find-file orig-rev orig-file))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- orig-line))))
|
||||
|
||||
(defun magit-blame-quit ()
|
||||
"Turn off Magit-Blame mode.
|
||||
If the buffer was created during a recursive blame,
|
||||
then also kill the buffer."
|
||||
(interactive)
|
||||
(magit-blame-mode -1)
|
||||
(when magit-blame-recursive-p
|
||||
(kill-buffer)))
|
||||
|
||||
(defun magit-blame-next-chunk ()
|
||||
"Move to the next chunk."
|
||||
(interactive)
|
||||
(--if-let (next-single-char-property-change (point) 'magit-blame-chunk)
|
||||
(goto-char it)
|
||||
(user-error "No more chunks")))
|
||||
|
||||
(defun magit-blame-previous-chunk ()
|
||||
"Move to the previous chunk."
|
||||
(interactive)
|
||||
(--if-let (previous-single-char-property-change (point) 'magit-blame-chunk)
|
||||
(goto-char it)
|
||||
(user-error "No more chunks")))
|
||||
|
||||
(defun magit-blame-next-chunk-same-commit (&optional previous)
|
||||
"Move to the next chunk from the same commit.\n\n(fn)"
|
||||
(interactive)
|
||||
(if-let ((rev (oref (magit-current-blame-chunk) orig-rev)))
|
||||
(let ((pos (point)) ov)
|
||||
(save-excursion
|
||||
(while (and (not ov)
|
||||
(not (= pos (if previous (point-min) (point-max))))
|
||||
(setq pos (funcall
|
||||
(if previous
|
||||
'previous-single-char-property-change
|
||||
'next-single-char-property-change)
|
||||
pos 'magit-blame-chunk)))
|
||||
(--when-let (magit-blame--overlay-at pos)
|
||||
(when (equal (oref (magit-blame-chunk-at pos) orig-rev) rev)
|
||||
(setq ov it)))))
|
||||
(if ov
|
||||
(goto-char (overlay-start ov))
|
||||
(user-error "No more chunks from same commit")))
|
||||
(user-error "This chunk hasn't been blamed yet")))
|
||||
|
||||
(defun magit-blame-previous-chunk-same-commit ()
|
||||
"Move to the previous chunk from the same commit."
|
||||
(interactive)
|
||||
(magit-blame-next-chunk-same-commit 'previous-single-char-property-change))
|
||||
|
||||
(defun magit-blame-cycle-style ()
|
||||
"Change how blame information is visualized.
|
||||
Cycle through the elements of option `magit-blame-styles'."
|
||||
(interactive)
|
||||
(setq magit-blame--style
|
||||
(or (cadr (cl-member (car magit-blame--style)
|
||||
magit-blame-styles :key #'car))
|
||||
(car magit-blame-styles)))
|
||||
(magit-blame--update-margin)
|
||||
(magit-blame--update-overlays))
|
||||
|
||||
(defun magit-blame-copy-hash ()
|
||||
"Save hash of the current chunk's commit to the kill ring.
|
||||
|
||||
When the region is active, then save the region's content
|
||||
instead of the hash, like `kill-ring-save' would."
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(copy-region-as-kill nil nil 'region)
|
||||
(kill-new (message "%s" (oref (magit-current-blame-chunk) orig-rev)))))
|
||||
|
||||
;;; Popup
|
||||
|
||||
;;;###autoload (autoload 'magit-blame-popup "magit-blame" nil t)
|
||||
(magit-define-popup magit-blame-popup
|
||||
"Popup console for blame commands."
|
||||
:man-page "git-blame"
|
||||
:switches '((?w "Ignore whitespace" "-w")
|
||||
(?r "Do not treat root commits as boundaries" "--root"))
|
||||
:options '((?M "Detect lines moved or copied within a file" "-M")
|
||||
(?C "Detect lines moved or copied between files" "-C"))
|
||||
:actions '("Actions"
|
||||
(?b "Show commits adding lines" magit-blame)
|
||||
(?r (lambda ()
|
||||
(with-current-buffer magit-pre-popup-buffer
|
||||
(and (not buffer-file-name)
|
||||
(propertize "Show commits removing lines"
|
||||
'face 'default))))
|
||||
magit-blame-removal)
|
||||
(?f (lambda ()
|
||||
(with-current-buffer magit-pre-popup-buffer
|
||||
(and (not buffer-file-name)
|
||||
(propertize "Show last commits that still have lines"
|
||||
'face 'default))))
|
||||
magit-blame-reverse)
|
||||
(lambda ()
|
||||
(and (with-current-buffer magit-pre-popup-buffer
|
||||
magit-blame-mode)
|
||||
(propertize "Refresh" 'face 'magit-popup-heading)))
|
||||
(?c "Cycle style" magit-blame-cycle-style))
|
||||
:default-arguments '("-w")
|
||||
:max-action-columns 1
|
||||
:default-action 'magit-blame)
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defun magit-blame-maybe-update-revision-buffer ()
|
||||
(unless magit--update-revision-buffer
|
||||
(setq magit--update-revision-buffer nil)
|
||||
(when-let ((chunk (magit-current-blame-chunk))
|
||||
(commit (oref chunk orig-rev))
|
||||
(buffer (magit-mode-get-buffer 'magit-revision-mode nil t)))
|
||||
(setq magit--update-revision-buffer (list commit buffer))
|
||||
(run-with-idle-timer
|
||||
magit-update-other-window-delay nil
|
||||
(lambda ()
|
||||
(pcase-let ((`(,rev ,buf) magit--update-revision-buffer))
|
||||
(setq magit--update-revision-buffer nil)
|
||||
(when (buffer-live-p buf)
|
||||
(let ((magit-display-buffer-noselect t))
|
||||
(apply #'magit-show-commit rev (magit-diff-arguments))))))))))
|
||||
|
||||
(provide 'magit-blame)
|
||||
;;; magit-blame.el ends here
|
Binary file not shown.
|
@ -0,0 +1,366 @@
|
|||
;;; magit-bookmark.el --- bookmark support for Magit -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Yuri Khan <yuri.v.khan@gmail.com>
|
||||
;; 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:
|
||||
|
||||
;; Support for bookmarks for most Magit buffers.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
(require 'bookmark)
|
||||
|
||||
;;; Supporting primitives
|
||||
|
||||
(defun magit-bookmark--jump (bookmark fn &rest args)
|
||||
"Handle a Magit BOOKMARK.
|
||||
|
||||
This function will:
|
||||
|
||||
1. Bind `default-directory' to the repository root directory
|
||||
stored in the `filename' bookmark property.
|
||||
2. Invoke the function FN with ARGS as arguments. This needs to
|
||||
restore the buffer.
|
||||
3. Restore the expanded/collapsed status of top level sections
|
||||
and the point position."
|
||||
(declare (indent 2))
|
||||
(let* ((default-directory (bookmark-get-filename bookmark)))
|
||||
(if default-directory
|
||||
(apply fn args)
|
||||
(signal 'bookmark-error-no-filename (list 'stringp default-directory)))
|
||||
(when (derived-mode-p 'magit-mode)
|
||||
(when-let ((hidden-sections (bookmark-prop-get bookmark
|
||||
'magit-hidden-sections)))
|
||||
(dolist (child (oref magit-root-section children))
|
||||
(if (member (cons (oref child type)
|
||||
(oref child value))
|
||||
hidden-sections)
|
||||
(magit-section-hide child)
|
||||
(magit-section-show child)))))
|
||||
(--when-let (bookmark-get-position bookmark)
|
||||
(goto-char it))
|
||||
(--when-let (bookmark-get-front-context-string bookmark)
|
||||
(when (search-forward it (point-max) t)
|
||||
(goto-char (match-beginning 0))))
|
||||
(--when-let (bookmark-get-rear-context-string bookmark)
|
||||
(when (search-backward it (point-min) t)
|
||||
(goto-char (match-end 0))))
|
||||
nil))
|
||||
|
||||
(defun magit-bookmark--make-record (mode handler &optional make-props)
|
||||
"Create a Magit bookmark.
|
||||
|
||||
MODE specifies the expected major mode of current buffer.
|
||||
|
||||
HANDLER should be a function that will be used to restore this
|
||||
buffer.
|
||||
|
||||
MAKE-PROPS should be either nil or a function that will be called
|
||||
with `magit-refresh-args' as the argument list, and may return an
|
||||
alist whose every element has the form (PROP . VALUE) and
|
||||
specifies additional properties to store in the bookmark."
|
||||
(declare (indent 1))
|
||||
(unless (eq major-mode mode)
|
||||
(user-error "Not in a %s buffer" mode))
|
||||
(let ((bookmark (bookmark-make-record-default 'no-file)))
|
||||
(bookmark-prop-set bookmark 'handler handler)
|
||||
(bookmark-set-filename bookmark (magit-toplevel))
|
||||
(when (derived-mode-p 'magit-mode)
|
||||
(bookmark-prop-set
|
||||
bookmark 'magit-hidden-sections
|
||||
(--map (cons (oref it type)
|
||||
(oref it value))
|
||||
(--filter (oref it hidden)
|
||||
(oref magit-root-section children)))))
|
||||
(when make-props
|
||||
(pcase-dolist (`(,prop . ,value) (apply make-props magit-refresh-args))
|
||||
(bookmark-prop-set bookmark prop value)))
|
||||
bookmark))
|
||||
|
||||
;;; Status
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--status-jump (bookmark)
|
||||
"Handle a Magit status BOOKMARK."
|
||||
(magit-bookmark--jump bookmark
|
||||
(lambda () (magit-status-internal default-directory))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--status-make-record ()
|
||||
"Create a Magit status bookmark."
|
||||
(magit-bookmark--make-record 'magit-status-mode
|
||||
#'magit-bookmark--status-jump))
|
||||
|
||||
;;; Refs
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--refs-jump (bookmark)
|
||||
"Handle a Magit refs BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-show-refs
|
||||
(bookmark-prop-get bookmark 'magit-refs)
|
||||
(bookmark-prop-get bookmark 'magit-args)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--refs-make-record ()
|
||||
"Create a Magit refs bookmark."
|
||||
(magit-bookmark--make-record 'magit-refs-mode
|
||||
#'magit-bookmark--refs-jump
|
||||
(lambda (refs args)
|
||||
`((magit-refs . ,refs)
|
||||
(magit-args . ,args)))))
|
||||
|
||||
;;; Log
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--log-jump (bookmark)
|
||||
"Handle a Magit log BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-log
|
||||
(bookmark-prop-get bookmark 'magit-revs)
|
||||
(bookmark-prop-get bookmark 'magit-args)
|
||||
(bookmark-prop-get bookmark 'magit-files)))
|
||||
|
||||
(defun magit-bookmark--log-make-name (buffer-name revs _args files)
|
||||
"Generate the default name for a log bookmark."
|
||||
(concat
|
||||
buffer-name " " (mapconcat #'identity revs " ")
|
||||
(and files
|
||||
(concat " touching " (mapconcat #'identity files " ")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--log-make-record ()
|
||||
"Create a Magit log bookmark."
|
||||
(magit-bookmark--make-record 'magit-log-mode
|
||||
#'magit-bookmark--log-jump
|
||||
(lambda (revs args files)
|
||||
`((defaults . (,(magit-bookmark--log-make-name
|
||||
(buffer-name) revs args files)))
|
||||
(magit-revs . ,revs)
|
||||
(magit-args . ,args)
|
||||
(magit-files . ,files)))))
|
||||
|
||||
;;; Reflog
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--reflog-jump (bookmark)
|
||||
"Handle a Magit reflog BOOKMARK."
|
||||
(magit-bookmark--jump bookmark
|
||||
(lambda ()
|
||||
(let ((magit-reflog-arguments (bookmark-prop-get bookmark 'magit-args)))
|
||||
(magit-reflog (bookmark-prop-get bookmark 'magit-ref))))))
|
||||
|
||||
(defun magit-bookmark--reflog-make-name (buffer-name ref)
|
||||
"Generate the default name for a reflog bookmark."
|
||||
(concat buffer-name " " ref))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--reflog-make-record ()
|
||||
"Create a Magit reflog bookmark."
|
||||
(magit-bookmark--make-record 'magit-reflog-mode
|
||||
#'magit-bookmark--reflog-jump
|
||||
(lambda (ref args)
|
||||
`((defaults . (,(magit-bookmark--reflog-make-name (buffer-name) ref)))
|
||||
(magit-ref . ,ref)
|
||||
(magit-args . ,args)))))
|
||||
|
||||
;;; Stashes
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--stashes-jump (bookmark)
|
||||
"Handle a Magit stash list BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-stash-list))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--stashes-make-record ()
|
||||
"Create a Magit stash list bookmark."
|
||||
(magit-bookmark--make-record 'magit-stashes-mode
|
||||
#'magit-bookmark--stashes-jump))
|
||||
|
||||
;;; Cherry
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--cherry-jump (bookmark)
|
||||
"Handle a Magit cherry BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-cherry
|
||||
(bookmark-prop-get bookmark 'magit-head)
|
||||
(bookmark-prop-get bookmark 'magit-upstream)))
|
||||
|
||||
(defun magit-bookmark--cherry-make-name (buffer-name head upstream)
|
||||
"Generate the default name for a cherry bookmark."
|
||||
(concat buffer-name " " head " upstream " upstream))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--cherry-make-record ()
|
||||
"Create a Magit cherry bookmark."
|
||||
(magit-bookmark--make-record 'magit-cherry-mode
|
||||
#'magit-bookmark--cherry-jump
|
||||
(lambda (upstream head)
|
||||
`((defaults . (,(magit-bookmark--cherry-make-name
|
||||
(buffer-name) head upstream)))
|
||||
(magit-head . ,head)
|
||||
(magit-upstream . ,upstream)))))
|
||||
|
||||
;;; Diff
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--diff-jump (bookmark)
|
||||
"Handle a Magit diff BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-diff-setup
|
||||
(bookmark-prop-get bookmark 'magit-rev-or-range)
|
||||
(bookmark-prop-get bookmark 'magit-const)
|
||||
(bookmark-prop-get bookmark 'magit-args)
|
||||
(bookmark-prop-get bookmark 'magit-files)))
|
||||
|
||||
(defun magit-bookmark--resolve (rev-or-range)
|
||||
"Return REV-OR-RANGE with ref names resolved to commit hashes."
|
||||
(pcase (magit-git-lines "rev-parse" rev-or-range)
|
||||
(`(,rev)
|
||||
(magit-rev-abbrev rev))
|
||||
((and `(,rev1 ,rev2)
|
||||
(guard (/= ?^ (aref rev1 0)))
|
||||
(guard (= ?^ (aref rev2 0))))
|
||||
(concat (magit-rev-abbrev (substring rev2 1))
|
||||
".."
|
||||
(magit-rev-abbrev rev1)))
|
||||
((and `(,rev1 ,rev2 ,rev3)
|
||||
(guard (/= ?^ (aref rev1 0)))
|
||||
(guard (/= ?^ (aref rev2 0)))
|
||||
(guard (= ?^ (aref rev3 0))))
|
||||
(ignore rev3)
|
||||
(concat (magit-rev-abbrev rev1)
|
||||
"..."
|
||||
(magit-rev-abbrev rev2)))
|
||||
(_
|
||||
rev-or-range)))
|
||||
|
||||
(defun magit-bookmark--diff-make-name
|
||||
(buffer-name rev-or-range const _args files)
|
||||
"Generate a default name for a diff bookmark."
|
||||
(if (member "--no-index" const)
|
||||
(apply #'format "*magit-diff %s %s" files)
|
||||
(concat buffer-name " "
|
||||
(cond (rev-or-range)
|
||||
((member "--cached" const) "staged")
|
||||
(t "unstaged"))
|
||||
(when files
|
||||
(concat " in " (mapconcat #'identity files ", "))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--diff-make-record ()
|
||||
"Create a Magit diff bookmark."
|
||||
(magit-bookmark--make-record 'magit-diff-mode
|
||||
#'magit-bookmark--diff-jump
|
||||
(lambda (rev-or-range const args files)
|
||||
(let ((resolved (magit-bookmark--resolve rev-or-range)))
|
||||
`((defaults . (,(magit-bookmark--diff-make-name
|
||||
(buffer-name) resolved const args files)))
|
||||
(magit-rev-or-range . ,resolved)
|
||||
(magit-const . ,const)
|
||||
(magit-args . ,args)
|
||||
(magit-files . ,files))))))
|
||||
|
||||
;;; Revision
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--revision-jump (bookmark)
|
||||
"Handle a Magit revision BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-show-commit
|
||||
(bookmark-prop-get bookmark 'magit-rev)
|
||||
(bookmark-prop-get bookmark 'args)
|
||||
(bookmark-prop-get bookmark 'files)))
|
||||
|
||||
(defun magit-bookmark--revision-make-name (buffer-name rev _args files)
|
||||
"Generate a default name for a revision bookmark."
|
||||
(let ((subject (magit-rev-format "%s" rev)))
|
||||
(concat buffer-name " "
|
||||
(magit-rev-abbrev rev)
|
||||
(cond (files (concat " " (mapconcat #'identity files " ")))
|
||||
(subject (concat " " subject))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--revision-make-record ()
|
||||
"Create a Magit revision bookmark."
|
||||
;; magit-refresh-args stores the revision in relative form.
|
||||
;; For bookmarks, the exact hash is more appropriate.
|
||||
(magit-bookmark--make-record 'magit-revision-mode
|
||||
#'magit-bookmark--revision-jump
|
||||
(lambda (_rev _ args files)
|
||||
`((defaults . (,(magit-bookmark--revision-make-name
|
||||
(buffer-name) magit-buffer-revision-hash
|
||||
args files)))
|
||||
(magit-rev . ,magit-buffer-revision-hash)
|
||||
(magit-args . ,args)
|
||||
(magit-files . ,files)))))
|
||||
|
||||
;;; Stash
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--stash-jump (bookmark)
|
||||
"Handle a Magit stash BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-stash-show
|
||||
(bookmark-prop-get bookmark 'magit-stash)
|
||||
(bookmark-prop-get bookmark 'magit-args)
|
||||
(bookmark-prop-get bookmark 'magit-files)))
|
||||
|
||||
(defun magit-bookmark--stash-make-name (buffer-name stash _args files)
|
||||
"Generate the default name for a stash bookmark."
|
||||
(concat buffer-name " " stash " "
|
||||
(if files
|
||||
(mapconcat #'identity files " ")
|
||||
(magit-rev-format "%s" stash))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--stash-make-record ()
|
||||
"Create a Magit stash bookmark."
|
||||
(magit-bookmark--make-record 'magit-stash-mode
|
||||
#'magit-bookmark--stash-jump
|
||||
(lambda (stash _ args files)
|
||||
`((defaults . (,(magit-bookmark--stash-make-name
|
||||
(buffer-name)
|
||||
(magit-rev-abbrev magit-buffer-revision-hash)
|
||||
args files)))
|
||||
(magit-stash . ,magit-buffer-revision-hash)
|
||||
(magit-args . ,args)
|
||||
(magit-files . ,files)
|
||||
(magit-hidden-sections
|
||||
. ,(--map `(,(oref it type)
|
||||
. ,(replace-regexp-in-string (regexp-quote stash)
|
||||
magit-buffer-revision-hash
|
||||
(oref it value)))
|
||||
(--filter (oref it hidden)
|
||||
(oref magit-root-section children))))))))
|
||||
|
||||
;;; Submodules
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--submodules-jump (bookmark)
|
||||
"Handle a Magit submodule list BOOKMARK."
|
||||
(magit-bookmark--jump bookmark #'magit-list-submodules))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-bookmark--submodules-make-record ()
|
||||
"Create a Magit submodule list bookmark."
|
||||
(magit-bookmark--make-record 'magit-submodule-list-mode
|
||||
#'magit-bookmark--submodules-jump))
|
||||
|
||||
(provide 'magit-bookmark)
|
||||
;;; magit-bookmark.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,173 @@
|
|||
;;; magit-collab.el --- collaboration tools -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements various collaboration tools. These tools
|
||||
;; are only early incarnation -- implementing collaboration tools is
|
||||
;; a top priority for future development.
|
||||
|
||||
;; Currently these tools (including `magit-branch-pull-request', which
|
||||
;; is defined elsewhere) only support Github, but support for other
|
||||
;; Git forges as well as mailing list based collaboration is in
|
||||
;; planning.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
(require 'ghub)
|
||||
|
||||
;;; Variables
|
||||
|
||||
(defvar magit-github-token-scopes '(repo)
|
||||
"The Github API scopes needed by Magit.
|
||||
|
||||
`repo' is the only required scope. Without this scope none of
|
||||
Magit's features that use the API work. Instead of this scope
|
||||
you could use `public_repo' if you are only interested in public
|
||||
repositories.
|
||||
|
||||
`repo' Grants read/write access to code, commit statuses,
|
||||
invitations, collaborators, adding team memberships, and
|
||||
deployment statuses for public and private repositories
|
||||
and organizations.
|
||||
|
||||
`public_repo' Grants read/write access to code, commit statuses,
|
||||
collaborators, and deployment statuses for public repositories
|
||||
and organizations. Also required for starring public
|
||||
repositories.")
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-browse-pull-request (pr)
|
||||
"Visit pull-request PR using `browse-url'.
|
||||
|
||||
Currently this only supports Github, but that restriction will
|
||||
be lifted eventually to support other Git forges."
|
||||
(interactive (list (magit-read-pull-request "Visit pull request")))
|
||||
(browse-url (format "https://github.com/%s/pull/%s"
|
||||
(--> pr
|
||||
(cdr (assq 'base it))
|
||||
(cdr (assq 'repo it))
|
||||
(cdr (assq 'full_name it)))
|
||||
(cdr (assq 'number pr)))))
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defun magit-read-pull-request (prompt)
|
||||
"Read a pull request from the user, prompting with PROMPT.
|
||||
Return the Git forge's API response. Currently this function
|
||||
only supports Github, but that will change eventually."
|
||||
(let* ((origin (magit-upstream-repository))
|
||||
(id (magit--forge-id origin))
|
||||
(fmtfun (lambda (pull-request)
|
||||
(format "%s %s"
|
||||
(cdr (assq 'number pull-request))
|
||||
(cdr (assq 'title pull-request)))))
|
||||
(prs (ghub-get (format "/repos/%s/pulls" id) nil :auth 'magit))
|
||||
(choice (magit-completing-read
|
||||
prompt (mapcar fmtfun prs) nil nil nil nil
|
||||
(let ((default (thing-at-point 'github-pull-request)))
|
||||
(and default (funcall fmtfun default)))))
|
||||
(number (and (string-match "\\([0-9]+\\)" choice)
|
||||
(string-to-number (match-string 1 choice)))))
|
||||
(and number
|
||||
;; Don't reuse the pr from the list, it lacks some information
|
||||
;; that is only returned when requesting a single pr. #3371
|
||||
(ghub-get (format "/repos/%s/pulls/%s" id number)
|
||||
nil :auth 'magit))))
|
||||
|
||||
(defun magit-upstream-repository ()
|
||||
"Return the remote name of the upstream repository.
|
||||
|
||||
If the Git variable `magit.upstream' is set, then return its
|
||||
value. Otherwise return \"origin\". If the remote does not
|
||||
exist, then raise an error."
|
||||
(let ((remote (or (magit-get "magit.upstream") "origin")))
|
||||
(unless (magit-remote-p remote)
|
||||
(error "No remote named `%s' exists (consider setting `magit.upstream')"
|
||||
remote))
|
||||
(unless (magit--github-remote-p remote)
|
||||
(error "Currently only Github is supported"))
|
||||
remote))
|
||||
|
||||
(defun magit--forge-id (remote)
|
||||
(let ((url (magit-get "remote" remote "url")))
|
||||
(and (string-match "\\([^:/]+/[^/]+?\\)\\(?:\\.git\\)?\\'" url)
|
||||
(match-string 1 url))))
|
||||
|
||||
(defconst magit--github-url-regexp "\
|
||||
\\`\\(?:git://\\|git@\\|ssh://git@\\|https://\\)\
|
||||
\\(.*?\\)[/:]\
|
||||
\\(\\([^:/]+\\)/\\([^/]+?\\)\\)\
|
||||
\\(?:\\.git\\)?\\'")
|
||||
|
||||
(defun magit--github-url-p (url)
|
||||
(save-match-data
|
||||
(and url
|
||||
(string-match magit--github-url-regexp url)
|
||||
(let ((host (match-string 1 url)))
|
||||
;; Match values like "github.com-as-someone", which are
|
||||
;; translated to just "github.com" according to settings
|
||||
;; in "~/.ssh/config". Theoretically this could result
|
||||
;; in false-positives, but that's rather unlikely. #3392
|
||||
(and (or (string-match-p (regexp-quote "github.com") host)
|
||||
(string-match-p
|
||||
(regexp-quote (car (split-string (ghub--host) "/")))
|
||||
host))
|
||||
host)))))
|
||||
|
||||
(defun magit--github-remote-p (remote)
|
||||
(or (--when-let (magit-git-string "remote" "get-url" "--push" remote)
|
||||
(magit--github-url-p it))
|
||||
(--when-let (magit-git-string "remote" "get-url" "--all" remote)
|
||||
(magit--github-url-p it))))
|
||||
|
||||
(defun magit--github-url-equal (r1 r2)
|
||||
(or (equal r1 r2)
|
||||
(save-match-data
|
||||
(let ((n1 (and (string-match magit--github-url-regexp r1)
|
||||
(match-string 2 r1)))
|
||||
(n2 (and (string-match magit--github-url-regexp r2)
|
||||
(match-string 2 r2))))
|
||||
(and n1 n2 (equal n1 n2))))))
|
||||
|
||||
(defun magit--pullreq-from-upstream-p (pr)
|
||||
(let-alist pr
|
||||
(equal .head.repo.full_name
|
||||
.base.repo.full_name)))
|
||||
|
||||
(defun magit--pullreq-branch (pr &optional assert-new)
|
||||
(let-alist pr
|
||||
(let ((branch .head.ref))
|
||||
(when (and (not (magit--pullreq-from-upstream-p pr))
|
||||
(or (not .maintainer_can_modify)
|
||||
(magit-branch-p branch)))
|
||||
(setq branch (format "pr-%s" .number)))
|
||||
(when (and assert-new (magit-branch-p branch))
|
||||
(user-error "Branch `%s' already exists" branch))
|
||||
branch)))
|
||||
|
||||
(provide 'magit-collab)
|
||||
;;; magit-collab.el ends here
|
Binary file not shown.
|
@ -0,0 +1,519 @@
|
|||
;;; magit-commit.el --- create Git commits -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2008-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements commands for creating Git commits. These
|
||||
;; commands just initiate the commit, support for writing the commit
|
||||
;; messages is implemented in `git-commit.el'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
(require 'magit-sequence)
|
||||
|
||||
(eval-when-compile (require 'epa)) ; for `epa-protocol'
|
||||
(eval-when-compile (require 'epg))
|
||||
|
||||
;;; Options
|
||||
|
||||
(defcustom magit-commit-arguments nil
|
||||
"The arguments used when committing."
|
||||
:group 'magit-git-arguments
|
||||
:type '(repeat (string :tag "Argument")))
|
||||
|
||||
(defcustom magit-commit-ask-to-stage 'verbose
|
||||
"Whether to ask to stage all unstaged changes when committing and nothing is staged."
|
||||
:package-version '(magit . "2.3.0")
|
||||
:group 'magit-commands
|
||||
:type '(choice (const :tag "Ask showing diff" verbose)
|
||||
(const :tag "Ask" t)
|
||||
(const :tag "Don't ask" nil)))
|
||||
|
||||
(defcustom magit-commit-show-diff t
|
||||
"Whether the relevant diff is automatically shown when committing."
|
||||
:package-version '(magit . "2.3.0")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-commit-extend-override-date t
|
||||
"Whether using `magit-commit-extend' changes the committer date."
|
||||
:package-version '(magit . "2.3.0")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-commit-reword-override-date t
|
||||
"Whether using `magit-commit-reword' changes the committer date."
|
||||
:package-version '(magit . "2.3.0")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-commit-squash-confirm t
|
||||
"Whether the commit targeted by squash and fixup has to be confirmed.
|
||||
When non-nil then the commit at point (if any) is used as default
|
||||
choice, otherwise it has to be confirmed. This option only
|
||||
affects `magit-commit-squash' and `magit-commit-fixup'. The
|
||||
\"instant\" variants always require confirmation because making
|
||||
an error while using those is harder to recover from."
|
||||
:package-version '(magit . "2.1.0")
|
||||
:group 'magit-commands
|
||||
:type 'boolean)
|
||||
|
||||
;;; Popup
|
||||
|
||||
(defun magit-commit-popup (&optional arg)
|
||||
"Popup console for commit commands."
|
||||
(interactive "P")
|
||||
(--if-let (magit-commit-message-buffer)
|
||||
(switch-to-buffer it)
|
||||
(magit-invoke-popup 'magit-commit-popup nil arg)))
|
||||
|
||||
(defvar magit-commit-popup
|
||||
'(:variable magit-commit-arguments
|
||||
:man-page "git-commit"
|
||||
:switches ((?a "Stage all modified and deleted files" "--all")
|
||||
(?e "Allow empty commit" "--allow-empty")
|
||||
(?v "Show diff of changes to be committed" "--verbose")
|
||||
(?h "Disable hooks" "--no-verify")
|
||||
(?s "Add Signed-off-by line" "--signoff")
|
||||
(?R "Claim authorship and reset author date" "--reset-author"))
|
||||
:options ((?A "Override the author" "--author=")
|
||||
(?S "Sign using gpg" "--gpg-sign=" magit-read-gpg-secret-key)
|
||||
(?C "Reuse commit message" "--reuse-message="
|
||||
magit-read-reuse-message))
|
||||
:actions ((?c "Commit" magit-commit)
|
||||
(?e "Extend" magit-commit-extend)
|
||||
(?f "Fixup" magit-commit-fixup)
|
||||
(?F "Instant Fixup" magit-commit-instant-fixup) nil
|
||||
(?w "Reword" magit-commit-reword)
|
||||
(?s "Squash" magit-commit-squash)
|
||||
(?S "Instant Squash" magit-commit-instant-squash) nil
|
||||
(?a "Amend" magit-commit-amend)
|
||||
(?A "Augment" magit-commit-augment))
|
||||
:max-action-columns 4
|
||||
:default-action magit-commit))
|
||||
|
||||
(magit-define-popup-keys-deferred 'magit-commit-popup)
|
||||
|
||||
(defun magit-commit-arguments nil
|
||||
(if (eq magit-current-popup 'magit-commit-popup)
|
||||
magit-current-popup-args
|
||||
magit-commit-arguments))
|
||||
|
||||
(defvar magit-gpg-secret-key-hist nil)
|
||||
|
||||
(defun magit-read-gpg-secret-key (prompt &optional _initial-input)
|
||||
(require 'epa)
|
||||
(let ((keys (--map (concat (epg-sub-key-id (car (epg-key-sub-key-list it)))
|
||||
" "
|
||||
(when-let ((id-obj (car (epg-key-user-id-list it))))
|
||||
(let ((id-str (epg-user-id-string id-obj)))
|
||||
(if (stringp id-str)
|
||||
id-str
|
||||
(epg-decode-dn id-obj)))))
|
||||
(epg-list-keys (epg-make-context epa-protocol) nil t))))
|
||||
(car (split-string (magit-completing-read
|
||||
prompt keys nil nil nil 'magit-gpg-secret-key-hist
|
||||
(car (or magit-gpg-secret-key-hist keys)))
|
||||
" "))))
|
||||
|
||||
(defun magit-read-reuse-message (prompt &optional default)
|
||||
(magit-completing-read prompt (magit-list-refnames)
|
||||
nil nil nil 'magit-revision-history
|
||||
(or default
|
||||
(and (magit-rev-verify "ORIG_HEAD")
|
||||
"ORIG_HEAD"))))
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit (&optional args)
|
||||
"Create a new commit on `HEAD'.
|
||||
With a prefix argument, amend to the commit at `HEAD' instead.
|
||||
\n(git commit [--amend] ARGS)"
|
||||
(interactive (if current-prefix-arg
|
||||
(list (cons "--amend" (magit-commit-arguments)))
|
||||
(list (magit-commit-arguments))))
|
||||
(when (member "--all" args)
|
||||
(setq this-command 'magit-commit-all))
|
||||
(when (setq args (magit-commit-assert args))
|
||||
(let ((default-directory (magit-toplevel)))
|
||||
(magit-run-git-with-editor "commit" args))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-amend (&optional args)
|
||||
"Amend the last commit.
|
||||
\n(git commit --amend ARGS)"
|
||||
(interactive (list (magit-commit-arguments)))
|
||||
(magit-commit-amend-assert)
|
||||
(magit-run-git-with-editor "commit" "--amend" args))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-extend (&optional args override-date)
|
||||
"Amend the last commit, without editing the message.
|
||||
|
||||
With a prefix argument keep the committer date, otherwise change
|
||||
it. The option `magit-commit-extend-override-date' can be used
|
||||
to inverse the meaning of the prefix argument. \n(git commit
|
||||
--amend --no-edit)"
|
||||
(interactive (list (magit-commit-arguments)
|
||||
(if current-prefix-arg
|
||||
(not magit-commit-extend-override-date)
|
||||
magit-commit-extend-override-date)))
|
||||
(when (setq args (magit-commit-assert args (not override-date)))
|
||||
(magit-commit-amend-assert)
|
||||
(let ((process-environment process-environment))
|
||||
(unless override-date
|
||||
(push (magit-rev-format "GIT_COMMITTER_DATE=%cD") process-environment))
|
||||
(magit-run-git-with-editor "commit" "--amend" "--no-edit" args))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-reword (&optional args override-date)
|
||||
"Reword the last commit, ignoring staged changes.
|
||||
|
||||
With a prefix argument keep the committer date, otherwise change
|
||||
it. The option `magit-commit-reword-override-date' can be used
|
||||
to inverse the meaning of the prefix argument.
|
||||
|
||||
Non-interactively respect the optional OVERRIDE-DATE argument
|
||||
and ignore the option.
|
||||
\n(git commit --amend --only)"
|
||||
(interactive (list (magit-commit-arguments)
|
||||
(if current-prefix-arg
|
||||
(not magit-commit-reword-override-date)
|
||||
magit-commit-reword-override-date)))
|
||||
(magit-commit-amend-assert)
|
||||
(let ((process-environment process-environment))
|
||||
(unless override-date
|
||||
(push (magit-rev-format "GIT_COMMITTER_DATE=%cD") process-environment))
|
||||
(magit-run-git-with-editor "commit" "--amend" "--only" args)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-fixup (&optional commit args)
|
||||
"Create a fixup commit.
|
||||
|
||||
With a prefix argument the target COMMIT has to be confirmed.
|
||||
Otherwise the commit at point may be used without confirmation
|
||||
depending on the value of option `magit-commit-squash-confirm'."
|
||||
(interactive (list (magit-commit-at-point)
|
||||
(magit-commit-arguments)))
|
||||
(magit-commit-squash-internal "--fixup" commit args))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-squash (&optional commit args)
|
||||
"Create a squash commit, without editing the squash message.
|
||||
|
||||
With a prefix argument the target COMMIT has to be confirmed.
|
||||
Otherwise the commit at point may be used without confirmation
|
||||
depending on the value of option `magit-commit-squash-confirm'."
|
||||
(interactive (list (magit-commit-at-point)
|
||||
(magit-commit-arguments)))
|
||||
(magit-commit-squash-internal "--squash" commit args))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-augment (&optional commit args)
|
||||
"Create a squash commit, editing the squash message.
|
||||
|
||||
With a prefix argument the target COMMIT has to be confirmed.
|
||||
Otherwise the commit at point may be used without confirmation
|
||||
depending on the value of option `magit-commit-squash-confirm'."
|
||||
(interactive (list (magit-commit-at-point)
|
||||
(magit-commit-arguments)))
|
||||
(magit-commit-squash-internal "--squash" commit args nil t))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-instant-fixup (&optional commit args)
|
||||
"Create a fixup commit targeting COMMIT and instantly rebase."
|
||||
(interactive (list (magit-commit-at-point)
|
||||
(magit-commit-arguments)))
|
||||
(magit-commit-squash-internal "--fixup" commit args t))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-instant-squash (&optional commit args)
|
||||
"Create a squash commit targeting COMMIT and instantly rebase."
|
||||
(interactive (list (magit-commit-at-point)
|
||||
(magit-commit-arguments)))
|
||||
(magit-commit-squash-internal "--squash" commit args t))
|
||||
|
||||
(defun magit-commit-squash-internal
|
||||
(option commit &optional args rebase edit confirmed)
|
||||
(when-let ((args (magit-commit-assert args t)))
|
||||
(when commit
|
||||
(when (and rebase (not (magit-rev-ancestor-p commit "HEAD")))
|
||||
(magit-read-char-case
|
||||
(format "%s isn't an ancestor of HEAD. " commit) nil
|
||||
(?c "[c]reate without rebasing" (setq rebase nil))
|
||||
(?s "[s]elect other" (setq commit nil))
|
||||
(?a "[a]bort" (user-error "Quit")))))
|
||||
(when commit
|
||||
(setq commit (magit-rebase-interactive-assert commit t)))
|
||||
(if (and commit
|
||||
(or confirmed
|
||||
(not (or rebase
|
||||
current-prefix-arg
|
||||
magit-commit-squash-confirm))))
|
||||
(let ((magit-commit-show-diff nil))
|
||||
(push (concat option "=" commit) args)
|
||||
(unless edit
|
||||
(push "--no-edit" args))
|
||||
(if rebase
|
||||
(magit-with-editor
|
||||
(magit-call-git
|
||||
"commit" "--no-gpg-sign"
|
||||
(-remove-first
|
||||
(apply-partially #'string-match-p "\\`--gpg-sign=")
|
||||
args)))
|
||||
(magit-run-git-with-editor "commit" args))
|
||||
t) ; The commit was created; used by below lambda.
|
||||
(magit-log-select
|
||||
(lambda (commit)
|
||||
(when (and (magit-commit-squash-internal option commit args
|
||||
rebase edit t)
|
||||
rebase)
|
||||
(magit-commit-amend-assert commit)
|
||||
(magit-rebase-interactive-1 commit
|
||||
(list "--autosquash" "--autostash")
|
||||
"" "true" nil t)))
|
||||
(format "Type %%p on a commit to %s into it,"
|
||||
(substring option 2)))
|
||||
(when magit-commit-show-diff
|
||||
(let ((magit-display-buffer-noselect t))
|
||||
(apply #'magit-diff-staged nil (magit-diff-arguments)))))))
|
||||
|
||||
(defun magit-commit-amend-assert (&optional commit)
|
||||
(--when-let (magit-list-publishing-branches commit)
|
||||
(let ((m1 "This commit has already been published to ")
|
||||
(m2 ".\nDo you really want to modify it"))
|
||||
(magit-confirm 'amend-published
|
||||
(concat m1 "%s" m2)
|
||||
(concat m1 "%i public branches" m2)
|
||||
nil it))))
|
||||
|
||||
(defun magit-commit-assert (args &optional strict)
|
||||
(cond
|
||||
((or (magit-anything-staged-p)
|
||||
(and (magit-anything-unstaged-p)
|
||||
;; ^ Everything of nothing is still nothing.
|
||||
(member "--all" args))
|
||||
(and (not strict)
|
||||
;; ^ For amend variants that don't make sense otherwise.
|
||||
(or (member "--amend" args)
|
||||
(member "--allow-empty" args))))
|
||||
(or args (list "--")))
|
||||
((and (magit-rebase-in-progress-p)
|
||||
(not (magit-anything-unstaged-p))
|
||||
(y-or-n-p "Nothing staged. Continue in-progress rebase? "))
|
||||
(magit-run-git-sequencer "rebase" "--continue")
|
||||
nil)
|
||||
((and (file-exists-p (magit-git-dir "MERGE_MSG"))
|
||||
(not (magit-anything-unstaged-p)))
|
||||
(or args (list "--")))
|
||||
((not (magit-anything-unstaged-p))
|
||||
(user-error "Nothing staged (or unstaged)"))
|
||||
(magit-commit-ask-to-stage
|
||||
(when (eq magit-commit-ask-to-stage 'verbose)
|
||||
(magit-diff-unstaged))
|
||||
(prog1 (when (y-or-n-p "Nothing staged. Stage and commit all unstaged changes? ")
|
||||
(magit-run-git "add" "-u" ".")
|
||||
(or args (list "--")))
|
||||
(when (and (eq magit-commit-ask-to-stage 'verbose)
|
||||
(derived-mode-p 'magit-diff-mode))
|
||||
(magit-mode-bury-buffer))))
|
||||
(t
|
||||
(user-error "Nothing staged"))))
|
||||
|
||||
(defvar magit--reshelve-history nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-commit-reshelve (date)
|
||||
"Change the committer date and possibly the author date of `HEAD'.
|
||||
|
||||
If you are the author of `HEAD', then both dates are changed,
|
||||
otherwise only the committer date. The current time is used
|
||||
as the initial minibuffer input and the original author (if
|
||||
that is you) or committer date is available as the previous
|
||||
history element."
|
||||
(interactive
|
||||
(let ((author-p (magit-rev-author-p "HEAD")))
|
||||
(push (magit-rev-format (if author-p "%ad" "%cd") "HEAD"
|
||||
(concat "--date=format:%F %T %z"))
|
||||
magit--reshelve-history)
|
||||
(list (read-string (if author-p
|
||||
"Change author and committer dates to: "
|
||||
"Change committer date to: ")
|
||||
(cons (format-time-string "%F %T %z") 17)
|
||||
'magit--reshelve-history))))
|
||||
(let ((process-environment process-environment))
|
||||
(push (concat "GIT_COMMITTER_DATE=" date) process-environment)
|
||||
(magit-run-git "commit" "--amend" "--no-edit"
|
||||
(and (magit-rev-author-p "HEAD")
|
||||
(concat "--date=" date)))))
|
||||
|
||||
;;;###autoload (autoload 'magit-commit-absorb-popup "magit-commit" nil t)
|
||||
(magit-define-popup magit-commit-absorb-popup
|
||||
"Spread unstaged changes across recent commits.
|
||||
Without a prefix argument just call `magit-commit-absorb'.
|
||||
With a prefix argument use a popup buffer to select arguments."
|
||||
:man-page "git-bisect"
|
||||
:options '((?c "Diff context lines" "--context=")
|
||||
(?s "Strictness" "--strict="))
|
||||
:actions '((?x "Absorb" magit-commit-absorb))
|
||||
:default-action 'magit-commit-absorb
|
||||
:use-prefix 'popup)
|
||||
|
||||
(defun magit-commit-absorb (&optional commit args confirmed)
|
||||
"Spread unstaged changes across recent commits.
|
||||
This command requires the git-autofixup script, which is
|
||||
available from https://github.com/torbiak/git-autofixup."
|
||||
(interactive (list (magit-get-upstream-branch)
|
||||
(magit-commit-absorb-arguments)))
|
||||
(unless (executable-find "git-autofixup")
|
||||
(user-error "This command requires the git-autofixup script, which %s"
|
||||
"is available from https://github.com/torbiak/git-autofixup"))
|
||||
(when (magit-anything-staged-p)
|
||||
(user-error "Cannot absorb when there are staged changes"))
|
||||
(unless (magit-anything-unstaged-p)
|
||||
(user-error "There are no unstaged changes that could be absorbed"))
|
||||
(when commit
|
||||
(setq commit (magit-rebase-interactive-assert commit t)))
|
||||
(if (and commit confirmed)
|
||||
(progn (magit-run-git-async "autofixup" "-vv" args commit) t)
|
||||
(magit-log-select
|
||||
(lambda (commit)
|
||||
(magit-commit-absorb commit args t))
|
||||
nil nil nil nil commit)))
|
||||
|
||||
;;; Pending Diff
|
||||
|
||||
(defun magit-commit-diff ()
|
||||
(when (and git-commit-mode magit-commit-show-diff)
|
||||
(when-let ((diff-buffer (magit-mode-get-buffer 'magit-diff-mode)))
|
||||
;; This window just started displaying the commit message
|
||||
;; buffer. Without this that buffer would immediately be
|
||||
;; replaced with the diff buffer. See #2632.
|
||||
(unrecord-window-buffer nil diff-buffer))
|
||||
(condition-case nil
|
||||
(let ((args (car (magit-diff-arguments)))
|
||||
(magit-inhibit-save-previous-winconf 'unset)
|
||||
(magit-display-buffer-noselect t)
|
||||
(inhibit-quit nil))
|
||||
(message "Diffing changes to be committed (C-g to abort diffing)")
|
||||
(if-let ((fn (cl-case last-command
|
||||
(magit-commit
|
||||
(apply-partially 'magit-diff-staged nil))
|
||||
(magit-commit-all
|
||||
(apply-partially 'magit-diff-working-tree nil))
|
||||
((magit-commit-amend
|
||||
magit-commit-reword
|
||||
magit-rebase-reword-commit)
|
||||
'magit-diff-while-amending))))
|
||||
(funcall fn args)
|
||||
(if (magit-anything-staged-p)
|
||||
(magit-diff-staged nil args)
|
||||
(magit-diff-while-amending args))))
|
||||
(quit))))
|
||||
|
||||
;; Mention `magit-diff-while-committing' because that's
|
||||
;; always what I search for when I try to find this line.
|
||||
(add-hook 'server-switch-hook 'magit-commit-diff)
|
||||
|
||||
(add-to-list 'with-editor-server-window-alist
|
||||
(cons git-commit-filename-regexp 'switch-to-buffer))
|
||||
|
||||
;;; Message Utilities
|
||||
|
||||
(defun magit-commit-message-buffer ()
|
||||
(let* ((find-file-visit-truename t) ; git uses truename of COMMIT_EDITMSG
|
||||
(topdir (magit-toplevel)))
|
||||
(--first (equal topdir (with-current-buffer it
|
||||
(and git-commit-mode (magit-toplevel))))
|
||||
(append (buffer-list (selected-frame))
|
||||
(buffer-list)))))
|
||||
|
||||
(defvar magit-commit-add-log-insert-function 'magit-commit-add-log-insert
|
||||
"Used by `magit-commit-add-log' to insert a single entry.")
|
||||
|
||||
(defun magit-commit-add-log ()
|
||||
"Add a stub for the current change into the commit message buffer.
|
||||
If no commit is in progress, then initiate it. Use the function
|
||||
specified by variable `magit-commit-add-log-insert-function' to
|
||||
actually insert the entry."
|
||||
(interactive)
|
||||
(let ((hunk (and (magit-section-match 'hunk)
|
||||
(magit-current-section)))
|
||||
(log (magit-commit-message-buffer)) buf pos)
|
||||
(save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(setq buf (current-buffer))
|
||||
(setq pos (point)))
|
||||
(unless log
|
||||
(unless (magit-commit-assert nil)
|
||||
(user-error "Abort"))
|
||||
(magit-commit)
|
||||
(while (not (setq log (magit-commit-message-buffer)))
|
||||
(sit-for 0.01)))
|
||||
(save-excursion
|
||||
(with-current-buffer buf
|
||||
(goto-char pos)
|
||||
(funcall magit-commit-add-log-insert-function log
|
||||
(magit-file-relative-name)
|
||||
(and hunk (add-log-current-defun)))))))
|
||||
|
||||
(defun magit-commit-add-log-insert (buffer file defun)
|
||||
(with-current-buffer buffer
|
||||
(undo-boundary)
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward (concat "^" comment-start) nil t))
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (point))
|
||||
(cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
|
||||
nil t)
|
||||
(when (equal (match-string 1) defun)
|
||||
(setq defun nil))
|
||||
(re-search-forward ": "))
|
||||
(t
|
||||
(when (re-search-backward "^[\\*(].+\n" nil t)
|
||||
(goto-char (match-end 0)))
|
||||
(while (re-search-forward "^[^\\*\n].*\n" nil t))
|
||||
(if defun
|
||||
(progn (insert (format "* %s (%s): \n" file defun))
|
||||
(setq defun nil))
|
||||
(insert (format "* %s: \n" file)))
|
||||
(backward-char)
|
||||
(unless (looking-at "\n[\n\\']")
|
||||
(insert ?\n)
|
||||
(backward-char))))
|
||||
(when defun
|
||||
(forward-line)
|
||||
(let ((limit (save-excursion
|
||||
(and (re-search-forward "^\\*" nil t)
|
||||
(point)))))
|
||||
(unless (or (looking-back (format "(%s): " defun)
|
||||
(line-beginning-position))
|
||||
(re-search-forward (format "^(%s): " defun) limit t))
|
||||
(while (re-search-forward "^[^\\*\n].*\n" limit t))
|
||||
(insert (format "(%s): \n" defun))
|
||||
(backward-char)))))))
|
||||
|
||||
(provide 'magit-commit)
|
||||
;;; magit-commit.el ends here
|
Binary file not shown.
|
@ -0,0 +1,132 @@
|
|||
;;; magit-core.el --- core functionality -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library requires several other libraries, so that yet other
|
||||
;; libraries can just require this one, instead of having to require
|
||||
;; all the other ones. In other words this separates the low-level
|
||||
;; stuff from the rest. It also defines some Custom groups.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit-popup)
|
||||
(require 'magit-utils)
|
||||
(require 'magit-section)
|
||||
(require 'magit-git)
|
||||
(require 'magit-mode)
|
||||
(require 'magit-margin)
|
||||
(require 'magit-process)
|
||||
(require 'magit-autorevert)
|
||||
|
||||
(defgroup magit nil
|
||||
"Controlling Git from Emacs."
|
||||
:link '(url-link "https://magit.vc")
|
||||
:link '(info-link "(magit)FAQ")
|
||||
:link '(info-link "(magit)")
|
||||
:group 'tools)
|
||||
|
||||
(defgroup magit-essentials nil
|
||||
"Options that every Magit user should briefly think about.
|
||||
|
||||
Each of these options falls into one or more of these categories:
|
||||
|
||||
* Options that affect Magit's behavior in fundamental ways.
|
||||
* Options that affect safety.
|
||||
* Options that affect performance.
|
||||
* Options that are of a personal nature."
|
||||
:link '(info-link "(magit)Essential Settings")
|
||||
:group 'magit)
|
||||
|
||||
(defgroup magit-miscellaneous nil
|
||||
"Miscellanous Magit options."
|
||||
:group 'magit)
|
||||
|
||||
(defgroup magit-commands nil
|
||||
"Options controlling behavior of certain commands."
|
||||
:group 'magit)
|
||||
|
||||
(defgroup magit-git-arguments nil
|
||||
"Options controlling what arguments are passed to Git.
|
||||
|
||||
Most of these options can be set using the respective popup,
|
||||
and it is recommended that you do that because then you can
|
||||
be certain that Magit supports the arguments that you select.
|
||||
|
||||
An option `magit-NAME-argument' specifies the arguments that
|
||||
are enabled by default by the popup `magit-NAME-popup'."
|
||||
:link '(info-link "(magit-popup)Customizing Existing Popups")
|
||||
:link '(info-link "(magit-popup)Usage")
|
||||
:group 'magit-commands)
|
||||
|
||||
(defgroup magit-modes nil
|
||||
"Modes used or provided by Magit."
|
||||
:group 'magit)
|
||||
|
||||
(defgroup magit-buffers nil
|
||||
"Options concerning Magit buffers."
|
||||
:link '(info-link "(magit)Modes and Buffers")
|
||||
:group 'magit)
|
||||
|
||||
(defgroup magit-refresh nil
|
||||
"Options controlling how Magit buffers are refreshed."
|
||||
:link '(info-link "(magit)Automatic Refreshing of Magit Buffers")
|
||||
:group 'magit
|
||||
:group 'magit-buffers)
|
||||
|
||||
(defgroup magit-faces nil
|
||||
"Faces used by Magit."
|
||||
:group 'magit
|
||||
:group 'faces)
|
||||
|
||||
(defgroup magit-extensions nil
|
||||
"Extensions to Magit."
|
||||
:group 'magit)
|
||||
|
||||
(custom-add-to-group 'magit-modes 'magit-popup 'custom-group)
|
||||
(custom-add-to-group 'magit-faces 'magit-popup-faces 'custom-group)
|
||||
(custom-add-to-group 'magit-modes 'git-commit 'custom-group)
|
||||
(custom-add-to-group 'magit-faces 'git-commit-faces 'custom-group)
|
||||
(custom-add-to-group 'magit-modes 'git-rebase 'custom-group)
|
||||
(custom-add-to-group 'magit-faces 'git-rebase-faces 'custom-group)
|
||||
(custom-add-to-group 'magit-process 'with-editor 'custom-group)
|
||||
|
||||
(defgroup magit-related nil
|
||||
"Options that are relevant to Magit but that are defined elsewhere."
|
||||
:link '(custom-group-link vc)
|
||||
:link '(custom-group-link smerge)
|
||||
:link '(custom-group-link ediff)
|
||||
:link '(custom-group-link auto-revert)
|
||||
:group 'magit
|
||||
:group 'magit-extensions
|
||||
:group 'magit-essentials)
|
||||
|
||||
(custom-add-to-group 'magit-related 'auto-revert-check-vc-info 'custom-variable)
|
||||
(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable)
|
||||
|
||||
(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable)
|
||||
(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable)
|
||||
(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable)
|
||||
|
||||
(provide 'magit-core)
|
||||
;;; magit-core.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,509 @@
|
|||
;;; magit-ediff.el --- Ediff extension for Magit -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library provides basic support for Ediff.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
(require 'ediff)
|
||||
(require 'smerge-mode)
|
||||
|
||||
(defvar smerge-ediff-buf)
|
||||
(defvar smerge-ediff-windows)
|
||||
|
||||
;;; Options
|
||||
|
||||
(defgroup magit-ediff nil
|
||||
"Ediff support for Magit."
|
||||
:link '(info-link "(magit)Ediffing")
|
||||
:group 'magit-extensions)
|
||||
|
||||
(defcustom magit-ediff-quit-hook
|
||||
'(magit-ediff-cleanup-auxiliary-buffers
|
||||
magit-ediff-restore-previous-winconf)
|
||||
"Hooks to run after finishing Ediff, when that was invoked using Magit.
|
||||
The hooks are run in the Ediff control buffer. This is similar
|
||||
to `ediff-quit-hook' but takes the needs of Magit into account.
|
||||
The `ediff-quit-hook' is ignored by Ediff sessions which were
|
||||
invoked using Magit."
|
||||
:package-version '(magit . "2.2.0")
|
||||
:group 'magit-ediff
|
||||
:type 'hook
|
||||
:get 'magit-hook-custom-get
|
||||
:options '(magit-ediff-cleanup-auxiliary-buffers
|
||||
magit-ediff-restore-previous-winconf))
|
||||
|
||||
(defcustom magit-ediff-dwim-show-on-hunks nil
|
||||
"Whether `magit-ediff-dwim' runs show variants on hunks.
|
||||
If non-nil, `magit-ediff-show-staged' or
|
||||
`magit-ediff-show-unstaged' are called based on what section the
|
||||
hunk is in. Otherwise, `magit-ediff-dwim' runs
|
||||
`magit-ediff-stage' when point is on an uncommitted hunk."
|
||||
:package-version '(magit . "2.2.0")
|
||||
:group 'magit-ediff
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom magit-ediff-show-stash-with-index t
|
||||
"Whether `magit-ediff-show-stash' shows the state of the index.
|
||||
|
||||
If non-nil, use a third Ediff buffer to distinguish which changes
|
||||
in the stash were staged. In cases where the stash contains no
|
||||
staged changes, fall back to a two-buffer Ediff.
|
||||
|
||||
More specifically, a stash is a merge commit, stash@{N}, with
|
||||
potentially three parents.
|
||||
|
||||
* stash@{N}^1 represents the `HEAD' commit at the time the stash
|
||||
was created.
|
||||
|
||||
* stash@{N}^2 records any changes that were staged when the stash
|
||||
was made.
|
||||
|
||||
* stash@{N}^3, if it exists, contains files that were untracked
|
||||
when stashing.
|
||||
|
||||
If this option is non-nil, `magit-ediff-show-stash' will run
|
||||
Ediff on a file using three buffers: one for stash@{N}, another
|
||||
for stash@{N}^1, and a third for stash@{N}^2.
|
||||
|
||||
Otherwise, Ediff uses two buffers, comparing
|
||||
stash@{N}^1..stash@{N}. Along with any unstaged changes, changes
|
||||
in the index commit, stash@{N}^2, will be shown in this
|
||||
comparison unless they conflicted with changes in the working
|
||||
tree at the time of stashing."
|
||||
:package-version '(magit . "2.6.0")
|
||||
:group 'magit-ediff
|
||||
:type 'boolean)
|
||||
|
||||
;;; Commands
|
||||
|
||||
(defvar magit-ediff-previous-winconf nil)
|
||||
|
||||
;;;###autoload (autoload 'magit-ediff-popup "magit-ediff" nil t)
|
||||
(magit-define-popup magit-ediff-popup
|
||||
"Popup console for ediff commands."
|
||||
:actions '((?E "Dwim" magit-ediff-dwim)
|
||||
(?u "Show unstaged" magit-ediff-show-unstaged)
|
||||
(?s "Stage" magit-ediff-stage)
|
||||
(?i "Show staged" magit-ediff-show-staged)
|
||||
(?m "Resolve" magit-ediff-resolve)
|
||||
(?w "Show worktree" magit-ediff-show-working-tree)
|
||||
(?r "Diff range" magit-ediff-compare)
|
||||
(?c "Show commit" magit-ediff-show-commit) nil
|
||||
(?z "Show stash" magit-ediff-show-stash))
|
||||
:max-action-columns 2)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-resolve (file)
|
||||
"Resolve outstanding conflicts in FILE using Ediff.
|
||||
FILE has to be relative to the top directory of the repository.
|
||||
|
||||
In the rare event that you want to manually resolve all
|
||||
conflicts, including those already resolved by Git, use
|
||||
`ediff-merge-revisions-with-ancestor'."
|
||||
(interactive
|
||||
(let ((current (magit-current-file))
|
||||
(unmerged (magit-unmerged-files)))
|
||||
(unless unmerged
|
||||
(user-error "There are no unresolved conflicts"))
|
||||
(list (magit-completing-read "Resolve file" unmerged nil t nil nil
|
||||
(car (member current unmerged))))))
|
||||
(magit-with-toplevel
|
||||
(with-current-buffer (find-file-noselect file)
|
||||
(smerge-ediff)
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
(let ((bufC ediff-buffer-C)
|
||||
(bufS smerge-ediff-buf))
|
||||
(with-current-buffer bufS
|
||||
(when (yes-or-no-p (format "Conflict resolution finished; save %s? "
|
||||
buffer-file-name))
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring bufC)
|
||||
(save-buffer))))
|
||||
(when (buffer-live-p ediff-buffer-A) (kill-buffer ediff-buffer-A))
|
||||
(when (buffer-live-p ediff-buffer-B) (kill-buffer ediff-buffer-B))
|
||||
(when (buffer-live-p ediff-buffer-C) (kill-buffer ediff-buffer-C))
|
||||
(when (buffer-live-p ediff-ancestor-buffer)
|
||||
(kill-buffer ediff-ancestor-buffer))
|
||||
(let ((magit-ediff-previous-winconf smerge-ediff-windows))
|
||||
(run-hooks 'magit-ediff-quit-hook)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-stage (file)
|
||||
"Stage and unstage changes to FILE using Ediff.
|
||||
FILE has to be relative to the top directory of the repository."
|
||||
(interactive
|
||||
(list (magit-completing-read "Selectively stage file"
|
||||
(magit-tracked-files) nil nil nil nil
|
||||
(magit-current-file))))
|
||||
(magit-with-toplevel
|
||||
(let* ((conf (current-window-configuration))
|
||||
(bufA (magit-get-revision-buffer "HEAD" file))
|
||||
(bufB (get-buffer (concat file ".~{index}~")))
|
||||
(bufBrw (and bufB (with-current-buffer bufB (not buffer-read-only))))
|
||||
(bufC (get-file-buffer file))
|
||||
(fileBufC (or bufC (find-file-noselect file)))
|
||||
(coding-system-for-read
|
||||
(with-current-buffer fileBufC buffer-file-coding-system)))
|
||||
(ediff-buffers3
|
||||
(or bufA (magit-find-file-noselect "HEAD" file))
|
||||
(with-current-buffer (magit-find-file-index-noselect file t)
|
||||
(setq buffer-read-only nil)
|
||||
(current-buffer))
|
||||
fileBufC
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
(and (buffer-live-p ediff-buffer-B)
|
||||
(buffer-modified-p ediff-buffer-B)
|
||||
(with-current-buffer ediff-buffer-B
|
||||
(magit-update-index)))
|
||||
(and (buffer-live-p ediff-buffer-C)
|
||||
(buffer-modified-p ediff-buffer-C)
|
||||
(with-current-buffer ediff-buffer-C
|
||||
(when (y-or-n-p
|
||||
(format "Save file %s? " buffer-file-name))
|
||||
(save-buffer))))
|
||||
,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(if bufB
|
||||
(unless bufBrw '((with-current-buffer ediff-buffer-B
|
||||
(setq buffer-read-only t))))
|
||||
'((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
,@(unless bufC '((ediff-kill-buffer-carefully ediff-buffer-C)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-buffers3))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-compare (revA revB fileA fileB)
|
||||
"Compare REVA:FILEA with REVB:FILEB using Ediff.
|
||||
|
||||
FILEA and FILEB have to be relative to the top directory of the
|
||||
repository. If REVA or REVB is nil, then this stands for the
|
||||
working tree state.
|
||||
|
||||
If the region is active, use the revisions on the first and last
|
||||
line of the region. With a prefix argument, instead of diffing
|
||||
the revisions, choose a revision to view changes along, starting
|
||||
at the common ancestor of both revisions (i.e., use a \"...\"
|
||||
range)."
|
||||
(interactive
|
||||
(pcase-let ((`(,revA ,revB) (magit-ediff-compare--read-revisions
|
||||
nil current-prefix-arg)))
|
||||
(nconc (list revA revB)
|
||||
(magit-ediff-read-files revA revB))))
|
||||
(magit-with-toplevel
|
||||
(let ((conf (current-window-configuration))
|
||||
(bufA (if revA
|
||||
(magit-get-revision-buffer revA fileA)
|
||||
(get-file-buffer fileA)))
|
||||
(bufB (if revB
|
||||
(magit-get-revision-buffer revB fileB)
|
||||
(get-file-buffer fileB))))
|
||||
(ediff-buffers
|
||||
(or bufA (if revA
|
||||
(magit-find-file-noselect revA fileA)
|
||||
(find-file-noselect fileA)))
|
||||
(or bufB (if revB
|
||||
(magit-find-file-noselect revB fileB)
|
||||
(find-file-noselect fileB)))
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-revision))))
|
||||
|
||||
(defun magit-ediff-compare--read-revisions (&optional arg mbase)
|
||||
(let ((input (or arg (magit-diff-read-range-or-commit
|
||||
"Compare range or commit"
|
||||
nil mbase))))
|
||||
(--if-let (magit-split-range input)
|
||||
(-cons-to-list it)
|
||||
(list input nil))))
|
||||
|
||||
(defun magit-ediff-read-files (revA revB &optional fileB)
|
||||
"Read file in REVB, return it and the corresponding file in REVA.
|
||||
When FILEB is non-nil, use this as REVB's file instead of
|
||||
prompting for it."
|
||||
(unless fileB
|
||||
(setq fileB (magit-read-file-choice
|
||||
(format "File to compare between %s and %s"
|
||||
revA (or revB "the working tree"))
|
||||
(magit-changed-files revA revB)
|
||||
(format "No changed files between %s and %s"
|
||||
revA (or revB "the working tree")))))
|
||||
(list (or (car (member fileB (magit-revision-files revA)))
|
||||
(cdr (assoc fileB (magit-renamed-files revB revA)))
|
||||
(magit-read-file-choice
|
||||
(format "File in %s to compare with %s in %s"
|
||||
revA fileB (or revB "the working tree"))
|
||||
(magit-changed-files revB revA)
|
||||
(format "No files have changed between %s and %s"
|
||||
revA revB)))
|
||||
fileB))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-dwim ()
|
||||
"Compare, stage, or resolve using Ediff.
|
||||
This command tries to guess what file, and what commit or range
|
||||
the user wants to compare, stage, or resolve using Ediff. It
|
||||
might only be able to guess either the file, or range or commit,
|
||||
in which case the user is asked about the other. It might not
|
||||
always guess right, in which case the appropriate `magit-ediff-*'
|
||||
command has to be used explicitly. If it cannot read the user's
|
||||
mind at all, then it asks the user for a command to run."
|
||||
(interactive)
|
||||
(magit-section-case
|
||||
(hunk (save-excursion
|
||||
(goto-char (oref (oref it parent) start))
|
||||
(magit-ediff-dwim)))
|
||||
(t
|
||||
(let ((range (magit-diff--dwim))
|
||||
(file (magit-current-file))
|
||||
command revA revB)
|
||||
(pcase range
|
||||
((and (guard (not magit-ediff-dwim-show-on-hunks))
|
||||
(or `unstaged `staged))
|
||||
(setq command (if (magit-anything-unmerged-p)
|
||||
#'magit-ediff-resolve
|
||||
#'magit-ediff-stage)))
|
||||
(`unstaged (setq command #'magit-ediff-show-unstaged))
|
||||
(`staged (setq command #'magit-ediff-show-staged))
|
||||
(`(commit . ,value)
|
||||
(setq command #'magit-ediff-show-commit)
|
||||
(setq revB value))
|
||||
(`(stash . ,value)
|
||||
(setq command #'magit-ediff-show-stash)
|
||||
(setq revB value))
|
||||
((pred stringp)
|
||||
(pcase-let ((`(,a ,b) (magit-ediff-compare--read-revisions range)))
|
||||
(setq command #'magit-ediff-compare)
|
||||
(setq revA a)
|
||||
(setq revB b)))
|
||||
(_
|
||||
(when (derived-mode-p 'magit-diff-mode)
|
||||
(pcase (magit-diff-type)
|
||||
(`committed (pcase-let ((`(,a ,b)
|
||||
(magit-ediff-compare--read-revisions
|
||||
(car magit-refresh-args))))
|
||||
(setq revA a)
|
||||
(setq revB b)))
|
||||
((guard (not magit-ediff-dwim-show-on-hunks))
|
||||
(setq command #'magit-ediff-stage))
|
||||
(`unstaged (setq command #'magit-ediff-show-unstaged))
|
||||
(`staged (setq command #'magit-ediff-show-staged))
|
||||
(`undefined (setq command nil))
|
||||
(_ (setq command nil))))))
|
||||
(cond ((not command)
|
||||
(call-interactively
|
||||
(magit-read-char-case
|
||||
"Failed to read your mind; do you want to " t
|
||||
(?c "[c]ommit" 'magit-ediff-show-commit)
|
||||
(?r "[r]ange" 'magit-ediff-compare)
|
||||
(?s "[s]tage" 'magit-ediff-stage)
|
||||
(?v "resol[v]e" 'magit-ediff-resolve))))
|
||||
((eq command 'magit-ediff-compare)
|
||||
(apply 'magit-ediff-compare revA revB
|
||||
(magit-ediff-read-files revA revB file)))
|
||||
((eq command 'magit-ediff-show-commit)
|
||||
(magit-ediff-show-commit revB))
|
||||
((eq command 'magit-ediff-show-stash)
|
||||
(magit-ediff-show-stash revB))
|
||||
(file
|
||||
(funcall command file))
|
||||
(t
|
||||
(call-interactively command)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-show-staged (file)
|
||||
"Show staged changes using Ediff.
|
||||
|
||||
This only allows looking at the changes; to stage, unstage,
|
||||
and discard changes using Ediff, use `magit-ediff-stage'.
|
||||
|
||||
FILE must be relative to the top directory of the repository."
|
||||
(interactive
|
||||
(list (magit-read-file-choice "Show staged changes for file"
|
||||
(magit-staged-files)
|
||||
"No staged files")))
|
||||
(let ((conf (current-window-configuration))
|
||||
(bufA (magit-get-revision-buffer "HEAD" file))
|
||||
(bufB (get-buffer (concat file ".~{index}~"))))
|
||||
(ediff-buffers
|
||||
(or bufA (magit-find-file-noselect "HEAD" file))
|
||||
(or bufB (magit-find-file-index-noselect file t))
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-buffers)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-show-unstaged (file)
|
||||
"Show unstaged changes using Ediff.
|
||||
|
||||
This only allows looking at the changes; to stage, unstage,
|
||||
and discard changes using Ediff, use `magit-ediff-stage'.
|
||||
|
||||
FILE must be relative to the top directory of the repository."
|
||||
(interactive
|
||||
(list (magit-read-file-choice "Show unstaged changes for file"
|
||||
(magit-unstaged-files)
|
||||
"No unstaged files")))
|
||||
(magit-with-toplevel
|
||||
(let ((conf (current-window-configuration))
|
||||
(bufA (get-buffer (concat file ".~{index}~")))
|
||||
(bufB (get-file-buffer file)))
|
||||
(ediff-buffers
|
||||
(or bufA (magit-find-file-index-noselect file t))
|
||||
(or bufB (find-file-noselect file))
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-buffers))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-show-working-tree (file)
|
||||
"Show changes between `HEAD' and working tree using Ediff.
|
||||
FILE must be relative to the top directory of the repository."
|
||||
(interactive
|
||||
(list (magit-read-file-choice "Show changes in file"
|
||||
(magit-changed-files "HEAD")
|
||||
"No changed files")))
|
||||
(magit-with-toplevel
|
||||
(let ((conf (current-window-configuration))
|
||||
(bufA (magit-get-revision-buffer "HEAD" file))
|
||||
(bufB (get-file-buffer file)))
|
||||
(ediff-buffers
|
||||
(or bufA (magit-find-file-noselect "HEAD" file))
|
||||
(or bufB (find-file-noselect file))
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-buffers))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-show-commit (commit)
|
||||
"Show changes introduced by COMMIT using Ediff."
|
||||
(interactive (list (magit-read-branch-or-commit "Revision")))
|
||||
(let ((revA (concat commit "^"))
|
||||
(revB commit))
|
||||
(apply #'magit-ediff-compare
|
||||
revA revB
|
||||
(magit-ediff-read-files revA revB (magit-current-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-ediff-show-stash (stash)
|
||||
"Show changes introduced by STASH using Ediff.
|
||||
`magit-ediff-show-stash-with-index' controls whether a
|
||||
three-buffer Ediff is used in order to distinguish changes in the
|
||||
stash that were staged."
|
||||
(interactive (list (magit-read-stash "Stash")))
|
||||
(pcase-let* ((revA (concat stash "^1"))
|
||||
(revB (concat stash "^2"))
|
||||
(revC stash)
|
||||
(`(,fileA ,fileC) (magit-ediff-read-files revA revC))
|
||||
(fileB fileC))
|
||||
(if (and magit-ediff-show-stash-with-index
|
||||
(member fileA (magit-changed-files revB revA)))
|
||||
(let ((conf (current-window-configuration))
|
||||
(bufA (magit-get-revision-buffer revA fileA))
|
||||
(bufB (magit-get-revision-buffer revB fileB))
|
||||
(bufC (magit-get-revision-buffer revC fileC)))
|
||||
(ediff-buffers3
|
||||
(or bufA (magit-find-file-noselect revA fileA))
|
||||
(or bufB (magit-find-file-noselect revB fileB))
|
||||
(or bufC (magit-find-file-noselect revC fileC))
|
||||
`((lambda ()
|
||||
(setq-local
|
||||
ediff-quit-hook
|
||||
(lambda ()
|
||||
,@(unless bufA
|
||||
'((ediff-kill-buffer-carefully ediff-buffer-A)))
|
||||
,@(unless bufB
|
||||
'((ediff-kill-buffer-carefully ediff-buffer-B)))
|
||||
,@(unless bufC
|
||||
'((ediff-kill-buffer-carefully ediff-buffer-C)))
|
||||
(let ((magit-ediff-previous-winconf ,conf))
|
||||
(run-hooks 'magit-ediff-quit-hook))))))
|
||||
'ediff-buffers3))
|
||||
(magit-ediff-compare revA revC fileA fileC))))
|
||||
|
||||
(defun magit-ediff-cleanup-auxiliary-buffers ()
|
||||
(let* ((ctl-buf ediff-control-buffer)
|
||||
(ctl-win (ediff-get-visible-buffer-window ctl-buf))
|
||||
(ctl-frm ediff-control-frame)
|
||||
(main-frame (cond ((window-live-p ediff-window-A)
|
||||
(window-frame ediff-window-A))
|
||||
((window-live-p ediff-window-B)
|
||||
(window-frame ediff-window-B)))))
|
||||
(ediff-kill-buffer-carefully ediff-diff-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-custom-diff-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-fine-diff-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-tmp-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-error-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-msg-buffer)
|
||||
(ediff-kill-buffer-carefully ediff-debug-buffer)
|
||||
(when (boundp 'ediff-patch-diagnostics)
|
||||
(ediff-kill-buffer-carefully ediff-patch-diagnostics))
|
||||
(cond ((and (ediff-window-display-p)
|
||||
(frame-live-p ctl-frm))
|
||||
(delete-frame ctl-frm))
|
||||
((window-live-p ctl-win)
|
||||
(delete-window ctl-win)))
|
||||
(unless (ediff-multiframe-setup-p)
|
||||
(ediff-kill-bottom-toolbar))
|
||||
(ediff-kill-buffer-carefully ctl-buf)
|
||||
(when (frame-live-p main-frame)
|
||||
(select-frame main-frame))))
|
||||
|
||||
(defun magit-ediff-restore-previous-winconf ()
|
||||
(set-window-configuration magit-ediff-previous-winconf))
|
||||
|
||||
(provide 'magit-ediff)
|
||||
;;; magit-ediff.el ends here
|
Binary file not shown.
|
@ -0,0 +1,701 @@
|
|||
;;; magit-extras.el --- additional functionality for Magit -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2008-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Additional functionality for Magit.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
(declare-function dired-read-shell-command "dired-aux" (prompt arg files))
|
||||
|
||||
(defgroup magit-extras nil
|
||||
"Additional functionality for Magit."
|
||||
:group 'magit-extensions)
|
||||
|
||||
;;; External Tools
|
||||
|
||||
(defcustom magit-gitk-executable
|
||||
(or (and (eq system-type 'windows-nt)
|
||||
(let ((exe (magit-git-string
|
||||
"-c" "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
|
||||
"X" "gitk.exe")))
|
||||
(and exe (file-executable-p exe) exe)))
|
||||
(executable-find "gitk") "gitk")
|
||||
"The Gitk executable."
|
||||
:group 'magit-extras
|
||||
:set-after '(magit-git-executable)
|
||||
:type 'string)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-run-git-gui ()
|
||||
"Run `git gui' for the current git repository."
|
||||
(interactive)
|
||||
(magit-with-toplevel
|
||||
(magit-process-file magit-git-executable nil 0 nil "gui")))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-run-git-gui-blame (commit filename &optional linenum)
|
||||
"Run `git gui blame' on the given FILENAME and COMMIT.
|
||||
Interactively run it for the current file and the `HEAD', with a
|
||||
prefix or when the current file cannot be determined let the user
|
||||
choose. When the current buffer is visiting FILENAME instruct
|
||||
blame to center around the line point is on."
|
||||
(interactive
|
||||
(let (revision filename)
|
||||
(when (or current-prefix-arg
|
||||
(not (setq revision "HEAD"
|
||||
filename (magit-file-relative-name nil 'tracked))))
|
||||
(setq revision (magit-read-branch-or-commit "Blame from revision"))
|
||||
(setq filename (magit-read-file-from-rev revision "Blame file")))
|
||||
(list revision filename
|
||||
(and (equal filename
|
||||
(ignore-errors
|
||||
(magit-file-relative-name buffer-file-name)))
|
||||
(line-number-at-pos)))))
|
||||
(magit-with-toplevel
|
||||
(apply #'magit-process-file magit-git-executable nil 0 nil "gui" "blame"
|
||||
`(,@(and linenum (list (format "--line=%d" linenum)))
|
||||
,commit
|
||||
,filename))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-run-gitk ()
|
||||
"Run `gitk' in the current repository."
|
||||
(interactive)
|
||||
(magit-process-file magit-gitk-executable nil 0))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-run-gitk-branches ()
|
||||
"Run `gitk --branches' in the current repository."
|
||||
(interactive)
|
||||
(magit-process-file magit-gitk-executable nil 0 nil "--branches"))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-run-gitk-all ()
|
||||
"Run `gitk --all' in the current repository."
|
||||
(interactive)
|
||||
(magit-process-file magit-gitk-executable nil 0 nil "--all"))
|
||||
|
||||
;;; Emacs Tools
|
||||
|
||||
;;;###autoload
|
||||
(defun ido-enter-magit-status ()
|
||||
"Drop into `magit-status' from file switching.
|
||||
|
||||
To make this command available use something like:
|
||||
|
||||
(add-hook \\='ido-setup-hook
|
||||
(lambda ()
|
||||
(define-key ido-completion-map
|
||||
(kbd \"C-x g\") \\='ido-enter-magit-status)))
|
||||
|
||||
Starting with Emacs 25.1 the Ido keymaps are defined just once
|
||||
instead of every time Ido is invoked, so now you can modify it
|
||||
like pretty much every other keymap:
|
||||
|
||||
(define-key ido-common-completion-map
|
||||
(kbd \"C-x g\") \\='ido-enter-magit-status)"
|
||||
(interactive)
|
||||
(with-no-warnings ; FIXME these are internal variables
|
||||
(setq ido-exit 'fallback fallback 'magit-status))
|
||||
(exit-minibuffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-dired-jump (&optional other-window)
|
||||
"Visit file at point using Dired.
|
||||
With a prefix argument, visit in another window. If there
|
||||
is no file at point, then instead visit `default-directory'."
|
||||
(interactive "P")
|
||||
(dired-jump other-window
|
||||
(when-let ((file (magit-file-at-point)))
|
||||
(expand-file-name (if (file-directory-p file)
|
||||
(file-name-as-directory file)
|
||||
file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-dired-log (&optional follow)
|
||||
"Show log for all marked files, or the current file."
|
||||
(interactive "P")
|
||||
(if-let ((topdir (magit-toplevel default-directory)))
|
||||
(let ((args (car (magit-log-arguments)))
|
||||
(files (dired-get-marked-files nil nil #'magit-file-tracked-p)))
|
||||
(unless files
|
||||
(user-error "No marked file is being tracked by Git"))
|
||||
(when (and follow
|
||||
(not (member "--follow" args))
|
||||
(not (cdr files)))
|
||||
(push "--follow" args))
|
||||
(magit-mode-setup-internal
|
||||
#'magit-log-mode
|
||||
(list (list (or (magit-get-current-branch) "HEAD"))
|
||||
args
|
||||
(let ((default-directory topdir))
|
||||
(mapcar #'file-relative-name files)))
|
||||
magit-log-buffer-file-locked))
|
||||
(magit--not-inside-repository-error)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-do-async-shell-command (file)
|
||||
"Open FILE with `dired-do-async-shell-command'.
|
||||
Interactively, open the file at point."
|
||||
(interactive (list (or (magit-file-at-point)
|
||||
(completing-read "Act on file: "
|
||||
(magit-list-files)))))
|
||||
(require 'dired-aux)
|
||||
(dired-do-async-shell-command
|
||||
(dired-read-shell-command "& on %s: " current-prefix-arg (list file))
|
||||
nil (list file)))
|
||||
|
||||
;;; Shift Selection
|
||||
|
||||
(defun magit--turn-on-shift-select-mode-p ()
|
||||
(and shift-select-mode
|
||||
this-command-keys-shift-translated
|
||||
(not mark-active)
|
||||
(not (eq (car-safe transient-mark-mode) 'only))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-previous-line (&optional arg try-vscroll)
|
||||
"Like `previous-line' but with Magit-specific shift-selection.
|
||||
|
||||
Magit's selection mechanism is based on the region but selects an
|
||||
area that is larger than the region. This causes `previous-line'
|
||||
when invoked while holding the shift key to move up one line and
|
||||
thereby select two lines. When invoked inside a hunk body this
|
||||
command does not move point on the first invocation and thereby
|
||||
it only selects a single line. Which inconsistency you prefer
|
||||
is a matter of preference."
|
||||
(declare (interactive-only
|
||||
"use `forward-line' with negative argument instead."))
|
||||
(interactive "p\np")
|
||||
(unless arg (setq arg 1))
|
||||
(let ((stay (or (magit-diff-inside-hunk-body-p)
|
||||
(magit-section-position-in-heading-p))))
|
||||
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
|
||||
(push-mark nil nil t)
|
||||
(with-no-warnings
|
||||
(handle-shift-selection)
|
||||
(previous-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-next-line (&optional arg try-vscroll)
|
||||
"Like `next-line' but with Magit-specific shift-selection.
|
||||
|
||||
Magit's selection mechanism is based on the region but selects
|
||||
an area that is larger than the region. This causes `next-line'
|
||||
when invoked while holding the shift key to move down one line
|
||||
and thereby select two lines. When invoked inside a hunk body
|
||||
this command does not move point on the first invocation and
|
||||
thereby it only selects a single line. Which inconsistency you
|
||||
prefer is a matter of preference."
|
||||
(declare (interactive-only forward-line))
|
||||
(interactive "p\np")
|
||||
(unless arg (setq arg 1))
|
||||
(let ((stay (or (magit-diff-inside-hunk-body-p)
|
||||
(magit-section-position-in-heading-p))))
|
||||
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
|
||||
(push-mark nil nil t)
|
||||
(with-no-warnings
|
||||
(handle-shift-selection)
|
||||
(next-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
|
||||
|
||||
;;; Clean
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-clean (&optional arg)
|
||||
"Remove untracked files from the working tree.
|
||||
With a prefix argument also remove ignored files,
|
||||
with two prefix arguments remove ignored files only.
|
||||
\n(git clean -f -d [-x|-X])"
|
||||
(interactive "p")
|
||||
(when (yes-or-no-p (format "Remove %s files? "
|
||||
(pcase arg
|
||||
(1 "untracked")
|
||||
(4 "untracked and ignored")
|
||||
(_ "ignored"))))
|
||||
(magit-wip-commit-before-change)
|
||||
(magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
|
||||
|
||||
(put 'magit-clean 'disabled t)
|
||||
|
||||
;;; Gitignore
|
||||
|
||||
;;;###autoload (autoload 'magit-gitignore-popup "magit-extras" nil t)
|
||||
(magit-define-popup magit-gitignore-popup
|
||||
"Popup console for gitignore commands."
|
||||
:man-page "gitignore"
|
||||
:actions '((?l "ignore locally" magit-gitignore-locally)
|
||||
(?g "ignore globally" magit-gitignore))
|
||||
:max-action-columns 1)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-gitignore (file-or-pattern &optional local)
|
||||
"Instruct Git to ignore FILE-OR-PATTERN.
|
||||
With a prefix argument only ignore locally."
|
||||
(interactive (list (magit-gitignore-read-pattern current-prefix-arg)
|
||||
current-prefix-arg))
|
||||
(let ((gitignore
|
||||
(if local
|
||||
(magit-git-dir (convert-standard-filename "info/exclude"))
|
||||
(expand-file-name ".gitignore" (magit-toplevel)))))
|
||||
(make-directory (file-name-directory gitignore) t)
|
||||
(with-temp-buffer
|
||||
(when (file-exists-p gitignore)
|
||||
(insert-file-contents gitignore))
|
||||
(goto-char (point-max))
|
||||
(unless (bolp)
|
||||
(insert "\n"))
|
||||
(insert (replace-regexp-in-string "\\(\\\\*\\)" "\\1\\1" file-or-pattern))
|
||||
(insert "\n")
|
||||
(write-region nil nil gitignore))
|
||||
(if local
|
||||
(magit-refresh)
|
||||
(magit-run-git "add" ".gitignore"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-gitignore-locally (file-or-pattern)
|
||||
"Instruct Git to locally ignore FILE-OR-PATTERN."
|
||||
(interactive (list (magit-gitignore-read-pattern t)))
|
||||
(magit-gitignore file-or-pattern t))
|
||||
|
||||
(defun magit-gitignore-read-pattern (local)
|
||||
(let* ((default (magit-current-file))
|
||||
(choices
|
||||
(delete-dups
|
||||
(--mapcat
|
||||
(cons (concat "/" it)
|
||||
(when-let ((ext (file-name-extension it)))
|
||||
(list (concat "/" (file-name-directory "foo") "*." ext)
|
||||
(concat "*." ext))))
|
||||
(magit-untracked-files)))))
|
||||
(when default
|
||||
(setq default (concat "/" default))
|
||||
(unless (member default choices)
|
||||
(setq default (concat "*." (file-name-extension default)))
|
||||
(unless (member default choices)
|
||||
(setq default nil))))
|
||||
(magit-completing-read (concat "File or pattern to ignore"
|
||||
(and local " locally"))
|
||||
choices nil nil nil nil default)))
|
||||
|
||||
;;; ChangeLog
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-add-change-log-entry (&optional whoami file-name other-window)
|
||||
"Find change log file and add date entry and item for current change.
|
||||
This differs from `add-change-log-entry' (which see) in that
|
||||
it acts on the current hunk in a Magit buffer instead of on
|
||||
a position in a file-visiting buffer."
|
||||
(interactive (list current-prefix-arg
|
||||
(prompt-for-change-log-name)))
|
||||
(let (buf pos)
|
||||
(save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(setq buf (current-buffer))
|
||||
(setq pos (point)))
|
||||
(save-excursion
|
||||
(with-current-buffer buf
|
||||
(goto-char pos)
|
||||
(add-change-log-entry whoami file-name other-window)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-add-change-log-entry-other-window (&optional whoami file-name)
|
||||
"Find change log file in other window and add entry and item.
|
||||
This differs from `add-change-log-entry-other-window' (which see)
|
||||
in that it acts on the current hunk in a Magit buffer instead of
|
||||
on a position in a file-visiting buffer."
|
||||
(interactive (and current-prefix-arg
|
||||
(list current-prefix-arg
|
||||
(prompt-for-change-log-name))))
|
||||
(magit-add-change-log-entry whoami file-name t))
|
||||
|
||||
;;; Edit Line Commit
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-edit-line-commit (&optional type)
|
||||
"Edit the commit that added the current line.
|
||||
|
||||
With a prefix argument edit the commit that removes the line,
|
||||
if any. The commit is determined using `git blame' and made
|
||||
editable using `git rebase --interactive' if it is reachable
|
||||
from `HEAD', or by checking out the commit (or a branch that
|
||||
points at it) otherwise."
|
||||
(interactive (list (and current-prefix-arg 'removal)))
|
||||
(let* ((chunk (magit-current-blame-chunk (or type 'addition)))
|
||||
(rev (oref chunk orig-rev)))
|
||||
(if (equal rev "0000000000000000000000000000000000000000")
|
||||
(message "This line has not been committed yet")
|
||||
(let ((rebase (magit-rev-ancestor-p rev "HEAD"))
|
||||
(file (expand-file-name (oref chunk orig-file)
|
||||
(magit-toplevel))))
|
||||
(if rebase
|
||||
(let ((magit--rebase-published-symbol 'edit-published))
|
||||
(magit-rebase-edit-commit rev (magit-rebase-arguments)))
|
||||
(magit-checkout (or (magit-rev-branch rev) rev)))
|
||||
(unless (and buffer-file-name
|
||||
(file-equal-p file buffer-file-name))
|
||||
(let ((blame-type (and magit-blame-mode magit-blame-type)))
|
||||
(if rebase
|
||||
(set-process-sentinel
|
||||
magit-this-process
|
||||
(lambda (process event)
|
||||
(magit-sequencer-process-sentinel process event)
|
||||
(when (eq (process-status process) 'exit)
|
||||
(find-file file)
|
||||
(when blame-type
|
||||
(magit-blame--pre-blame-setup blame-type)
|
||||
(magit-blame--run)))))
|
||||
(find-file file)
|
||||
(when blame-type
|
||||
(magit-blame--pre-blame-setup blame-type)
|
||||
(magit-blame--run)))))))))
|
||||
|
||||
(put 'magit-edit-line-commit 'disabled t)
|
||||
|
||||
(defun magit-diff-edit-hunk-commit ()
|
||||
"From a hunk, edit the respective commit and visit the file.
|
||||
|
||||
First visit the file being modified by the hunk at the correct
|
||||
location using `magit-diff-visit-file'. This actually visits a
|
||||
blob. When point is on a diff header, not within an individual
|
||||
hunk, then this visits the blob the first hunk is about.
|
||||
|
||||
Then invoke `magit-edit-line-commit', which uses an interactive
|
||||
rebase to make the commit editable, or if that is not possible
|
||||
because the commit is not reachable from `HEAD' by checking out
|
||||
that commit directly. This also causes the actual worktree file
|
||||
to be visited.
|
||||
|
||||
Neither the blob nor the file buffer are killed when finishing
|
||||
the rebase. If that is undesirable, then it might be better to
|
||||
use `magit-rebase-edit-command' instead of this command."
|
||||
(interactive)
|
||||
(let ((magit-diff-visit-previous-blob nil))
|
||||
(magit-diff-visit-file (--if-let (magit-file-at-point)
|
||||
(expand-file-name it)
|
||||
(user-error "No file at point"))
|
||||
nil 'switch-to-buffer))
|
||||
(magit-edit-line-commit))
|
||||
|
||||
(put 'magit-diff-edit-hunk-commit 'disabled t)
|
||||
|
||||
;;; Reshelve
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-reshelve-since (rev)
|
||||
"Change the author and committer dates of the commits since REV.
|
||||
|
||||
Ask the user for the first reachable commit whose dates should
|
||||
be changed. The read the new date for that commit. The initial
|
||||
minibuffer input and the previous history element offer good
|
||||
values. The next commit will be created one minute later and so
|
||||
on.
|
||||
|
||||
This command is only intended for interactive use and should only
|
||||
be used on highly rearranged and unpublished history."
|
||||
(interactive (list nil))
|
||||
(cond
|
||||
((not rev)
|
||||
(let ((backup (concat "refs/original/refs/heads/"
|
||||
(magit-get-current-branch))))
|
||||
(when (and (magit-ref-p backup)
|
||||
(not (magit-y-or-n-p
|
||||
"Backup ref %s already exists. Override? " backup)))
|
||||
(user-error "Abort")))
|
||||
(magit-log-select 'magit-reshelve-since
|
||||
"Type %p on a commit to reshelve it and the commits above it,"))
|
||||
(t
|
||||
(cl-flet ((adjust (time offset)
|
||||
(format-time-string
|
||||
"%F %T %z"
|
||||
(+ (floor time)
|
||||
(* offset 60)
|
||||
(- (car (decode-time time)))))))
|
||||
(let* ((start (concat rev "^"))
|
||||
(range (concat start ".." (magit-get-current-branch)))
|
||||
(time-rev (adjust (float-time (string-to-number
|
||||
(magit-rev-format "%at" start)))
|
||||
1))
|
||||
(time-now (adjust (float-time)
|
||||
(- (string-to-number
|
||||
(magit-git-string "rev-list" "--count"
|
||||
range))))))
|
||||
(push time-rev magit--reshelve-history)
|
||||
(let ((date (floor
|
||||
(float-time
|
||||
(date-to-time
|
||||
(read-string "Date for first commit: "
|
||||
time-now 'magit--reshelve-history))))))
|
||||
(magit-with-toplevel
|
||||
(magit-run-git-async
|
||||
"filter-branch" "--force" "--env-filter"
|
||||
(format "case $GIT_COMMIT in %s\nesac"
|
||||
(mapconcat (lambda (rev)
|
||||
(prog1 (format "%s) \
|
||||
export GIT_AUTHOR_DATE=\"%s\"; \
|
||||
export GIT_COMMITTER_DATE=\"%s\";;" rev date date)
|
||||
(cl-incf date 60)))
|
||||
(magit-git-lines "rev-list" "--reverse"
|
||||
range)
|
||||
" "))
|
||||
range "--")
|
||||
(set-process-sentinel
|
||||
magit-this-process
|
||||
(lambda (process event)
|
||||
(when (memq (process-status process) '(exit signal))
|
||||
(if (> (process-exit-status process) 0)
|
||||
(magit-process-sentinel process event)
|
||||
(process-put process 'inhibit-refresh t)
|
||||
(magit-process-sentinel process event)
|
||||
(magit-run-git "update-ref" "-d"
|
||||
(concat "refs/original/refs/heads/"
|
||||
(magit-get-current-branch))))))))))))))
|
||||
|
||||
;;; Revision Stack
|
||||
|
||||
(defvar magit-revision-stack nil)
|
||||
|
||||
(defcustom magit-pop-revision-stack-format
|
||||
'("[%N: %h] " "%N: %H\n %s\n" "\\[\\([0-9]+\\)[]:]")
|
||||
"Control how `magit-pop-revision-stack' inserts a revision.
|
||||
|
||||
The command `magit-pop-revision-stack' inserts a representation
|
||||
of the revision last pushed to the `magit-revision-stack' into
|
||||
the current buffer. It inserts text at point and/or near the end
|
||||
of the buffer, and removes the consumed revision from the stack.
|
||||
|
||||
The entries on the stack have the format (HASH TOPLEVEL) and this
|
||||
option has the format (POINT-FORMAT EOB-FORMAT INDEX-REGEXP), all
|
||||
of which may be nil or a string (though either one of EOB-FORMAT
|
||||
or POINT-FORMAT should be a string, and if INDEX-REGEXP is
|
||||
non-nil, then the two formats should be too).
|
||||
|
||||
First INDEX-REGEXP is used to find the previously inserted entry,
|
||||
by searching backward from point. The first submatch must match
|
||||
the index number. That number is incremented by one, and becomes
|
||||
the index number of the entry to be inserted. If you don't want
|
||||
to number the inserted revisions, then use nil for INDEX-REGEXP.
|
||||
|
||||
If INDEX-REGEXP is non-nil, then both POINT-FORMAT and EOB-FORMAT
|
||||
should contain \"%N\", which is replaced with the number that was
|
||||
determined in the previous step.
|
||||
|
||||
Both formats, if non-nil and after removing %N, are then expanded
|
||||
using `git show --format=FORMAT ...' inside TOPLEVEL.
|
||||
|
||||
The expansion of POINT-FORMAT is inserted at point, and the
|
||||
expansion of EOB-FORMAT is inserted at the end of the buffer (if
|
||||
the buffer ends with a comment, then it is inserted right before
|
||||
that)."
|
||||
:package-version '(magit . "2.3.0")
|
||||
:group 'magit-commands
|
||||
:type '(list (choice (string :tag "Insert at point format")
|
||||
(cons (string :tag "Insert at point format")
|
||||
(repeat (string :tag "Argument to git show")))
|
||||
(const :tag "Don't insert at point" nil))
|
||||
(choice (string :tag "Insert at eob format")
|
||||
(cons (string :tag "Insert at eob format")
|
||||
(repeat (string :tag "Argument to git show")))
|
||||
(const :tag "Don't insert at eob" nil))
|
||||
(choice (regexp :tag "Find index regexp")
|
||||
(const :tag "Don't number entries" nil))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-pop-revision-stack (rev toplevel)
|
||||
"Insert a representation of a revision into the current buffer.
|
||||
|
||||
Pop a revision from the `magit-revision-stack' and insert it into
|
||||
the current buffer according to `magit-pop-revision-stack-format'.
|
||||
Revisions can be put on the stack using `magit-copy-section-value'
|
||||
and `magit-copy-buffer-revision'.
|
||||
|
||||
If the stack is empty or with a prefix argument, instead read a
|
||||
revision in the minibuffer. By using the minibuffer history this
|
||||
allows selecting an item which was popped earlier or to insert an
|
||||
arbitrary reference or revision without first pushing it onto the
|
||||
stack.
|
||||
|
||||
When reading the revision from the minibuffer, then it might not
|
||||
be possible to guess the correct repository. When this command
|
||||
is called inside a repository (e.g. while composing a commit
|
||||
message), then that repository is used. Otherwise (e.g. while
|
||||
composing an email) then the repository recorded for the top
|
||||
element of the stack is used (even though we insert another
|
||||
revision). If not called inside a repository and with an empty
|
||||
stack, or with two prefix arguments, then read the repository in
|
||||
the minibuffer too."
|
||||
(interactive
|
||||
(if (or current-prefix-arg (not magit-revision-stack))
|
||||
(let ((default-directory
|
||||
(or (and (not (= (prefix-numeric-value current-prefix-arg) 16))
|
||||
(or (magit-toplevel)
|
||||
(cadr (car magit-revision-stack))))
|
||||
(magit-read-repository))))
|
||||
(list (magit-read-branch-or-commit "Insert revision")
|
||||
default-directory))
|
||||
(push (caar magit-revision-stack) magit-revision-history)
|
||||
(pop magit-revision-stack)))
|
||||
(if rev
|
||||
(pcase-let ((`(,pnt-format ,eob-format ,idx-format)
|
||||
magit-pop-revision-stack-format))
|
||||
(let ((default-directory toplevel)
|
||||
(idx (and idx-format
|
||||
(save-excursion
|
||||
(if (re-search-backward idx-format nil t)
|
||||
(number-to-string
|
||||
(1+ (string-to-number (match-string 1))))
|
||||
"1"))))
|
||||
pnt-args eob-args)
|
||||
(when (listp pnt-format)
|
||||
(setq pnt-args (cdr pnt-format))
|
||||
(setq pnt-format (car pnt-format)))
|
||||
(when (listp eob-format)
|
||||
(setq eob-args (cdr eob-format))
|
||||
(setq eob-format (car eob-format)))
|
||||
(when pnt-format
|
||||
(when idx-format
|
||||
(setq pnt-format
|
||||
(replace-regexp-in-string "%N" idx pnt-format t t)))
|
||||
(magit-rev-insert-format pnt-format rev pnt-args)
|
||||
(backward-delete-char 1))
|
||||
(when eob-format
|
||||
(when idx-format
|
||||
(setq eob-format
|
||||
(replace-regexp-in-string "%N" idx eob-format t t)))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(skip-syntax-backward ">s-")
|
||||
(beginning-of-line)
|
||||
(if (and comment-start (looking-at comment-start))
|
||||
(while (looking-at comment-start)
|
||||
(forward-line -1))
|
||||
(forward-line)
|
||||
(unless (= (current-column) 0)
|
||||
(insert ?\n)))
|
||||
(insert ?\n)
|
||||
(magit-rev-insert-format eob-format rev eob-args)
|
||||
(backward-delete-char 1)))))
|
||||
(user-error "Revision stack is empty")))
|
||||
|
||||
(define-key git-commit-mode-map
|
||||
(kbd "C-c C-w") 'magit-pop-revision-stack)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-copy-section-value ()
|
||||
"Save the value of the current section for later use.
|
||||
|
||||
Save the section value to the `kill-ring', and, provided that
|
||||
the current section is a commit, branch, or tag section, push
|
||||
the (referenced) revision to the `magit-revision-stack' for use
|
||||
with `magit-pop-revision-stack'.
|
||||
|
||||
When the current section is a branch or a tag, and a prefix
|
||||
argument is used, then save the revision at its tip to the
|
||||
`kill-ring' instead of the reference name.
|
||||
|
||||
When the region is active, then save that to the `kill-ring',
|
||||
like `kill-ring-save' would, instead of behaving as described
|
||||
above."
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(copy-region-as-kill nil nil 'region)
|
||||
(when-let ((section (magit-current-section))
|
||||
(value (oref section value)))
|
||||
(magit-section-case
|
||||
((branch commit module-commit tag)
|
||||
(let ((default-directory default-directory) ref)
|
||||
(magit-section-case
|
||||
((branch tag)
|
||||
(setq ref value))
|
||||
(module-commit
|
||||
(setq default-directory
|
||||
(file-name-as-directory
|
||||
(expand-file-name (magit-section-parent-value section)
|
||||
(magit-toplevel))))))
|
||||
(setq value (magit-rev-parse value))
|
||||
(push (list value default-directory) magit-revision-stack)
|
||||
(kill-new (message "%s" (or (and current-prefix-arg ref)
|
||||
value)))))
|
||||
(t (kill-new (message "%s" value)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-copy-buffer-revision ()
|
||||
"Save the revision of the current buffer for later use.
|
||||
|
||||
Save the revision shown in the current buffer to the `kill-ring'
|
||||
and push it to the `magit-revision-stack'.
|
||||
|
||||
This command is mainly intended for use in `magit-revision-mode'
|
||||
buffers, the only buffers where it is always unambiguous exactly
|
||||
which revision should be saved.
|
||||
|
||||
Most other Magit buffers usually show more than one revision, in
|
||||
some way or another, so this command has to select one of them,
|
||||
and that choice might not always be the one you think would have
|
||||
been the best pick.
|
||||
|
||||
In such buffers it is often more useful to save the value of
|
||||
the current section instead, using `magit-copy-section-value'.
|
||||
|
||||
When the region is active, then save that to the `kill-ring',
|
||||
like `kill-ring-save' would, instead of behaving as described
|
||||
above."
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(copy-region-as-kill nil nil 'region)
|
||||
(when-let ((rev (cond ((memq major-mode '(magit-cherry-mode
|
||||
magit-log-select-mode
|
||||
magit-reflog-mode
|
||||
magit-refs-mode
|
||||
magit-revision-mode
|
||||
magit-stash-mode
|
||||
magit-stashes-mode))
|
||||
(car magit-refresh-args))
|
||||
((memq major-mode '(magit-diff-mode
|
||||
magit-log-mode))
|
||||
(let ((r (caar magit-refresh-args)))
|
||||
(if (string-match "\\.\\.\\.?\\(.+\\)" r)
|
||||
(match-string 1 r)
|
||||
r)))
|
||||
((eq major-mode 'magit-status-mode) "HEAD"))))
|
||||
(when (magit-rev-verify-commit rev)
|
||||
(setq rev (magit-rev-parse rev))
|
||||
(push (list rev default-directory) magit-revision-stack)
|
||||
(kill-new (message "%s" rev))))))
|
||||
|
||||
;;; Miscellaneous
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-abort-dwim ()
|
||||
"Abort current operation.
|
||||
Depending on the context, this will abort a merge, a rebase, a
|
||||
patch application, a cherry-pick, a revert, or a bisect."
|
||||
(interactive)
|
||||
(cond ((magit-merge-in-progress-p) (magit-merge-abort))
|
||||
((magit-rebase-in-progress-p) (magit-rebase-abort))
|
||||
((magit-am-in-progress-p) (magit-am-abort))
|
||||
((magit-sequencer-in-progress-p) (magit-sequencer-abort))
|
||||
((magit-bisect-in-progress-p) (magit-bisect-reset))))
|
||||
|
||||
(provide 'magit-extras)
|
||||
;;; magit-extras.el ends here
|
Binary file not shown.
|
@ -0,0 +1,563 @@
|
|||
;;; magit-files.el --- finding files -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements support for finding blobs, staged files,
|
||||
;; and Git configuration files. It also implements modes useful in
|
||||
;; buffers visiting files and blobs, and the commands used by those
|
||||
;; modes.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
;;; Find Blob
|
||||
|
||||
(defvar magit-find-file-hook nil)
|
||||
(add-hook 'magit-find-file-hook #'magit-blob-mode)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-find-file (rev file)
|
||||
"View FILE from REV.
|
||||
Switch to a buffer visiting blob REV:FILE,
|
||||
creating one if none already exists."
|
||||
(interactive (magit-find-file-read-args "Find file"))
|
||||
(switch-to-buffer (magit-find-file-noselect rev file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-find-file-other-window (rev file)
|
||||
"View FILE from REV, in another window.
|
||||
Like `magit-find-file', but create a new window or reuse an
|
||||
existing one."
|
||||
(interactive (magit-find-file-read-args "Find file in other window"))
|
||||
(switch-to-buffer-other-window (magit-find-file-noselect rev file)))
|
||||
|
||||
(defun magit-find-file-read-args (prompt)
|
||||
(let ((rev (magit-read-branch-or-commit "Find file from revision")))
|
||||
(list rev (magit-read-file-from-rev rev prompt))))
|
||||
|
||||
(defun magit-find-file-noselect (rev file)
|
||||
"Read FILE from REV into a buffer and return the buffer.
|
||||
FILE must be relative to the top directory of the repository."
|
||||
(magit-find-file-noselect-1 rev file 'magit-find-file-hook))
|
||||
|
||||
(defun magit-find-file-noselect-1 (rev file hookvar &optional revert)
|
||||
"Read FILE from REV into a buffer and return the buffer.
|
||||
FILE must be relative to the top directory of the repository.
|
||||
An empty REV stands for index."
|
||||
(let ((topdir (magit-toplevel)))
|
||||
(when (file-name-absolute-p file)
|
||||
(setq file (file-relative-name file topdir)))
|
||||
(with-current-buffer (magit-get-revision-buffer-create rev file)
|
||||
(when (or (not magit-buffer-file-name)
|
||||
(if (eq revert 'ask-revert)
|
||||
(y-or-n-p (format "%s already exists; revert it? "
|
||||
(buffer-name))))
|
||||
revert)
|
||||
(setq magit-buffer-revision
|
||||
(if (string= rev "") "{index}" (magit-rev-format "%H" rev)))
|
||||
(setq magit-buffer-refname rev)
|
||||
(setq magit-buffer-file-name (expand-file-name file topdir))
|
||||
(setq default-directory
|
||||
(let ((dir (file-name-directory magit-buffer-file-name)))
|
||||
(if (file-exists-p dir) dir topdir)))
|
||||
(setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
|
||||
(revert-buffer t t)
|
||||
(run-hooks hookvar))
|
||||
(current-buffer))))
|
||||
|
||||
(defun magit-get-revision-buffer-create (rev file)
|
||||
(magit-get-revision-buffer rev file t))
|
||||
|
||||
(defun magit-get-revision-buffer (rev file &optional create)
|
||||
(funcall (if create 'get-buffer-create 'get-buffer)
|
||||
(format "%s.~%s~" file (if (equal rev "") "index"
|
||||
(subst-char-in-string ?/ ?_ rev)))))
|
||||
|
||||
(defun magit-revert-rev-file-buffer (_ignore-auto noconfirm)
|
||||
(when (or noconfirm
|
||||
(and (not (buffer-modified-p))
|
||||
(catch 'found
|
||||
(dolist (regexp revert-without-query)
|
||||
(when (string-match regexp magit-buffer-file-name)
|
||||
(throw 'found t)))))
|
||||
(yes-or-no-p (format "Revert buffer from git %s? "
|
||||
(if (equal magit-buffer-refname "") "{index}"
|
||||
(concat "revision " magit-buffer-refname)))))
|
||||
(let* ((inhibit-read-only t)
|
||||
(default-directory (magit-toplevel))
|
||||
(file (file-relative-name magit-buffer-file-name))
|
||||
(coding-system-for-read (or coding-system-for-read 'undecided)))
|
||||
(erase-buffer)
|
||||
(magit-git-insert "cat-file" "-p" (concat magit-buffer-refname ":" file))
|
||||
(setq buffer-file-coding-system last-coding-system-used))
|
||||
(let ((buffer-file-name magit-buffer-file-name)
|
||||
(after-change-major-mode-hook
|
||||
(remq 'global-diff-hl-mode-enable-in-buffers
|
||||
after-change-major-mode-hook)))
|
||||
(normal-mode t))
|
||||
(setq buffer-read-only t)
|
||||
(set-buffer-modified-p nil)
|
||||
(goto-char (point-min))))
|
||||
|
||||
;;; Find Index
|
||||
|
||||
(defvar magit-find-index-hook nil)
|
||||
|
||||
(defun magit-find-file-index-noselect (file &optional revert)
|
||||
"Read FILE from the index into a buffer and return the buffer.
|
||||
FILE must to be relative to the top directory of the repository."
|
||||
(magit-find-file-noselect-1 "" file 'magit-find-index-hook
|
||||
(or revert 'ask-revert)))
|
||||
|
||||
(defun magit-update-index ()
|
||||
"Update the index with the contents of the current buffer.
|
||||
The current buffer has to be visiting a file in the index, which
|
||||
is done using `magit-find-index-noselect'."
|
||||
(interactive)
|
||||
(let ((file (magit-file-relative-name)))
|
||||
(unless (equal magit-buffer-refname "")
|
||||
(user-error "%s isn't visiting the index" file))
|
||||
(if (y-or-n-p (format "Update index with contents of %s" (buffer-name)))
|
||||
(let ((index (make-temp-file "index"))
|
||||
(buffer (current-buffer)))
|
||||
(when magit-wip-before-change-mode
|
||||
(magit-wip-commit-before-change (list file) " before un-/stage"))
|
||||
(let ((coding-system-for-write buffer-file-coding-system))
|
||||
(with-temp-file index
|
||||
(insert-buffer-substring buffer)))
|
||||
(magit-with-toplevel
|
||||
(magit-call-git "update-index" "--cacheinfo"
|
||||
(substring (magit-git-string "ls-files" "-s" file)
|
||||
0 6)
|
||||
(magit-git-string "hash-object" "-t" "blob" "-w"
|
||||
(concat "--path=" file)
|
||||
"--" index)
|
||||
file))
|
||||
(set-buffer-modified-p nil)
|
||||
(when magit-wip-after-apply-mode
|
||||
(magit-wip-commit-after-apply (list file) " after un-/stage")))
|
||||
(message "Abort")))
|
||||
(--when-let (magit-mode-get-buffer 'magit-status-mode)
|
||||
(with-current-buffer it (magit-refresh)))
|
||||
t)
|
||||
|
||||
;;; Find Config File
|
||||
|
||||
(defun magit-find-git-config-file (filename &optional wildcards)
|
||||
"Edit a file located in the current repository's git directory.
|
||||
|
||||
When \".git\", located at the root of the working tree, is a
|
||||
regular file, then that makes it cumbersome to open a file
|
||||
located in the actual git directory.
|
||||
|
||||
This command is like `find-file', except that it temporarily
|
||||
binds `default-directory' to the actual git directory, while
|
||||
reading the FILENAME."
|
||||
(interactive
|
||||
(let ((default-directory (magit-git-dir)))
|
||||
(find-file-read-args "Find file: "
|
||||
(confirm-nonexistent-file-or-buffer))))
|
||||
(find-file filename wildcards))
|
||||
|
||||
(defun magit-find-git-config-file-other-window (filename &optional wildcards)
|
||||
"Edit a file located in the current repository's git directory, in another window.
|
||||
|
||||
When \".git\", located at the root of the working tree, is a
|
||||
regular file, then that makes it cumbersome to open a file
|
||||
located in the actual git directory.
|
||||
|
||||
This command is like `find-file-other-window', except that it
|
||||
temporarily binds `default-directory' to the actual git
|
||||
directory, while reading the FILENAME."
|
||||
(interactive
|
||||
(let ((default-directory (magit-git-dir)))
|
||||
(find-file-read-args "Find file in other window: "
|
||||
(confirm-nonexistent-file-or-buffer))))
|
||||
(find-file-other-window filename wildcards))
|
||||
|
||||
(defun magit-find-git-config-file-other-frame (filename &optional wildcards)
|
||||
"Edit a file located in the current repository's git directory, in another frame.
|
||||
|
||||
When \".git\", located at the root of the working tree, is a
|
||||
regular file, then that makes it cumbersome to open a file
|
||||
located in the actual git directory.
|
||||
|
||||
This command is like `find-file-other-frame', except that it
|
||||
temporarily binds `default-directory' to the actual git
|
||||
directory, while reading the FILENAME."
|
||||
(interactive
|
||||
(let ((default-directory (magit-git-dir)))
|
||||
(find-file-read-args "Find file in other frame: "
|
||||
(confirm-nonexistent-file-or-buffer))))
|
||||
(find-file-other-frame filename wildcards))
|
||||
|
||||
;;; File Mode
|
||||
|
||||
(defvar magit-file-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-xg" 'magit-status)
|
||||
(define-key map "\C-x\M-g" 'magit-dispatch-popup)
|
||||
(define-key map "\C-c\M-g" 'magit-file-popup)
|
||||
map)
|
||||
"Keymap for `magit-file-mode'.")
|
||||
|
||||
;;;###autoload (autoload 'magit-file-popup "magit" nil t)
|
||||
(magit-define-popup magit-file-popup
|
||||
"Popup console for Magit commands in file-visiting buffers."
|
||||
:actions '((?s "Stage" magit-stage-file)
|
||||
(?D "Diff..." magit-diff-buffer-file-popup)
|
||||
(?L "Log..." magit-log-buffer-file-popup)
|
||||
(?B "Blame..." magit-blame-popup) nil
|
||||
(?u "Unstage" magit-unstage-file)
|
||||
(?d "Diff" magit-diff-buffer-file)
|
||||
(?l "Log" magit-log-buffer-file)
|
||||
(?b "Blame" magit-blame)
|
||||
(?p "Prev blob" magit-blob-previous)
|
||||
(?c "Commit" magit-commit-popup) nil
|
||||
(?t "Trace" magit-log-trace-definition)
|
||||
(?r (lambda ()
|
||||
(with-current-buffer magit-pre-popup-buffer
|
||||
(and (not buffer-file-name)
|
||||
(propertize "...removal" 'face 'default))))
|
||||
magit-blame-removal)
|
||||
(?n "Next blob" magit-blob-next)
|
||||
(?e "Edit line" magit-edit-line-commit)
|
||||
nil nil
|
||||
(?f (lambda ()
|
||||
(with-current-buffer magit-pre-popup-buffer
|
||||
(and (not buffer-file-name)
|
||||
(propertize "...reverse" 'face 'default))))
|
||||
magit-blame-reverse)
|
||||
nil)
|
||||
:max-action-columns 5)
|
||||
|
||||
(defvar magit-file-mode-lighter "")
|
||||
|
||||
(define-minor-mode magit-file-mode
|
||||
"Enable some Magit features in a file-visiting buffer.
|
||||
|
||||
Currently this only adds the following key bindings.
|
||||
\n\\{magit-file-mode-map}"
|
||||
:package-version '(magit . "2.2.0")
|
||||
:lighter magit-file-mode-lighter
|
||||
:keymap magit-file-mode-map)
|
||||
|
||||
(defun magit-file-mode-turn-on ()
|
||||
(and buffer-file-name
|
||||
(magit-inside-worktree-p t)
|
||||
(magit-file-mode)))
|
||||
|
||||
;;;###autoload
|
||||
(define-globalized-minor-mode global-magit-file-mode
|
||||
magit-file-mode magit-file-mode-turn-on
|
||||
:package-version '(magit . "2.13.0")
|
||||
:link '(info-link "(magit)Minor Mode for Buffers Visiting Files")
|
||||
:group 'magit-essentials
|
||||
:group 'magit-modes
|
||||
:init-value t)
|
||||
;; Unfortunately `:init-value t' only sets the value of the mode
|
||||
;; variable but does not cause the mode function to be called, and we
|
||||
;; cannot use `:initialize' to call that explicitly because the option
|
||||
;; is defined before the functions, so we have to do it here.
|
||||
(cl-eval-when (load)
|
||||
(when global-magit-file-mode
|
||||
(global-magit-file-mode 1)))
|
||||
|
||||
;;; Blob Mode
|
||||
|
||||
(defvar magit-blob-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(cond ((featurep 'jkl)
|
||||
(define-key map "i" 'magit-blob-previous)
|
||||
(define-key map "k" 'magit-blob-next)
|
||||
(define-key map "j" 'magit-blame)
|
||||
(define-key map "l" 'magit-blame-removal)
|
||||
(define-key map "f" 'magit-blame-reverse))
|
||||
(t
|
||||
(define-key map "p" 'magit-blob-previous)
|
||||
(define-key map "n" 'magit-blob-next)
|
||||
(define-key map "b" 'magit-blame)
|
||||
(define-key map "r" 'magit-blame-removal)
|
||||
(define-key map "f" 'magit-blame-reverse)))
|
||||
(define-key map "q" 'magit-kill-this-buffer)
|
||||
map)
|
||||
"Keymap for `magit-blob-mode'.")
|
||||
|
||||
(define-minor-mode magit-blob-mode
|
||||
"Enable some Magit features in blob-visiting buffers.
|
||||
|
||||
Currently this only adds the following key bindings.
|
||||
\n\\{magit-blob-mode-map}"
|
||||
:package-version '(magit . "2.3.0"))
|
||||
|
||||
(defun magit-blob-next ()
|
||||
"Visit the next blob which modified the current file."
|
||||
(interactive)
|
||||
(if magit-buffer-file-name
|
||||
(magit-blob-visit (or (magit-blob-successor magit-buffer-revision
|
||||
magit-buffer-file-name)
|
||||
magit-buffer-file-name)
|
||||
(line-number-at-pos))
|
||||
(if (buffer-file-name (buffer-base-buffer))
|
||||
(user-error "You have reached the end of time")
|
||||
(user-error "Buffer isn't visiting a file or blob"))))
|
||||
|
||||
(defun magit-blob-previous ()
|
||||
"Visit the previous blob which modified the current file."
|
||||
(interactive)
|
||||
(if-let ((file (or magit-buffer-file-name
|
||||
(buffer-file-name (buffer-base-buffer)))))
|
||||
(--if-let (magit-blob-ancestor magit-buffer-revision file)
|
||||
(magit-blob-visit it (line-number-at-pos))
|
||||
(user-error "You have reached the beginning of time"))
|
||||
(user-error "Buffer isn't visiting a file or blob")))
|
||||
|
||||
(defun magit-blob-visit (blob-or-file line)
|
||||
(if (stringp blob-or-file)
|
||||
(find-file blob-or-file)
|
||||
(pcase-let ((`(,rev ,file) blob-or-file))
|
||||
(magit-find-file rev file)
|
||||
(apply #'message "%s (%s %s ago)"
|
||||
(magit-rev-format "%s" rev)
|
||||
(magit--age (magit-rev-format "%ct" rev)))))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line)))
|
||||
|
||||
(defun magit-blob-ancestor (rev file)
|
||||
(let ((lines (magit-with-toplevel
|
||||
(magit-git-lines "log" "-2" "--format=%H" "--name-only"
|
||||
"--follow" (or rev "HEAD") "--" file))))
|
||||
(if rev (cddr lines) (butlast lines 2))))
|
||||
|
||||
(defun magit-blob-successor (rev file)
|
||||
(let ((lines (magit-with-toplevel
|
||||
(magit-git-lines "log" "--format=%H" "--name-only" "--follow"
|
||||
"HEAD" "--" file))))
|
||||
(catch 'found
|
||||
(while lines
|
||||
(if (equal (nth 2 lines) rev)
|
||||
(throw 'found (list (nth 0 lines) (nth 1 lines)))
|
||||
(setq lines (nthcdr 2 lines)))))))
|
||||
|
||||
;;; File Commands
|
||||
|
||||
(defun magit-file-rename (file newname)
|
||||
"Rename the FILE to NEWNAME.
|
||||
If FILE isn't tracked in Git, fallback to using `rename-file'."
|
||||
(interactive
|
||||
(let* ((file (magit-read-file "Rename file"))
|
||||
(dir (file-name-directory file))
|
||||
(newname (read-file-name (format "Rename %s to file: " file)
|
||||
(and dir (expand-file-name dir)))))
|
||||
(list (expand-file-name file (magit-toplevel))
|
||||
(expand-file-name newname))))
|
||||
(if (magit-file-tracked-p (magit-convert-filename-for-git file))
|
||||
(let ((oldbuf (get-file-buffer file)))
|
||||
(when (and oldbuf (buffer-modified-p oldbuf))
|
||||
(user-error "Save %s before moving it" file))
|
||||
(when (file-exists-p newname)
|
||||
(user-error "%s already exists" newname))
|
||||
(magit-run-git "mv"
|
||||
(magit-convert-filename-for-git file)
|
||||
(magit-convert-filename-for-git newname))
|
||||
(when oldbuf
|
||||
(with-current-buffer oldbuf
|
||||
(let ((buffer-read-only buffer-read-only))
|
||||
(set-visited-file-name newname))
|
||||
(if (fboundp 'vc-refresh-state)
|
||||
(vc-refresh-state)
|
||||
(with-no-warnings
|
||||
(vc-find-file-hook))))))
|
||||
(rename-file file newname current-prefix-arg)
|
||||
(magit-refresh)))
|
||||
|
||||
(defun magit-file-untrack (files &optional force)
|
||||
"Untrack the selected FILES or one file read in the minibuffer.
|
||||
|
||||
With a prefix argument FORCE do so even when the files have
|
||||
staged as well as unstaged changes."
|
||||
(interactive (list (or (--if-let (magit-region-values 'file t)
|
||||
(progn
|
||||
(unless (magit-file-tracked-p (car it))
|
||||
(user-error "Already untracked"))
|
||||
(magit-confirm-files 'untrack it "Untrack"))
|
||||
(list (magit-read-tracked-file "Untrack file"))))
|
||||
current-prefix-arg))
|
||||
(magit-run-git "rm" "--cached" (and force "--force") "--" files))
|
||||
|
||||
(defun magit-file-delete (files &optional force)
|
||||
"Delete the selected FILES or one file read in the minibuffer.
|
||||
|
||||
With a prefix argument FORCE do so even when the files have
|
||||
uncommitted changes. When the files aren't being tracked in
|
||||
Git, then fallback to using `delete-file'."
|
||||
(interactive (list (--if-let (magit-region-values 'file t)
|
||||
(magit-confirm-files 'delete it "Delete")
|
||||
(list (magit-read-file "Delete file")))
|
||||
current-prefix-arg))
|
||||
(if (magit-file-tracked-p (car files))
|
||||
(magit-call-git "rm" (and force "--force") "--" files)
|
||||
(let ((topdir (magit-toplevel)))
|
||||
(dolist (file files)
|
||||
(delete-file (expand-file-name file topdir) t))))
|
||||
(magit-refresh))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-file-checkout (rev file)
|
||||
"Checkout FILE from REV."
|
||||
(interactive
|
||||
(let ((rev (magit-read-branch-or-commit
|
||||
"Checkout from revision" magit-buffer-revision)))
|
||||
(list rev (magit-read-file-from-rev rev "Checkout file"))))
|
||||
(magit-with-toplevel
|
||||
(magit-run-git "checkout" rev "--" file)))
|
||||
|
||||
;;; Read File
|
||||
|
||||
(defvar magit-read-file-hist nil)
|
||||
|
||||
(defun magit-read-file-from-rev (rev prompt &optional default)
|
||||
(let ((files (magit-revision-files rev)))
|
||||
(magit-completing-read
|
||||
prompt files nil t nil 'magit-read-file-hist
|
||||
(car (member (or default (magit-current-file)) files)))))
|
||||
|
||||
(defun magit-read-file (prompt &optional tracked-only)
|
||||
(let ((choices (nconc (magit-list-files)
|
||||
(unless tracked-only (magit-untracked-files)))))
|
||||
(magit-completing-read
|
||||
prompt choices nil t nil nil
|
||||
(car (member (or (magit-section-value-if '(file submodule))
|
||||
(magit-file-relative-name nil tracked-only))
|
||||
choices)))))
|
||||
|
||||
(defun magit-read-tracked-file (prompt)
|
||||
(magit-read-file prompt t))
|
||||
|
||||
(defun magit-read-file-choice (prompt files &optional error default)
|
||||
"Read file from FILES.
|
||||
|
||||
If FILES has only one member, return that instead of prompting.
|
||||
If FILES has no members, give a user error. ERROR can be given
|
||||
to provide a more informative error.
|
||||
|
||||
If DEFAULT is non-nil, use this as the default value instead of
|
||||
`magit-current-file'."
|
||||
(pcase (length files)
|
||||
(0 (user-error (or error "No file choices")))
|
||||
(1 (car files))
|
||||
(_ (magit-completing-read
|
||||
prompt files nil t nil 'magit-read-file-hist
|
||||
(car (member (or default (magit-current-file)) files))))))
|
||||
|
||||
(defun magit-read-changed-file (rev-or-range prompt &optional default)
|
||||
(magit-read-file-choice
|
||||
prompt
|
||||
(magit-changed-files rev-or-range)
|
||||
default
|
||||
(concat "No file changed in " rev-or-range)))
|
||||
|
||||
(defun magit-read-files (prompt initial-contents)
|
||||
(mapconcat 'identity
|
||||
(completing-read-multiple (or prompt "File,s: ")
|
||||
(magit-list-files)
|
||||
nil nil initial-contents) ","))
|
||||
|
||||
;;; Patch File
|
||||
|
||||
(defcustom magit-patch-save-arguments '(exclude "--stat")
|
||||
"Arguments used by `magit-patch-save-arguments' (which see)"
|
||||
:package-version '(magit . "2.12.0")
|
||||
:group 'magit-diff
|
||||
:type '(choice (const :tag "use buffer arguments" buffer)
|
||||
(cons :tag "use buffer arguments except"
|
||||
(const :format "" exclude)
|
||||
(repeat :format "%v%i\n"
|
||||
(string :tag "Argument")))
|
||||
(repeat :tag "use constant arguments"
|
||||
(string :tag "Argument"))))
|
||||
|
||||
(magit-define-popup magit-patch-apply-popup
|
||||
"Popup console for applying a patch file."
|
||||
:man-page "git-apply"
|
||||
:switches '((?i "Also apply to index" "--index")
|
||||
(?c "Only apply to index" "--cached")
|
||||
(?3 "Fall back on 3way merge" "--3way"))
|
||||
:actions '((?a "Apply patch" magit-patch-apply))
|
||||
:default-action 'magit-patch-apply)
|
||||
|
||||
(defun magit-patch-apply (file &rest args)
|
||||
"Apply the patch file FILE."
|
||||
(interactive (list (expand-file-name
|
||||
(read-file-name "Apply patch: "
|
||||
default-directory nil nil
|
||||
(--when-let (magit-file-at-point)
|
||||
(file-relative-name it))))
|
||||
(magit-patch-apply-arguments)))
|
||||
(magit-run-git "apply" args "--" (magit-convert-filename-for-git file)))
|
||||
|
||||
(defun magit-patch-save (file &optional arg)
|
||||
"Write current diff into patch FILE.
|
||||
|
||||
What arguments are used to create the patch depends on the value
|
||||
of `magit-patch-save-arguments' and whether a prefix argument is
|
||||
used.
|
||||
|
||||
If the value is the symbol `buffer', then use the same arguments
|
||||
as the buffer. With a prefix argument use no arguments.
|
||||
|
||||
If the value is a list beginning with the symbol `exclude', then
|
||||
use the same arguments as the buffer except for those matched by
|
||||
entries in the cdr of the list. The comparison is done using
|
||||
`string-prefix-p'. With a prefix argument use the same arguments
|
||||
as the buffer.
|
||||
|
||||
If the value is a list of strings (including the empty list),
|
||||
then use those arguments. With a prefix argument use the same
|
||||
arguments as the buffer.
|
||||
|
||||
Of course the arguments that are required to actually show the
|
||||
same differences as those shown in the buffer are always used."
|
||||
(interactive (list (read-file-name "Write patch file: " default-directory)
|
||||
current-prefix-arg))
|
||||
(unless (derived-mode-p 'magit-diff-mode)
|
||||
(user-error "Only diff buffers can be saved as patches"))
|
||||
(pcase-let ((`(,rev ,const ,args ,files) magit-refresh-args))
|
||||
(when (derived-mode-p 'magit-revision-mode)
|
||||
(setq rev (format "%s~..%s" rev rev)))
|
||||
(cond ((eq magit-patch-save-arguments 'buffer)
|
||||
(when arg
|
||||
(setq args nil)))
|
||||
((eq (car-safe magit-patch-save-arguments) 'exclude)
|
||||
(unless arg
|
||||
(setq args (-difference args (cdr magit-patch-save-arguments)))))
|
||||
((not arg)
|
||||
(setq args magit-patch-save-arguments)))
|
||||
(with-temp-file file
|
||||
(magit-git-insert "diff" rev "-p" const args "--" files)))
|
||||
(magit-refresh))
|
||||
|
||||
(provide 'magit-files)
|
||||
;;; magit-files.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,241 @@
|
|||
;;; magit-imenu.el --- Integrate Imenu in magit major modes -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Damien Cassou <damien@cassou.me>
|
||||
;; 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:
|
||||
|
||||
;; Emacs' major modes can facilitate navigation in their buffers by
|
||||
;; supporting Imenu. In such major modes, launching Imenu (M-x imenu)
|
||||
;; makes Emacs display a list of items (e.g., function definitions in
|
||||
;; a programming major mode). Selecting an item from this list moves
|
||||
;; point to this item.
|
||||
|
||||
;; magit-imenu.el adds Imenu support to every major mode in Magit
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'subr-x))
|
||||
|
||||
(require 'magit)
|
||||
(require 'git-rebase)
|
||||
|
||||
(defun magit-imenu--index-function (entry-types menu-types)
|
||||
"Return an alist of imenu entries in current buffer.
|
||||
|
||||
ENTRY-TYPES is a list of section types to be selected through
|
||||
`imenu'.
|
||||
|
||||
MENU-TYPES is a list of section types containing elements of
|
||||
ENTRY-TYPES. Elements of MENU-TYPES are are used to categories
|
||||
elements of ENTRY-TYPES.
|
||||
|
||||
This function is used as a helper for functions set as
|
||||
`imenu-create-index-function'."
|
||||
(let ((entries (make-hash-table :test 'equal)))
|
||||
(goto-char (point-max))
|
||||
(while (magit-section--backward-find
|
||||
(lambda ()
|
||||
(let* ((section (magit-current-section))
|
||||
(type (oref section type))
|
||||
(parent (oref section parent))
|
||||
(parent-type (oref parent type)))
|
||||
(and (-contains-p entry-types type)
|
||||
(-contains-p menu-types parent-type)))))
|
||||
(let* ((section (magit-current-section))
|
||||
(name (buffer-substring-no-properties
|
||||
(line-beginning-position)
|
||||
(line-end-position)))
|
||||
(parent (oref section parent))
|
||||
(parent-title (buffer-substring-no-properties
|
||||
(oref parent start)
|
||||
(1- (oref parent content)))))
|
||||
(puthash parent-title
|
||||
(cons (cons name (point))
|
||||
(gethash parent-title entries (list)))
|
||||
entries)))
|
||||
(mapcar (lambda (menu-title)
|
||||
(cons menu-title (gethash menu-title entries)))
|
||||
(hash-table-keys entries))))
|
||||
|
||||
;;; Log mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--log-prev-index-position-function ()
|
||||
"Move point to previous line in current buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(magit-section--backward-find
|
||||
(lambda ()
|
||||
(-contains-p '(commit stash)
|
||||
(oref (magit-current-section) type)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--log-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(save-match-data
|
||||
(looking-at "\\([^ ]+\\)[ *|]+\\(.+\\)$")
|
||||
(format "%s: %s"
|
||||
(match-string-no-properties 1)
|
||||
(match-string-no-properties 2))))
|
||||
|
||||
;;; Diff mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--diff-prev-index-position-function ()
|
||||
"Move point to previous file line in current buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(magit-section--backward-find
|
||||
(lambda ()
|
||||
(let ((section (magit-current-section)))
|
||||
(and (magit-file-section-p section)
|
||||
(not (equal (oref (oref section parent) type)
|
||||
'diffstat)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--diff-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(buffer-substring-no-properties (line-beginning-position)
|
||||
(line-end-position)))
|
||||
|
||||
;;; Status mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--status-create-index-function ()
|
||||
"Return an alist of all imenu entries in current buffer.
|
||||
This function is used as a value for
|
||||
`imenu-create-index-function'."
|
||||
(magit-imenu--index-function
|
||||
'(file commit stash)
|
||||
'(unpushed unstaged unpulled untracked staged stashes)))
|
||||
|
||||
;;;; Refs mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--refs-create-index-function ()
|
||||
"Return an alist of all imenu entries in current buffer.
|
||||
This function is used as a value for
|
||||
`imenu-create-index-function'."
|
||||
(magit-imenu--index-function
|
||||
'(branch commit tag)
|
||||
'(local remote tags)))
|
||||
|
||||
;;;; Cherry mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--cherry-create-index-function ()
|
||||
"Return an alist of all imenu entries in current buffer.
|
||||
This function is used as a value for
|
||||
`imenu-create-index-function'."
|
||||
(magit-imenu--index-function
|
||||
'(commit)
|
||||
'(cherries)))
|
||||
|
||||
;;;; Submodule list mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--submodule-prev-index-position-function ()
|
||||
"Move point to previous line in magit-submodule-list buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(unless (bobp)
|
||||
(forward-line -1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--submodule-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(elt (tabulated-list-get-entry) 0))
|
||||
|
||||
;;;; Repolist mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--repolist-prev-index-position-function ()
|
||||
"Move point to previous line in magit-repolist buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(unless (bobp)
|
||||
(forward-line -1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--repolist-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(let ((entry (tabulated-list-get-entry)))
|
||||
(format "%s (%s)"
|
||||
(elt entry 0)
|
||||
(elt entry (1- (length entry))))))
|
||||
|
||||
;;;; Process mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--process-prev-index-position-function ()
|
||||
"Move point to previous process in magit-process buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(magit-section--backward-find
|
||||
(lambda ()
|
||||
(eq (oref (magit-current-section) type) 'process))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--process-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(buffer-substring-no-properties (line-beginning-position)
|
||||
(line-end-position)))
|
||||
|
||||
;;;; Rebase mode
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--rebase-prev-index-position-function ()
|
||||
"Move point to previous commit in git-rebase buffer.
|
||||
This function is used as a value for
|
||||
`imenu-prev-index-position-function'."
|
||||
(catch 'found
|
||||
(while (not (bobp))
|
||||
(git-rebase-backward-line)
|
||||
(when (git-rebase-line-p)
|
||||
(throw 'found t)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-imenu--rebase-extract-index-name-function ()
|
||||
"Return imenu name for line at point.
|
||||
This function is used as a value for
|
||||
`imenu-extract-index-name-function'. Point should be at the
|
||||
beginning of the line."
|
||||
(buffer-substring-no-properties (line-beginning-position)
|
||||
(line-end-position)))
|
||||
|
||||
(provide 'magit-imenu)
|
||||
;;; magit-imenu.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,240 @@
|
|||
;;; magit-margin.el --- margins in Magit buffers -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements support for showing additional information
|
||||
;; in the margins of Magit buffers. Currently this is only used for
|
||||
;; commits, for which the committer date or age, and optionally the
|
||||
;; author name are shown.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
|
||||
(require 'magit-section)
|
||||
(require 'magit-mode)
|
||||
|
||||
(defgroup magit-margin nil
|
||||
"Information Magit displays in the margin.
|
||||
|
||||
You can change the STYLE and AUTHOR-WIDTH of all `magit-*-margin'
|
||||
options to the same values by customizing `magit-log-margin'
|
||||
*before* `magit' is loaded. If you do that, then the respective
|
||||
values for the other options will default to what you have set
|
||||
for that variable. Likewise if you set `magit-log-margin's INIT
|
||||
to nil, then that is used in the default of all other options. But
|
||||
setting it to t, i.e. re-enforcing the default for that option,
|
||||
does not carry to other options."
|
||||
:link '(info-link "(magit)Log Margin")
|
||||
:group 'magit-log)
|
||||
|
||||
(defvar-local magit-buffer-margin nil)
|
||||
(put 'magit-buffer-margin 'permanent-local t)
|
||||
|
||||
(defvar-local magit-set-buffer-margin-refresh nil)
|
||||
|
||||
(defvar magit--age-spec)
|
||||
|
||||
;;; Commands
|
||||
|
||||
(magit-define-popup magit-margin-popup
|
||||
"Popup console for changing appearance of the margin."
|
||||
:actions '("Margin"
|
||||
(?L "Toggle visibility" magit-toggle-margin)
|
||||
(?l "Cycle style" magit-cycle-margin-style)
|
||||
(?d "Toggle details" magit-toggle-margin-details)
|
||||
(lambda ()
|
||||
(and (with-current-buffer magit-pre-popup-buffer
|
||||
(derived-mode-p 'magit-refs-mode))
|
||||
(propertize "Left edge" 'face 'magit-popup-heading)))
|
||||
(?v "Change verbosity" magit-refs-set-show-commit-count))
|
||||
:max-action-columns 1)
|
||||
|
||||
(defun magit-toggle-margin ()
|
||||
"Show or hide the Magit margin."
|
||||
(interactive)
|
||||
(unless (magit-margin-option)
|
||||
(user-error "Magit margin isn't supported in this buffer"))
|
||||
(setcar magit-buffer-margin (not (magit-buffer-margin-p)))
|
||||
(magit-set-buffer-margin))
|
||||
|
||||
(defun magit-cycle-margin-style ()
|
||||
"Cycle style used for the Magit margin."
|
||||
(interactive)
|
||||
(unless (magit-margin-option)
|
||||
(user-error "Magit margin isn't supported in this buffer"))
|
||||
;; This is only suitable for commit margins (there are not others).
|
||||
(setf (cadr magit-buffer-margin)
|
||||
(pcase (cadr magit-buffer-margin)
|
||||
(`age 'age-abbreviated)
|
||||
(`age-abbreviated
|
||||
(let ((default (cadr (symbol-value (magit-margin-option)))))
|
||||
(if (stringp default) default "%Y-%m-%d %H:%M ")))
|
||||
(_ 'age)))
|
||||
(magit-set-buffer-margin nil t))
|
||||
|
||||
(defun magit-toggle-margin-details ()
|
||||
"Show or hide details in the Magit margin."
|
||||
(interactive)
|
||||
(unless (magit-margin-option)
|
||||
(user-error "Magit margin isn't supported in this buffer"))
|
||||
(setf (nth 3 magit-buffer-margin)
|
||||
(not (nth 3 magit-buffer-margin)))
|
||||
(magit-set-buffer-margin nil t))
|
||||
|
||||
;;; Core
|
||||
|
||||
(defun magit-buffer-margin-p ()
|
||||
(car magit-buffer-margin))
|
||||
|
||||
(defun magit-margin-option ()
|
||||
(pcase major-mode
|
||||
(`magit-cherry-mode 'magit-cherry-margin)
|
||||
(`magit-log-mode 'magit-log-margin)
|
||||
(`magit-log-select-mode 'magit-log-select-margin)
|
||||
(`magit-reflog-mode 'magit-reflog-margin)
|
||||
(`magit-refs-mode 'magit-refs-margin)
|
||||
(`magit-stashes-mode 'magit-stashes-margin)
|
||||
(`magit-status-mode 'magit-status-margin)))
|
||||
|
||||
(defun magit-set-buffer-margin (&optional reset refresh)
|
||||
(when-let ((option (magit-margin-option)))
|
||||
(let* ((default (symbol-value option))
|
||||
(default-width (nth 2 default)))
|
||||
(when (or reset (not magit-buffer-margin))
|
||||
(setq magit-buffer-margin (copy-sequence default)))
|
||||
(pcase-let ((`(,enable ,style ,_width ,details ,details-width)
|
||||
magit-buffer-margin))
|
||||
(when (functionp default-width)
|
||||
(setf (nth 2 magit-buffer-margin)
|
||||
(funcall default-width style details details-width)))
|
||||
(dolist (window (get-buffer-window-list nil nil 0))
|
||||
(with-selected-window window
|
||||
(magit-set-window-margin window)
|
||||
(if enable
|
||||
(add-hook 'window-configuration-change-hook
|
||||
'magit-set-window-margin nil t)
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
'magit-set-window-margin t))))
|
||||
(when (and enable (or refresh magit-set-buffer-margin-refresh))
|
||||
(magit-refresh-buffer))))))
|
||||
|
||||
(defun magit-set-window-margin (&optional window)
|
||||
(when (or window (setq window (get-buffer-window)))
|
||||
(with-selected-window window
|
||||
(set-window-margins
|
||||
nil (car (window-margins))
|
||||
(and (magit-buffer-margin-p)
|
||||
(if (bound-and-true-p magit-log-margin-show-shortstat)
|
||||
16 ; kludge
|
||||
(nth 2 magit-buffer-margin)))))))
|
||||
|
||||
(defun magit-make-margin-overlay (&optional string previous-line)
|
||||
(if previous-line
|
||||
(save-excursion
|
||||
(forward-line -1)
|
||||
(magit-make-margin-overlay string))
|
||||
;; Don't put the overlay on the complete line to work around #1880.
|
||||
(let ((o (make-overlay (1+ (line-beginning-position))
|
||||
(line-end-position)
|
||||
nil t)))
|
||||
(overlay-put o 'evaporate t)
|
||||
(overlay-put o 'before-string
|
||||
(propertize "o" 'display
|
||||
(list (list 'margin 'right-margin)
|
||||
(or string " ")))))))
|
||||
|
||||
(defun magit-maybe-make-margin-overlay ()
|
||||
(when (or (magit-section-match
|
||||
'(unpulled unpushed recent stashes local cherries)
|
||||
magit-insert-section--current)
|
||||
(and (eq major-mode 'magit-refs-mode)
|
||||
(magit-section-match
|
||||
'(remote commit tags)
|
||||
magit-insert-section--current)))
|
||||
(magit-make-margin-overlay nil t)))
|
||||
|
||||
;;; Custom Support
|
||||
|
||||
(defun magit-margin-set-variable (mode symbol value)
|
||||
(set-default symbol value)
|
||||
(message "Updating margins in %s buffers..." mode)
|
||||
(dolist (buffer (buffer-list))
|
||||
(with-current-buffer buffer
|
||||
(when (eq major-mode mode)
|
||||
(magit-set-buffer-margin t)
|
||||
(magit-refresh))))
|
||||
(message "Updating margins in %s buffers...done" mode))
|
||||
|
||||
(defconst magit-log-margin--custom-type
|
||||
'(list (boolean :tag "Show margin initially")
|
||||
(choice :tag "Show committer"
|
||||
(string :tag "date using time-format" "%Y-%m-%d %H:%M ")
|
||||
(const :tag "date's age" age)
|
||||
(const :tag "date's age (abbreviated)" age-abbreviated))
|
||||
(const :tag "Calculate width using magit-log-margin-width"
|
||||
magit-log-margin-width)
|
||||
(boolean :tag "Show author name by default")
|
||||
(integer :tag "Show author name using width")))
|
||||
|
||||
;;; Time Utilities
|
||||
|
||||
(defvar magit--age-spec
|
||||
`((?Y "year" "years" ,(round (* 60 60 24 365.2425)))
|
||||
(?M "month" "months" ,(round (* 60 60 24 30.436875)))
|
||||
(?w "week" "weeks" ,(* 60 60 24 7))
|
||||
(?d "day" "days" ,(* 60 60 24))
|
||||
(?h "hour" "hours" ,(* 60 60))
|
||||
(?m "minute" "minutes" 60)
|
||||
(?s "second" "seconds" 1))
|
||||
"Time units used when formatting relative commit ages.
|
||||
|
||||
The value is a list of time units, beginning with the longest.
|
||||
Each element has the form (CHAR UNIT UNITS SECONDS). UNIT is the
|
||||
time unit, UNITS is the plural of that unit. CHAR is a character
|
||||
abbreviation. And SECONDS is the number of seconds in one UNIT.
|
||||
|
||||
This is defined as a variable to make it possible to use time
|
||||
units for a language other than English. It is not defined
|
||||
as an option, because most other parts of Magit are always in
|
||||
English.")
|
||||
|
||||
(defun magit--age (date &optional abbreviate)
|
||||
(cl-labels ((fn (age spec)
|
||||
(pcase-let ((`(,char ,unit ,units ,weight) (car spec)))
|
||||
(let ((cnt (round (/ age weight 1.0))))
|
||||
(if (or (not (cdr spec))
|
||||
(>= (/ age weight) 1))
|
||||
(list cnt (cond (abbreviate char)
|
||||
((= cnt 1) unit)
|
||||
(t units)))
|
||||
(fn age (cdr spec)))))))
|
||||
(fn (abs (- (float-time)
|
||||
(if (stringp date)
|
||||
(string-to-number date)
|
||||
date)))
|
||||
magit--age-spec)))
|
||||
|
||||
(provide 'magit-margin)
|
||||
;;; magit-margin.el ends here
|
Binary file not shown.
|
@ -0,0 +1,279 @@
|
|||
;;; magit-merge.el --- merge functionality -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements merge commands.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload (autoload 'magit-merge-popup "magit" nil t)
|
||||
(magit-define-popup magit-merge-popup
|
||||
"Popup console for merge commands."
|
||||
:man-page "git-merge"
|
||||
:switches '((?f "Fast-forward only" "--ff-only")
|
||||
(?n "No fast-forward" "--no-ff"))
|
||||
:options '((?s "Strategy" "--strategy="))
|
||||
:actions '((?m "Merge" magit-merge)
|
||||
(?p "Preview merge" magit-merge-preview)
|
||||
(?e "Merge and edit message" magit-merge-editmsg) nil
|
||||
(?n "Merge but don't commit" magit-merge-nocommit)
|
||||
(?s "Squash merge" magit-merge-squash)
|
||||
(?a "Absorb" magit-merge-absorb)
|
||||
(?i "Merge into" magit-merge-into))
|
||||
:sequence-actions '((?m "Commit merge" magit-commit)
|
||||
(?a "Abort merge" magit-merge-abort))
|
||||
:sequence-predicate 'magit-merge-in-progress-p
|
||||
:default-action 'magit-merge
|
||||
:max-action-columns 2)
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge (rev &optional args nocommit)
|
||||
"Merge commit REV into the current branch; using default message.
|
||||
|
||||
Unless there are conflicts or a prefix argument is used create a
|
||||
merge commit using a generic commit message and without letting
|
||||
the user inspect the result. With a prefix argument pretend the
|
||||
merge failed to give the user the opportunity to inspect the
|
||||
merge.
|
||||
|
||||
\(git merge --no-edit|--no-commit [ARGS] REV)"
|
||||
(interactive (list (magit-read-other-branch-or-commit "Merge")
|
||||
(magit-merge-arguments)
|
||||
current-prefix-arg))
|
||||
(magit-merge-assert)
|
||||
(magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-editmsg (rev &optional args)
|
||||
"Merge commit REV into the current branch; and edit message.
|
||||
Perform the merge and prepare a commit message but let the user
|
||||
edit it.
|
||||
\n(git merge --edit --no-ff [ARGS] REV)"
|
||||
(interactive (list (magit-read-other-branch-or-commit "Merge")
|
||||
(magit-merge-arguments)))
|
||||
(magit-merge-assert)
|
||||
(cl-pushnew "--no-ff" args :test #'equal)
|
||||
(apply #'magit-run-git-with-editor "merge" "--edit"
|
||||
(append args (list rev))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-nocommit (rev &optional args)
|
||||
"Merge commit REV into the current branch; pretending it failed.
|
||||
Pretend the merge failed to give the user the opportunity to
|
||||
inspect the merge and change the commit message.
|
||||
\n(git merge --no-commit --no-ff [ARGS] REV)"
|
||||
(interactive (list (magit-read-other-branch-or-commit "Merge")
|
||||
(magit-merge-arguments)))
|
||||
(magit-merge-assert)
|
||||
(cl-pushnew "--no-ff" args :test #'equal)
|
||||
(magit-run-git-async "merge" "--no-commit" args rev))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-into (branch &optional args)
|
||||
"Merge the current branch into BRANCH and remove the former.
|
||||
|
||||
Before merging, force push the source branch to its push-remote,
|
||||
provided the respective remote branch already exists, ensuring
|
||||
that the respective pull-request (if any) won't get stuck on some
|
||||
obsolete version of the commits that are being merged. Finally
|
||||
if `magit-branch-pull-request' was used to create the merged
|
||||
branch, then also remove the respective remote branch."
|
||||
(interactive
|
||||
(list (magit-read-other-local-branch
|
||||
(format "Merge `%s' into" (magit-get-current-branch))
|
||||
nil
|
||||
(when-let ((upstream (magit-get-upstream-branch)))
|
||||
(when-let ((upstream (cdr (magit-split-branch-name upstream))))
|
||||
(and (magit-branch-p upstream) upstream))))
|
||||
(magit-merge-arguments)))
|
||||
(let ((current (magit-get-current-branch)))
|
||||
(when (zerop (magit-call-git "checkout" branch))
|
||||
(magit--merge-absort current args))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-absorb (branch &optional args)
|
||||
"Merge BRANCH into the current branch and remove the former.
|
||||
|
||||
Before merging, force push the source branch to its push-remote,
|
||||
provided the respective remote branch already exists, ensuring
|
||||
that the respective pull-request (if any) won't get stuck on some
|
||||
obsolete version of the commits that are being merged. Finally
|
||||
if `magit-branch-pull-request' was used to create the merged
|
||||
branch, then also remove the respective remote branch."
|
||||
(interactive (list (magit-read-other-local-branch "Absorb branch")
|
||||
(magit-merge-arguments)))
|
||||
(magit--merge-absort branch args))
|
||||
|
||||
(defun magit--merge-absort (branch args)
|
||||
(when (equal branch "master")
|
||||
(unless (yes-or-no-p
|
||||
"Do you really want to to merge `master' into another branch? ")
|
||||
(user-error "Abort")))
|
||||
(if-let ((target (magit-get-push-branch branch t)))
|
||||
(progn
|
||||
(magit-git-push branch target (list "--force-with-lease"))
|
||||
(set-process-sentinel
|
||||
magit-this-process
|
||||
(lambda (process event)
|
||||
(when (memq (process-status process) '(exit signal))
|
||||
(if (not (zerop (process-exit-status process)))
|
||||
(magit-process-sentinel process event)
|
||||
(process-put process 'inhibit-refresh t)
|
||||
(magit-process-sentinel process event)
|
||||
(magit--merge-absort-1 branch args))))))
|
||||
(magit--merge-absort-1 branch args)))
|
||||
|
||||
(defun magit--merge-absort-1 (branch args)
|
||||
(magit-run-git-async "merge" args "--no-edit" branch)
|
||||
(set-process-sentinel
|
||||
magit-this-process
|
||||
(lambda (process event)
|
||||
(when (memq (process-status process) '(exit signal))
|
||||
(if (> (process-exit-status process) 0)
|
||||
(magit-process-sentinel process event)
|
||||
(process-put process 'inhibit-refresh t)
|
||||
(magit-process-sentinel process event)
|
||||
(magit-branch-maybe-delete-pr-remote branch)
|
||||
(magit-branch-unset-pushRemote branch)
|
||||
(magit-run-git "branch" "-D" branch))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-squash (rev)
|
||||
"Squash commit REV into the current branch; don't create a commit.
|
||||
\n(git merge --squash REV)"
|
||||
(interactive (list (magit-read-other-branch-or-commit "Squash")))
|
||||
(magit-merge-assert)
|
||||
(magit-run-git-async "merge" "--squash" rev))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-preview (rev)
|
||||
"Preview result of merging REV into the current branch."
|
||||
(interactive (list (magit-read-other-branch-or-commit "Preview merge")))
|
||||
(magit-mode-setup #'magit-merge-preview-mode rev))
|
||||
|
||||
(define-derived-mode magit-merge-preview-mode magit-diff-mode "Magit Merge"
|
||||
"Mode for previewing a merge."
|
||||
:group 'magit-diff
|
||||
(hack-dir-local-variables-non-file-buffer))
|
||||
|
||||
(defun magit-merge-preview-refresh-buffer (rev)
|
||||
(let* ((branch (magit-get-current-branch))
|
||||
(head (or branch (magit-rev-verify "HEAD"))))
|
||||
(magit-set-header-line-format (format "Preview merge of %s into %s"
|
||||
rev
|
||||
(or branch "HEAD")))
|
||||
(magit-insert-section (diffbuf)
|
||||
(magit-git-wash #'magit-diff-wash-diffs
|
||||
"merge-tree" (magit-git-string "merge-base" head rev) head rev))))
|
||||
|
||||
;;;###autoload
|
||||
(defun magit-merge-abort ()
|
||||
"Abort the current merge operation.
|
||||
\n(git merge --abort)"
|
||||
(interactive)
|
||||
(unless (file-exists-p (magit-git-dir "MERGE_HEAD"))
|
||||
(user-error "No merge in progress"))
|
||||
(magit-confirm 'abort-merge)
|
||||
(magit-run-git-async "merge" "--abort"))
|
||||
|
||||
(defun magit-checkout-stage (file arg)
|
||||
"During a conflict checkout and stage side, or restore conflict."
|
||||
(interactive
|
||||
(let ((file (magit-completing-read "Checkout file"
|
||||
(magit-tracked-files) nil nil nil
|
||||
'magit-read-file-hist
|
||||
(magit-current-file))))
|
||||
(cond ((member file (magit-unmerged-files))
|
||||
(list file (magit-checkout-read-stage file)))
|
||||
((yes-or-no-p (format "Restore conflicts in %s? " file))
|
||||
(list file "--merge"))
|
||||
(t
|
||||
(user-error "Quit")))))
|
||||
(pcase (cons arg (cddr (car (magit-file-status file))))
|
||||
((or `("--ours" ?D ,_)
|
||||
`("--theirs" ,_ ?D))
|
||||
(magit-run-git "rm" "--" file))
|
||||
(_ (if (equal arg "--merge")
|
||||
;; This fails if the file was deleted on one
|
||||
;; side. And we cannot do anything about it.
|
||||
(magit-run-git "checkout" "--merge" "--" file)
|
||||
(magit-call-git "checkout" arg "--" file)
|
||||
(magit-run-git "add" "-u" "--" file)))))
|
||||
|
||||
;;; Utilities
|
||||
|
||||
(defun magit-merge-in-progress-p ()
|
||||
(file-exists-p (magit-git-dir "MERGE_HEAD")))
|
||||
|
||||
(defun magit--merge-range (&optional head)
|
||||
(unless head
|
||||
(setq head (magit-get-shortname
|
||||
(car (magit-file-lines (magit-git-dir "MERGE_HEAD"))))))
|
||||
(and head
|
||||
(concat (magit-git-string "merge-base" "--octopus" "HEAD" head)
|
||||
".." head)))
|
||||
|
||||
(defun magit-merge-assert ()
|
||||
(or (not (magit-anything-modified-p t))
|
||||
(magit-confirm 'merge-dirty
|
||||
"Merging with dirty worktree is risky. Continue")))
|
||||
|
||||
(defun magit-checkout-read-stage (file)
|
||||
(magit-read-char-case (format "For %s checkout: " file) t
|
||||
(?o "[o]ur stage" "--ours")
|
||||
(?t "[t]heir stage" "--theirs")
|
||||
(?c "[c]onflict" "--merge")))
|
||||
|
||||
;;; Sections
|
||||
|
||||
(defvar magit-unmerged-section-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [remap magit-visit-thing] 'magit-diff-dwim)
|
||||
map)
|
||||
"Keymap for `unmerged' sections.")
|
||||
|
||||
(defun magit-insert-merge-log ()
|
||||
"Insert section for the on-going merge.
|
||||
Display the heads that are being merged.
|
||||
If no merge is in progress, do nothing."
|
||||
(when (magit-merge-in-progress-p)
|
||||
(let* ((heads (mapcar #'magit-get-shortname
|
||||
(magit-file-lines (magit-git-dir "MERGE_HEAD"))))
|
||||
(range (magit--merge-range (car heads))))
|
||||
(magit-insert-section (unmerged range)
|
||||
(magit-insert-heading
|
||||
(format "Merging %s:" (mapconcat #'identity heads ", ")))
|
||||
(magit-insert-log
|
||||
range
|
||||
(let ((args magit-log-section-arguments))
|
||||
(unless (member "--decorate=full" magit-log-section-arguments)
|
||||
(push "--decorate=full" args))
|
||||
args))))))
|
||||
|
||||
(provide 'magit-merge)
|
||||
;;; magit-merge.el ends here
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1,201 @@
|
|||
;;; magit-notes.el --- notes support -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library implements support for `git-notes'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
;;; Popup
|
||||
|
||||
;;;###autoload (autoload 'magit-notes-popup "magit" nil t)
|
||||
(magit-define-popup magit-notes-popup
|
||||
"Popup console for notes commands."
|
||||
:man-page "git-notes"
|
||||
:variables '("Configure local settings"
|
||||
(?c "core.notesRef"
|
||||
magit-set-core.notesRef
|
||||
magit-format-core.notesRef)
|
||||
(?d "notes.displayRef"
|
||||
magit-set-notes.displayRef
|
||||
magit-format-notes.displayRef)
|
||||
"Configure global settings"
|
||||
(?C "core.notesRef"
|
||||
magit-set-global-core.notesRef
|
||||
magit-format-global-core.notesRef)
|
||||
(?D "notes.displayRef"
|
||||
magit-set-global-notes.displayRef
|
||||
magit-format-global-notes.displayRef))
|
||||
:switches '("Switch for prune"
|
||||
(?n "Dry run" "--dry-run"))
|
||||
:options '("Option for edit and remove"
|
||||
(?r "Manipulate ref" "--ref=" magit-notes-popup-read-ref)
|
||||
"Option for merge"
|
||||
(?s "Merge strategy" "--strategy="))
|
||||
:actions '((?T "Edit" magit-notes-edit)
|
||||
(?r "Remove" magit-notes-remove)
|
||||
(?m "Merge" magit-notes-merge)
|
||||
(?p "Prune" magit-notes-prune))
|
||||
:sequence-actions '((?c "Commit merge" magit-notes-merge-commit)
|
||||
(?a "Abort merge" magit-notes-merge-abort))
|
||||
:sequence-predicate 'magit-notes-merging-p
|
||||
:default-action 'magit-notes-edit)
|
||||
|
||||
(defun magit-notes-merging-p ()
|
||||
(let ((dir (magit-git-dir "NOTES_MERGE_WORKTREE")))
|
||||
(and (file-directory-p dir)
|
||||
(directory-files dir nil "^[^.]"))))
|
||||
|
||||
(defun magit-format-core.notesRef ()
|
||||
(magit--format-popup-variable:value "core.notesRef" 22))
|
||||
|
||||
(defun magit-format-notes.displayRef ()
|
||||
(magit--format-popup-variable:values "notes.displayRef" 22))
|
||||
|
||||
(defun magit-format-global-core.notesRef ()
|
||||
(magit--format-popup-variable:value "core.notesRef" 22 t))
|
||||
|
||||
(defun magit-format-global-notes.displayRef ()
|
||||
(magit--format-popup-variable:values "notes.displayRef" 22 t))
|
||||
|
||||
;;; Commands
|
||||
|
||||
(defun magit-notes-edit (commit &optional ref)
|
||||
"Edit the note attached to COMMIT.
|
||||
REF is the notes ref used to store the notes.
|
||||
|
||||
Interactively or when optional REF is nil use the value of Git
|
||||
variable `core.notesRef' or \"refs/notes/commits\" if that is
|
||||
undefined."
|
||||
(interactive (magit-notes-read-args "Edit notes"))
|
||||
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
|
||||
"edit" commit))
|
||||
|
||||
(defun magit-notes-remove (commit &optional ref)
|
||||
"Remove the note attached to COMMIT.
|
||||
REF is the notes ref from which the note is removed.
|
||||
|
||||
Interactively or when optional REF is nil use the value of Git
|
||||
variable `core.notesRef' or \"refs/notes/commits\" if that is
|
||||
undefined."
|
||||
(interactive (magit-notes-read-args "Remove notes"))
|
||||
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
|
||||
"remove" commit))
|
||||
|
||||
(defun magit-notes-merge (ref)
|
||||
"Merge the notes ref REF into the current notes ref.
|
||||
|
||||
The current notes ref is the value of Git variable
|
||||
`core.notesRef' or \"refs/notes/commits\" if that is undefined.
|
||||
|
||||
When there are conflicts, then they have to be resolved in the
|
||||
temporary worktree \".git/NOTES_MERGE_WORKTREE\". When
|
||||
done use `magit-notes-merge-commit' to finish. To abort
|
||||
use `magit-notes-merge-abort'."
|
||||
(interactive (list (magit-read-string-ns "Merge reference")))
|
||||
(magit-run-git-with-editor "notes" "merge" ref))
|
||||
|
||||
(defun magit-notes-merge-commit ()
|
||||
"Commit the current notes ref merge.
|
||||
Also see `magit-notes-merge'."
|
||||
(interactive)
|
||||
(magit-run-git-with-editor "notes" "merge" "--commit"))
|
||||
|
||||
(defun magit-notes-merge-abort ()
|
||||
"Abort the current notes ref merge.
|
||||
Also see `magit-notes-merge'."
|
||||
(interactive)
|
||||
(magit-run-git-with-editor "notes" "merge" "--abort"))
|
||||
|
||||
(defun magit-notes-prune (&optional dry-run)
|
||||
"Remove notes about unreachable commits."
|
||||
(interactive (list (and (member "--dry-run" (magit-notes-arguments)) t)))
|
||||
(when dry-run
|
||||
(magit-process-buffer))
|
||||
(magit-run-git-with-editor "notes" "prune" (and dry-run "--dry-run")))
|
||||
|
||||
(defun magit-set-core.notesRef (ref)
|
||||
"Set the local value of `core.notesRef' to REF."
|
||||
(interactive (list (magit-notes-read-ref "Set local core.notesRef")))
|
||||
(magit-set ref "core.notesRef")
|
||||
(magit-with-pre-popup-buffer
|
||||
(magit-refresh)))
|
||||
|
||||
(defun magit-set-global-core.notesRef (ref)
|
||||
"Set the global value of `core.notesRef' to REF."
|
||||
(interactive (list (magit-notes-read-ref "Set global core.notesRef")))
|
||||
(magit-set ref "--global" "core.notesRef")
|
||||
(magit-with-pre-popup-buffer
|
||||
(magit-refresh)))
|
||||
|
||||
(defun magit-set-notes.displayRef (refs)
|
||||
"Set the local values of `notes.displayRef' to REFS."
|
||||
(interactive (list (magit-notes-read-refs "Set local notes.displayRef")))
|
||||
(magit-set-all refs "notes.displayRef")
|
||||
(magit-with-pre-popup-buffer
|
||||
(magit-refresh)))
|
||||
|
||||
(defun magit-set-global-notes.displayRef (refs)
|
||||
"Set the global values of `notes.displayRef' to REFS."
|
||||
(interactive (list (magit-notes-read-refs "Set global notes.displayRef")))
|
||||
(magit-set-all refs "--global" "notes.displayRef")
|
||||
(magit-with-pre-popup-buffer
|
||||
(magit-refresh)))
|
||||
|
||||
(defun magit-notes-read-ref (prompt)
|
||||
(--when-let (magit-completing-read
|
||||
prompt (magit-list-notes-refnames) nil nil
|
||||
(--when-let (magit-get "core.notesRef")
|
||||
(if (string-prefix-p "refs/notes/" it)
|
||||
(substring it 11)
|
||||
it)))
|
||||
(if (string-prefix-p "refs/" it)
|
||||
it
|
||||
(concat "refs/notes/" it))))
|
||||
|
||||
(defun magit-notes-read-refs (prompt)
|
||||
(mapcar (lambda (ref)
|
||||
(if (string-prefix-p "refs/" ref)
|
||||
ref
|
||||
(concat "refs/notes/" ref)))
|
||||
(completing-read-multiple
|
||||
(concat prompt ": ")
|
||||
(magit-list-notes-refnames) nil nil
|
||||
(mapconcat (lambda (ref)
|
||||
(if (string-prefix-p "refs/notes/" ref)
|
||||
(substring ref 11)
|
||||
ref))
|
||||
(magit-get-all "notes.displayRef")
|
||||
","))))
|
||||
|
||||
(defun magit-notes-read-args (prompt)
|
||||
(list (magit-read-branch-or-commit prompt (magit-stash-at-point))
|
||||
(--when-let (--first (string-match "^--ref=\\(.+\\)" it)
|
||||
(magit-notes-arguments))
|
||||
(match-string 1 it))))
|
||||
|
||||
(provide 'magit-notes)
|
||||
;;; magit-notes.el ends here
|
Binary file not shown.
|
@ -0,0 +1,33 @@
|
|||
;;; magit-obsolete.el --- obsolete definitions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
||||
;;
|
||||
;; You should have received a copy of the AUTHORS.md file which
|
||||
;; lists all contributors. If not, see http://magit.vc/authors.
|
||||
|
||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
||||
;; 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 library defines aliases for obsolete variables and functions.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit)
|
||||
|
||||
(provide 'magit-obsolete)
|
||||
;;; magit-obsolete.el ends here
|
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue