import sublime and vscode settings

weechat-localhost
Ben Harris 2018-10-01 00:51:07 -04:00
parent 54ed1fc297
commit db4a4fa9b7
No known key found for this signature in database
GPG Key ID: 4E0AF802FFF7960C
337 changed files with 74417 additions and 36 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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:

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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.

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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:

View File

@ -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

View File

@ -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.

View File

@ -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.

View File

@ -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.

View File

@ -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

View File

@ -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")

View File

@ -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.

View File

@ -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

View File

@ -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")

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"))

View File

@ -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 dont 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

View File

@ -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>

View File

@ -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>.

View File

@ -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.

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

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