mirror of
				https://tildegit.org/ben/dotfiles.git
				synced 2025-08-10 05:02:03 +00:00 
			
		
		
		
	add fzf submodule, remove emacs
This commit is contained in:
		
							parent
							
								
									aa5b71e0aa
								
							
						
					
					
						commit
						b7fcdf410b
					
				
							
								
								
									
										6
									
								
								.gitmodules
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										6
									
								
								.gitmodules
									
									
									
									
										vendored
									
									
								
							@ -2,9 +2,6 @@
 | 
			
		||||
	path = fish/.config/fish/nvm-wrapper
 | 
			
		||||
	url = https://github.com/passcod/nvm-fish-wrapper
 | 
			
		||||
 | 
			
		||||
[submodule "emacs/.emacs.d/evil"]
 | 
			
		||||
	path = emacs/.emacs.d/evil
 | 
			
		||||
	url = https://github.com/emacs-evil/evil
 | 
			
		||||
[submodule "vim/.vim/bundle/quick-scope"]
 | 
			
		||||
	path = vim/.vim/bundle/quick-scope
 | 
			
		||||
	url = https://github.com/unblevable/quick-scope
 | 
			
		||||
@ -20,3 +17,6 @@
 | 
			
		||||
[submodule "vim/.vim/bundle/vim-gitgutter"]
 | 
			
		||||
	path = vim/.vim/bundle/vim-gitgutter
 | 
			
		||||
	url = https://github.com/airblade/vim-gitgutter
 | 
			
		||||
[submodule "fzf/.fzf"]
 | 
			
		||||
	path = fzf/.fzf
 | 
			
		||||
	url = https://github.com/junegunn/fzf
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										16
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								Makefile
									
									
									
									
									
								
							@ -16,7 +16,7 @@ endif
 | 
			
		||||
install:
 | 
			
		||||
	@make $(UNAME)
 | 
			
		||||
 | 
			
		||||
Linux: bash fish git mutt byobu weechat vim nvim gnupg bin emacs vscode sublime
 | 
			
		||||
Linux: bash fzf fish git mutt byobu weechat vim nvim gnupg bin emacs vscode sublime
 | 
			
		||||
Windows: bash git vim
 | 
			
		||||
Other: bash git vim
 | 
			
		||||
 | 
			
		||||
@ -25,7 +25,6 @@ clean:
 | 
			
		||||
	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 gnupg
 | 
			
		||||
@ -48,15 +47,16 @@ 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
 | 
			
		||||
 | 
			
		||||
fzf:
 | 
			
		||||
	@printf "$(YELLOW)--- fzf ------------------------------------------------\n$(RESET)"
 | 
			
		||||
	git submodule update --init -- fzf/.fzf
 | 
			
		||||
	stow -t "$$HOME" fzf
 | 
			
		||||
	~/.fzf/install
 | 
			
		||||
 | 
			
		||||
git:
 | 
			
		||||
	@printf "$(YELLOW)--- git ------------------------------------------------\n$(RESET)"
 | 
			
		||||
	stow -t "$$HOME" git
 | 
			
		||||
@ -92,4 +92,4 @@ 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
 | 
			
		||||
.PHONY: bash fzf fish git vim nvim mutt byobu weechat gnupg bin vscode sublime clean install Windows Linux Other
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										22
									
								
								emacs/.emacs
									
									
									
									
									
								
							
							
						
						
									
										22
									
								
								emacs/.emacs
									
									
									
									
									
								
							@ -1,22 +0,0 @@
 | 
			
		||||
(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
											
										
									
								
							@ -1 +0,0 @@
 | 
			
		||||
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
											
										
									
								
							@ -1,158 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,219 +0,0 @@
 | 
			
		||||
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
;; Authors: John Wiegley <jwiegley@gmail.com>
 | 
			
		||||
;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
 | 
			
		||||
 | 
			
		||||
;; Keywords: dired async byte-compile
 | 
			
		||||
;; X-URL: https://github.com/jwiegley/dired-async
 | 
			
		||||
 | 
			
		||||
;; This program is free software; you can redistribute it and/or
 | 
			
		||||
;; modify it under the terms of the GNU General Public License as
 | 
			
		||||
;; published by the Free Software Foundation; either version 2, or (at
 | 
			
		||||
;; your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; This program is distributed in the hope that it will be useful, but
 | 
			
		||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
			
		||||
;; General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 | 
			
		||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 | 
			
		||||
;; Boston, MA 02111-1307, USA.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
;;
 | 
			
		||||
;;  This package provide the `async-byte-recompile-directory' function
 | 
			
		||||
;;  which allows, as the name says to recompile a directory outside of
 | 
			
		||||
;;  your running emacs.
 | 
			
		||||
;;  The benefit is your files will be compiled in a clean environment without
 | 
			
		||||
;;  the old *.el files loaded.
 | 
			
		||||
;;  Among other things, this fix a bug in package.el which recompile
 | 
			
		||||
;;  the new files in the current environment with the old files loaded, creating
 | 
			
		||||
;;  errors in most packages after upgrades.
 | 
			
		||||
;;
 | 
			
		||||
;;  NB: This package is advicing the function `package--compile'.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'cl-lib)
 | 
			
		||||
(require 'async)
 | 
			
		||||
 | 
			
		||||
(defcustom async-bytecomp-allowed-packages
 | 
			
		||||
  '(async helm helm-core helm-ls-git helm-ls-hg magit)
 | 
			
		||||
  "Packages in this list will be compiled asynchronously by `package--compile'.
 | 
			
		||||
All the dependencies of these packages will be compiled async too,
 | 
			
		||||
so no need to add dependencies to this list.
 | 
			
		||||
The value of this variable can also be a list with a single element,
 | 
			
		||||
the symbol `all', in this case packages are always compiled asynchronously."
 | 
			
		||||
  :group 'async
 | 
			
		||||
  :type '(repeat (choice symbol)))
 | 
			
		||||
 | 
			
		||||
(defvar async-byte-compile-log-file
 | 
			
		||||
  (concat user-emacs-directory "async-bytecomp.log"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun async-byte-recompile-directory (directory &optional quiet)
 | 
			
		||||
  "Compile all *.el files in DIRECTORY asynchronously.
 | 
			
		||||
All *.elc files are systematically deleted before proceeding."
 | 
			
		||||
  (cl-loop with dir = (directory-files directory t "\\.elc\\'")
 | 
			
		||||
           unless dir return nil
 | 
			
		||||
           for f in dir
 | 
			
		||||
           when (file-exists-p f) do (delete-file f))
 | 
			
		||||
  ;; Ensure async is reloaded when async.elc is deleted.
 | 
			
		||||
  ;; This happen when recompiling its own directory.
 | 
			
		||||
  (load "async")
 | 
			
		||||
  (let ((call-back
 | 
			
		||||
         (lambda (&optional _ignore)
 | 
			
		||||
           (if (file-exists-p async-byte-compile-log-file)
 | 
			
		||||
               (let ((buf (get-buffer-create byte-compile-log-buffer))
 | 
			
		||||
                     (n 0))
 | 
			
		||||
                 (with-current-buffer buf
 | 
			
		||||
                   (goto-char (point-max))
 | 
			
		||||
                   (let ((inhibit-read-only t))
 | 
			
		||||
                     (insert-file-contents async-byte-compile-log-file)
 | 
			
		||||
                     (compilation-mode))
 | 
			
		||||
                   (display-buffer buf)
 | 
			
		||||
                   (delete-file async-byte-compile-log-file)
 | 
			
		||||
                   (unless quiet
 | 
			
		||||
                     (save-excursion
 | 
			
		||||
                       (goto-char (point-min))
 | 
			
		||||
                       (while (re-search-forward "^.*:Error:" nil t)
 | 
			
		||||
                         (cl-incf n)))
 | 
			
		||||
                     (if (> n 0)
 | 
			
		||||
                         (message "Failed to compile %d files in directory `%s'" n directory)
 | 
			
		||||
                         (message "Directory `%s' compiled asynchronously with warnings" directory)))))
 | 
			
		||||
               (unless quiet
 | 
			
		||||
                 (message "Directory `%s' compiled asynchronously with success" directory))))))
 | 
			
		||||
    (async-start
 | 
			
		||||
     `(lambda ()
 | 
			
		||||
        (require 'bytecomp)
 | 
			
		||||
        ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
 | 
			
		||||
        (let ((default-directory (file-name-as-directory ,directory))
 | 
			
		||||
              error-data)
 | 
			
		||||
          (add-to-list 'load-path default-directory)
 | 
			
		||||
          (byte-recompile-directory ,directory 0 t)
 | 
			
		||||
          (when (get-buffer byte-compile-log-buffer)
 | 
			
		||||
            (setq error-data (with-current-buffer byte-compile-log-buffer
 | 
			
		||||
                               (buffer-substring-no-properties (point-min) (point-max))))
 | 
			
		||||
            (unless (string= error-data "")
 | 
			
		||||
              (with-temp-file ,async-byte-compile-log-file
 | 
			
		||||
                (erase-buffer)
 | 
			
		||||
                (insert error-data))))))
 | 
			
		||||
     call-back)
 | 
			
		||||
    (unless quiet (message "Started compiling asynchronously directory %s" directory))))
 | 
			
		||||
 | 
			
		||||
(defvar package-archive-contents)
 | 
			
		||||
(defvar package-alist)
 | 
			
		||||
(declare-function package-desc-reqs "package.el" (cl-x))
 | 
			
		||||
 | 
			
		||||
(defun async-bytecomp--get-package-deps (pkg &optional only)
 | 
			
		||||
  ;; Same as `package--get-deps' but parse instead `package-archive-contents'
 | 
			
		||||
  ;; because PKG is not already installed and not present in `package-alist'.
 | 
			
		||||
  ;; However fallback to `package-alist' in case PKG no more present
 | 
			
		||||
  ;; in `package-archive-contents' due to modification to `package-archives'.
 | 
			
		||||
  ;; See issue #58.
 | 
			
		||||
  (let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
 | 
			
		||||
                             (assq pkg package-alist))))
 | 
			
		||||
         (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
 | 
			
		||||
                               for name = (car p)
 | 
			
		||||
                               when (or (assq name package-archive-contents)
 | 
			
		||||
                                        (assq name package-alist))
 | 
			
		||||
                               collect name))
 | 
			
		||||
         (indirect-deps (unless (eq only 'direct)
 | 
			
		||||
                          (delete-dups
 | 
			
		||||
                           (cl-loop for p in direct-deps append
 | 
			
		||||
                                    (async-bytecomp--get-package-deps p))))))
 | 
			
		||||
    (cl-case only
 | 
			
		||||
      (direct   direct-deps)
 | 
			
		||||
      (separate (list direct-deps indirect-deps))
 | 
			
		||||
      (indirect indirect-deps)
 | 
			
		||||
      (t        (delete-dups (append direct-deps indirect-deps))))))
 | 
			
		||||
 | 
			
		||||
(defun async-bytecomp-get-allowed-pkgs ()
 | 
			
		||||
  (when (and async-bytecomp-allowed-packages
 | 
			
		||||
             (listp async-bytecomp-allowed-packages))
 | 
			
		||||
    (if package-archive-contents
 | 
			
		||||
        (cl-loop for p in async-bytecomp-allowed-packages
 | 
			
		||||
                 when (assq p package-archive-contents)
 | 
			
		||||
                 append (async-bytecomp--get-package-deps p) into reqs
 | 
			
		||||
                 finally return
 | 
			
		||||
                 (delete-dups
 | 
			
		||||
                  (append async-bytecomp-allowed-packages reqs)))
 | 
			
		||||
        async-bytecomp-allowed-packages)))
 | 
			
		||||
 | 
			
		||||
(defadvice package--compile (around byte-compile-async)
 | 
			
		||||
  (let ((cur-package (package-desc-name pkg-desc))
 | 
			
		||||
        (pkg-dir (package-desc-dir pkg-desc)))
 | 
			
		||||
    (if (or (equal async-bytecomp-allowed-packages '(all))
 | 
			
		||||
            (memq cur-package (async-bytecomp-get-allowed-pkgs)))
 | 
			
		||||
        (progn
 | 
			
		||||
          (when (eq cur-package 'async)
 | 
			
		||||
            (fmakunbound 'async-byte-recompile-directory))
 | 
			
		||||
          ;; Add to `load-path' the latest version of async and
 | 
			
		||||
          ;; reload it when reinstalling async.
 | 
			
		||||
          (when (string= cur-package "async")
 | 
			
		||||
            (cl-pushnew pkg-dir load-path)
 | 
			
		||||
            (load "async-bytecomp"))
 | 
			
		||||
          ;; `async-byte-recompile-directory' will add directory
 | 
			
		||||
          ;; as needed to `load-path'.
 | 
			
		||||
          (async-byte-recompile-directory (package-desc-dir pkg-desc) t))
 | 
			
		||||
        ad-do-it)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-minor-mode async-bytecomp-package-mode
 | 
			
		||||
    "Byte compile asynchronously packages installed with package.el.
 | 
			
		||||
Async compilation of packages can be controlled by
 | 
			
		||||
`async-bytecomp-allowed-packages'."
 | 
			
		||||
  :group 'async
 | 
			
		||||
  :global t
 | 
			
		||||
  (if async-bytecomp-package-mode
 | 
			
		||||
      (ad-activate 'package--compile)
 | 
			
		||||
      (ad-deactivate 'package--compile)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun async-byte-compile-file (file)
 | 
			
		||||
  "Byte compile Lisp code FILE asynchronously.
 | 
			
		||||
 | 
			
		||||
Same as `byte-compile-file' but asynchronous."
 | 
			
		||||
  (interactive "fFile: ")
 | 
			
		||||
  (let ((call-back
 | 
			
		||||
         (lambda (&optional _ignore)
 | 
			
		||||
           (let ((bn (file-name-nondirectory file)))
 | 
			
		||||
             (if (file-exists-p async-byte-compile-log-file)
 | 
			
		||||
                 (let ((buf (get-buffer-create byte-compile-log-buffer))
 | 
			
		||||
                       start)
 | 
			
		||||
                   (with-current-buffer buf
 | 
			
		||||
                     (goto-char (setq start (point-max)))
 | 
			
		||||
                     (let ((inhibit-read-only t))
 | 
			
		||||
                       (insert-file-contents async-byte-compile-log-file)
 | 
			
		||||
                       (compilation-mode))
 | 
			
		||||
                     (display-buffer buf)
 | 
			
		||||
                     (delete-file async-byte-compile-log-file)
 | 
			
		||||
                     (save-excursion
 | 
			
		||||
                       (goto-char start)
 | 
			
		||||
                       (if (re-search-forward "^.*:Error:" nil t)
 | 
			
		||||
                           (message "Failed to compile `%s'" bn)
 | 
			
		||||
                         (message "`%s' compiled asynchronously with warnings" bn)))))
 | 
			
		||||
               (message "`%s' compiled asynchronously with success" bn))))))
 | 
			
		||||
    (async-start
 | 
			
		||||
     `(lambda ()
 | 
			
		||||
        (require 'bytecomp)
 | 
			
		||||
        ,(async-inject-variables "\\`load-path\\'")
 | 
			
		||||
        (let ((default-directory ,(file-name-directory file)))
 | 
			
		||||
          (add-to-list 'load-path default-directory)
 | 
			
		||||
          (byte-compile-file ,file)
 | 
			
		||||
          (when (get-buffer byte-compile-log-buffer)
 | 
			
		||||
            (setq error-data (with-current-buffer byte-compile-log-buffer
 | 
			
		||||
                               (buffer-substring-no-properties (point-min) (point-max))))
 | 
			
		||||
            (unless (string= error-data "")
 | 
			
		||||
              (with-temp-file ,async-byte-compile-log-file
 | 
			
		||||
                (erase-buffer)
 | 
			
		||||
                (insert error-data))))))
 | 
			
		||||
     call-back)))
 | 
			
		||||
 | 
			
		||||
(provide 'async-bytecomp)
 | 
			
		||||
 | 
			
		||||
;;; async-bytecomp.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,6 +0,0 @@
 | 
			
		||||
(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:
 | 
			
		||||
@ -1,392 +0,0 @@
 | 
			
		||||
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
;; Author: John Wiegley <jwiegley@gmail.com>
 | 
			
		||||
;; Created: 18 Jun 2012
 | 
			
		||||
;; Version: 1.9.3
 | 
			
		||||
 | 
			
		||||
;; Keywords: async
 | 
			
		||||
;; X-URL: https://github.com/jwiegley/emacs-async
 | 
			
		||||
 | 
			
		||||
;; This program is free software; you can redistribute it and/or
 | 
			
		||||
;; modify it under the terms of the GNU General Public License as
 | 
			
		||||
;; published by the Free Software Foundation; either version 2, or (at
 | 
			
		||||
;; your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; This program is distributed in the hope that it will be useful, but
 | 
			
		||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
			
		||||
;; General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 | 
			
		||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 | 
			
		||||
;; Boston, MA 02111-1307, USA.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Adds the ability to call asynchronous functions and process with ease.  See
 | 
			
		||||
;; the documentation for `async-start' and `async-start-process'.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'cl-lib))
 | 
			
		||||
 | 
			
		||||
(defgroup async nil
 | 
			
		||||
  "Simple asynchronous processing in Emacs"
 | 
			
		||||
  :group 'emacs)
 | 
			
		||||
 | 
			
		||||
(defcustom async-variables-noprops-function #'async-variables-noprops
 | 
			
		||||
  "Default function to remove text properties in variables."
 | 
			
		||||
  :group 'async
 | 
			
		||||
  :type 'function)
 | 
			
		||||
 | 
			
		||||
(defvar async-debug nil)
 | 
			
		||||
(defvar async-send-over-pipe t)
 | 
			
		||||
(defvar async-in-child-emacs nil)
 | 
			
		||||
(defvar async-callback nil)
 | 
			
		||||
(defvar async-callback-for-process nil)
 | 
			
		||||
(defvar async-callback-value nil)
 | 
			
		||||
(defvar async-callback-value-set nil)
 | 
			
		||||
(defvar async-current-process nil)
 | 
			
		||||
(defvar async--procvar nil)
 | 
			
		||||
 | 
			
		||||
(defun async-variables-noprops (sequence)
 | 
			
		||||
  "Remove text properties in SEQUENCE.
 | 
			
		||||
 | 
			
		||||
Argument SEQUENCE may be a list or a string, if anything else it
 | 
			
		||||
is returned unmodified.
 | 
			
		||||
 | 
			
		||||
Note that this is a naive function that doesn't remove text properties
 | 
			
		||||
in SEQUENCE recursively, only at the first level which suffice in most
 | 
			
		||||
cases."
 | 
			
		||||
  (cond ((stringp sequence)
 | 
			
		||||
         (substring-no-properties sequence))
 | 
			
		||||
        ((listp sequence)
 | 
			
		||||
         (cl-loop for elm in sequence
 | 
			
		||||
                  if (stringp elm)
 | 
			
		||||
                  collect (substring-no-properties elm)
 | 
			
		||||
                  else collect elm))
 | 
			
		||||
        (t sequence)))
 | 
			
		||||
 | 
			
		||||
(defun async-inject-variables
 | 
			
		||||
  (include-regexp &optional predicate exclude-regexp noprops)
 | 
			
		||||
  "Return a `setq' form that replicates part of the calling environment.
 | 
			
		||||
 | 
			
		||||
It sets the value for every variable matching INCLUDE-REGEXP and
 | 
			
		||||
also PREDICATE.  It will not perform injection for any variable
 | 
			
		||||
matching EXCLUDE-REGEXP (if present) or representing a syntax-table
 | 
			
		||||
i.e. ending by \"-syntax-table\".
 | 
			
		||||
When NOPROPS is non nil it tries to strip out text properties of each
 | 
			
		||||
variable's value with `async-variables-noprops-function'.
 | 
			
		||||
 | 
			
		||||
It is intended to be used as follows:
 | 
			
		||||
 | 
			
		||||
    (async-start
 | 
			
		||||
       `(lambda ()
 | 
			
		||||
          (require 'smtpmail)
 | 
			
		||||
          (with-temp-buffer
 | 
			
		||||
            (insert ,(buffer-substring-no-properties (point-min) (point-max)))
 | 
			
		||||
            ;; Pass in the variable environment for smtpmail
 | 
			
		||||
            ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
 | 
			
		||||
            (smtpmail-send-it)))
 | 
			
		||||
       'ignore)"
 | 
			
		||||
  `(setq
 | 
			
		||||
    ,@(let (bindings)
 | 
			
		||||
        (mapatoms
 | 
			
		||||
         (lambda (sym)
 | 
			
		||||
           (let* ((sname (and (boundp sym) (symbol-name sym)))
 | 
			
		||||
                  (value (and sname (symbol-value sym))))
 | 
			
		||||
             (when (and sname
 | 
			
		||||
                        (or (null include-regexp)
 | 
			
		||||
                            (string-match include-regexp sname))
 | 
			
		||||
                        (or (null exclude-regexp)
 | 
			
		||||
                            (not (string-match exclude-regexp sname)))
 | 
			
		||||
                        (not (string-match "-syntax-table\\'" sname)))
 | 
			
		||||
               (unless (or (stringp value)
 | 
			
		||||
                           (memq value '(nil t))
 | 
			
		||||
                           (numberp value)
 | 
			
		||||
                           (vectorp value))
 | 
			
		||||
                 (setq value `(quote ,value)))
 | 
			
		||||
               (when noprops
 | 
			
		||||
                 (setq value (funcall async-variables-noprops-function
 | 
			
		||||
                                      value)))
 | 
			
		||||
               (when (or (null predicate)
 | 
			
		||||
                         (funcall predicate sym))
 | 
			
		||||
                 (setq bindings (cons value bindings)
 | 
			
		||||
                       bindings (cons sym bindings)))))))
 | 
			
		||||
        bindings)))
 | 
			
		||||
 | 
			
		||||
(defalias 'async-inject-environment 'async-inject-variables)
 | 
			
		||||
 | 
			
		||||
(defun async-handle-result (func result buf)
 | 
			
		||||
  (if (null func)
 | 
			
		||||
      (progn
 | 
			
		||||
        (set (make-local-variable 'async-callback-value) result)
 | 
			
		||||
        (set (make-local-variable 'async-callback-value-set) t))
 | 
			
		||||
    (unwind-protect
 | 
			
		||||
        (if (and (listp result)
 | 
			
		||||
                 (eq 'async-signal (nth 0 result)))
 | 
			
		||||
            (signal (car (nth 1 result))
 | 
			
		||||
                    (cdr (nth 1 result)))
 | 
			
		||||
          (funcall func result))
 | 
			
		||||
      (unless async-debug
 | 
			
		||||
        (kill-buffer buf)))))
 | 
			
		||||
 | 
			
		||||
(defun async-when-done (proc &optional _change)
 | 
			
		||||
  "Process sentinel used to retrieve the value from the child process."
 | 
			
		||||
  (when (eq 'exit (process-status proc))
 | 
			
		||||
    (with-current-buffer (process-buffer proc)
 | 
			
		||||
      (let ((async-current-process proc))
 | 
			
		||||
        (if (= 0 (process-exit-status proc))
 | 
			
		||||
            (if async-callback-for-process
 | 
			
		||||
                (if async-callback
 | 
			
		||||
                    (prog1
 | 
			
		||||
                        (funcall async-callback proc)
 | 
			
		||||
                      (unless async-debug
 | 
			
		||||
                        (kill-buffer (current-buffer))))
 | 
			
		||||
                  (set (make-local-variable 'async-callback-value) proc)
 | 
			
		||||
                  (set (make-local-variable 'async-callback-value-set) t))
 | 
			
		||||
              (goto-char (point-max))
 | 
			
		||||
              (backward-sexp)
 | 
			
		||||
              (async-handle-result async-callback (read (current-buffer))
 | 
			
		||||
                                   (current-buffer)))
 | 
			
		||||
          (set (make-local-variable 'async-callback-value)
 | 
			
		||||
               (list 'error
 | 
			
		||||
                     (format "Async process '%s' failed with exit code %d"
 | 
			
		||||
                             (process-name proc) (process-exit-status proc))))
 | 
			
		||||
          (set (make-local-variable 'async-callback-value-set) t))))))
 | 
			
		||||
 | 
			
		||||
(defun async--receive-sexp (&optional stream)
 | 
			
		||||
  (let ((sexp (decode-coding-string (base64-decode-string
 | 
			
		||||
                                     (read stream)) 'utf-8-auto))
 | 
			
		||||
	;; Parent expects UTF-8 encoded text.
 | 
			
		||||
	(coding-system-for-write 'utf-8-auto))
 | 
			
		||||
    (if async-debug
 | 
			
		||||
        (message "Received sexp {{{%s}}}" (pp-to-string sexp)))
 | 
			
		||||
    (setq sexp (read sexp))
 | 
			
		||||
    (if async-debug
 | 
			
		||||
        (message "Read sexp {{{%s}}}" (pp-to-string sexp)))
 | 
			
		||||
    (eval sexp)))
 | 
			
		||||
 | 
			
		||||
(defun async--insert-sexp (sexp)
 | 
			
		||||
  (let (print-level
 | 
			
		||||
	print-length
 | 
			
		||||
	(print-escape-nonascii t)
 | 
			
		||||
	(print-circle t))
 | 
			
		||||
    (prin1 sexp (current-buffer))
 | 
			
		||||
    ;; Just in case the string we're sending might contain EOF
 | 
			
		||||
    (encode-coding-region (point-min) (point-max) 'utf-8-auto)
 | 
			
		||||
    (base64-encode-region (point-min) (point-max) t)
 | 
			
		||||
    (goto-char (point-min)) (insert ?\")
 | 
			
		||||
    (goto-char (point-max)) (insert ?\" ?\n)))
 | 
			
		||||
 | 
			
		||||
(defun async--transmit-sexp (process sexp)
 | 
			
		||||
  (with-temp-buffer
 | 
			
		||||
    (if async-debug
 | 
			
		||||
        (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
 | 
			
		||||
    (async--insert-sexp sexp)
 | 
			
		||||
    (process-send-region process (point-min) (point-max))))
 | 
			
		||||
 | 
			
		||||
(defun async-batch-invoke ()
 | 
			
		||||
  "Called from the child Emacs process' command-line."
 | 
			
		||||
  ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
 | 
			
		||||
  ;; process expects.
 | 
			
		||||
  (let ((coding-system-for-write 'utf-8-auto))
 | 
			
		||||
    (setq async-in-child-emacs t
 | 
			
		||||
	  debug-on-error async-debug)
 | 
			
		||||
    (if debug-on-error
 | 
			
		||||
	(prin1 (funcall
 | 
			
		||||
		(async--receive-sexp (unless async-send-over-pipe
 | 
			
		||||
				       command-line-args-left))))
 | 
			
		||||
      (condition-case err
 | 
			
		||||
	  (prin1 (funcall
 | 
			
		||||
		  (async--receive-sexp (unless async-send-over-pipe
 | 
			
		||||
					 command-line-args-left))))
 | 
			
		||||
	(error
 | 
			
		||||
	 (prin1 (list 'async-signal err)))))))
 | 
			
		||||
 | 
			
		||||
(defun async-ready (future)
 | 
			
		||||
  "Query a FUTURE to see if it is ready.
 | 
			
		||||
 | 
			
		||||
I.e., if no blocking
 | 
			
		||||
would result from a call to `async-get' on that FUTURE."
 | 
			
		||||
  (and (memq (process-status future) '(exit signal))
 | 
			
		||||
       (let ((buf (process-buffer future)))
 | 
			
		||||
         (if (buffer-live-p buf)
 | 
			
		||||
             (with-current-buffer buf
 | 
			
		||||
               async-callback-value-set)
 | 
			
		||||
             t))))
 | 
			
		||||
 | 
			
		||||
(defun async-wait (future)
 | 
			
		||||
  "Wait for FUTURE to become ready."
 | 
			
		||||
  (while (not (async-ready future))
 | 
			
		||||
    (sleep-for 0.05)))
 | 
			
		||||
 | 
			
		||||
(defun async-get (future)
 | 
			
		||||
  "Get the value from process FUTURE when it is ready.
 | 
			
		||||
FUTURE is returned by `async-start' or `async-start-process' when
 | 
			
		||||
its FINISH-FUNC is nil."
 | 
			
		||||
  (and future (async-wait future))
 | 
			
		||||
  (let ((buf (process-buffer future)))
 | 
			
		||||
    (when (buffer-live-p buf)
 | 
			
		||||
      (with-current-buffer buf
 | 
			
		||||
        (async-handle-result
 | 
			
		||||
         #'identity async-callback-value (current-buffer))))))
 | 
			
		||||
 | 
			
		||||
(defun async-message-p (value)
 | 
			
		||||
  "Return true of VALUE is an async.el message packet."
 | 
			
		||||
  (and (listp value)
 | 
			
		||||
       (plist-get value :async-message)))
 | 
			
		||||
 | 
			
		||||
(defun async-send (&rest args)
 | 
			
		||||
  "Send the given messages to the asychronous Emacs PROCESS."
 | 
			
		||||
  (let ((args (append args '(:async-message t))))
 | 
			
		||||
    (if async-in-child-emacs
 | 
			
		||||
        (if async-callback
 | 
			
		||||
            (funcall async-callback args))
 | 
			
		||||
      (async--transmit-sexp (car args) (list 'quote (cdr args))))))
 | 
			
		||||
 | 
			
		||||
(defun async-receive ()
 | 
			
		||||
  "Send the given messages to the asychronous Emacs PROCESS."
 | 
			
		||||
  (async--receive-sexp))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun async-start-process (name program finish-func &rest program-args)
 | 
			
		||||
  "Start the executable PROGRAM asynchronously.  See `async-start'.
 | 
			
		||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
 | 
			
		||||
process object when done.  If FINISH-FUNC is nil, the future
 | 
			
		||||
object will return the process object when the program is
 | 
			
		||||
finished.  Set DEFAULT-DIRECTORY to change PROGRAM's current
 | 
			
		||||
working directory."
 | 
			
		||||
  (let* ((buf (generate-new-buffer (concat "*" name "*")))
 | 
			
		||||
         (proc (let ((process-connection-type nil))
 | 
			
		||||
                 (apply #'start-process name buf program program-args))))
 | 
			
		||||
    (with-current-buffer buf
 | 
			
		||||
      (set (make-local-variable 'async-callback) finish-func)
 | 
			
		||||
      (set-process-sentinel proc #'async-when-done)
 | 
			
		||||
      (unless (string= name "emacs")
 | 
			
		||||
        (set (make-local-variable 'async-callback-for-process) t))
 | 
			
		||||
      proc)))
 | 
			
		||||
 | 
			
		||||
(defvar async-quiet-switch "-Q"
 | 
			
		||||
  "The Emacs parameter to use to call emacs without config.
 | 
			
		||||
Can be one of \"-Q\" or \"-q\".
 | 
			
		||||
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
 | 
			
		||||
enhanced config or some more variables loaded.")
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun async-start (start-func &optional finish-func)
 | 
			
		||||
  "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
 | 
			
		||||
When done, the return value is passed to FINISH-FUNC.  Example:
 | 
			
		||||
 | 
			
		||||
    (async-start
 | 
			
		||||
       ;; What to do in the child process
 | 
			
		||||
       (lambda ()
 | 
			
		||||
         (message \"This is a test\")
 | 
			
		||||
         (sleep-for 3)
 | 
			
		||||
         222)
 | 
			
		||||
 | 
			
		||||
       ;; What to do when it finishes
 | 
			
		||||
       (lambda (result)
 | 
			
		||||
         (message \"Async process done, result should be 222: %s\"
 | 
			
		||||
                  result)))
 | 
			
		||||
 | 
			
		||||
If FINISH-FUNC is nil or missing, a future is returned that can
 | 
			
		||||
be inspected using `async-get', blocking until the value is
 | 
			
		||||
ready.  Example:
 | 
			
		||||
 | 
			
		||||
    (let ((proc (async-start
 | 
			
		||||
                   ;; What to do in the child process
 | 
			
		||||
                   (lambda ()
 | 
			
		||||
                     (message \"This is a test\")
 | 
			
		||||
                     (sleep-for 3)
 | 
			
		||||
                     222))))
 | 
			
		||||
 | 
			
		||||
        (message \"I'm going to do some work here\") ;; ....
 | 
			
		||||
 | 
			
		||||
        (message \"Waiting on async process, result should be 222: %s\"
 | 
			
		||||
                 (async-get proc)))
 | 
			
		||||
 | 
			
		||||
If you don't want to use a callback, and you don't care about any
 | 
			
		||||
return value from the child process, pass the `ignore' symbol as
 | 
			
		||||
the second argument (if you don't, and never call `async-get', it
 | 
			
		||||
will leave *emacs* process buffers hanging around):
 | 
			
		||||
 | 
			
		||||
    (async-start
 | 
			
		||||
     (lambda ()
 | 
			
		||||
       (delete-file \"a remote file on a slow link\" nil))
 | 
			
		||||
     'ignore)
 | 
			
		||||
 | 
			
		||||
Note: Even when FINISH-FUNC is present, a future is still
 | 
			
		||||
returned except that it yields no value (since the value is
 | 
			
		||||
passed to FINISH-FUNC).  Call `async-get' on such a future always
 | 
			
		||||
returns nil.  It can still be useful, however, as an argument to
 | 
			
		||||
`async-ready' or `async-wait'."
 | 
			
		||||
  (let ((sexp start-func)
 | 
			
		||||
	;; Subordinate Emacs will send text encoded in UTF-8.
 | 
			
		||||
	(coding-system-for-read 'utf-8-auto))
 | 
			
		||||
    (setq async--procvar
 | 
			
		||||
          (async-start-process
 | 
			
		||||
           "emacs" (file-truename
 | 
			
		||||
                    (expand-file-name invocation-name
 | 
			
		||||
                                      invocation-directory))
 | 
			
		||||
           finish-func
 | 
			
		||||
           async-quiet-switch "-l"
 | 
			
		||||
           ;; Using `locate-library' ensure we use the right file
 | 
			
		||||
           ;; when the .elc have been deleted.
 | 
			
		||||
           (locate-library "async")
 | 
			
		||||
           "-batch" "-f" "async-batch-invoke"
 | 
			
		||||
           (if async-send-over-pipe
 | 
			
		||||
               "<none>"
 | 
			
		||||
               (with-temp-buffer
 | 
			
		||||
                 (async--insert-sexp (list 'quote sexp))
 | 
			
		||||
                 (buffer-string)))))
 | 
			
		||||
    (if async-send-over-pipe
 | 
			
		||||
        (async--transmit-sexp async--procvar (list 'quote sexp)))
 | 
			
		||||
    async--procvar))
 | 
			
		||||
 | 
			
		||||
(defmacro async-sandbox(func)
 | 
			
		||||
  "Evaluate FUNC in a separate Emacs process, synchronously."
 | 
			
		||||
  `(async-get (async-start ,func)))
 | 
			
		||||
 | 
			
		||||
(defun async--fold-left (fn forms bindings)
 | 
			
		||||
  (let ((res forms))
 | 
			
		||||
    (dolist (binding bindings)
 | 
			
		||||
      (setq res (funcall fn res
 | 
			
		||||
                         (if (listp binding)
 | 
			
		||||
                             binding
 | 
			
		||||
                             (list binding)))))
 | 
			
		||||
    res))
 | 
			
		||||
 | 
			
		||||
(defmacro async-let (bindings &rest forms)
 | 
			
		||||
  "Implements `let', but each binding is established asynchronously.
 | 
			
		||||
For example:
 | 
			
		||||
 | 
			
		||||
  (async-let ((x (foo))
 | 
			
		||||
              (y (bar)))
 | 
			
		||||
     (message \"%s %s\" x y))
 | 
			
		||||
 | 
			
		||||
    expands to ==>
 | 
			
		||||
 | 
			
		||||
  (async-start (foo)
 | 
			
		||||
   (lambda (x)
 | 
			
		||||
     (async-start (bar)
 | 
			
		||||
      (lambda (y)
 | 
			
		||||
        (message \"%s %s\" x y)))))"
 | 
			
		||||
  (declare (indent 1))
 | 
			
		||||
  (async--fold-left
 | 
			
		||||
   (lambda (acc binding)
 | 
			
		||||
     (let ((fun (pcase (cadr binding)
 | 
			
		||||
                  ((and (pred functionp) f) f)
 | 
			
		||||
                  (f `(lambda () ,f)))))
 | 
			
		||||
       `(async-start ,fun
 | 
			
		||||
                     (lambda (,(car binding))
 | 
			
		||||
                       ,acc))))
 | 
			
		||||
   `(progn ,@forms)
 | 
			
		||||
   (reverse bindings)))
 | 
			
		||||
 | 
			
		||||
(provide 'async)
 | 
			
		||||
 | 
			
		||||
;;; async.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,405 +0,0 @@
 | 
			
		||||
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
;; Authors: John Wiegley <jwiegley@gmail.com>
 | 
			
		||||
;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
 | 
			
		||||
 | 
			
		||||
;; Keywords: dired async network
 | 
			
		||||
;; X-URL: https://github.com/jwiegley/dired-async
 | 
			
		||||
 | 
			
		||||
;; This program is free software; you can redistribute it and/or
 | 
			
		||||
;; modify it under the terms of the GNU General Public License as
 | 
			
		||||
;; published by the Free Software Foundation; either version 2, or (at
 | 
			
		||||
;; your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; This program is distributed in the hope that it will be useful, but
 | 
			
		||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
			
		||||
;; General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 | 
			
		||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 | 
			
		||||
;; Boston, MA 02111-1307, USA.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This file provide a redefinition of `dired-create-file' function,
 | 
			
		||||
;; performs copies, moves and all what is handled by `dired-create-file'
 | 
			
		||||
;; in the background using a slave Emacs process,
 | 
			
		||||
;; by means of the async.el module.
 | 
			
		||||
;; To use it, put this in your .emacs:
 | 
			
		||||
 | 
			
		||||
;;     (dired-async-mode 1)
 | 
			
		||||
 | 
			
		||||
;; This will enable async copy/rename etc...
 | 
			
		||||
;; in dired and helm.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'cl-lib)
 | 
			
		||||
(require 'dired-aux)
 | 
			
		||||
(require 'async)
 | 
			
		||||
 | 
			
		||||
(eval-when-compile
 | 
			
		||||
  (defvar async-callback))
 | 
			
		||||
 | 
			
		||||
(defgroup dired-async nil
 | 
			
		||||
  "Copy rename files asynchronously from dired."
 | 
			
		||||
  :group 'dired)
 | 
			
		||||
 | 
			
		||||
(defcustom dired-async-env-variables-regexp
 | 
			
		||||
  "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
 | 
			
		||||
  "Variables matching this regexp will be loaded on Child Emacs."
 | 
			
		||||
  :type  'regexp
 | 
			
		||||
  :group 'dired-async)
 | 
			
		||||
 | 
			
		||||
(defcustom dired-async-message-function 'dired-async-mode-line-message
 | 
			
		||||
  "Function to use to notify result when operation finish.
 | 
			
		||||
Should take same args as `message'."
 | 
			
		||||
  :group 'dired-async
 | 
			
		||||
  :type  'function)
 | 
			
		||||
 | 
			
		||||
(defcustom dired-async-log-file "/tmp/dired-async.log"
 | 
			
		||||
  "File use to communicate errors from Child Emacs to host Emacs."
 | 
			
		||||
  :group 'dired-async
 | 
			
		||||
  :type 'string)
 | 
			
		||||
 | 
			
		||||
(defcustom dired-async-mode-lighter '(:eval
 | 
			
		||||
                                      (when (eq major-mode 'dired-mode)
 | 
			
		||||
                                        " Async"))
 | 
			
		||||
  "Mode line lighter used for `dired-async-mode'."
 | 
			
		||||
  :group 'dired-async
 | 
			
		||||
  :risky t
 | 
			
		||||
  :type 'sexp)
 | 
			
		||||
 | 
			
		||||
(defface dired-async-message
 | 
			
		||||
    '((t (:foreground "yellow")))
 | 
			
		||||
  "Face used for mode-line message."
 | 
			
		||||
  :group 'dired-async)
 | 
			
		||||
 | 
			
		||||
(defface dired-async-failures
 | 
			
		||||
    '((t (:foreground "red")))
 | 
			
		||||
  "Face used for mode-line message."
 | 
			
		||||
  :group 'dired-async)
 | 
			
		||||
 | 
			
		||||
(defface dired-async-mode-message
 | 
			
		||||
    '((t (:foreground "Gold")))
 | 
			
		||||
  "Face used for `dired-async--modeline-mode' lighter."
 | 
			
		||||
  :group 'dired-async)
 | 
			
		||||
 | 
			
		||||
(define-minor-mode dired-async--modeline-mode
 | 
			
		||||
    "Notify mode-line that an async process run."
 | 
			
		||||
  :group 'dired-async
 | 
			
		||||
  :global t
 | 
			
		||||
  :lighter (:eval (propertize (format " [%s Async job(s) running]"
 | 
			
		||||
                                      (length (dired-async-processes)))
 | 
			
		||||
                              'face 'dired-async-mode-message))
 | 
			
		||||
  (unless dired-async--modeline-mode
 | 
			
		||||
    (let ((visible-bell t)) (ding))))
 | 
			
		||||
 | 
			
		||||
(defun dired-async-mode-line-message (text face &rest args)
 | 
			
		||||
  "Notify end of operation in `mode-line'."
 | 
			
		||||
  (message nil)
 | 
			
		||||
  (let ((mode-line-format (concat
 | 
			
		||||
                           " " (propertize
 | 
			
		||||
                                (if args
 | 
			
		||||
                                    (apply #'format text args)
 | 
			
		||||
                                    text)
 | 
			
		||||
                                'face face))))
 | 
			
		||||
    (force-mode-line-update)
 | 
			
		||||
    (sit-for 3)
 | 
			
		||||
    (force-mode-line-update)))
 | 
			
		||||
 | 
			
		||||
(defun dired-async-processes ()
 | 
			
		||||
  (cl-loop for p in (process-list)
 | 
			
		||||
           when (cl-loop for c in (process-command p) thereis
 | 
			
		||||
                         (string= "async-batch-invoke" c))
 | 
			
		||||
           collect p))
 | 
			
		||||
 | 
			
		||||
(defun dired-async-kill-process ()
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let* ((processes (dired-async-processes))
 | 
			
		||||
         (proc (car (last processes))))
 | 
			
		||||
    (and proc (delete-process proc))
 | 
			
		||||
    (unless (> (length processes) 1)
 | 
			
		||||
      (dired-async--modeline-mode -1))))
 | 
			
		||||
 | 
			
		||||
(defun dired-async-after-file-create (total operation failures skipped)
 | 
			
		||||
  "Callback function used for operation handled by `dired-create-file'."
 | 
			
		||||
  (unless (dired-async-processes)
 | 
			
		||||
    ;; Turn off mode-line notification
 | 
			
		||||
    ;; only when last process end.
 | 
			
		||||
    (dired-async--modeline-mode -1))
 | 
			
		||||
  (when operation
 | 
			
		||||
    (if (file-exists-p dired-async-log-file)
 | 
			
		||||
        (progn
 | 
			
		||||
          (pop-to-buffer (get-buffer-create dired-log-buffer))
 | 
			
		||||
          (goto-char (point-max))
 | 
			
		||||
          (setq inhibit-read-only t)
 | 
			
		||||
          (insert "Error: ")
 | 
			
		||||
          (insert-file-contents dired-async-log-file)
 | 
			
		||||
          (special-mode)
 | 
			
		||||
          (shrink-window-if-larger-than-buffer)
 | 
			
		||||
          (delete-file dired-async-log-file))
 | 
			
		||||
        (run-with-timer
 | 
			
		||||
         0.1 nil
 | 
			
		||||
         (lambda ()
 | 
			
		||||
           ;; First send error messages.
 | 
			
		||||
           (cond (failures
 | 
			
		||||
                  (funcall dired-async-message-function
 | 
			
		||||
                           "%s failed for %d of %d file%s -- See *Dired log* buffer"
 | 
			
		||||
                           'dired-async-failures
 | 
			
		||||
                           (car operation) (length failures)
 | 
			
		||||
                           total (dired-plural-s total)))
 | 
			
		||||
                 (skipped
 | 
			
		||||
                  (funcall dired-async-message-function
 | 
			
		||||
                           "%s: %d of %d file%s skipped -- See *Dired log* buffer"
 | 
			
		||||
                           'dired-async-failures
 | 
			
		||||
                           (car operation) (length skipped) total
 | 
			
		||||
                           (dired-plural-s total))))
 | 
			
		||||
           (when dired-buffers
 | 
			
		||||
             (cl-loop for (_f . b) in dired-buffers
 | 
			
		||||
                      when (buffer-live-p b)
 | 
			
		||||
                      do (with-current-buffer b (revert-buffer nil t))))
 | 
			
		||||
           ;; Finally send the success message.
 | 
			
		||||
           (funcall dired-async-message-function
 | 
			
		||||
                    "Asynchronous %s of %s on %s file%s done"
 | 
			
		||||
                    'dired-async-message
 | 
			
		||||
                    (car operation) (cadr operation)
 | 
			
		||||
                    total (dired-plural-s total)))))))
 | 
			
		||||
 | 
			
		||||
(defun dired-async-maybe-kill-ftp ()
 | 
			
		||||
  "Return a form to kill ftp process in child emacs."
 | 
			
		||||
  (quote
 | 
			
		||||
   (progn
 | 
			
		||||
     (require 'cl-lib)
 | 
			
		||||
     (let ((buf (cl-loop for b in (buffer-list)
 | 
			
		||||
                         thereis (and (string-match
 | 
			
		||||
                                       "\\`\\*ftp.*"
 | 
			
		||||
                                       (buffer-name b)) b))))
 | 
			
		||||
       (when buf (kill-buffer buf))))))
 | 
			
		||||
 | 
			
		||||
(defvar overwrite-query)
 | 
			
		||||
(defun dired-async-create-files (file-creator operation fn-list name-constructor
 | 
			
		||||
                                 &optional _marker-char)
 | 
			
		||||
  "Same as `dired-create-files' but asynchronous.
 | 
			
		||||
 | 
			
		||||
See `dired-create-files' for the behavior of arguments."
 | 
			
		||||
  (setq overwrite-query nil)
 | 
			
		||||
  (let ((total (length fn-list))
 | 
			
		||||
        failures async-fn-list skipped callback
 | 
			
		||||
        async-quiet-switch)
 | 
			
		||||
    (let (to)
 | 
			
		||||
      (dolist (from fn-list)
 | 
			
		||||
        (setq to (funcall name-constructor from))
 | 
			
		||||
        (if (and (equal to from)
 | 
			
		||||
                 (null (eq file-creator 'backup-file)))
 | 
			
		||||
            (progn
 | 
			
		||||
              (setq to nil)
 | 
			
		||||
              (dired-log "Cannot %s to same file: %s\n"
 | 
			
		||||
                         (downcase operation) from)))
 | 
			
		||||
        (if (not to)
 | 
			
		||||
            (setq skipped (cons (dired-make-relative from) skipped))
 | 
			
		||||
            (let* ((overwrite (and (null (eq file-creator 'backup-file))
 | 
			
		||||
                                   (file-exists-p to)))
 | 
			
		||||
                   (dired-overwrite-confirmed ; for dired-handle-overwrite
 | 
			
		||||
                    (and overwrite
 | 
			
		||||
                         (let ((help-form `(format "\
 | 
			
		||||
Type SPC or `y' to overwrite file `%s',
 | 
			
		||||
DEL or `n' to skip to next,
 | 
			
		||||
ESC or `q' to not overwrite any of the remaining files,
 | 
			
		||||
`!' to overwrite all remaining files with no more questions." ,to)))
 | 
			
		||||
                           (dired-query 'overwrite-query "Overwrite `%s'?" to)))))
 | 
			
		||||
              ;; Handle the `dired-copy-file' file-creator specially
 | 
			
		||||
              ;; When copying a directory to another directory or
 | 
			
		||||
              ;; possibly to itself or one of its subdirectories.
 | 
			
		||||
              ;; e.g "~/foo/" => "~/test/"
 | 
			
		||||
              ;; or "~/foo/" =>"~/foo/"
 | 
			
		||||
              ;; or "~/foo/ => ~/foo/bar/")
 | 
			
		||||
              ;; In this case the 'name-constructor' have set the destination
 | 
			
		||||
              ;; TO to "~/test/foo" because the old emacs23 behavior
 | 
			
		||||
              ;; of `copy-directory' was to not create the subdirectory
 | 
			
		||||
              ;; and instead copy the contents.
 | 
			
		||||
              ;; With the new behavior of `copy-directory'
 | 
			
		||||
              ;; (similar to the `cp' shell command) we don't
 | 
			
		||||
              ;; need such a construction of the target directory,
 | 
			
		||||
              ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
 | 
			
		||||
              (let ((destname (file-name-directory to)))
 | 
			
		||||
                (when (and (file-directory-p from)
 | 
			
		||||
                           (file-directory-p to)
 | 
			
		||||
                           (eq file-creator 'dired-copy-file))
 | 
			
		||||
                  (setq to destname))
 | 
			
		||||
                ;; If DESTNAME is a subdirectory of FROM, not a symlink,
 | 
			
		||||
                ;; and the method in use is copying, signal an error.
 | 
			
		||||
                (and (eq t (car (file-attributes destname)))
 | 
			
		||||
                     (eq file-creator 'dired-copy-file)
 | 
			
		||||
                     (file-in-directory-p destname from)
 | 
			
		||||
                     (error "Cannot copy `%s' into its subdirectory `%s'"
 | 
			
		||||
                            from to)))
 | 
			
		||||
              (if overwrite
 | 
			
		||||
                  (or (and dired-overwrite-confirmed
 | 
			
		||||
                           (push (cons from to) async-fn-list))
 | 
			
		||||
                      (progn
 | 
			
		||||
                        (push (dired-make-relative from) failures)
 | 
			
		||||
                        (dired-log "%s `%s' to `%s' failed\n"
 | 
			
		||||
                                   operation from to)))
 | 
			
		||||
                  (push (cons from to) async-fn-list)))))
 | 
			
		||||
      ;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
 | 
			
		||||
      (setq async-quiet-switch
 | 
			
		||||
            (if (and (boundp 'tramp-cache-read-persistent-data)
 | 
			
		||||
                     async-fn-list
 | 
			
		||||
                     (cl-loop for (_from . to) in async-fn-list
 | 
			
		||||
                              thereis (file-remote-p to)))
 | 
			
		||||
                "-q" "-Q"))
 | 
			
		||||
      ;; When failures have been printed to dired log add the date at bob.
 | 
			
		||||
      (when (or failures skipped) (dired-log t))
 | 
			
		||||
      ;; When async-fn-list is empty that's mean only one file
 | 
			
		||||
      ;; had to be copied and user finally answer NO.
 | 
			
		||||
      ;; In this case async process will never start and callback
 | 
			
		||||
      ;; will have no chance to run, so notify failures here.
 | 
			
		||||
      (unless async-fn-list
 | 
			
		||||
        (cond (failures
 | 
			
		||||
               (funcall dired-async-message-function
 | 
			
		||||
                        "%s failed for %d of %d file%s -- See *Dired log* buffer"
 | 
			
		||||
                        'dired-async-failures
 | 
			
		||||
                        operation (length failures)
 | 
			
		||||
                        total (dired-plural-s total)))
 | 
			
		||||
              (skipped
 | 
			
		||||
               (funcall dired-async-message-function
 | 
			
		||||
                        "%s: %d of %d file%s skipped -- See *Dired log* buffer"
 | 
			
		||||
                        'dired-async-failures
 | 
			
		||||
                        operation (length skipped) total
 | 
			
		||||
                        (dired-plural-s total)))))
 | 
			
		||||
      ;; Setup callback.
 | 
			
		||||
      (setq callback
 | 
			
		||||
            (lambda (&optional _ignore)
 | 
			
		||||
               (dired-async-after-file-create
 | 
			
		||||
                total (list operation (length async-fn-list)) failures skipped)
 | 
			
		||||
               (when (string= (downcase operation) "rename")
 | 
			
		||||
                 (cl-loop for (file . to) in async-fn-list
 | 
			
		||||
                          for bf = (get-file-buffer file)
 | 
			
		||||
                          for destp = (file-exists-p to)
 | 
			
		||||
                          do (and bf destp
 | 
			
		||||
                                  (with-current-buffer bf
 | 
			
		||||
                                    (set-visited-file-name to t t))))))))
 | 
			
		||||
    ;; Start async process.
 | 
			
		||||
    (when async-fn-list
 | 
			
		||||
      (async-start `(lambda ()
 | 
			
		||||
                      (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
 | 
			
		||||
                      ,(async-inject-variables dired-async-env-variables-regexp)
 | 
			
		||||
                          (let ((dired-recursive-copies (quote always))
 | 
			
		||||
                                (dired-copy-preserve-time
 | 
			
		||||
                                 ,dired-copy-preserve-time))
 | 
			
		||||
                            (setq overwrite-backup-query nil)
 | 
			
		||||
                            ;; Inline `backup-file' as long as it is not
 | 
			
		||||
                            ;; available in emacs.
 | 
			
		||||
                            (defalias 'backup-file
 | 
			
		||||
                                ;; Same feature as "cp -f --backup=numbered from to"
 | 
			
		||||
                                ;; Symlinks are copied as file from source unlike
 | 
			
		||||
                                ;; `dired-copy-file' which is same as cp -d.
 | 
			
		||||
                                ;; Directories are omitted.
 | 
			
		||||
                                (lambda (from to ok)
 | 
			
		||||
                                  (cond ((file-directory-p from) (ignore))
 | 
			
		||||
                                        (t (let ((count 0))
 | 
			
		||||
                                             (while (let ((attrs (file-attributes to)))
 | 
			
		||||
                                                      (and attrs (null (nth 0 attrs))))
 | 
			
		||||
                                               (cl-incf count)
 | 
			
		||||
                                               (setq to (concat (file-name-sans-versions to)
 | 
			
		||||
                                                                (format ".~%s~" count)))))
 | 
			
		||||
                                           (condition-case err
 | 
			
		||||
                                               (copy-file from to ok dired-copy-preserve-time)
 | 
			
		||||
                                             (file-date-error
 | 
			
		||||
                                              (dired-log "Can't set date on %s:\n%s\n" from err)))))))
 | 
			
		||||
                            ;; Now run the FILE-CREATOR function on files.
 | 
			
		||||
                            (cl-loop with fn = (quote ,file-creator)
 | 
			
		||||
                                     for (from . dest) in (quote ,async-fn-list)
 | 
			
		||||
                                     do (condition-case err
 | 
			
		||||
                                            (funcall fn from dest t)
 | 
			
		||||
                                          (file-error
 | 
			
		||||
                                           (dired-log "%s: %s\n" (car err) (cdr err)))
 | 
			
		||||
                                          nil))
 | 
			
		||||
                        (when (get-buffer dired-log-buffer)
 | 
			
		||||
                          (dired-log t)
 | 
			
		||||
                          (with-current-buffer dired-log-buffer
 | 
			
		||||
                           (write-region (point-min) (point-max)
 | 
			
		||||
                                         ,dired-async-log-file))))
 | 
			
		||||
                      ,(dired-async-maybe-kill-ftp))
 | 
			
		||||
                   callback)
 | 
			
		||||
      ;; Run mode-line notifications while process running.
 | 
			
		||||
      (dired-async--modeline-mode 1)
 | 
			
		||||
      (message "%s proceeding asynchronously..." operation))))
 | 
			
		||||
 | 
			
		||||
(defvar wdired-use-interactive-rename)
 | 
			
		||||
(defun dired-async-wdired-do-renames (old-fn &rest args)
 | 
			
		||||
  ;; Perhaps a better fix would be to ask for renaming BEFORE starting
 | 
			
		||||
  ;; OLD-FN when `wdired-use-interactive-rename' is non-nil.  For now
 | 
			
		||||
  ;; just bind it to nil to ensure no questions will be asked between
 | 
			
		||||
  ;; each rename.
 | 
			
		||||
  (let (wdired-use-interactive-rename)
 | 
			
		||||
    (apply old-fn args)))
 | 
			
		||||
 | 
			
		||||
(defadvice wdired-do-renames (around wdired-async)
 | 
			
		||||
  (let (wdired-use-interactive-rename)
 | 
			
		||||
    ad-do-it))
 | 
			
		||||
 | 
			
		||||
(defadvice dired-create-files (around dired-async)
 | 
			
		||||
  (dired-async-create-files file-creator operation fn-list
 | 
			
		||||
                            name-constructor marker-char))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-minor-mode dired-async-mode
 | 
			
		||||
  "Do dired actions asynchronously."
 | 
			
		||||
  :group 'dired-async
 | 
			
		||||
  :lighter dired-async-mode-lighter
 | 
			
		||||
  :global t
 | 
			
		||||
  (if dired-async-mode
 | 
			
		||||
      (if (fboundp 'advice-add)
 | 
			
		||||
          (progn (advice-add 'dired-create-files :override #'dired-async-create-files)
 | 
			
		||||
                 (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
 | 
			
		||||
        (ad-activate 'dired-create-files)
 | 
			
		||||
        (ad-activate 'wdired-do-renames))
 | 
			
		||||
      (if (fboundp 'advice-remove)
 | 
			
		||||
          (progn (advice-remove 'dired-create-files #'dired-async-create-files)
 | 
			
		||||
                 (advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
 | 
			
		||||
          (ad-deactivate 'dired-create-files)
 | 
			
		||||
          (ad-deactivate 'wdired-do-renames))))
 | 
			
		||||
 | 
			
		||||
(defmacro dired-async--with-async-create-files (&rest body)
 | 
			
		||||
  "Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."
 | 
			
		||||
  (declare (indent 0))
 | 
			
		||||
  `(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files))
 | 
			
		||||
     ,@body))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun dired-async-do-copy (&optional arg)
 | 
			
		||||
  "Run ‘dired-do-copy’ asynchronously."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (dired-async--with-async-create-files
 | 
			
		||||
    (dired-do-copy arg)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun dired-async-do-symlink (&optional arg)
 | 
			
		||||
  "Run ‘dired-do-symlink’ asynchronously."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (dired-async--with-async-create-files
 | 
			
		||||
    (dired-do-symlink arg)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun dired-async-do-hardlink (&optional arg)
 | 
			
		||||
  "Run ‘dired-do-hardlink’ asynchronously."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (dired-async--with-async-create-files
 | 
			
		||||
    (dired-do-hardlink arg)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun dired-async-do-rename (&optional arg)
 | 
			
		||||
  "Run ‘dired-do-rename’ asynchronously."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (dired-async--with-async-create-files
 | 
			
		||||
    (dired-do-rename arg)))
 | 
			
		||||
 | 
			
		||||
(provide 'dired-async)
 | 
			
		||||
 | 
			
		||||
;;; dired-async.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,73 +0,0 @@
 | 
			
		||||
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
;; Author: John Wiegley <jwiegley@gmail.com>
 | 
			
		||||
;; Created: 18 Jun 2012
 | 
			
		||||
 | 
			
		||||
;; Keywords: email async
 | 
			
		||||
;; X-URL: https://github.com/jwiegley/emacs-async
 | 
			
		||||
 | 
			
		||||
;; This program is free software; you can redistribute it and/or
 | 
			
		||||
;; modify it under the terms of the GNU General Public License as
 | 
			
		||||
;; published by the Free Software Foundation; either version 2, or (at
 | 
			
		||||
;; your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; This program is distributed in the hope that it will be useful, but
 | 
			
		||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
			
		||||
;; General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 | 
			
		||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 | 
			
		||||
;; Boston, MA 02111-1307, USA.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Send e-mail with smtpmail.el asynchronously.  To use:
 | 
			
		||||
;;
 | 
			
		||||
;;   (require 'smtpmail-async)
 | 
			
		||||
;;
 | 
			
		||||
;;   (setq send-mail-function 'async-smtpmail-send-it
 | 
			
		||||
;;         message-send-mail-function 'async-smtpmail-send-it)
 | 
			
		||||
;;
 | 
			
		||||
;; This assumes you already have smtpmail.el working.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(defgroup smtpmail-async nil
 | 
			
		||||
  "Send e-mail with smtpmail.el asynchronously"
 | 
			
		||||
  :group 'smptmail)
 | 
			
		||||
 | 
			
		||||
(require 'async)
 | 
			
		||||
(require 'smtpmail)
 | 
			
		||||
(require 'message)
 | 
			
		||||
 | 
			
		||||
(defvar async-smtpmail-before-send-hook nil
 | 
			
		||||
  "Hook running in the child emacs in `async-smtpmail-send-it'.
 | 
			
		||||
It is called just before calling `smtpmail-send-it'.")
 | 
			
		||||
 | 
			
		||||
(defun async-smtpmail-send-it ()
 | 
			
		||||
  (let ((to          (message-field-value "To"))
 | 
			
		||||
        (buf-content (buffer-substring-no-properties
 | 
			
		||||
                      (point-min) (point-max))))
 | 
			
		||||
    (message "Delivering message to %s..." to)
 | 
			
		||||
    (async-start
 | 
			
		||||
     `(lambda ()
 | 
			
		||||
        (require 'smtpmail)
 | 
			
		||||
        (with-temp-buffer
 | 
			
		||||
          (insert ,buf-content)
 | 
			
		||||
          (set-buffer-multibyte nil)
 | 
			
		||||
          ;; Pass in the variable environment for smtpmail
 | 
			
		||||
          ,(async-inject-variables
 | 
			
		||||
            "\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
 | 
			
		||||
            nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
 | 
			
		||||
          (run-hooks 'async-smtpmail-before-send-hook)
 | 
			
		||||
          (smtpmail-send-it)))
 | 
			
		||||
     (lambda (&optional _ignore)
 | 
			
		||||
       (message "Delivering message to %s...done" to)))))
 | 
			
		||||
 | 
			
		||||
(provide 'smtpmail-async)
 | 
			
		||||
 | 
			
		||||
;;; smtpmail-async.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,15 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,2 +0,0 @@
 | 
			
		||||
;;; -*- no-byte-compile: t -*-
 | 
			
		||||
(define-package "dash" "20180910.1856" "A modern list library for Emacs" 'nil :commit "6514359b8606a6a9a94068ccd601fcd6379d6584" :keywords '("lists") :authors '(("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Magnar Sveen" . "magnars@gmail.com"))
 | 
			
		||||
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,35 +0,0 @@
 | 
			
		||||
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.
 | 
			
		||||
@ -1,128 +0,0 @@
 | 
			
		||||
;;; 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.
										
									
								
							@ -1,18 +0,0 @@
 | 
			
		||||
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.
 | 
			
		||||
@ -1,50 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,440 +0,0 @@
 | 
			
		||||
;;; ghub-graphql.el --- access Github API using GrapthQL  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2016-2018  Jonas Bernoulli
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Homepage: https://github.com/magit/ghub
 | 
			
		||||
 | 
			
		||||
;; This file is not part of GNU Emacs.
 | 
			
		||||
 | 
			
		||||
;; This file is free software; you can redistribute it and/or modify
 | 
			
		||||
;; it under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
 | 
			
		||||
;; This file is distributed in the hope that it will be useful,
 | 
			
		||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
			
		||||
;; GNU General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'dash)
 | 
			
		||||
(require 'ghub)
 | 
			
		||||
(require 'graphql)
 | 
			
		||||
(require 'subr-x)
 | 
			
		||||
(require 'treepy)
 | 
			
		||||
 | 
			
		||||
;;; Api
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub-graphql (graphql &optional variables
 | 
			
		||||
                                &key username auth host
 | 
			
		||||
                                silent
 | 
			
		||||
                                callback errorback value extra)
 | 
			
		||||
  "Make a GraphQL request using GRAPHQL and VARIABLES.
 | 
			
		||||
Return the response as a JSON-like alist.  Even if the response
 | 
			
		||||
contains `errors', do not raise an error.  GRAPHQL is a GraphQL
 | 
			
		||||
string.  VARIABLES is a JSON-like alist.  The other arguments
 | 
			
		||||
behave as for `ghub-request' (which see)."
 | 
			
		||||
  (cl-assert (stringp graphql))
 | 
			
		||||
  (cl-assert (not (stringp variables)))
 | 
			
		||||
  (ghub-request "POST" "/graphql" nil :payload
 | 
			
		||||
                (json-encode `(("query" . ,graphql)
 | 
			
		||||
                               ,@(and variables `(("variables" ,@variables)))))
 | 
			
		||||
                :silent silent
 | 
			
		||||
                :username username :auth auth :host host
 | 
			
		||||
                :callback callback :errorback errorback
 | 
			
		||||
                :extra extra :value value))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub-graphql-rate-limit (&key username auth host)
 | 
			
		||||
  "Return rate limit information."
 | 
			
		||||
  (let-alist (ghub-graphql
 | 
			
		||||
              "query { rateLimit { limit cost remaining resetAt }}"
 | 
			
		||||
              nil :username username :auth auth :host host)
 | 
			
		||||
    .data.rateLimit))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub--repository-id (owner name &key username auth host)
 | 
			
		||||
  "Return the id of the repository specified by OWNER, NAME and HOST."
 | 
			
		||||
  (let-alist (ghub-graphql
 | 
			
		||||
              "query ($owner:String!, $name:String!) {
 | 
			
		||||
                 repository(owner:$owner, name:$name) { id }
 | 
			
		||||
               }"
 | 
			
		||||
              `((owner . ,owner)
 | 
			
		||||
                (name  . ,name))
 | 
			
		||||
              :username username :auth auth :host host)
 | 
			
		||||
    .data.repository.id))
 | 
			
		||||
 | 
			
		||||
;;; Api (drafts)
 | 
			
		||||
 | 
			
		||||
(defconst ghub-fetch-repository
 | 
			
		||||
  '(query
 | 
			
		||||
    (repository
 | 
			
		||||
     [(owner $owner String!)
 | 
			
		||||
      (name  $name  String!)]
 | 
			
		||||
     name
 | 
			
		||||
     id
 | 
			
		||||
     createdAt
 | 
			
		||||
     updatedAt
 | 
			
		||||
     nameWithOwner
 | 
			
		||||
     description
 | 
			
		||||
     (defaultBranchRef name)
 | 
			
		||||
     isArchived
 | 
			
		||||
     isFork
 | 
			
		||||
     isLocked
 | 
			
		||||
     isMirror
 | 
			
		||||
     isPrivate
 | 
			
		||||
     hasIssuesEnabled
 | 
			
		||||
     hasWikiEnabled
 | 
			
		||||
     (licenseInfo name)
 | 
			
		||||
     (stargazers totalCount)
 | 
			
		||||
     (watchers totalCount)
 | 
			
		||||
     (assignableUsers [(:edges t)]
 | 
			
		||||
                      id
 | 
			
		||||
                      login
 | 
			
		||||
                      name)
 | 
			
		||||
     (issues         [(:edges t)
 | 
			
		||||
                      (:singular issue number)
 | 
			
		||||
                      (orderBy ((field . UPDATED_AT) (direction . DESC)))]
 | 
			
		||||
                     number
 | 
			
		||||
                     state
 | 
			
		||||
                     (author login)
 | 
			
		||||
                     title
 | 
			
		||||
                     createdAt
 | 
			
		||||
                     updatedAt
 | 
			
		||||
                     closedAt
 | 
			
		||||
                     locked
 | 
			
		||||
                     (milestone id)
 | 
			
		||||
                     body
 | 
			
		||||
                     (assignees [(:edges t)]
 | 
			
		||||
                                id)
 | 
			
		||||
                     (comments  [(:edges t)]
 | 
			
		||||
                                databaseId
 | 
			
		||||
                                (author login)
 | 
			
		||||
	                        createdAt
 | 
			
		||||
	                        updatedAt
 | 
			
		||||
                                body)
 | 
			
		||||
                     (labels    [(:edges t)]
 | 
			
		||||
                                id))
 | 
			
		||||
     (labels         [(:edges t)
 | 
			
		||||
                      (:singular label id)]
 | 
			
		||||
                     id
 | 
			
		||||
                     name
 | 
			
		||||
                     color
 | 
			
		||||
                     description)
 | 
			
		||||
     (pullRequests   [(:edges t)
 | 
			
		||||
                      (:singular pullRequest number)
 | 
			
		||||
                      (orderBy ((field . UPDATED_AT) (direction . DESC)))]
 | 
			
		||||
                     number
 | 
			
		||||
                     state
 | 
			
		||||
                     (author login)
 | 
			
		||||
                     title
 | 
			
		||||
                     createdAt
 | 
			
		||||
                     updatedAt
 | 
			
		||||
                     closedAt
 | 
			
		||||
                     mergedAt
 | 
			
		||||
                     locked
 | 
			
		||||
                     maintainerCanModify
 | 
			
		||||
                     isCrossRepository
 | 
			
		||||
                     (milestone id)
 | 
			
		||||
                     body
 | 
			
		||||
                     (baseRef name
 | 
			
		||||
                              (repository nameWithOwner))
 | 
			
		||||
                     (headRef name
 | 
			
		||||
                              (repository (owner login)
 | 
			
		||||
                                          nameWithOwner))
 | 
			
		||||
                     (assignees [(:edges t)]
 | 
			
		||||
                                id)
 | 
			
		||||
                     (comments  [(:edges t)]
 | 
			
		||||
                                databaseId
 | 
			
		||||
                                (author login)
 | 
			
		||||
                                createdAt
 | 
			
		||||
	                        updatedAt
 | 
			
		||||
	                        body)
 | 
			
		||||
                     (labels    [(:edges t)]
 | 
			
		||||
                                id)))))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub-fetch-repository (owner name callback
 | 
			
		||||
                                       &optional until
 | 
			
		||||
                                       &key username auth host forge)
 | 
			
		||||
  "Asynchronously fetch forge data about the specified repository.
 | 
			
		||||
Once all data has been collected, CALLBACK is called with the
 | 
			
		||||
data as the only argument."
 | 
			
		||||
  (ghub--graphql-vacuum ghub-fetch-repository
 | 
			
		||||
                        `((owner . ,owner)
 | 
			
		||||
                          (name  . ,name))
 | 
			
		||||
                        callback until
 | 
			
		||||
                        :narrow   '(repository)
 | 
			
		||||
                        :username username
 | 
			
		||||
                        :auth     auth
 | 
			
		||||
                        :host     host
 | 
			
		||||
                        :forge    forge))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub-fetch-issue (owner name number callback
 | 
			
		||||
                                  &optional until
 | 
			
		||||
                                  &key username auth host forge)
 | 
			
		||||
  "Asynchronously fetch forge data about the specified issue.
 | 
			
		||||
Once all data has been collected, CALLBACK is called with the
 | 
			
		||||
data as the only argument."
 | 
			
		||||
  (ghub--graphql-vacuum (ghub--graphql-prepare-query
 | 
			
		||||
                         ghub-fetch-repository
 | 
			
		||||
                         `(repository issues (issue . ,number)))
 | 
			
		||||
                        `((owner . ,owner)
 | 
			
		||||
                          (name  . ,name))
 | 
			
		||||
                        callback until
 | 
			
		||||
                        :narrow   '(repository issue)
 | 
			
		||||
                        :username username
 | 
			
		||||
                        :auth     auth
 | 
			
		||||
                        :host     host
 | 
			
		||||
                        :forge    forge))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub-fetch-pullreq (owner name number callback
 | 
			
		||||
                                    &optional until
 | 
			
		||||
                                    &key username auth host forge)
 | 
			
		||||
  "Asynchronously fetch forge data about the specified pull-request.
 | 
			
		||||
Once all data has been collected, CALLBACK is called with the
 | 
			
		||||
data as the only argument."
 | 
			
		||||
  (ghub--graphql-vacuum (ghub--graphql-prepare-query
 | 
			
		||||
                         ghub-fetch-repository
 | 
			
		||||
                         `(repository pullRequests (pullRequest . ,number)))
 | 
			
		||||
                        `((owner . ,owner)
 | 
			
		||||
                          (name  . ,name))
 | 
			
		||||
                        callback until
 | 
			
		||||
                        :narrow   '(repository pullRequest)
 | 
			
		||||
                        :username username
 | 
			
		||||
                        :auth     auth
 | 
			
		||||
                        :host     host
 | 
			
		||||
                        :forge    forge))
 | 
			
		||||
 | 
			
		||||
;;; Internal
 | 
			
		||||
 | 
			
		||||
(cl-defstruct (ghub--graphql-req
 | 
			
		||||
               (:include ghub--req)
 | 
			
		||||
               (:constructor ghub--make-graphql-req)
 | 
			
		||||
               (:copier nil))
 | 
			
		||||
  (query     nil :read-only t)
 | 
			
		||||
  (variables nil :read-only t)
 | 
			
		||||
  (until     nil :read-only t)
 | 
			
		||||
  (pages     0   :read-only nil))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub--graphql-vacuum (query variables callback
 | 
			
		||||
                                      &optional until
 | 
			
		||||
                                      &key narrow username auth host forge)
 | 
			
		||||
  "Make a GraphQL request using QUERY and VARIABLES.
 | 
			
		||||
See Info node `(ghub)GraphQL Support'."
 | 
			
		||||
  (unless host
 | 
			
		||||
    (setq host (ghub--host forge)))
 | 
			
		||||
  (unless (or username (stringp auth) (eq auth 'none))
 | 
			
		||||
    (setq username (ghub--username host forge)))
 | 
			
		||||
  (ghub--graphql-retrieve
 | 
			
		||||
   (ghub--make-graphql-req
 | 
			
		||||
    :url       (url-generic-parse-url (concat "https://" host "/graphql"))
 | 
			
		||||
    :method    "POST"
 | 
			
		||||
    :headers   (ghub--headers nil host auth username forge)
 | 
			
		||||
    :handler   'ghub--graphql-handle-response
 | 
			
		||||
    :query     query
 | 
			
		||||
    :variables variables
 | 
			
		||||
    :until     until
 | 
			
		||||
    :callback  (if narrow
 | 
			
		||||
                   (lambda (data)
 | 
			
		||||
                     (let ((path narrow) key)
 | 
			
		||||
                       (while (setq key (pop path))
 | 
			
		||||
                         (setq data (cdr (assq key data)))))
 | 
			
		||||
                     (funcall callback data))
 | 
			
		||||
                 callback))))
 | 
			
		||||
 | 
			
		||||
(cl-defun ghub--graphql-retrieve (req &optional lineage cursor)
 | 
			
		||||
  (let ((p (cl-incf (ghub--graphql-req-pages req))))
 | 
			
		||||
    (when (> p 1)
 | 
			
		||||
      (message "Fetching page %s..." p)))
 | 
			
		||||
  (ghub--retrieve
 | 
			
		||||
   (let ((json-false nil))
 | 
			
		||||
     (ghub--encode-payload
 | 
			
		||||
      `((query     . ,(ghub--graphql-encode
 | 
			
		||||
                       (ghub--graphql-prepare-query
 | 
			
		||||
                        (ghub--graphql-req-query req)
 | 
			
		||||
                        lineage cursor)))
 | 
			
		||||
        (variables . ,(ghub--graphql-req-variables req)))))
 | 
			
		||||
   req))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-prepare-query (query &optional lineage cursor)
 | 
			
		||||
  (when lineage
 | 
			
		||||
    (setq query (ghub--graphql-narrow-query query lineage cursor)))
 | 
			
		||||
  (let ((loc (ghub--alist-zip query))
 | 
			
		||||
        variables)
 | 
			
		||||
    (cl-block nil
 | 
			
		||||
      (while t
 | 
			
		||||
        (let ((node (treepy-node loc)))
 | 
			
		||||
          (when (vectorp node)
 | 
			
		||||
            (let ((alist (cl-coerce node 'list))
 | 
			
		||||
                  vars)
 | 
			
		||||
              (when (assq :edges alist)
 | 
			
		||||
                (push (list 'first 100) vars)
 | 
			
		||||
                (setq loc  (treepy-up loc))
 | 
			
		||||
                (setq node (treepy-node loc))
 | 
			
		||||
                (setq loc  (treepy-replace
 | 
			
		||||
                            loc `(,(car  node)
 | 
			
		||||
                                  ,(cadr node)
 | 
			
		||||
                                  (pageInfo endCursor hasNextPage)
 | 
			
		||||
                                  (edges (node ,@(cddr node))))))
 | 
			
		||||
                (setq loc  (treepy-down loc))
 | 
			
		||||
                (setq loc  (treepy-next loc)))
 | 
			
		||||
              (dolist (elt alist)
 | 
			
		||||
                (cond ((keywordp (car elt)))
 | 
			
		||||
                      ((= (length elt) 3)
 | 
			
		||||
                       (push (list (nth 0 elt)
 | 
			
		||||
                                   (nth 1 elt)) vars)
 | 
			
		||||
                       (push (list (nth 1 elt)
 | 
			
		||||
                                   (nth 2 elt)) variables))
 | 
			
		||||
                      ((= (length elt) 2)
 | 
			
		||||
                       (push elt vars))))
 | 
			
		||||
              (setq loc (treepy-replace loc (cl-coerce vars 'vector))))))
 | 
			
		||||
        (if (treepy-end-p loc)
 | 
			
		||||
            (let ((node (copy-sequence (treepy-node loc))))
 | 
			
		||||
              (when variables
 | 
			
		||||
                (push (cl-coerce variables 'vector)
 | 
			
		||||
                      (cdr node)))
 | 
			
		||||
              (cl-return node))
 | 
			
		||||
          (setq loc (treepy-next loc)))))))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-handle-response (status req)
 | 
			
		||||
  (let ((buffer (current-buffer)))
 | 
			
		||||
    (unwind-protect
 | 
			
		||||
        (progn
 | 
			
		||||
          (set-buffer-multibyte t)
 | 
			
		||||
          (let* ((headers (ghub--handle-response-headers status req))
 | 
			
		||||
                 (payload (ghub--handle-response-payload req))
 | 
			
		||||
                 (payload (ghub--handle-response-error status payload req))
 | 
			
		||||
                 (err     (plist-get status :error))
 | 
			
		||||
                 (errors  (cdr (assq 'errors payload)))
 | 
			
		||||
                 (errors  (and errors
 | 
			
		||||
                               (cons 'ghub-graphql-error errors)))
 | 
			
		||||
                 (data    (assq 'data payload))
 | 
			
		||||
                 (value   (ghub--req-value req)))
 | 
			
		||||
            (setf (ghub--req-value req) value)
 | 
			
		||||
            (if (or err errors)
 | 
			
		||||
                (if-let ((errorback (ghub--req-errorback req)))
 | 
			
		||||
                    (funcall errorback (or err errors) headers status req)
 | 
			
		||||
                  (ghub--signal-error (or err errors)))
 | 
			
		||||
              (ghub--graphql-walk-response value data req))))
 | 
			
		||||
      (when (buffer-live-p buffer)
 | 
			
		||||
        (kill-buffer buffer)))))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-walk-response (loc data req)
 | 
			
		||||
  (if (not loc)
 | 
			
		||||
      (setf (ghub--req-value req)
 | 
			
		||||
            (setq loc (ghub--alist-zip data)))
 | 
			
		||||
    (setq data (ghub--graphql-narrow-data data (ghub--graphql-lineage loc)))
 | 
			
		||||
    (setf (alist-get 'edges data)
 | 
			
		||||
          (append (alist-get 'edges (treepy-node loc))
 | 
			
		||||
                  (or (alist-get 'edges data)
 | 
			
		||||
                      (error "BUG: Expected new nodes"))))
 | 
			
		||||
    (setq loc (treepy-replace loc data)))
 | 
			
		||||
  (cl-block nil
 | 
			
		||||
    (while t
 | 
			
		||||
      (when (eq (car-safe (treepy-node loc)) 'edges)
 | 
			
		||||
        (setq loc (treepy-up loc))
 | 
			
		||||
        (pcase-let ((`(,key . ,val) (treepy-node loc)))
 | 
			
		||||
          (let-alist val
 | 
			
		||||
            (let* ((cursor (and .pageInfo.hasNextPage
 | 
			
		||||
                                .pageInfo.endCursor))
 | 
			
		||||
                   (until (cdr (assq (intern (format "%s-until" key))
 | 
			
		||||
                                     (ghub--graphql-req-until req))))
 | 
			
		||||
                   (nodes (mapcar #'cdar .edges))
 | 
			
		||||
                   (nodes (if until
 | 
			
		||||
                              (--take-while
 | 
			
		||||
                               (or (string> (cdr (assq 'updatedAt it)) until)
 | 
			
		||||
                                   (setq cursor nil))
 | 
			
		||||
                               nodes)
 | 
			
		||||
                            nodes)))
 | 
			
		||||
              (if cursor
 | 
			
		||||
                  (progn
 | 
			
		||||
                    (setf (ghub--req-value req) loc)
 | 
			
		||||
                    (ghub--graphql-retrieve req
 | 
			
		||||
                                            (ghub--graphql-lineage loc)
 | 
			
		||||
                                            cursor)
 | 
			
		||||
                    (cl-return))
 | 
			
		||||
                (setq loc (treepy-replace loc (cons key nodes))))))))
 | 
			
		||||
      (if (not (treepy-end-p loc))
 | 
			
		||||
          (setq loc (treepy-next loc))
 | 
			
		||||
        (funcall (ghub--req-callback req)
 | 
			
		||||
                 (treepy-root loc))
 | 
			
		||||
        (cl-return)))))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-lineage (loc)
 | 
			
		||||
  (let (lineage)
 | 
			
		||||
    (while (treepy-up loc)
 | 
			
		||||
      (push (car (treepy-node loc)) lineage)
 | 
			
		||||
      (setq loc (treepy-up loc)))
 | 
			
		||||
    lineage))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-narrow-data (data lineage)
 | 
			
		||||
  (let (key)
 | 
			
		||||
    (while (setq key (pop lineage))
 | 
			
		||||
      (if (consp (car lineage))
 | 
			
		||||
          (progn (pop lineage)
 | 
			
		||||
                 (setf data (cadr data)))
 | 
			
		||||
        (setq data (assq key (cdr data))))))
 | 
			
		||||
  data)
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-narrow-query (query lineage cursor)
 | 
			
		||||
  (if (consp (car lineage))
 | 
			
		||||
      (let* ((child  (cddr query))
 | 
			
		||||
             (alist  (cl-coerce (cadr query) 'list))
 | 
			
		||||
             (single (cdr (assq :singular alist))))
 | 
			
		||||
        `(,(car single)
 | 
			
		||||
          ,(vector (list (cadr single) (cdr (car lineage))))
 | 
			
		||||
          ,@(if (cdr lineage)
 | 
			
		||||
               (ghub--graphql-narrow-query child (cdr lineage) cursor)
 | 
			
		||||
             child)))
 | 
			
		||||
    (let* ((child  (or (assq (car lineage) (cdr query))
 | 
			
		||||
                       (cl-find-if (lambda (c)
 | 
			
		||||
                                     (and (listp c)
 | 
			
		||||
                                          (vectorp (cadr c))
 | 
			
		||||
                                          (eq (cadr (assq :singular
 | 
			
		||||
                                                          (cl-coerce (cadr c)
 | 
			
		||||
                                                                     'list)))
 | 
			
		||||
                                              (car lineage))))
 | 
			
		||||
                                   (cdr query))))
 | 
			
		||||
           (object (car query))
 | 
			
		||||
           (args   (and (vectorp (cadr query))
 | 
			
		||||
                        (cadr query))))
 | 
			
		||||
      `(,object
 | 
			
		||||
        ,@(and args (list args))
 | 
			
		||||
        ,(cond ((cdr lineage)
 | 
			
		||||
                (ghub--graphql-narrow-query child (cdr lineage) cursor))
 | 
			
		||||
               (cursor
 | 
			
		||||
                `(,(car child)
 | 
			
		||||
                  ,(vconcat `((after ,cursor))
 | 
			
		||||
                            (cadr child))
 | 
			
		||||
                  ,@(cddr child)))
 | 
			
		||||
               (t
 | 
			
		||||
                child))))))
 | 
			
		||||
 | 
			
		||||
(defun ghub--graphql-encode (g)
 | 
			
		||||
  (if (symbolp g)
 | 
			
		||||
      (symbol-name g)
 | 
			
		||||
    (let* ((object (car g))
 | 
			
		||||
           (args   (and (vectorp (cadr g))
 | 
			
		||||
                        (cl-coerce (cadr g) 'list)))
 | 
			
		||||
           (fields (if args (cddr g) (cdr g))))
 | 
			
		||||
       (concat
 | 
			
		||||
        (graphql--encode-object object)
 | 
			
		||||
        (and args
 | 
			
		||||
             (format " (\n%s)"
 | 
			
		||||
                     (mapconcat (pcase-lambda (`(,key ,val))
 | 
			
		||||
                                  (graphql--encode-argument key val))
 | 
			
		||||
                                args ",\n")))
 | 
			
		||||
        (and fields
 | 
			
		||||
             (format " {\n%s\n}"
 | 
			
		||||
                     (mapconcat #'ghub--graphql-encode fields "\n")))))))
 | 
			
		||||
 | 
			
		||||
(defun ghub--alist-zip (root)
 | 
			
		||||
  (let ((branchp (lambda (elt) (and (listp elt) (listp (cdr elt)))))
 | 
			
		||||
        (make-node (lambda (_ children) children)))
 | 
			
		||||
    (treepy-zipper branchp #'identity make-node root)))
 | 
			
		||||
 | 
			
		||||
;;; _
 | 
			
		||||
(provide 'ghub-graphql)
 | 
			
		||||
;;; ghub-graphql.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,9 +0,0 @@
 | 
			
		||||
(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:
 | 
			
		||||
@ -1,929 +0,0 @@
 | 
			
		||||
;;; 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
											
										
									
								
							@ -1,153 +0,0 @@
 | 
			
		||||
;;; 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.
										
									
								
							@ -1,140 +0,0 @@
 | 
			
		||||
;;; 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.
										
									
								
							@ -1,140 +0,0 @@
 | 
			
		||||
;;; 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.
										
									
								
							@ -1,48 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,2 +0,0 @@
 | 
			
		||||
;;; -*- 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")
 | 
			
		||||
@ -1,900 +0,0 @@
 | 
			
		||||
;;; git-commit.el --- Edit Git commit messages  -*- lexical-binding: t; -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Authors: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;;	Sebastian Wiesner <lunaryorn@gmail.com>
 | 
			
		||||
;;	Florian Ragwitz <rafl@debian.org>
 | 
			
		||||
;;	Marius Vollmer <marius.vollmer@gmail.com>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Package-Requires: ((emacs "25.1") (dash "20180413") (with-editor "20180414"))
 | 
			
		||||
;; Package-Version: 20180912.1012
 | 
			
		||||
;; Keywords: git tools vc
 | 
			
		||||
;; Homepage: https://github.com/magit/magit
 | 
			
		||||
 | 
			
		||||
;; This file is not part of GNU Emacs.
 | 
			
		||||
 | 
			
		||||
;; This file is free software; you can redistribute it and/or modify
 | 
			
		||||
;; it under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
 | 
			
		||||
;; This file is distributed in the hope that it will be useful,
 | 
			
		||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
			
		||||
;; GNU General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This package assists the user in writing good Git commit messages.
 | 
			
		||||
 | 
			
		||||
;; While Git allows for the message to be provided on the command
 | 
			
		||||
;; line, it is preferable to tell Git to create the commit without
 | 
			
		||||
;; actually passing it a message.  Git then invokes the `$GIT_EDITOR'
 | 
			
		||||
;; (or if that is undefined `$EDITOR') asking the user to provide the
 | 
			
		||||
;; message by editing the file ".git/COMMIT_EDITMSG" (or another file
 | 
			
		||||
;; in that directory, e.g. ".git/MERGE_MSG" for merge commits).
 | 
			
		||||
 | 
			
		||||
;; When `global-git-commit-mode' is enabled, which it is by default,
 | 
			
		||||
;; then opening such a file causes the features described below, to
 | 
			
		||||
;; be enabled in that buffer.  Normally this would be done using a
 | 
			
		||||
;; major-mode but to allow the use of any major-mode, as the user sees
 | 
			
		||||
;; fit, it is done here by running a setup function, which among other
 | 
			
		||||
;; things turns on the preferred major-mode, by default `text-mode'.
 | 
			
		||||
 | 
			
		||||
;; Git waits for the `$EDITOR' to finish and then either creates the
 | 
			
		||||
;; commit using the contents of the file as commit message, or, if the
 | 
			
		||||
;; editor process exited with a non-zero exit status, aborts without
 | 
			
		||||
;; creating a commit.  Unfortunately Emacsclient (which is what Emacs
 | 
			
		||||
;; users should be using as `$EDITOR' or at least as `$GIT_EDITOR')
 | 
			
		||||
;; does not differentiate between "successfully" editing a file and
 | 
			
		||||
;; aborting; not out of the box that is.
 | 
			
		||||
 | 
			
		||||
;; By making use of the `with-editor' package this package provides
 | 
			
		||||
;; both ways of finish an editing session.  In either case the file
 | 
			
		||||
;; is saved, but Emacseditor's exit code differs.
 | 
			
		||||
;;
 | 
			
		||||
;;   C-c C-c  Finish the editing session successfully by returning
 | 
			
		||||
;;            with exit code 0.  Git then creates the commit using
 | 
			
		||||
;;            the message it finds in the file.
 | 
			
		||||
;;
 | 
			
		||||
;;   C-c C-k  Aborts the edit editing session by returning with exit
 | 
			
		||||
;;            code 1.  Git then aborts the commit.
 | 
			
		||||
 | 
			
		||||
;; Aborting the commit does not cause the message to be lost, but
 | 
			
		||||
;; relying solely on the file not being tampered with is risky.  This
 | 
			
		||||
;; package additionally stores all aborted messages for the duration
 | 
			
		||||
;; of the current session (i.e. until you close Emacs).  To get back
 | 
			
		||||
;; an aborted message use M-p and M-n while editing a message.
 | 
			
		||||
;;
 | 
			
		||||
;;   M-p      Replace the buffer contents with the previous message
 | 
			
		||||
;;            from the message ring.  Of course only after storing
 | 
			
		||||
;;            the current content there too.
 | 
			
		||||
;;
 | 
			
		||||
;;   M-n      Replace the buffer contents with the next message from
 | 
			
		||||
;;            the message ring, after storing the current content.
 | 
			
		||||
 | 
			
		||||
;; Some support for pseudo headers as used in some projects is
 | 
			
		||||
;; provided by these commands:
 | 
			
		||||
;;
 | 
			
		||||
;;   C-c C-s  Insert a Signed-off-by header.
 | 
			
		||||
;;   C-c C-a  Insert a Acked-by header.
 | 
			
		||||
;;   C-c C-m  Insert a Modified-by header.
 | 
			
		||||
;;   C-c C-t  Insert a Tested-by header.
 | 
			
		||||
;;   C-c C-r  Insert a Reviewed-by header.
 | 
			
		||||
;;   C-c C-o  Insert a Cc header.
 | 
			
		||||
;;   C-c C-p  Insert a Reported-by header.
 | 
			
		||||
;;   C-c M-s  Insert a Suggested-by header.
 | 
			
		||||
 | 
			
		||||
;; When Git requests a commit message from the user, it does so by
 | 
			
		||||
;; having her edit a file which initially contains some comments,
 | 
			
		||||
;; instructing her what to do, and providing useful information, such
 | 
			
		||||
;; as which files were modified.  These comments, even when left
 | 
			
		||||
;; intact by the user, do not become part of the commit message.  This
 | 
			
		||||
;; package ensures these comments are propertizes as such and further
 | 
			
		||||
;; prettifies them by using different faces for various parts, such as
 | 
			
		||||
;; files.
 | 
			
		||||
 | 
			
		||||
;; Finally this package highlights style errors, like lines that are
 | 
			
		||||
;; too long, or when the second line is not empty.  It may even nag
 | 
			
		||||
;; you when you attempt to finish the commit without having fixed
 | 
			
		||||
;; these issues.  The style checks and many other settings can easily
 | 
			
		||||
;; be configured:
 | 
			
		||||
;;
 | 
			
		||||
;;   M-x customize-group RET git-commit RET
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
;;;; Dependencies
 | 
			
		||||
 | 
			
		||||
(require 'dash)
 | 
			
		||||
(require 'log-edit)
 | 
			
		||||
(require 'magit-git nil t)
 | 
			
		||||
(require 'magit-utils nil t)
 | 
			
		||||
(require 'ring)
 | 
			
		||||
(require 'server)
 | 
			
		||||
(require 'with-editor)
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'recentf))
 | 
			
		||||
 | 
			
		||||
;;;; Declarations
 | 
			
		||||
 | 
			
		||||
(defvar diff-default-read-only)
 | 
			
		||||
(defvar flyspell-generic-check-word-predicate)
 | 
			
		||||
(defvar font-lock-beg)
 | 
			
		||||
(defvar font-lock-end)
 | 
			
		||||
 | 
			
		||||
(declare-function magit-expand-git-file-name "magit-git" (filename))
 | 
			
		||||
(declare-function magit-list-local-branch-names "magit-git" ())
 | 
			
		||||
(declare-function magit-list-remote-branch-names "magit-git"
 | 
			
		||||
                  (&optional remote relative))
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
;;;; Variables
 | 
			
		||||
 | 
			
		||||
(defgroup git-commit nil
 | 
			
		||||
  "Edit Git commit messages."
 | 
			
		||||
  :prefix "git-commit-"
 | 
			
		||||
  :link '(info-link "(magit)Editing Commit Messages")
 | 
			
		||||
  :group 'tools)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-minor-mode global-git-commit-mode
 | 
			
		||||
  "Edit Git commit messages.
 | 
			
		||||
This global mode arranges for `git-commit-setup' to be called
 | 
			
		||||
when a Git commit message file is opened.  That usually happens
 | 
			
		||||
when Git uses the Emacsclient as $GIT_EDITOR to have the user
 | 
			
		||||
provide such a commit message."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :type 'boolean
 | 
			
		||||
  :global t
 | 
			
		||||
  :init-value t
 | 
			
		||||
  :initialize (lambda (symbol exp)
 | 
			
		||||
                (custom-initialize-default symbol exp)
 | 
			
		||||
                (when global-git-commit-mode
 | 
			
		||||
                  (add-hook 'find-file-hook 'git-commit-setup-check-buffer)))
 | 
			
		||||
  (if global-git-commit-mode
 | 
			
		||||
      (add-hook  'find-file-hook 'git-commit-setup-check-buffer)
 | 
			
		||||
    (remove-hook 'find-file-hook 'git-commit-setup-check-buffer)))
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-major-mode 'text-mode
 | 
			
		||||
  "Major mode used to edit Git commit messages.
 | 
			
		||||
The major mode configured here is turned on by the minor mode
 | 
			
		||||
`git-commit-mode'."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :type '(choice (function-item text-mode)
 | 
			
		||||
                 (const :tag "No major mode")))
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-setup-hook
 | 
			
		||||
  '(git-commit-save-message
 | 
			
		||||
    git-commit-setup-changelog-support
 | 
			
		||||
    git-commit-turn-on-auto-fill
 | 
			
		||||
    git-commit-propertize-diff
 | 
			
		||||
    with-editor-usage-message)
 | 
			
		||||
  "Hook run at the end of `git-commit-setup'."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :type 'hook
 | 
			
		||||
  :get (and (featurep 'magit-utils) 'magit-hook-custom-get)
 | 
			
		||||
  :options '(git-commit-save-message
 | 
			
		||||
             git-commit-setup-changelog-support
 | 
			
		||||
             git-commit-turn-on-auto-fill
 | 
			
		||||
             git-commit-turn-on-flyspell
 | 
			
		||||
             git-commit-propertize-diff
 | 
			
		||||
             bug-reference-mode
 | 
			
		||||
             with-editor-usage-message))
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-finish-query-functions
 | 
			
		||||
  '(git-commit-check-style-conventions)
 | 
			
		||||
  "List of functions called to query before performing commit.
 | 
			
		||||
 | 
			
		||||
The commit message buffer is current while the functions are
 | 
			
		||||
called.  If any of them returns nil, then the commit is not
 | 
			
		||||
performed and the buffer is not killed.  The user should then
 | 
			
		||||
fix the issue and try again.
 | 
			
		||||
 | 
			
		||||
The functions are called with one argument.  If it is non-nil,
 | 
			
		||||
then that indicates that the user used a prefix argument to
 | 
			
		||||
force finishing the session despite issues.  Functions should
 | 
			
		||||
usually honor this wish and return non-nil."
 | 
			
		||||
  :options '(git-commit-check-style-conventions)
 | 
			
		||||
  :type 'hook
 | 
			
		||||
  :group 'git-commit)
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-style-convention-checks '(non-empty-second-line)
 | 
			
		||||
  "List of checks performed by `git-commit-check-style-conventions'.
 | 
			
		||||
Valid members are `non-empty-second-line' and `overlong-summary-line'.
 | 
			
		||||
That function is a member of `git-commit-finish-query-functions'."
 | 
			
		||||
  :options '(non-empty-second-line overlong-summary-line)
 | 
			
		||||
  :type '(list :convert-widget custom-hook-convert-widget)
 | 
			
		||||
  :group 'git-commit)
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-summary-max-length 68
 | 
			
		||||
  "Column beyond which characters in the summary lines are highlighted.
 | 
			
		||||
 | 
			
		||||
The highlighting indicates that the summary is getting too long
 | 
			
		||||
by some standards.  It does in no way imply that going over the
 | 
			
		||||
limit a few characters or in some cases even many characters is
 | 
			
		||||
anything that deserves shaming.  It's just a friendly reminder
 | 
			
		||||
that if you can make the summary shorter, then you might want
 | 
			
		||||
to consider doing so."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :safe 'numberp
 | 
			
		||||
  :type 'number)
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-fill-column nil
 | 
			
		||||
  "Override `fill-column' in commit message buffers.
 | 
			
		||||
 | 
			
		||||
If this is non-nil, then it should be an integer.  If that is the
 | 
			
		||||
case and the buffer-local value of `fill-column' is not already
 | 
			
		||||
set by the time `git-commit-turn-on-auto-fill' is called as a
 | 
			
		||||
member of `git-commit-setup-hook', then that function sets the
 | 
			
		||||
buffer-local value of `fill-column' to the value of this option.
 | 
			
		||||
 | 
			
		||||
This option exists mostly for historic reasons.  If you are not
 | 
			
		||||
already using it, then you probably shouldn't start doing so."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :safe 'numberp
 | 
			
		||||
  :type '(choice (const :tag "use regular fill-column")
 | 
			
		||||
                 number))
 | 
			
		||||
 | 
			
		||||
(make-obsolete-variable 'git-commit-fill-column 'fill-column
 | 
			
		||||
                        "Magit 2.11.0" 'set)
 | 
			
		||||
 | 
			
		||||
(defcustom git-commit-known-pseudo-headers
 | 
			
		||||
  '("Signed-off-by" "Acked-by" "Modified-by" "Cc"
 | 
			
		||||
    "Suggested-by" "Reported-by" "Tested-by" "Reviewed-by")
 | 
			
		||||
  "A list of Git pseudo headers to be highlighted."
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :safe (lambda (val) (and (listp val) (-all-p 'stringp val)))
 | 
			
		||||
  :type '(repeat string))
 | 
			
		||||
 | 
			
		||||
;;;; Faces
 | 
			
		||||
 | 
			
		||||
(defgroup git-commit-faces nil
 | 
			
		||||
  "Faces used for highlighting Git commit messages."
 | 
			
		||||
  :prefix "git-commit-"
 | 
			
		||||
  :group 'git-commit
 | 
			
		||||
  :group 'faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-summary
 | 
			
		||||
  '((t :inherit font-lock-type-face))
 | 
			
		||||
  "Face used for the summary in commit messages."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-overlong-summary
 | 
			
		||||
  '((t :inherit font-lock-warning-face))
 | 
			
		||||
  "Face used for the tail of overlong commit message summaries."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-nonempty-second-line
 | 
			
		||||
  '((t :inherit font-lock-warning-face))
 | 
			
		||||
  "Face used for non-whitespace on the second line of commit messages."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-note
 | 
			
		||||
  '((t :inherit font-lock-string-face))
 | 
			
		||||
  "Face used for notes in commit messages."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-pseudo-header
 | 
			
		||||
  '((t :inherit font-lock-string-face))
 | 
			
		||||
  "Face used for pseudo headers in commit messages."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-known-pseudo-header
 | 
			
		||||
  '((t :inherit font-lock-keyword-face))
 | 
			
		||||
  "Face used for the keywords of known pseudo headers in commit messages."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-branch-local
 | 
			
		||||
  (if (featurep 'magit)
 | 
			
		||||
      '((t :inherit magit-branch-local))
 | 
			
		||||
    '((t :inherit font-lock-variable-name-face)))
 | 
			
		||||
  "Face used for names of local branches in commit message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(define-obsolete-face-alias 'git-commit-comment-branch
 | 
			
		||||
  'git-commit-comment-branch-local "Git-Commit 2.12.0")
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-branch-remote
 | 
			
		||||
  (if (featurep 'magit)
 | 
			
		||||
      '((t :inherit magit-branch-remote))
 | 
			
		||||
    '((t :inherit font-lock-variable-name-face)))
 | 
			
		||||
  "Face used for names of remote branches in commit message comments.
 | 
			
		||||
This is only used if Magit is available."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-detached
 | 
			
		||||
  '((t :inherit git-commit-comment-branch-local))
 | 
			
		||||
  "Face used for detached `HEAD' in commit message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-heading
 | 
			
		||||
  '((t :inherit git-commit-known-pseudo-header))
 | 
			
		||||
  "Face used for headings in commit message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-file
 | 
			
		||||
  '((t :inherit git-commit-pseudo-header))
 | 
			
		||||
  "Face used for file names in commit message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-commit-comment-action
 | 
			
		||||
  '((t :inherit bold))
 | 
			
		||||
  "Face used for actions in commit message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
;;; Keymap
 | 
			
		||||
 | 
			
		||||
(defvar git-commit-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (cond ((featurep 'jkl)
 | 
			
		||||
           (define-key map (kbd "C-M-i") 'git-commit-prev-message)
 | 
			
		||||
           (define-key map (kbd "C-M-k") 'git-commit-next-message))
 | 
			
		||||
          (t
 | 
			
		||||
           (define-key map (kbd "M-p") 'git-commit-prev-message)
 | 
			
		||||
           (define-key map (kbd "M-n") 'git-commit-next-message)
 | 
			
		||||
           ;; Old bindings to avoid confusion
 | 
			
		||||
           (define-key map (kbd "C-c C-x a") 'git-commit-ack)
 | 
			
		||||
           (define-key map (kbd "C-c C-x i") 'git-commit-suggested)
 | 
			
		||||
           (define-key map (kbd "C-c C-x m") 'git-commit-modified)
 | 
			
		||||
           (define-key map (kbd "C-c C-x o") 'git-commit-cc)
 | 
			
		||||
           (define-key map (kbd "C-c C-x p") 'git-commit-reported)
 | 
			
		||||
           (define-key map (kbd "C-c C-x r") 'git-commit-review)
 | 
			
		||||
           (define-key map (kbd "C-c C-x s") 'git-commit-signoff)
 | 
			
		||||
           (define-key map (kbd "C-c C-x t") 'git-commit-test)))
 | 
			
		||||
    (define-key map (kbd "C-c C-a") 'git-commit-ack)
 | 
			
		||||
    (define-key map (kbd "C-c C-i") 'git-commit-suggested)
 | 
			
		||||
    (define-key map (kbd "C-c C-m") 'git-commit-modified)
 | 
			
		||||
    (define-key map (kbd "C-c C-o") 'git-commit-cc)
 | 
			
		||||
    (define-key map (kbd "C-c C-p") 'git-commit-reported)
 | 
			
		||||
    (define-key map (kbd "C-c C-r") 'git-commit-review)
 | 
			
		||||
    (define-key map (kbd "C-c C-s") 'git-commit-signoff)
 | 
			
		||||
    (define-key map (kbd "C-c C-t") 'git-commit-test)
 | 
			
		||||
    (define-key map (kbd "C-c M-s") 'git-commit-save-message)
 | 
			
		||||
    map)
 | 
			
		||||
  "Key map used by `git-commit-mode'.")
 | 
			
		||||
 | 
			
		||||
;;; Menu
 | 
			
		||||
 | 
			
		||||
(require 'easymenu)
 | 
			
		||||
(easy-menu-define git-commit-mode-menu git-commit-mode-map
 | 
			
		||||
  "Git Commit Mode Menu"
 | 
			
		||||
  '("Commit"
 | 
			
		||||
    ["Previous" git-commit-prev-message t]
 | 
			
		||||
    ["Next" git-commit-next-message t]
 | 
			
		||||
    "-"
 | 
			
		||||
    ["Ack" git-commit-ack :active t
 | 
			
		||||
     :help "Insert an 'Acked-by' header"]
 | 
			
		||||
    ["Sign-Off" git-commit-signoff :active t
 | 
			
		||||
     :help "Insert a 'Signed-off-by' header"]
 | 
			
		||||
    ["Modified-by" git-commit-modified :active t
 | 
			
		||||
     :help "Insert a 'Modified-by' header"]
 | 
			
		||||
    ["Tested-by" git-commit-test :active t
 | 
			
		||||
     :help "Insert a 'Tested-by' header"]
 | 
			
		||||
    ["Reviewed-by" git-commit-review :active t
 | 
			
		||||
     :help "Insert a 'Reviewed-by' header"]
 | 
			
		||||
    ["CC" git-commit-cc t
 | 
			
		||||
     :help "Insert a 'Cc' header"]
 | 
			
		||||
    ["Reported" git-commit-reported :active t
 | 
			
		||||
     :help "Insert a 'Reported-by' header"]
 | 
			
		||||
    ["Suggested" git-commit-suggested t
 | 
			
		||||
     :help "Insert a 'Suggested-by' header"]
 | 
			
		||||
    "-"
 | 
			
		||||
    ["Save" git-commit-save-message t]
 | 
			
		||||
    ["Cancel" with-editor-cancel t]
 | 
			
		||||
    ["Commit" with-editor-finish t]))
 | 
			
		||||
 | 
			
		||||
;;; Hooks
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defconst git-commit-filename-regexp "/\\(\
 | 
			
		||||
\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\
 | 
			
		||||
\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'")
 | 
			
		||||
 | 
			
		||||
(eval-after-load 'recentf
 | 
			
		||||
  '(add-to-list 'recentf-exclude git-commit-filename-regexp))
 | 
			
		||||
 | 
			
		||||
(add-to-list 'with-editor-file-name-history-exclude git-commit-filename-regexp)
 | 
			
		||||
 | 
			
		||||
(defun git-commit-setup-font-lock-in-buffer ()
 | 
			
		||||
  (and buffer-file-name
 | 
			
		||||
       (string-match-p git-commit-filename-regexp buffer-file-name)
 | 
			
		||||
       (git-commit-setup-font-lock)))
 | 
			
		||||
 | 
			
		||||
(add-hook 'after-change-major-mode-hook 'git-commit-setup-font-lock-in-buffer)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun git-commit-setup-check-buffer ()
 | 
			
		||||
  (and buffer-file-name
 | 
			
		||||
       (string-match-p git-commit-filename-regexp buffer-file-name)
 | 
			
		||||
       (git-commit-setup)))
 | 
			
		||||
 | 
			
		||||
(defvar git-commit-mode)
 | 
			
		||||
 | 
			
		||||
(defun git-commit-file-not-found ()
 | 
			
		||||
  ;; cygwin git will pass a cygwin path (/cygdrive/c/foo/.git/...),
 | 
			
		||||
  ;; try to handle this in window-nt Emacs.
 | 
			
		||||
  (--when-let
 | 
			
		||||
      (and (or (string-match-p git-commit-filename-regexp buffer-file-name)
 | 
			
		||||
               (if (boundp 'git-rebase-filename-regexp)
 | 
			
		||||
                   (string-match-p git-rebase-filename-regexp buffer-file-name)))
 | 
			
		||||
           (not (file-accessible-directory-p
 | 
			
		||||
                 (file-name-directory buffer-file-name)))
 | 
			
		||||
           (if (require 'magit-git nil t)
 | 
			
		||||
               ;; Emacs prepends a "c:".
 | 
			
		||||
               (magit-expand-git-file-name (substring buffer-file-name 2))
 | 
			
		||||
             ;; Fallback if we can't load `magit-git'.
 | 
			
		||||
             (and (string-match "\\`[a-z]:/\\(cygdrive/\\)?\\([a-z]\\)/\\(.*\\)"
 | 
			
		||||
                                buffer-file-name)
 | 
			
		||||
                  (concat (match-string 2 buffer-file-name) ":/"
 | 
			
		||||
                          (match-string 3 buffer-file-name)))))
 | 
			
		||||
    (when (file-accessible-directory-p (file-name-directory it))
 | 
			
		||||
      (let ((inhibit-read-only t))
 | 
			
		||||
        (insert-file-contents it t)
 | 
			
		||||
        t))))
 | 
			
		||||
 | 
			
		||||
(when (eq system-type 'windows-nt)
 | 
			
		||||
  (add-hook 'find-file-not-found-functions #'git-commit-file-not-found))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun git-commit-setup ()
 | 
			
		||||
  ;; Pretend that git-commit-mode is a major-mode,
 | 
			
		||||
  ;; so that directory-local settings can be used.
 | 
			
		||||
  (let ((default-directory
 | 
			
		||||
          (if (or (file-exists-p ".dir-locals.el")
 | 
			
		||||
                  (not (fboundp 'magit-toplevel)))
 | 
			
		||||
              default-directory
 | 
			
		||||
            ;; When $GIT_DIR/.dir-locals.el doesn't exist,
 | 
			
		||||
            ;; fallback to $GIT_WORK_TREE/.dir-locals.el,
 | 
			
		||||
            ;; because the maintainer can use the latter
 | 
			
		||||
            ;; to enforce conventions, while s/he has no
 | 
			
		||||
            ;; control over the former.
 | 
			
		||||
            (and (fboundp 'magit-toplevel) ; silence byte-compiler
 | 
			
		||||
                 (magit-toplevel)))))
 | 
			
		||||
    (let ((buffer-file-name nil)         ; trick hack-dir-local-variables
 | 
			
		||||
          (major-mode 'git-commit-mode)) ; trick dir-locals-collect-variables
 | 
			
		||||
      (hack-dir-local-variables)
 | 
			
		||||
      (hack-local-variables-apply)))
 | 
			
		||||
  (when git-commit-major-mode
 | 
			
		||||
    (let ((auto-mode-alist (list (cons (concat "\\`"
 | 
			
		||||
                                               (regexp-quote buffer-file-name)
 | 
			
		||||
                                               "\\'")
 | 
			
		||||
                                       git-commit-major-mode)))
 | 
			
		||||
          ;; The major-mode hook might want to consult these minor
 | 
			
		||||
          ;; modes, while the minor-mode hooks might want to consider
 | 
			
		||||
          ;; the major mode.
 | 
			
		||||
          (git-commit-mode t)
 | 
			
		||||
          (with-editor-mode t))
 | 
			
		||||
      (normal-mode t)))
 | 
			
		||||
  (setq with-editor-show-usage nil)
 | 
			
		||||
  (unless with-editor-mode
 | 
			
		||||
    ;; Maybe already enabled when using `shell-command' or an Emacs shell.
 | 
			
		||||
    (with-editor-mode 1))
 | 
			
		||||
  (add-hook 'with-editor-finish-query-functions
 | 
			
		||||
            'git-commit-finish-query-functions nil t)
 | 
			
		||||
  (add-hook 'with-editor-pre-finish-hook
 | 
			
		||||
            'git-commit-save-message nil t)
 | 
			
		||||
  (add-hook 'with-editor-pre-cancel-hook
 | 
			
		||||
            'git-commit-save-message nil t)
 | 
			
		||||
  (when (bound-and-true-p magit-wip-merge-branch)
 | 
			
		||||
    (add-hook 'with-editor-post-finish-hook
 | 
			
		||||
              'magit-wip-commit nil t))
 | 
			
		||||
  (setq with-editor-cancel-message
 | 
			
		||||
        'git-commit-cancel-message)
 | 
			
		||||
  (make-local-variable 'log-edit-comment-ring-index)
 | 
			
		||||
  (git-commit-mode 1)
 | 
			
		||||
  (git-commit-setup-font-lock)
 | 
			
		||||
  (when (boundp 'save-place)
 | 
			
		||||
    (setq save-place nil))
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (when (looking-at "\\`\\(\\'\\|\n[^\n]\\)")
 | 
			
		||||
      (open-line 1)))
 | 
			
		||||
  (run-hooks 'git-commit-setup-hook)
 | 
			
		||||
  (set-buffer-modified-p nil))
 | 
			
		||||
 | 
			
		||||
(define-minor-mode git-commit-mode
 | 
			
		||||
  "Auxiliary minor mode used when editing Git commit messages.
 | 
			
		||||
This mode is only responsible for setting up some key bindings.
 | 
			
		||||
Don't use it directly, instead enable `global-git-commit-mode'."
 | 
			
		||||
  :lighter "")
 | 
			
		||||
 | 
			
		||||
(put 'git-commit-mode 'permanent-local t)
 | 
			
		||||
 | 
			
		||||
(defun git-commit-setup-changelog-support ()
 | 
			
		||||
  "Treat ChangeLog entries as paragraphs."
 | 
			
		||||
  (setq-local paragraph-start (concat paragraph-start "\\|\\*\\|(")))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-turn-on-auto-fill ()
 | 
			
		||||
  "Unconditionally turn on Auto Fill mode.
 | 
			
		||||
If `git-commit-fill-column' is non-nil, and `fill-column'
 | 
			
		||||
doesn't already have a buffer-local value, then set that
 | 
			
		||||
to `git-commit-fill-column'."
 | 
			
		||||
  (when (and (numberp git-commit-fill-column)
 | 
			
		||||
             (not (local-variable-p 'fill-column)))
 | 
			
		||||
    (setq fill-column git-commit-fill-column))
 | 
			
		||||
  (setq-local comment-auto-fill-only-comments nil)
 | 
			
		||||
  (turn-on-auto-fill))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-turn-on-flyspell ()
 | 
			
		||||
  "Unconditionally turn on Flyspell mode.
 | 
			
		||||
Also prevent comments from being checked and
 | 
			
		||||
finally check current non-comment text."
 | 
			
		||||
  (require 'flyspell)
 | 
			
		||||
  (turn-on-flyspell)
 | 
			
		||||
  (setq flyspell-generic-check-word-predicate
 | 
			
		||||
        'git-commit-flyspell-verify)
 | 
			
		||||
  (let ((end)
 | 
			
		||||
        (comment-start-regex (format "^\\(%s\\|$\\)" comment-start)))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (goto-char (point-max))
 | 
			
		||||
      (while (and (not (bobp)) (looking-at comment-start-regex))
 | 
			
		||||
        (forward-line -1))
 | 
			
		||||
      (unless (looking-at comment-start-regex)
 | 
			
		||||
        (forward-line))
 | 
			
		||||
      (setq end (point)))
 | 
			
		||||
    (flyspell-region (point-min) end)))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-flyspell-verify ()
 | 
			
		||||
  (not (= (char-after (line-beginning-position))
 | 
			
		||||
          (aref comment-start 0))))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-finish-query-functions (force)
 | 
			
		||||
  (run-hook-with-args-until-failure
 | 
			
		||||
   'git-commit-finish-query-functions force))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-check-style-conventions (force)
 | 
			
		||||
  "Check for violations of certain basic style conventions.
 | 
			
		||||
 | 
			
		||||
For each violation ask the user if she wants to proceed anyway.
 | 
			
		||||
Option `git-commit-check-style-conventions' controls which
 | 
			
		||||
conventions are checked."
 | 
			
		||||
  (or force
 | 
			
		||||
      (save-excursion
 | 
			
		||||
        (goto-char (point-min))
 | 
			
		||||
        (re-search-forward (git-commit-summary-regexp) nil t)
 | 
			
		||||
        (if (equal (match-string 1) "")
 | 
			
		||||
            t ; Just try; we don't know whether --allow-empty-message was used.
 | 
			
		||||
          (and (or (not (memq 'overlong-summary-line
 | 
			
		||||
                              git-commit-style-convention-checks))
 | 
			
		||||
                   (equal (match-string 2) "")
 | 
			
		||||
                   (y-or-n-p "Summary line is too long.  Commit anyway? "))
 | 
			
		||||
               (or (not (memq 'non-empty-second-line
 | 
			
		||||
                              git-commit-style-convention-checks))
 | 
			
		||||
                   (not (match-string 3))
 | 
			
		||||
                   (y-or-n-p "Second line is not empty.  Commit anyway? ")))))))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-cancel-message ()
 | 
			
		||||
  (message
 | 
			
		||||
   (concat "Commit canceled"
 | 
			
		||||
           (and (memq 'git-commit-save-message with-editor-pre-cancel-hook)
 | 
			
		||||
                ".  Message saved to `log-edit-comment-ring'"))))
 | 
			
		||||
 | 
			
		||||
;;; History
 | 
			
		||||
 | 
			
		||||
(defun git-commit-prev-message (arg)
 | 
			
		||||
  "Cycle backward through message history, after saving current message.
 | 
			
		||||
With a numeric prefix ARG, go back ARG comments."
 | 
			
		||||
  (interactive "*p")
 | 
			
		||||
  (when (and (git-commit-save-message) (> arg 0))
 | 
			
		||||
    (setq log-edit-comment-ring-index
 | 
			
		||||
          (log-edit-new-comment-index
 | 
			
		||||
           arg (ring-length log-edit-comment-ring))))
 | 
			
		||||
  (save-restriction
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (narrow-to-region (point)
 | 
			
		||||
                      (if (re-search-forward (concat "^" comment-start) nil t)
 | 
			
		||||
                          (max 1 (- (point) 2))
 | 
			
		||||
                        (point-max)))
 | 
			
		||||
    (log-edit-previous-comment arg)))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-next-message (arg)
 | 
			
		||||
  "Cycle forward through message history, after saving current message.
 | 
			
		||||
With a numeric prefix ARG, go forward ARG comments."
 | 
			
		||||
  (interactive "*p")
 | 
			
		||||
  (git-commit-prev-message (- arg)))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-save-message ()
 | 
			
		||||
  "Save current message to `log-edit-comment-ring'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (--when-let (git-commit-buffer-message)
 | 
			
		||||
    (unless (ring-member log-edit-comment-ring it)
 | 
			
		||||
      (ring-insert log-edit-comment-ring it))))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-buffer-message ()
 | 
			
		||||
  (let ((flush (concat "^" comment-start))
 | 
			
		||||
        (str (buffer-substring-no-properties (point-min) (point-max))))
 | 
			
		||||
    (with-temp-buffer
 | 
			
		||||
      (insert str)
 | 
			
		||||
      (goto-char (point-min))
 | 
			
		||||
      (when (re-search-forward (concat flush " -+ >8 -+$") nil t)
 | 
			
		||||
        (delete-region (point-at-bol) (point-max)))
 | 
			
		||||
      (goto-char (point-min))
 | 
			
		||||
      (flush-lines flush)
 | 
			
		||||
      (goto-char (point-max))
 | 
			
		||||
      (unless (eq (char-before) ?\n)
 | 
			
		||||
        (insert ?\n))
 | 
			
		||||
      (setq str (buffer-string)))
 | 
			
		||||
    (unless (string-match "\\`[ \t\n\r]*\\'" str)
 | 
			
		||||
      (when (string-match "\\`\n\\{2,\\}" str)
 | 
			
		||||
        (setq str (replace-match "\n" t t str)))
 | 
			
		||||
      (when (string-match "\n\\{2,\\}\\'" str)
 | 
			
		||||
        (setq str (replace-match "\n" t t str)))
 | 
			
		||||
      str)))
 | 
			
		||||
 | 
			
		||||
;;; Headers
 | 
			
		||||
 | 
			
		||||
(defun git-commit-ack (name mail)
 | 
			
		||||
  "Insert a header acknowledging that you have looked at the commit."
 | 
			
		||||
  (interactive (git-commit-self-ident))
 | 
			
		||||
  (git-commit-insert-header "Acked-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-modified (name mail)
 | 
			
		||||
  "Insert a header to signal that you have modified the commit."
 | 
			
		||||
  (interactive (git-commit-self-ident))
 | 
			
		||||
  (git-commit-insert-header "Modified-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-review (name mail)
 | 
			
		||||
  "Insert a header acknowledging that you have reviewed the commit."
 | 
			
		||||
  (interactive (git-commit-self-ident))
 | 
			
		||||
  (git-commit-insert-header "Reviewed-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-signoff (name mail)
 | 
			
		||||
  "Insert a header to sign off the commit."
 | 
			
		||||
  (interactive (git-commit-self-ident))
 | 
			
		||||
  (git-commit-insert-header "Signed-off-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-test (name mail)
 | 
			
		||||
  "Insert a header acknowledging that you have tested the commit."
 | 
			
		||||
  (interactive (git-commit-self-ident))
 | 
			
		||||
  (git-commit-insert-header "Tested-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-cc (name mail)
 | 
			
		||||
  "Insert a header mentioning someone who might be interested."
 | 
			
		||||
  (interactive (git-commit-read-ident))
 | 
			
		||||
  (git-commit-insert-header "Cc" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-reported (name mail)
 | 
			
		||||
  "Insert a header mentioning the person who reported the issue."
 | 
			
		||||
  (interactive (git-commit-read-ident))
 | 
			
		||||
  (git-commit-insert-header "Reported-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-suggested (name mail)
 | 
			
		||||
  "Insert a header mentioning the person who suggested the change."
 | 
			
		||||
  (interactive (git-commit-read-ident))
 | 
			
		||||
  (git-commit-insert-header "Suggested-by" name mail))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-self-ident ()
 | 
			
		||||
  (list (or (getenv "GIT_AUTHOR_NAME")
 | 
			
		||||
            (getenv "GIT_COMMITTER_NAME")
 | 
			
		||||
            (ignore-errors (car (process-lines "git" "config" "user.name")))
 | 
			
		||||
            user-full-name
 | 
			
		||||
            (read-string "Name: "))
 | 
			
		||||
        (or (getenv "GIT_AUTHOR_EMAIL")
 | 
			
		||||
            (getenv "GIT_COMMITTER_EMAIL")
 | 
			
		||||
            (getenv "EMAIL")
 | 
			
		||||
            (ignore-errors (car (process-lines "git" "config" "user.email")))
 | 
			
		||||
            (read-string "Email: "))))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-read-ident ()
 | 
			
		||||
  (list (read-string "Name: ")
 | 
			
		||||
        (read-string "Email: ")))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-insert-header (header name email)
 | 
			
		||||
  (setq header (format "%s: %s <%s>" header name email))
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (point-max))
 | 
			
		||||
    (cond ((re-search-backward "^[-a-zA-Z]+: [^<]+? <[^>]+>" nil t)
 | 
			
		||||
           (end-of-line)
 | 
			
		||||
           (insert ?\n header)
 | 
			
		||||
           (unless (= (char-after) ?\n)
 | 
			
		||||
             (insert ?\n)))
 | 
			
		||||
          (t
 | 
			
		||||
           (while (re-search-backward (concat "^" comment-start) nil t))
 | 
			
		||||
           (unless (looking-back "\n\n" nil)
 | 
			
		||||
             (insert ?\n))
 | 
			
		||||
           (insert header ?\n)))
 | 
			
		||||
    (unless (or (eobp) (= (char-after) ?\n))
 | 
			
		||||
      (insert ?\n))))
 | 
			
		||||
 | 
			
		||||
;;; Font-Lock
 | 
			
		||||
 | 
			
		||||
(defun git-commit-summary-regexp ()
 | 
			
		||||
  (concat
 | 
			
		||||
   ;; Leading empty lines and comments
 | 
			
		||||
   (format "\\`\\(?:^\\(?:\\s-*\\|%s.*\\)\n\\)*" comment-start)
 | 
			
		||||
   ;; Summary line
 | 
			
		||||
   (format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length)
 | 
			
		||||
   ;; Non-empty non-comment second line
 | 
			
		||||
   (format "\\(?:\n%s\\|\n\\(.+\\)\\)?" comment-start)))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-extend-region-summary-line ()
 | 
			
		||||
  "Identify the multiline summary-regexp construct.
 | 
			
		||||
Added to `font-lock-extend-region-functions'."
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (save-match-data
 | 
			
		||||
      (goto-char (point-min))
 | 
			
		||||
      (when (looking-at (git-commit-summary-regexp))
 | 
			
		||||
        (let ((summary-beg (match-beginning 0))
 | 
			
		||||
              (summary-end (match-end 0)))
 | 
			
		||||
          (when (or (< summary-beg font-lock-beg summary-end)
 | 
			
		||||
                    (< summary-beg font-lock-end summary-end))
 | 
			
		||||
            (setq font-lock-beg (min font-lock-beg summary-beg))
 | 
			
		||||
            (setq font-lock-end (max font-lock-end summary-end))))))))
 | 
			
		||||
 | 
			
		||||
(defvar-local git-commit--branch-name-regexp nil)
 | 
			
		||||
 | 
			
		||||
(defconst git-commit-comment-headings
 | 
			
		||||
  '("Changes to be committed:"
 | 
			
		||||
    "Untracked files:"
 | 
			
		||||
    "Changed but not updated:"
 | 
			
		||||
    "Changes not staged for commit:"
 | 
			
		||||
    "Unmerged paths:"
 | 
			
		||||
    "Author:"
 | 
			
		||||
    "Date:"))
 | 
			
		||||
 | 
			
		||||
(defconst git-commit-font-lock-keywords-1
 | 
			
		||||
  '(;; Pseudo headers
 | 
			
		||||
    (eval . `(,(format "^\\(%s:\\)\\( .*\\)"
 | 
			
		||||
                       (regexp-opt git-commit-known-pseudo-headers))
 | 
			
		||||
              (1 'git-commit-known-pseudo-header)
 | 
			
		||||
              (2 'git-commit-pseudo-header)))
 | 
			
		||||
    ("^[-a-zA-Z]+: [^<]+? <[^>]+>"
 | 
			
		||||
     (0 'git-commit-pseudo-header))
 | 
			
		||||
    ;; Summary
 | 
			
		||||
    (eval . `(,(git-commit-summary-regexp)
 | 
			
		||||
              (1 'git-commit-summary)))
 | 
			
		||||
    ;; - Note (overrides summary)
 | 
			
		||||
    ("\\[.+?\\]"
 | 
			
		||||
     (0 'git-commit-note t))
 | 
			
		||||
    ;; - Non-empty second line (overrides summary and note)
 | 
			
		||||
    (eval . `(,(git-commit-summary-regexp)
 | 
			
		||||
              (2 'git-commit-overlong-summary t t)
 | 
			
		||||
              (3 'git-commit-nonempty-second-line t t)))))
 | 
			
		||||
 | 
			
		||||
(defconst git-commit-font-lock-keywords-2
 | 
			
		||||
  `(,@git-commit-font-lock-keywords-1
 | 
			
		||||
    ;; Comments
 | 
			
		||||
    (eval . `(,(format "^%s.*" comment-start)
 | 
			
		||||
              (0 'font-lock-comment-face)))
 | 
			
		||||
    (eval . `(,(format "^%s On branch \\(.*\\)" comment-start)
 | 
			
		||||
              (1 'git-commit-comment-branch-local t)))
 | 
			
		||||
    (eval . `(,(format "^%s \\(HEAD\\) detached at" comment-start)
 | 
			
		||||
              (1 'git-commit-comment-detached t)))
 | 
			
		||||
    (eval . `(,(format "^%s %s" comment-start
 | 
			
		||||
                       (regexp-opt git-commit-comment-headings t))
 | 
			
		||||
              (1 'git-commit-comment-heading t)))
 | 
			
		||||
    (eval . `(,(format "^%s\t\\(?:\\([^:\n]+\\):\\s-+\\)?\\(.*\\)" comment-start)
 | 
			
		||||
              (1 'git-commit-comment-action t t)
 | 
			
		||||
              (2 'git-commit-comment-file t)))))
 | 
			
		||||
 | 
			
		||||
(defconst git-commit-font-lock-keywords-3
 | 
			
		||||
  `(,@git-commit-font-lock-keywords-2
 | 
			
		||||
    ;; More comments
 | 
			
		||||
    (eval
 | 
			
		||||
     ;; Your branch is ahead of 'master' by 3 commits.
 | 
			
		||||
     ;; Your branch is behind 'master' by 2 commits, and can be fast-forwarded.
 | 
			
		||||
     . `(,(format
 | 
			
		||||
           "^%s Your branch is \\(?:ahead\\|behind\\) of '%s' by \\([0-9]*\\)"
 | 
			
		||||
           comment-start git-commit--branch-name-regexp)
 | 
			
		||||
         (1 'git-commit-comment-branch-local t)
 | 
			
		||||
         (2 'git-commit-comment-branch-remote t)
 | 
			
		||||
         (3 'bold t)))
 | 
			
		||||
    (eval
 | 
			
		||||
     ;; Your branch is up to date with 'master'.
 | 
			
		||||
     ;; Your branch and 'master' have diverged,
 | 
			
		||||
     . `(,(format
 | 
			
		||||
           "^%s Your branch \\(?:is up-to-date with\\|and\\) '%s'"
 | 
			
		||||
           comment-start git-commit--branch-name-regexp)
 | 
			
		||||
         (1 'git-commit-comment-branch-local t)
 | 
			
		||||
         (2 'git-commit-comment-branch-remote t)))
 | 
			
		||||
    (eval
 | 
			
		||||
     ;; and have 1 and 2 different commits each, respectively.
 | 
			
		||||
     . `(,(format
 | 
			
		||||
           "^%s and have \\([0-9]*\\) and \\([0-9]*\\) commits each"
 | 
			
		||||
           comment-start)
 | 
			
		||||
         (1 'bold t)
 | 
			
		||||
         (2 'bold t)))))
 | 
			
		||||
 | 
			
		||||
(defvar git-commit-font-lock-keywords git-commit-font-lock-keywords-2
 | 
			
		||||
  "Font-Lock keywords for Git-Commit mode.")
 | 
			
		||||
 | 
			
		||||
(defun git-commit-setup-font-lock ()
 | 
			
		||||
  (let ((table (make-syntax-table (syntax-table))))
 | 
			
		||||
    (when comment-start
 | 
			
		||||
      (modify-syntax-entry (string-to-char comment-start) "." table))
 | 
			
		||||
    (modify-syntax-entry ?#  "." table)
 | 
			
		||||
    (modify-syntax-entry ?\" "." table)
 | 
			
		||||
    (modify-syntax-entry ?\' "." table)
 | 
			
		||||
    (modify-syntax-entry ?`  "." table)
 | 
			
		||||
    (set-syntax-table table))
 | 
			
		||||
  (setq-local comment-start
 | 
			
		||||
              (or (ignore-errors
 | 
			
		||||
                    (car (process-lines "git" "config" "core.commentchar")))
 | 
			
		||||
                  "#"))
 | 
			
		||||
  (setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start))
 | 
			
		||||
  (setq-local comment-end-skip "\n")
 | 
			
		||||
  (setq-local comment-use-syntax nil)
 | 
			
		||||
  (setq-local git-commit--branch-name-regexp
 | 
			
		||||
              (if (and (featurep 'magit-git)
 | 
			
		||||
                       ;; When using cygwin git, we may end up in a
 | 
			
		||||
                       ;; non-existing directory, which would cause
 | 
			
		||||
                       ;; any git calls to signal an error.
 | 
			
		||||
                       (file-accessible-directory-p default-directory))
 | 
			
		||||
                  (progn
 | 
			
		||||
                    ;; Make sure the below functions are available.
 | 
			
		||||
                    (require 'magit)
 | 
			
		||||
                    ;; Font-Lock wants every submatch to succeed,
 | 
			
		||||
                    ;; so also match the empty string.  Do not use
 | 
			
		||||
                    ;; `regexp-quote' because that is slow if there
 | 
			
		||||
                    ;; are thousands of branches outweighing the
 | 
			
		||||
                    ;; benefit of an efficient regep.
 | 
			
		||||
                    (format "\\(\\(?:%s\\)\\|\\)\\(\\(?:%s\\)\\|\\)"
 | 
			
		||||
                            (mapconcat #'identity
 | 
			
		||||
                                       (magit-list-local-branch-names)
 | 
			
		||||
                                       "\\|")
 | 
			
		||||
                            (mapconcat #'identity
 | 
			
		||||
                                       (magit-list-remote-branch-names)
 | 
			
		||||
                                       "\\|")))
 | 
			
		||||
                "\\([^']*\\)"))
 | 
			
		||||
  (setq-local font-lock-multiline t)
 | 
			
		||||
  (add-hook 'font-lock-extend-region-functions
 | 
			
		||||
            #'git-commit-extend-region-summary-line
 | 
			
		||||
            t t)
 | 
			
		||||
  (font-lock-add-keywords nil git-commit-font-lock-keywords t))
 | 
			
		||||
 | 
			
		||||
(defun git-commit-propertize-diff ()
 | 
			
		||||
  (require 'diff-mode)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (when (re-search-forward "^diff --git" nil t)
 | 
			
		||||
      (beginning-of-line)
 | 
			
		||||
      (let ((buffer (current-buffer)))
 | 
			
		||||
        (insert
 | 
			
		||||
         (with-temp-buffer
 | 
			
		||||
           (insert
 | 
			
		||||
            (with-current-buffer buffer
 | 
			
		||||
              (prog1 (buffer-substring-no-properties (point) (point-max))
 | 
			
		||||
                (delete-region (point) (point-max)))))
 | 
			
		||||
           (let ((diff-default-read-only nil))
 | 
			
		||||
             (diff-mode))
 | 
			
		||||
           (let (font-lock-verbose font-lock-support-mode)
 | 
			
		||||
             (if (fboundp 'font-lock-ensure)
 | 
			
		||||
                 (font-lock-ensure)
 | 
			
		||||
               (with-no-warnings
 | 
			
		||||
                 (font-lock-fontify-buffer))))
 | 
			
		||||
           (let (next (pos (point-min)))
 | 
			
		||||
             (while (setq next (next-single-property-change pos 'face))
 | 
			
		||||
               (put-text-property pos next 'font-lock-face
 | 
			
		||||
                                  (get-text-property pos 'face))
 | 
			
		||||
               (setq pos next))
 | 
			
		||||
             (put-text-property pos (point-max) 'font-lock-face
 | 
			
		||||
                                (get-text-property pos 'face)))
 | 
			
		||||
           (buffer-string)))))))
 | 
			
		||||
 | 
			
		||||
;;; Elisp Text Mode
 | 
			
		||||
 | 
			
		||||
(define-derived-mode git-commit-elisp-text-mode text-mode "ElText"
 | 
			
		||||
  "Major mode for editing commit messages of elisp projects.
 | 
			
		||||
This is intended for use as `git-commit-major-mode' for projects
 | 
			
		||||
that expect `symbols' to look like this.  I.e. like they look in
 | 
			
		||||
Elisp doc-strings, including this one.  Unlike in doc-strings,
 | 
			
		||||
\"strings\" also look different than the other text."
 | 
			
		||||
  (setq font-lock-defaults '(git-commit-elisp-text-mode-keywords)))
 | 
			
		||||
 | 
			
		||||
(defvar git-commit-elisp-text-mode-keywords
 | 
			
		||||
  `((,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
 | 
			
		||||
              lisp-mode-symbol-regexp "\\)['’]")
 | 
			
		||||
     (1 font-lock-constant-face prepend))
 | 
			
		||||
    ("\"[^\"]*\"" (0 font-lock-string-face prepend))))
 | 
			
		||||
 | 
			
		||||
;;; _
 | 
			
		||||
(provide 'git-commit)
 | 
			
		||||
;;; git-commit.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,15 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,2 +0,0 @@
 | 
			
		||||
;;; -*- 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")
 | 
			
		||||
@ -1,220 +0,0 @@
 | 
			
		||||
;;; graphql.el --- GraphQL utilities                 -*- lexical-binding: t; -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2017  Sean Allred
 | 
			
		||||
 | 
			
		||||
;; Author: Sean Allred <code@seanallred.com>
 | 
			
		||||
;; Keywords: hypermedia, tools, lisp
 | 
			
		||||
;; Homepage: https://github.com/vermiculus/graphql.el
 | 
			
		||||
;; Package-Version: 20180912.31
 | 
			
		||||
;; Package-X-Original-Version: 0.1.1
 | 
			
		||||
;; Package-Requires: ((emacs "25"))
 | 
			
		||||
 | 
			
		||||
;; This program is free software; you can redistribute it and/or modify
 | 
			
		||||
;; it under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation, either version 3 of the License, or
 | 
			
		||||
;; (at your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; This program is distributed in the hope that it will be useful,
 | 
			
		||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
			
		||||
;; GNU General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; GraphQL.el provides a generally-applicable domain-specific language
 | 
			
		||||
;; for creating and executing GraphQL queries against your favorite
 | 
			
		||||
;; web services.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'pcase)
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-object (obj)
 | 
			
		||||
  "Encode OBJ as a GraphQL string."
 | 
			
		||||
  (cond
 | 
			
		||||
   ((stringp obj)
 | 
			
		||||
    obj)
 | 
			
		||||
   ((symbolp obj)
 | 
			
		||||
    (symbol-name obj))
 | 
			
		||||
   ((numberp obj)
 | 
			
		||||
    (number-to-string obj))
 | 
			
		||||
   ((and (consp obj)
 | 
			
		||||
         (not (consp (cdr obj))))
 | 
			
		||||
    (symbol-name (car obj)))))
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-argument-spec (spec)
 | 
			
		||||
  "Encode an argument spec SPEC.
 | 
			
		||||
SPEC is of the form..."
 | 
			
		||||
  (graphql--encode-argument (car spec) (cdr spec)))
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-argument (key value)
 | 
			
		||||
  "Encode an argument KEY with value VALUE."
 | 
			
		||||
  (format "%s:%s" key (graphql--encode-argument-value value)))
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-argument-value (value)
 | 
			
		||||
  "Encode an argument value VALUE.
 | 
			
		||||
VALUE is expected to be one of the following:
 | 
			
		||||
 | 
			
		||||
* a symbol
 | 
			
		||||
* a 'variable', i.e. \\='($ variableName)
 | 
			
		||||
* an object (as a list)
 | 
			
		||||
* a string
 | 
			
		||||
* a vector of values (e.g., symbols)
 | 
			
		||||
* a number
 | 
			
		||||
* something encode-able by `graphql-encode'."
 | 
			
		||||
  (cond
 | 
			
		||||
   ((symbolp value)
 | 
			
		||||
    (symbol-name value))
 | 
			
		||||
   ((eq '$ (car-safe value))
 | 
			
		||||
    (format "$%s" (cadr value)))
 | 
			
		||||
   ((listp value)
 | 
			
		||||
    (format "{%s}" (mapconcat #'graphql--encode-argument-spec value ",")))
 | 
			
		||||
   ((stringp value)
 | 
			
		||||
    (format "\"%s\"" value))
 | 
			
		||||
   ((vectorp value)
 | 
			
		||||
    (format "[%s]" (mapconcat #'graphql-encode value ",")))
 | 
			
		||||
   ((numberp value)
 | 
			
		||||
    (number-to-string value))
 | 
			
		||||
   (t
 | 
			
		||||
    (graphql-encode value))))
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-parameter-spec (spec)
 | 
			
		||||
  "Encode a parameter SPEC.
 | 
			
		||||
SPEC is expected to be of the following form:
 | 
			
		||||
 | 
			
		||||
   (NAME TYPE [REQUIRED] . [DEFAULT])
 | 
			
		||||
 | 
			
		||||
NAME is the name of the parameter.
 | 
			
		||||
 | 
			
		||||
TYPE is the parameter's type.
 | 
			
		||||
 | 
			
		||||
A non-nil value for REQUIRED will indicate the parameter is
 | 
			
		||||
required.  A value of `!' is recommended.
 | 
			
		||||
 | 
			
		||||
A non-nil value for DEFAULT will provide a default value for the
 | 
			
		||||
parameter."
 | 
			
		||||
  ;; Unfortunately can't use `pcase' here because the first DEFAULT
 | 
			
		||||
  ;; value (in the case of a complex value) might be misunderstood as
 | 
			
		||||
  ;; the value for REQUIRED.  We need to know if the third cons is the
 | 
			
		||||
  ;; very last one; not just that the list has at least three
 | 
			
		||||
  ;; elements.
 | 
			
		||||
  (if (eq (last spec) (nthcdr 2 spec))
 | 
			
		||||
      (graphql--encode-parameter (nth 0 spec)
 | 
			
		||||
                                 (nth 1 spec)
 | 
			
		||||
                                 (car (last spec))
 | 
			
		||||
                                 (cdr (last spec)))
 | 
			
		||||
    (graphql--encode-parameter (nth 0 spec)
 | 
			
		||||
                               (nth 1 spec)
 | 
			
		||||
                               nil
 | 
			
		||||
                               (nthcdr 2 spec))))
 | 
			
		||||
 | 
			
		||||
(defun graphql--encode-parameter (name type &optional required default)
 | 
			
		||||
  "Encode a GraphQL parameter with a NAME and TYPE.
 | 
			
		||||
If REQUIRED is non-nil, mark the parameter as required.
 | 
			
		||||
If DEFAULT is non-nil, is the default value of the parameter."
 | 
			
		||||
  (format "$%s:%s%s%s"
 | 
			
		||||
          (symbol-name name)
 | 
			
		||||
          (symbol-name type)
 | 
			
		||||
          (if required "!" "")
 | 
			
		||||
          (if default
 | 
			
		||||
              (concat "=" (graphql--encode-argument-value default))
 | 
			
		||||
            "")))
 | 
			
		||||
 | 
			
		||||
(defun graphql--get-keys (g)
 | 
			
		||||
  "Get the keyword arguments from a graph G.
 | 
			
		||||
Returns a list where the first element is a plist of arguments
 | 
			
		||||
and the second is a 'clean' copy of G."
 | 
			
		||||
  (or (and (not (consp g))
 | 
			
		||||
           (list nil g))
 | 
			
		||||
      (let (graph keys)
 | 
			
		||||
        (while g
 | 
			
		||||
          (if (keywordp (car g))
 | 
			
		||||
              (let* ((param (pop g))
 | 
			
		||||
                     (value (pop g)))
 | 
			
		||||
                (push (cons param value) keys))
 | 
			
		||||
            (push (pop g) graph)))
 | 
			
		||||
        (list keys (nreverse graph)))))
 | 
			
		||||
 | 
			
		||||
(defun graphql-encode (g)
 | 
			
		||||
  "Encode graph G as a GraphQL string."
 | 
			
		||||
  (pcase (graphql--get-keys g)
 | 
			
		||||
    (`(,keys ,graph)
 | 
			
		||||
     (let ((object (or (car-safe graph) graph))
 | 
			
		||||
           (name (alist-get :op-name keys))
 | 
			
		||||
           (params (alist-get :op-params keys))
 | 
			
		||||
           (arguments (alist-get :arguments keys))
 | 
			
		||||
           (fields (cdr-safe graph)))
 | 
			
		||||
       (concat
 | 
			
		||||
        (graphql--encode-object object)
 | 
			
		||||
        (when name
 | 
			
		||||
          (format " %S" name))
 | 
			
		||||
        (when arguments
 | 
			
		||||
          ;; Format arguments "key:value,key:value,..."
 | 
			
		||||
          (format "(%s)"
 | 
			
		||||
                  (mapconcat #'graphql--encode-argument-spec arguments ",")))
 | 
			
		||||
        (when params
 | 
			
		||||
          (format "(%s)"
 | 
			
		||||
                  (mapconcat #'graphql--encode-parameter-spec params ",")))
 | 
			
		||||
        (when fields
 | 
			
		||||
          (format "{%s}"
 | 
			
		||||
                  (mapconcat #'graphql-encode fields " "))))))))
 | 
			
		||||
 | 
			
		||||
(defun graphql-simplify-response-edges (data)
 | 
			
		||||
  "Simplify DATA to collapse edges into their nodes."
 | 
			
		||||
  (pcase data
 | 
			
		||||
    ;; When we encounter a collection of edges, simplify those edges
 | 
			
		||||
    ;; into their nodes
 | 
			
		||||
    (`(,object (edges . ,edges))
 | 
			
		||||
     (cons object (mapcar #'graphql-simplify-response-edges
 | 
			
		||||
                          (mapcar (lambda (edge) (alist-get 'node edge))
 | 
			
		||||
                                  edges))))
 | 
			
		||||
    ;; When we encounter a plain cons cell (not a list), let it pass
 | 
			
		||||
    (`(,(and key (guard (not (consp key)))) . ,(and value (guard (not (consp value)))))
 | 
			
		||||
     (cons key value))
 | 
			
		||||
    ;; symbols should pass unaltered
 | 
			
		||||
    (`,(and symbol (guard (symbolp symbol)))
 | 
			
		||||
     symbol)
 | 
			
		||||
    ;; everything else should be mapped
 | 
			
		||||
    (_ (mapcar #'graphql-simplify-response-edges data))))
 | 
			
		||||
 | 
			
		||||
(defun graphql--genform-operation (args kind)
 | 
			
		||||
  "Generate the Lisp form for an operation.
 | 
			
		||||
ARGS is is a list ([NAME [PARAMETERS]] GRAPH) where NAME is the
 | 
			
		||||
name of the operation, PARAMETERS are its parameters, and GRAPH
 | 
			
		||||
is the form of the actual operation.
 | 
			
		||||
 | 
			
		||||
KIND can be `query' or `mutation'."
 | 
			
		||||
  (pcase args
 | 
			
		||||
    (`(,name ,parameters ,graph)
 | 
			
		||||
     `(graphql-encode '(,kind :op-name ,name
 | 
			
		||||
                              :op-params ,parameters
 | 
			
		||||
                              ,@graph)))
 | 
			
		||||
 | 
			
		||||
    (`(,name ,graph)
 | 
			
		||||
     `(graphql-encode '(,kind :op-name ,name
 | 
			
		||||
                              ,@graph)))
 | 
			
		||||
 | 
			
		||||
    (`(,graph)
 | 
			
		||||
     `(graphql-encode '(,kind ,@graph)))
 | 
			
		||||
 | 
			
		||||
    (_ (error "Bad form"))))
 | 
			
		||||
 | 
			
		||||
(defmacro graphql-query (&rest args)
 | 
			
		||||
  "Construct a Query object.
 | 
			
		||||
ARGS is a listof the form described by `graphql--genform-operation'.
 | 
			
		||||
 | 
			
		||||
\(fn [NAME] [(PARAMETER-SPEC...)] GRAPH)"
 | 
			
		||||
  (graphql--genform-operation args 'query))
 | 
			
		||||
 | 
			
		||||
(defmacro graphql-mutation (&rest args)
 | 
			
		||||
  "Construct a Mutation object.
 | 
			
		||||
ARGS is a listof the form described by `graphql--genform-operation'.
 | 
			
		||||
 | 
			
		||||
\(fn [NAME] [(PARAMETER-SPEC...)] GRAPH)"
 | 
			
		||||
  (graphql--genform-operation args 'mutation))
 | 
			
		||||
 | 
			
		||||
(provide 'graphql)
 | 
			
		||||
;;; graphql.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1 +0,0 @@
 | 
			
		||||
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2017-02-01T05:05:02-0500 using DSA
 | 
			
		||||
@ -1,50 +0,0 @@
 | 
			
		||||
;;; 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
 | 
			
		||||
@ -1,2 +0,0 @@
 | 
			
		||||
;;; -*- 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"))
 | 
			
		||||
@ -1,182 +0,0 @@
 | 
			
		||||
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
 | 
			
		||||
 | 
			
		||||
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
 | 
			
		||||
;; Package-Requires: ((emacs "24.1"))
 | 
			
		||||
;; Version: 1.0.5
 | 
			
		||||
;; Keywords: extensions lisp
 | 
			
		||||
;; Prefix: let-alist
 | 
			
		||||
;; Separator: -
 | 
			
		||||
 | 
			
		||||
;; This is an Elpa :core package. Don't use functionality that is not
 | 
			
		||||
;; compatible with Emacs 24.1.
 | 
			
		||||
 | 
			
		||||
;; This file is part of GNU Emacs.
 | 
			
		||||
 | 
			
		||||
;; GNU Emacs is free software: you can redistribute it and/or modify
 | 
			
		||||
;; it under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation, either version 3 of the License, or
 | 
			
		||||
;; (at your option) any later version.
 | 
			
		||||
 | 
			
		||||
;; GNU Emacs is distributed in the hope that it will be useful,
 | 
			
		||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
			
		||||
;; GNU General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This package offers a single macro, `let-alist'.  This macro takes a
 | 
			
		||||
;; first argument (whose value must be an alist) and a body.
 | 
			
		||||
;;
 | 
			
		||||
;; The macro expands to a let form containing body, where each dotted
 | 
			
		||||
;; symbol inside body is let-bound to their cdrs in the alist.  Dotted
 | 
			
		||||
;; symbol is any symbol starting with a `.'.  Only those present in
 | 
			
		||||
;; the body are let-bound and this search is done at compile time.
 | 
			
		||||
;;
 | 
			
		||||
;; For instance, the following code
 | 
			
		||||
;;
 | 
			
		||||
;;   (let-alist alist
 | 
			
		||||
;;     (if (and .title .body)
 | 
			
		||||
;;         .body
 | 
			
		||||
;;       .site
 | 
			
		||||
;;       .site.contents))
 | 
			
		||||
;;
 | 
			
		||||
;; essentially expands to
 | 
			
		||||
;;
 | 
			
		||||
;;   (let ((.title (cdr (assq 'title alist)))
 | 
			
		||||
;;         (.body  (cdr (assq 'body alist)))
 | 
			
		||||
;;         (.site  (cdr (assq 'site alist)))
 | 
			
		||||
;;         (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
 | 
			
		||||
;;     (if (and .title .body)
 | 
			
		||||
;;         .body
 | 
			
		||||
;;       .site
 | 
			
		||||
;;       .site.contents))
 | 
			
		||||
;;
 | 
			
		||||
;; If you nest `let-alist' invocations, the inner one can't access
 | 
			
		||||
;; the variables of the outer one. You can, however, access alists
 | 
			
		||||
;; inside the original alist by using dots inside the symbol, as
 | 
			
		||||
;; displayed in the example above by the `.site.contents'.
 | 
			
		||||
;;
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(defun let-alist--deep-dot-search (data)
 | 
			
		||||
  "Return alist of symbols inside DATA that start with a `.'.
 | 
			
		||||
Perform a deep search and return an alist where each car is the
 | 
			
		||||
symbol, and each cdr is the same symbol without the `.'."
 | 
			
		||||
  (cond
 | 
			
		||||
   ((symbolp data)
 | 
			
		||||
    (let ((name (symbol-name data)))
 | 
			
		||||
      (when (string-match "\\`\\." name)
 | 
			
		||||
        ;; Return the cons cell inside a list, so it can be appended
 | 
			
		||||
        ;; with other results in the clause below.
 | 
			
		||||
        (list (cons data (intern (replace-match "" nil nil name)))))))
 | 
			
		||||
   ((not (consp data)) nil)
 | 
			
		||||
   ((eq (car data) 'let-alist)
 | 
			
		||||
    ;; For nested ‘let-alist’ forms, ignore symbols appearing in the
 | 
			
		||||
    ;; inner body because they don’t refer to the alist currently
 | 
			
		||||
    ;; being processed.  See Bug#24641.
 | 
			
		||||
    (let-alist--deep-dot-search (cadr data)))
 | 
			
		||||
   (t (append (let-alist--deep-dot-search (car data))
 | 
			
		||||
              (let-alist--deep-dot-search (cdr data))))))
 | 
			
		||||
 | 
			
		||||
(defun let-alist--access-sexp (symbol variable)
 | 
			
		||||
  "Return a sexp used to access SYMBOL inside VARIABLE."
 | 
			
		||||
  (let* ((clean (let-alist--remove-dot symbol))
 | 
			
		||||
         (name (symbol-name clean)))
 | 
			
		||||
    (if (string-match "\\`\\." name)
 | 
			
		||||
        clean
 | 
			
		||||
      (let-alist--list-to-sexp
 | 
			
		||||
       (mapcar #'intern (nreverse (split-string name "\\.")))
 | 
			
		||||
       variable))))
 | 
			
		||||
 | 
			
		||||
(defun let-alist--list-to-sexp (list var)
 | 
			
		||||
  "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
 | 
			
		||||
  `(cdr (assq ',(car list)
 | 
			
		||||
              ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
 | 
			
		||||
                 var))))
 | 
			
		||||
 | 
			
		||||
(defun let-alist--remove-dot (symbol)
 | 
			
		||||
  "Return SYMBOL, sans an initial dot."
 | 
			
		||||
  (let ((name (symbol-name symbol)))
 | 
			
		||||
    (if (string-match "\\`\\." name)
 | 
			
		||||
        (intern (replace-match "" nil nil name))
 | 
			
		||||
      symbol)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; The actual macro.
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defmacro let-alist (alist &rest body)
 | 
			
		||||
  "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
 | 
			
		||||
Dotted symbol is any symbol starting with a `.'.  Only those present
 | 
			
		||||
in BODY are let-bound and this search is done at compile time.
 | 
			
		||||
 | 
			
		||||
For instance, the following code
 | 
			
		||||
 | 
			
		||||
  (let-alist alist
 | 
			
		||||
    (if (and .title .body)
 | 
			
		||||
        .body
 | 
			
		||||
      .site
 | 
			
		||||
      .site.contents))
 | 
			
		||||
 | 
			
		||||
essentially expands to
 | 
			
		||||
 | 
			
		||||
  (let ((.title (cdr (assq \\='title alist)))
 | 
			
		||||
        (.body  (cdr (assq \\='body alist)))
 | 
			
		||||
        (.site  (cdr (assq \\='site alist)))
 | 
			
		||||
        (.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
 | 
			
		||||
    (if (and .title .body)
 | 
			
		||||
        .body
 | 
			
		||||
      .site
 | 
			
		||||
      .site.contents))
 | 
			
		||||
 | 
			
		||||
If you nest `let-alist' invocations, the inner one can't access
 | 
			
		||||
the variables of the outer one. You can, however, access alists
 | 
			
		||||
inside the original alist by using dots inside the symbol, as
 | 
			
		||||
displayed in the example above."
 | 
			
		||||
  (declare (indent 1) (debug t))
 | 
			
		||||
  (let ((var (make-symbol "alist")))
 | 
			
		||||
    `(let ((,var ,alist))
 | 
			
		||||
       (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
 | 
			
		||||
                     (delete-dups (let-alist--deep-dot-search body)))
 | 
			
		||||
         ,@body))))
 | 
			
		||||
 | 
			
		||||
;;;; ChangeLog:
 | 
			
		||||
 | 
			
		||||
;; 2015-12-01  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	packages/let-alist: Define it as a :core package
 | 
			
		||||
;; 
 | 
			
		||||
;; 2015-06-11  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	* let-alist (let-alist--deep-dot-search): Fix cons
 | 
			
		||||
;; 
 | 
			
		||||
;; 2015-03-07  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	let-alist: Update copyright
 | 
			
		||||
;; 
 | 
			
		||||
;; 2014-12-22  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	packages/let-alist: Use `make-symbol' instead of `gensym'.
 | 
			
		||||
;; 
 | 
			
		||||
;; 2014-12-20  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	packages/let-alist: Enable access to deeper alists
 | 
			
		||||
;; 
 | 
			
		||||
;; 2014-12-14  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	let-alist.el: Add lexical binding. Version bump.
 | 
			
		||||
;; 
 | 
			
		||||
;; 2014-12-11  Artur Malabarba  <bruce.connor.am@gmail.com>
 | 
			
		||||
;; 
 | 
			
		||||
;; 	let-alist: New package
 | 
			
		||||
;; 
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'let-alist)
 | 
			
		||||
 | 
			
		||||
;;; let-alist.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,311 +0,0 @@
 | 
			
		||||
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>
 | 
			
		||||
@ -1,676 +0,0 @@
 | 
			
		||||
 | 
			
		||||
		    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>.
 | 
			
		||||
 | 
			
		||||
@ -1,18 +0,0 @@
 | 
			
		||||
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.
 | 
			
		||||
@ -1,592 +0,0 @@
 | 
			
		||||
;;; git-rebase.el --- Edit Git rebase files  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Phil Jackson <phil@shellarchive.co.uk>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; This file is not part of GNU Emacs.
 | 
			
		||||
 | 
			
		||||
;; This file is free software; you can redistribute it and/or modify
 | 
			
		||||
;; it under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
 | 
			
		||||
;; This file is distributed in the hope that it will be useful,
 | 
			
		||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
			
		||||
;; GNU General Public License for more details.
 | 
			
		||||
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This package assists the user in editing the list of commits to be
 | 
			
		||||
;; rewritten during an interactive rebase.
 | 
			
		||||
 | 
			
		||||
;; When the user initiates an interactive rebase, e.g. using "r e" in
 | 
			
		||||
;; a Magit buffer or on the command line using "git rebase -i REV",
 | 
			
		||||
;; Git invokes the `$GIT_SEQUENCE_EDITOR' (or if that is undefined
 | 
			
		||||
;; `$GIT_EDITOR' or even `$EDITOR') letting the user rearrange, drop,
 | 
			
		||||
;; reword, edit, and squash commits.
 | 
			
		||||
 | 
			
		||||
;; This package provides the major-mode `git-rebase-mode' which makes
 | 
			
		||||
;; doing so much more fun, by making the buffer more colorful and
 | 
			
		||||
;; providing the following commands:
 | 
			
		||||
;;
 | 
			
		||||
;;   C-c C-c  Tell Git to make it happen.
 | 
			
		||||
;;   C-c C-k  Tell Git that you changed your mind, i.e. abort.
 | 
			
		||||
;;
 | 
			
		||||
;;   p        Move point to previous line.
 | 
			
		||||
;;   n        Move point to next line.
 | 
			
		||||
;;
 | 
			
		||||
;;   M-p      Move the commit at point up.
 | 
			
		||||
;;   M-n      Move the commit at point down.
 | 
			
		||||
;;
 | 
			
		||||
;;   k        Drop the commit at point.
 | 
			
		||||
;;   c        Don't drop the commit at point.
 | 
			
		||||
;;   r        Change the message of the commit at point.
 | 
			
		||||
;;   e        Edit the commit at point.
 | 
			
		||||
;;   s        Squash the commit at point, into the one above.
 | 
			
		||||
;;   f        Like "s" but don't also edit the commit message.
 | 
			
		||||
;;   x        Add a script to be run with the commit at point
 | 
			
		||||
;;            being checked out.
 | 
			
		||||
;;   z        Add noop action at point.
 | 
			
		||||
;;
 | 
			
		||||
;;   SPC      Show the commit at point in another buffer.
 | 
			
		||||
;;   RET      Show the commit at point in another buffer and
 | 
			
		||||
;;            select its window.
 | 
			
		||||
;;   C-/      Undo last change.
 | 
			
		||||
 | 
			
		||||
;; You should probably also read the `git-rebase' manpage.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'dash)
 | 
			
		||||
(require 'easymenu)
 | 
			
		||||
(require 'server)
 | 
			
		||||
(require 'with-editor)
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
(and (require 'async-bytecomp nil t)
 | 
			
		||||
     (memq 'magit (bound-and-true-p async-bytecomp-allowed-packages))
 | 
			
		||||
     (fboundp 'async-bytecomp-package-mode)
 | 
			
		||||
     (async-bytecomp-package-mode 1))
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'recentf))
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
;;;; Variables
 | 
			
		||||
 | 
			
		||||
(defgroup git-rebase nil
 | 
			
		||||
  "Edit Git rebase sequences."
 | 
			
		||||
  :link '(info-link "(magit)Editing Rebase Sequences")
 | 
			
		||||
  :group 'tools)
 | 
			
		||||
 | 
			
		||||
(defcustom git-rebase-auto-advance t
 | 
			
		||||
  "Whether to move to next line after changing a line."
 | 
			
		||||
  :group 'git-rebase
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom git-rebase-show-instructions t
 | 
			
		||||
  "Whether to show usage instructions inside the rebase buffer."
 | 
			
		||||
  :group 'git-rebase
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom git-rebase-confirm-cancel t
 | 
			
		||||
  "Whether confirmation is required to cancel."
 | 
			
		||||
  :group 'git-rebase
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
;;;; Faces
 | 
			
		||||
 | 
			
		||||
(defgroup git-rebase-faces nil
 | 
			
		||||
  "Faces used by Git-Rebase mode."
 | 
			
		||||
  :group 'faces
 | 
			
		||||
  :group 'git-rebase)
 | 
			
		||||
 | 
			
		||||
(defface git-rebase-hash '((t (:inherit magit-hash)))
 | 
			
		||||
  "Face for commit hashes."
 | 
			
		||||
  :group 'git-rebase-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-rebase-description nil
 | 
			
		||||
  "Face for commit descriptions."
 | 
			
		||||
  :group 'git-rebase-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-rebase-killed-action
 | 
			
		||||
  '((t (:inherit font-lock-comment-face :strike-through t)))
 | 
			
		||||
  "Face for commented action and exec lines."
 | 
			
		||||
  :group 'git-rebase-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-rebase-comment-hash
 | 
			
		||||
  '((t (:inherit git-rebase-hash :weight bold)))
 | 
			
		||||
  "Face for commit hashes in commit message comments."
 | 
			
		||||
  :group 'git-rebase-faces)
 | 
			
		||||
 | 
			
		||||
(defface git-rebase-comment-heading
 | 
			
		||||
  '((t :inherit font-lock-keyword-face))
 | 
			
		||||
  "Face for headings in rebase message comments."
 | 
			
		||||
  :group 'git-commit-faces)
 | 
			
		||||
 | 
			
		||||
;;; Keymaps
 | 
			
		||||
 | 
			
		||||
(defvar git-rebase-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (set-keymap-parent map special-mode-map)
 | 
			
		||||
    (cond ((featurep 'jkl)
 | 
			
		||||
           (define-key map [return]    'git-rebase-show-commit)
 | 
			
		||||
           (define-key map (kbd   "i") 'git-rebase-backward-line)
 | 
			
		||||
           (define-key map (kbd   "k") 'forward-line)
 | 
			
		||||
           (define-key map (kbd "M-i") 'git-rebase-move-line-up)
 | 
			
		||||
           (define-key map (kbd "M-k") 'git-rebase-move-line-down)
 | 
			
		||||
           (define-key map (kbd   "p") 'git-rebase-pick)
 | 
			
		||||
           (define-key map (kbd   ",") 'git-rebase-kill-line))
 | 
			
		||||
          (t
 | 
			
		||||
           (define-key map (kbd "C-m") 'git-rebase-show-commit)
 | 
			
		||||
           (define-key map (kbd   "p") 'git-rebase-backward-line)
 | 
			
		||||
           (define-key map (kbd   "n") 'forward-line)
 | 
			
		||||
           (define-key map (kbd "M-p") 'git-rebase-move-line-up)
 | 
			
		||||
           (define-key map (kbd "M-n") 'git-rebase-move-line-down)
 | 
			
		||||
           (define-key map (kbd   "c") 'git-rebase-pick)
 | 
			
		||||
           (define-key map (kbd   "k") 'git-rebase-kill-line)
 | 
			
		||||
           (define-key map (kbd "C-k") 'git-rebase-kill-line)))
 | 
			
		||||
    (define-key map (kbd "e") 'git-rebase-edit)
 | 
			
		||||
    (define-key map (kbd "m") 'git-rebase-edit)
 | 
			
		||||
    (define-key map (kbd "f") 'git-rebase-fixup)
 | 
			
		||||
    (define-key map (kbd "q") 'undefined)
 | 
			
		||||
    (define-key map (kbd "r") 'git-rebase-reword)
 | 
			
		||||
    (define-key map (kbd "w") 'git-rebase-reword)
 | 
			
		||||
    (define-key map (kbd "s") 'git-rebase-squash)
 | 
			
		||||
    (define-key map (kbd "x") 'git-rebase-exec)
 | 
			
		||||
    (define-key map (kbd "y") 'git-rebase-insert)
 | 
			
		||||
    (define-key map (kbd "z") 'git-rebase-noop)
 | 
			
		||||
    (define-key map (kbd "SPC")     'git-rebase-show-or-scroll-up)
 | 
			
		||||
    (define-key map (kbd "DEL")     'git-rebase-show-or-scroll-down)
 | 
			
		||||
    (define-key map (kbd "C-x C-t") 'git-rebase-move-line-up)
 | 
			
		||||
    (define-key map [M-up]          'git-rebase-move-line-up)
 | 
			
		||||
    (define-key map [M-down]        'git-rebase-move-line-down)
 | 
			
		||||
    (define-key map [remap undo]    'git-rebase-undo)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for Git-Rebase mode.")
 | 
			
		||||
 | 
			
		||||
(cond ((featurep 'jkl)
 | 
			
		||||
       (put 'git-rebase-reword       :advertised-binding "r")
 | 
			
		||||
       (put 'git-rebase-move-line-up :advertised-binding (kbd "M-i"))
 | 
			
		||||
       (put 'git-rebase-kill-line    :advertised-binding ","))
 | 
			
		||||
      (t
 | 
			
		||||
       (put 'git-rebase-reword       :advertised-binding "r")
 | 
			
		||||
       (put 'git-rebase-move-line-up :advertised-binding (kbd "M-p"))
 | 
			
		||||
       (put 'git-rebase-kill-line    :advertised-binding "k")))
 | 
			
		||||
 | 
			
		||||
(easy-menu-define git-rebase-mode-menu git-rebase-mode-map
 | 
			
		||||
  "Git-Rebase mode menu"
 | 
			
		||||
  '("Rebase"
 | 
			
		||||
    ["Pick" git-rebase-pick t]
 | 
			
		||||
    ["Reword" git-rebase-reword t]
 | 
			
		||||
    ["Edit" git-rebase-edit t]
 | 
			
		||||
    ["Squash" git-rebase-squash t]
 | 
			
		||||
    ["Fixup" git-rebase-fixup t]
 | 
			
		||||
    ["Kill" git-rebase-kill-line t]
 | 
			
		||||
    ["Noop" git-rebase-noop t]
 | 
			
		||||
    ["Execute" git-rebase-exec t]
 | 
			
		||||
    ["Move Down" git-rebase-move-line-down t]
 | 
			
		||||
    ["Move Up" git-rebase-move-line-up t]
 | 
			
		||||
    "---"
 | 
			
		||||
    ["Cancel" with-editor-cancel t]
 | 
			
		||||
    ["Finish" with-editor-finish t]))
 | 
			
		||||
 | 
			
		||||
(defvar git-rebase-command-descriptions
 | 
			
		||||
  '((with-editor-finish           . "tell Git to make it happen")
 | 
			
		||||
    (with-editor-cancel           . "tell Git that you changed your mind, i.e. abort")
 | 
			
		||||
    (git-rebase-backward-line     . "move point to previous line")
 | 
			
		||||
    (forward-line                 . "move point to next line")
 | 
			
		||||
    (git-rebase-move-line-up      . "move the commit at point up")
 | 
			
		||||
    (git-rebase-move-line-down    . "move the commit at point down")
 | 
			
		||||
    (git-rebase-show-or-scroll-up . "show the commit at point in another buffer")
 | 
			
		||||
    (git-rebase-show-commit
 | 
			
		||||
     . "show the commit at point in another buffer and select its window")
 | 
			
		||||
    (undo                         . "undo last change")
 | 
			
		||||
    (git-rebase-kill-line         . "drop the commit at point")
 | 
			
		||||
    (git-rebase-insert            . "insert a line for an arbitrary commit")
 | 
			
		||||
    (git-rebase-noop              . "add noop action at point")))
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-pick ()
 | 
			
		||||
  "Use commit on current line."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase-set-action "pick"))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-reword ()
 | 
			
		||||
  "Edit message of commit on current line."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase-set-action "reword"))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-edit ()
 | 
			
		||||
  "Stop at the commit on the current line."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase-set-action "edit"))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-squash ()
 | 
			
		||||
  "Meld commit on current line into previous commit, edit message."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase-set-action "squash"))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-fixup ()
 | 
			
		||||
  "Meld commit on current line into previous commit, discard its message."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase-set-action "fixup"))
 | 
			
		||||
 | 
			
		||||
(defvar-local git-rebase-line nil)
 | 
			
		||||
(defvar-local git-rebase-comment-re nil)
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-set-action (action)
 | 
			
		||||
  (goto-char (line-beginning-position))
 | 
			
		||||
  (if (and (looking-at git-rebase-line)
 | 
			
		||||
           (not (string-match-p "\\(e\\|exec\\|noop\\)$" (match-string 1))))
 | 
			
		||||
      (let ((inhibit-read-only t))
 | 
			
		||||
        (replace-match action t t nil 1)
 | 
			
		||||
        (when git-rebase-auto-advance
 | 
			
		||||
          (forward-line)))
 | 
			
		||||
    (ding)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-line-p (&optional pos)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (when pos (goto-char pos))
 | 
			
		||||
    (goto-char (line-beginning-position))
 | 
			
		||||
    (looking-at-p git-rebase-line)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-region-bounds ()
 | 
			
		||||
  (when (use-region-p)
 | 
			
		||||
    (let ((beg (save-excursion (goto-char (region-beginning))
 | 
			
		||||
                               (line-beginning-position)))
 | 
			
		||||
          (end (save-excursion (goto-char (region-end))
 | 
			
		||||
                               (line-end-position))))
 | 
			
		||||
      (when (and (git-rebase-line-p beg)
 | 
			
		||||
                 (git-rebase-line-p end))
 | 
			
		||||
        (list beg (1+ end))))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-move-line-down (n)
 | 
			
		||||
  "Move the current commit (or command) N lines down.
 | 
			
		||||
If N is negative, move the commit up instead.  With an active
 | 
			
		||||
region, move all the lines that the region touches, not just the
 | 
			
		||||
current line."
 | 
			
		||||
  (interactive "p")
 | 
			
		||||
  (pcase-let* ((`(,beg ,end)
 | 
			
		||||
                (or (git-rebase-region-bounds)
 | 
			
		||||
                    (list (line-beginning-position)
 | 
			
		||||
                          (1+ (line-end-position)))))
 | 
			
		||||
               (pt-offset (- (point) beg))
 | 
			
		||||
               (mark-offset (and mark-active (- (mark) beg))))
 | 
			
		||||
    (save-restriction
 | 
			
		||||
      (narrow-to-region
 | 
			
		||||
       (point-min)
 | 
			
		||||
       (1+ (save-excursion
 | 
			
		||||
             (goto-char (point-min))
 | 
			
		||||
             (while (re-search-forward git-rebase-line nil t))
 | 
			
		||||
             (point))))
 | 
			
		||||
      (if (or (and (< n 0) (= beg (point-min)))
 | 
			
		||||
              (and (> n 0) (= end (point-max)))
 | 
			
		||||
              (> end (point-max)))
 | 
			
		||||
          (ding)
 | 
			
		||||
        (goto-char (if (< n 0) beg end))
 | 
			
		||||
        (forward-line n)
 | 
			
		||||
        (atomic-change-group
 | 
			
		||||
          (let ((inhibit-read-only t))
 | 
			
		||||
            (insert (delete-and-extract-region beg end)))
 | 
			
		||||
          (let ((new-beg (- (point) (- end beg))))
 | 
			
		||||
            (when (use-region-p)
 | 
			
		||||
              (setq deactivate-mark nil)
 | 
			
		||||
              (set-mark (+ new-beg mark-offset)))
 | 
			
		||||
            (goto-char (+ new-beg pt-offset))))))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-move-line-up (n)
 | 
			
		||||
  "Move the current commit (or command) N lines up.
 | 
			
		||||
If N is negative, move the commit down instead.  With an active
 | 
			
		||||
region, move all the lines that the region touches, not just the
 | 
			
		||||
current line."
 | 
			
		||||
  (interactive "p")
 | 
			
		||||
  (git-rebase-move-line-down (- n)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-highlight-region (start end window rol)
 | 
			
		||||
  (let ((inhibit-read-only t)
 | 
			
		||||
        (deactivate-mark nil)
 | 
			
		||||
        (bounds (git-rebase-region-bounds)))
 | 
			
		||||
    (mapc #'delete-overlay magit-section-highlight-overlays)
 | 
			
		||||
    (when bounds
 | 
			
		||||
      (magit-section-make-overlay (car bounds) (cadr bounds)
 | 
			
		||||
                                  'magit-section-heading-selection))
 | 
			
		||||
    (if (and bounds (not magit-keep-region-overlay))
 | 
			
		||||
        (funcall (default-value 'redisplay-unhighlight-region-function) rol)
 | 
			
		||||
      (funcall (default-value 'redisplay-highlight-region-function)
 | 
			
		||||
               start end window rol))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-unhighlight-region (rol)
 | 
			
		||||
  (mapc #'delete-overlay magit-section-highlight-overlays)
 | 
			
		||||
  (funcall (default-value 'redisplay-unhighlight-region-function) rol))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-kill-line ()
 | 
			
		||||
  "Kill the current action line."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (goto-char (line-beginning-position))
 | 
			
		||||
  (when (and (looking-at git-rebase-line)
 | 
			
		||||
             (not (eq (char-after) (string-to-char comment-start))))
 | 
			
		||||
    (let ((inhibit-read-only t))
 | 
			
		||||
      (insert comment-start)
 | 
			
		||||
      (insert " "))
 | 
			
		||||
    (when git-rebase-auto-advance
 | 
			
		||||
      (forward-line))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-insert (rev)
 | 
			
		||||
  "Read an arbitrary commit and insert it below current line."
 | 
			
		||||
  (interactive (list (magit-read-branch-or-commit "Insert revision")))
 | 
			
		||||
  (forward-line)
 | 
			
		||||
  (--if-let (magit-rev-format "%h %s" rev)
 | 
			
		||||
      (let ((inhibit-read-only t))
 | 
			
		||||
        (insert "pick " it ?\n))
 | 
			
		||||
    (user-error "Unknown revision")))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-exec (arg)
 | 
			
		||||
  "Insert a shell command to be run after the proceeding commit.
 | 
			
		||||
 | 
			
		||||
If there already is such a command on the current line, then edit
 | 
			
		||||
that instead.  With a prefix argument insert a new command even
 | 
			
		||||
when there already is one on the current line.  With empty input
 | 
			
		||||
remove the command on the current line, if any."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let ((inhibit-read-only t) initial command)
 | 
			
		||||
    (unless arg
 | 
			
		||||
      (goto-char (line-beginning-position))
 | 
			
		||||
      (when (looking-at (concat git-rebase-comment-re "?"
 | 
			
		||||
                                "\\(e\\|exec\\) \\(.*\\)"))
 | 
			
		||||
        (setq initial (match-string-no-properties 2))))
 | 
			
		||||
    (setq command (read-shell-command "Execute: " initial))
 | 
			
		||||
    (pcase (list command initial)
 | 
			
		||||
      (`("" nil) (ding))
 | 
			
		||||
      (`(""  ,_)
 | 
			
		||||
       (delete-region (match-beginning 0) (1+ (match-end 0))))
 | 
			
		||||
      (`(,_ nil)
 | 
			
		||||
       (forward-line)
 | 
			
		||||
       (insert (concat "exec " command "\n"))
 | 
			
		||||
       (unless git-rebase-auto-advance
 | 
			
		||||
         (forward-line -1)))
 | 
			
		||||
      (_
 | 
			
		||||
       (replace-match (concat "exec " command) t t)
 | 
			
		||||
       (if git-rebase-auto-advance
 | 
			
		||||
           (forward-line)
 | 
			
		||||
         (goto-char (line-beginning-position)))))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-noop (&optional arg)
 | 
			
		||||
  "Add noop action at point.
 | 
			
		||||
 | 
			
		||||
If the current line already contains a a noop action, leave it
 | 
			
		||||
unchanged.  If there is a commented noop action present, remove
 | 
			
		||||
the comment.  Otherwise add a new noop action.  With a prefix
 | 
			
		||||
argument insert a new noop action regardless what is already
 | 
			
		||||
present on the current line.
 | 
			
		||||
 | 
			
		||||
A noop action can be used to make git perform a rebase even if
 | 
			
		||||
no commits are selected.  Without the noop action present, git
 | 
			
		||||
would see an empty file and therefore do nothing."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (goto-char (line-beginning-position))
 | 
			
		||||
  ;; The extra space at the end is only there to make the action
 | 
			
		||||
  ;; consistent with the others (action argument). This keeps
 | 
			
		||||
  ;; the regexp `git-rebase-line' from getting complicated.
 | 
			
		||||
  (let ((noop-string "noop \n"))
 | 
			
		||||
    (when (or arg (not (looking-at noop-string)))
 | 
			
		||||
      (let ((inhibit-read-only t))
 | 
			
		||||
        (if (and (not arg)
 | 
			
		||||
                 (looking-at (concat comment-start noop-string)))
 | 
			
		||||
            (delete-char 1)
 | 
			
		||||
          (insert noop-string))))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-undo (&optional arg)
 | 
			
		||||
  "Undo some previous changes.
 | 
			
		||||
Like `undo' but works in read-only buffers."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let ((inhibit-read-only t))
 | 
			
		||||
    (undo arg)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase--show-commit (&optional scroll)
 | 
			
		||||
  (let ((disable-magit-save-buffers t))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (goto-char (line-beginning-position))
 | 
			
		||||
      (--if-let (and (looking-at git-rebase-line)
 | 
			
		||||
                     (match-string 2))
 | 
			
		||||
          (pcase scroll
 | 
			
		||||
            (`up   (magit-diff-show-or-scroll-up))
 | 
			
		||||
            (`down (magit-diff-show-or-scroll-down))
 | 
			
		||||
            (_     (apply #'magit-show-commit it (magit-diff-arguments))))
 | 
			
		||||
        (ding)))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-show-commit ()
 | 
			
		||||
  "Show the commit on the current line if any."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase--show-commit))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-show-or-scroll-up ()
 | 
			
		||||
  "Update the commit buffer for commit on current line.
 | 
			
		||||
 | 
			
		||||
Either show the commit at point in the appropriate buffer, or if
 | 
			
		||||
that buffer is already being displayed in the current frame and
 | 
			
		||||
contains information about that commit, then instead scroll the
 | 
			
		||||
buffer up."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase--show-commit 'up))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-show-or-scroll-down ()
 | 
			
		||||
  "Update the commit buffer for commit on current line.
 | 
			
		||||
 | 
			
		||||
Either show the commit at point in the appropriate buffer, or if
 | 
			
		||||
that buffer is already being displayed in the current frame and
 | 
			
		||||
contains information about that commit, then instead scroll the
 | 
			
		||||
buffer down."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (git-rebase--show-commit 'down))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-backward-line (&optional n)
 | 
			
		||||
  "Move N lines backward (forward if N is negative).
 | 
			
		||||
Like `forward-line' but go into the opposite direction."
 | 
			
		||||
  (interactive "p")
 | 
			
		||||
  (forward-line (- (or n 1))))
 | 
			
		||||
 | 
			
		||||
;;; Mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-derived-mode git-rebase-mode special-mode "Git Rebase"
 | 
			
		||||
  "Major mode for editing of a Git rebase file.
 | 
			
		||||
 | 
			
		||||
Rebase files are generated when you run 'git rebase -i' or run
 | 
			
		||||
`magit-interactive-rebase'.  They describe how Git should perform
 | 
			
		||||
the rebase.  See the documentation for git-rebase (e.g., by
 | 
			
		||||
running 'man git-rebase' at the command line) for details."
 | 
			
		||||
  :group 'git-rebase
 | 
			
		||||
  (setq comment-start (or (magit-get "core.commentChar") "#"))
 | 
			
		||||
  (setq git-rebase-comment-re (concat "^" (regexp-quote comment-start)))
 | 
			
		||||
  (setq git-rebase-line
 | 
			
		||||
        (concat "^\\(" (regexp-quote comment-start) "? *"
 | 
			
		||||
                "\\(?:[fprse]\\|pick\\|reword\\|edit\\|squash\\|fixup\\|exec\\|noop\\)\\) "
 | 
			
		||||
                "\\(?:\\([^ \n]+\\) \\(.*\\)\\)?"))
 | 
			
		||||
  (setq font-lock-defaults (list (git-rebase-mode-font-lock-keywords) t t))
 | 
			
		||||
  (unless git-rebase-show-instructions
 | 
			
		||||
    (let ((inhibit-read-only t))
 | 
			
		||||
      (flush-lines git-rebase-comment-re)))
 | 
			
		||||
  (unless with-editor-mode
 | 
			
		||||
    ;; Maybe already enabled when using `shell-command' or an Emacs shell.
 | 
			
		||||
    (with-editor-mode 1))
 | 
			
		||||
  (when git-rebase-confirm-cancel
 | 
			
		||||
    (add-hook 'with-editor-cancel-query-functions
 | 
			
		||||
              'git-rebase-cancel-confirm nil t))
 | 
			
		||||
  (setq-local redisplay-highlight-region-function 'git-rebase-highlight-region)
 | 
			
		||||
  (setq-local redisplay-unhighlight-region-function 'git-rebase-unhighlight-region)
 | 
			
		||||
  (add-hook 'with-editor-pre-cancel-hook  'git-rebase-autostash-save  nil t)
 | 
			
		||||
  (add-hook 'with-editor-post-cancel-hook 'git-rebase-autostash-apply nil t)
 | 
			
		||||
  (setq imenu-prev-index-position-function
 | 
			
		||||
        #'magit-imenu--rebase-prev-index-position-function)
 | 
			
		||||
  (setq imenu-extract-index-name-function
 | 
			
		||||
        #'magit-imenu--rebase-extract-index-name-function)
 | 
			
		||||
  (when (boundp 'save-place)
 | 
			
		||||
    (setq save-place nil)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-cancel-confirm (force)
 | 
			
		||||
  (or (not (buffer-modified-p))
 | 
			
		||||
      force
 | 
			
		||||
      (magit-confirm 'abort-rebase "Abort this rebase" nil 'noabort)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-autostash-save ()
 | 
			
		||||
  (--when-let (magit-file-line (magit-git-dir "rebase-merge/autostash"))
 | 
			
		||||
    (push (cons 'stash it) with-editor-cancel-alist)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-autostash-apply ()
 | 
			
		||||
  (--when-let (cdr (assq 'stash with-editor-cancel-alist))
 | 
			
		||||
    (magit-stash-apply it)))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-match-comment-line (limit)
 | 
			
		||||
  (re-search-forward (concat git-rebase-comment-re ".*") limit t))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-mode-font-lock-keywords ()
 | 
			
		||||
  "Font lock keywords for Git-Rebase mode."
 | 
			
		||||
  (let ((action-re "\
 | 
			
		||||
\\([efprs]\\|pick\\|reword\\|edit\\|squash\\|fixup\\) \\([^ \n]+\\) \\(.*\\)"))
 | 
			
		||||
    `((,(concat "^" action-re)
 | 
			
		||||
       (1 'font-lock-keyword-face)
 | 
			
		||||
       (2 'git-rebase-hash)
 | 
			
		||||
       (3 'git-rebase-description))
 | 
			
		||||
      ("^\\(exec\\) \\(.*\\)"
 | 
			
		||||
       (1 'font-lock-keyword-face)
 | 
			
		||||
       (2 'git-rebase-description))
 | 
			
		||||
      ("^\\(noop\\)"
 | 
			
		||||
       (1 'font-lock-keyword-face))
 | 
			
		||||
      (git-rebase-match-comment-line 0 'font-lock-comment-face)
 | 
			
		||||
      (,(concat git-rebase-comment-re " *" action-re)
 | 
			
		||||
       0 'git-rebase-killed-action t)
 | 
			
		||||
      ("\\[[^[]*\\]"
 | 
			
		||||
       0 'magit-keyword t)
 | 
			
		||||
      (,(format "^%s Rebase \\([^ ]*\\) onto \\([^ ]*\\)" comment-start)
 | 
			
		||||
       (1 'git-rebase-comment-hash t)
 | 
			
		||||
       (2 'git-rebase-comment-hash t))
 | 
			
		||||
      (,(format "^%s \\(Commands:\\)" comment-start)
 | 
			
		||||
       (1 'git-rebase-comment-heading t)))))
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-mode-show-keybindings ()
 | 
			
		||||
  "Modify the \"Commands:\" section of the comment Git generates
 | 
			
		||||
at the bottom of the file so that in place of the one-letter
 | 
			
		||||
abbreviation for the command, it shows the command's keybinding.
 | 
			
		||||
By default, this is the same except for the \"pick\" command."
 | 
			
		||||
  (let ((inhibit-read-only t))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (goto-char (point-min))
 | 
			
		||||
      (when (and git-rebase-show-instructions
 | 
			
		||||
                 (re-search-forward
 | 
			
		||||
                  (concat git-rebase-comment-re "\\s-+p, pick")
 | 
			
		||||
                  nil t))
 | 
			
		||||
        (goto-char (line-beginning-position))
 | 
			
		||||
        (pcase-dolist (`(,cmd . ,desc) git-rebase-command-descriptions)
 | 
			
		||||
          (insert (format "%s %-8s %s\n"
 | 
			
		||||
                          comment-start
 | 
			
		||||
                          (substitute-command-keys (format "\\[%s]" cmd))
 | 
			
		||||
                          desc)))
 | 
			
		||||
        (while (re-search-forward (concat git-rebase-comment-re
 | 
			
		||||
                                          "\\(  ?\\)\\([^\n,],\\) "
 | 
			
		||||
                                          "\\([^\n ]+\\) ")
 | 
			
		||||
                                  nil t)
 | 
			
		||||
          (let ((cmd (intern (concat "git-rebase-" (match-string 3)))))
 | 
			
		||||
            (if (not (fboundp cmd))
 | 
			
		||||
                (delete-region (line-beginning-position) (1+ (line-end-position)))
 | 
			
		||||
              (replace-match " " t t nil 1)
 | 
			
		||||
              (replace-match
 | 
			
		||||
               (format "%-8s"
 | 
			
		||||
                       (mapconcat #'key-description
 | 
			
		||||
                                  (--remove (eq (elt it 0) 'menu-bar)
 | 
			
		||||
                                            (reverse (where-is-internal cmd)))
 | 
			
		||||
                                  ", "))
 | 
			
		||||
               t t nil 2))))))))
 | 
			
		||||
 | 
			
		||||
(add-hook 'git-rebase-mode-hook 'git-rebase-mode-show-keybindings t)
 | 
			
		||||
 | 
			
		||||
(defun git-rebase-mode-disable-before-save-hook ()
 | 
			
		||||
  (set (make-local-variable 'before-save-hook) nil))
 | 
			
		||||
 | 
			
		||||
(add-hook 'git-rebase-mode-hook 'git-rebase-mode-disable-before-save-hook)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defconst git-rebase-filename-regexp "/git-rebase-todo\\'")
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(add-to-list 'auto-mode-alist
 | 
			
		||||
             (cons git-rebase-filename-regexp 'git-rebase-mode))
 | 
			
		||||
 | 
			
		||||
(add-to-list 'with-editor-server-window-alist
 | 
			
		||||
             (cons git-rebase-filename-regexp 'switch-to-buffer))
 | 
			
		||||
 | 
			
		||||
(eval-after-load 'recentf
 | 
			
		||||
  '(add-to-list 'recentf-exclude git-rebase-filename-regexp))
 | 
			
		||||
 | 
			
		||||
(add-to-list 'with-editor-file-name-history-exclude git-rebase-filename-regexp)
 | 
			
		||||
 | 
			
		||||
(provide 'git-rebase)
 | 
			
		||||
;;; git-rebase.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,658 +0,0 @@
 | 
			
		||||
;;; magit-apply.el --- apply Git diffs  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements commands for applying Git diffs or parts
 | 
			
		||||
;; of such a diff.  The supported "apply variants" are apply, stage,
 | 
			
		||||
;; unstage, discard, and reverse - more than Git itself knows about,
 | 
			
		||||
;; at least at the porcelain level.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit-core)
 | 
			
		||||
(require 'magit-diff)
 | 
			
		||||
(require 'magit-wip)
 | 
			
		||||
 | 
			
		||||
;; For `magit-apply'
 | 
			
		||||
(declare-function magit-am-popup "magit-sequence" (&optional arg))
 | 
			
		||||
(declare-function magit-patch-apply-popup "magit-files" (&optional arg))
 | 
			
		||||
;; For `magit-discard-files'
 | 
			
		||||
(declare-function magit-checkout-stage "magit-merge" (file arg))
 | 
			
		||||
(declare-function magit-checkout-read-stage "magit-merge" (file))
 | 
			
		||||
(defvar auto-revert-verbose)
 | 
			
		||||
;; For `magit-stage-untracked'
 | 
			
		||||
(declare-function magit-submodule-add "magit-submodule"
 | 
			
		||||
                  (url &optional path name args))
 | 
			
		||||
(declare-function magit-submodule-read-name-for-path "magit-submodule"
 | 
			
		||||
                  (path &optional prefer-short))
 | 
			
		||||
(declare-function borg--maybe-absorb-gitdir "borg" (pkg))
 | 
			
		||||
(declare-function borg--sort-submodule-sections "borg" (file))
 | 
			
		||||
(defvar borg-user-emacs-directory)
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defcustom magit-delete-by-moving-to-trash t
 | 
			
		||||
  "Whether Magit uses the system's trash can.
 | 
			
		||||
 | 
			
		||||
You should absolutely not disable this and also remove `discard'
 | 
			
		||||
from `magit-no-confirm'.  You shouldn't do that even if you have
 | 
			
		||||
all of the Magit-Wip modes enabled, because those modes do not
 | 
			
		||||
track any files that are not tracked in the proper branch."
 | 
			
		||||
  :package-version '(magit . "2.1.0")
 | 
			
		||||
  :group 'magit-essentials
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-unstage-committed t
 | 
			
		||||
  "Whether unstaging a committed change reverts it instead.
 | 
			
		||||
 | 
			
		||||
A committed change cannot be unstaged, because staging and
 | 
			
		||||
unstaging are actions that are concerned with the differences
 | 
			
		||||
between the index and the working tree, not with committed
 | 
			
		||||
changes.
 | 
			
		||||
 | 
			
		||||
If this option is non-nil (the default), then typing \"u\"
 | 
			
		||||
\(`magit-unstage') on a committed change, causes it to be
 | 
			
		||||
reversed in the index but not the working tree.  For more
 | 
			
		||||
information see command `magit-reverse-in-index'."
 | 
			
		||||
  :package-version '(magit . "2.4.1")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-reverse-atomically nil
 | 
			
		||||
  "Whether to reverse changes atomically.
 | 
			
		||||
 | 
			
		||||
If some changes can be reversed while others cannot, then nothing
 | 
			
		||||
is reversed if the value of this option is non-nil.  But when it
 | 
			
		||||
is nil, then the changes that can be reversed are reversed and
 | 
			
		||||
for the other changes diff files are created that contain the
 | 
			
		||||
rejected reversals."
 | 
			
		||||
  :package-version '(magit . "2.7.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
;;;; Apply
 | 
			
		||||
 | 
			
		||||
(defun magit-apply (&rest args)
 | 
			
		||||
  "Apply the change at point to the working tree.
 | 
			
		||||
With a prefix argument fallback to a 3-way merge.  Doing
 | 
			
		||||
so causes the change to be applied to the index as well."
 | 
			
		||||
  (interactive (and current-prefix-arg (list "--3way")))
 | 
			
		||||
  (--when-let (magit-apply--get-selection)
 | 
			
		||||
    (pcase (list (magit-diff-type) (magit-diff-scope))
 | 
			
		||||
      (`(,(or `unstaged `staged) ,_)
 | 
			
		||||
       (user-error "Change is already in the working tree"))
 | 
			
		||||
      (`(untracked ,(or `file `files))
 | 
			
		||||
       (magit-am-popup))
 | 
			
		||||
      (`(,_ region) (magit-apply-region it args))
 | 
			
		||||
      (`(,_   hunk) (magit-apply-hunk   it args))
 | 
			
		||||
      (`(,_  hunks) (magit-apply-hunks  it args))
 | 
			
		||||
      (`(rebase-sequence file) (magit-patch-apply-popup))
 | 
			
		||||
      (`(,_   file) (magit-apply-diff   it args))
 | 
			
		||||
      (`(,_  files) (magit-apply-diffs  it args)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply--section-content (section)
 | 
			
		||||
  (buffer-substring-no-properties (if (magit-hunk-section-p section)
 | 
			
		||||
                                      (oref section start)
 | 
			
		||||
                                    (oref section content))
 | 
			
		||||
                                  (oref section end)))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-diffs (sections &rest args)
 | 
			
		||||
  (setq sections (magit-apply--get-diffs sections))
 | 
			
		||||
  (magit-apply-patch sections args
 | 
			
		||||
                     (mapconcat
 | 
			
		||||
                      (lambda (s)
 | 
			
		||||
                        (concat (magit-diff-file-header s)
 | 
			
		||||
                                (magit-apply--section-content s)))
 | 
			
		||||
                      sections "")))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-diff (section &rest args)
 | 
			
		||||
  (setq section (car (magit-apply--get-diffs (list section))))
 | 
			
		||||
  (magit-apply-patch section args
 | 
			
		||||
                     (concat (magit-diff-file-header section)
 | 
			
		||||
                             (magit-apply--section-content section))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-hunks (sections &rest args)
 | 
			
		||||
  (let ((section (oref (car sections) parent)))
 | 
			
		||||
    (when (string-match "^diff --cc" (oref section value))
 | 
			
		||||
      (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
 | 
			
		||||
    (magit-apply-patch section args
 | 
			
		||||
                       (concat (oref section header)
 | 
			
		||||
                               (mapconcat 'magit-apply--section-content
 | 
			
		||||
                                          sections "")))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-hunk (section &rest args)
 | 
			
		||||
  (when (string-match "^diff --cc" (magit-section-parent-value section))
 | 
			
		||||
    (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
 | 
			
		||||
  (magit-apply-patch (oref section parent) args
 | 
			
		||||
                     (concat (magit-diff-file-header section)
 | 
			
		||||
                             (magit-apply--section-content section))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-region (section &rest args)
 | 
			
		||||
  (unless (magit-diff-context-p)
 | 
			
		||||
    (user-error "Not enough context to apply region.  Increase the context"))
 | 
			
		||||
  (when (string-match "^diff --cc" (magit-section-parent-value section))
 | 
			
		||||
    (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
 | 
			
		||||
  (magit-apply-patch (oref section parent) args
 | 
			
		||||
                     (concat (magit-diff-file-header section)
 | 
			
		||||
                             (magit-diff-hunk-region-patch section args))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply-patch (section:s args patch)
 | 
			
		||||
  (let* ((files (if (atom section:s)
 | 
			
		||||
                    (list (oref section:s value))
 | 
			
		||||
                  (--map (oref it value) section:s)))
 | 
			
		||||
         (command (symbol-name this-command))
 | 
			
		||||
         (command (if (and command (string-match "^magit-\\([^-]+\\)" command))
 | 
			
		||||
                      (match-string 1 command)
 | 
			
		||||
                    "apply")))
 | 
			
		||||
    (when (and magit-wip-before-change-mode (not inhibit-magit-refresh))
 | 
			
		||||
      (magit-wip-commit-before-change files (concat " before " command)))
 | 
			
		||||
    (with-temp-buffer
 | 
			
		||||
      (insert patch)
 | 
			
		||||
      (magit-run-git-with-input
 | 
			
		||||
       "apply" args "-p0"
 | 
			
		||||
       (unless (magit-diff-context-p) "--unidiff-zero")
 | 
			
		||||
       "--ignore-space-change" "-"))
 | 
			
		||||
    (unless inhibit-magit-refresh
 | 
			
		||||
      (when magit-wip-after-apply-mode
 | 
			
		||||
        (magit-wip-commit-after-apply files (concat " after " command)))
 | 
			
		||||
      (magit-refresh))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply--get-selection ()
 | 
			
		||||
  (or (magit-region-sections '(hunk file) t)
 | 
			
		||||
      (let ((section (magit-current-section)))
 | 
			
		||||
        (pcase (oref section type)
 | 
			
		||||
          ((or `hunk `file) section)
 | 
			
		||||
          ((or `staged `unstaged `untracked
 | 
			
		||||
               `stashed-index `stashed-worktree `stashed-untracked)
 | 
			
		||||
           (oref section children))
 | 
			
		||||
          (_ (user-error "Cannot apply this, it's not a change"))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply--get-diffs (sections)
 | 
			
		||||
  (magit-section-case
 | 
			
		||||
    ([file diffstat]
 | 
			
		||||
     (--map (or (magit-get-section
 | 
			
		||||
                 (append `((file . ,(oref it value)))
 | 
			
		||||
                         (magit-section-ident magit-root-section)))
 | 
			
		||||
                (error "Cannot get required diff headers"))
 | 
			
		||||
            sections))
 | 
			
		||||
    (t sections)))
 | 
			
		||||
 | 
			
		||||
(defun magit-apply--diff-ignores-whitespace-p ()
 | 
			
		||||
  (and (cl-intersection (if (derived-mode-p 'magit-diff-mode)
 | 
			
		||||
                            (nth 2 magit-refresh-args)
 | 
			
		||||
                          magit-diff-section-arguments)
 | 
			
		||||
                        '("--ignore-space-at-eol"
 | 
			
		||||
                          "--ignore-space-change"
 | 
			
		||||
                          "--ignore-all-space"
 | 
			
		||||
                          "--ignore-blank-lines")
 | 
			
		||||
                        :test #'equal)
 | 
			
		||||
       t))
 | 
			
		||||
 | 
			
		||||
;;;; Stage
 | 
			
		||||
 | 
			
		||||
(defun magit-stage (&optional intent)
 | 
			
		||||
  "Add the change at point to the staging area.
 | 
			
		||||
With a prefix argument, INTENT, and an untracked file (or files)
 | 
			
		||||
at point, stage the file but not its content."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (--if-let (and (derived-mode-p 'magit-mode) (magit-apply--get-selection))
 | 
			
		||||
      (pcase (list (magit-diff-type)
 | 
			
		||||
                   (magit-diff-scope)
 | 
			
		||||
                   (magit-apply--diff-ignores-whitespace-p))
 | 
			
		||||
        (`(untracked     ,_  ,_) (magit-stage-untracked intent))
 | 
			
		||||
        (`(unstaged  region  ,_) (magit-apply-region it "--cached"))
 | 
			
		||||
        (`(unstaged    hunk  ,_) (magit-apply-hunk   it "--cached"))
 | 
			
		||||
        (`(unstaged   hunks  ,_) (magit-apply-hunks  it "--cached"))
 | 
			
		||||
        (`(unstaged    file   t) (magit-apply-diff   it "--cached"))
 | 
			
		||||
        (`(unstaged   files   t) (magit-apply-diffs  it "--cached"))
 | 
			
		||||
        (`(unstaged    list   t) (magit-apply-diffs  it "--cached"))
 | 
			
		||||
        (`(unstaged    file nil) (magit-stage-1 "-u" (list (oref it value))))
 | 
			
		||||
        (`(unstaged   files nil) (magit-stage-1 "-u" (magit-region-values nil t)))
 | 
			
		||||
        (`(unstaged    list nil) (magit-stage-modified))
 | 
			
		||||
        (`(staged        ,_  ,_) (user-error "Already staged"))
 | 
			
		||||
        (`(committed     ,_  ,_) (user-error "Cannot stage committed changes"))
 | 
			
		||||
        (`(undefined     ,_  ,_) (user-error "Cannot stage this change")))
 | 
			
		||||
    (call-interactively 'magit-stage-file)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-stage-file (file)
 | 
			
		||||
  "Stage all changes to FILE.
 | 
			
		||||
With a prefix argument or when there is no file at point ask for
 | 
			
		||||
the file to be staged.  Otherwise stage the file at point without
 | 
			
		||||
requiring confirmation."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let* ((atpoint (magit-section-value-if 'file))
 | 
			
		||||
          (current (magit-file-relative-name))
 | 
			
		||||
          (choices (nconc (magit-unstaged-files)
 | 
			
		||||
                          (magit-untracked-files)))
 | 
			
		||||
          (default (car (member (or atpoint current) choices))))
 | 
			
		||||
     (list (if (or current-prefix-arg (not default))
 | 
			
		||||
               (magit-completing-read "Stage file" choices
 | 
			
		||||
                                      nil t nil nil default)
 | 
			
		||||
             default))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-stage-1 nil (list file))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-stage-modified (&optional all)
 | 
			
		||||
  "Stage all changes to files modified in the worktree.
 | 
			
		||||
Stage all new content of tracked files and remove tracked files
 | 
			
		||||
that no longer exist in the working tree from the index also.
 | 
			
		||||
With a prefix argument also stage previously untracked (but not
 | 
			
		||||
ignored) files."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (when (magit-anything-staged-p)
 | 
			
		||||
    (magit-confirm 'stage-all-changes))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-stage-1 (if all "--all" "-u"))))
 | 
			
		||||
 | 
			
		||||
(defun magit-stage-1 (arg &optional files)
 | 
			
		||||
  (magit-wip-commit-before-change files " before stage")
 | 
			
		||||
  (magit-run-git "add" arg (if files (cons "--" files) "."))
 | 
			
		||||
  (when magit-auto-revert-mode
 | 
			
		||||
    (mapc #'magit-turn-on-auto-revert-mode-if-desired files))
 | 
			
		||||
  (magit-wip-commit-after-apply files " after stage"))
 | 
			
		||||
 | 
			
		||||
(defun magit-stage-untracked (&optional intent)
 | 
			
		||||
  (let* ((section (magit-current-section))
 | 
			
		||||
         (files (pcase (magit-diff-scope)
 | 
			
		||||
                  (`file  (list (oref section value)))
 | 
			
		||||
                  (`files (magit-region-values nil t))
 | 
			
		||||
                  (`list  (magit-untracked-files))))
 | 
			
		||||
         plain repos)
 | 
			
		||||
    (dolist (file files)
 | 
			
		||||
      (if (and (not (file-symlink-p file))
 | 
			
		||||
               (magit-git-repo-p file t))
 | 
			
		||||
          (push file repos)
 | 
			
		||||
        (push file plain)))
 | 
			
		||||
    (magit-wip-commit-before-change files " before stage")
 | 
			
		||||
    (when plain
 | 
			
		||||
      (magit-run-git "add" (and intent "--intent-to-add")
 | 
			
		||||
                     "--" plain)
 | 
			
		||||
      (when magit-auto-revert-mode
 | 
			
		||||
        (mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
 | 
			
		||||
    (dolist (repo repos)
 | 
			
		||||
      (save-excursion
 | 
			
		||||
        (goto-char (oref (magit-get-section
 | 
			
		||||
                          `((file . ,repo) (untracked) (status)))
 | 
			
		||||
                         start))
 | 
			
		||||
        (let* ((topdir (magit-toplevel))
 | 
			
		||||
               (package
 | 
			
		||||
                (and (equal (bound-and-true-p borg-user-emacs-directory)
 | 
			
		||||
                            topdir)
 | 
			
		||||
                     (file-name-nondirectory (directory-file-name repo)))))
 | 
			
		||||
          (magit-submodule-add
 | 
			
		||||
           (let ((default-directory
 | 
			
		||||
                   (file-name-as-directory (expand-file-name repo))))
 | 
			
		||||
             (or (magit-get "remote" (magit-get-some-remote) "url")
 | 
			
		||||
                 (concat (file-name-as-directory ".") repo)))
 | 
			
		||||
           repo
 | 
			
		||||
           (magit-submodule-read-name-for-path repo package))
 | 
			
		||||
          (when package
 | 
			
		||||
            (borg--sort-submodule-sections
 | 
			
		||||
             (expand-file-name ".gitmodules" topdir))
 | 
			
		||||
            (let ((default-directory borg-user-emacs-directory))
 | 
			
		||||
              (borg--maybe-absorb-gitdir package))
 | 
			
		||||
            (when (and (y-or-n-p
 | 
			
		||||
                        (format "Also build and activate `%s' drone?" package))
 | 
			
		||||
                       (fboundp 'borg-build)
 | 
			
		||||
                       (fboundp 'borg-activate))
 | 
			
		||||
              (borg-build package)
 | 
			
		||||
              (borg-activate package))))))
 | 
			
		||||
    (magit-wip-commit-after-apply files " after stage")))
 | 
			
		||||
 | 
			
		||||
;;;; Unstage
 | 
			
		||||
 | 
			
		||||
(defun magit-unstage ()
 | 
			
		||||
  "Remove the change at point from the staging area."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (--when-let (magit-apply--get-selection)
 | 
			
		||||
    (pcase (list (magit-diff-type)
 | 
			
		||||
                 (magit-diff-scope)
 | 
			
		||||
                 (magit-apply--diff-ignores-whitespace-p))
 | 
			
		||||
      (`(untracked     ,_  ,_) (user-error "Cannot unstage untracked changes"))
 | 
			
		||||
      (`(unstaged      ,_  ,_) (user-error "Already unstaged"))
 | 
			
		||||
      (`(staged    region  ,_) (magit-apply-region it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged      hunk  ,_) (magit-apply-hunk   it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged     hunks  ,_) (magit-apply-hunks  it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged      file   t) (magit-apply-diff   it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged     files   t) (magit-apply-diffs  it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged      list   t) (magit-apply-diffs  it "--reverse" "--cached"))
 | 
			
		||||
      (`(staged      file nil) (magit-unstage-1 (list (oref it value))))
 | 
			
		||||
      (`(staged     files nil) (magit-unstage-1 (magit-region-values nil t)))
 | 
			
		||||
      (`(staged      list nil) (magit-unstage-all))
 | 
			
		||||
      (`(committed     ,_  ,_) (if magit-unstage-committed
 | 
			
		||||
                                   (magit-reverse-in-index)
 | 
			
		||||
                                 (user-error "Cannot unstage committed changes")))
 | 
			
		||||
      (`(undefined     ,_  ,_) (user-error "Cannot unstage this change")))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-unstage-file (file)
 | 
			
		||||
  "Unstage all changes to FILE.
 | 
			
		||||
With a prefix argument or when there is no file at point ask for
 | 
			
		||||
the file to be unstaged.  Otherwise unstage the file at point
 | 
			
		||||
without requiring confirmation."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let* ((atpoint (magit-section-value-if 'file))
 | 
			
		||||
          (current (magit-file-relative-name))
 | 
			
		||||
          (choices (magit-staged-files))
 | 
			
		||||
          (default (car (member (or atpoint current) choices))))
 | 
			
		||||
     (list (if (or current-prefix-arg (not default))
 | 
			
		||||
               (magit-completing-read "Unstage file" choices
 | 
			
		||||
                                      nil t nil nil default)
 | 
			
		||||
             default))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-unstage-1 (list file))))
 | 
			
		||||
 | 
			
		||||
(defun magit-unstage-1 (files)
 | 
			
		||||
  (magit-wip-commit-before-change files " before unstage")
 | 
			
		||||
  (if (magit-no-commit-p)
 | 
			
		||||
      (magit-run-git "rm" "--cached" "--" files)
 | 
			
		||||
    (magit-run-git "reset" "HEAD" "--" files))
 | 
			
		||||
  (magit-wip-commit-after-apply files " after unstage"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-unstage-all ()
 | 
			
		||||
  "Remove all changes from the staging area."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (when (or (magit-anything-unstaged-p)
 | 
			
		||||
            (magit-untracked-files))
 | 
			
		||||
    (magit-confirm 'unstage-all-changes))
 | 
			
		||||
  (magit-wip-commit-before-change nil " before unstage")
 | 
			
		||||
  (magit-run-git "reset" "HEAD" "--")
 | 
			
		||||
  (magit-wip-commit-after-apply nil " after unstage"))
 | 
			
		||||
 | 
			
		||||
;;;; Discard
 | 
			
		||||
 | 
			
		||||
(defun magit-discard ()
 | 
			
		||||
  "Remove the change at point."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (--when-let (magit-apply--get-selection)
 | 
			
		||||
    (pcase (list (magit-diff-type) (magit-diff-scope))
 | 
			
		||||
      (`(committed ,_) (user-error "Cannot discard committed changes"))
 | 
			
		||||
      (`(undefined ,_) (user-error "Cannot discard this change"))
 | 
			
		||||
      (`(,_    region) (magit-discard-region it))
 | 
			
		||||
      (`(,_      hunk) (magit-discard-hunk   it))
 | 
			
		||||
      (`(,_     hunks) (magit-discard-hunks  it))
 | 
			
		||||
      (`(,_      file) (magit-discard-file   it))
 | 
			
		||||
      (`(,_     files) (magit-discard-files  it))
 | 
			
		||||
      (`(,_      list) (magit-discard-files  it)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-region (section)
 | 
			
		||||
  (magit-confirm 'discard "Discard region")
 | 
			
		||||
  (magit-discard-apply section 'magit-apply-region))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-hunk (section)
 | 
			
		||||
  (magit-confirm 'discard "Discard hunk")
 | 
			
		||||
  (magit-discard-apply section 'magit-apply-hunk))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-apply (section apply)
 | 
			
		||||
  (if (eq (magit-diff-type section) 'unstaged)
 | 
			
		||||
      (funcall apply section "--reverse")
 | 
			
		||||
    (if (magit-anything-unstaged-p
 | 
			
		||||
         nil (if (magit-file-section-p section)
 | 
			
		||||
                 (oref section value)
 | 
			
		||||
               (magit-section-parent-value section)))
 | 
			
		||||
        (progn (let ((inhibit-magit-refresh t))
 | 
			
		||||
                 (funcall apply section "--reverse" "--cached")
 | 
			
		||||
                 (funcall apply section "--reverse" "--reject"))
 | 
			
		||||
               (magit-refresh))
 | 
			
		||||
      (funcall apply section "--reverse" "--index"))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-hunks (sections)
 | 
			
		||||
  (magit-confirm 'discard (format "Discard %s hunks from %s"
 | 
			
		||||
                                  (length sections)
 | 
			
		||||
                                  (magit-section-parent-value (car sections))))
 | 
			
		||||
  (magit-discard-apply-n sections 'magit-apply-hunks))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-apply-n (sections apply)
 | 
			
		||||
  (let ((section (car sections)))
 | 
			
		||||
    (if (eq (magit-diff-type section) 'unstaged)
 | 
			
		||||
        (funcall apply sections "--reverse")
 | 
			
		||||
      (if (magit-anything-unstaged-p
 | 
			
		||||
           nil (if (magit-file-section-p section)
 | 
			
		||||
                   (oref section value)
 | 
			
		||||
                 (magit-section-parent-value section)))
 | 
			
		||||
          (progn (let ((inhibit-magit-refresh t))
 | 
			
		||||
                   (funcall apply sections "--reverse" "--cached")
 | 
			
		||||
                   (funcall apply sections "--reverse" "--reject"))
 | 
			
		||||
                 (magit-refresh))
 | 
			
		||||
        (funcall apply sections "--reverse" "--index")))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-file (section)
 | 
			
		||||
  (magit-discard-files (list section)))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files (sections)
 | 
			
		||||
  (let ((auto-revert-verbose nil)
 | 
			
		||||
        (type (magit-diff-type (car sections)))
 | 
			
		||||
        (status (magit-file-status))
 | 
			
		||||
        files delete resurrect rename discard discard-new resolve)
 | 
			
		||||
    (dolist (section sections)
 | 
			
		||||
      (let ((file (oref section value)))
 | 
			
		||||
        (push file files)
 | 
			
		||||
        (pcase (cons (pcase type
 | 
			
		||||
                       (`staged ?X)
 | 
			
		||||
                       (`unstaged ?Y)
 | 
			
		||||
                       (`untracked ?Z))
 | 
			
		||||
                     (cddr (assoc file status)))
 | 
			
		||||
          (`(?Z) (dolist (f (magit-untracked-files nil file))
 | 
			
		||||
                   (push f delete)))
 | 
			
		||||
          ((or `(?Z ?? ??) `(?Z ?! ?!)) (push file delete))
 | 
			
		||||
          ((or `(?Z ?D ? ) `(,_ ?D ?D)) (push file delete))
 | 
			
		||||
          ((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve))
 | 
			
		||||
          (`(,_ ?A ?A)                  (push file resolve))
 | 
			
		||||
          (`(?X ?M ,(or ?  ?M ?D)) (push section discard))
 | 
			
		||||
          (`(?Y ,_         ?M    ) (push section discard))
 | 
			
		||||
          (`(?X ?A         ?M    ) (push file discard-new))
 | 
			
		||||
          (`(?X ?C         ?M    ) (push file discard-new))
 | 
			
		||||
          (`(?X ?A ,(or ?     ?D)) (push file delete))
 | 
			
		||||
          (`(?X ?C ,(or ?     ?D)) (push file delete))
 | 
			
		||||
          (`(?X ?D ,(or ?  ?M   )) (push file resurrect))
 | 
			
		||||
          (`(?Y ,_            ?D ) (push file resurrect))
 | 
			
		||||
          (`(?X ?R ,(or ?  ?M ?D)) (push file rename)))))
 | 
			
		||||
    (unwind-protect
 | 
			
		||||
        (let ((inhibit-magit-refresh t))
 | 
			
		||||
          (magit-wip-commit-before-change files " before discard")
 | 
			
		||||
          (when resolve
 | 
			
		||||
            (magit-discard-files--resolve (nreverse resolve)))
 | 
			
		||||
          (when resurrect
 | 
			
		||||
            (magit-discard-files--resurrect (nreverse resurrect)))
 | 
			
		||||
          (when delete
 | 
			
		||||
            (magit-discard-files--delete (nreverse delete) status))
 | 
			
		||||
          (when rename
 | 
			
		||||
            (magit-discard-files--rename (nreverse rename) status))
 | 
			
		||||
          (when (or discard discard-new)
 | 
			
		||||
            (magit-discard-files--discard (nreverse discard)
 | 
			
		||||
                                          (nreverse discard-new)))
 | 
			
		||||
          (magit-wip-commit-after-apply files " after discard"))
 | 
			
		||||
      (magit-refresh))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files--resolve (files)
 | 
			
		||||
  (if-let ((arg (and (cdr files)
 | 
			
		||||
                     (magit-read-char-case
 | 
			
		||||
                         (format "For these %i files\n%s\ncheckout:\n"
 | 
			
		||||
                                 (length files)
 | 
			
		||||
                                 (mapconcat (lambda (file)
 | 
			
		||||
                                              (concat "  " file))
 | 
			
		||||
                                            files "\n"))
 | 
			
		||||
                         t
 | 
			
		||||
                       (?o "[o]ur stage"   "--ours")
 | 
			
		||||
                       (?t "[t]heir stage" "--theirs")
 | 
			
		||||
                       (?c "[c]onflict"    "--merge")
 | 
			
		||||
                       (?i "decide [i]ndividually" nil)))))
 | 
			
		||||
      (dolist (file files)
 | 
			
		||||
        (magit-checkout-stage file arg))
 | 
			
		||||
    (dolist (file files)
 | 
			
		||||
      (magit-checkout-stage file (magit-checkout-read-stage file)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files--resurrect (files)
 | 
			
		||||
  (magit-confirm-files 'resurrect files)
 | 
			
		||||
  (if (eq (magit-diff-type) 'staged)
 | 
			
		||||
      (magit-call-git "reset"  "--" files)
 | 
			
		||||
    (magit-call-git "checkout" "--" files)))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files--delete (files status)
 | 
			
		||||
  (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
 | 
			
		||||
                       files)
 | 
			
		||||
  (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
 | 
			
		||||
    (dolist (file files)
 | 
			
		||||
      (if (memq (magit-diff-type) '(unstaged untracked))
 | 
			
		||||
          (progn (dired-delete-file file dired-recursive-deletes
 | 
			
		||||
                                    magit-delete-by-moving-to-trash)
 | 
			
		||||
                 (dired-clean-up-after-deletion file))
 | 
			
		||||
        (pcase (nth 3 (assoc file status))
 | 
			
		||||
          (?  (delete-file file t)
 | 
			
		||||
              (magit-call-git "rm" "--cached" "--" file))
 | 
			
		||||
          (?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
 | 
			
		||||
                (string-match
 | 
			
		||||
                 (format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
 | 
			
		||||
                (rename-file (match-string 1 temp)
 | 
			
		||||
                             (setq temp (concat file ".~{index}~")))
 | 
			
		||||
                (delete-file temp t))
 | 
			
		||||
              (magit-call-git "rm" "--cached" "--force" "--" file))
 | 
			
		||||
          (?D (magit-call-git "checkout" "--" file)
 | 
			
		||||
              (delete-file file t)
 | 
			
		||||
              (magit-call-git "rm" "--cached" "--force" "--" file)))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files--rename (files status)
 | 
			
		||||
  (magit-confirm 'rename "Undo rename %s" "Undo %i renames" nil
 | 
			
		||||
    (mapcar (lambda (file)
 | 
			
		||||
              (setq file (assoc file status))
 | 
			
		||||
              (format "%s -> %s" (cadr file) (car file)))
 | 
			
		||||
            files))
 | 
			
		||||
  (dolist (file files)
 | 
			
		||||
    (let ((orig (cadr (assoc file status))))
 | 
			
		||||
      (if (file-exists-p file)
 | 
			
		||||
          (progn
 | 
			
		||||
            (--when-let (file-name-directory orig)
 | 
			
		||||
              (make-directory it t))
 | 
			
		||||
            (magit-call-git "mv" file orig))
 | 
			
		||||
        (magit-call-git "rm" "--cached" "--" file)
 | 
			
		||||
        (magit-call-git "reset" "--" orig)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-discard-files--discard (sections new-files)
 | 
			
		||||
  (let ((files (--map (oref it value) sections)))
 | 
			
		||||
    (magit-confirm-files 'discard (append files new-files)
 | 
			
		||||
                         (format "Discard %s changes in" (magit-diff-type)))
 | 
			
		||||
    (if (eq (magit-diff-type (car sections)) 'unstaged)
 | 
			
		||||
        (magit-call-git "checkout" "--" files)
 | 
			
		||||
      (when new-files
 | 
			
		||||
        (magit-call-git "add"   "--" new-files)
 | 
			
		||||
        (magit-call-git "reset" "--" new-files))
 | 
			
		||||
      (let ((binaries (magit-staged-binary-files)))
 | 
			
		||||
        (when binaries
 | 
			
		||||
          (setq sections
 | 
			
		||||
                (--remove (member (oref it value) binaries)
 | 
			
		||||
                          sections)))
 | 
			
		||||
        (cond ((= (length sections) 1)
 | 
			
		||||
               (magit-discard-apply (car sections) 'magit-apply-diff))
 | 
			
		||||
              (sections
 | 
			
		||||
               (magit-discard-apply-n sections 'magit-apply-diffs)))
 | 
			
		||||
        (when binaries
 | 
			
		||||
          (let ((modified (magit-unstaged-files t)))
 | 
			
		||||
            (setq binaries (--separate (member it modified) binaries)))
 | 
			
		||||
          (when (cadr binaries)
 | 
			
		||||
            (magit-call-git "reset" "--" (cadr binaries)))
 | 
			
		||||
          (when (car binaries)
 | 
			
		||||
            (user-error
 | 
			
		||||
             (concat
 | 
			
		||||
              "Cannot discard staged changes to binary files, "
 | 
			
		||||
              "which also have unstaged changes.  Unstage instead."))))))))
 | 
			
		||||
 | 
			
		||||
;;;; Reverse
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse (&rest args)
 | 
			
		||||
  "Reverse the change at point in the working tree.
 | 
			
		||||
With a prefix argument fallback to a 3-way merge.  Doing
 | 
			
		||||
so causes the change to be applied to the index as well."
 | 
			
		||||
  (interactive (and current-prefix-arg (list "--3way")))
 | 
			
		||||
  (--when-let (magit-apply--get-selection)
 | 
			
		||||
    (pcase (list (magit-diff-type) (magit-diff-scope))
 | 
			
		||||
      (`(untracked ,_) (user-error "Cannot reverse untracked changes"))
 | 
			
		||||
      (`(unstaged  ,_) (user-error "Cannot reverse unstaged changes"))
 | 
			
		||||
      (`(,_    region) (magit-reverse-region it args))
 | 
			
		||||
      (`(,_      hunk) (magit-reverse-hunk   it args))
 | 
			
		||||
      (`(,_     hunks) (magit-reverse-hunks  it args))
 | 
			
		||||
      (`(,_      file) (magit-reverse-file   it args))
 | 
			
		||||
      (`(,_     files) (magit-reverse-files  it args))
 | 
			
		||||
      (`(,_      list) (magit-reverse-files  it args)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-region (section args)
 | 
			
		||||
  (magit-confirm 'reverse "Reverse region")
 | 
			
		||||
  (magit-reverse-apply section 'magit-apply-region args))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-hunk (section args)
 | 
			
		||||
  (magit-confirm 'reverse "Reverse hunk")
 | 
			
		||||
  (magit-reverse-apply section 'magit-apply-hunk args))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-hunks (sections args)
 | 
			
		||||
  (magit-confirm 'reverse
 | 
			
		||||
    (format "Reverse %s hunks from %s"
 | 
			
		||||
            (length sections)
 | 
			
		||||
            (magit-section-parent-value (car sections))))
 | 
			
		||||
  (magit-reverse-apply sections 'magit-apply-hunks args))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-file (section args)
 | 
			
		||||
  (magit-reverse-files (list section) args))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-files (sections args)
 | 
			
		||||
  (pcase-let ((`(,binaries ,sections)
 | 
			
		||||
               (let ((bs (magit-staged-binary-files)))
 | 
			
		||||
                 (--separate (member (oref it value) bs)
 | 
			
		||||
                             sections))))
 | 
			
		||||
    (magit-confirm-files 'reverse (--map (oref it value) sections))
 | 
			
		||||
    (if (= (length sections) 1)
 | 
			
		||||
        (magit-reverse-apply (car sections) 'magit-apply-diff args)
 | 
			
		||||
      (magit-reverse-apply sections 'magit-apply-diffs args))
 | 
			
		||||
    (when binaries
 | 
			
		||||
      (user-error "Cannot reverse binary files"))))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-apply (section:s apply args)
 | 
			
		||||
  (funcall apply section:s "--reverse" args
 | 
			
		||||
           (and (not magit-reverse-atomically)
 | 
			
		||||
                (not (member "--3way" args))
 | 
			
		||||
                "--reject")))
 | 
			
		||||
 | 
			
		||||
(defun magit-reverse-in-index (&rest args)
 | 
			
		||||
  "Reverse the change at point in the index but not the working tree.
 | 
			
		||||
 | 
			
		||||
Use this command to extract a change from `HEAD', while leaving
 | 
			
		||||
it in the working tree, so that it can later be committed using
 | 
			
		||||
a separate commit.  A typical workflow would be:
 | 
			
		||||
 | 
			
		||||
0. Optionally make sure that there are no uncommitted changes.
 | 
			
		||||
1. Visit the `HEAD' commit and navigate to the change that should
 | 
			
		||||
   not have been included in that commit.
 | 
			
		||||
2. Type \"u\" (`magit-unstage') to reverse it in the index.
 | 
			
		||||
   This assumes that `magit-unstage-committed-changes' is non-nil.
 | 
			
		||||
3. Type \"c e\" to extend `HEAD' with the staged changes,
 | 
			
		||||
   including those that were already staged before.
 | 
			
		||||
4. Optionally stage the remaining changes using \"s\" or \"S\"
 | 
			
		||||
   and then type \"c c\" to create a new commit."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-reverse (cons "--cached" args)))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-apply)
 | 
			
		||||
;;; magit-apply.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							@ -1,260 +0,0 @@
 | 
			
		||||
;;; magit-autorevert.el --- revert buffers when files in repository change  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'cl-lib)
 | 
			
		||||
(require 'dash)
 | 
			
		||||
 | 
			
		||||
(require 'magit-git)
 | 
			
		||||
 | 
			
		||||
(require 'autorevert)
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defgroup magit-auto-revert nil
 | 
			
		||||
  "Revert buffers when files in repository change."
 | 
			
		||||
  :link '(custom-group-link auto-revert)
 | 
			
		||||
  :link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
 | 
			
		||||
  :group 'auto-revert
 | 
			
		||||
  :group 'magit-essentials
 | 
			
		||||
  :group 'magit-modes)
 | 
			
		||||
 | 
			
		||||
(defcustom auto-revert-buffer-list-filter nil
 | 
			
		||||
  "Filter that determines which buffers `auto-revert-buffers' reverts.
 | 
			
		||||
 | 
			
		||||
This option is provided by `magit', which also redefines
 | 
			
		||||
`auto-revert-buffers' to respect it.  Magit users who do not turn
 | 
			
		||||
on the local mode `auto-revert-mode' themselves, are best served
 | 
			
		||||
by setting the value to `magit-auto-revert-repository-buffers-p'.
 | 
			
		||||
 | 
			
		||||
However the default is nil, to not disturb users who do use the
 | 
			
		||||
local mode directly.  If you experience delays when running Magit
 | 
			
		||||
commands, then you should consider using one of the predicates
 | 
			
		||||
provided by Magit - especially if you also use Tramp.
 | 
			
		||||
 | 
			
		||||
Users who do turn on `auto-revert-mode' in buffers in which Magit
 | 
			
		||||
doesn't do that for them, should likely not use any filter.
 | 
			
		||||
Users who turn on `global-auto-revert-mode', do not have to worry
 | 
			
		||||
about this option, because it is disregarded if the global mode
 | 
			
		||||
is enabled."
 | 
			
		||||
  :package-version '(magit . "2.4.2")
 | 
			
		||||
  :group 'auto-revert
 | 
			
		||||
  :group 'magit-auto-revert
 | 
			
		||||
  :group 'magit-related
 | 
			
		||||
  :type '(radio (const :tag "no filter" nil)
 | 
			
		||||
                (function-item magit-auto-revert-buffer-p)
 | 
			
		||||
                (function-item magit-auto-revert-repository-buffer-p)
 | 
			
		||||
                function))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-auto-revert-tracked-only t
 | 
			
		||||
  "Whether `magit-auto-revert-mode' only reverts tracked files."
 | 
			
		||||
  :package-version '(magit . "2.4.0")
 | 
			
		||||
  :group 'magit-auto-revert
 | 
			
		||||
  :type 'boolean
 | 
			
		||||
  :set (lambda (var val)
 | 
			
		||||
         (set var val)
 | 
			
		||||
         (when (and (bound-and-true-p magit-auto-revert-mode)
 | 
			
		||||
                    (featurep 'magit-autorevert))
 | 
			
		||||
           (magit-auto-revert-mode -1)
 | 
			
		||||
           (magit-auto-revert-mode))))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-auto-revert-immediately t
 | 
			
		||||
  "Whether Magit reverts buffers immediately.
 | 
			
		||||
 | 
			
		||||
If this is non-nil and either `global-auto-revert-mode' or
 | 
			
		||||
`magit-auto-revert-mode' is enabled, then Magit immediately
 | 
			
		||||
reverts buffers by explicitly calling `auto-revert-buffers'
 | 
			
		||||
after running git for side-effects.
 | 
			
		||||
 | 
			
		||||
If `auto-revert-use-notify' is non-nil (and file notifications
 | 
			
		||||
are actually supported), then `magit-auto-revert-immediately'
 | 
			
		||||
does not have to be non-nil, because the reverts happen
 | 
			
		||||
immediately anyway.
 | 
			
		||||
 | 
			
		||||
If `magit-auto-revert-immediately' and `auto-revert-use-notify'
 | 
			
		||||
are both nil, then reverts happen after `auto-revert-interval'
 | 
			
		||||
seconds of user inactivity.  That is not desirable."
 | 
			
		||||
  :package-version '(magit . "2.4.0")
 | 
			
		||||
  :group 'magit-auto-revert
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
;;; Mode
 | 
			
		||||
 | 
			
		||||
(defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
 | 
			
		||||
  (if file
 | 
			
		||||
      (--when-let (find-buffer-visiting file)
 | 
			
		||||
        (with-current-buffer it
 | 
			
		||||
          (magit-turn-on-auto-revert-mode-if-desired)))
 | 
			
		||||
    (when (and buffer-file-name
 | 
			
		||||
               (file-readable-p buffer-file-name)
 | 
			
		||||
               (magit-toplevel)
 | 
			
		||||
               (or (not magit-auto-revert-tracked-only)
 | 
			
		||||
                   (magit-file-tracked-p buffer-file-name))
 | 
			
		||||
               (not auto-revert-mode)         ; see #3014
 | 
			
		||||
               (not global-auto-revert-mode)) ; see #3460
 | 
			
		||||
      (auto-revert-mode 1))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-globalized-minor-mode magit-auto-revert-mode auto-revert-mode
 | 
			
		||||
  magit-turn-on-auto-revert-mode-if-desired
 | 
			
		||||
  :package-version '(magit . "2.4.0")
 | 
			
		||||
  :link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
 | 
			
		||||
  :group 'magit-auto-revert
 | 
			
		||||
  :group 'magit-essentials
 | 
			
		||||
  ;; - When `global-auto-revert-mode' is enabled, then this mode is
 | 
			
		||||
  ;;   redundant.
 | 
			
		||||
  ;; - In all other cases enable the mode because if buffers are not
 | 
			
		||||
  ;;   automatically reverted that would make many very common tasks
 | 
			
		||||
  ;;   much more cumbersome.
 | 
			
		||||
  ;; - When `magit-revert-buffers' is nil, then the user has opted out
 | 
			
		||||
  ;;   of the automatic reverts while a very old implementation was
 | 
			
		||||
  ;;   still in use.  We continued to respect that setting for another
 | 
			
		||||
  ;;   two and a half years, but no longer do so now.
 | 
			
		||||
  :init-value (and (not global-auto-revert-mode)
 | 
			
		||||
                   (not noninteractive)))
 | 
			
		||||
;; - Unfortunately `:init-value t' only sets the value of the mode
 | 
			
		||||
;;   variable but does not cause the mode function to be called.
 | 
			
		||||
;; - I don't think it works like this on purpose, but since one usually
 | 
			
		||||
;;   should not enable global modes by default, it is understandable.
 | 
			
		||||
;; - If the user has set the variable `magit-auto-revert-mode' to nil
 | 
			
		||||
;;   after loading magit (instead of doing so before loading magit or
 | 
			
		||||
;;   by using the function), then we should still respect that setting.
 | 
			
		||||
;; - If the user has set the obsolete variable `magit-revert-buffers'
 | 
			
		||||
;;   to nil before or after loading magit, then we should still respect
 | 
			
		||||
;;   that setting.
 | 
			
		||||
;; - If the user sets one of these variables after loading magit and
 | 
			
		||||
;;   after `after-init-hook' has run, then that won't have an effect
 | 
			
		||||
;;   and there is nothing we can do about it.
 | 
			
		||||
(defun magit-auto-revert-mode--init-kludge ()
 | 
			
		||||
  "This is an internal kludge to be used on `after-init-hook'.
 | 
			
		||||
Do not use this function elsewhere, and don't remove it from
 | 
			
		||||
the `after-init-hook'.  For more information see the comments
 | 
			
		||||
and code surrounding the definition of this function."
 | 
			
		||||
  (if magit-auto-revert-mode
 | 
			
		||||
      (let ((start (current-time)))
 | 
			
		||||
        (magit-message "Turning on magit-auto-revert-mode...")
 | 
			
		||||
        (magit-auto-revert-mode 1)
 | 
			
		||||
        (magit-message
 | 
			
		||||
         "Turning on magit-auto-revert-mode...done%s"
 | 
			
		||||
         (let ((elapsed (float-time (time-subtract (current-time) start))))
 | 
			
		||||
           (if (> elapsed 0.2)
 | 
			
		||||
               (format " (%.3fs, %s buffers checked)" elapsed
 | 
			
		||||
                       (length (buffer-list)))
 | 
			
		||||
             ""))))
 | 
			
		||||
    (magit-auto-revert-mode -1)))
 | 
			
		||||
(if after-init-time
 | 
			
		||||
    ;; Since `after-init-hook' has already been
 | 
			
		||||
    ;; run, turn the mode on or off right now.
 | 
			
		||||
    (magit-auto-revert-mode--init-kludge)
 | 
			
		||||
  ;; By the time the init file has been fully loaded the
 | 
			
		||||
  ;; values of the relevant variables might have changed.
 | 
			
		||||
  (add-hook 'after-init-hook #'magit-auto-revert-mode--init-kludge t))
 | 
			
		||||
 | 
			
		||||
(put 'magit-auto-revert-mode 'function-documentation
 | 
			
		||||
     "Toggle Magit Auto Revert mode.
 | 
			
		||||
With a prefix argument ARG, enable Magit Auto Revert mode if ARG
 | 
			
		||||
is positive, and disable it otherwise.  If called from Lisp,
 | 
			
		||||
enable the mode if ARG is omitted or nil.
 | 
			
		||||
 | 
			
		||||
Magit Auto Revert mode is a global minor mode that reverts
 | 
			
		||||
buffers associated with a file that is located inside a Git
 | 
			
		||||
repository when the file changes on disk.  Use `auto-revert-mode'
 | 
			
		||||
to revert a particular buffer.  Or use `global-auto-revert-mode'
 | 
			
		||||
to revert all file-visiting buffers, not just those that visit
 | 
			
		||||
a file located inside a Git repository.
 | 
			
		||||
 | 
			
		||||
This global mode works by turning on the buffer-local mode
 | 
			
		||||
`auto-revert-mode' at the time a buffer is first created.  The
 | 
			
		||||
local mode is turned on if the visited file is being tracked in
 | 
			
		||||
a Git repository at the time when the buffer is created.
 | 
			
		||||
 | 
			
		||||
If `magit-auto-revert-tracked-only' is non-nil (the default),
 | 
			
		||||
then only tracked files are reverted.  But if you stage a
 | 
			
		||||
previously untracked file using `magit-stage', then this mode
 | 
			
		||||
notices that.
 | 
			
		||||
 | 
			
		||||
Unlike `global-auto-revert-mode', this mode never reverts any
 | 
			
		||||
buffers that are not visiting files.
 | 
			
		||||
 | 
			
		||||
The behavior of this mode can be customized using the options
 | 
			
		||||
in the `autorevert' and `magit-autorevert' groups.
 | 
			
		||||
 | 
			
		||||
This function calls the hook `magit-auto-revert-mode-hook'.")
 | 
			
		||||
 | 
			
		||||
(defun magit-auto-revert-buffers ()
 | 
			
		||||
  (when (and magit-auto-revert-immediately
 | 
			
		||||
             (or global-auto-revert-mode
 | 
			
		||||
                 (and magit-auto-revert-mode auto-revert-buffer-list)))
 | 
			
		||||
    (let ((auto-revert-buffer-list-filter
 | 
			
		||||
           (or auto-revert-buffer-list-filter
 | 
			
		||||
               'magit-auto-revert-repository-buffer-p)))
 | 
			
		||||
      (auto-revert-buffers))))
 | 
			
		||||
 | 
			
		||||
(defvar magit-auto-revert-toplevel nil)
 | 
			
		||||
 | 
			
		||||
(when (< emacs-major-version 25)
 | 
			
		||||
  (defvar auto-revert-buffers-counter 1
 | 
			
		||||
    "Incremented each time `auto-revert-buffers' is called"))
 | 
			
		||||
 | 
			
		||||
(defun magit-auto-revert-buffer-p (buffer)
 | 
			
		||||
  "Return t if BUFFER visits a file inside the current repository.
 | 
			
		||||
The current repository is the one in which `default-directory' is
 | 
			
		||||
located.  If there is no current repository, then return t for
 | 
			
		||||
any BUFFER."
 | 
			
		||||
  (magit-auto-revert-repository-buffer-p buffer t))
 | 
			
		||||
 | 
			
		||||
(defun magit-auto-revert-repository-buffer-p (buffer &optional fallback)
 | 
			
		||||
  "Return t if BUFFER visits a file inside the current repository.
 | 
			
		||||
The current repository is the one in which `default-directory' is
 | 
			
		||||
located.  If there is no current repository, then return FALLBACK
 | 
			
		||||
\(which defaults to nil) for any BUFFER."
 | 
			
		||||
  ;; Call `magit-toplevel' just once per cycle.
 | 
			
		||||
  (unless (and magit-auto-revert-toplevel
 | 
			
		||||
               (= (cdr magit-auto-revert-toplevel)
 | 
			
		||||
                  auto-revert-buffers-counter))
 | 
			
		||||
    (setq magit-auto-revert-toplevel
 | 
			
		||||
          (cons (or (magit-toplevel) 'no-repo)
 | 
			
		||||
                auto-revert-buffers-counter)))
 | 
			
		||||
  (let ((top (car magit-auto-revert-toplevel)))
 | 
			
		||||
    (if (eq top 'no-repo)
 | 
			
		||||
        fallback
 | 
			
		||||
      (let ((dir (with-current-buffer buffer default-directory)))
 | 
			
		||||
        (and (equal (file-remote-p dir)
 | 
			
		||||
                    (file-remote-p top))
 | 
			
		||||
             ;; ^ `tramp-handle-file-in-directory-p' lacks this optimization.
 | 
			
		||||
             (file-in-directory-p dir top))))))
 | 
			
		||||
 | 
			
		||||
(defun auto-revert-buffers--buffer-list-filter ()
 | 
			
		||||
  (when (< emacs-major-version 25)
 | 
			
		||||
    (cl-incf auto-revert-buffers-counter))
 | 
			
		||||
  (when auto-revert-buffer-list-filter
 | 
			
		||||
    (setq auto-revert-buffer-list
 | 
			
		||||
          (--filter auto-revert-buffer-list-filter
 | 
			
		||||
                    auto-revert-buffer-list))))
 | 
			
		||||
 | 
			
		||||
(advice-add 'auto-revert-buffers :before
 | 
			
		||||
            'auto-revert-buffers--buffer-list-filter)
 | 
			
		||||
 | 
			
		||||
(provide 'magit-autorevert)
 | 
			
		||||
;;; magit-autorevert.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,216 +0,0 @@
 | 
			
		||||
;;; magit-bisect.el --- bisect support for Magit  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2011-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Use a binary search to find the commit that introduced a bug.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defcustom magit-bisect-show-graph t
 | 
			
		||||
  "Whether to use `--graph' in the log showing commits yet to be bisected."
 | 
			
		||||
  :package-version '(magit . "2.8.0")
 | 
			
		||||
  :group 'magit-status
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defface magit-bisect-good
 | 
			
		||||
  '((t :foreground "DarkOliveGreen"))
 | 
			
		||||
  "Face for good bisect revisions."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-bisect-skip
 | 
			
		||||
  '((t :foreground "DarkGoldenrod"))
 | 
			
		||||
  "Face for skipped bisect revisions."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-bisect-bad
 | 
			
		||||
  '((t :foreground "IndianRed4"))
 | 
			
		||||
  "Face for bad bisect revisions."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-bisect-popup "magit-bisect" nil t)
 | 
			
		||||
(magit-define-popup magit-bisect-popup
 | 
			
		||||
  "Popup console for bisect commands."
 | 
			
		||||
  :man-page "git-bisect"
 | 
			
		||||
  :actions            '((?B "Start"        magit-bisect-start)
 | 
			
		||||
                        (?s "Start script" magit-bisect-run))
 | 
			
		||||
  :sequence-actions   '((?b "Bad"          magit-bisect-bad)
 | 
			
		||||
                        (?g "Good"         magit-bisect-good)
 | 
			
		||||
                        (?k "Skip"         magit-bisect-skip)
 | 
			
		||||
                        (?r "Reset"        magit-bisect-reset)
 | 
			
		||||
                        (?s "Run script"   magit-bisect-run))
 | 
			
		||||
  :sequence-predicate 'magit-bisect-in-progress-p)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-start (bad good)
 | 
			
		||||
  "Start a bisect session.
 | 
			
		||||
 | 
			
		||||
Bisecting a bug means to find the commit that introduced it.
 | 
			
		||||
This command starts such a bisect session by asking for a know
 | 
			
		||||
good and a bad commit.  To move the session forward use the
 | 
			
		||||
other actions from the bisect popup (\
 | 
			
		||||
\\<magit-status-mode-map>\\[magit-bisect-popup])."
 | 
			
		||||
  (interactive (if (magit-bisect-in-progress-p)
 | 
			
		||||
                   (user-error "Already bisecting")
 | 
			
		||||
                 (magit-bisect-start-read-args)))
 | 
			
		||||
  (unless (magit-rev-ancestor-p good bad)
 | 
			
		||||
    (user-error
 | 
			
		||||
     "The good revision (%s) has to be an ancestor of the bad one (%s)"
 | 
			
		||||
     good bad))
 | 
			
		||||
  (when (magit-anything-modified-p)
 | 
			
		||||
    (user-error "Cannot bisect with uncommitted changes"))
 | 
			
		||||
  (magit-git-bisect "start" (list bad good) t))
 | 
			
		||||
 | 
			
		||||
(defun magit-bisect-start-read-args ()
 | 
			
		||||
  (let  ((b (magit-read-branch-or-commit "Start bisect with bad revision")))
 | 
			
		||||
    (list b (magit-read-other-branch-or-commit "Good revision" b))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-reset ()
 | 
			
		||||
  "After bisecting, cleanup bisection state and return to original `HEAD'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-confirm 'reset-bisect)
 | 
			
		||||
  (magit-run-git "bisect" "reset")
 | 
			
		||||
  (ignore-errors (delete-file (magit-git-dir "BISECT_CMD_OUTPUT"))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-good ()
 | 
			
		||||
  "While bisecting, mark the current commit as good.
 | 
			
		||||
Use this after you have asserted that the commit does not contain
 | 
			
		||||
the bug in question."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-git-bisect "good"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-bad ()
 | 
			
		||||
  "While bisecting, mark the current commit as bad.
 | 
			
		||||
Use this after you have asserted that the commit does contain the
 | 
			
		||||
bug in question."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-git-bisect "bad"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-skip ()
 | 
			
		||||
  "While bisecting, skip the current commit.
 | 
			
		||||
Use this if for some reason the current commit is not a good one
 | 
			
		||||
to test.  This command lets Git choose a different one."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-git-bisect "skip"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bisect-run (cmdline &optional bad good)
 | 
			
		||||
  "Bisect automatically by running commands after each step.
 | 
			
		||||
 | 
			
		||||
Unlike `git bisect run' this can be used before bisecting has
 | 
			
		||||
begun.  In that case it behaves like `git bisect start; git
 | 
			
		||||
bisect run'."
 | 
			
		||||
  (interactive (let ((args (and (not (magit-bisect-in-progress-p))
 | 
			
		||||
                                (magit-bisect-start-read-args))))
 | 
			
		||||
                 (cons (read-shell-command "Bisect shell command: ") args)))
 | 
			
		||||
  (when (and bad good)
 | 
			
		||||
    (magit-bisect-start bad good))
 | 
			
		||||
  (magit-git-bisect "run" (list shell-file-name shell-command-switch cmdline)))
 | 
			
		||||
 | 
			
		||||
(defun magit-git-bisect (subcommand &optional args no-assert)
 | 
			
		||||
  (unless (or no-assert (magit-bisect-in-progress-p))
 | 
			
		||||
    (user-error "Not bisecting"))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-run-git-with-logfile
 | 
			
		||||
     (magit-git-dir "BISECT_CMD_OUTPUT") "bisect" subcommand args)))
 | 
			
		||||
 | 
			
		||||
;;; Sections
 | 
			
		||||
 | 
			
		||||
(defun magit-bisect-in-progress-p ()
 | 
			
		||||
  (file-exists-p (magit-git-dir "BISECT_LOG")))
 | 
			
		||||
 | 
			
		||||
(defun magit-insert-bisect-output ()
 | 
			
		||||
  "While bisecting, insert section with output from `git bisect'."
 | 
			
		||||
  (when (magit-bisect-in-progress-p)
 | 
			
		||||
    (let* ((lines
 | 
			
		||||
            (or (magit-file-lines (magit-git-dir "BISECT_CMD_OUTPUT"))
 | 
			
		||||
                (list "Bisecting: (no saved bisect output)"
 | 
			
		||||
                      "It appears you have invoked `git bisect' from a shell."
 | 
			
		||||
                      "There is nothing wrong with that, we just cannot display"
 | 
			
		||||
                      "anything useful here.  Consult the shell output instead.")))
 | 
			
		||||
           (done-re "^\\([a-z0-9]\\{40\\}\\) is the first bad commit$")
 | 
			
		||||
           (bad-line (or (and (string-match done-re (car lines))
 | 
			
		||||
                              (pop lines))
 | 
			
		||||
                         (--first (string-match done-re it) lines))))
 | 
			
		||||
      (magit-insert-section ((eval (if bad-line 'commit 'bisect-output))
 | 
			
		||||
                             (and bad-line (match-string 1 bad-line)))
 | 
			
		||||
        (magit-insert-heading
 | 
			
		||||
          (propertize (or bad-line (pop lines))
 | 
			
		||||
                      'face 'magit-section-heading))
 | 
			
		||||
        (dolist (line lines)
 | 
			
		||||
          (insert line "\n"))))
 | 
			
		||||
    (insert "\n")))
 | 
			
		||||
 | 
			
		||||
(defun magit-insert-bisect-rest ()
 | 
			
		||||
  "While bisecting, insert section visualizing the bisect state."
 | 
			
		||||
  (when (magit-bisect-in-progress-p)
 | 
			
		||||
    (magit-insert-section (bisect-view)
 | 
			
		||||
      (magit-insert-heading "Bisect Rest:")
 | 
			
		||||
      (magit-git-wash (apply-partially 'magit-log-wash-log 'bisect-vis)
 | 
			
		||||
        "bisect" "visualize" "git" "log"
 | 
			
		||||
        "--format=%h%d%x00%s" "--decorate=full"
 | 
			
		||||
        (and magit-bisect-show-graph "--graph")))))
 | 
			
		||||
 | 
			
		||||
(defun magit-insert-bisect-log ()
 | 
			
		||||
  "While bisecting, insert section logging bisect progress."
 | 
			
		||||
  (when (magit-bisect-in-progress-p)
 | 
			
		||||
    (magit-insert-section (bisect-log)
 | 
			
		||||
      (magit-insert-heading "Bisect Log:")
 | 
			
		||||
      (magit-git-wash #'magit-wash-bisect-log "bisect" "log")
 | 
			
		||||
      (insert ?\n))))
 | 
			
		||||
 | 
			
		||||
(defun magit-wash-bisect-log (_args)
 | 
			
		||||
  (let (beg)
 | 
			
		||||
    (while (progn (setq beg (point-marker))
 | 
			
		||||
                  (re-search-forward "^\\(git bisect [^\n]+\n\\)" nil t))
 | 
			
		||||
      (magit-bind-match-strings (heading) nil
 | 
			
		||||
        (magit-delete-match)
 | 
			
		||||
        (save-restriction
 | 
			
		||||
          (narrow-to-region beg (point))
 | 
			
		||||
          (goto-char (point-min))
 | 
			
		||||
          (magit-insert-section (bisect-item heading t)
 | 
			
		||||
            (insert (propertize heading 'face 'magit-section-secondary-heading))
 | 
			
		||||
            (magit-insert-heading)
 | 
			
		||||
            (magit-wash-sequence
 | 
			
		||||
             (apply-partially 'magit-log-wash-rev 'bisect-log
 | 
			
		||||
                              (magit-abbrev-length)))
 | 
			
		||||
            (insert ?\n)))))
 | 
			
		||||
    (when (re-search-forward
 | 
			
		||||
           "# first bad commit: \\[\\([a-z0-9]\\{40\\}\\)\\] [^\n]+\n" nil t)
 | 
			
		||||
      (magit-bind-match-strings (hash) nil
 | 
			
		||||
        (magit-delete-match)
 | 
			
		||||
        (magit-insert-section (bisect-item)
 | 
			
		||||
          (insert hash " is the first bad commit\n"))))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-bisect)
 | 
			
		||||
;;; magit-bisect.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,926 +0,0 @@
 | 
			
		||||
;;; magit-blame.el --- blame support for Magit  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2012-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Annotates each line in file-visiting buffer with information from
 | 
			
		||||
;; the revision which last modified the line.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defgroup magit-blame nil
 | 
			
		||||
  "Blame support for Magit."
 | 
			
		||||
  :link '(info-link "(magit)Blaming")
 | 
			
		||||
  :group 'magit-modes)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-styles
 | 
			
		||||
  '((headings
 | 
			
		||||
     (heading-format   . "%-20a %C %s\n"))
 | 
			
		||||
    (margin
 | 
			
		||||
     (margin-format    . (" %s%f" " %C %a" " %H"))
 | 
			
		||||
     (margin-width     . 42)
 | 
			
		||||
     (margin-face      . magit-blame-margin)
 | 
			
		||||
     (margin-body-face . (magit-blame-dimmed)))
 | 
			
		||||
    (highlight
 | 
			
		||||
     (highlight-face   . magit-blame-highlight))
 | 
			
		||||
    (lines
 | 
			
		||||
     (show-lines       . t)))
 | 
			
		||||
  "List of styles used to visualize blame information.
 | 
			
		||||
 | 
			
		||||
Each entry has the form (IDENT (KEY . VALUE)...).  IDENT has
 | 
			
		||||
to be a symbol uniquely identifing the style.  The following
 | 
			
		||||
KEYs are recognized:
 | 
			
		||||
 | 
			
		||||
 `show-lines'
 | 
			
		||||
    Whether to prefix each chunk of lines with a thin line.
 | 
			
		||||
    This has no effect if `heading-format' is non-nil.
 | 
			
		||||
 `highlight-face'
 | 
			
		||||
    Face used to highlight the first line of each chunk.
 | 
			
		||||
    If this is nil, then those lines are not highlighted.
 | 
			
		||||
 `heading-format'
 | 
			
		||||
    String specifing the information to be shown above each
 | 
			
		||||
    chunk of lines.  It must end with a newline character.
 | 
			
		||||
 `margin-format'
 | 
			
		||||
    String specifing the information to be shown in the left
 | 
			
		||||
    buffer margin.  It must NOT end with a newline character.
 | 
			
		||||
    This can also be a list of formats used for the lines at
 | 
			
		||||
    the same positions within the chunk.  If the chunk has
 | 
			
		||||
    more lines than formats are specified, then the last is
 | 
			
		||||
    repeated.
 | 
			
		||||
 `margin-width'
 | 
			
		||||
    Width of the margin, provided `margin-format' is non-nil.
 | 
			
		||||
 `margin-face'
 | 
			
		||||
    Face used in the margin, provided `margin-format' is
 | 
			
		||||
    non-nil.  This face is used in combination with the faces
 | 
			
		||||
    that are specific to the used %-specs.  If this is nil,
 | 
			
		||||
    then `magit-blame-margin' is used.
 | 
			
		||||
 `margin-body-face'
 | 
			
		||||
    Face used in the margin for all but first line of a chunk.
 | 
			
		||||
    This face is used in combination with the faces that are
 | 
			
		||||
    specific to the used %-specs.  This can also be a list of
 | 
			
		||||
    faces (usually one face), in which case only these faces
 | 
			
		||||
    are used and the %-spec faces are ignored.  A good value
 | 
			
		||||
    might be `(magit-blame-dimmed)'.  If this is nil, then
 | 
			
		||||
    the same face as for the first line is used.
 | 
			
		||||
 | 
			
		||||
The following %-specs can be used in `heading-format' and
 | 
			
		||||
`margin-format':
 | 
			
		||||
 | 
			
		||||
  %H    hash              using face `magit-blame-hash'
 | 
			
		||||
  %s    summary           using face `magit-blame-summary'
 | 
			
		||||
  %a    author            using face `magit-blame-name'
 | 
			
		||||
  %A    author time       using face `magit-blame-date'
 | 
			
		||||
  %c    committer         using face `magit-blame-name'
 | 
			
		||||
  %C    committer time    using face `magit-blame-date'
 | 
			
		||||
 | 
			
		||||
Additionally if `margin-format' ends with %f, then the string
 | 
			
		||||
that is displayed in the margin is made at least `margin-width'
 | 
			
		||||
characters wide, which may be desirable if the used face sets
 | 
			
		||||
the background color.
 | 
			
		||||
 | 
			
		||||
The style used in the current buffer can be cycled from the blame
 | 
			
		||||
popup.  Blame commands (except `magit-blame-echo') use the first
 | 
			
		||||
style as the initial style when beginning to blame in a buffer."
 | 
			
		||||
  :package-version '(magit . "2.13.0")
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type 'string)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-echo-style 'lines
 | 
			
		||||
  "The blame visualization style used by `magit-blame-echo'.
 | 
			
		||||
A symbol that has to be used as the identifier for one of the
 | 
			
		||||
styles defined in `magit-blame-styles'."
 | 
			
		||||
  :package-version '(magit . "2.13.0")
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type 'symbol)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-time-format "%F %H:%M"
 | 
			
		||||
  "Format for time strings in blame headings."
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type 'string)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-read-only t
 | 
			
		||||
  "Whether to initially make the blamed buffer read-only."
 | 
			
		||||
  :package-version '(magit . "2.13.0")
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
 | 
			
		||||
  "List of modes not compatible with Magit-Blame mode.
 | 
			
		||||
This modes are turned off when Magit-Blame mode is turned on,
 | 
			
		||||
and then turned on again when turning off the latter."
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type '(repeat (symbol :tag "Mode")))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-mode-lighter " Blame"
 | 
			
		||||
  "The mode-line lighter of the Magit-Blame mode."
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type '(choice (const :tag "No lighter" "") string))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-blame-goto-chunk-hook
 | 
			
		||||
  '(magit-blame-maybe-update-revision-buffer
 | 
			
		||||
    magit-blame-maybe-show-message)
 | 
			
		||||
  "Hook run after point entered another chunk."
 | 
			
		||||
  :package-version '(magit . "2.13.0")
 | 
			
		||||
  :group 'magit-blame
 | 
			
		||||
  :type 'hook
 | 
			
		||||
  :get 'magit-hook-custom-get
 | 
			
		||||
  :options '(magit-blame-maybe-update-revision-buffer
 | 
			
		||||
             magit-blame-maybe-show-message))
 | 
			
		||||
 | 
			
		||||
;;; Faces
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-highlight
 | 
			
		||||
  '((((class color) (background light))
 | 
			
		||||
     :background "grey80"
 | 
			
		||||
     :foreground "black")
 | 
			
		||||
    (((class color) (background dark))
 | 
			
		||||
     :background "grey25"
 | 
			
		||||
     :foreground "white"))
 | 
			
		||||
  "Face used for highlighting when blaming.
 | 
			
		||||
Also see option `magit-blame-styles'."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-margin
 | 
			
		||||
  '((t :inherit magit-blame-highlight
 | 
			
		||||
       :weight normal
 | 
			
		||||
       :slant normal))
 | 
			
		||||
  "Face used for the blame margin by default when blaming.
 | 
			
		||||
Also see option `magit-blame-styles'."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-dimmed
 | 
			
		||||
  '((t :inherit magit-dimmed
 | 
			
		||||
       :weight normal
 | 
			
		||||
       :slant normal))
 | 
			
		||||
  "Face used for the blame margin in some cases when blaming.
 | 
			
		||||
Also see option `magit-blame-styles'."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-heading
 | 
			
		||||
  '((t :inherit magit-blame-highlight
 | 
			
		||||
       :weight normal
 | 
			
		||||
       :slant normal))
 | 
			
		||||
  "Face used for blame headings by default when blaming.
 | 
			
		||||
Also see option `magit-blame-styles'."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-summary nil
 | 
			
		||||
  "Face used for commit summaries when blaming."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-hash nil
 | 
			
		||||
  "Face used for commit hashes when blaming."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-name nil
 | 
			
		||||
  "Face used for author and committer names when blaming."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
(defface magit-blame-date nil
 | 
			
		||||
  "Face used for dates when blaming."
 | 
			
		||||
  :group 'magit-faces)
 | 
			
		||||
 | 
			
		||||
;;; Chunks
 | 
			
		||||
 | 
			
		||||
(defclass magit-blame-chunk ()
 | 
			
		||||
  (;; <orig-rev> <orig-line> <final-line> <num-lines>
 | 
			
		||||
   (orig-rev   :initarg :orig-rev)
 | 
			
		||||
   (orig-line  :initarg :orig-line)
 | 
			
		||||
   (final-line :initarg :final-line)
 | 
			
		||||
   (num-lines  :initarg :num-lines)
 | 
			
		||||
   ;; previous <prev-rev> <prev-file>
 | 
			
		||||
   (prev-rev   :initform nil)
 | 
			
		||||
   (prev-file  :initform nil)
 | 
			
		||||
   ;; filename <orig-file>
 | 
			
		||||
   (orig-file)))
 | 
			
		||||
 | 
			
		||||
(defun magit-current-blame-chunk (&optional type)
 | 
			
		||||
  (or (and (not (and type (not (eq type magit-blame-type))))
 | 
			
		||||
           (magit-blame-chunk-at (point)))
 | 
			
		||||
      (and type
 | 
			
		||||
           (let ((rev  (or magit-buffer-refname magit-buffer-revision))
 | 
			
		||||
                 (file (magit-file-relative-name nil (not magit-buffer-file-name)))
 | 
			
		||||
                 (line (format "%i,+1" (line-number-at-pos))))
 | 
			
		||||
             (unless file
 | 
			
		||||
               (error "Buffer does not visit a tracked file"))
 | 
			
		||||
             (with-temp-buffer
 | 
			
		||||
               (magit-with-toplevel
 | 
			
		||||
                 (magit-git-insert
 | 
			
		||||
                  "blame" "--porcelain"
 | 
			
		||||
                  (if (memq magit-blame-type '(final removal))
 | 
			
		||||
                      (cons "--reverse" (magit-blame-arguments))
 | 
			
		||||
                    (magit-blame-arguments))
 | 
			
		||||
                  "-L" line rev "--" file)
 | 
			
		||||
                 (goto-char (point-min))
 | 
			
		||||
                 (car (magit-blame--parse-chunk type))))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-chunk-at (pos)
 | 
			
		||||
  (--some (overlay-get it 'magit-blame-chunk)
 | 
			
		||||
          (overlays-at pos)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--overlay-at (&optional pos key)
 | 
			
		||||
  (unless pos
 | 
			
		||||
    (setq pos (point)))
 | 
			
		||||
  (--first (overlay-get it (or key 'magit-blame-chunk))
 | 
			
		||||
           (nconc (overlays-at pos)
 | 
			
		||||
                  (overlays-in pos pos))))
 | 
			
		||||
 | 
			
		||||
;;; Keymaps
 | 
			
		||||
 | 
			
		||||
(defvar magit-blame-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (define-key map (kbd "C-c C-q") 'magit-blame-quit)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for `magit-blame-mode'.
 | 
			
		||||
Note that most blaming key bindings are defined
 | 
			
		||||
in `magit-blame-read-only-mode-map' instead.")
 | 
			
		||||
 | 
			
		||||
(defvar magit-blame-read-only-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (cond ((featurep 'jkl)
 | 
			
		||||
           (define-key map [return]    'magit-show-commit)
 | 
			
		||||
           (define-key map (kbd   "i") 'magit-blame-previous-chunk)
 | 
			
		||||
           (define-key map (kbd   "I") 'magit-blame-previous-chunk-same-commit)
 | 
			
		||||
           (define-key map (kbd   "k") 'magit-blame-next-chunk)
 | 
			
		||||
           (define-key map (kbd   "K") 'magit-blame-next-chunk-same-commit)
 | 
			
		||||
           (define-key map (kbd   "j") 'magit-blame)
 | 
			
		||||
           (define-key map (kbd   "l") 'magit-blame-removal)
 | 
			
		||||
           (define-key map (kbd   "f") 'magit-blame-reverse)
 | 
			
		||||
           (define-key map (kbd   "b") 'magit-blame-popup))
 | 
			
		||||
          (t
 | 
			
		||||
           (define-key map (kbd "C-m") 'magit-show-commit)
 | 
			
		||||
           (define-key map (kbd   "p") 'magit-blame-previous-chunk)
 | 
			
		||||
           (define-key map (kbd   "P") 'magit-blame-previous-chunk-same-commit)
 | 
			
		||||
           (define-key map (kbd   "n") 'magit-blame-next-chunk)
 | 
			
		||||
           (define-key map (kbd   "N") 'magit-blame-next-chunk-same-commit)
 | 
			
		||||
           (define-key map (kbd   "b") 'magit-blame)
 | 
			
		||||
           (define-key map (kbd   "r") 'magit-blame-removal)
 | 
			
		||||
           (define-key map (kbd   "f") 'magit-blame-reverse)
 | 
			
		||||
           (define-key map (kbd   "B") 'magit-blame-popup)))
 | 
			
		||||
    (define-key map (kbd   "c") 'magit-blame-cycle-style)
 | 
			
		||||
    (define-key map (kbd   "q") 'magit-blame-quit)
 | 
			
		||||
    (define-key map (kbd "M-w") 'magit-blame-copy-hash)
 | 
			
		||||
    (define-key map (kbd "SPC") 'magit-diff-show-or-scroll-up)
 | 
			
		||||
    (define-key map (kbd "DEL") 'magit-diff-show-or-scroll-down)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for `magit-blame-read-only-mode'.")
 | 
			
		||||
 | 
			
		||||
;;; Modes
 | 
			
		||||
;;;; Variables
 | 
			
		||||
 | 
			
		||||
(defvar-local magit-blame-buffer-read-only nil)
 | 
			
		||||
(defvar-local magit-blame-cache nil)
 | 
			
		||||
(defvar-local magit-blame-disabled-modes nil)
 | 
			
		||||
(defvar-local magit-blame-process nil)
 | 
			
		||||
(defvar-local magit-blame-recursive-p nil)
 | 
			
		||||
(defvar-local magit-blame-type nil)
 | 
			
		||||
(defvar-local magit-blame-separator nil)
 | 
			
		||||
(defvar-local magit-blame-previous-chunk nil)
 | 
			
		||||
 | 
			
		||||
(defvar-local magit-blame--style nil)
 | 
			
		||||
 | 
			
		||||
(defsubst magit-blame--style-get (key)
 | 
			
		||||
  (cdr (assoc key (cdr magit-blame--style))))
 | 
			
		||||
 | 
			
		||||
;;;; Base Mode
 | 
			
		||||
 | 
			
		||||
(define-minor-mode magit-blame-mode
 | 
			
		||||
  "Display blame information inline."
 | 
			
		||||
  :lighter magit-blame-mode-lighter
 | 
			
		||||
  (cond (magit-blame-mode
 | 
			
		||||
         (when (called-interactively-p 'any)
 | 
			
		||||
           (setq magit-blame-mode nil)
 | 
			
		||||
           (user-error
 | 
			
		||||
            (concat "Don't call `magit-blame-mode' directly; "
 | 
			
		||||
                    "instead use `magit-blame' or `magit-blame-popup'")))
 | 
			
		||||
         (add-hook 'after-save-hook     'magit-blame--run t t)
 | 
			
		||||
         (add-hook 'post-command-hook   'magit-blame-goto-chunk-hook t t)
 | 
			
		||||
         (add-hook 'before-revert-hook  'magit-blame--remove-overlays t t)
 | 
			
		||||
         (add-hook 'after-revert-hook   'magit-blame--run t t)
 | 
			
		||||
         (add-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t t)
 | 
			
		||||
         (setq magit-blame-buffer-read-only buffer-read-only)
 | 
			
		||||
         (when (or magit-blame-read-only magit-buffer-file-name)
 | 
			
		||||
           (read-only-mode 1))
 | 
			
		||||
         (dolist (mode magit-blame-disable-modes)
 | 
			
		||||
           (when (and (boundp mode) (symbol-value mode))
 | 
			
		||||
             (funcall mode -1)
 | 
			
		||||
             (push mode magit-blame-disabled-modes)))
 | 
			
		||||
         (setq magit-blame-separator (magit-blame--format-separator))
 | 
			
		||||
         (unless magit-blame--style
 | 
			
		||||
           (setq magit-blame--style (car magit-blame-styles)))
 | 
			
		||||
         (magit-blame--update-margin))
 | 
			
		||||
        (t
 | 
			
		||||
         (when (process-live-p magit-blame-process)
 | 
			
		||||
           (kill-process magit-blame-process)
 | 
			
		||||
           (while magit-blame-process
 | 
			
		||||
             (sit-for 0.01))) ; avoid racing the sentinal
 | 
			
		||||
         (remove-hook 'after-save-hook     'magit-blame--run t)
 | 
			
		||||
         (remove-hook 'post-command-hook   'magit-blame-goto-chunk-hook t)
 | 
			
		||||
         (remove-hook 'before-revert-hook  'magit-blame--remove-overlays t)
 | 
			
		||||
         (remove-hook 'after-revert-hook   'magit-blame--run t)
 | 
			
		||||
         (remove-hook 'read-only-mode-hook 'magit-blame-toggle-read-only t)
 | 
			
		||||
         (unless magit-blame-buffer-read-only
 | 
			
		||||
           (read-only-mode -1))
 | 
			
		||||
         (magit-blame-read-only-mode -1)
 | 
			
		||||
         (dolist (mode magit-blame-disabled-modes)
 | 
			
		||||
           (funcall mode 1))
 | 
			
		||||
         (kill-local-variable 'magit-blame-disabled-modes)
 | 
			
		||||
         (kill-local-variable 'magit-blame-type)
 | 
			
		||||
         (kill-local-variable 'magit-blame--style)
 | 
			
		||||
         (magit-blame--update-margin)
 | 
			
		||||
         (magit-blame--remove-overlays))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-goto-chunk-hook ()
 | 
			
		||||
  (let ((chunk (magit-blame-chunk-at (point))))
 | 
			
		||||
    (when (cl-typep chunk 'magit-blame-chunk)
 | 
			
		||||
      (unless (eq chunk magit-blame-previous-chunk)
 | 
			
		||||
        (run-hooks 'magit-blame-goto-chunk-hook))
 | 
			
		||||
      (setq magit-blame-previous-chunk chunk))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-toggle-read-only ()
 | 
			
		||||
  (magit-blame-read-only-mode (if buffer-read-only 1 -1)))
 | 
			
		||||
 | 
			
		||||
;;;; Read-Only Mode
 | 
			
		||||
 | 
			
		||||
(define-minor-mode magit-blame-read-only-mode
 | 
			
		||||
  "Provide keybindings for Magit-Blame mode.
 | 
			
		||||
 | 
			
		||||
This minor-mode provides the key bindings for Magit-Blame mode,
 | 
			
		||||
but only when Read-Only mode is also enabled because these key
 | 
			
		||||
bindings would otherwise conflict badly with regular bindings.
 | 
			
		||||
 | 
			
		||||
When both Magit-Blame mode and Read-Only mode are enabled, then
 | 
			
		||||
this mode gets automatically enabled too and when one of these
 | 
			
		||||
modes is toggled, then this mode also gets toggled automatically.
 | 
			
		||||
 | 
			
		||||
\\{magit-blame-read-only-mode-map}")
 | 
			
		||||
 | 
			
		||||
;;;; Kludges
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-put-keymap-before-view-mode ()
 | 
			
		||||
  "Put `magit-blame-read-only-mode' ahead of `view-mode' in `minor-mode-map-alist'."
 | 
			
		||||
  (--when-let (assq 'magit-blame-read-only-mode
 | 
			
		||||
                    (cl-member 'view-mode minor-mode-map-alist :key #'car))
 | 
			
		||||
    (setq minor-mode-map-alist
 | 
			
		||||
          (cons it (delq it minor-mode-map-alist))))
 | 
			
		||||
  (remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
 | 
			
		||||
 | 
			
		||||
(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
 | 
			
		||||
 | 
			
		||||
;;; Process
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--run ()
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (unless magit-blame-mode
 | 
			
		||||
      (magit-blame-mode 1))
 | 
			
		||||
    (message "Blaming...")
 | 
			
		||||
    (magit-blame-run-process
 | 
			
		||||
     (or magit-buffer-refname magit-buffer-revision)
 | 
			
		||||
     (magit-file-relative-name nil (not magit-buffer-file-name))
 | 
			
		||||
     (if (memq magit-blame-type '(final removal))
 | 
			
		||||
         (cons "--reverse" (magit-blame-arguments))
 | 
			
		||||
       (magit-blame-arguments))
 | 
			
		||||
     (list (line-number-at-pos (window-start))
 | 
			
		||||
           (line-number-at-pos (1- (window-end nil t)))))
 | 
			
		||||
    (set-process-sentinel magit-this-process
 | 
			
		||||
                          'magit-blame-process-quickstart-sentinel)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-run-process (revision file args &optional lines)
 | 
			
		||||
  (let ((process (magit-parse-git-async
 | 
			
		||||
                  "blame" "--incremental" args
 | 
			
		||||
                  (and lines (list "-L" (apply #'format "%s,%s" lines)))
 | 
			
		||||
                  revision "--" file)))
 | 
			
		||||
    (set-process-filter   process 'magit-blame-process-filter)
 | 
			
		||||
    (set-process-sentinel process 'magit-blame-process-sentinel)
 | 
			
		||||
    (process-put process 'arguments (list revision file args))
 | 
			
		||||
    (setq magit-blame-cache (make-hash-table :test 'equal))
 | 
			
		||||
    (setq magit-blame-process process)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-process-quickstart-sentinel (process event)
 | 
			
		||||
  (when (memq (process-status process) '(exit signal))
 | 
			
		||||
    (magit-blame-process-sentinel process event t)
 | 
			
		||||
    (magit-blame-assert-buffer process)
 | 
			
		||||
    (with-current-buffer (process-get process 'command-buf)
 | 
			
		||||
      (when magit-blame-mode
 | 
			
		||||
        (let ((default-directory (magit-toplevel)))
 | 
			
		||||
          (apply #'magit-blame-run-process
 | 
			
		||||
                 (process-get process 'arguments)))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-process-sentinel (process _event &optional quiet)
 | 
			
		||||
  (let ((status (process-status process)))
 | 
			
		||||
    (when (memq status '(exit signal))
 | 
			
		||||
      (kill-buffer (process-buffer process))
 | 
			
		||||
      (if (and (eq status 'exit)
 | 
			
		||||
               (zerop (process-exit-status process)))
 | 
			
		||||
          (unless quiet
 | 
			
		||||
            (message "Blaming...done"))
 | 
			
		||||
        (magit-blame-assert-buffer process)
 | 
			
		||||
        (with-current-buffer (process-get process 'command-buf)
 | 
			
		||||
          (if magit-blame-mode
 | 
			
		||||
              (progn (magit-blame-mode -1)
 | 
			
		||||
                     (message "Blaming...failed"))
 | 
			
		||||
            (message "Blaming...aborted"))))
 | 
			
		||||
      (kill-local-variable 'magit-blame-process))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-process-filter (process string)
 | 
			
		||||
  (internal-default-process-filter process string)
 | 
			
		||||
  (let ((buf  (process-get process 'command-buf))
 | 
			
		||||
        (pos  (process-get process 'parsed))
 | 
			
		||||
        (mark (process-mark process))
 | 
			
		||||
        type cache)
 | 
			
		||||
    (with-current-buffer buf
 | 
			
		||||
      (setq type  magit-blame-type)
 | 
			
		||||
      (setq cache magit-blame-cache))
 | 
			
		||||
    (with-current-buffer (process-buffer process)
 | 
			
		||||
      (goto-char pos)
 | 
			
		||||
      (while (and (< (point) mark)
 | 
			
		||||
                  (save-excursion (re-search-forward "^filename .+\n" nil t)))
 | 
			
		||||
        (pcase-let* ((`(,chunk ,revinfo)
 | 
			
		||||
                      (magit-blame--parse-chunk type))
 | 
			
		||||
                     (rev (oref chunk orig-rev)))
 | 
			
		||||
          (if revinfo
 | 
			
		||||
              (puthash rev revinfo cache)
 | 
			
		||||
            (setq revinfo
 | 
			
		||||
                  (or (gethash rev cache)
 | 
			
		||||
                      (puthash rev (magit-blame--commit-alist rev) cache))))
 | 
			
		||||
          (magit-blame--make-overlays buf chunk revinfo))
 | 
			
		||||
        (process-put process 'parsed (point))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--parse-chunk (type)
 | 
			
		||||
  (let (chunk revinfo)
 | 
			
		||||
    (looking-at "^\\(.\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)")
 | 
			
		||||
    (with-slots (orig-rev orig-file prev-rev prev-file)
 | 
			
		||||
        (setq chunk (magit-blame-chunk
 | 
			
		||||
                     :orig-rev                     (match-string 1)
 | 
			
		||||
                     :orig-line  (string-to-number (match-string 2))
 | 
			
		||||
                     :final-line (string-to-number (match-string 3))
 | 
			
		||||
                     :num-lines  (string-to-number (match-string 4))))
 | 
			
		||||
      (forward-line)
 | 
			
		||||
      (let (done)
 | 
			
		||||
        (while (not done)
 | 
			
		||||
          (cond ((looking-at "^filename \\(.+\\)")
 | 
			
		||||
                 (setq done t)
 | 
			
		||||
                 (setf orig-file (match-string 1)))
 | 
			
		||||
                ((looking-at "^previous \\(.\\{40\\}\\) \\(.+\\)")
 | 
			
		||||
                 (setf prev-rev  (match-string 1))
 | 
			
		||||
                 (setf prev-file (match-string 2)))
 | 
			
		||||
                ((looking-at "^\\([^ ]+\\) \\(.+\\)")
 | 
			
		||||
                 (push (cons (match-string 1)
 | 
			
		||||
                             (match-string 2)) revinfo)))
 | 
			
		||||
          (forward-line)))
 | 
			
		||||
      (when (and (eq type 'removal) prev-rev)
 | 
			
		||||
        (cl-rotatef orig-rev  prev-rev)
 | 
			
		||||
        (cl-rotatef orig-file prev-file)
 | 
			
		||||
        (setq revinfo nil)))
 | 
			
		||||
    (list chunk revinfo)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--commit-alist (rev)
 | 
			
		||||
  (cl-mapcar 'cons
 | 
			
		||||
             '("summary"
 | 
			
		||||
               "author" "author-time" "author-tz"
 | 
			
		||||
               "committer" "committer-time" "committer-tz")
 | 
			
		||||
             (split-string (magit-rev-format "%s\v%an\v%ad\v%cn\v%cd" rev
 | 
			
		||||
                                             "--date=format:%s\v%z")
 | 
			
		||||
                           "\v")))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-assert-buffer (process)
 | 
			
		||||
  (unless (buffer-live-p (process-get process 'command-buf))
 | 
			
		||||
    (kill-process process)
 | 
			
		||||
    (user-error "Buffer being blamed has been killed")))
 | 
			
		||||
 | 
			
		||||
;;; Display
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--make-overlays (buf chunk revinfo)
 | 
			
		||||
  (with-current-buffer buf
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (save-restriction
 | 
			
		||||
        (widen)
 | 
			
		||||
        (goto-char (point-min))
 | 
			
		||||
        (forward-line (1- (oref chunk final-line)))
 | 
			
		||||
        (let ((beg (point))
 | 
			
		||||
              (end (save-excursion
 | 
			
		||||
                     (forward-line (oref chunk num-lines))
 | 
			
		||||
                     (point))))
 | 
			
		||||
          (magit-blame--remove-overlays beg end)
 | 
			
		||||
          (magit-blame--make-margin-overlays chunk revinfo beg end)
 | 
			
		||||
          (magit-blame--make-heading-overlay chunk revinfo beg end)
 | 
			
		||||
          (magit-blame--make-highlight-overlay   chunk beg))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--make-margin-overlays (chunk revinfo _beg end)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (let ((line 0))
 | 
			
		||||
      (while (< (point) end)
 | 
			
		||||
        (magit-blame--make-margin-overlay chunk revinfo line)
 | 
			
		||||
        (forward-line)
 | 
			
		||||
        (cl-incf line)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--make-margin-overlay (chunk revinfo line)
 | 
			
		||||
  (let* ((end (line-end-position))
 | 
			
		||||
         ;; If possible avoid putting this on the first character
 | 
			
		||||
         ;; of the line to avoid a conflict with the line overlay.
 | 
			
		||||
         (beg (min (1+ (line-beginning-position)) end))
 | 
			
		||||
         (ov  (make-overlay beg end)))
 | 
			
		||||
    (overlay-put ov 'magit-blame-chunk chunk)
 | 
			
		||||
    (overlay-put ov 'magit-blame-revinfo revinfo)
 | 
			
		||||
    (overlay-put ov 'magit-blame-margin line)
 | 
			
		||||
    (magit-blame--update-margin-overlay ov)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--make-heading-overlay (chunk revinfo beg end)
 | 
			
		||||
  (let ((ov (make-overlay beg end)))
 | 
			
		||||
    (overlay-put ov 'magit-blame-chunk chunk)
 | 
			
		||||
    (overlay-put ov 'magit-blame-revinfo revinfo)
 | 
			
		||||
    (overlay-put ov 'magit-blame-heading t)
 | 
			
		||||
    (magit-blame--update-heading-overlay ov)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--make-highlight-overlay (chunk beg)
 | 
			
		||||
  (let ((ov (make-overlay beg (1+ (line-end-position)))))
 | 
			
		||||
    (overlay-put ov 'magit-blame-chunk chunk)
 | 
			
		||||
    (overlay-put ov 'magit-blame-highlight t)
 | 
			
		||||
    (magit-blame--update-highlight-overlay ov)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--update-margin ()
 | 
			
		||||
  (setq left-margin-width (or (magit-blame--style-get 'margin-width) 0))
 | 
			
		||||
  (set-window-buffer (selected-window) (current-buffer)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--update-overlays ()
 | 
			
		||||
  (save-restriction
 | 
			
		||||
    (widen)
 | 
			
		||||
    (dolist (ov (overlays-in (point-min) (point-max)))
 | 
			
		||||
      (cond ((overlay-get ov 'magit-blame-heading)
 | 
			
		||||
             (magit-blame--update-heading-overlay ov))
 | 
			
		||||
            ((overlay-get ov 'magit-blame-margin)
 | 
			
		||||
             (magit-blame--update-margin-overlay ov))
 | 
			
		||||
            ((overlay-get ov 'magit-blame-highlight)
 | 
			
		||||
             (magit-blame--update-highlight-overlay ov))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--update-margin-overlay (ov)
 | 
			
		||||
  (overlay-put
 | 
			
		||||
   ov 'before-string
 | 
			
		||||
   (and (magit-blame--style-get 'margin-width)
 | 
			
		||||
        (propertize
 | 
			
		||||
         "o" 'display
 | 
			
		||||
         (list (list 'margin 'left-margin)
 | 
			
		||||
               (let ((line   (overlay-get ov 'magit-blame-margin))
 | 
			
		||||
                     (format (magit-blame--style-get 'margin-format))
 | 
			
		||||
                     (face   (magit-blame--style-get 'margin-face)))
 | 
			
		||||
                 (magit-blame--format-string
 | 
			
		||||
                  ov
 | 
			
		||||
                  (or (and (atom format)
 | 
			
		||||
                           format)
 | 
			
		||||
                      (nth line format)
 | 
			
		||||
                      (car (last format)))
 | 
			
		||||
                  (or (and (not (zerop line))
 | 
			
		||||
                           (magit-blame--style-get 'margin-body-face))
 | 
			
		||||
                      face
 | 
			
		||||
                      'magit-blame-margin))))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--update-heading-overlay (ov)
 | 
			
		||||
  (overlay-put
 | 
			
		||||
   ov 'before-string
 | 
			
		||||
   (--if-let (magit-blame--style-get 'heading-format)
 | 
			
		||||
       (magit-blame--format-string ov it 'magit-blame-heading)
 | 
			
		||||
     (and (magit-blame--style-get 'show-lines)
 | 
			
		||||
          (or (not (magit-blame--style-get 'margin-format))
 | 
			
		||||
              (save-excursion
 | 
			
		||||
                (goto-char (overlay-start ov))
 | 
			
		||||
                ;; Special case of the special case described in
 | 
			
		||||
                ;; `magit-blame--make-margin-overlay'.  For empty
 | 
			
		||||
                ;; lines it is not possible to show both overlays
 | 
			
		||||
                ;; without the line being to high.
 | 
			
		||||
                (not (= (point) (line-end-position)))))
 | 
			
		||||
          magit-blame-separator))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--update-highlight-overlay (ov)
 | 
			
		||||
  (overlay-put ov 'face (magit-blame--style-get 'highlight-face)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--format-string (ov format face)
 | 
			
		||||
  (let* ((chunk   (overlay-get ov 'magit-blame-chunk))
 | 
			
		||||
         (revinfo (overlay-get ov 'magit-blame-revinfo))
 | 
			
		||||
         (key     (list format face))
 | 
			
		||||
         (string  (cdr (assoc key revinfo))))
 | 
			
		||||
    (unless string
 | 
			
		||||
      (setq string
 | 
			
		||||
            (and format
 | 
			
		||||
                 (magit-blame--format-string-1 (oref chunk orig-rev)
 | 
			
		||||
                                               revinfo format face)))
 | 
			
		||||
      (nconc revinfo (list (cons key string))))
 | 
			
		||||
    string))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--format-string-1 (rev revinfo format face)
 | 
			
		||||
  (let ((str
 | 
			
		||||
         (if (equal rev "0000000000000000000000000000000000000000")
 | 
			
		||||
             (propertize (concat (if (string-prefix-p "\s" format) "\s" "")
 | 
			
		||||
                                 "Not Yet Committed"
 | 
			
		||||
                                 (if (string-suffix-p "\n" format) "\n" ""))
 | 
			
		||||
                         'face face)
 | 
			
		||||
           (magit--format-spec
 | 
			
		||||
            (propertize format 'face face)
 | 
			
		||||
            (cl-flet* ((p0 (s f)
 | 
			
		||||
                           (propertize s 'face (if face
 | 
			
		||||
                                                   (if (listp face)
 | 
			
		||||
                                                       face
 | 
			
		||||
                                                     (list f face))
 | 
			
		||||
                                                 f)))
 | 
			
		||||
                       (p1 (k f)
 | 
			
		||||
                           (p0 (cdr (assoc k revinfo)) f))
 | 
			
		||||
                       (p2 (k1 k2 f)
 | 
			
		||||
                           (p0 (magit-blame--format-time-string
 | 
			
		||||
                                (cdr (assoc k1 revinfo))
 | 
			
		||||
                                (cdr (assoc k2 revinfo)))
 | 
			
		||||
                               f)))
 | 
			
		||||
              `((?H . ,(p0 rev         'magit-blame-hash))
 | 
			
		||||
                (?s . ,(p1 "summary"   'magit-blame-summary))
 | 
			
		||||
                (?a . ,(p1 "author"    'magit-blame-name))
 | 
			
		||||
                (?c . ,(p1 "committer" 'magit-blame-name))
 | 
			
		||||
                (?A . ,(p2 "author-time"    "author-tz"    'magit-blame-date))
 | 
			
		||||
                (?C . ,(p2 "committer-time" "committer-tz" 'magit-blame-date))
 | 
			
		||||
                (?f . "")))))))
 | 
			
		||||
    (if-let ((width (and (string-suffix-p "%f" format)
 | 
			
		||||
                         (magit-blame--style-get 'margin-width))))
 | 
			
		||||
        (concat str
 | 
			
		||||
                (propertize (make-string (max 0 (- width (length str))) ?\s)
 | 
			
		||||
                            'face face))
 | 
			
		||||
      str)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--format-separator ()
 | 
			
		||||
  (propertize
 | 
			
		||||
   (concat (propertize "\s" 'display '(space :height (2)))
 | 
			
		||||
           (propertize "\n" 'line-height t))
 | 
			
		||||
   'face (list :background
 | 
			
		||||
               (face-attribute 'magit-blame-heading :background nil t))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--format-time-string (time tz)
 | 
			
		||||
  (let* ((time-format (or (magit-blame--style-get 'time-format)
 | 
			
		||||
                          magit-blame-time-format))
 | 
			
		||||
         (tz-in-second (and (not (version< emacs-version "25"))
 | 
			
		||||
                            (string-match "%z" time-format)
 | 
			
		||||
                            (car (last (parse-time-string tz))))))
 | 
			
		||||
    (format-time-string time-format
 | 
			
		||||
                        (seconds-to-time (string-to-number time))
 | 
			
		||||
                        tz-in-second)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--remove-overlays (&optional beg end)
 | 
			
		||||
  (save-restriction
 | 
			
		||||
    (widen)
 | 
			
		||||
    (dolist (ov (overlays-in (or beg (point-min))
 | 
			
		||||
                             (or end (point-max))))
 | 
			
		||||
      (when (overlay-get ov 'magit-blame-chunk)
 | 
			
		||||
        (delete-overlay ov)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-maybe-show-message ()
 | 
			
		||||
  (when (magit-blame--style-get 'show-message)
 | 
			
		||||
    (let ((message-log-max 0))
 | 
			
		||||
      (if-let ((msg (cdr (assq 'heading
 | 
			
		||||
                               (gethash (oref (magit-current-blame-chunk)
 | 
			
		||||
                                              orig-rev)
 | 
			
		||||
                                        magit-blame-cache)))))
 | 
			
		||||
          (progn (setq msg (substring msg 0 -1))
 | 
			
		||||
                 (set-text-properties 0 (length msg) nil msg)
 | 
			
		||||
                 (message msg))
 | 
			
		||||
        (message "Commit data not available yet.  Still blaming.")))))
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-blame-echo ()
 | 
			
		||||
  "For each line show the revision in which it was added.
 | 
			
		||||
Show the information about the chunk at point in the echo area
 | 
			
		||||
when moving between chunks.  Unlike other blaming commands, do
 | 
			
		||||
not turn on `read-only-mode'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (when magit-buffer-file-name
 | 
			
		||||
    (user-error "Blob buffers aren't supported"))
 | 
			
		||||
  (setq-local magit-blame--style
 | 
			
		||||
              (assq magit-blame-echo-style magit-blame-styles))
 | 
			
		||||
  (setq-local magit-blame-disable-modes
 | 
			
		||||
              (cons 'eldoc-mode magit-blame-disable-modes))
 | 
			
		||||
  (if (not magit-blame-mode)
 | 
			
		||||
      (let ((magit-blame-read-only nil))
 | 
			
		||||
        (magit-blame))
 | 
			
		||||
    (read-only-mode -1)
 | 
			
		||||
    (magit-blame--update-overlays)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-blame ()
 | 
			
		||||
  "For each line show the revision in which it was added."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-blame--pre-blame-assert 'addition)
 | 
			
		||||
  (magit-blame--pre-blame-setup  'addition)
 | 
			
		||||
  (magit-blame--run))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-blame-removal ()
 | 
			
		||||
  "For each line show the revision in which it was removed."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless magit-buffer-file-name
 | 
			
		||||
    (user-error "Only blob buffers can be blamed in reverse"))
 | 
			
		||||
  (magit-blame--pre-blame-assert 'removal)
 | 
			
		||||
  (magit-blame--pre-blame-setup  'removal)
 | 
			
		||||
  (magit-blame--run))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-blame-reverse ()
 | 
			
		||||
  "For each line show the last revision in which it still exists."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless magit-buffer-file-name
 | 
			
		||||
    (user-error "Only blob buffers can be blamed in reverse"))
 | 
			
		||||
  (magit-blame--pre-blame-assert 'final)
 | 
			
		||||
  (magit-blame--pre-blame-setup  'final)
 | 
			
		||||
  (magit-blame--run))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--pre-blame-assert (type)
 | 
			
		||||
  (unless (magit-toplevel)
 | 
			
		||||
    (magit--not-inside-repository-error))
 | 
			
		||||
  (if (and magit-blame-mode
 | 
			
		||||
           (eq type magit-blame-type))
 | 
			
		||||
      (if-let ((chunk (magit-current-blame-chunk)))
 | 
			
		||||
          (unless (oref chunk prev-rev)
 | 
			
		||||
            (user-error "Chunk has no further history"))
 | 
			
		||||
        (user-error "Commit data not available yet.  Still blaming."))
 | 
			
		||||
    (unless (magit-file-relative-name nil (not magit-buffer-file-name))
 | 
			
		||||
      (if buffer-file-name
 | 
			
		||||
          (user-error "Buffer isn't visiting a tracked file")
 | 
			
		||||
        (user-error "Buffer isn't visiting a file")))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame--pre-blame-setup (type)
 | 
			
		||||
  (when magit-blame-mode
 | 
			
		||||
    (if (eq type magit-blame-type)
 | 
			
		||||
        (let ((style magit-blame--style))
 | 
			
		||||
          (magit-blame-visit-other-file)
 | 
			
		||||
          (setq-local magit-blame--style style)
 | 
			
		||||
          (setq-local magit-blame-recursive-p t)
 | 
			
		||||
          ;; Set window-start for the benefit of quickstart.
 | 
			
		||||
          (redisplay))
 | 
			
		||||
      (magit-blame--remove-overlays)))
 | 
			
		||||
  (setq magit-blame-type type))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-visit-other-file ()
 | 
			
		||||
  "Visit another blob related to the current chunk."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (with-slots (prev-rev prev-file orig-line)
 | 
			
		||||
      (magit-current-blame-chunk)
 | 
			
		||||
    (unless prev-rev
 | 
			
		||||
      (user-error "Chunk has no further history"))
 | 
			
		||||
    (magit-with-toplevel
 | 
			
		||||
      (magit-find-file prev-rev prev-file))
 | 
			
		||||
    ;; TODO Adjust line like magit-diff-visit-file.
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (forward-line (1- orig-line))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-visit-file ()
 | 
			
		||||
  "Visit the blob related to the current chunk."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (with-slots (orig-rev orig-file orig-line)
 | 
			
		||||
      (magit-current-blame-chunk)
 | 
			
		||||
    (magit-with-toplevel
 | 
			
		||||
      (magit-find-file orig-rev orig-file))
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (forward-line (1- orig-line))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-quit ()
 | 
			
		||||
  "Turn off Magit-Blame mode.
 | 
			
		||||
If the buffer was created during a recursive blame,
 | 
			
		||||
then also kill the buffer."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-blame-mode -1)
 | 
			
		||||
  (when magit-blame-recursive-p
 | 
			
		||||
    (kill-buffer)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-next-chunk ()
 | 
			
		||||
  "Move to the next chunk."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (--if-let (next-single-char-property-change (point) 'magit-blame-chunk)
 | 
			
		||||
      (goto-char it)
 | 
			
		||||
    (user-error "No more chunks")))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-previous-chunk ()
 | 
			
		||||
  "Move to the previous chunk."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (--if-let (previous-single-char-property-change (point) 'magit-blame-chunk)
 | 
			
		||||
      (goto-char it)
 | 
			
		||||
    (user-error "No more chunks")))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-next-chunk-same-commit (&optional previous)
 | 
			
		||||
  "Move to the next chunk from the same commit.\n\n(fn)"
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if-let ((rev (oref (magit-current-blame-chunk) orig-rev)))
 | 
			
		||||
      (let ((pos (point)) ov)
 | 
			
		||||
        (save-excursion
 | 
			
		||||
          (while (and (not ov)
 | 
			
		||||
                      (not (= pos (if previous (point-min) (point-max))))
 | 
			
		||||
                      (setq pos (funcall
 | 
			
		||||
                                 (if previous
 | 
			
		||||
                                     'previous-single-char-property-change
 | 
			
		||||
                                   'next-single-char-property-change)
 | 
			
		||||
                                 pos 'magit-blame-chunk)))
 | 
			
		||||
            (--when-let (magit-blame--overlay-at pos)
 | 
			
		||||
              (when (equal (oref (magit-blame-chunk-at pos) orig-rev) rev)
 | 
			
		||||
                (setq ov it)))))
 | 
			
		||||
        (if ov
 | 
			
		||||
            (goto-char (overlay-start ov))
 | 
			
		||||
          (user-error "No more chunks from same commit")))
 | 
			
		||||
    (user-error "This chunk hasn't been blamed yet")))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-previous-chunk-same-commit ()
 | 
			
		||||
  "Move to the previous chunk from the same commit."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-blame-next-chunk-same-commit 'previous-single-char-property-change))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-cycle-style ()
 | 
			
		||||
  "Change how blame information is visualized.
 | 
			
		||||
Cycle through the elements of option `magit-blame-styles'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (setq magit-blame--style
 | 
			
		||||
        (or (cadr (cl-member (car magit-blame--style)
 | 
			
		||||
                             magit-blame-styles :key #'car))
 | 
			
		||||
            (car magit-blame-styles)))
 | 
			
		||||
  (magit-blame--update-margin)
 | 
			
		||||
  (magit-blame--update-overlays))
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-copy-hash ()
 | 
			
		||||
  "Save hash of the current chunk's commit to the kill ring.
 | 
			
		||||
 | 
			
		||||
When the region is active, then save the region's content
 | 
			
		||||
instead of the hash, like `kill-ring-save' would."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if (use-region-p)
 | 
			
		||||
      (copy-region-as-kill nil nil 'region)
 | 
			
		||||
    (kill-new (message "%s" (oref (magit-current-blame-chunk) orig-rev)))))
 | 
			
		||||
 | 
			
		||||
;;; Popup
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-blame-popup "magit-blame" nil t)
 | 
			
		||||
(magit-define-popup magit-blame-popup
 | 
			
		||||
  "Popup console for blame commands."
 | 
			
		||||
  :man-page "git-blame"
 | 
			
		||||
  :switches '((?w "Ignore whitespace" "-w")
 | 
			
		||||
              (?r "Do not treat root commits as boundaries" "--root"))
 | 
			
		||||
  :options  '((?M "Detect lines moved or copied within a file" "-M")
 | 
			
		||||
              (?C "Detect lines moved or copied between files" "-C"))
 | 
			
		||||
  :actions  '("Actions"
 | 
			
		||||
              (?b "Show commits adding lines" magit-blame)
 | 
			
		||||
              (?r (lambda ()
 | 
			
		||||
                    (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                      (and (not buffer-file-name)
 | 
			
		||||
                           (propertize "Show commits removing lines"
 | 
			
		||||
                                       'face 'default))))
 | 
			
		||||
                  magit-blame-removal)
 | 
			
		||||
              (?f (lambda ()
 | 
			
		||||
                    (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                      (and (not buffer-file-name)
 | 
			
		||||
                           (propertize "Show last commits that still have lines"
 | 
			
		||||
                                       'face 'default))))
 | 
			
		||||
                  magit-blame-reverse)
 | 
			
		||||
              (lambda ()
 | 
			
		||||
                (and (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                       magit-blame-mode)
 | 
			
		||||
                     (propertize "Refresh" 'face 'magit-popup-heading)))
 | 
			
		||||
              (?c "Cycle style" magit-blame-cycle-style))
 | 
			
		||||
  :default-arguments '("-w")
 | 
			
		||||
  :max-action-columns 1
 | 
			
		||||
  :default-action 'magit-blame)
 | 
			
		||||
 | 
			
		||||
;;; Utilities
 | 
			
		||||
 | 
			
		||||
(defun magit-blame-maybe-update-revision-buffer ()
 | 
			
		||||
  (unless magit--update-revision-buffer
 | 
			
		||||
    (setq magit--update-revision-buffer nil)
 | 
			
		||||
    (when-let ((chunk  (magit-current-blame-chunk))
 | 
			
		||||
               (commit (oref chunk orig-rev))
 | 
			
		||||
               (buffer (magit-mode-get-buffer 'magit-revision-mode nil t)))
 | 
			
		||||
      (setq magit--update-revision-buffer (list commit buffer))
 | 
			
		||||
      (run-with-idle-timer
 | 
			
		||||
       magit-update-other-window-delay nil
 | 
			
		||||
       (lambda ()
 | 
			
		||||
         (pcase-let ((`(,rev ,buf) magit--update-revision-buffer))
 | 
			
		||||
           (setq magit--update-revision-buffer nil)
 | 
			
		||||
           (when (buffer-live-p buf)
 | 
			
		||||
             (let ((magit-display-buffer-noselect t))
 | 
			
		||||
               (apply #'magit-show-commit rev (magit-diff-arguments))))))))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-blame)
 | 
			
		||||
;;; magit-blame.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,366 +0,0 @@
 | 
			
		||||
;;; magit-bookmark.el --- bookmark support for Magit  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Yuri Khan <yuri.v.khan@gmail.com>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Support for bookmarks for most Magit buffers.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
(require 'bookmark)
 | 
			
		||||
 | 
			
		||||
;;; Supporting primitives
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--jump (bookmark fn &rest args)
 | 
			
		||||
  "Handle a Magit BOOKMARK.
 | 
			
		||||
 | 
			
		||||
This function will:
 | 
			
		||||
 | 
			
		||||
1. Bind `default-directory' to the repository root directory
 | 
			
		||||
   stored in the `filename' bookmark property.
 | 
			
		||||
2. Invoke the function FN with ARGS as arguments.  This needs to
 | 
			
		||||
   restore the buffer.
 | 
			
		||||
3. Restore the expanded/collapsed status of top level sections
 | 
			
		||||
   and the point position."
 | 
			
		||||
  (declare (indent 2))
 | 
			
		||||
  (let* ((default-directory (bookmark-get-filename bookmark)))
 | 
			
		||||
    (if default-directory
 | 
			
		||||
        (apply fn args)
 | 
			
		||||
      (signal 'bookmark-error-no-filename (list 'stringp default-directory)))
 | 
			
		||||
    (when (derived-mode-p 'magit-mode)
 | 
			
		||||
      (when-let ((hidden-sections (bookmark-prop-get bookmark
 | 
			
		||||
                                                     'magit-hidden-sections)))
 | 
			
		||||
        (dolist (child (oref magit-root-section children))
 | 
			
		||||
          (if (member (cons (oref child type)
 | 
			
		||||
                            (oref child value))
 | 
			
		||||
                      hidden-sections)
 | 
			
		||||
              (magit-section-hide child)
 | 
			
		||||
            (magit-section-show child)))))
 | 
			
		||||
    (--when-let (bookmark-get-position bookmark)
 | 
			
		||||
      (goto-char it))
 | 
			
		||||
    (--when-let (bookmark-get-front-context-string bookmark)
 | 
			
		||||
      (when (search-forward it (point-max) t)
 | 
			
		||||
        (goto-char (match-beginning 0))))
 | 
			
		||||
    (--when-let (bookmark-get-rear-context-string bookmark)
 | 
			
		||||
      (when (search-backward it (point-min) t)
 | 
			
		||||
        (goto-char (match-end 0))))
 | 
			
		||||
    nil))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--make-record (mode handler &optional make-props)
 | 
			
		||||
  "Create a Magit bookmark.
 | 
			
		||||
 | 
			
		||||
MODE specifies the expected major mode of current buffer.
 | 
			
		||||
 | 
			
		||||
HANDLER should be a function that will be used to restore this
 | 
			
		||||
buffer.
 | 
			
		||||
 | 
			
		||||
MAKE-PROPS should be either nil or a function that will be called
 | 
			
		||||
with `magit-refresh-args' as the argument list, and may return an
 | 
			
		||||
alist whose every element has the form (PROP . VALUE) and
 | 
			
		||||
specifies additional properties to store in the bookmark."
 | 
			
		||||
  (declare (indent 1))
 | 
			
		||||
  (unless (eq major-mode mode)
 | 
			
		||||
    (user-error "Not in a %s buffer" mode))
 | 
			
		||||
  (let ((bookmark (bookmark-make-record-default 'no-file)))
 | 
			
		||||
    (bookmark-prop-set bookmark 'handler handler)
 | 
			
		||||
    (bookmark-set-filename bookmark (magit-toplevel))
 | 
			
		||||
    (when (derived-mode-p 'magit-mode)
 | 
			
		||||
      (bookmark-prop-set
 | 
			
		||||
       bookmark 'magit-hidden-sections
 | 
			
		||||
       (--map (cons (oref it type)
 | 
			
		||||
                    (oref it value))
 | 
			
		||||
              (--filter (oref it hidden)
 | 
			
		||||
                        (oref magit-root-section children)))))
 | 
			
		||||
    (when make-props
 | 
			
		||||
      (pcase-dolist (`(,prop . ,value) (apply make-props magit-refresh-args))
 | 
			
		||||
        (bookmark-prop-set bookmark prop value)))
 | 
			
		||||
    bookmark))
 | 
			
		||||
 | 
			
		||||
;;; Status
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--status-jump (bookmark)
 | 
			
		||||
  "Handle a Magit status BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark
 | 
			
		||||
      (lambda () (magit-status-internal default-directory))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--status-make-record ()
 | 
			
		||||
  "Create a Magit status bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-status-mode
 | 
			
		||||
    #'magit-bookmark--status-jump))
 | 
			
		||||
 | 
			
		||||
;;; Refs
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--refs-jump (bookmark)
 | 
			
		||||
  "Handle a Magit refs BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-show-refs
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-refs)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-args)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--refs-make-record ()
 | 
			
		||||
  "Create a Magit refs bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-refs-mode
 | 
			
		||||
    #'magit-bookmark--refs-jump
 | 
			
		||||
    (lambda (refs args)
 | 
			
		||||
      `((magit-refs . ,refs)
 | 
			
		||||
        (magit-args . ,args)))))
 | 
			
		||||
 | 
			
		||||
;;; Log
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--log-jump (bookmark)
 | 
			
		||||
  "Handle a Magit log BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-log
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-revs)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-args)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-files)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--log-make-name (buffer-name revs _args files)
 | 
			
		||||
  "Generate the default name for a log bookmark."
 | 
			
		||||
  (concat
 | 
			
		||||
   buffer-name " " (mapconcat #'identity revs " ")
 | 
			
		||||
   (and files
 | 
			
		||||
        (concat " touching " (mapconcat #'identity files " ")))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--log-make-record ()
 | 
			
		||||
  "Create a Magit log bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-log-mode
 | 
			
		||||
    #'magit-bookmark--log-jump
 | 
			
		||||
    (lambda (revs args files)
 | 
			
		||||
      `((defaults    . (,(magit-bookmark--log-make-name
 | 
			
		||||
                          (buffer-name) revs args files)))
 | 
			
		||||
        (magit-revs  . ,revs)
 | 
			
		||||
        (magit-args  . ,args)
 | 
			
		||||
        (magit-files . ,files)))))
 | 
			
		||||
 | 
			
		||||
;;; Reflog
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--reflog-jump (bookmark)
 | 
			
		||||
  "Handle a Magit reflog BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (let ((magit-reflog-arguments (bookmark-prop-get bookmark 'magit-args)))
 | 
			
		||||
          (magit-reflog (bookmark-prop-get bookmark 'magit-ref))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--reflog-make-name (buffer-name ref)
 | 
			
		||||
  "Generate the default name for a reflog bookmark."
 | 
			
		||||
  (concat buffer-name " " ref))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--reflog-make-record ()
 | 
			
		||||
  "Create a Magit reflog bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-reflog-mode
 | 
			
		||||
    #'magit-bookmark--reflog-jump
 | 
			
		||||
    (lambda (ref args)
 | 
			
		||||
      `((defaults   . (,(magit-bookmark--reflog-make-name (buffer-name) ref)))
 | 
			
		||||
        (magit-ref  . ,ref)
 | 
			
		||||
        (magit-args . ,args)))))
 | 
			
		||||
 | 
			
		||||
;;; Stashes
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--stashes-jump (bookmark)
 | 
			
		||||
  "Handle a Magit stash list BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-stash-list))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--stashes-make-record ()
 | 
			
		||||
  "Create a Magit stash list bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-stashes-mode
 | 
			
		||||
    #'magit-bookmark--stashes-jump))
 | 
			
		||||
 | 
			
		||||
;;; Cherry
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--cherry-jump (bookmark)
 | 
			
		||||
  "Handle a Magit cherry BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-cherry
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-head)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-upstream)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--cherry-make-name (buffer-name head upstream)
 | 
			
		||||
  "Generate the default name for a cherry bookmark."
 | 
			
		||||
  (concat buffer-name " " head " upstream " upstream))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--cherry-make-record ()
 | 
			
		||||
  "Create a Magit cherry bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-cherry-mode
 | 
			
		||||
    #'magit-bookmark--cherry-jump
 | 
			
		||||
    (lambda (upstream head)
 | 
			
		||||
      `((defaults       . (,(magit-bookmark--cherry-make-name
 | 
			
		||||
                             (buffer-name) head upstream)))
 | 
			
		||||
        (magit-head     . ,head)
 | 
			
		||||
        (magit-upstream . ,upstream)))))
 | 
			
		||||
 | 
			
		||||
;;; Diff
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--diff-jump (bookmark)
 | 
			
		||||
  "Handle a Magit diff BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-diff-setup
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-rev-or-range)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-const)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-args)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-files)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--resolve (rev-or-range)
 | 
			
		||||
  "Return REV-OR-RANGE with ref names resolved to commit hashes."
 | 
			
		||||
  (pcase (magit-git-lines "rev-parse" rev-or-range)
 | 
			
		||||
    (`(,rev)
 | 
			
		||||
     (magit-rev-abbrev rev))
 | 
			
		||||
    ((and `(,rev1 ,rev2)
 | 
			
		||||
          (guard (/= ?^ (aref rev1 0)))
 | 
			
		||||
          (guard (=  ?^ (aref rev2 0))))
 | 
			
		||||
     (concat (magit-rev-abbrev (substring rev2 1))
 | 
			
		||||
             ".."
 | 
			
		||||
             (magit-rev-abbrev rev1)))
 | 
			
		||||
    ((and `(,rev1 ,rev2 ,rev3)
 | 
			
		||||
          (guard (/= ?^ (aref rev1 0)))
 | 
			
		||||
          (guard (/= ?^ (aref rev2 0)))
 | 
			
		||||
          (guard (=  ?^ (aref rev3 0))))
 | 
			
		||||
     (ignore rev3)
 | 
			
		||||
     (concat (magit-rev-abbrev rev1)
 | 
			
		||||
             "..."
 | 
			
		||||
             (magit-rev-abbrev rev2)))
 | 
			
		||||
    (_
 | 
			
		||||
     rev-or-range)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--diff-make-name
 | 
			
		||||
    (buffer-name rev-or-range const _args files)
 | 
			
		||||
  "Generate a default name for a diff bookmark."
 | 
			
		||||
  (if (member "--no-index" const)
 | 
			
		||||
      (apply #'format "*magit-diff %s %s" files)
 | 
			
		||||
    (concat buffer-name " "
 | 
			
		||||
            (cond (rev-or-range)
 | 
			
		||||
                  ((member "--cached" const) "staged")
 | 
			
		||||
                  (t                       "unstaged"))
 | 
			
		||||
            (when files
 | 
			
		||||
              (concat " in " (mapconcat #'identity files ", "))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--diff-make-record ()
 | 
			
		||||
  "Create a Magit diff bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-diff-mode
 | 
			
		||||
    #'magit-bookmark--diff-jump
 | 
			
		||||
    (lambda (rev-or-range const args files)
 | 
			
		||||
      (let ((resolved (magit-bookmark--resolve rev-or-range)))
 | 
			
		||||
        `((defaults           . (,(magit-bookmark--diff-make-name
 | 
			
		||||
                                   (buffer-name) resolved const args files)))
 | 
			
		||||
          (magit-rev-or-range . ,resolved)
 | 
			
		||||
          (magit-const        . ,const)
 | 
			
		||||
          (magit-args         . ,args)
 | 
			
		||||
          (magit-files        . ,files))))))
 | 
			
		||||
 | 
			
		||||
;;; Revision
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--revision-jump (bookmark)
 | 
			
		||||
  "Handle a Magit revision BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-show-commit
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-rev)
 | 
			
		||||
    (bookmark-prop-get bookmark 'args)
 | 
			
		||||
    (bookmark-prop-get bookmark 'files)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--revision-make-name (buffer-name rev _args files)
 | 
			
		||||
  "Generate a default name for a revision bookmark."
 | 
			
		||||
  (let ((subject (magit-rev-format "%s" rev)))
 | 
			
		||||
    (concat buffer-name " "
 | 
			
		||||
            (magit-rev-abbrev rev)
 | 
			
		||||
            (cond (files   (concat " " (mapconcat #'identity files " ")))
 | 
			
		||||
                  (subject (concat " " subject))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--revision-make-record ()
 | 
			
		||||
  "Create a Magit revision bookmark."
 | 
			
		||||
  ;; magit-refresh-args stores the revision in relative form.
 | 
			
		||||
  ;; For bookmarks, the exact hash is more appropriate.
 | 
			
		||||
  (magit-bookmark--make-record 'magit-revision-mode
 | 
			
		||||
    #'magit-bookmark--revision-jump
 | 
			
		||||
    (lambda (_rev _ args files)
 | 
			
		||||
      `((defaults    . (,(magit-bookmark--revision-make-name
 | 
			
		||||
                          (buffer-name) magit-buffer-revision-hash
 | 
			
		||||
                          args files)))
 | 
			
		||||
        (magit-rev   . ,magit-buffer-revision-hash)
 | 
			
		||||
        (magit-args  . ,args)
 | 
			
		||||
        (magit-files . ,files)))))
 | 
			
		||||
 | 
			
		||||
;;; Stash
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--stash-jump (bookmark)
 | 
			
		||||
  "Handle a Magit stash BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-stash-show
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-stash)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-args)
 | 
			
		||||
    (bookmark-prop-get bookmark 'magit-files)))
 | 
			
		||||
 | 
			
		||||
(defun magit-bookmark--stash-make-name (buffer-name stash _args files)
 | 
			
		||||
  "Generate the default name for a stash bookmark."
 | 
			
		||||
  (concat buffer-name " " stash " "
 | 
			
		||||
          (if files
 | 
			
		||||
              (mapconcat #'identity files " ")
 | 
			
		||||
            (magit-rev-format "%s" stash))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--stash-make-record ()
 | 
			
		||||
  "Create a Magit stash bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-stash-mode
 | 
			
		||||
    #'magit-bookmark--stash-jump
 | 
			
		||||
    (lambda (stash _ args files)
 | 
			
		||||
      `((defaults    . (,(magit-bookmark--stash-make-name
 | 
			
		||||
                          (buffer-name)
 | 
			
		||||
                          (magit-rev-abbrev magit-buffer-revision-hash)
 | 
			
		||||
                          args files)))
 | 
			
		||||
        (magit-stash . ,magit-buffer-revision-hash)
 | 
			
		||||
        (magit-args  . ,args)
 | 
			
		||||
        (magit-files . ,files)
 | 
			
		||||
        (magit-hidden-sections
 | 
			
		||||
         . ,(--map `(,(oref it type)
 | 
			
		||||
                     . ,(replace-regexp-in-string (regexp-quote stash)
 | 
			
		||||
                                                  magit-buffer-revision-hash
 | 
			
		||||
                                                  (oref it value)))
 | 
			
		||||
                   (--filter (oref it hidden)
 | 
			
		||||
                             (oref magit-root-section children))))))))
 | 
			
		||||
 | 
			
		||||
;;; Submodules
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--submodules-jump (bookmark)
 | 
			
		||||
  "Handle a Magit submodule list BOOKMARK."
 | 
			
		||||
  (magit-bookmark--jump bookmark #'magit-list-submodules))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-bookmark--submodules-make-record ()
 | 
			
		||||
  "Create a Magit submodule list bookmark."
 | 
			
		||||
  (magit-bookmark--make-record 'magit-submodule-list-mode
 | 
			
		||||
    #'magit-bookmark--submodules-jump))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-bookmark)
 | 
			
		||||
;;; magit-bookmark.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,173 +0,0 @@
 | 
			
		||||
;;; magit-collab.el --- collaboration tools       -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements various collaboration tools.  These tools
 | 
			
		||||
;; are only early incarnation -- implementing collaboration tools is
 | 
			
		||||
;; a top priority for future development.
 | 
			
		||||
 | 
			
		||||
;; Currently these tools (including `magit-branch-pull-request', which
 | 
			
		||||
;; is defined elsewhere) only support Github, but support for other
 | 
			
		||||
;; Git forges as well as mailing list based collaboration is in
 | 
			
		||||
;; planning.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
(require 'ghub)
 | 
			
		||||
 | 
			
		||||
;;; Variables
 | 
			
		||||
 | 
			
		||||
(defvar magit-github-token-scopes '(repo)
 | 
			
		||||
  "The Github API scopes needed by Magit.
 | 
			
		||||
 | 
			
		||||
`repo' is the only required scope.  Without this scope none of
 | 
			
		||||
Magit's features that use the API work.  Instead of this scope
 | 
			
		||||
you could use `public_repo' if you are only interested in public
 | 
			
		||||
repositories.
 | 
			
		||||
 | 
			
		||||
`repo' Grants read/write access to code, commit statuses,
 | 
			
		||||
  invitations, collaborators, adding team memberships, and
 | 
			
		||||
  deployment statuses for public and private repositories
 | 
			
		||||
  and organizations.
 | 
			
		||||
 | 
			
		||||
`public_repo' Grants read/write access to code, commit statuses,
 | 
			
		||||
  collaborators, and deployment statuses for public repositories
 | 
			
		||||
  and organizations. Also required for starring public
 | 
			
		||||
  repositories.")
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-browse-pull-request (pr)
 | 
			
		||||
  "Visit pull-request PR using `browse-url'.
 | 
			
		||||
 | 
			
		||||
Currently this only supports Github, but that restriction will
 | 
			
		||||
be lifted eventually to support other Git forges."
 | 
			
		||||
  (interactive (list (magit-read-pull-request "Visit pull request")))
 | 
			
		||||
  (browse-url (format "https://github.com/%s/pull/%s"
 | 
			
		||||
                      (--> pr
 | 
			
		||||
                           (cdr (assq 'base it))
 | 
			
		||||
                           (cdr (assq 'repo it))
 | 
			
		||||
                           (cdr (assq 'full_name it)))
 | 
			
		||||
                      (cdr (assq 'number pr)))))
 | 
			
		||||
 | 
			
		||||
;;; Utilities
 | 
			
		||||
 | 
			
		||||
(defun magit-read-pull-request (prompt)
 | 
			
		||||
  "Read a pull request from the user, prompting with PROMPT.
 | 
			
		||||
Return the Git forge's API response.  Currently this function
 | 
			
		||||
only supports Github, but that will change eventually."
 | 
			
		||||
  (let* ((origin (magit-upstream-repository))
 | 
			
		||||
         (id     (magit--forge-id origin))
 | 
			
		||||
         (fmtfun (lambda (pull-request)
 | 
			
		||||
                   (format "%s  %s"
 | 
			
		||||
                           (cdr (assq 'number pull-request))
 | 
			
		||||
                           (cdr (assq 'title  pull-request)))))
 | 
			
		||||
         (prs    (ghub-get (format "/repos/%s/pulls" id) nil :auth 'magit))
 | 
			
		||||
         (choice (magit-completing-read
 | 
			
		||||
                  prompt (mapcar fmtfun prs) nil nil nil nil
 | 
			
		||||
                  (let ((default (thing-at-point 'github-pull-request)))
 | 
			
		||||
                    (and default (funcall fmtfun default)))))
 | 
			
		||||
         (number (and (string-match "\\([0-9]+\\)" choice)
 | 
			
		||||
                      (string-to-number (match-string 1 choice)))))
 | 
			
		||||
    (and number
 | 
			
		||||
         ;; Don't reuse the pr from the list, it lacks some information
 | 
			
		||||
         ;; that is only returned when requesting a single pr.  #3371
 | 
			
		||||
         (ghub-get (format "/repos/%s/pulls/%s" id number)
 | 
			
		||||
                   nil :auth 'magit))))
 | 
			
		||||
 | 
			
		||||
(defun magit-upstream-repository ()
 | 
			
		||||
  "Return the remote name of the upstream repository.
 | 
			
		||||
 | 
			
		||||
If the Git variable `magit.upstream' is set, then return its
 | 
			
		||||
value.  Otherwise return \"origin\".  If the remote does not
 | 
			
		||||
exist, then raise an error."
 | 
			
		||||
  (let ((remote (or (magit-get "magit.upstream") "origin")))
 | 
			
		||||
    (unless (magit-remote-p remote)
 | 
			
		||||
      (error "No remote named `%s' exists (consider setting `magit.upstream')"
 | 
			
		||||
             remote))
 | 
			
		||||
    (unless (magit--github-remote-p remote)
 | 
			
		||||
      (error "Currently only Github is supported"))
 | 
			
		||||
    remote))
 | 
			
		||||
 | 
			
		||||
(defun magit--forge-id (remote)
 | 
			
		||||
  (let ((url (magit-get "remote" remote "url")))
 | 
			
		||||
    (and (string-match "\\([^:/]+/[^/]+?\\)\\(?:\\.git\\)?\\'" url)
 | 
			
		||||
         (match-string 1 url))))
 | 
			
		||||
 | 
			
		||||
(defconst magit--github-url-regexp "\
 | 
			
		||||
\\`\\(?:git://\\|git@\\|ssh://git@\\|https://\\)\
 | 
			
		||||
\\(.*?\\)[/:]\
 | 
			
		||||
\\(\\([^:/]+\\)/\\([^/]+?\\)\\)\
 | 
			
		||||
\\(?:\\.git\\)?\\'")
 | 
			
		||||
 | 
			
		||||
(defun magit--github-url-p (url)
 | 
			
		||||
  (save-match-data
 | 
			
		||||
    (and url
 | 
			
		||||
         (string-match magit--github-url-regexp url)
 | 
			
		||||
         (let ((host (match-string 1 url)))
 | 
			
		||||
           ;; Match values like "github.com-as-someone", which are
 | 
			
		||||
           ;; translated to just "github.com" according to settings
 | 
			
		||||
           ;; in "~/.ssh/config".  Theoretically this could result
 | 
			
		||||
           ;; in false-positives, but that's rather unlikely.  #3392
 | 
			
		||||
           (and (or (string-match-p (regexp-quote "github.com") host)
 | 
			
		||||
                    (string-match-p
 | 
			
		||||
                     (regexp-quote (car (split-string (ghub--host) "/")))
 | 
			
		||||
                     host))
 | 
			
		||||
                host)))))
 | 
			
		||||
 | 
			
		||||
(defun magit--github-remote-p (remote)
 | 
			
		||||
  (or (--when-let (magit-git-string "remote" "get-url" "--push" remote)
 | 
			
		||||
        (magit--github-url-p it))
 | 
			
		||||
      (--when-let (magit-git-string "remote" "get-url" "--all" remote)
 | 
			
		||||
        (magit--github-url-p it))))
 | 
			
		||||
 | 
			
		||||
(defun magit--github-url-equal (r1 r2)
 | 
			
		||||
  (or (equal r1 r2)
 | 
			
		||||
      (save-match-data
 | 
			
		||||
        (let ((n1 (and (string-match magit--github-url-regexp r1)
 | 
			
		||||
                       (match-string 2 r1)))
 | 
			
		||||
              (n2 (and (string-match magit--github-url-regexp r2)
 | 
			
		||||
                       (match-string 2 r2))))
 | 
			
		||||
          (and n1 n2 (equal n1 n2))))))
 | 
			
		||||
 | 
			
		||||
(defun magit--pullreq-from-upstream-p (pr)
 | 
			
		||||
  (let-alist pr
 | 
			
		||||
    (equal .head.repo.full_name
 | 
			
		||||
           .base.repo.full_name)))
 | 
			
		||||
 | 
			
		||||
(defun magit--pullreq-branch (pr &optional assert-new)
 | 
			
		||||
  (let-alist pr
 | 
			
		||||
    (let ((branch .head.ref))
 | 
			
		||||
      (when (and (not (magit--pullreq-from-upstream-p pr))
 | 
			
		||||
                 (or (not .maintainer_can_modify)
 | 
			
		||||
                     (magit-branch-p branch)))
 | 
			
		||||
        (setq branch (format "pr-%s" .number)))
 | 
			
		||||
      (when (and assert-new (magit-branch-p branch))
 | 
			
		||||
        (user-error "Branch `%s' already exists" branch))
 | 
			
		||||
      branch)))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-collab)
 | 
			
		||||
;;; magit-collab.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,519 +0,0 @@
 | 
			
		||||
;;; magit-commit.el --- create Git commits  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2008-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements commands for creating Git commits.  These
 | 
			
		||||
;; commands just initiate the commit, support for writing the commit
 | 
			
		||||
;; messages is implemented in `git-commit.el'.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
(require 'magit-sequence)
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'epa)) ; for `epa-protocol'
 | 
			
		||||
(eval-when-compile (require 'epg))
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-arguments nil
 | 
			
		||||
  "The arguments used when committing."
 | 
			
		||||
  :group 'magit-git-arguments
 | 
			
		||||
  :type '(repeat (string :tag "Argument")))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-ask-to-stage 'verbose
 | 
			
		||||
  "Whether to ask to stage all unstaged changes when committing and nothing is staged."
 | 
			
		||||
  :package-version '(magit . "2.3.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type '(choice (const :tag "Ask showing diff" verbose)
 | 
			
		||||
                 (const :tag "Ask" t)
 | 
			
		||||
                 (const :tag "Don't ask" nil)))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-show-diff t
 | 
			
		||||
  "Whether the relevant diff is automatically shown when committing."
 | 
			
		||||
  :package-version '(magit . "2.3.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-extend-override-date t
 | 
			
		||||
  "Whether using `magit-commit-extend' changes the committer date."
 | 
			
		||||
  :package-version '(magit . "2.3.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-reword-override-date t
 | 
			
		||||
  "Whether using `magit-commit-reword' changes the committer date."
 | 
			
		||||
  :package-version '(magit . "2.3.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-commit-squash-confirm t
 | 
			
		||||
  "Whether the commit targeted by squash and fixup has to be confirmed.
 | 
			
		||||
When non-nil then the commit at point (if any) is used as default
 | 
			
		||||
choice, otherwise it has to be confirmed.  This option only
 | 
			
		||||
affects `magit-commit-squash' and `magit-commit-fixup'.  The
 | 
			
		||||
\"instant\" variants always require confirmation because making
 | 
			
		||||
an error while using those is harder to recover from."
 | 
			
		||||
  :package-version '(magit . "2.1.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
;;; Popup
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-popup (&optional arg)
 | 
			
		||||
  "Popup console for commit commands."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (--if-let (magit-commit-message-buffer)
 | 
			
		||||
      (switch-to-buffer it)
 | 
			
		||||
    (magit-invoke-popup 'magit-commit-popup nil arg)))
 | 
			
		||||
 | 
			
		||||
(defvar magit-commit-popup
 | 
			
		||||
  '(:variable magit-commit-arguments
 | 
			
		||||
    :man-page "git-commit"
 | 
			
		||||
    :switches ((?a "Stage all modified and deleted files"   "--all")
 | 
			
		||||
               (?e "Allow empty commit"                     "--allow-empty")
 | 
			
		||||
               (?v "Show diff of changes to be committed"   "--verbose")
 | 
			
		||||
               (?h "Disable hooks"                          "--no-verify")
 | 
			
		||||
               (?s "Add Signed-off-by line"                 "--signoff")
 | 
			
		||||
               (?R "Claim authorship and reset author date" "--reset-author"))
 | 
			
		||||
    :options  ((?A "Override the author"  "--author=")
 | 
			
		||||
               (?S "Sign using gpg"       "--gpg-sign=" magit-read-gpg-secret-key)
 | 
			
		||||
               (?C "Reuse commit message" "--reuse-message="
 | 
			
		||||
                   magit-read-reuse-message))
 | 
			
		||||
    :actions  ((?c "Commit"         magit-commit)
 | 
			
		||||
               (?e "Extend"         magit-commit-extend)
 | 
			
		||||
               (?f "Fixup"          magit-commit-fixup)
 | 
			
		||||
               (?F "Instant Fixup"  magit-commit-instant-fixup) nil
 | 
			
		||||
               (?w "Reword"         magit-commit-reword)
 | 
			
		||||
               (?s "Squash"         magit-commit-squash)
 | 
			
		||||
               (?S "Instant Squash" magit-commit-instant-squash) nil
 | 
			
		||||
               (?a "Amend"          magit-commit-amend)
 | 
			
		||||
               (?A "Augment"        magit-commit-augment))
 | 
			
		||||
    :max-action-columns 4
 | 
			
		||||
    :default-action magit-commit))
 | 
			
		||||
 | 
			
		||||
(magit-define-popup-keys-deferred 'magit-commit-popup)
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-arguments nil
 | 
			
		||||
  (if (eq magit-current-popup 'magit-commit-popup)
 | 
			
		||||
      magit-current-popup-args
 | 
			
		||||
    magit-commit-arguments))
 | 
			
		||||
 | 
			
		||||
(defvar magit-gpg-secret-key-hist nil)
 | 
			
		||||
 | 
			
		||||
(defun magit-read-gpg-secret-key (prompt &optional _initial-input)
 | 
			
		||||
  (require 'epa)
 | 
			
		||||
  (let ((keys (--map (concat (epg-sub-key-id (car (epg-key-sub-key-list it)))
 | 
			
		||||
                             " "
 | 
			
		||||
                             (when-let ((id-obj (car (epg-key-user-id-list it))))
 | 
			
		||||
                               (let ((id-str (epg-user-id-string id-obj)))
 | 
			
		||||
                                 (if (stringp id-str)
 | 
			
		||||
                                     id-str
 | 
			
		||||
                                   (epg-decode-dn id-obj)))))
 | 
			
		||||
                     (epg-list-keys (epg-make-context epa-protocol) nil t))))
 | 
			
		||||
    (car (split-string (magit-completing-read
 | 
			
		||||
                        prompt keys nil nil nil 'magit-gpg-secret-key-hist
 | 
			
		||||
                        (car (or magit-gpg-secret-key-hist keys)))
 | 
			
		||||
                       " "))))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-reuse-message (prompt &optional default)
 | 
			
		||||
  (magit-completing-read prompt (magit-list-refnames)
 | 
			
		||||
                         nil nil nil 'magit-revision-history
 | 
			
		||||
                         (or default
 | 
			
		||||
                             (and (magit-rev-verify "ORIG_HEAD")
 | 
			
		||||
                                  "ORIG_HEAD"))))
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit (&optional args)
 | 
			
		||||
  "Create a new commit on `HEAD'.
 | 
			
		||||
With a prefix argument, amend to the commit at `HEAD' instead.
 | 
			
		||||
\n(git commit [--amend] ARGS)"
 | 
			
		||||
  (interactive (if current-prefix-arg
 | 
			
		||||
                   (list (cons "--amend" (magit-commit-arguments)))
 | 
			
		||||
                 (list (magit-commit-arguments))))
 | 
			
		||||
  (when (member "--all" args)
 | 
			
		||||
    (setq this-command 'magit-commit-all))
 | 
			
		||||
  (when (setq args (magit-commit-assert args))
 | 
			
		||||
    (let ((default-directory (magit-toplevel)))
 | 
			
		||||
      (magit-run-git-with-editor "commit" args))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-amend (&optional args)
 | 
			
		||||
  "Amend the last commit.
 | 
			
		||||
\n(git commit --amend ARGS)"
 | 
			
		||||
  (interactive (list (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-amend-assert)
 | 
			
		||||
  (magit-run-git-with-editor "commit" "--amend" args))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-extend (&optional args override-date)
 | 
			
		||||
  "Amend the last commit, without editing the message.
 | 
			
		||||
 | 
			
		||||
With a prefix argument keep the committer date, otherwise change
 | 
			
		||||
it.  The option `magit-commit-extend-override-date' can be used
 | 
			
		||||
to inverse the meaning of the prefix argument.  \n(git commit
 | 
			
		||||
--amend --no-edit)"
 | 
			
		||||
  (interactive (list (magit-commit-arguments)
 | 
			
		||||
                     (if current-prefix-arg
 | 
			
		||||
                         (not magit-commit-extend-override-date)
 | 
			
		||||
                       magit-commit-extend-override-date)))
 | 
			
		||||
  (when (setq args (magit-commit-assert args (not override-date)))
 | 
			
		||||
    (magit-commit-amend-assert)
 | 
			
		||||
    (let ((process-environment process-environment))
 | 
			
		||||
      (unless override-date
 | 
			
		||||
        (push (magit-rev-format "GIT_COMMITTER_DATE=%cD") process-environment))
 | 
			
		||||
      (magit-run-git-with-editor "commit" "--amend" "--no-edit" args))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-reword (&optional args override-date)
 | 
			
		||||
  "Reword the last commit, ignoring staged changes.
 | 
			
		||||
 | 
			
		||||
With a prefix argument keep the committer date, otherwise change
 | 
			
		||||
it.  The option `magit-commit-reword-override-date' can be used
 | 
			
		||||
to inverse the meaning of the prefix argument.
 | 
			
		||||
 | 
			
		||||
Non-interactively respect the optional OVERRIDE-DATE argument
 | 
			
		||||
and ignore the option.
 | 
			
		||||
\n(git commit --amend --only)"
 | 
			
		||||
  (interactive (list (magit-commit-arguments)
 | 
			
		||||
                     (if current-prefix-arg
 | 
			
		||||
                         (not magit-commit-reword-override-date)
 | 
			
		||||
                       magit-commit-reword-override-date)))
 | 
			
		||||
  (magit-commit-amend-assert)
 | 
			
		||||
  (let ((process-environment process-environment))
 | 
			
		||||
    (unless override-date
 | 
			
		||||
      (push (magit-rev-format "GIT_COMMITTER_DATE=%cD") process-environment))
 | 
			
		||||
    (magit-run-git-with-editor "commit" "--amend" "--only" args)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-fixup (&optional commit args)
 | 
			
		||||
  "Create a fixup commit.
 | 
			
		||||
 | 
			
		||||
With a prefix argument the target COMMIT has to be confirmed.
 | 
			
		||||
Otherwise the commit at point may be used without confirmation
 | 
			
		||||
depending on the value of option `magit-commit-squash-confirm'."
 | 
			
		||||
  (interactive (list (magit-commit-at-point)
 | 
			
		||||
                     (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-squash-internal "--fixup" commit args))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-squash (&optional commit args)
 | 
			
		||||
  "Create a squash commit, without editing the squash message.
 | 
			
		||||
 | 
			
		||||
With a prefix argument the target COMMIT has to be confirmed.
 | 
			
		||||
Otherwise the commit at point may be used without confirmation
 | 
			
		||||
depending on the value of option `magit-commit-squash-confirm'."
 | 
			
		||||
  (interactive (list (magit-commit-at-point)
 | 
			
		||||
                     (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-squash-internal "--squash" commit args))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-augment (&optional commit args)
 | 
			
		||||
  "Create a squash commit, editing the squash message.
 | 
			
		||||
 | 
			
		||||
With a prefix argument the target COMMIT has to be confirmed.
 | 
			
		||||
Otherwise the commit at point may be used without confirmation
 | 
			
		||||
depending on the value of option `magit-commit-squash-confirm'."
 | 
			
		||||
  (interactive (list (magit-commit-at-point)
 | 
			
		||||
                     (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-squash-internal "--squash" commit args nil t))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-instant-fixup (&optional commit args)
 | 
			
		||||
  "Create a fixup commit targeting COMMIT and instantly rebase."
 | 
			
		||||
  (interactive (list (magit-commit-at-point)
 | 
			
		||||
                     (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-squash-internal "--fixup" commit args t))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-instant-squash (&optional commit args)
 | 
			
		||||
  "Create a squash commit targeting COMMIT and instantly rebase."
 | 
			
		||||
  (interactive (list (magit-commit-at-point)
 | 
			
		||||
                     (magit-commit-arguments)))
 | 
			
		||||
  (magit-commit-squash-internal "--squash" commit args t))
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-squash-internal
 | 
			
		||||
    (option commit &optional args rebase edit confirmed)
 | 
			
		||||
  (when-let ((args (magit-commit-assert args t)))
 | 
			
		||||
    (when commit
 | 
			
		||||
      (when (and rebase (not (magit-rev-ancestor-p commit "HEAD")))
 | 
			
		||||
        (magit-read-char-case
 | 
			
		||||
            (format "%s isn't an ancestor of HEAD.  " commit) nil
 | 
			
		||||
          (?c "[c]reate without rebasing" (setq rebase nil))
 | 
			
		||||
          (?s "[s]elect other"            (setq commit nil))
 | 
			
		||||
          (?a "[a]bort"                   (user-error "Quit")))))
 | 
			
		||||
    (when commit
 | 
			
		||||
      (setq commit (magit-rebase-interactive-assert commit t)))
 | 
			
		||||
    (if (and commit
 | 
			
		||||
             (or confirmed
 | 
			
		||||
                 (not (or rebase
 | 
			
		||||
                          current-prefix-arg
 | 
			
		||||
                          magit-commit-squash-confirm))))
 | 
			
		||||
        (let ((magit-commit-show-diff nil))
 | 
			
		||||
          (push (concat option "=" commit) args)
 | 
			
		||||
          (unless edit
 | 
			
		||||
            (push "--no-edit" args))
 | 
			
		||||
          (if rebase
 | 
			
		||||
              (magit-with-editor
 | 
			
		||||
                (magit-call-git
 | 
			
		||||
                 "commit" "--no-gpg-sign"
 | 
			
		||||
                 (-remove-first
 | 
			
		||||
                  (apply-partially #'string-match-p "\\`--gpg-sign=")
 | 
			
		||||
                  args)))
 | 
			
		||||
            (magit-run-git-with-editor "commit" args))
 | 
			
		||||
          t) ; The commit was created; used by below lambda.
 | 
			
		||||
      (magit-log-select
 | 
			
		||||
        (lambda (commit)
 | 
			
		||||
          (when (and (magit-commit-squash-internal option commit args
 | 
			
		||||
                                                   rebase edit t)
 | 
			
		||||
                     rebase)
 | 
			
		||||
            (magit-commit-amend-assert commit)
 | 
			
		||||
            (magit-rebase-interactive-1 commit
 | 
			
		||||
                (list "--autosquash" "--autostash")
 | 
			
		||||
              "" "true" nil t)))
 | 
			
		||||
        (format "Type %%p on a commit to %s into it,"
 | 
			
		||||
                (substring option 2)))
 | 
			
		||||
      (when magit-commit-show-diff
 | 
			
		||||
        (let ((magit-display-buffer-noselect t))
 | 
			
		||||
          (apply #'magit-diff-staged nil (magit-diff-arguments)))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-amend-assert (&optional commit)
 | 
			
		||||
  (--when-let (magit-list-publishing-branches commit)
 | 
			
		||||
    (let ((m1 "This commit has already been published to ")
 | 
			
		||||
          (m2 ".\nDo you really want to modify it"))
 | 
			
		||||
      (magit-confirm 'amend-published
 | 
			
		||||
        (concat m1 "%s" m2)
 | 
			
		||||
        (concat m1 "%i public branches" m2)
 | 
			
		||||
        nil it))))
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-assert (args &optional strict)
 | 
			
		||||
  (cond
 | 
			
		||||
   ((or (magit-anything-staged-p)
 | 
			
		||||
        (and (magit-anything-unstaged-p)
 | 
			
		||||
             ;; ^ Everything of nothing is still nothing.
 | 
			
		||||
             (member "--all" args))
 | 
			
		||||
        (and (not strict)
 | 
			
		||||
             ;; ^ For amend variants that don't make sense otherwise.
 | 
			
		||||
             (or (member "--amend" args)
 | 
			
		||||
                 (member "--allow-empty" args))))
 | 
			
		||||
    (or args (list "--")))
 | 
			
		||||
   ((and (magit-rebase-in-progress-p)
 | 
			
		||||
         (not (magit-anything-unstaged-p))
 | 
			
		||||
         (y-or-n-p "Nothing staged.  Continue in-progress rebase? "))
 | 
			
		||||
    (magit-run-git-sequencer "rebase" "--continue")
 | 
			
		||||
    nil)
 | 
			
		||||
   ((and (file-exists-p (magit-git-dir "MERGE_MSG"))
 | 
			
		||||
         (not (magit-anything-unstaged-p)))
 | 
			
		||||
    (or args (list "--")))
 | 
			
		||||
   ((not (magit-anything-unstaged-p))
 | 
			
		||||
    (user-error "Nothing staged (or unstaged)"))
 | 
			
		||||
   (magit-commit-ask-to-stage
 | 
			
		||||
    (when (eq magit-commit-ask-to-stage 'verbose)
 | 
			
		||||
      (magit-diff-unstaged))
 | 
			
		||||
    (prog1 (when (y-or-n-p "Nothing staged.  Stage and commit all unstaged changes? ")
 | 
			
		||||
             (magit-run-git "add" "-u" ".")
 | 
			
		||||
             (or args (list "--")))
 | 
			
		||||
      (when (and (eq magit-commit-ask-to-stage 'verbose)
 | 
			
		||||
                 (derived-mode-p 'magit-diff-mode))
 | 
			
		||||
        (magit-mode-bury-buffer))))
 | 
			
		||||
   (t
 | 
			
		||||
    (user-error "Nothing staged"))))
 | 
			
		||||
 | 
			
		||||
(defvar magit--reshelve-history nil)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-commit-reshelve (date)
 | 
			
		||||
  "Change the committer date and possibly the author date of `HEAD'.
 | 
			
		||||
 | 
			
		||||
If you are the author of `HEAD', then both dates are changed,
 | 
			
		||||
otherwise only the committer date.  The current time is used
 | 
			
		||||
as the initial minibuffer input and the original author (if
 | 
			
		||||
that is you) or committer date is available as the previous
 | 
			
		||||
history element."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((author-p (magit-rev-author-p "HEAD")))
 | 
			
		||||
     (push (magit-rev-format (if author-p "%ad" "%cd") "HEAD"
 | 
			
		||||
                             (concat "--date=format:%F %T %z"))
 | 
			
		||||
           magit--reshelve-history)
 | 
			
		||||
     (list (read-string (if author-p
 | 
			
		||||
                            "Change author and committer dates to: "
 | 
			
		||||
                          "Change committer date to: ")
 | 
			
		||||
                        (cons (format-time-string "%F %T %z") 17)
 | 
			
		||||
                        'magit--reshelve-history))))
 | 
			
		||||
  (let ((process-environment process-environment))
 | 
			
		||||
    (push (concat "GIT_COMMITTER_DATE=" date) process-environment)
 | 
			
		||||
    (magit-run-git "commit" "--amend" "--no-edit"
 | 
			
		||||
                   (and (magit-rev-author-p "HEAD")
 | 
			
		||||
                        (concat "--date=" date)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-commit-absorb-popup "magit-commit" nil t)
 | 
			
		||||
(magit-define-popup magit-commit-absorb-popup
 | 
			
		||||
  "Spread unstaged changes across recent commits.
 | 
			
		||||
Without a prefix argument just call `magit-commit-absorb'.
 | 
			
		||||
With a prefix argument use a popup buffer to select arguments."
 | 
			
		||||
  :man-page "git-bisect"
 | 
			
		||||
  :options '((?c "Diff context lines" "--context=")
 | 
			
		||||
             (?s "Strictness"         "--strict="))
 | 
			
		||||
  :actions '((?x "Absorb" magit-commit-absorb))
 | 
			
		||||
  :default-action 'magit-commit-absorb
 | 
			
		||||
  :use-prefix 'popup)
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-absorb (&optional commit args confirmed)
 | 
			
		||||
  "Spread unstaged changes across recent commits.
 | 
			
		||||
This command requires the git-autofixup script, which is
 | 
			
		||||
available from https://github.com/torbiak/git-autofixup."
 | 
			
		||||
  (interactive (list (magit-get-upstream-branch)
 | 
			
		||||
                     (magit-commit-absorb-arguments)))
 | 
			
		||||
  (unless (executable-find "git-autofixup")
 | 
			
		||||
    (user-error "This command requires the git-autofixup script, which %s"
 | 
			
		||||
                "is available from https://github.com/torbiak/git-autofixup"))
 | 
			
		||||
  (when (magit-anything-staged-p)
 | 
			
		||||
    (user-error "Cannot absorb when there are staged changes"))
 | 
			
		||||
  (unless (magit-anything-unstaged-p)
 | 
			
		||||
    (user-error "There are no unstaged changes that could be absorbed"))
 | 
			
		||||
  (when commit
 | 
			
		||||
    (setq commit (magit-rebase-interactive-assert commit t)))
 | 
			
		||||
  (if (and commit confirmed)
 | 
			
		||||
      (progn (magit-run-git-async "autofixup" "-vv" args commit) t)
 | 
			
		||||
    (magit-log-select
 | 
			
		||||
      (lambda (commit)
 | 
			
		||||
        (magit-commit-absorb commit args t))
 | 
			
		||||
      nil nil nil nil commit)))
 | 
			
		||||
 | 
			
		||||
;;; Pending Diff
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-diff ()
 | 
			
		||||
  (when (and git-commit-mode magit-commit-show-diff)
 | 
			
		||||
    (when-let ((diff-buffer (magit-mode-get-buffer 'magit-diff-mode)))
 | 
			
		||||
      ;; This window just started displaying the commit message
 | 
			
		||||
      ;; buffer.  Without this that buffer would immediately be
 | 
			
		||||
      ;; replaced with the diff buffer.  See #2632.
 | 
			
		||||
      (unrecord-window-buffer nil diff-buffer))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (let ((args (car (magit-diff-arguments)))
 | 
			
		||||
              (magit-inhibit-save-previous-winconf 'unset)
 | 
			
		||||
              (magit-display-buffer-noselect t)
 | 
			
		||||
              (inhibit-quit nil))
 | 
			
		||||
          (message "Diffing changes to be committed (C-g to abort diffing)")
 | 
			
		||||
          (if-let ((fn (cl-case last-command
 | 
			
		||||
                         (magit-commit
 | 
			
		||||
                          (apply-partially 'magit-diff-staged nil))
 | 
			
		||||
                         (magit-commit-all
 | 
			
		||||
                          (apply-partially 'magit-diff-working-tree nil))
 | 
			
		||||
                         ((magit-commit-amend
 | 
			
		||||
                           magit-commit-reword
 | 
			
		||||
                           magit-rebase-reword-commit)
 | 
			
		||||
                          'magit-diff-while-amending))))
 | 
			
		||||
              (funcall fn args)
 | 
			
		||||
            (if (magit-anything-staged-p)
 | 
			
		||||
                (magit-diff-staged nil args)
 | 
			
		||||
              (magit-diff-while-amending args))))
 | 
			
		||||
      (quit))))
 | 
			
		||||
 | 
			
		||||
;; Mention `magit-diff-while-committing' because that's
 | 
			
		||||
;; always what I search for when I try to find this line.
 | 
			
		||||
(add-hook 'server-switch-hook 'magit-commit-diff)
 | 
			
		||||
 | 
			
		||||
(add-to-list 'with-editor-server-window-alist
 | 
			
		||||
             (cons git-commit-filename-regexp 'switch-to-buffer))
 | 
			
		||||
 | 
			
		||||
;;; Message Utilities
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-message-buffer ()
 | 
			
		||||
  (let* ((find-file-visit-truename t) ; git uses truename of COMMIT_EDITMSG
 | 
			
		||||
         (topdir (magit-toplevel)))
 | 
			
		||||
    (--first (equal topdir (with-current-buffer it
 | 
			
		||||
                             (and git-commit-mode (magit-toplevel))))
 | 
			
		||||
             (append (buffer-list (selected-frame))
 | 
			
		||||
                     (buffer-list)))))
 | 
			
		||||
 | 
			
		||||
(defvar magit-commit-add-log-insert-function 'magit-commit-add-log-insert
 | 
			
		||||
  "Used by `magit-commit-add-log' to insert a single entry.")
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-add-log ()
 | 
			
		||||
  "Add a stub for the current change into the commit message buffer.
 | 
			
		||||
If no commit is in progress, then initiate it.  Use the function
 | 
			
		||||
specified by variable `magit-commit-add-log-insert-function' to
 | 
			
		||||
actually insert the entry."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((hunk (and (magit-section-match 'hunk)
 | 
			
		||||
                   (magit-current-section)))
 | 
			
		||||
        (log  (magit-commit-message-buffer)) buf pos)
 | 
			
		||||
    (save-window-excursion
 | 
			
		||||
      (call-interactively #'magit-diff-visit-file)
 | 
			
		||||
      (setq buf (current-buffer))
 | 
			
		||||
      (setq pos (point)))
 | 
			
		||||
    (unless log
 | 
			
		||||
      (unless (magit-commit-assert nil)
 | 
			
		||||
        (user-error "Abort"))
 | 
			
		||||
      (magit-commit)
 | 
			
		||||
      (while (not (setq log (magit-commit-message-buffer)))
 | 
			
		||||
        (sit-for 0.01)))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (with-current-buffer buf
 | 
			
		||||
        (goto-char pos)
 | 
			
		||||
        (funcall magit-commit-add-log-insert-function log
 | 
			
		||||
                 (magit-file-relative-name)
 | 
			
		||||
                 (and hunk (add-log-current-defun)))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-commit-add-log-insert (buffer file defun)
 | 
			
		||||
  (with-current-buffer buffer
 | 
			
		||||
    (undo-boundary)
 | 
			
		||||
    (goto-char (point-max))
 | 
			
		||||
    (while (re-search-backward (concat "^" comment-start) nil t))
 | 
			
		||||
    (save-restriction
 | 
			
		||||
      (narrow-to-region (point-min) (point))
 | 
			
		||||
      (cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
 | 
			
		||||
                                 nil t)
 | 
			
		||||
             (when (equal (match-string 1) defun)
 | 
			
		||||
               (setq defun nil))
 | 
			
		||||
             (re-search-forward ": "))
 | 
			
		||||
            (t
 | 
			
		||||
             (when (re-search-backward "^[\\*(].+\n" nil t)
 | 
			
		||||
               (goto-char (match-end 0)))
 | 
			
		||||
             (while (re-search-forward "^[^\\*\n].*\n" nil t))
 | 
			
		||||
             (if defun
 | 
			
		||||
                 (progn (insert (format "* %s (%s): \n" file defun))
 | 
			
		||||
                        (setq defun nil))
 | 
			
		||||
               (insert (format "* %s: \n" file)))
 | 
			
		||||
             (backward-char)
 | 
			
		||||
             (unless (looking-at "\n[\n\\']")
 | 
			
		||||
               (insert ?\n)
 | 
			
		||||
               (backward-char))))
 | 
			
		||||
      (when defun
 | 
			
		||||
        (forward-line)
 | 
			
		||||
        (let ((limit (save-excursion
 | 
			
		||||
                       (and (re-search-forward "^\\*" nil t)
 | 
			
		||||
                            (point)))))
 | 
			
		||||
          (unless (or (looking-back (format "(%s): " defun)
 | 
			
		||||
                                    (line-beginning-position))
 | 
			
		||||
                      (re-search-forward (format "^(%s): " defun) limit t))
 | 
			
		||||
            (while (re-search-forward "^[^\\*\n].*\n" limit t))
 | 
			
		||||
            (insert (format "(%s): \n" defun))
 | 
			
		||||
            (backward-char)))))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-commit)
 | 
			
		||||
;;; magit-commit.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,132 +0,0 @@
 | 
			
		||||
;;; magit-core.el --- core functionality  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library requires several other libraries, so that yet other
 | 
			
		||||
;; libraries can just require this one, instead of having to require
 | 
			
		||||
;; all the other ones.  In other words this separates the low-level
 | 
			
		||||
;; stuff from the rest.  It also defines some Custom groups.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit-popup)
 | 
			
		||||
(require 'magit-utils)
 | 
			
		||||
(require 'magit-section)
 | 
			
		||||
(require 'magit-git)
 | 
			
		||||
(require 'magit-mode)
 | 
			
		||||
(require 'magit-margin)
 | 
			
		||||
(require 'magit-process)
 | 
			
		||||
(require 'magit-autorevert)
 | 
			
		||||
 | 
			
		||||
(defgroup magit nil
 | 
			
		||||
  "Controlling Git from Emacs."
 | 
			
		||||
  :link '(url-link "https://magit.vc")
 | 
			
		||||
  :link '(info-link "(magit)FAQ")
 | 
			
		||||
  :link '(info-link "(magit)")
 | 
			
		||||
  :group 'tools)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-essentials nil
 | 
			
		||||
  "Options that every Magit user should briefly think about.
 | 
			
		||||
 | 
			
		||||
Each of these options falls into one or more of these categories:
 | 
			
		||||
 | 
			
		||||
* Options that affect Magit's behavior in fundamental ways.
 | 
			
		||||
* Options that affect safety.
 | 
			
		||||
* Options that affect performance.
 | 
			
		||||
* Options that are of a personal nature."
 | 
			
		||||
  :link '(info-link "(magit)Essential Settings")
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-miscellaneous nil
 | 
			
		||||
  "Miscellanous Magit options."
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-commands nil
 | 
			
		||||
  "Options controlling behavior of certain commands."
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-git-arguments nil
 | 
			
		||||
  "Options controlling what arguments are passed to Git.
 | 
			
		||||
 | 
			
		||||
Most of these options can be set using the respective popup,
 | 
			
		||||
and it is recommended that you do that because then you can
 | 
			
		||||
be certain that Magit supports the arguments that you select.
 | 
			
		||||
 | 
			
		||||
An option `magit-NAME-argument' specifies the arguments that
 | 
			
		||||
are enabled by default by the popup `magit-NAME-popup'."
 | 
			
		||||
  :link '(info-link "(magit-popup)Customizing Existing Popups")
 | 
			
		||||
  :link '(info-link "(magit-popup)Usage")
 | 
			
		||||
  :group 'magit-commands)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-modes nil
 | 
			
		||||
  "Modes used or provided by Magit."
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-buffers nil
 | 
			
		||||
  "Options concerning Magit buffers."
 | 
			
		||||
  :link '(info-link "(magit)Modes and Buffers")
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-refresh nil
 | 
			
		||||
  "Options controlling how Magit buffers are refreshed."
 | 
			
		||||
  :link '(info-link "(magit)Automatic Refreshing of Magit Buffers")
 | 
			
		||||
  :group 'magit
 | 
			
		||||
  :group 'magit-buffers)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-faces nil
 | 
			
		||||
  "Faces used by Magit."
 | 
			
		||||
  :group 'magit
 | 
			
		||||
  :group 'faces)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-extensions nil
 | 
			
		||||
  "Extensions to Magit."
 | 
			
		||||
  :group 'magit)
 | 
			
		||||
 | 
			
		||||
(custom-add-to-group 'magit-modes   'magit-popup       'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-faces   'magit-popup-faces 'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-modes   'git-commit        'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-faces   'git-commit-faces  'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-modes   'git-rebase        'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-faces   'git-rebase-faces  'custom-group)
 | 
			
		||||
(custom-add-to-group 'magit-process 'with-editor       'custom-group)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-related nil
 | 
			
		||||
  "Options that are relevant to Magit but that are defined elsewhere."
 | 
			
		||||
  :link '(custom-group-link vc)
 | 
			
		||||
  :link '(custom-group-link smerge)
 | 
			
		||||
  :link '(custom-group-link ediff)
 | 
			
		||||
  :link '(custom-group-link auto-revert)
 | 
			
		||||
  :group 'magit
 | 
			
		||||
  :group 'magit-extensions
 | 
			
		||||
  :group 'magit-essentials)
 | 
			
		||||
 | 
			
		||||
(custom-add-to-group 'magit-related     'auto-revert-check-vc-info 'custom-variable)
 | 
			
		||||
(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable)
 | 
			
		||||
 | 
			
		||||
(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable)
 | 
			
		||||
(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable)
 | 
			
		||||
(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable)
 | 
			
		||||
 | 
			
		||||
(provide 'magit-core)
 | 
			
		||||
;;; magit-core.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,509 +0,0 @@
 | 
			
		||||
;;; magit-ediff.el --- Ediff extension for Magit  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library provides basic support for Ediff.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
(require 'ediff)
 | 
			
		||||
(require 'smerge-mode)
 | 
			
		||||
 | 
			
		||||
(defvar smerge-ediff-buf)
 | 
			
		||||
(defvar smerge-ediff-windows)
 | 
			
		||||
 | 
			
		||||
;;; Options
 | 
			
		||||
 | 
			
		||||
(defgroup magit-ediff nil
 | 
			
		||||
  "Ediff support for Magit."
 | 
			
		||||
  :link '(info-link "(magit)Ediffing")
 | 
			
		||||
  :group 'magit-extensions)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-ediff-quit-hook
 | 
			
		||||
  '(magit-ediff-cleanup-auxiliary-buffers
 | 
			
		||||
    magit-ediff-restore-previous-winconf)
 | 
			
		||||
  "Hooks to run after finishing Ediff, when that was invoked using Magit.
 | 
			
		||||
The hooks are run in the Ediff control buffer.  This is similar
 | 
			
		||||
to `ediff-quit-hook' but takes the needs of Magit into account.
 | 
			
		||||
The `ediff-quit-hook' is ignored by Ediff sessions which were
 | 
			
		||||
invoked using Magit."
 | 
			
		||||
  :package-version '(magit . "2.2.0")
 | 
			
		||||
  :group 'magit-ediff
 | 
			
		||||
  :type 'hook
 | 
			
		||||
  :get 'magit-hook-custom-get
 | 
			
		||||
  :options '(magit-ediff-cleanup-auxiliary-buffers
 | 
			
		||||
             magit-ediff-restore-previous-winconf))
 | 
			
		||||
 | 
			
		||||
(defcustom magit-ediff-dwim-show-on-hunks nil
 | 
			
		||||
  "Whether `magit-ediff-dwim' runs show variants on hunks.
 | 
			
		||||
If non-nil, `magit-ediff-show-staged' or
 | 
			
		||||
`magit-ediff-show-unstaged' are called based on what section the
 | 
			
		||||
hunk is in.  Otherwise, `magit-ediff-dwim' runs
 | 
			
		||||
`magit-ediff-stage' when point is on an uncommitted hunk."
 | 
			
		||||
  :package-version '(magit . "2.2.0")
 | 
			
		||||
  :group 'magit-ediff
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-ediff-show-stash-with-index t
 | 
			
		||||
  "Whether `magit-ediff-show-stash' shows the state of the index.
 | 
			
		||||
 | 
			
		||||
If non-nil, use a third Ediff buffer to distinguish which changes
 | 
			
		||||
in the stash were staged.  In cases where the stash contains no
 | 
			
		||||
staged changes, fall back to a two-buffer Ediff.
 | 
			
		||||
 | 
			
		||||
More specifically, a stash is a merge commit, stash@{N}, with
 | 
			
		||||
potentially three parents.
 | 
			
		||||
 | 
			
		||||
* stash@{N}^1 represents the `HEAD' commit at the time the stash
 | 
			
		||||
  was created.
 | 
			
		||||
 | 
			
		||||
* stash@{N}^2 records any changes that were staged when the stash
 | 
			
		||||
  was made.
 | 
			
		||||
 | 
			
		||||
* stash@{N}^3, if it exists, contains files that were untracked
 | 
			
		||||
  when stashing.
 | 
			
		||||
 | 
			
		||||
If this option is non-nil, `magit-ediff-show-stash' will run
 | 
			
		||||
Ediff on a file using three buffers: one for stash@{N}, another
 | 
			
		||||
for stash@{N}^1, and a third for stash@{N}^2.
 | 
			
		||||
 | 
			
		||||
Otherwise, Ediff uses two buffers, comparing
 | 
			
		||||
stash@{N}^1..stash@{N}.  Along with any unstaged changes, changes
 | 
			
		||||
in the index commit, stash@{N}^2, will be shown in this
 | 
			
		||||
comparison unless they conflicted with changes in the working
 | 
			
		||||
tree at the time of stashing."
 | 
			
		||||
  :package-version '(magit . "2.6.0")
 | 
			
		||||
  :group 'magit-ediff
 | 
			
		||||
  :type 'boolean)
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
(defvar magit-ediff-previous-winconf nil)
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-ediff-popup "magit-ediff" nil t)
 | 
			
		||||
(magit-define-popup magit-ediff-popup
 | 
			
		||||
  "Popup console for ediff commands."
 | 
			
		||||
  :actions '((?E "Dwim"          magit-ediff-dwim)
 | 
			
		||||
             (?u "Show unstaged" magit-ediff-show-unstaged)
 | 
			
		||||
             (?s "Stage"         magit-ediff-stage)
 | 
			
		||||
             (?i "Show staged"   magit-ediff-show-staged)
 | 
			
		||||
             (?m "Resolve"       magit-ediff-resolve)
 | 
			
		||||
             (?w "Show worktree" magit-ediff-show-working-tree)
 | 
			
		||||
             (?r "Diff range"    magit-ediff-compare)
 | 
			
		||||
             (?c "Show commit"   magit-ediff-show-commit) nil
 | 
			
		||||
             (?z "Show stash"    magit-ediff-show-stash))
 | 
			
		||||
  :max-action-columns 2)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-resolve (file)
 | 
			
		||||
  "Resolve outstanding conflicts in FILE using Ediff.
 | 
			
		||||
FILE has to be relative to the top directory of the repository.
 | 
			
		||||
 | 
			
		||||
In the rare event that you want to manually resolve all
 | 
			
		||||
conflicts, including those already resolved by Git, use
 | 
			
		||||
`ediff-merge-revisions-with-ancestor'."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((current  (magit-current-file))
 | 
			
		||||
         (unmerged (magit-unmerged-files)))
 | 
			
		||||
     (unless unmerged
 | 
			
		||||
       (user-error "There are no unresolved conflicts"))
 | 
			
		||||
     (list (magit-completing-read "Resolve file" unmerged nil t nil nil
 | 
			
		||||
                                  (car (member current unmerged))))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (with-current-buffer (find-file-noselect file)
 | 
			
		||||
      (smerge-ediff)
 | 
			
		||||
      (setq-local
 | 
			
		||||
       ediff-quit-hook
 | 
			
		||||
       (lambda ()
 | 
			
		||||
         (let ((bufC ediff-buffer-C)
 | 
			
		||||
               (bufS smerge-ediff-buf))
 | 
			
		||||
           (with-current-buffer bufS
 | 
			
		||||
             (when (yes-or-no-p (format "Conflict resolution finished; save %s? "
 | 
			
		||||
                                        buffer-file-name))
 | 
			
		||||
               (erase-buffer)
 | 
			
		||||
               (insert-buffer-substring bufC)
 | 
			
		||||
               (save-buffer))))
 | 
			
		||||
         (when (buffer-live-p ediff-buffer-A) (kill-buffer ediff-buffer-A))
 | 
			
		||||
         (when (buffer-live-p ediff-buffer-B) (kill-buffer ediff-buffer-B))
 | 
			
		||||
         (when (buffer-live-p ediff-buffer-C) (kill-buffer ediff-buffer-C))
 | 
			
		||||
         (when (buffer-live-p ediff-ancestor-buffer)
 | 
			
		||||
           (kill-buffer ediff-ancestor-buffer))
 | 
			
		||||
         (let ((magit-ediff-previous-winconf smerge-ediff-windows))
 | 
			
		||||
           (run-hooks 'magit-ediff-quit-hook)))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-stage (file)
 | 
			
		||||
  "Stage and unstage changes to FILE using Ediff.
 | 
			
		||||
FILE has to be relative to the top directory of the repository."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (list (magit-completing-read "Selectively stage file"
 | 
			
		||||
                                (magit-tracked-files) nil nil nil nil
 | 
			
		||||
                                (magit-current-file))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (let* ((conf (current-window-configuration))
 | 
			
		||||
           (bufA (magit-get-revision-buffer "HEAD" file))
 | 
			
		||||
           (bufB (get-buffer (concat file ".~{index}~")))
 | 
			
		||||
           (bufBrw (and bufB (with-current-buffer bufB (not buffer-read-only))))
 | 
			
		||||
           (bufC (get-file-buffer file))
 | 
			
		||||
           (fileBufC (or bufC (find-file-noselect file)))
 | 
			
		||||
           (coding-system-for-read
 | 
			
		||||
            (with-current-buffer fileBufC buffer-file-coding-system)))
 | 
			
		||||
      (ediff-buffers3
 | 
			
		||||
       (or bufA (magit-find-file-noselect "HEAD" file))
 | 
			
		||||
       (with-current-buffer (magit-find-file-index-noselect file t)
 | 
			
		||||
         (setq buffer-read-only nil)
 | 
			
		||||
         (current-buffer))
 | 
			
		||||
       fileBufC
 | 
			
		||||
       `((lambda ()
 | 
			
		||||
           (setq-local
 | 
			
		||||
            ediff-quit-hook
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              (and (buffer-live-p ediff-buffer-B)
 | 
			
		||||
                   (buffer-modified-p ediff-buffer-B)
 | 
			
		||||
                   (with-current-buffer ediff-buffer-B
 | 
			
		||||
                     (magit-update-index)))
 | 
			
		||||
              (and (buffer-live-p ediff-buffer-C)
 | 
			
		||||
                   (buffer-modified-p ediff-buffer-C)
 | 
			
		||||
                   (with-current-buffer ediff-buffer-C
 | 
			
		||||
                     (when (y-or-n-p
 | 
			
		||||
                            (format "Save file %s? " buffer-file-name))
 | 
			
		||||
                       (save-buffer))))
 | 
			
		||||
              ,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
              ,@(if bufB
 | 
			
		||||
                    (unless bufBrw '((with-current-buffer ediff-buffer-B
 | 
			
		||||
                                       (setq buffer-read-only t))))
 | 
			
		||||
                  '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
              ,@(unless bufC '((ediff-kill-buffer-carefully ediff-buffer-C)))
 | 
			
		||||
              (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
                (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
       'ediff-buffers3))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-compare (revA revB fileA fileB)
 | 
			
		||||
  "Compare REVA:FILEA with REVB:FILEB using Ediff.
 | 
			
		||||
 | 
			
		||||
FILEA and FILEB have to be relative to the top directory of the
 | 
			
		||||
repository.  If REVA or REVB is nil, then this stands for the
 | 
			
		||||
working tree state.
 | 
			
		||||
 | 
			
		||||
If the region is active, use the revisions on the first and last
 | 
			
		||||
line of the region.  With a prefix argument, instead of diffing
 | 
			
		||||
the revisions, choose a revision to view changes along, starting
 | 
			
		||||
at the common ancestor of both revisions (i.e., use a \"...\"
 | 
			
		||||
range)."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (pcase-let ((`(,revA ,revB) (magit-ediff-compare--read-revisions
 | 
			
		||||
                                nil current-prefix-arg)))
 | 
			
		||||
     (nconc (list revA revB)
 | 
			
		||||
            (magit-ediff-read-files revA revB))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (let ((conf (current-window-configuration))
 | 
			
		||||
          (bufA (if revA
 | 
			
		||||
                    (magit-get-revision-buffer revA fileA)
 | 
			
		||||
                  (get-file-buffer fileA)))
 | 
			
		||||
          (bufB (if revB
 | 
			
		||||
                    (magit-get-revision-buffer revB fileB)
 | 
			
		||||
                  (get-file-buffer fileB))))
 | 
			
		||||
      (ediff-buffers
 | 
			
		||||
       (or bufA (if revA
 | 
			
		||||
                    (magit-find-file-noselect revA fileA)
 | 
			
		||||
                  (find-file-noselect fileA)))
 | 
			
		||||
       (or bufB (if revB
 | 
			
		||||
                    (magit-find-file-noselect revB fileB)
 | 
			
		||||
                  (find-file-noselect fileB)))
 | 
			
		||||
       `((lambda ()
 | 
			
		||||
           (setq-local
 | 
			
		||||
            ediff-quit-hook
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              ,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
              ,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
              (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
                (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
       'ediff-revision))))
 | 
			
		||||
 | 
			
		||||
(defun magit-ediff-compare--read-revisions (&optional arg mbase)
 | 
			
		||||
  (let ((input (or arg (magit-diff-read-range-or-commit
 | 
			
		||||
                        "Compare range or commit"
 | 
			
		||||
                        nil mbase))))
 | 
			
		||||
    (--if-let (magit-split-range input)
 | 
			
		||||
        (-cons-to-list it)
 | 
			
		||||
      (list input nil))))
 | 
			
		||||
 | 
			
		||||
(defun magit-ediff-read-files (revA revB &optional fileB)
 | 
			
		||||
  "Read file in REVB, return it and the corresponding file in REVA.
 | 
			
		||||
When FILEB is non-nil, use this as REVB's file instead of
 | 
			
		||||
prompting for it."
 | 
			
		||||
  (unless fileB
 | 
			
		||||
    (setq fileB (magit-read-file-choice
 | 
			
		||||
                 (format "File to compare between %s and %s"
 | 
			
		||||
                         revA (or revB "the working tree"))
 | 
			
		||||
                 (magit-changed-files revA revB)
 | 
			
		||||
                 (format "No changed files between %s and %s"
 | 
			
		||||
                         revA (or revB "the working tree")))))
 | 
			
		||||
  (list (or (car (member fileB (magit-revision-files revA)))
 | 
			
		||||
            (cdr (assoc fileB (magit-renamed-files revB revA)))
 | 
			
		||||
            (magit-read-file-choice
 | 
			
		||||
             (format "File in %s to compare with %s in %s"
 | 
			
		||||
                     revA fileB (or revB "the working tree"))
 | 
			
		||||
             (magit-changed-files revB revA)
 | 
			
		||||
             (format "No files have changed between %s and %s"
 | 
			
		||||
                     revA revB)))
 | 
			
		||||
        fileB))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-dwim ()
 | 
			
		||||
  "Compare, stage, or resolve using Ediff.
 | 
			
		||||
This command tries to guess what file, and what commit or range
 | 
			
		||||
the user wants to compare, stage, or resolve using Ediff.  It
 | 
			
		||||
might only be able to guess either the file, or range or commit,
 | 
			
		||||
in which case the user is asked about the other.  It might not
 | 
			
		||||
always guess right, in which case the appropriate `magit-ediff-*'
 | 
			
		||||
command has to be used explicitly.  If it cannot read the user's
 | 
			
		||||
mind at all, then it asks the user for a command to run."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-section-case
 | 
			
		||||
    (hunk (save-excursion
 | 
			
		||||
            (goto-char (oref (oref it parent) start))
 | 
			
		||||
            (magit-ediff-dwim)))
 | 
			
		||||
    (t
 | 
			
		||||
     (let ((range (magit-diff--dwim))
 | 
			
		||||
           (file (magit-current-file))
 | 
			
		||||
           command revA revB)
 | 
			
		||||
       (pcase range
 | 
			
		||||
         ((and (guard (not magit-ediff-dwim-show-on-hunks))
 | 
			
		||||
               (or `unstaged `staged))
 | 
			
		||||
          (setq command (if (magit-anything-unmerged-p)
 | 
			
		||||
                            #'magit-ediff-resolve
 | 
			
		||||
                          #'magit-ediff-stage)))
 | 
			
		||||
         (`unstaged (setq command #'magit-ediff-show-unstaged))
 | 
			
		||||
         (`staged (setq command #'magit-ediff-show-staged))
 | 
			
		||||
         (`(commit . ,value)
 | 
			
		||||
          (setq command #'magit-ediff-show-commit)
 | 
			
		||||
          (setq revB value))
 | 
			
		||||
         (`(stash . ,value)
 | 
			
		||||
          (setq command #'magit-ediff-show-stash)
 | 
			
		||||
          (setq revB value))
 | 
			
		||||
         ((pred stringp)
 | 
			
		||||
          (pcase-let ((`(,a ,b) (magit-ediff-compare--read-revisions range)))
 | 
			
		||||
            (setq command #'magit-ediff-compare)
 | 
			
		||||
            (setq revA a)
 | 
			
		||||
            (setq revB b)))
 | 
			
		||||
         (_
 | 
			
		||||
          (when (derived-mode-p 'magit-diff-mode)
 | 
			
		||||
            (pcase (magit-diff-type)
 | 
			
		||||
              (`committed (pcase-let ((`(,a ,b)
 | 
			
		||||
                                       (magit-ediff-compare--read-revisions
 | 
			
		||||
                                        (car magit-refresh-args))))
 | 
			
		||||
                            (setq revA a)
 | 
			
		||||
                            (setq revB b)))
 | 
			
		||||
              ((guard (not magit-ediff-dwim-show-on-hunks))
 | 
			
		||||
               (setq command #'magit-ediff-stage))
 | 
			
		||||
              (`unstaged  (setq command #'magit-ediff-show-unstaged))
 | 
			
		||||
              (`staged    (setq command #'magit-ediff-show-staged))
 | 
			
		||||
              (`undefined (setq command nil))
 | 
			
		||||
              (_          (setq command nil))))))
 | 
			
		||||
       (cond ((not command)
 | 
			
		||||
              (call-interactively
 | 
			
		||||
               (magit-read-char-case
 | 
			
		||||
                   "Failed to read your mind; do you want to " t
 | 
			
		||||
                 (?c "[c]ommit"  'magit-ediff-show-commit)
 | 
			
		||||
                 (?r "[r]ange"   'magit-ediff-compare)
 | 
			
		||||
                 (?s "[s]tage"   'magit-ediff-stage)
 | 
			
		||||
                 (?v "resol[v]e" 'magit-ediff-resolve))))
 | 
			
		||||
             ((eq command 'magit-ediff-compare)
 | 
			
		||||
              (apply 'magit-ediff-compare revA revB
 | 
			
		||||
                     (magit-ediff-read-files revA revB file)))
 | 
			
		||||
             ((eq command 'magit-ediff-show-commit)
 | 
			
		||||
              (magit-ediff-show-commit revB))
 | 
			
		||||
             ((eq command 'magit-ediff-show-stash)
 | 
			
		||||
              (magit-ediff-show-stash revB))
 | 
			
		||||
             (file
 | 
			
		||||
              (funcall command file))
 | 
			
		||||
             (t
 | 
			
		||||
              (call-interactively command)))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-show-staged (file)
 | 
			
		||||
  "Show staged changes using Ediff.
 | 
			
		||||
 | 
			
		||||
This only allows looking at the changes; to stage, unstage,
 | 
			
		||||
and discard changes using Ediff, use `magit-ediff-stage'.
 | 
			
		||||
 | 
			
		||||
FILE must be relative to the top directory of the repository."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (list (magit-read-file-choice "Show staged changes for file"
 | 
			
		||||
                                 (magit-staged-files)
 | 
			
		||||
                                 "No staged files")))
 | 
			
		||||
  (let ((conf (current-window-configuration))
 | 
			
		||||
        (bufA (magit-get-revision-buffer "HEAD" file))
 | 
			
		||||
        (bufB (get-buffer (concat file ".~{index}~"))))
 | 
			
		||||
    (ediff-buffers
 | 
			
		||||
     (or bufA (magit-find-file-noselect "HEAD" file))
 | 
			
		||||
     (or bufB (magit-find-file-index-noselect file t))
 | 
			
		||||
     `((lambda ()
 | 
			
		||||
         (setq-local
 | 
			
		||||
          ediff-quit-hook
 | 
			
		||||
          (lambda ()
 | 
			
		||||
            ,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
            ,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
            (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
              (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
     'ediff-buffers)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-show-unstaged (file)
 | 
			
		||||
  "Show unstaged changes using Ediff.
 | 
			
		||||
 | 
			
		||||
This only allows looking at the changes; to stage, unstage,
 | 
			
		||||
and discard changes using Ediff, use `magit-ediff-stage'.
 | 
			
		||||
 | 
			
		||||
FILE must be relative to the top directory of the repository."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (list (magit-read-file-choice "Show unstaged changes for file"
 | 
			
		||||
                                 (magit-unstaged-files)
 | 
			
		||||
                                 "No unstaged files")))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (let ((conf (current-window-configuration))
 | 
			
		||||
          (bufA (get-buffer (concat file ".~{index}~")))
 | 
			
		||||
          (bufB (get-file-buffer file)))
 | 
			
		||||
      (ediff-buffers
 | 
			
		||||
       (or bufA (magit-find-file-index-noselect file t))
 | 
			
		||||
       (or bufB (find-file-noselect file))
 | 
			
		||||
       `((lambda ()
 | 
			
		||||
           (setq-local
 | 
			
		||||
            ediff-quit-hook
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              ,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
              ,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
              (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
                (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
       'ediff-buffers))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-show-working-tree (file)
 | 
			
		||||
  "Show changes between `HEAD' and working tree using Ediff.
 | 
			
		||||
FILE must be relative to the top directory of the repository."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (list (magit-read-file-choice "Show changes in file"
 | 
			
		||||
                                 (magit-changed-files "HEAD")
 | 
			
		||||
                                 "No changed files")))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (let ((conf (current-window-configuration))
 | 
			
		||||
          (bufA (magit-get-revision-buffer "HEAD" file))
 | 
			
		||||
          (bufB (get-file-buffer file)))
 | 
			
		||||
      (ediff-buffers
 | 
			
		||||
       (or bufA (magit-find-file-noselect "HEAD" file))
 | 
			
		||||
       (or bufB (find-file-noselect file))
 | 
			
		||||
       `((lambda ()
 | 
			
		||||
           (setq-local
 | 
			
		||||
            ediff-quit-hook
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              ,@(unless bufA '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
              ,@(unless bufB '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
              (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
                (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
       'ediff-buffers))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-show-commit (commit)
 | 
			
		||||
  "Show changes introduced by COMMIT using Ediff."
 | 
			
		||||
  (interactive (list (magit-read-branch-or-commit "Revision")))
 | 
			
		||||
  (let ((revA (concat commit "^"))
 | 
			
		||||
        (revB commit))
 | 
			
		||||
    (apply #'magit-ediff-compare
 | 
			
		||||
           revA revB
 | 
			
		||||
           (magit-ediff-read-files revA revB (magit-current-file)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-ediff-show-stash (stash)
 | 
			
		||||
  "Show changes introduced by STASH using Ediff.
 | 
			
		||||
`magit-ediff-show-stash-with-index' controls whether a
 | 
			
		||||
three-buffer Ediff is used in order to distinguish changes in the
 | 
			
		||||
stash that were staged."
 | 
			
		||||
  (interactive (list (magit-read-stash "Stash")))
 | 
			
		||||
  (pcase-let* ((revA (concat stash "^1"))
 | 
			
		||||
               (revB (concat stash "^2"))
 | 
			
		||||
               (revC stash)
 | 
			
		||||
               (`(,fileA ,fileC) (magit-ediff-read-files revA revC))
 | 
			
		||||
               (fileB fileC))
 | 
			
		||||
    (if (and magit-ediff-show-stash-with-index
 | 
			
		||||
             (member fileA (magit-changed-files revB revA)))
 | 
			
		||||
        (let ((conf (current-window-configuration))
 | 
			
		||||
              (bufA (magit-get-revision-buffer revA fileA))
 | 
			
		||||
              (bufB (magit-get-revision-buffer revB fileB))
 | 
			
		||||
              (bufC (magit-get-revision-buffer revC fileC)))
 | 
			
		||||
          (ediff-buffers3
 | 
			
		||||
           (or bufA (magit-find-file-noselect revA fileA))
 | 
			
		||||
           (or bufB (magit-find-file-noselect revB fileB))
 | 
			
		||||
           (or bufC (magit-find-file-noselect revC fileC))
 | 
			
		||||
           `((lambda ()
 | 
			
		||||
               (setq-local
 | 
			
		||||
                ediff-quit-hook
 | 
			
		||||
                (lambda ()
 | 
			
		||||
                  ,@(unless bufA
 | 
			
		||||
                      '((ediff-kill-buffer-carefully ediff-buffer-A)))
 | 
			
		||||
                  ,@(unless bufB
 | 
			
		||||
                      '((ediff-kill-buffer-carefully ediff-buffer-B)))
 | 
			
		||||
                  ,@(unless bufC
 | 
			
		||||
                      '((ediff-kill-buffer-carefully ediff-buffer-C)))
 | 
			
		||||
                  (let ((magit-ediff-previous-winconf ,conf))
 | 
			
		||||
                    (run-hooks 'magit-ediff-quit-hook))))))
 | 
			
		||||
           'ediff-buffers3))
 | 
			
		||||
      (magit-ediff-compare revA revC fileA fileC))))
 | 
			
		||||
 | 
			
		||||
(defun magit-ediff-cleanup-auxiliary-buffers ()
 | 
			
		||||
  (let* ((ctl-buf ediff-control-buffer)
 | 
			
		||||
         (ctl-win (ediff-get-visible-buffer-window ctl-buf))
 | 
			
		||||
         (ctl-frm ediff-control-frame)
 | 
			
		||||
         (main-frame (cond ((window-live-p ediff-window-A)
 | 
			
		||||
                            (window-frame ediff-window-A))
 | 
			
		||||
                           ((window-live-p ediff-window-B)
 | 
			
		||||
                            (window-frame ediff-window-B)))))
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-diff-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-custom-diff-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-fine-diff-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-tmp-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-error-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-msg-buffer)
 | 
			
		||||
    (ediff-kill-buffer-carefully ediff-debug-buffer)
 | 
			
		||||
    (when (boundp 'ediff-patch-diagnostics)
 | 
			
		||||
      (ediff-kill-buffer-carefully ediff-patch-diagnostics))
 | 
			
		||||
    (cond ((and (ediff-window-display-p)
 | 
			
		||||
                (frame-live-p ctl-frm))
 | 
			
		||||
           (delete-frame ctl-frm))
 | 
			
		||||
          ((window-live-p ctl-win)
 | 
			
		||||
           (delete-window ctl-win)))
 | 
			
		||||
    (unless (ediff-multiframe-setup-p)
 | 
			
		||||
      (ediff-kill-bottom-toolbar))
 | 
			
		||||
    (ediff-kill-buffer-carefully ctl-buf)
 | 
			
		||||
    (when (frame-live-p main-frame)
 | 
			
		||||
      (select-frame main-frame))))
 | 
			
		||||
 | 
			
		||||
(defun magit-ediff-restore-previous-winconf ()
 | 
			
		||||
  (set-window-configuration magit-ediff-previous-winconf))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-ediff)
 | 
			
		||||
;;; magit-ediff.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,701 +0,0 @@
 | 
			
		||||
;;; magit-extras.el --- additional functionality for Magit  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2008-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Additional functionality for Magit.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
(declare-function dired-read-shell-command "dired-aux" (prompt arg files))
 | 
			
		||||
 | 
			
		||||
(defgroup magit-extras nil
 | 
			
		||||
  "Additional functionality for Magit."
 | 
			
		||||
  :group 'magit-extensions)
 | 
			
		||||
 | 
			
		||||
;;; External Tools
 | 
			
		||||
 | 
			
		||||
(defcustom magit-gitk-executable
 | 
			
		||||
  (or (and (eq system-type 'windows-nt)
 | 
			
		||||
           (let ((exe (magit-git-string
 | 
			
		||||
                       "-c" "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
 | 
			
		||||
                       "X" "gitk.exe")))
 | 
			
		||||
             (and exe (file-executable-p exe) exe)))
 | 
			
		||||
      (executable-find "gitk") "gitk")
 | 
			
		||||
  "The Gitk executable."
 | 
			
		||||
  :group 'magit-extras
 | 
			
		||||
  :set-after '(magit-git-executable)
 | 
			
		||||
  :type 'string)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-run-git-gui ()
 | 
			
		||||
  "Run `git gui' for the current git repository."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-process-file magit-git-executable nil 0 nil "gui")))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-run-git-gui-blame (commit filename &optional linenum)
 | 
			
		||||
  "Run `git gui blame' on the given FILENAME and COMMIT.
 | 
			
		||||
Interactively run it for the current file and the `HEAD', with a
 | 
			
		||||
prefix or when the current file cannot be determined let the user
 | 
			
		||||
choose.  When the current buffer is visiting FILENAME instruct
 | 
			
		||||
blame to center around the line point is on."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let (revision filename)
 | 
			
		||||
     (when (or current-prefix-arg
 | 
			
		||||
               (not (setq revision "HEAD"
 | 
			
		||||
                          filename (magit-file-relative-name nil 'tracked))))
 | 
			
		||||
       (setq revision (magit-read-branch-or-commit "Blame from revision"))
 | 
			
		||||
       (setq filename (magit-read-file-from-rev revision "Blame file")))
 | 
			
		||||
     (list revision filename
 | 
			
		||||
           (and (equal filename
 | 
			
		||||
                       (ignore-errors
 | 
			
		||||
                         (magit-file-relative-name buffer-file-name)))
 | 
			
		||||
                (line-number-at-pos)))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (apply #'magit-process-file magit-git-executable nil 0 nil "gui" "blame"
 | 
			
		||||
           `(,@(and linenum (list (format "--line=%d" linenum)))
 | 
			
		||||
             ,commit
 | 
			
		||||
             ,filename))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-run-gitk ()
 | 
			
		||||
  "Run `gitk' in the current repository."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-process-file magit-gitk-executable nil 0))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-run-gitk-branches ()
 | 
			
		||||
  "Run `gitk --branches' in the current repository."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-process-file magit-gitk-executable nil 0 nil "--branches"))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-run-gitk-all ()
 | 
			
		||||
  "Run `gitk --all' in the current repository."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-process-file magit-gitk-executable nil 0 nil "--all"))
 | 
			
		||||
 | 
			
		||||
;;; Emacs Tools
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun ido-enter-magit-status ()
 | 
			
		||||
  "Drop into `magit-status' from file switching.
 | 
			
		||||
 | 
			
		||||
To make this command available use something like:
 | 
			
		||||
 | 
			
		||||
  (add-hook \\='ido-setup-hook
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              (define-key ido-completion-map
 | 
			
		||||
                (kbd \"C-x g\") \\='ido-enter-magit-status)))
 | 
			
		||||
 | 
			
		||||
Starting with Emacs 25.1 the Ido keymaps are defined just once
 | 
			
		||||
instead of every time Ido is invoked, so now you can modify it
 | 
			
		||||
like pretty much every other keymap:
 | 
			
		||||
 | 
			
		||||
  (define-key ido-common-completion-map
 | 
			
		||||
    (kbd \"C-x g\") \\='ido-enter-magit-status)"
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (with-no-warnings ; FIXME these are internal variables
 | 
			
		||||
    (setq ido-exit 'fallback fallback 'magit-status))
 | 
			
		||||
  (exit-minibuffer))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-dired-jump (&optional other-window)
 | 
			
		||||
  "Visit file at point using Dired.
 | 
			
		||||
With a prefix argument, visit in another window.  If there
 | 
			
		||||
is no file at point, then instead visit `default-directory'."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (dired-jump other-window
 | 
			
		||||
              (when-let ((file (magit-file-at-point)))
 | 
			
		||||
                (expand-file-name (if (file-directory-p file)
 | 
			
		||||
                                      (file-name-as-directory file)
 | 
			
		||||
                                    file)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-dired-log (&optional follow)
 | 
			
		||||
  "Show log for all marked files, or the current file."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (if-let ((topdir (magit-toplevel default-directory)))
 | 
			
		||||
      (let ((args (car (magit-log-arguments)))
 | 
			
		||||
            (files (dired-get-marked-files nil nil #'magit-file-tracked-p)))
 | 
			
		||||
        (unless files
 | 
			
		||||
          (user-error "No marked file is being tracked by Git"))
 | 
			
		||||
        (when (and follow
 | 
			
		||||
                   (not (member "--follow" args))
 | 
			
		||||
                   (not (cdr files)))
 | 
			
		||||
          (push "--follow" args))
 | 
			
		||||
        (magit-mode-setup-internal
 | 
			
		||||
         #'magit-log-mode
 | 
			
		||||
         (list (list (or (magit-get-current-branch) "HEAD"))
 | 
			
		||||
               args
 | 
			
		||||
               (let ((default-directory topdir))
 | 
			
		||||
                 (mapcar #'file-relative-name files)))
 | 
			
		||||
         magit-log-buffer-file-locked))
 | 
			
		||||
    (magit--not-inside-repository-error)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-do-async-shell-command (file)
 | 
			
		||||
  "Open FILE with `dired-do-async-shell-command'.
 | 
			
		||||
Interactively, open the file at point."
 | 
			
		||||
  (interactive (list (or (magit-file-at-point)
 | 
			
		||||
                         (completing-read "Act on file: "
 | 
			
		||||
                                          (magit-list-files)))))
 | 
			
		||||
  (require 'dired-aux)
 | 
			
		||||
  (dired-do-async-shell-command
 | 
			
		||||
   (dired-read-shell-command "& on %s: " current-prefix-arg (list file))
 | 
			
		||||
   nil (list file)))
 | 
			
		||||
 | 
			
		||||
;;; Shift Selection
 | 
			
		||||
 | 
			
		||||
(defun magit--turn-on-shift-select-mode-p ()
 | 
			
		||||
  (and shift-select-mode
 | 
			
		||||
       this-command-keys-shift-translated
 | 
			
		||||
       (not mark-active)
 | 
			
		||||
       (not (eq (car-safe transient-mark-mode) 'only))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-previous-line (&optional arg try-vscroll)
 | 
			
		||||
  "Like `previous-line' but with Magit-specific shift-selection.
 | 
			
		||||
 | 
			
		||||
Magit's selection mechanism is based on the region but selects an
 | 
			
		||||
area that is larger than the region.  This causes `previous-line'
 | 
			
		||||
when invoked while holding the shift key to move up one line and
 | 
			
		||||
thereby select two lines.  When invoked inside a hunk body this
 | 
			
		||||
command does not move point on the first invocation and thereby
 | 
			
		||||
it only selects a single line.  Which inconsistency you prefer
 | 
			
		||||
is a matter of preference."
 | 
			
		||||
  (declare (interactive-only
 | 
			
		||||
            "use `forward-line' with negative argument instead."))
 | 
			
		||||
  (interactive "p\np")
 | 
			
		||||
  (unless arg (setq arg 1))
 | 
			
		||||
  (let ((stay (or (magit-diff-inside-hunk-body-p)
 | 
			
		||||
                  (magit-section-position-in-heading-p))))
 | 
			
		||||
    (if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
 | 
			
		||||
        (push-mark nil nil t)
 | 
			
		||||
      (with-no-warnings
 | 
			
		||||
        (handle-shift-selection)
 | 
			
		||||
        (previous-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-next-line (&optional arg try-vscroll)
 | 
			
		||||
  "Like `next-line' but with Magit-specific shift-selection.
 | 
			
		||||
 | 
			
		||||
Magit's selection mechanism is based on the region but selects
 | 
			
		||||
an area that is larger than the region.  This causes `next-line'
 | 
			
		||||
when invoked while holding the shift key to move down one line
 | 
			
		||||
and thereby select two lines.  When invoked inside a hunk body
 | 
			
		||||
this command does not move point on the first invocation and
 | 
			
		||||
thereby it only selects a single line.  Which inconsistency you
 | 
			
		||||
prefer is a matter of preference."
 | 
			
		||||
  (declare (interactive-only forward-line))
 | 
			
		||||
  (interactive "p\np")
 | 
			
		||||
  (unless arg (setq arg 1))
 | 
			
		||||
  (let ((stay (or (magit-diff-inside-hunk-body-p)
 | 
			
		||||
                  (magit-section-position-in-heading-p))))
 | 
			
		||||
    (if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
 | 
			
		||||
        (push-mark nil nil t)
 | 
			
		||||
      (with-no-warnings
 | 
			
		||||
        (handle-shift-selection)
 | 
			
		||||
        (next-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
 | 
			
		||||
 | 
			
		||||
;;; Clean
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-clean (&optional arg)
 | 
			
		||||
  "Remove untracked files from the working tree.
 | 
			
		||||
With a prefix argument also remove ignored files,
 | 
			
		||||
with two prefix arguments remove ignored files only.
 | 
			
		||||
\n(git clean -f -d [-x|-X])"
 | 
			
		||||
  (interactive "p")
 | 
			
		||||
  (when (yes-or-no-p (format "Remove %s files? "
 | 
			
		||||
                             (pcase arg
 | 
			
		||||
                               (1 "untracked")
 | 
			
		||||
                               (4 "untracked and ignored")
 | 
			
		||||
                               (_ "ignored"))))
 | 
			
		||||
    (magit-wip-commit-before-change)
 | 
			
		||||
    (magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
 | 
			
		||||
 | 
			
		||||
(put 'magit-clean 'disabled t)
 | 
			
		||||
 | 
			
		||||
;;; Gitignore
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-gitignore-popup "magit-extras" nil t)
 | 
			
		||||
(magit-define-popup magit-gitignore-popup
 | 
			
		||||
  "Popup console for gitignore commands."
 | 
			
		||||
  :man-page "gitignore"
 | 
			
		||||
  :actions '((?l "ignore locally"  magit-gitignore-locally)
 | 
			
		||||
             (?g "ignore globally" magit-gitignore))
 | 
			
		||||
  :max-action-columns 1)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-gitignore (file-or-pattern &optional local)
 | 
			
		||||
  "Instruct Git to ignore FILE-OR-PATTERN.
 | 
			
		||||
With a prefix argument only ignore locally."
 | 
			
		||||
  (interactive (list (magit-gitignore-read-pattern current-prefix-arg)
 | 
			
		||||
                     current-prefix-arg))
 | 
			
		||||
  (let ((gitignore
 | 
			
		||||
         (if local
 | 
			
		||||
             (magit-git-dir (convert-standard-filename "info/exclude"))
 | 
			
		||||
           (expand-file-name ".gitignore" (magit-toplevel)))))
 | 
			
		||||
    (make-directory (file-name-directory gitignore) t)
 | 
			
		||||
    (with-temp-buffer
 | 
			
		||||
      (when (file-exists-p gitignore)
 | 
			
		||||
        (insert-file-contents gitignore))
 | 
			
		||||
      (goto-char (point-max))
 | 
			
		||||
      (unless (bolp)
 | 
			
		||||
        (insert "\n"))
 | 
			
		||||
      (insert (replace-regexp-in-string "\\(\\\\*\\)" "\\1\\1" file-or-pattern))
 | 
			
		||||
      (insert "\n")
 | 
			
		||||
      (write-region nil nil gitignore))
 | 
			
		||||
    (if local
 | 
			
		||||
        (magit-refresh)
 | 
			
		||||
      (magit-run-git "add" ".gitignore"))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-gitignore-locally (file-or-pattern)
 | 
			
		||||
  "Instruct Git to locally ignore FILE-OR-PATTERN."
 | 
			
		||||
  (interactive (list (magit-gitignore-read-pattern t)))
 | 
			
		||||
  (magit-gitignore file-or-pattern t))
 | 
			
		||||
 | 
			
		||||
(defun magit-gitignore-read-pattern (local)
 | 
			
		||||
  (let* ((default (magit-current-file))
 | 
			
		||||
         (choices
 | 
			
		||||
          (delete-dups
 | 
			
		||||
           (--mapcat
 | 
			
		||||
            (cons (concat "/" it)
 | 
			
		||||
                  (when-let ((ext (file-name-extension it)))
 | 
			
		||||
                    (list (concat "/" (file-name-directory "foo") "*." ext)
 | 
			
		||||
                          (concat "*." ext))))
 | 
			
		||||
            (magit-untracked-files)))))
 | 
			
		||||
    (when default
 | 
			
		||||
      (setq default (concat "/" default))
 | 
			
		||||
      (unless (member default choices)
 | 
			
		||||
        (setq default (concat "*." (file-name-extension default)))
 | 
			
		||||
        (unless (member default choices)
 | 
			
		||||
          (setq default nil))))
 | 
			
		||||
    (magit-completing-read (concat "File or pattern to ignore"
 | 
			
		||||
                                   (and local " locally"))
 | 
			
		||||
                           choices nil nil nil nil default)))
 | 
			
		||||
 | 
			
		||||
;;; ChangeLog
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-add-change-log-entry (&optional whoami file-name other-window)
 | 
			
		||||
  "Find change log file and add date entry and item for current change.
 | 
			
		||||
This differs from `add-change-log-entry' (which see) in that
 | 
			
		||||
it acts on the current hunk in a Magit buffer instead of on
 | 
			
		||||
a position in a file-visiting buffer."
 | 
			
		||||
  (interactive (list current-prefix-arg
 | 
			
		||||
                     (prompt-for-change-log-name)))
 | 
			
		||||
  (let (buf pos)
 | 
			
		||||
    (save-window-excursion
 | 
			
		||||
      (call-interactively #'magit-diff-visit-file)
 | 
			
		||||
      (setq buf (current-buffer))
 | 
			
		||||
      (setq pos (point)))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (with-current-buffer buf
 | 
			
		||||
        (goto-char pos)
 | 
			
		||||
        (add-change-log-entry whoami file-name other-window)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-add-change-log-entry-other-window (&optional whoami file-name)
 | 
			
		||||
  "Find change log file in other window and add entry and item.
 | 
			
		||||
This differs from `add-change-log-entry-other-window' (which see)
 | 
			
		||||
in that it acts on the current hunk in a Magit buffer instead of
 | 
			
		||||
on a position in a file-visiting buffer."
 | 
			
		||||
  (interactive (and current-prefix-arg
 | 
			
		||||
                    (list current-prefix-arg
 | 
			
		||||
                          (prompt-for-change-log-name))))
 | 
			
		||||
  (magit-add-change-log-entry whoami file-name t))
 | 
			
		||||
 | 
			
		||||
;;; Edit Line Commit
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-edit-line-commit (&optional type)
 | 
			
		||||
  "Edit the commit that added the current line.
 | 
			
		||||
 | 
			
		||||
With a prefix argument edit the commit that removes the line,
 | 
			
		||||
if any.  The commit is determined using `git blame' and made
 | 
			
		||||
editable using `git rebase --interactive' if it is reachable
 | 
			
		||||
from `HEAD', or by checking out the commit (or a branch that
 | 
			
		||||
points at it) otherwise."
 | 
			
		||||
  (interactive (list (and current-prefix-arg 'removal)))
 | 
			
		||||
  (let* ((chunk (magit-current-blame-chunk (or type 'addition)))
 | 
			
		||||
         (rev   (oref chunk orig-rev)))
 | 
			
		||||
    (if (equal rev "0000000000000000000000000000000000000000")
 | 
			
		||||
        (message "This line has not been committed yet")
 | 
			
		||||
      (let ((rebase (magit-rev-ancestor-p rev "HEAD"))
 | 
			
		||||
            (file   (expand-file-name (oref chunk orig-file)
 | 
			
		||||
                                      (magit-toplevel))))
 | 
			
		||||
        (if rebase
 | 
			
		||||
            (let ((magit--rebase-published-symbol 'edit-published))
 | 
			
		||||
              (magit-rebase-edit-commit rev (magit-rebase-arguments)))
 | 
			
		||||
          (magit-checkout (or (magit-rev-branch rev) rev)))
 | 
			
		||||
        (unless (and buffer-file-name
 | 
			
		||||
                     (file-equal-p file buffer-file-name))
 | 
			
		||||
          (let ((blame-type (and magit-blame-mode magit-blame-type)))
 | 
			
		||||
            (if rebase
 | 
			
		||||
                (set-process-sentinel
 | 
			
		||||
                 magit-this-process
 | 
			
		||||
                 (lambda (process event)
 | 
			
		||||
                   (magit-sequencer-process-sentinel process event)
 | 
			
		||||
                   (when (eq (process-status process) 'exit)
 | 
			
		||||
                     (find-file file)
 | 
			
		||||
                     (when blame-type
 | 
			
		||||
                       (magit-blame--pre-blame-setup blame-type)
 | 
			
		||||
                       (magit-blame--run)))))
 | 
			
		||||
              (find-file file)
 | 
			
		||||
              (when blame-type
 | 
			
		||||
                (magit-blame--pre-blame-setup blame-type)
 | 
			
		||||
                (magit-blame--run)))))))))
 | 
			
		||||
 | 
			
		||||
(put 'magit-edit-line-commit 'disabled t)
 | 
			
		||||
 | 
			
		||||
(defun magit-diff-edit-hunk-commit ()
 | 
			
		||||
  "From a hunk, edit the respective commit and visit the file.
 | 
			
		||||
 | 
			
		||||
First visit the file being modified by the hunk at the correct
 | 
			
		||||
location using `magit-diff-visit-file'.  This actually visits a
 | 
			
		||||
blob.  When point is on a diff header, not within an individual
 | 
			
		||||
hunk, then this visits the blob the first hunk is about.
 | 
			
		||||
 | 
			
		||||
Then invoke `magit-edit-line-commit', which uses an interactive
 | 
			
		||||
rebase to make the commit editable, or if that is not possible
 | 
			
		||||
because the commit is not reachable from `HEAD' by checking out
 | 
			
		||||
that commit directly.  This also causes the actual worktree file
 | 
			
		||||
to be visited.
 | 
			
		||||
 | 
			
		||||
Neither the blob nor the file buffer are killed when finishing
 | 
			
		||||
the rebase.  If that is undesirable, then it might be better to
 | 
			
		||||
use `magit-rebase-edit-command' instead of this command."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((magit-diff-visit-previous-blob nil))
 | 
			
		||||
    (magit-diff-visit-file (--if-let (magit-file-at-point)
 | 
			
		||||
                               (expand-file-name it)
 | 
			
		||||
                             (user-error "No file at point"))
 | 
			
		||||
                           nil 'switch-to-buffer))
 | 
			
		||||
  (magit-edit-line-commit))
 | 
			
		||||
 | 
			
		||||
(put 'magit-diff-edit-hunk-commit 'disabled t)
 | 
			
		||||
 | 
			
		||||
;;; Reshelve
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-reshelve-since (rev)
 | 
			
		||||
  "Change the author and committer dates of the commits since REV.
 | 
			
		||||
 | 
			
		||||
Ask the user for the first reachable commit whose dates should
 | 
			
		||||
be changed.  The read the new date for that commit.  The initial
 | 
			
		||||
minibuffer input and the previous history element offer good
 | 
			
		||||
values.  The next commit will be created one minute later and so
 | 
			
		||||
on.
 | 
			
		||||
 | 
			
		||||
This command is only intended for interactive use and should only
 | 
			
		||||
be used on highly rearranged and unpublished history."
 | 
			
		||||
  (interactive (list nil))
 | 
			
		||||
  (cond
 | 
			
		||||
   ((not rev)
 | 
			
		||||
    (let ((backup (concat "refs/original/refs/heads/"
 | 
			
		||||
                          (magit-get-current-branch))))
 | 
			
		||||
      (when (and (magit-ref-p backup)
 | 
			
		||||
                 (not (magit-y-or-n-p
 | 
			
		||||
                       "Backup ref %s already exists.  Override? " backup)))
 | 
			
		||||
        (user-error "Abort")))
 | 
			
		||||
    (magit-log-select 'magit-reshelve-since
 | 
			
		||||
      "Type %p on a commit to reshelve it and the commits above it,"))
 | 
			
		||||
   (t
 | 
			
		||||
    (cl-flet ((adjust (time offset)
 | 
			
		||||
                      (format-time-string
 | 
			
		||||
                       "%F %T %z"
 | 
			
		||||
                       (+ (floor time)
 | 
			
		||||
                          (* offset 60)
 | 
			
		||||
                          (- (car (decode-time time)))))))
 | 
			
		||||
      (let* ((start (concat rev "^"))
 | 
			
		||||
             (range (concat start ".." (magit-get-current-branch)))
 | 
			
		||||
             (time-rev (adjust (float-time (string-to-number
 | 
			
		||||
                                            (magit-rev-format "%at" start)))
 | 
			
		||||
                               1))
 | 
			
		||||
             (time-now (adjust (float-time)
 | 
			
		||||
                               (- (string-to-number
 | 
			
		||||
                                   (magit-git-string "rev-list" "--count"
 | 
			
		||||
                                                     range))))))
 | 
			
		||||
        (push time-rev magit--reshelve-history)
 | 
			
		||||
        (let ((date (floor
 | 
			
		||||
                     (float-time
 | 
			
		||||
                      (date-to-time
 | 
			
		||||
                       (read-string "Date for first commit: "
 | 
			
		||||
                                    time-now 'magit--reshelve-history))))))
 | 
			
		||||
          (magit-with-toplevel
 | 
			
		||||
            (magit-run-git-async
 | 
			
		||||
             "filter-branch" "--force" "--env-filter"
 | 
			
		||||
             (format "case $GIT_COMMIT in %s\nesac"
 | 
			
		||||
                     (mapconcat (lambda (rev)
 | 
			
		||||
                                  (prog1 (format "%s) \
 | 
			
		||||
export GIT_AUTHOR_DATE=\"%s\"; \
 | 
			
		||||
export GIT_COMMITTER_DATE=\"%s\";;" rev date date)
 | 
			
		||||
                                    (cl-incf date 60)))
 | 
			
		||||
                                (magit-git-lines "rev-list" "--reverse"
 | 
			
		||||
                                                 range)
 | 
			
		||||
                                " "))
 | 
			
		||||
             range "--")
 | 
			
		||||
            (set-process-sentinel
 | 
			
		||||
             magit-this-process
 | 
			
		||||
             (lambda (process event)
 | 
			
		||||
               (when (memq (process-status process) '(exit signal))
 | 
			
		||||
                 (if (> (process-exit-status process) 0)
 | 
			
		||||
                     (magit-process-sentinel process event)
 | 
			
		||||
                   (process-put process 'inhibit-refresh t)
 | 
			
		||||
                   (magit-process-sentinel process event)
 | 
			
		||||
                   (magit-run-git "update-ref" "-d"
 | 
			
		||||
                                  (concat "refs/original/refs/heads/"
 | 
			
		||||
                                          (magit-get-current-branch))))))))))))))
 | 
			
		||||
 | 
			
		||||
;;; Revision Stack
 | 
			
		||||
 | 
			
		||||
(defvar magit-revision-stack nil)
 | 
			
		||||
 | 
			
		||||
(defcustom magit-pop-revision-stack-format
 | 
			
		||||
  '("[%N: %h] " "%N: %H\n   %s\n" "\\[\\([0-9]+\\)[]:]")
 | 
			
		||||
  "Control how `magit-pop-revision-stack' inserts a revision.
 | 
			
		||||
 | 
			
		||||
The command `magit-pop-revision-stack' inserts a representation
 | 
			
		||||
of the revision last pushed to the `magit-revision-stack' into
 | 
			
		||||
the current buffer.  It inserts text at point and/or near the end
 | 
			
		||||
of the buffer, and removes the consumed revision from the stack.
 | 
			
		||||
 | 
			
		||||
The entries on the stack have the format (HASH TOPLEVEL) and this
 | 
			
		||||
option has the format (POINT-FORMAT EOB-FORMAT INDEX-REGEXP), all
 | 
			
		||||
of which may be nil or a string (though either one of EOB-FORMAT
 | 
			
		||||
or POINT-FORMAT should be a string, and if INDEX-REGEXP is
 | 
			
		||||
non-nil, then the two formats should be too).
 | 
			
		||||
 | 
			
		||||
First INDEX-REGEXP is used to find the previously inserted entry,
 | 
			
		||||
by searching backward from point.  The first submatch must match
 | 
			
		||||
the index number.  That number is incremented by one, and becomes
 | 
			
		||||
the index number of the entry to be inserted.  If you don't want
 | 
			
		||||
to number the inserted revisions, then use nil for INDEX-REGEXP.
 | 
			
		||||
 | 
			
		||||
If INDEX-REGEXP is non-nil, then both POINT-FORMAT and EOB-FORMAT
 | 
			
		||||
should contain \"%N\", which is replaced with the number that was
 | 
			
		||||
determined in the previous step.
 | 
			
		||||
 | 
			
		||||
Both formats, if non-nil and after removing %N, are then expanded
 | 
			
		||||
using `git show --format=FORMAT ...' inside TOPLEVEL.
 | 
			
		||||
 | 
			
		||||
The expansion of POINT-FORMAT is inserted at point, and the
 | 
			
		||||
expansion of EOB-FORMAT is inserted at the end of the buffer (if
 | 
			
		||||
the buffer ends with a comment, then it is inserted right before
 | 
			
		||||
that)."
 | 
			
		||||
  :package-version '(magit . "2.3.0")
 | 
			
		||||
  :group 'magit-commands
 | 
			
		||||
  :type '(list (choice (string :tag "Insert at point format")
 | 
			
		||||
                       (cons (string :tag "Insert at point format")
 | 
			
		||||
                             (repeat (string :tag "Argument to git show")))
 | 
			
		||||
                       (const :tag "Don't insert at point" nil))
 | 
			
		||||
               (choice (string :tag "Insert at eob format")
 | 
			
		||||
                       (cons (string :tag "Insert at eob format")
 | 
			
		||||
                             (repeat (string :tag "Argument to git show")))
 | 
			
		||||
                       (const :tag "Don't insert at eob" nil))
 | 
			
		||||
               (choice (regexp :tag "Find index regexp")
 | 
			
		||||
                       (const :tag "Don't number entries" nil))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-pop-revision-stack (rev toplevel)
 | 
			
		||||
  "Insert a representation of a revision into the current buffer.
 | 
			
		||||
 | 
			
		||||
Pop a revision from the `magit-revision-stack' and insert it into
 | 
			
		||||
the current buffer according to `magit-pop-revision-stack-format'.
 | 
			
		||||
Revisions can be put on the stack using `magit-copy-section-value'
 | 
			
		||||
and `magit-copy-buffer-revision'.
 | 
			
		||||
 | 
			
		||||
If the stack is empty or with a prefix argument, instead read a
 | 
			
		||||
revision in the minibuffer.  By using the minibuffer history this
 | 
			
		||||
allows selecting an item which was popped earlier or to insert an
 | 
			
		||||
arbitrary reference or revision without first pushing it onto the
 | 
			
		||||
stack.
 | 
			
		||||
 | 
			
		||||
When reading the revision from the minibuffer, then it might not
 | 
			
		||||
be possible to guess the correct repository.  When this command
 | 
			
		||||
is called inside a repository (e.g. while composing a commit
 | 
			
		||||
message), then that repository is used.  Otherwise (e.g. while
 | 
			
		||||
composing an email) then the repository recorded for the top
 | 
			
		||||
element of the stack is used (even though we insert another
 | 
			
		||||
revision).  If not called inside a repository and with an empty
 | 
			
		||||
stack, or with two prefix arguments, then read the repository in
 | 
			
		||||
the minibuffer too."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (if (or current-prefix-arg (not magit-revision-stack))
 | 
			
		||||
       (let ((default-directory
 | 
			
		||||
               (or (and (not (= (prefix-numeric-value current-prefix-arg) 16))
 | 
			
		||||
                        (or (magit-toplevel)
 | 
			
		||||
                            (cadr (car magit-revision-stack))))
 | 
			
		||||
                   (magit-read-repository))))
 | 
			
		||||
         (list (magit-read-branch-or-commit "Insert revision")
 | 
			
		||||
               default-directory))
 | 
			
		||||
     (push (caar magit-revision-stack) magit-revision-history)
 | 
			
		||||
     (pop magit-revision-stack)))
 | 
			
		||||
  (if rev
 | 
			
		||||
      (pcase-let ((`(,pnt-format ,eob-format ,idx-format)
 | 
			
		||||
                   magit-pop-revision-stack-format))
 | 
			
		||||
        (let ((default-directory toplevel)
 | 
			
		||||
              (idx (and idx-format
 | 
			
		||||
                        (save-excursion
 | 
			
		||||
                          (if (re-search-backward idx-format nil t)
 | 
			
		||||
                              (number-to-string
 | 
			
		||||
                               (1+ (string-to-number (match-string 1))))
 | 
			
		||||
                            "1"))))
 | 
			
		||||
              pnt-args eob-args)
 | 
			
		||||
          (when (listp pnt-format)
 | 
			
		||||
            (setq pnt-args (cdr pnt-format))
 | 
			
		||||
            (setq pnt-format (car pnt-format)))
 | 
			
		||||
          (when (listp eob-format)
 | 
			
		||||
            (setq eob-args (cdr eob-format))
 | 
			
		||||
            (setq eob-format (car eob-format)))
 | 
			
		||||
          (when pnt-format
 | 
			
		||||
            (when idx-format
 | 
			
		||||
              (setq pnt-format
 | 
			
		||||
                    (replace-regexp-in-string "%N" idx pnt-format t t)))
 | 
			
		||||
            (magit-rev-insert-format pnt-format rev pnt-args)
 | 
			
		||||
            (backward-delete-char 1))
 | 
			
		||||
          (when eob-format
 | 
			
		||||
            (when idx-format
 | 
			
		||||
              (setq eob-format
 | 
			
		||||
                    (replace-regexp-in-string "%N" idx eob-format t t)))
 | 
			
		||||
            (save-excursion
 | 
			
		||||
              (goto-char (point-max))
 | 
			
		||||
              (skip-syntax-backward ">s-")
 | 
			
		||||
              (beginning-of-line)
 | 
			
		||||
              (if (and comment-start (looking-at comment-start))
 | 
			
		||||
                  (while (looking-at comment-start)
 | 
			
		||||
                    (forward-line -1))
 | 
			
		||||
                (forward-line)
 | 
			
		||||
                (unless (= (current-column) 0)
 | 
			
		||||
                  (insert ?\n)))
 | 
			
		||||
              (insert ?\n)
 | 
			
		||||
              (magit-rev-insert-format eob-format rev eob-args)
 | 
			
		||||
              (backward-delete-char 1)))))
 | 
			
		||||
    (user-error "Revision stack is empty")))
 | 
			
		||||
 | 
			
		||||
(define-key git-commit-mode-map
 | 
			
		||||
  (kbd "C-c C-w") 'magit-pop-revision-stack)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-copy-section-value ()
 | 
			
		||||
  "Save the value of the current section for later use.
 | 
			
		||||
 | 
			
		||||
Save the section value to the `kill-ring', and, provided that
 | 
			
		||||
the current section is a commit, branch, or tag section, push
 | 
			
		||||
the (referenced) revision to the `magit-revision-stack' for use
 | 
			
		||||
with `magit-pop-revision-stack'.
 | 
			
		||||
 | 
			
		||||
When the current section is a branch or a tag, and a prefix
 | 
			
		||||
argument is used, then save the revision at its tip to the
 | 
			
		||||
`kill-ring' instead of the reference name.
 | 
			
		||||
 | 
			
		||||
When the region is active, then save that to the `kill-ring',
 | 
			
		||||
like `kill-ring-save' would, instead of behaving as described
 | 
			
		||||
above."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if (use-region-p)
 | 
			
		||||
      (copy-region-as-kill nil nil 'region)
 | 
			
		||||
    (when-let ((section (magit-current-section))
 | 
			
		||||
               (value (oref section value)))
 | 
			
		||||
      (magit-section-case
 | 
			
		||||
        ((branch commit module-commit tag)
 | 
			
		||||
         (let ((default-directory default-directory) ref)
 | 
			
		||||
           (magit-section-case
 | 
			
		||||
             ((branch tag)
 | 
			
		||||
              (setq ref value))
 | 
			
		||||
             (module-commit
 | 
			
		||||
              (setq default-directory
 | 
			
		||||
                    (file-name-as-directory
 | 
			
		||||
                     (expand-file-name (magit-section-parent-value section)
 | 
			
		||||
                                       (magit-toplevel))))))
 | 
			
		||||
           (setq value (magit-rev-parse value))
 | 
			
		||||
           (push (list value default-directory) magit-revision-stack)
 | 
			
		||||
           (kill-new (message "%s" (or (and current-prefix-arg ref)
 | 
			
		||||
                                       value)))))
 | 
			
		||||
        (t (kill-new (message "%s" value)))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-copy-buffer-revision ()
 | 
			
		||||
  "Save the revision of the current buffer for later use.
 | 
			
		||||
 | 
			
		||||
Save the revision shown in the current buffer to the `kill-ring'
 | 
			
		||||
and push it to the `magit-revision-stack'.
 | 
			
		||||
 | 
			
		||||
This command is mainly intended for use in `magit-revision-mode'
 | 
			
		||||
buffers, the only buffers where it is always unambiguous exactly
 | 
			
		||||
which revision should be saved.
 | 
			
		||||
 | 
			
		||||
Most other Magit buffers usually show more than one revision, in
 | 
			
		||||
some way or another, so this command has to select one of them,
 | 
			
		||||
and that choice might not always be the one you think would have
 | 
			
		||||
been the best pick.
 | 
			
		||||
 | 
			
		||||
In such buffers it is often more useful to save the value of
 | 
			
		||||
the current section instead, using `magit-copy-section-value'.
 | 
			
		||||
 | 
			
		||||
When the region is active, then save that to the `kill-ring',
 | 
			
		||||
like `kill-ring-save' would, instead of behaving as described
 | 
			
		||||
above."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if (use-region-p)
 | 
			
		||||
      (copy-region-as-kill nil nil 'region)
 | 
			
		||||
    (when-let ((rev (cond ((memq major-mode '(magit-cherry-mode
 | 
			
		||||
                                              magit-log-select-mode
 | 
			
		||||
                                              magit-reflog-mode
 | 
			
		||||
                                              magit-refs-mode
 | 
			
		||||
                                              magit-revision-mode
 | 
			
		||||
                                              magit-stash-mode
 | 
			
		||||
                                              magit-stashes-mode))
 | 
			
		||||
                           (car magit-refresh-args))
 | 
			
		||||
                          ((memq major-mode '(magit-diff-mode
 | 
			
		||||
                                              magit-log-mode))
 | 
			
		||||
                           (let ((r (caar magit-refresh-args)))
 | 
			
		||||
                             (if (string-match "\\.\\.\\.?\\(.+\\)" r)
 | 
			
		||||
                                 (match-string 1 r)
 | 
			
		||||
                               r)))
 | 
			
		||||
                          ((eq major-mode 'magit-status-mode) "HEAD"))))
 | 
			
		||||
      (when (magit-rev-verify-commit rev)
 | 
			
		||||
        (setq rev (magit-rev-parse rev))
 | 
			
		||||
        (push (list rev default-directory) magit-revision-stack)
 | 
			
		||||
        (kill-new (message "%s" rev))))))
 | 
			
		||||
 | 
			
		||||
;;; Miscellaneous
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-abort-dwim ()
 | 
			
		||||
  "Abort current operation.
 | 
			
		||||
Depending on the context, this will abort a merge, a rebase, a
 | 
			
		||||
patch application, a cherry-pick, a revert, or a bisect."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (cond ((magit-merge-in-progress-p)     (magit-merge-abort))
 | 
			
		||||
        ((magit-rebase-in-progress-p)    (magit-rebase-abort))
 | 
			
		||||
        ((magit-am-in-progress-p)        (magit-am-abort))
 | 
			
		||||
        ((magit-sequencer-in-progress-p) (magit-sequencer-abort))
 | 
			
		||||
        ((magit-bisect-in-progress-p)    (magit-bisect-reset))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-extras)
 | 
			
		||||
;;; magit-extras.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,563 +0,0 @@
 | 
			
		||||
;;; magit-files.el --- finding files  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements support for finding blobs, staged files,
 | 
			
		||||
;; and Git configuration files.  It also implements modes useful in
 | 
			
		||||
;; buffers visiting files and blobs, and the commands used by those
 | 
			
		||||
;; modes.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
;;; Find Blob
 | 
			
		||||
 | 
			
		||||
(defvar magit-find-file-hook nil)
 | 
			
		||||
(add-hook 'magit-find-file-hook #'magit-blob-mode)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-find-file (rev file)
 | 
			
		||||
  "View FILE from REV.
 | 
			
		||||
Switch to a buffer visiting blob REV:FILE,
 | 
			
		||||
creating one if none already exists."
 | 
			
		||||
  (interactive (magit-find-file-read-args "Find file"))
 | 
			
		||||
  (switch-to-buffer (magit-find-file-noselect rev file)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-find-file-other-window (rev file)
 | 
			
		||||
  "View FILE from REV, in another window.
 | 
			
		||||
Like `magit-find-file', but create a new window or reuse an
 | 
			
		||||
existing one."
 | 
			
		||||
  (interactive (magit-find-file-read-args "Find file in other window"))
 | 
			
		||||
  (switch-to-buffer-other-window (magit-find-file-noselect rev file)))
 | 
			
		||||
 | 
			
		||||
(defun magit-find-file-read-args (prompt)
 | 
			
		||||
  (let  ((rev (magit-read-branch-or-commit "Find file from revision")))
 | 
			
		||||
    (list rev (magit-read-file-from-rev rev prompt))))
 | 
			
		||||
 | 
			
		||||
(defun magit-find-file-noselect (rev file)
 | 
			
		||||
  "Read FILE from REV into a buffer and return the buffer.
 | 
			
		||||
FILE must be relative to the top directory of the repository."
 | 
			
		||||
  (magit-find-file-noselect-1 rev file 'magit-find-file-hook))
 | 
			
		||||
 | 
			
		||||
(defun magit-find-file-noselect-1 (rev file hookvar &optional revert)
 | 
			
		||||
  "Read FILE from REV into a buffer and return the buffer.
 | 
			
		||||
FILE must be relative to the top directory of the repository.
 | 
			
		||||
An empty REV stands for index."
 | 
			
		||||
  (let ((topdir (magit-toplevel)))
 | 
			
		||||
    (when (file-name-absolute-p file)
 | 
			
		||||
      (setq file (file-relative-name file topdir)))
 | 
			
		||||
    (with-current-buffer (magit-get-revision-buffer-create rev file)
 | 
			
		||||
      (when (or (not magit-buffer-file-name)
 | 
			
		||||
                (if (eq revert 'ask-revert)
 | 
			
		||||
                    (y-or-n-p (format "%s already exists; revert it? "
 | 
			
		||||
                                      (buffer-name))))
 | 
			
		||||
                revert)
 | 
			
		||||
        (setq magit-buffer-revision
 | 
			
		||||
              (if (string= rev "") "{index}" (magit-rev-format "%H" rev)))
 | 
			
		||||
        (setq magit-buffer-refname rev)
 | 
			
		||||
        (setq magit-buffer-file-name (expand-file-name file topdir))
 | 
			
		||||
        (setq default-directory
 | 
			
		||||
              (let ((dir (file-name-directory magit-buffer-file-name)))
 | 
			
		||||
                (if (file-exists-p dir) dir topdir)))
 | 
			
		||||
        (setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
 | 
			
		||||
        (revert-buffer t t)
 | 
			
		||||
        (run-hooks hookvar))
 | 
			
		||||
      (current-buffer))))
 | 
			
		||||
 | 
			
		||||
(defun magit-get-revision-buffer-create (rev file)
 | 
			
		||||
  (magit-get-revision-buffer rev file t))
 | 
			
		||||
 | 
			
		||||
(defun magit-get-revision-buffer (rev file &optional create)
 | 
			
		||||
  (funcall (if create 'get-buffer-create 'get-buffer)
 | 
			
		||||
           (format "%s.~%s~" file (if (equal rev "") "index"
 | 
			
		||||
                                    (subst-char-in-string ?/ ?_ rev)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-revert-rev-file-buffer (_ignore-auto noconfirm)
 | 
			
		||||
  (when (or noconfirm
 | 
			
		||||
            (and (not (buffer-modified-p))
 | 
			
		||||
                 (catch 'found
 | 
			
		||||
                   (dolist (regexp revert-without-query)
 | 
			
		||||
                     (when (string-match regexp magit-buffer-file-name)
 | 
			
		||||
                       (throw 'found t)))))
 | 
			
		||||
            (yes-or-no-p (format "Revert buffer from git %s? "
 | 
			
		||||
                                 (if (equal magit-buffer-refname "") "{index}"
 | 
			
		||||
                                   (concat "revision " magit-buffer-refname)))))
 | 
			
		||||
    (let* ((inhibit-read-only t)
 | 
			
		||||
           (default-directory (magit-toplevel))
 | 
			
		||||
           (file (file-relative-name magit-buffer-file-name))
 | 
			
		||||
           (coding-system-for-read (or coding-system-for-read 'undecided)))
 | 
			
		||||
      (erase-buffer)
 | 
			
		||||
      (magit-git-insert "cat-file" "-p" (concat magit-buffer-refname ":" file))
 | 
			
		||||
      (setq buffer-file-coding-system last-coding-system-used))
 | 
			
		||||
    (let ((buffer-file-name magit-buffer-file-name)
 | 
			
		||||
          (after-change-major-mode-hook
 | 
			
		||||
           (remq 'global-diff-hl-mode-enable-in-buffers
 | 
			
		||||
                 after-change-major-mode-hook)))
 | 
			
		||||
      (normal-mode t))
 | 
			
		||||
    (setq buffer-read-only t)
 | 
			
		||||
    (set-buffer-modified-p nil)
 | 
			
		||||
    (goto-char (point-min))))
 | 
			
		||||
 | 
			
		||||
;;; Find Index
 | 
			
		||||
 | 
			
		||||
(defvar magit-find-index-hook nil)
 | 
			
		||||
 | 
			
		||||
(defun magit-find-file-index-noselect (file &optional revert)
 | 
			
		||||
  "Read FILE from the index into a buffer and return the buffer.
 | 
			
		||||
FILE must to be relative to the top directory of the repository."
 | 
			
		||||
  (magit-find-file-noselect-1 "" file 'magit-find-index-hook
 | 
			
		||||
                              (or revert 'ask-revert)))
 | 
			
		||||
 | 
			
		||||
(defun magit-update-index ()
 | 
			
		||||
  "Update the index with the contents of the current buffer.
 | 
			
		||||
The current buffer has to be visiting a file in the index, which
 | 
			
		||||
is done using `magit-find-index-noselect'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((file (magit-file-relative-name)))
 | 
			
		||||
    (unless (equal magit-buffer-refname "")
 | 
			
		||||
      (user-error "%s isn't visiting the index" file))
 | 
			
		||||
    (if (y-or-n-p (format "Update index with contents of %s" (buffer-name)))
 | 
			
		||||
        (let ((index (make-temp-file "index"))
 | 
			
		||||
              (buffer (current-buffer)))
 | 
			
		||||
          (when magit-wip-before-change-mode
 | 
			
		||||
            (magit-wip-commit-before-change (list file) " before un-/stage"))
 | 
			
		||||
          (let ((coding-system-for-write buffer-file-coding-system))
 | 
			
		||||
            (with-temp-file index
 | 
			
		||||
              (insert-buffer-substring buffer)))
 | 
			
		||||
          (magit-with-toplevel
 | 
			
		||||
            (magit-call-git "update-index" "--cacheinfo"
 | 
			
		||||
                            (substring (magit-git-string "ls-files" "-s" file)
 | 
			
		||||
                                       0 6)
 | 
			
		||||
                            (magit-git-string "hash-object" "-t" "blob" "-w"
 | 
			
		||||
                                              (concat "--path=" file)
 | 
			
		||||
                                              "--" index)
 | 
			
		||||
                            file))
 | 
			
		||||
          (set-buffer-modified-p nil)
 | 
			
		||||
          (when magit-wip-after-apply-mode
 | 
			
		||||
            (magit-wip-commit-after-apply (list file) " after un-/stage")))
 | 
			
		||||
      (message "Abort")))
 | 
			
		||||
  (--when-let (magit-mode-get-buffer 'magit-status-mode)
 | 
			
		||||
    (with-current-buffer it (magit-refresh)))
 | 
			
		||||
  t)
 | 
			
		||||
 | 
			
		||||
;;; Find Config File
 | 
			
		||||
 | 
			
		||||
(defun magit-find-git-config-file (filename &optional wildcards)
 | 
			
		||||
  "Edit a file located in the current repository's git directory.
 | 
			
		||||
 | 
			
		||||
When \".git\", located at the root of the working tree, is a
 | 
			
		||||
regular file, then that makes it cumbersome to open a file
 | 
			
		||||
located in the actual git directory.
 | 
			
		||||
 | 
			
		||||
This command is like `find-file', except that it temporarily
 | 
			
		||||
binds `default-directory' to the actual git directory, while
 | 
			
		||||
reading the FILENAME."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((default-directory (magit-git-dir)))
 | 
			
		||||
     (find-file-read-args "Find file: "
 | 
			
		||||
                          (confirm-nonexistent-file-or-buffer))))
 | 
			
		||||
  (find-file filename wildcards))
 | 
			
		||||
 | 
			
		||||
(defun magit-find-git-config-file-other-window (filename &optional wildcards)
 | 
			
		||||
  "Edit a file located in the current repository's git directory, in another window.
 | 
			
		||||
 | 
			
		||||
When \".git\", located at the root of the working tree, is a
 | 
			
		||||
regular file, then that makes it cumbersome to open a file
 | 
			
		||||
located in the actual git directory.
 | 
			
		||||
 | 
			
		||||
This command is like `find-file-other-window', except that it
 | 
			
		||||
temporarily binds `default-directory' to the actual git
 | 
			
		||||
directory, while reading the FILENAME."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((default-directory (magit-git-dir)))
 | 
			
		||||
     (find-file-read-args "Find file in other window: "
 | 
			
		||||
                          (confirm-nonexistent-file-or-buffer))))
 | 
			
		||||
  (find-file-other-window filename wildcards))
 | 
			
		||||
 | 
			
		||||
(defun magit-find-git-config-file-other-frame (filename &optional wildcards)
 | 
			
		||||
  "Edit a file located in the current repository's git directory, in another frame.
 | 
			
		||||
 | 
			
		||||
When \".git\", located at the root of the working tree, is a
 | 
			
		||||
regular file, then that makes it cumbersome to open a file
 | 
			
		||||
located in the actual git directory.
 | 
			
		||||
 | 
			
		||||
This command is like `find-file-other-frame', except that it
 | 
			
		||||
temporarily binds `default-directory' to the actual git
 | 
			
		||||
directory, while reading the FILENAME."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((default-directory (magit-git-dir)))
 | 
			
		||||
     (find-file-read-args "Find file in other frame: "
 | 
			
		||||
                          (confirm-nonexistent-file-or-buffer))))
 | 
			
		||||
  (find-file-other-frame filename wildcards))
 | 
			
		||||
 | 
			
		||||
;;; File Mode
 | 
			
		||||
 | 
			
		||||
(defvar magit-file-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (define-key map "\C-xg"    'magit-status)
 | 
			
		||||
    (define-key map "\C-x\M-g" 'magit-dispatch-popup)
 | 
			
		||||
    (define-key map "\C-c\M-g" 'magit-file-popup)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for `magit-file-mode'.")
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-file-popup "magit" nil t)
 | 
			
		||||
(magit-define-popup magit-file-popup
 | 
			
		||||
  "Popup console for Magit commands in file-visiting buffers."
 | 
			
		||||
  :actions '((?s "Stage"     magit-stage-file)
 | 
			
		||||
             (?D "Diff..."   magit-diff-buffer-file-popup)
 | 
			
		||||
             (?L "Log..."    magit-log-buffer-file-popup)
 | 
			
		||||
             (?B "Blame..."  magit-blame-popup) nil
 | 
			
		||||
             (?u "Unstage"   magit-unstage-file)
 | 
			
		||||
             (?d "Diff"      magit-diff-buffer-file)
 | 
			
		||||
             (?l "Log"       magit-log-buffer-file)
 | 
			
		||||
             (?b "Blame"     magit-blame)
 | 
			
		||||
             (?p "Prev blob" magit-blob-previous)
 | 
			
		||||
             (?c "Commit"    magit-commit-popup) nil
 | 
			
		||||
             (?t "Trace"     magit-log-trace-definition)
 | 
			
		||||
             (?r (lambda ()
 | 
			
		||||
                   (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                     (and (not buffer-file-name)
 | 
			
		||||
                          (propertize "...removal" 'face 'default))))
 | 
			
		||||
                 magit-blame-removal)
 | 
			
		||||
             (?n "Next blob" magit-blob-next)
 | 
			
		||||
             (?e "Edit line" magit-edit-line-commit)
 | 
			
		||||
             nil nil
 | 
			
		||||
             (?f (lambda ()
 | 
			
		||||
                   (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                     (and (not buffer-file-name)
 | 
			
		||||
                          (propertize "...reverse" 'face 'default))))
 | 
			
		||||
                 magit-blame-reverse)
 | 
			
		||||
             nil)
 | 
			
		||||
  :max-action-columns 5)
 | 
			
		||||
 | 
			
		||||
(defvar magit-file-mode-lighter "")
 | 
			
		||||
 | 
			
		||||
(define-minor-mode magit-file-mode
 | 
			
		||||
  "Enable some Magit features in a file-visiting buffer.
 | 
			
		||||
 | 
			
		||||
Currently this only adds the following key bindings.
 | 
			
		||||
\n\\{magit-file-mode-map}"
 | 
			
		||||
  :package-version '(magit . "2.2.0")
 | 
			
		||||
  :lighter magit-file-mode-lighter
 | 
			
		||||
  :keymap  magit-file-mode-map)
 | 
			
		||||
 | 
			
		||||
(defun magit-file-mode-turn-on ()
 | 
			
		||||
  (and buffer-file-name
 | 
			
		||||
       (magit-inside-worktree-p t)
 | 
			
		||||
       (magit-file-mode)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(define-globalized-minor-mode global-magit-file-mode
 | 
			
		||||
  magit-file-mode magit-file-mode-turn-on
 | 
			
		||||
  :package-version '(magit . "2.13.0")
 | 
			
		||||
  :link '(info-link "(magit)Minor Mode for Buffers Visiting Files")
 | 
			
		||||
  :group 'magit-essentials
 | 
			
		||||
  :group 'magit-modes
 | 
			
		||||
  :init-value t)
 | 
			
		||||
;; Unfortunately `:init-value t' only sets the value of the mode
 | 
			
		||||
;; variable but does not cause the mode function to be called, and we
 | 
			
		||||
;; cannot use `:initialize' to call that explicitly because the option
 | 
			
		||||
;; is defined before the functions, so we have to do it here.
 | 
			
		||||
(cl-eval-when (load)
 | 
			
		||||
  (when global-magit-file-mode
 | 
			
		||||
    (global-magit-file-mode 1)))
 | 
			
		||||
 | 
			
		||||
;;; Blob Mode
 | 
			
		||||
 | 
			
		||||
(defvar magit-blob-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (cond ((featurep 'jkl)
 | 
			
		||||
           (define-key map "i" 'magit-blob-previous)
 | 
			
		||||
           (define-key map "k" 'magit-blob-next)
 | 
			
		||||
           (define-key map "j" 'magit-blame)
 | 
			
		||||
           (define-key map "l" 'magit-blame-removal)
 | 
			
		||||
           (define-key map "f" 'magit-blame-reverse))
 | 
			
		||||
          (t
 | 
			
		||||
           (define-key map "p" 'magit-blob-previous)
 | 
			
		||||
           (define-key map "n" 'magit-blob-next)
 | 
			
		||||
           (define-key map "b" 'magit-blame)
 | 
			
		||||
           (define-key map "r" 'magit-blame-removal)
 | 
			
		||||
           (define-key map "f" 'magit-blame-reverse)))
 | 
			
		||||
    (define-key map "q" 'magit-kill-this-buffer)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for `magit-blob-mode'.")
 | 
			
		||||
 | 
			
		||||
(define-minor-mode magit-blob-mode
 | 
			
		||||
  "Enable some Magit features in blob-visiting buffers.
 | 
			
		||||
 | 
			
		||||
Currently this only adds the following key bindings.
 | 
			
		||||
\n\\{magit-blob-mode-map}"
 | 
			
		||||
  :package-version '(magit . "2.3.0"))
 | 
			
		||||
 | 
			
		||||
(defun magit-blob-next ()
 | 
			
		||||
  "Visit the next blob which modified the current file."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if magit-buffer-file-name
 | 
			
		||||
      (magit-blob-visit (or (magit-blob-successor magit-buffer-revision
 | 
			
		||||
                                                  magit-buffer-file-name)
 | 
			
		||||
                            magit-buffer-file-name)
 | 
			
		||||
                        (line-number-at-pos))
 | 
			
		||||
    (if (buffer-file-name (buffer-base-buffer))
 | 
			
		||||
        (user-error "You have reached the end of time")
 | 
			
		||||
      (user-error "Buffer isn't visiting a file or blob"))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blob-previous ()
 | 
			
		||||
  "Visit the previous blob which modified the current file."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (if-let ((file (or magit-buffer-file-name
 | 
			
		||||
                     (buffer-file-name (buffer-base-buffer)))))
 | 
			
		||||
      (--if-let (magit-blob-ancestor magit-buffer-revision file)
 | 
			
		||||
          (magit-blob-visit it (line-number-at-pos))
 | 
			
		||||
        (user-error "You have reached the beginning of time"))
 | 
			
		||||
    (user-error "Buffer isn't visiting a file or blob")))
 | 
			
		||||
 | 
			
		||||
(defun magit-blob-visit (blob-or-file line)
 | 
			
		||||
  (if (stringp blob-or-file)
 | 
			
		||||
      (find-file blob-or-file)
 | 
			
		||||
    (pcase-let ((`(,rev ,file) blob-or-file))
 | 
			
		||||
      (magit-find-file rev file)
 | 
			
		||||
      (apply #'message "%s (%s %s ago)"
 | 
			
		||||
             (magit-rev-format "%s" rev)
 | 
			
		||||
             (magit--age (magit-rev-format "%ct" rev)))))
 | 
			
		||||
  (goto-char (point-min))
 | 
			
		||||
  (forward-line (1- line)))
 | 
			
		||||
 | 
			
		||||
(defun magit-blob-ancestor (rev file)
 | 
			
		||||
  (let ((lines (magit-with-toplevel
 | 
			
		||||
                 (magit-git-lines "log" "-2" "--format=%H" "--name-only"
 | 
			
		||||
                                  "--follow" (or rev "HEAD") "--" file))))
 | 
			
		||||
    (if rev (cddr lines) (butlast lines 2))))
 | 
			
		||||
 | 
			
		||||
(defun magit-blob-successor (rev file)
 | 
			
		||||
  (let ((lines (magit-with-toplevel
 | 
			
		||||
                 (magit-git-lines "log" "--format=%H" "--name-only" "--follow"
 | 
			
		||||
                                  "HEAD" "--" file))))
 | 
			
		||||
    (catch 'found
 | 
			
		||||
      (while lines
 | 
			
		||||
        (if (equal (nth 2 lines) rev)
 | 
			
		||||
            (throw 'found (list (nth 0 lines) (nth 1 lines)))
 | 
			
		||||
          (setq lines (nthcdr 2 lines)))))))
 | 
			
		||||
 | 
			
		||||
;;; File Commands
 | 
			
		||||
 | 
			
		||||
(defun magit-file-rename (file newname)
 | 
			
		||||
  "Rename the FILE to NEWNAME.
 | 
			
		||||
If FILE isn't tracked in Git, fallback to using `rename-file'."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let* ((file (magit-read-file "Rename file"))
 | 
			
		||||
          (dir (file-name-directory file))
 | 
			
		||||
          (newname (read-file-name (format "Rename %s to file: " file)
 | 
			
		||||
                                   (and dir (expand-file-name dir)))))
 | 
			
		||||
     (list (expand-file-name file (magit-toplevel))
 | 
			
		||||
           (expand-file-name newname))))
 | 
			
		||||
  (if (magit-file-tracked-p (magit-convert-filename-for-git file))
 | 
			
		||||
      (let ((oldbuf (get-file-buffer file)))
 | 
			
		||||
        (when (and oldbuf (buffer-modified-p oldbuf))
 | 
			
		||||
          (user-error "Save %s before moving it" file))
 | 
			
		||||
        (when (file-exists-p newname)
 | 
			
		||||
          (user-error "%s already exists" newname))
 | 
			
		||||
        (magit-run-git "mv"
 | 
			
		||||
                       (magit-convert-filename-for-git file)
 | 
			
		||||
                       (magit-convert-filename-for-git newname))
 | 
			
		||||
        (when oldbuf
 | 
			
		||||
          (with-current-buffer oldbuf
 | 
			
		||||
            (let ((buffer-read-only buffer-read-only))
 | 
			
		||||
              (set-visited-file-name newname))
 | 
			
		||||
            (if (fboundp 'vc-refresh-state)
 | 
			
		||||
                (vc-refresh-state)
 | 
			
		||||
              (with-no-warnings
 | 
			
		||||
                (vc-find-file-hook))))))
 | 
			
		||||
    (rename-file file newname current-prefix-arg)
 | 
			
		||||
    (magit-refresh)))
 | 
			
		||||
 | 
			
		||||
(defun magit-file-untrack (files &optional force)
 | 
			
		||||
  "Untrack the selected FILES or one file read in the minibuffer.
 | 
			
		||||
 | 
			
		||||
With a prefix argument FORCE do so even when the files have
 | 
			
		||||
staged as well as unstaged changes."
 | 
			
		||||
  (interactive (list (or (--if-let (magit-region-values 'file t)
 | 
			
		||||
                             (progn
 | 
			
		||||
                               (unless (magit-file-tracked-p (car it))
 | 
			
		||||
                                 (user-error "Already untracked"))
 | 
			
		||||
                               (magit-confirm-files 'untrack it "Untrack"))
 | 
			
		||||
                           (list (magit-read-tracked-file "Untrack file"))))
 | 
			
		||||
                     current-prefix-arg))
 | 
			
		||||
  (magit-run-git "rm" "--cached" (and force "--force") "--" files))
 | 
			
		||||
 | 
			
		||||
(defun magit-file-delete (files &optional force)
 | 
			
		||||
  "Delete the selected FILES or one file read in the minibuffer.
 | 
			
		||||
 | 
			
		||||
With a prefix argument FORCE do so even when the files have
 | 
			
		||||
uncommitted changes.  When the files aren't being tracked in
 | 
			
		||||
Git, then fallback to using `delete-file'."
 | 
			
		||||
  (interactive (list (--if-let (magit-region-values 'file t)
 | 
			
		||||
                         (magit-confirm-files 'delete it "Delete")
 | 
			
		||||
                       (list (magit-read-file "Delete file")))
 | 
			
		||||
                     current-prefix-arg))
 | 
			
		||||
  (if (magit-file-tracked-p (car files))
 | 
			
		||||
      (magit-call-git "rm" (and force "--force") "--" files)
 | 
			
		||||
    (let ((topdir (magit-toplevel)))
 | 
			
		||||
      (dolist (file files)
 | 
			
		||||
        (delete-file (expand-file-name file topdir) t))))
 | 
			
		||||
  (magit-refresh))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-file-checkout (rev file)
 | 
			
		||||
  "Checkout FILE from REV."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((rev (magit-read-branch-or-commit
 | 
			
		||||
               "Checkout from revision" magit-buffer-revision)))
 | 
			
		||||
     (list rev (magit-read-file-from-rev rev "Checkout file"))))
 | 
			
		||||
  (magit-with-toplevel
 | 
			
		||||
    (magit-run-git "checkout" rev "--" file)))
 | 
			
		||||
 | 
			
		||||
;;; Read File
 | 
			
		||||
 | 
			
		||||
(defvar magit-read-file-hist nil)
 | 
			
		||||
 | 
			
		||||
(defun magit-read-file-from-rev (rev prompt &optional default)
 | 
			
		||||
  (let ((files (magit-revision-files rev)))
 | 
			
		||||
    (magit-completing-read
 | 
			
		||||
     prompt files nil t nil 'magit-read-file-hist
 | 
			
		||||
     (car (member (or default (magit-current-file)) files)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-file (prompt &optional tracked-only)
 | 
			
		||||
  (let ((choices (nconc (magit-list-files)
 | 
			
		||||
                        (unless tracked-only (magit-untracked-files)))))
 | 
			
		||||
    (magit-completing-read
 | 
			
		||||
     prompt choices nil t nil nil
 | 
			
		||||
     (car (member (or (magit-section-value-if '(file submodule))
 | 
			
		||||
                      (magit-file-relative-name nil tracked-only))
 | 
			
		||||
                  choices)))))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-tracked-file (prompt)
 | 
			
		||||
  (magit-read-file prompt t))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-file-choice (prompt files &optional error default)
 | 
			
		||||
  "Read file from FILES.
 | 
			
		||||
 | 
			
		||||
If FILES has only one member, return that instead of prompting.
 | 
			
		||||
If FILES has no members, give a user error.  ERROR can be given
 | 
			
		||||
to provide a more informative error.
 | 
			
		||||
 | 
			
		||||
If DEFAULT is non-nil, use this as the default value instead of
 | 
			
		||||
`magit-current-file'."
 | 
			
		||||
  (pcase (length files)
 | 
			
		||||
    (0 (user-error (or error "No file choices")))
 | 
			
		||||
    (1 (car files))
 | 
			
		||||
    (_ (magit-completing-read
 | 
			
		||||
        prompt files nil t nil 'magit-read-file-hist
 | 
			
		||||
        (car (member (or default (magit-current-file)) files))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-changed-file (rev-or-range prompt &optional default)
 | 
			
		||||
  (magit-read-file-choice
 | 
			
		||||
   prompt
 | 
			
		||||
   (magit-changed-files rev-or-range)
 | 
			
		||||
   default
 | 
			
		||||
   (concat "No file changed in " rev-or-range)))
 | 
			
		||||
 | 
			
		||||
(defun magit-read-files (prompt initial-contents)
 | 
			
		||||
  (mapconcat 'identity
 | 
			
		||||
             (completing-read-multiple (or prompt "File,s: ")
 | 
			
		||||
                                       (magit-list-files)
 | 
			
		||||
                                       nil nil initial-contents) ","))
 | 
			
		||||
 | 
			
		||||
;;; Patch File
 | 
			
		||||
 | 
			
		||||
(defcustom magit-patch-save-arguments '(exclude "--stat")
 | 
			
		||||
  "Arguments used by `magit-patch-save-arguments' (which see)"
 | 
			
		||||
  :package-version '(magit . "2.12.0")
 | 
			
		||||
  :group 'magit-diff
 | 
			
		||||
  :type '(choice (const :tag "use buffer arguments" buffer)
 | 
			
		||||
                 (cons :tag "use buffer arguments except"
 | 
			
		||||
                       (const :format "" exclude)
 | 
			
		||||
                       (repeat :format "%v%i\n"
 | 
			
		||||
                               (string :tag "Argument")))
 | 
			
		||||
                 (repeat :tag "use constant arguments"
 | 
			
		||||
                         (string :tag "Argument"))))
 | 
			
		||||
 | 
			
		||||
(magit-define-popup magit-patch-apply-popup
 | 
			
		||||
  "Popup console for applying a patch file."
 | 
			
		||||
  :man-page "git-apply"
 | 
			
		||||
  :switches '((?i "Also apply to index"     "--index")
 | 
			
		||||
              (?c "Only apply to index"     "--cached")
 | 
			
		||||
              (?3 "Fall back on 3way merge" "--3way"))
 | 
			
		||||
  :actions  '((?a "Apply patch" magit-patch-apply))
 | 
			
		||||
  :default-action 'magit-patch-apply)
 | 
			
		||||
 | 
			
		||||
(defun magit-patch-apply (file &rest args)
 | 
			
		||||
  "Apply the patch file FILE."
 | 
			
		||||
  (interactive (list (expand-file-name
 | 
			
		||||
                      (read-file-name "Apply patch: "
 | 
			
		||||
                                      default-directory nil nil
 | 
			
		||||
                                      (--when-let (magit-file-at-point)
 | 
			
		||||
                                        (file-relative-name it))))
 | 
			
		||||
                     (magit-patch-apply-arguments)))
 | 
			
		||||
  (magit-run-git "apply" args "--" (magit-convert-filename-for-git file)))
 | 
			
		||||
 | 
			
		||||
(defun magit-patch-save (file &optional arg)
 | 
			
		||||
  "Write current diff into patch FILE.
 | 
			
		||||
 | 
			
		||||
What arguments are used to create the patch depends on the value
 | 
			
		||||
of `magit-patch-save-arguments' and whether a prefix argument is
 | 
			
		||||
used.
 | 
			
		||||
 | 
			
		||||
If the value is the symbol `buffer', then use the same arguments
 | 
			
		||||
as the buffer.  With a prefix argument use no arguments.
 | 
			
		||||
 | 
			
		||||
If the value is a list beginning with the symbol `exclude', then
 | 
			
		||||
use the same arguments as the buffer except for those matched by
 | 
			
		||||
entries in the cdr of the list.  The comparison is done using
 | 
			
		||||
`string-prefix-p'.  With a prefix argument use the same arguments
 | 
			
		||||
as the buffer.
 | 
			
		||||
 | 
			
		||||
If the value is a list of strings (including the empty list),
 | 
			
		||||
then use those arguments.  With a prefix argument use the same
 | 
			
		||||
arguments as the buffer.
 | 
			
		||||
 | 
			
		||||
Of course the arguments that are required to actually show the
 | 
			
		||||
same differences as those shown in the buffer are always used."
 | 
			
		||||
  (interactive (list (read-file-name "Write patch file: " default-directory)
 | 
			
		||||
                     current-prefix-arg))
 | 
			
		||||
  (unless (derived-mode-p 'magit-diff-mode)
 | 
			
		||||
    (user-error "Only diff buffers can be saved as patches"))
 | 
			
		||||
  (pcase-let ((`(,rev ,const ,args ,files) magit-refresh-args))
 | 
			
		||||
    (when (derived-mode-p 'magit-revision-mode)
 | 
			
		||||
      (setq rev (format "%s~..%s" rev rev)))
 | 
			
		||||
    (cond ((eq magit-patch-save-arguments 'buffer)
 | 
			
		||||
           (when arg
 | 
			
		||||
             (setq args nil)))
 | 
			
		||||
          ((eq (car-safe magit-patch-save-arguments) 'exclude)
 | 
			
		||||
           (unless arg
 | 
			
		||||
             (setq args (-difference args (cdr magit-patch-save-arguments)))))
 | 
			
		||||
          ((not arg)
 | 
			
		||||
           (setq args magit-patch-save-arguments)))
 | 
			
		||||
    (with-temp-file file
 | 
			
		||||
      (magit-git-insert "diff" rev "-p" const args "--" files)))
 | 
			
		||||
  (magit-refresh))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-files)
 | 
			
		||||
;;; magit-files.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,241 +0,0 @@
 | 
			
		||||
;;; magit-imenu.el --- Integrate Imenu in magit major modes  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Damien Cassou <damien@cassou.me>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Emacs' major modes can facilitate navigation in their buffers by
 | 
			
		||||
;; supporting Imenu.  In such major modes, launching Imenu (M-x imenu)
 | 
			
		||||
;; makes Emacs display a list of items (e.g., function definitions in
 | 
			
		||||
;; a programming major mode).  Selecting an item from this list moves
 | 
			
		||||
;; point to this item.
 | 
			
		||||
 | 
			
		||||
;; magit-imenu.el adds Imenu support to every major mode in Magit
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'subr-x))
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
(require 'git-rebase)
 | 
			
		||||
 | 
			
		||||
(defun magit-imenu--index-function (entry-types menu-types)
 | 
			
		||||
  "Return an alist of imenu entries in current buffer.
 | 
			
		||||
 | 
			
		||||
ENTRY-TYPES is a list of section types to be selected through
 | 
			
		||||
`imenu'.
 | 
			
		||||
 | 
			
		||||
MENU-TYPES is a list of section types containing elements of
 | 
			
		||||
ENTRY-TYPES.  Elements of MENU-TYPES are are used to categories
 | 
			
		||||
elements of ENTRY-TYPES.
 | 
			
		||||
 | 
			
		||||
This function is used as a helper for functions set as
 | 
			
		||||
`imenu-create-index-function'."
 | 
			
		||||
  (let ((entries (make-hash-table :test 'equal)))
 | 
			
		||||
    (goto-char (point-max))
 | 
			
		||||
    (while (magit-section--backward-find
 | 
			
		||||
            (lambda ()
 | 
			
		||||
              (let* ((section (magit-current-section))
 | 
			
		||||
                     (type (oref section type))
 | 
			
		||||
                     (parent (oref section parent))
 | 
			
		||||
                     (parent-type (oref parent type)))
 | 
			
		||||
                (and (-contains-p entry-types type)
 | 
			
		||||
                     (-contains-p menu-types parent-type)))))
 | 
			
		||||
      (let* ((section (magit-current-section))
 | 
			
		||||
             (name (buffer-substring-no-properties
 | 
			
		||||
                    (line-beginning-position)
 | 
			
		||||
                    (line-end-position)))
 | 
			
		||||
             (parent (oref section parent))
 | 
			
		||||
             (parent-title (buffer-substring-no-properties
 | 
			
		||||
                            (oref parent start)
 | 
			
		||||
                            (1- (oref parent content)))))
 | 
			
		||||
        (puthash parent-title
 | 
			
		||||
                 (cons (cons name (point))
 | 
			
		||||
                       (gethash parent-title entries (list)))
 | 
			
		||||
                 entries)))
 | 
			
		||||
    (mapcar (lambda (menu-title)
 | 
			
		||||
              (cons menu-title (gethash menu-title entries)))
 | 
			
		||||
            (hash-table-keys entries))))
 | 
			
		||||
 | 
			
		||||
;;; Log mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--log-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous line in current buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (magit-section--backward-find
 | 
			
		||||
   (lambda ()
 | 
			
		||||
     (-contains-p '(commit stash)
 | 
			
		||||
                  (oref (magit-current-section) type)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--log-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (save-match-data
 | 
			
		||||
    (looking-at "\\([^ ]+\\)[ *|]+\\(.+\\)$")
 | 
			
		||||
    (format "%s: %s"
 | 
			
		||||
            (match-string-no-properties 1)
 | 
			
		||||
            (match-string-no-properties 2))))
 | 
			
		||||
 | 
			
		||||
;;; Diff mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--diff-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous file line in current buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (magit-section--backward-find
 | 
			
		||||
   (lambda ()
 | 
			
		||||
     (let ((section (magit-current-section)))
 | 
			
		||||
       (and (magit-file-section-p section)
 | 
			
		||||
            (not (equal (oref (oref section parent) type)
 | 
			
		||||
                        'diffstat)))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--diff-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (buffer-substring-no-properties (line-beginning-position)
 | 
			
		||||
                                  (line-end-position)))
 | 
			
		||||
 | 
			
		||||
;;; Status mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--status-create-index-function ()
 | 
			
		||||
  "Return an alist of all imenu entries in current buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-create-index-function'."
 | 
			
		||||
  (magit-imenu--index-function
 | 
			
		||||
   '(file commit stash)
 | 
			
		||||
   '(unpushed unstaged unpulled untracked staged stashes)))
 | 
			
		||||
 | 
			
		||||
;;;; Refs mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--refs-create-index-function ()
 | 
			
		||||
  "Return an alist of all imenu entries in current buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-create-index-function'."
 | 
			
		||||
  (magit-imenu--index-function
 | 
			
		||||
   '(branch commit tag)
 | 
			
		||||
   '(local remote tags)))
 | 
			
		||||
 | 
			
		||||
;;;; Cherry mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--cherry-create-index-function ()
 | 
			
		||||
  "Return an alist of all imenu entries in current buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-create-index-function'."
 | 
			
		||||
  (magit-imenu--index-function
 | 
			
		||||
   '(commit)
 | 
			
		||||
   '(cherries)))
 | 
			
		||||
 | 
			
		||||
;;;; Submodule list mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--submodule-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous line in magit-submodule-list buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (unless (bobp)
 | 
			
		||||
    (forward-line -1)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--submodule-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (elt (tabulated-list-get-entry) 0))
 | 
			
		||||
 | 
			
		||||
;;;; Repolist mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--repolist-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous line in magit-repolist buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (unless (bobp)
 | 
			
		||||
    (forward-line -1)))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--repolist-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (let ((entry (tabulated-list-get-entry)))
 | 
			
		||||
    (format "%s (%s)"
 | 
			
		||||
            (elt entry 0)
 | 
			
		||||
            (elt entry (1- (length entry))))))
 | 
			
		||||
 | 
			
		||||
;;;; Process mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--process-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous process in magit-process buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (magit-section--backward-find
 | 
			
		||||
   (lambda ()
 | 
			
		||||
     (eq (oref (magit-current-section) type) 'process))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--process-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (buffer-substring-no-properties (line-beginning-position)
 | 
			
		||||
                                  (line-end-position)))
 | 
			
		||||
 | 
			
		||||
;;;; Rebase mode
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--rebase-prev-index-position-function ()
 | 
			
		||||
  "Move point to previous commit in git-rebase buffer.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-prev-index-position-function'."
 | 
			
		||||
  (catch 'found
 | 
			
		||||
    (while (not (bobp))
 | 
			
		||||
      (git-rebase-backward-line)
 | 
			
		||||
      (when (git-rebase-line-p)
 | 
			
		||||
        (throw 'found t)))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-imenu--rebase-extract-index-name-function ()
 | 
			
		||||
  "Return imenu name for line at point.
 | 
			
		||||
This function is used as a value for
 | 
			
		||||
`imenu-extract-index-name-function'.  Point should be at the
 | 
			
		||||
beginning of the line."
 | 
			
		||||
  (buffer-substring-no-properties (line-beginning-position)
 | 
			
		||||
                                  (line-end-position)))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-imenu)
 | 
			
		||||
;;; magit-imenu.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,240 +0,0 @@
 | 
			
		||||
;;; magit-margin.el --- margins in Magit buffers  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements support for showing additional information
 | 
			
		||||
;; in the margins of Magit buffers.  Currently this is only used for
 | 
			
		||||
;; commits, for which the committer date or age, and optionally the
 | 
			
		||||
;; author name are shown.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'dash)
 | 
			
		||||
 | 
			
		||||
(require 'magit-section)
 | 
			
		||||
(require 'magit-mode)
 | 
			
		||||
 | 
			
		||||
(defgroup magit-margin nil
 | 
			
		||||
  "Information Magit displays in the margin.
 | 
			
		||||
 | 
			
		||||
You can change the STYLE and AUTHOR-WIDTH of all `magit-*-margin'
 | 
			
		||||
options to the same values by customizing `magit-log-margin'
 | 
			
		||||
*before* `magit' is loaded.  If you do that, then the respective
 | 
			
		||||
values for the other options will default to what you have set
 | 
			
		||||
for that variable.  Likewise if you set `magit-log-margin's INIT
 | 
			
		||||
to nil, then that is used in the default of all other options.  But
 | 
			
		||||
setting it to t, i.e. re-enforcing the default for that option,
 | 
			
		||||
does not carry to other options."
 | 
			
		||||
  :link '(info-link "(magit)Log Margin")
 | 
			
		||||
  :group 'magit-log)
 | 
			
		||||
 | 
			
		||||
(defvar-local magit-buffer-margin nil)
 | 
			
		||||
(put 'magit-buffer-margin 'permanent-local t)
 | 
			
		||||
 | 
			
		||||
(defvar-local magit-set-buffer-margin-refresh nil)
 | 
			
		||||
 | 
			
		||||
(defvar magit--age-spec)
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
(magit-define-popup magit-margin-popup
 | 
			
		||||
  "Popup console for changing appearance of the margin."
 | 
			
		||||
  :actions '("Margin"
 | 
			
		||||
             (?L "Toggle visibility" magit-toggle-margin)
 | 
			
		||||
             (?l "Cycle style"       magit-cycle-margin-style)
 | 
			
		||||
             (?d "Toggle details"    magit-toggle-margin-details)
 | 
			
		||||
             (lambda ()
 | 
			
		||||
               (and (with-current-buffer magit-pre-popup-buffer
 | 
			
		||||
                      (derived-mode-p 'magit-refs-mode))
 | 
			
		||||
                    (propertize "Left edge" 'face 'magit-popup-heading)))
 | 
			
		||||
             (?v "Change verbosity" magit-refs-set-show-commit-count))
 | 
			
		||||
  :max-action-columns 1)
 | 
			
		||||
 | 
			
		||||
(defun magit-toggle-margin ()
 | 
			
		||||
  "Show or hide the Magit margin."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless (magit-margin-option)
 | 
			
		||||
    (user-error "Magit margin isn't supported in this buffer"))
 | 
			
		||||
  (setcar magit-buffer-margin (not (magit-buffer-margin-p)))
 | 
			
		||||
  (magit-set-buffer-margin))
 | 
			
		||||
 | 
			
		||||
(defun magit-cycle-margin-style ()
 | 
			
		||||
  "Cycle style used for the Magit margin."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless (magit-margin-option)
 | 
			
		||||
    (user-error "Magit margin isn't supported in this buffer"))
 | 
			
		||||
  ;; This is only suitable for commit margins (there are not others).
 | 
			
		||||
  (setf (cadr magit-buffer-margin)
 | 
			
		||||
        (pcase (cadr magit-buffer-margin)
 | 
			
		||||
          (`age 'age-abbreviated)
 | 
			
		||||
          (`age-abbreviated
 | 
			
		||||
           (let ((default (cadr (symbol-value (magit-margin-option)))))
 | 
			
		||||
             (if (stringp default) default "%Y-%m-%d %H:%M ")))
 | 
			
		||||
          (_ 'age)))
 | 
			
		||||
  (magit-set-buffer-margin nil t))
 | 
			
		||||
 | 
			
		||||
(defun magit-toggle-margin-details ()
 | 
			
		||||
  "Show or hide details in the Magit margin."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless (magit-margin-option)
 | 
			
		||||
    (user-error "Magit margin isn't supported in this buffer"))
 | 
			
		||||
  (setf (nth 3 magit-buffer-margin)
 | 
			
		||||
        (not (nth 3 magit-buffer-margin)))
 | 
			
		||||
  (magit-set-buffer-margin nil t))
 | 
			
		||||
 | 
			
		||||
;;; Core
 | 
			
		||||
 | 
			
		||||
(defun magit-buffer-margin-p ()
 | 
			
		||||
  (car magit-buffer-margin))
 | 
			
		||||
 | 
			
		||||
(defun magit-margin-option ()
 | 
			
		||||
  (pcase major-mode
 | 
			
		||||
    (`magit-cherry-mode     'magit-cherry-margin)
 | 
			
		||||
    (`magit-log-mode        'magit-log-margin)
 | 
			
		||||
    (`magit-log-select-mode 'magit-log-select-margin)
 | 
			
		||||
    (`magit-reflog-mode     'magit-reflog-margin)
 | 
			
		||||
    (`magit-refs-mode       'magit-refs-margin)
 | 
			
		||||
    (`magit-stashes-mode    'magit-stashes-margin)
 | 
			
		||||
    (`magit-status-mode     'magit-status-margin)))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-buffer-margin (&optional reset refresh)
 | 
			
		||||
  (when-let ((option (magit-margin-option)))
 | 
			
		||||
    (let* ((default (symbol-value option))
 | 
			
		||||
           (default-width (nth 2 default)))
 | 
			
		||||
      (when (or reset (not magit-buffer-margin))
 | 
			
		||||
        (setq magit-buffer-margin (copy-sequence default)))
 | 
			
		||||
      (pcase-let ((`(,enable ,style ,_width ,details ,details-width)
 | 
			
		||||
                   magit-buffer-margin))
 | 
			
		||||
        (when (functionp default-width)
 | 
			
		||||
          (setf (nth 2 magit-buffer-margin)
 | 
			
		||||
                (funcall default-width style details details-width)))
 | 
			
		||||
        (dolist (window (get-buffer-window-list nil nil 0))
 | 
			
		||||
          (with-selected-window window
 | 
			
		||||
            (magit-set-window-margin window)
 | 
			
		||||
            (if enable
 | 
			
		||||
                (add-hook  'window-configuration-change-hook
 | 
			
		||||
                           'magit-set-window-margin nil t)
 | 
			
		||||
              (remove-hook 'window-configuration-change-hook
 | 
			
		||||
                           'magit-set-window-margin t))))
 | 
			
		||||
        (when (and enable (or refresh magit-set-buffer-margin-refresh))
 | 
			
		||||
          (magit-refresh-buffer))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-window-margin (&optional window)
 | 
			
		||||
  (when (or window (setq window (get-buffer-window)))
 | 
			
		||||
    (with-selected-window window
 | 
			
		||||
      (set-window-margins
 | 
			
		||||
       nil (car (window-margins))
 | 
			
		||||
       (and (magit-buffer-margin-p)
 | 
			
		||||
            (if (bound-and-true-p magit-log-margin-show-shortstat)
 | 
			
		||||
                16 ; kludge
 | 
			
		||||
              (nth 2 magit-buffer-margin)))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-make-margin-overlay (&optional string previous-line)
 | 
			
		||||
  (if previous-line
 | 
			
		||||
      (save-excursion
 | 
			
		||||
        (forward-line -1)
 | 
			
		||||
        (magit-make-margin-overlay string))
 | 
			
		||||
    ;; Don't put the overlay on the complete line to work around #1880.
 | 
			
		||||
    (let ((o (make-overlay (1+ (line-beginning-position))
 | 
			
		||||
                           (line-end-position)
 | 
			
		||||
                           nil t)))
 | 
			
		||||
      (overlay-put o 'evaporate t)
 | 
			
		||||
      (overlay-put o 'before-string
 | 
			
		||||
                   (propertize "o" 'display
 | 
			
		||||
                               (list (list 'margin 'right-margin)
 | 
			
		||||
                                     (or string " ")))))))
 | 
			
		||||
 | 
			
		||||
(defun magit-maybe-make-margin-overlay ()
 | 
			
		||||
  (when (or (magit-section-match
 | 
			
		||||
             '(unpulled unpushed recent stashes local cherries)
 | 
			
		||||
             magit-insert-section--current)
 | 
			
		||||
            (and (eq major-mode 'magit-refs-mode)
 | 
			
		||||
                 (magit-section-match
 | 
			
		||||
                  '(remote commit tags)
 | 
			
		||||
                  magit-insert-section--current)))
 | 
			
		||||
    (magit-make-margin-overlay nil t)))
 | 
			
		||||
 | 
			
		||||
;;; Custom Support
 | 
			
		||||
 | 
			
		||||
(defun magit-margin-set-variable (mode symbol value)
 | 
			
		||||
  (set-default symbol value)
 | 
			
		||||
  (message "Updating margins in %s buffers..." mode)
 | 
			
		||||
  (dolist (buffer (buffer-list))
 | 
			
		||||
    (with-current-buffer buffer
 | 
			
		||||
      (when (eq major-mode mode)
 | 
			
		||||
        (magit-set-buffer-margin t)
 | 
			
		||||
        (magit-refresh))))
 | 
			
		||||
  (message "Updating margins in %s buffers...done" mode))
 | 
			
		||||
 | 
			
		||||
(defconst magit-log-margin--custom-type
 | 
			
		||||
  '(list (boolean :tag "Show margin initially")
 | 
			
		||||
         (choice  :tag "Show committer"
 | 
			
		||||
                  (string :tag "date using time-format" "%Y-%m-%d %H:%M ")
 | 
			
		||||
                  (const  :tag "date's age" age)
 | 
			
		||||
                  (const  :tag "date's age (abbreviated)" age-abbreviated))
 | 
			
		||||
         (const   :tag "Calculate width using magit-log-margin-width"
 | 
			
		||||
                  magit-log-margin-width)
 | 
			
		||||
         (boolean :tag "Show author name by default")
 | 
			
		||||
         (integer :tag "Show author name using width")))
 | 
			
		||||
 | 
			
		||||
;;; Time Utilities
 | 
			
		||||
 | 
			
		||||
(defvar magit--age-spec
 | 
			
		||||
  `((?Y "year"   "years"   ,(round (* 60 60 24 365.2425)))
 | 
			
		||||
    (?M "month"  "months"  ,(round (* 60 60 24 30.436875)))
 | 
			
		||||
    (?w "week"   "weeks"   ,(* 60 60 24 7))
 | 
			
		||||
    (?d "day"    "days"    ,(* 60 60 24))
 | 
			
		||||
    (?h "hour"   "hours"   ,(* 60 60))
 | 
			
		||||
    (?m "minute" "minutes" 60)
 | 
			
		||||
    (?s "second" "seconds" 1))
 | 
			
		||||
  "Time units used when formatting relative commit ages.
 | 
			
		||||
 | 
			
		||||
The value is a list of time units, beginning with the longest.
 | 
			
		||||
Each element has the form (CHAR UNIT UNITS SECONDS).  UNIT is the
 | 
			
		||||
time unit, UNITS is the plural of that unit.  CHAR is a character
 | 
			
		||||
abbreviation.  And SECONDS is the number of seconds in one UNIT.
 | 
			
		||||
 | 
			
		||||
This is defined as a variable to make it possible to use time
 | 
			
		||||
units for a language other than English.  It is not defined
 | 
			
		||||
as an option, because most other parts of Magit are always in
 | 
			
		||||
English.")
 | 
			
		||||
 | 
			
		||||
(defun magit--age (date &optional abbreviate)
 | 
			
		||||
  (cl-labels ((fn (age spec)
 | 
			
		||||
                  (pcase-let ((`(,char ,unit ,units ,weight) (car spec)))
 | 
			
		||||
                    (let ((cnt (round (/ age weight 1.0))))
 | 
			
		||||
                      (if (or (not (cdr spec))
 | 
			
		||||
                              (>= (/ age weight) 1))
 | 
			
		||||
                          (list cnt (cond (abbreviate char)
 | 
			
		||||
                                          ((= cnt 1) unit)
 | 
			
		||||
                                          (t units)))
 | 
			
		||||
                        (fn age (cdr spec)))))))
 | 
			
		||||
    (fn (abs (- (float-time)
 | 
			
		||||
                (if (stringp date)
 | 
			
		||||
                    (string-to-number date)
 | 
			
		||||
                  date)))
 | 
			
		||||
        magit--age-spec)))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-margin)
 | 
			
		||||
;;; magit-margin.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,279 +0,0 @@
 | 
			
		||||
;;; magit-merge.el --- merge functionality  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements merge commands.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-merge-popup "magit" nil t)
 | 
			
		||||
(magit-define-popup magit-merge-popup
 | 
			
		||||
  "Popup console for merge commands."
 | 
			
		||||
  :man-page "git-merge"
 | 
			
		||||
  :switches '((?f "Fast-forward only" "--ff-only")
 | 
			
		||||
              (?n "No fast-forward"   "--no-ff"))
 | 
			
		||||
  :options  '((?s "Strategy" "--strategy="))
 | 
			
		||||
  :actions  '((?m "Merge"                  magit-merge)
 | 
			
		||||
              (?p "Preview merge"          magit-merge-preview)
 | 
			
		||||
              (?e "Merge and edit message" magit-merge-editmsg) nil
 | 
			
		||||
              (?n "Merge but don't commit" magit-merge-nocommit)
 | 
			
		||||
              (?s "Squash merge"           magit-merge-squash)
 | 
			
		||||
              (?a "Absorb"                 magit-merge-absorb)
 | 
			
		||||
              (?i "Merge into"             magit-merge-into))
 | 
			
		||||
  :sequence-actions   '((?m "Commit merge" magit-commit)
 | 
			
		||||
                        (?a "Abort merge"  magit-merge-abort))
 | 
			
		||||
  :sequence-predicate 'magit-merge-in-progress-p
 | 
			
		||||
  :default-action 'magit-merge
 | 
			
		||||
  :max-action-columns 2)
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge (rev &optional args nocommit)
 | 
			
		||||
  "Merge commit REV into the current branch; using default message.
 | 
			
		||||
 | 
			
		||||
Unless there are conflicts or a prefix argument is used create a
 | 
			
		||||
merge commit using a generic commit message and without letting
 | 
			
		||||
the user inspect the result.  With a prefix argument pretend the
 | 
			
		||||
merge failed to give the user the opportunity to inspect the
 | 
			
		||||
merge.
 | 
			
		||||
 | 
			
		||||
\(git merge --no-edit|--no-commit [ARGS] REV)"
 | 
			
		||||
  (interactive (list (magit-read-other-branch-or-commit "Merge")
 | 
			
		||||
                     (magit-merge-arguments)
 | 
			
		||||
                     current-prefix-arg))
 | 
			
		||||
  (magit-merge-assert)
 | 
			
		||||
  (magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-editmsg (rev &optional args)
 | 
			
		||||
  "Merge commit REV into the current branch; and edit message.
 | 
			
		||||
Perform the merge and prepare a commit message but let the user
 | 
			
		||||
edit it.
 | 
			
		||||
\n(git merge --edit --no-ff [ARGS] REV)"
 | 
			
		||||
  (interactive (list (magit-read-other-branch-or-commit "Merge")
 | 
			
		||||
                     (magit-merge-arguments)))
 | 
			
		||||
  (magit-merge-assert)
 | 
			
		||||
  (cl-pushnew "--no-ff" args :test #'equal)
 | 
			
		||||
  (apply #'magit-run-git-with-editor "merge" "--edit"
 | 
			
		||||
         (append args (list rev))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-nocommit (rev &optional args)
 | 
			
		||||
  "Merge commit REV into the current branch; pretending it failed.
 | 
			
		||||
Pretend the merge failed to give the user the opportunity to
 | 
			
		||||
inspect the merge and change the commit message.
 | 
			
		||||
\n(git merge --no-commit --no-ff [ARGS] REV)"
 | 
			
		||||
  (interactive (list (magit-read-other-branch-or-commit "Merge")
 | 
			
		||||
                     (magit-merge-arguments)))
 | 
			
		||||
  (magit-merge-assert)
 | 
			
		||||
  (cl-pushnew "--no-ff" args :test #'equal)
 | 
			
		||||
  (magit-run-git-async "merge" "--no-commit" args rev))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-into (branch &optional args)
 | 
			
		||||
  "Merge the current branch into BRANCH and remove the former.
 | 
			
		||||
 | 
			
		||||
Before merging, force push the source branch to its push-remote,
 | 
			
		||||
provided the respective remote branch already exists, ensuring
 | 
			
		||||
that the respective pull-request (if any) won't get stuck on some
 | 
			
		||||
obsolete version of the commits that are being merged.  Finally
 | 
			
		||||
if `magit-branch-pull-request' was used to create the merged
 | 
			
		||||
branch, then also remove the respective remote branch."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (list (magit-read-other-local-branch
 | 
			
		||||
          (format "Merge `%s' into" (magit-get-current-branch))
 | 
			
		||||
          nil
 | 
			
		||||
          (when-let ((upstream (magit-get-upstream-branch)))
 | 
			
		||||
            (when-let ((upstream (cdr (magit-split-branch-name upstream))))
 | 
			
		||||
              (and (magit-branch-p upstream) upstream))))
 | 
			
		||||
         (magit-merge-arguments)))
 | 
			
		||||
  (let ((current (magit-get-current-branch)))
 | 
			
		||||
    (when (zerop (magit-call-git "checkout" branch))
 | 
			
		||||
      (magit--merge-absort current args))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-absorb (branch &optional args)
 | 
			
		||||
  "Merge BRANCH into the current branch and remove the former.
 | 
			
		||||
 | 
			
		||||
Before merging, force push the source branch to its push-remote,
 | 
			
		||||
provided the respective remote branch already exists, ensuring
 | 
			
		||||
that the respective pull-request (if any) won't get stuck on some
 | 
			
		||||
obsolete version of the commits that are being merged.  Finally
 | 
			
		||||
if `magit-branch-pull-request' was used to create the merged
 | 
			
		||||
branch, then also remove the respective remote branch."
 | 
			
		||||
  (interactive (list (magit-read-other-local-branch "Absorb branch")
 | 
			
		||||
                     (magit-merge-arguments)))
 | 
			
		||||
  (magit--merge-absort branch args))
 | 
			
		||||
 | 
			
		||||
(defun magit--merge-absort (branch args)
 | 
			
		||||
  (when (equal branch "master")
 | 
			
		||||
    (unless (yes-or-no-p
 | 
			
		||||
             "Do you really want to to merge `master' into another branch? ")
 | 
			
		||||
      (user-error "Abort")))
 | 
			
		||||
  (if-let ((target (magit-get-push-branch branch t)))
 | 
			
		||||
      (progn
 | 
			
		||||
        (magit-git-push branch target (list "--force-with-lease"))
 | 
			
		||||
        (set-process-sentinel
 | 
			
		||||
         magit-this-process
 | 
			
		||||
         (lambda (process event)
 | 
			
		||||
           (when (memq (process-status process) '(exit signal))
 | 
			
		||||
             (if (not (zerop (process-exit-status process)))
 | 
			
		||||
                 (magit-process-sentinel process event)
 | 
			
		||||
               (process-put process 'inhibit-refresh t)
 | 
			
		||||
               (magit-process-sentinel process event)
 | 
			
		||||
               (magit--merge-absort-1 branch args))))))
 | 
			
		||||
    (magit--merge-absort-1 branch args)))
 | 
			
		||||
 | 
			
		||||
(defun magit--merge-absort-1 (branch args)
 | 
			
		||||
  (magit-run-git-async "merge" args "--no-edit" branch)
 | 
			
		||||
  (set-process-sentinel
 | 
			
		||||
   magit-this-process
 | 
			
		||||
   (lambda (process event)
 | 
			
		||||
     (when (memq (process-status process) '(exit signal))
 | 
			
		||||
       (if (> (process-exit-status process) 0)
 | 
			
		||||
           (magit-process-sentinel process event)
 | 
			
		||||
         (process-put process 'inhibit-refresh t)
 | 
			
		||||
         (magit-process-sentinel process event)
 | 
			
		||||
         (magit-branch-maybe-delete-pr-remote branch)
 | 
			
		||||
         (magit-branch-unset-pushRemote branch)
 | 
			
		||||
         (magit-run-git "branch" "-D" branch))))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-squash (rev)
 | 
			
		||||
  "Squash commit REV into the current branch; don't create a commit.
 | 
			
		||||
\n(git merge --squash REV)"
 | 
			
		||||
  (interactive (list (magit-read-other-branch-or-commit "Squash")))
 | 
			
		||||
  (magit-merge-assert)
 | 
			
		||||
  (magit-run-git-async "merge" "--squash" rev))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-preview (rev)
 | 
			
		||||
  "Preview result of merging REV into the current branch."
 | 
			
		||||
  (interactive (list (magit-read-other-branch-or-commit "Preview merge")))
 | 
			
		||||
  (magit-mode-setup #'magit-merge-preview-mode rev))
 | 
			
		||||
 | 
			
		||||
(define-derived-mode magit-merge-preview-mode magit-diff-mode "Magit Merge"
 | 
			
		||||
  "Mode for previewing a merge."
 | 
			
		||||
  :group 'magit-diff
 | 
			
		||||
  (hack-dir-local-variables-non-file-buffer))
 | 
			
		||||
 | 
			
		||||
(defun magit-merge-preview-refresh-buffer (rev)
 | 
			
		||||
  (let* ((branch (magit-get-current-branch))
 | 
			
		||||
         (head (or branch (magit-rev-verify "HEAD"))))
 | 
			
		||||
    (magit-set-header-line-format (format "Preview merge of %s into %s"
 | 
			
		||||
                                          rev
 | 
			
		||||
                                          (or branch "HEAD")))
 | 
			
		||||
    (magit-insert-section (diffbuf)
 | 
			
		||||
      (magit-git-wash #'magit-diff-wash-diffs
 | 
			
		||||
        "merge-tree" (magit-git-string "merge-base" head rev) head rev))))
 | 
			
		||||
 | 
			
		||||
;;;###autoload
 | 
			
		||||
(defun magit-merge-abort ()
 | 
			
		||||
  "Abort the current merge operation.
 | 
			
		||||
\n(git merge --abort)"
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (unless (file-exists-p (magit-git-dir "MERGE_HEAD"))
 | 
			
		||||
    (user-error "No merge in progress"))
 | 
			
		||||
  (magit-confirm 'abort-merge)
 | 
			
		||||
  (magit-run-git-async "merge" "--abort"))
 | 
			
		||||
 | 
			
		||||
(defun magit-checkout-stage (file arg)
 | 
			
		||||
  "During a conflict checkout and stage side, or restore conflict."
 | 
			
		||||
  (interactive
 | 
			
		||||
   (let ((file (magit-completing-read "Checkout file"
 | 
			
		||||
                                      (magit-tracked-files) nil nil nil
 | 
			
		||||
                                      'magit-read-file-hist
 | 
			
		||||
                                      (magit-current-file))))
 | 
			
		||||
     (cond ((member file (magit-unmerged-files))
 | 
			
		||||
            (list file (magit-checkout-read-stage file)))
 | 
			
		||||
           ((yes-or-no-p (format "Restore conflicts in %s? " file))
 | 
			
		||||
            (list file "--merge"))
 | 
			
		||||
           (t
 | 
			
		||||
            (user-error "Quit")))))
 | 
			
		||||
  (pcase (cons arg (cddr (car (magit-file-status file))))
 | 
			
		||||
    ((or `("--ours"   ?D ,_)
 | 
			
		||||
         `("--theirs" ,_ ?D))
 | 
			
		||||
     (magit-run-git "rm" "--" file))
 | 
			
		||||
    (_ (if (equal arg "--merge")
 | 
			
		||||
           ;; This fails if the file was deleted on one
 | 
			
		||||
           ;; side.  And we cannot do anything about it.
 | 
			
		||||
           (magit-run-git "checkout" "--merge" "--" file)
 | 
			
		||||
         (magit-call-git "checkout" arg "--" file)
 | 
			
		||||
         (magit-run-git "add" "-u" "--" file)))))
 | 
			
		||||
 | 
			
		||||
;;; Utilities
 | 
			
		||||
 | 
			
		||||
(defun magit-merge-in-progress-p ()
 | 
			
		||||
  (file-exists-p (magit-git-dir "MERGE_HEAD")))
 | 
			
		||||
 | 
			
		||||
(defun magit--merge-range (&optional head)
 | 
			
		||||
  (unless head
 | 
			
		||||
    (setq head (magit-get-shortname
 | 
			
		||||
                (car (magit-file-lines (magit-git-dir "MERGE_HEAD"))))))
 | 
			
		||||
  (and head
 | 
			
		||||
       (concat (magit-git-string "merge-base" "--octopus" "HEAD" head)
 | 
			
		||||
               ".." head)))
 | 
			
		||||
 | 
			
		||||
(defun magit-merge-assert ()
 | 
			
		||||
  (or (not (magit-anything-modified-p t))
 | 
			
		||||
      (magit-confirm 'merge-dirty
 | 
			
		||||
        "Merging with dirty worktree is risky.  Continue")))
 | 
			
		||||
 | 
			
		||||
(defun magit-checkout-read-stage (file)
 | 
			
		||||
  (magit-read-char-case (format "For %s checkout: " file) t
 | 
			
		||||
    (?o "[o]ur stage"   "--ours")
 | 
			
		||||
    (?t "[t]heir stage" "--theirs")
 | 
			
		||||
    (?c "[c]onflict"    "--merge")))
 | 
			
		||||
 | 
			
		||||
;;; Sections
 | 
			
		||||
 | 
			
		||||
(defvar magit-unmerged-section-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (define-key map [remap magit-visit-thing] 'magit-diff-dwim)
 | 
			
		||||
    map)
 | 
			
		||||
  "Keymap for `unmerged' sections.")
 | 
			
		||||
 | 
			
		||||
(defun magit-insert-merge-log ()
 | 
			
		||||
  "Insert section for the on-going merge.
 | 
			
		||||
Display the heads that are being merged.
 | 
			
		||||
If no merge is in progress, do nothing."
 | 
			
		||||
  (when (magit-merge-in-progress-p)
 | 
			
		||||
    (let* ((heads (mapcar #'magit-get-shortname
 | 
			
		||||
                          (magit-file-lines (magit-git-dir "MERGE_HEAD"))))
 | 
			
		||||
           (range (magit--merge-range (car heads))))
 | 
			
		||||
      (magit-insert-section (unmerged range)
 | 
			
		||||
        (magit-insert-heading
 | 
			
		||||
          (format "Merging %s:" (mapconcat #'identity heads ", ")))
 | 
			
		||||
        (magit-insert-log
 | 
			
		||||
         range
 | 
			
		||||
         (let ((args magit-log-section-arguments))
 | 
			
		||||
           (unless (member "--decorate=full" magit-log-section-arguments)
 | 
			
		||||
             (push "--decorate=full" args))
 | 
			
		||||
           args))))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-merge)
 | 
			
		||||
;;; magit-merge.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											Binary file not shown.
										
									
								
							@ -1,201 +0,0 @@
 | 
			
		||||
;;; magit-notes.el --- notes support  -*- lexical-binding: t -*-
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2010-2018  The Magit Project Contributors
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the AUTHORS.md file which
 | 
			
		||||
;; lists all contributors.  If not, see http://magit.vc/authors.
 | 
			
		||||
 | 
			
		||||
;; Author: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
 | 
			
		||||
 | 
			
		||||
;; Magit is free software; you can redistribute it and/or modify it
 | 
			
		||||
;; under the terms of the GNU General Public License as published by
 | 
			
		||||
;; the Free Software Foundation; either version 3, or (at your option)
 | 
			
		||||
;; any later version.
 | 
			
		||||
;;
 | 
			
		||||
;; Magit is distributed in the hope that it will be useful, but WITHOUT
 | 
			
		||||
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 | 
			
		||||
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
 | 
			
		||||
;; License for more details.
 | 
			
		||||
;;
 | 
			
		||||
;; You should have received a copy of the GNU General Public License
 | 
			
		||||
;; along with Magit.  If not, see http://www.gnu.org/licenses.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; This library implements support for `git-notes'.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'magit)
 | 
			
		||||
 | 
			
		||||
;;; Popup
 | 
			
		||||
 | 
			
		||||
;;;###autoload (autoload 'magit-notes-popup "magit" nil t)
 | 
			
		||||
(magit-define-popup magit-notes-popup
 | 
			
		||||
  "Popup console for notes commands."
 | 
			
		||||
  :man-page "git-notes"
 | 
			
		||||
  :variables '("Configure local settings"
 | 
			
		||||
               (?c "core.notesRef"
 | 
			
		||||
                   magit-set-core.notesRef
 | 
			
		||||
                   magit-format-core.notesRef)
 | 
			
		||||
               (?d "notes.displayRef"
 | 
			
		||||
                   magit-set-notes.displayRef
 | 
			
		||||
                   magit-format-notes.displayRef)
 | 
			
		||||
               "Configure global settings"
 | 
			
		||||
               (?C "core.notesRef"
 | 
			
		||||
                   magit-set-global-core.notesRef
 | 
			
		||||
                   magit-format-global-core.notesRef)
 | 
			
		||||
               (?D "notes.displayRef"
 | 
			
		||||
                   magit-set-global-notes.displayRef
 | 
			
		||||
                   magit-format-global-notes.displayRef))
 | 
			
		||||
  :switches '("Switch for prune"
 | 
			
		||||
              (?n "Dry run"          "--dry-run"))
 | 
			
		||||
  :options  '("Option for edit and remove"
 | 
			
		||||
              (?r "Manipulate ref"   "--ref=" magit-notes-popup-read-ref)
 | 
			
		||||
              "Option for merge"
 | 
			
		||||
              (?s "Merge strategy"   "--strategy="))
 | 
			
		||||
  :actions  '((?T "Edit"             magit-notes-edit)
 | 
			
		||||
              (?r "Remove"           magit-notes-remove)
 | 
			
		||||
              (?m "Merge"            magit-notes-merge)
 | 
			
		||||
              (?p "Prune"            magit-notes-prune))
 | 
			
		||||
  :sequence-actions '((?c "Commit merge" magit-notes-merge-commit)
 | 
			
		||||
                      (?a "Abort merge"  magit-notes-merge-abort))
 | 
			
		||||
  :sequence-predicate 'magit-notes-merging-p
 | 
			
		||||
  :default-action 'magit-notes-edit)
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-merging-p ()
 | 
			
		||||
  (let ((dir (magit-git-dir "NOTES_MERGE_WORKTREE")))
 | 
			
		||||
    (and (file-directory-p dir)
 | 
			
		||||
         (directory-files dir nil "^[^.]"))))
 | 
			
		||||
 | 
			
		||||
(defun magit-format-core.notesRef ()
 | 
			
		||||
  (magit--format-popup-variable:value "core.notesRef" 22))
 | 
			
		||||
 | 
			
		||||
(defun magit-format-notes.displayRef ()
 | 
			
		||||
  (magit--format-popup-variable:values "notes.displayRef" 22))
 | 
			
		||||
 | 
			
		||||
(defun magit-format-global-core.notesRef ()
 | 
			
		||||
  (magit--format-popup-variable:value "core.notesRef" 22 t))
 | 
			
		||||
 | 
			
		||||
(defun magit-format-global-notes.displayRef ()
 | 
			
		||||
  (magit--format-popup-variable:values "notes.displayRef" 22 t))
 | 
			
		||||
 | 
			
		||||
;;; Commands
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-edit (commit &optional ref)
 | 
			
		||||
  "Edit the note attached to COMMIT.
 | 
			
		||||
REF is the notes ref used to store the notes.
 | 
			
		||||
 | 
			
		||||
Interactively or when optional REF is nil use the value of Git
 | 
			
		||||
variable `core.notesRef' or \"refs/notes/commits\" if that is
 | 
			
		||||
undefined."
 | 
			
		||||
  (interactive (magit-notes-read-args "Edit notes"))
 | 
			
		||||
  (magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
 | 
			
		||||
                             "edit" commit))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-remove (commit &optional ref)
 | 
			
		||||
  "Remove the note attached to COMMIT.
 | 
			
		||||
REF is the notes ref from which the note is removed.
 | 
			
		||||
 | 
			
		||||
Interactively or when optional REF is nil use the value of Git
 | 
			
		||||
variable `core.notesRef' or \"refs/notes/commits\" if that is
 | 
			
		||||
undefined."
 | 
			
		||||
  (interactive (magit-notes-read-args "Remove notes"))
 | 
			
		||||
  (magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
 | 
			
		||||
                             "remove" commit))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-merge (ref)
 | 
			
		||||
  "Merge the notes ref REF into the current notes ref.
 | 
			
		||||
 | 
			
		||||
The current notes ref is the value of Git variable
 | 
			
		||||
`core.notesRef' or \"refs/notes/commits\" if that is undefined.
 | 
			
		||||
 | 
			
		||||
When there are conflicts, then they have to be resolved in the
 | 
			
		||||
temporary worktree \".git/NOTES_MERGE_WORKTREE\".  When
 | 
			
		||||
done use `magit-notes-merge-commit' to finish.  To abort
 | 
			
		||||
use `magit-notes-merge-abort'."
 | 
			
		||||
  (interactive (list (magit-read-string-ns "Merge reference")))
 | 
			
		||||
  (magit-run-git-with-editor "notes" "merge" ref))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-merge-commit ()
 | 
			
		||||
  "Commit the current notes ref merge.
 | 
			
		||||
Also see `magit-notes-merge'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-run-git-with-editor "notes" "merge" "--commit"))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-merge-abort ()
 | 
			
		||||
  "Abort the current notes ref merge.
 | 
			
		||||
Also see `magit-notes-merge'."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (magit-run-git-with-editor "notes" "merge" "--abort"))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-prune (&optional dry-run)
 | 
			
		||||
  "Remove notes about unreachable commits."
 | 
			
		||||
  (interactive (list (and (member "--dry-run" (magit-notes-arguments)) t)))
 | 
			
		||||
  (when dry-run
 | 
			
		||||
    (magit-process-buffer))
 | 
			
		||||
  (magit-run-git-with-editor "notes" "prune" (and dry-run "--dry-run")))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-core.notesRef (ref)
 | 
			
		||||
  "Set the local value of `core.notesRef' to REF."
 | 
			
		||||
  (interactive (list (magit-notes-read-ref "Set local core.notesRef")))
 | 
			
		||||
  (magit-set ref "core.notesRef")
 | 
			
		||||
  (magit-with-pre-popup-buffer
 | 
			
		||||
    (magit-refresh)))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-global-core.notesRef (ref)
 | 
			
		||||
  "Set the global value of `core.notesRef' to REF."
 | 
			
		||||
  (interactive (list (magit-notes-read-ref "Set global core.notesRef")))
 | 
			
		||||
  (magit-set ref "--global" "core.notesRef")
 | 
			
		||||
  (magit-with-pre-popup-buffer
 | 
			
		||||
    (magit-refresh)))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-notes.displayRef (refs)
 | 
			
		||||
  "Set the local values of `notes.displayRef' to REFS."
 | 
			
		||||
  (interactive (list (magit-notes-read-refs "Set local notes.displayRef")))
 | 
			
		||||
  (magit-set-all refs "notes.displayRef")
 | 
			
		||||
  (magit-with-pre-popup-buffer
 | 
			
		||||
    (magit-refresh)))
 | 
			
		||||
 | 
			
		||||
(defun magit-set-global-notes.displayRef (refs)
 | 
			
		||||
  "Set the global values of `notes.displayRef' to REFS."
 | 
			
		||||
  (interactive (list (magit-notes-read-refs "Set global notes.displayRef")))
 | 
			
		||||
  (magit-set-all refs "--global" "notes.displayRef")
 | 
			
		||||
  (magit-with-pre-popup-buffer
 | 
			
		||||
    (magit-refresh)))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-read-ref (prompt)
 | 
			
		||||
  (--when-let (magit-completing-read
 | 
			
		||||
               prompt (magit-list-notes-refnames) nil nil
 | 
			
		||||
               (--when-let (magit-get "core.notesRef")
 | 
			
		||||
                 (if (string-prefix-p "refs/notes/" it)
 | 
			
		||||
                     (substring it 11)
 | 
			
		||||
                   it)))
 | 
			
		||||
    (if (string-prefix-p "refs/" it)
 | 
			
		||||
        it
 | 
			
		||||
      (concat "refs/notes/" it))))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-read-refs (prompt)
 | 
			
		||||
  (mapcar (lambda (ref)
 | 
			
		||||
            (if (string-prefix-p "refs/" ref)
 | 
			
		||||
                ref
 | 
			
		||||
              (concat "refs/notes/" ref)))
 | 
			
		||||
          (completing-read-multiple
 | 
			
		||||
           (concat prompt ": ")
 | 
			
		||||
           (magit-list-notes-refnames) nil nil
 | 
			
		||||
           (mapconcat (lambda (ref)
 | 
			
		||||
                        (if (string-prefix-p "refs/notes/" ref)
 | 
			
		||||
                            (substring ref 11)
 | 
			
		||||
                          ref))
 | 
			
		||||
                      (magit-get-all "notes.displayRef")
 | 
			
		||||
                      ","))))
 | 
			
		||||
 | 
			
		||||
(defun magit-notes-read-args (prompt)
 | 
			
		||||
 (list (magit-read-branch-or-commit prompt (magit-stash-at-point))
 | 
			
		||||
       (--when-let (--first (string-match "^--ref=\\(.+\\)" it)
 | 
			
		||||
                            (magit-notes-arguments))
 | 
			
		||||
         (match-string 1 it))))
 | 
			
		||||
 | 
			
		||||
(provide 'magit-notes)
 | 
			
		||||
;;; magit-notes.el ends here
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							@ -1,33 +0,0 @@
 | 
			
		||||
;;; 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
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user