Update magit

This commit is contained in:
Gergely Polonkai 2016-02-24 22:06:01 +00:00
parent 73722de18c
commit d2f9933975
100 changed files with 39031 additions and 12339 deletions

View File

@ -0,0 +1,129 @@
;;; async-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "async" "async.el" (22221 60697 422000 0))
;;; 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" (22221
;;;;;; 60697 419000 0))
;;; 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 command `async-bytecomp-package-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `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)
;;;***
;;;### (autoloads nil "dired-async" "dired-async.el" (22221 60697
;;;;;; 412000 0))
;;; Generated autoloads from dired-async.el
(defvar dired-async-mode nil "\
Non-nil if Dired-Async mode is enabled.
See the command `dired-async-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `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)
;;;***
;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22221
;;;;;; 60697 432884 878000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; async-autoloads.el ends here

View File

@ -0,0 +1,177 @@
;;; async-bytecomp.el --- Async functions to compile elisp files async
;; 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 "~/.emacs.d/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)))
(provide 'async-bytecomp)
;;; async-bytecomp.el ends here

View File

@ -0,0 +1,6 @@
(define-package "async" "20160223.146" "Asynchronous processing in Emacs" 'nil :keywords
'("async")
:url "http://elpa.gnu.org/packages/async.html")
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,303 @@
;;; async.el --- Asynchronous processing in Emacs
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
;; Version: 1.6
;; 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:
(defgroup async nil
"Simple asynchronous processing in Emacs"
:group 'emacs)
(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-inject-variables
(include-regexp &optional predicate exclude-regexp)
"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). 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)
(if (and (boundp sym)
(or (null include-regexp)
(string-match include-regexp (symbol-name sym)))
(not (string-match
(or exclude-regexp "-syntax-table\\'")
(symbol-name sym))))
(let ((value (symbol-value sym)))
(when (or (null predicate)
(funcall predicate sym))
(setq bindings (cons `(quote ,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 sentinal 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-unix))
;; Parent expects UTF-8 encoded text.
(coding-system-for-write 'utf-8-unix))
(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-unix)
(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-unix))
(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 the ready 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))
(with-current-buffer (process-buffer future)
async-callback-value-set)))
(defun async-wait (future)
"Wait for FUTURE to become ready."
(while (not (async-ready future))
(sit-for 0.05)))
(defun async-get (future)
"Get the value from an asynchronously function when it is ready.
FUTURE is returned by `async-start' or `async-start-process' when
its FINISH-FUNC is nil."
(async-wait future)
(with-current-buffer (process-buffer future)
(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 (&rest args)
"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)))
;;;###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-unix))
(setq async--procvar
(async-start-process
"emacs" (file-truename
(expand-file-name invocation-name
invocation-directory))
finish-func
"-Q" "-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)))
(provide 'async)
;;; async.el ends here

View File

@ -0,0 +1,290 @@
;;; dired-async.el --- Copy/move/delete asynchronously in dired.
;; 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))
(defvar dired-async-operation nil)
(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)
(defface dired-async-message
'((t (:foreground "yellow")))
"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 &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 'dired-async-message))))
(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))))
(delete-process proc)
(unless (> (length processes) 1)
(dired-async--modeline-mode -1))))
(defun dired-async-after-file-create (len-flist)
"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 dired-async-operation
(if (file-exists-p dired-async-log-file)
(progn
(pop-to-buffer (get-buffer-create "*dired async*"))
(erase-buffer)
(insert "Error: ")
(insert-file-contents dired-async-log-file)
(delete-file dired-async-log-file))
(run-with-timer
0.1 nil
dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done"
(car dired-async-operation) (cadr dired-async-operation) len-flist))))
(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))))))
(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 dired-async-operation nil)
(let (dired-create-files-failures
failures async-fn-list
skipped (success-count 0)
(total (length fn-list))
callback)
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
(setq to (funcall name-constructor from))
(if (equal to from)
(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 (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))))
;; must determine if FROM is marked before file-creator
;; gets a chance to delete it (in case of a move).
(actual-marker-char
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
;; 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"
operation from to)))
(push (cons from to) async-fn-list)))))
(setq callback
`(lambda (&optional ignore)
(dired-async-after-file-create ,total)
(when (string= ,(downcase operation) "rename")
(cl-loop for (file . to) in ',async-fn-list
do (and (get-file-buffer file)
(with-current-buffer (get-file-buffer file)
(set-visited-file-name to nil t))))))))
;; Handle error happening in host emacs.
(cond
(dired-create-files-failures
(setq failures (nconc failures dired-create-files-failures))
(dired-log-summary
(format "%s failed for %d file%s in %d requests"
operation (length failures)
(dired-plural-s (length failures))
total)
failures))
(failures
(dired-log-summary
(format "%s failed for %d of %d file%s"
operation (length failures)
total (dired-plural-s total))
failures))
(skipped
(dired-log-summary
(format "%s: %d of %d file%s skipped"
operation (length skipped) total
(dired-plural-s total))
skipped))
(t (message "%s: %s file%s"
operation success-count (dired-plural-s success-count))))
;; 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)
(condition-case err
(let ((dired-recursive-copies (quote always)))
(cl-loop for (f . d) in (quote ,async-fn-list)
do (funcall (quote ,file-creator) f d t)))
(file-error
(with-temp-file ,dired-async-log-file
(insert (format "%S" err)))))
,(dired-async-maybe-kill-ftp))
callback)
;; Run mode-line notifications while process running.
(dired-async--modeline-mode 1)
(setq dired-async-operation (list operation (length async-fn-list)))
(message "%s proceeding asynchronously..." operation))))
(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
:global t
(if dired-async-mode
(if (fboundp 'advice-add)
(advice-add 'dired-create-files :override #'dired-async-create-files)
(ad-activate 'dired-create-files))
(if (fboundp 'advice-remove)
(advice-remove 'dired-create-files #'dired-async-create-files)
(ad-deactivate 'dired-create-files))))
(provide 'dired-async)
;;; dired-async.el ends here

View File

@ -0,0 +1,73 @@
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously
;; 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"
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
(run-hooks 'async-smtpmail-before-send-hook)
(smtpmail-send-it)))
`(lambda (&optional ignore)
(message "Delivering message to %s...done" ,to)))))
(provide 'smtpmail-async)
;;; smtpmail-async.el ends here

View File

@ -0,0 +1,15 @@
;;; dash-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("dash.el") (22221 60697 93676 700000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; dash-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "dash" "20160223.1028" "A modern list library for Emacs" 'nil :keywords '("lists"))

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,249 @@
;;; gh-api.el --- api definition for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'json)
(require 'gh-profile)
(require 'gh-url)
(require 'gh-auth)
(require 'gh-cache)
(require 'logito)
(defgroup gh-api nil
"Github API."
:group 'gh)
(defcustom gh-api-username-filter 'gh-api-enterprise-username-filter
"Filter to apply to usernames to build URL components"
:type 'function
:group 'gh-api)
;;;###autoload
(defclass gh-api ()
((sync :initarg :sync :initform t)
(cache :initarg :cache :initform nil)
(base :initarg :base :type string)
(profile :initarg :profile :type string)
(auth :initarg :auth :initform nil)
(data-format :initarg :data-format)
(num-retries :initarg :num-retries :initform 0)
(log :initarg :log :initform nil)
(cache-cls :initform gh-cache :allocation :class))
"Github API")
(defmethod logito-log ((api gh-api) level tag string &rest objects)
(apply 'logito-log (oref api :log) level tag string objects))
(defmethod constructor :static ((api gh-api) &rest args)
(call-next-method))
(defmethod gh-api-set-default-auth ((api gh-api) auth)
(let ((auth (or (oref api :auth) auth))
(cache (oref api :cache))
(classname (symbol-name (funcall (if (fboundp 'eieio-object-class)
'eieio-object-class
'object-class)
api))))
(oset api :auth auth)
(unless (or (null cache)
(and (eieio-object-p cache)
(object-of-class-p cache 'gh-cache)))
(oset api :cache (funcall (oref api cache-cls)
(format "gh/%s/%s"
classname
(gh-api-get-username api)))))))
(defmethod gh-api-expand-resource ((api gh-api)
resource)
resource)
(defun gh-api-enterprise-username-filter (username)
(replace-regexp-in-string (regexp-quote ".") "-" username))
(defmethod gh-api-get-username ((api gh-api))
(let ((username (oref (oref api :auth) :username)))
(funcall gh-api-username-filter username)))
;;;###autoload
(defclass gh-api-v3 (gh-api)
((data-format :initarg :data-format :initform :json))
"Github API v3")
(defcustom gh-api-v3-authenticator 'gh-oauth-authenticator
"Authenticator for Github API v3"
:type '(choice (const :tag "Password" gh-password-authenticator)
(const :tag "OAuth" gh-oauth-authenticator))
:group 'gh-api)
(defmethod constructor :static ((api gh-api-v3) &rest args)
(let ((obj (call-next-method))
(gh-profile-current-profile (gh-profile-current-profile)))
(oset obj :profile (gh-profile-current-profile))
(oset obj :base (gh-profile-url))
(gh-api-set-default-auth obj
(or (oref obj :auth)
(funcall gh-api-v3-authenticator "auth")))
obj))
(defclass gh-api-request (gh-url-request)
((default-response-cls :allocation :class :initform gh-api-response)))
(defclass gh-api-response (gh-url-response)
())
(defun gh-api-json-decode (repr)
(if (or (null repr) (string= repr ""))
'empty
(let ((json-array-type 'list))
(json-read-from-string repr))))
(defun gh-api-json-encode (json)
(json-encode-list json))
(defmethod gh-url-response-set-data ((resp gh-api-response) data)
(call-next-method resp (gh-api-json-decode data)))
(defclass gh-api-paged-request (gh-api-request)
((default-response-cls :allocation :class :initform gh-api-paged-response)))
(defclass gh-api-paged-response (gh-api-response)
())
(defmethod gh-api-paging-links ((resp gh-api-paged-response))
(let ((links-header (cdr (assoc "Link" (oref resp :headers)))))
(when links-header
(loop for item in (split-string links-header ", ")
when (string-match "^<\\(.*\\)>; rel=\"\\(.*\\)\"" item)
collect (cons (match-string 2 item)
(match-string 1 item))))))
(defmethod gh-url-response-set-data ((resp gh-api-paged-response) data)
(let ((previous-data (oref resp :data))
(next (cdr (assoc "next" (gh-api-paging-links resp)))))
(call-next-method)
(oset resp :data (append previous-data (oref resp :data)))
(when (and next (not (equal 304 (oref resp :http-status))))
(let ((req (oref resp :-req)))
(oset resp :data-received nil)
(oset req :url next)
(gh-url-run-request req resp)))))
(defmethod gh-api-authenticated-request
((api gh-api) transformer method resource &optional data params)
(let* ((fmt (oref api :data-format))
(headers (cond ((eq fmt :form)
'(("Content-Type" .
"application/x-www-form-urlencoded")))
((eq fmt :json)
'(("Content-Type" .
"application/json")))))
(cache (oref api :cache))
(key (list resource
method
(sha1 (format "%s" transformer))))
(cache-key (and cache
(member method (oref cache safe-methods))
key))
(has-value (and cache-key (pcache-has cache cache-key)))
(value (and has-value (pcache-get cache cache-key)))
(is-outdated (and has-value (gh-cache-outdated-p cache cache-key)))
(etag (and is-outdated (gh-cache-etag cache cache-key)))
(req
(and (or (not has-value)
is-outdated)
(gh-auth-modify-request
(oref api :auth)
;; TODO: use gh-api-paged-request only when needed
(make-instance 'gh-api-paged-request
:method method
:url (concat (oref api :base)
(gh-api-expand-resource
api resource))
:query params
:headers (if etag
(cons (cons "If-None-Match" etag)
headers)
headers)
:data (or (and (eq fmt :json)
(gh-api-json-encode data))
(and (eq fmt :form)
(gh-url-form-encode data))
""))))))
(cond ((and has-value ;; got value from cache
(not is-outdated))
(gh-api-response "cached" :data-received t :data value))
(cache-key ;; no value, but cache exists and method is safe
(let ((resp (make-instance (oref req default-response-cls)
:transform transformer)))
(gh-url-run-request req resp)
(gh-url-add-response-callback
resp (make-instance 'gh-api-callback :cache cache :key cache-key
:revive etag))
resp))
(cache ;; unsafe method, cache exists
(pcache-invalidate cache key)
(gh-url-run-request req (make-instance
(oref req default-response-cls)
:transform transformer)))
(t ;; no cache involved
(gh-url-run-request req (make-instance
(oref req default-response-cls)
:transform transformer))))))
(defclass gh-api-callback (gh-url-callback)
((cache :initarg :cache)
(key :initarg :key)
(revive :initarg :revive)))
(defmethod gh-url-callback-run ((cb gh-api-callback) resp)
(let ((cache (oref cb :cache))
(key (oref cb :key)))
(if (and (oref cb :revive) (equal (oref resp :http-status) 304))
(progn
(gh-cache-revive cache key)
(oset resp :data (pcache-get cache key)))
(pcache-put cache key (oref resp :data))
(gh-cache-set-etag cache key
(cdr (assoc "ETag" (oref resp :headers)))))))
(define-obsolete-function-alias 'gh-api-add-response-callback
'gh-url-add-response-callback "0.6.0")
(provide 'gh-api)
;;; gh-api.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,176 @@
;;; gh-auth.el --- authentication for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-profile)
(require 'gh-common)
(require 'gh-url)
(defgroup gh-auth nil
"Github authentication."
:group 'gh)
(defvar gh-auth-alist nil)
(defun gh-auth-remember (profile key value)
(let ((cell (assoc profile gh-auth-alist)))
(when (not cell)
(setq cell (cons profile nil))
(setq gh-auth-alist (append gh-auth-alist (list cell))))
(setcdr cell (plist-put (cdr cell) key value))))
(defun gh-auth-get-username ()
(let* ((profile (gh-profile-current-profile))
(user (or (plist-get (cdr (assoc profile gh-auth-alist)) :username)
(plist-get (cdr (assoc profile gh-profile-alist)) :username)
(gh-config "user"))))
(when (not user)
(setq user (read-string "GitHub username: "))
(gh-set-config "user" user))
(gh-auth-remember profile :username user)
user))
(defun gh-auth-get-password (&optional remember)
(let* ((profile (gh-profile-current-profile))
(pass (or (plist-get (cdr (assoc profile gh-auth-alist)) :password)
(plist-get (cdr (assoc profile gh-profile-alist)) :password)
(gh-config "password"))))
(when (not pass)
(setq pass (read-passwd "GitHub password: "))
(gh-set-config "password" pass))
(when remember
(gh-auth-remember profile :password pass))
pass))
(declare-function 'gh-oauth-auth-new "gh-oauth")
(defun gh-auth-get-oauth-token ()
(let* ((profile (gh-profile-current-profile))
(token (or (plist-get (cdr (assoc profile gh-auth-alist)) :token)
(plist-get (cdr (assoc profile gh-profile-alist)) :token)
(gh-config "oauth-token"))))
(when (not token)
(let* ((api (make-instance 'gh-oauth-api))
(tok (and (fboundp 'gh-oauth-auth-new)
(oref (oref (funcall 'gh-oauth-auth-new api
'(user repo gist)) :data)
:token))))
(setq token (or tok (read-string "GitHub OAuth token: ")))
(gh-set-config "oauth-token" token)))
(gh-auth-remember profile :token token)
token))
;;;###autoload
(defclass gh-authenticator ()
((username :initarg :username :initform nil))
"Abstract authenticator")
(defmethod constructor :static ((auth gh-authenticator) &rest args)
(let ((obj (call-next-method)))
(or (oref obj :username)
(oset obj :username (gh-auth-get-username)))
obj))
(defmethod gh-auth-modify-request ((auth gh-authenticator) req)
req)
(defclass gh-auth-2fa-callback (gh-url-callback)
((req :initarg :req :initform nil))
"2-factor callback")
(defmethod gh-url-callback-run ((cb gh-auth-2fa-callback) resp)
(when (equal (oref resp :http-status) 401)
(let* ((otp-header "X-GitHub-OTP")
(h (assoc otp-header (oref resp :headers))))
(when (and h (string-prefix-p "required;" (cdr h)))
(let ((otp (read-from-minibuffer "Enter dual-factor auth code: "))
(req (oref cb :req)))
;; reset resp
(oset resp :data nil)
(oset resp :data-received nil)
(object-add-to-list req :headers
(cons otp-header otp))
(gh-url-run-request req resp))))))
;;;###autoload
(defclass gh-password-authenticator (gh-authenticator)
((password :initarg :password :protection :private :initform nil)
(remember :allocation :class :initform t)
(2fa-cls :initform gh-auth-2fa-callback :allocation :class))
"Password-based authenticator")
(defmethod constructor :static ((auth gh-password-authenticator) &rest args)
(let ((obj (call-next-method)))
(or (oref obj :password)
(oset obj :password (gh-auth-get-password (oref obj remember))))
obj))
(defmethod gh-auth-modify-request ((auth gh-password-authenticator) req)
(object-add-to-list req :headers
(cons "Authorization"
(concat "Basic "
(base64-encode-string
(format "%s:%s" (oref auth :username)
(encode-coding-string
(oref auth :password) 'utf-8))))))
(object-add-to-list req :install-callbacks
(make-instance (oref auth 2fa-cls) :req req))
req)
;;;###autoload
(defclass gh-oauth-authenticator (gh-authenticator)
((token :initarg :token :protection :private :initform nil))
"Oauth-based authenticator")
(defmethod constructor :static ((auth gh-oauth-authenticator) &rest args)
(let ((obj (call-next-method)))
(or (oref obj :token)
(oset obj :token (gh-auth-get-oauth-token)))
obj))
(defmethod gh-auth-modify-request ((auth gh-oauth-authenticator) req)
(object-add-to-list req :headers
(cons "Authorization"
(format "token %s" (oref auth :token))))
req)
(provide 'gh-auth)
;; to avoid circular dependencies...
(require 'gh-oauth)
;;; gh-auth.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,162 @@
;;; gh-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gh-api" "gh-api.el" (22221 60701 548000 0))
;;; Generated autoloads from gh-api.el
(require 'eieio)
(eieio-defclass-autoload 'gh-api 'nil "gh-api" "Github API")
(eieio-defclass-autoload 'gh-api-v3 '(gh-api) "gh-api" "Github API v3")
;;;***
;;;### (autoloads nil "gh-auth" "gh-auth.el" (22221 60701 635000
;;;;;; 0))
;;; Generated autoloads from gh-auth.el
(require 'eieio)
(eieio-defclass-autoload 'gh-authenticator 'nil "gh-auth" "Abstract authenticator")
(eieio-defclass-autoload 'gh-password-authenticator '(gh-authenticator) "gh-auth" "Password-based authenticator")
(eieio-defclass-autoload 'gh-oauth-authenticator '(gh-authenticator) "gh-auth" "Oauth-based authenticator")
;;;***
;;;### (autoloads nil "gh-cache" "gh-cache.el" (22221 60701 606000
;;;;;; 0))
;;; Generated autoloads from gh-cache.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-common" "gh-common.el" (22221 60701 578000
;;;;;; 0))
;;; Generated autoloads from gh-common.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-gist" "gh-gist.el" (22221 60701 536000
;;;;;; 0))
;;; Generated autoloads from gh-gist.el
(require 'eieio)
(eieio-defclass-autoload 'gh-gist-api '(gh-api-v3) "gh-gist" "Gist API")
(eieio-defclass-autoload 'gh-gist-gist-stub '(gh-object) "gh-gist" "Class for user-created gist objects")
(eieio-defclass-autoload 'gh-gist-gist '(gh-gist-gist-stub) "gh-gist" "Gist object")
;;;***
;;;### (autoloads nil "gh-issue-comments" "gh-issue-comments.el"
;;;;;; (22221 60701 591000 0))
;;; Generated autoloads from gh-issue-comments.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-issues" "gh-issues.el" (22221 60701 615000
;;;;;; 0))
;;; Generated autoloads from gh-issues.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-oauth" "gh-oauth.el" (22221 60701 531000
;;;;;; 0))
;;; Generated autoloads from gh-oauth.el
(require 'eieio)
(eieio-defclass-autoload 'gh-oauth-api '(gh-api-v3) "gh-oauth" "OAuth API")
;;;***
;;;### (autoloads nil "gh-orgs" "gh-orgs.el" (22221 60701 586000
;;;;;; 0))
;;; Generated autoloads from gh-orgs.el
(require 'eieio)
(eieio-defclass-autoload 'gh-orgs-api '(gh-api-v3) "gh-orgs" "Orgs API")
(eieio-defclass-autoload 'gh-orgs-org-stub '(gh-object) "gh-orgs" nil)
;;;***
;;;### (autoloads nil "gh-pull-comments" "gh-pull-comments.el" (22221
;;;;;; 60701 627000 0))
;;; Generated autoloads from gh-pull-comments.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-pulls" "gh-pulls.el" (22221 60701 621000
;;;;;; 0))
;;; Generated autoloads from gh-pulls.el
(require 'eieio)
(eieio-defclass-autoload 'gh-pulls-api '(gh-api-v3) "gh-pulls" "Git pull requests API")
(eieio-defclass-autoload 'gh-pulls-request '(gh-pulls-request-stub) "gh-pulls" "Git pull requests API")
;;;***
;;;### (autoloads nil "gh-repos" "gh-repos.el" (22221 60701 598000
;;;;;; 0))
;;; Generated autoloads from gh-repos.el
(require 'eieio)
(eieio-defclass-autoload 'gh-repos-api '(gh-api-v3) "gh-repos" "Repos API")
(eieio-defclass-autoload 'gh-repos-repo-stub '(gh-object) "gh-repos" "Class for user-created repository objects")
(eieio-defclass-autoload 'gh-repos-repo '(gh-repos-repo-stub) "gh-repos" "Class for GitHub repositories")
;;;***
;;;### (autoloads nil "gh-url" "gh-url.el" (22221 60701 497000 0))
;;; Generated autoloads from gh-url.el
(require 'eieio)
;;;***
;;;### (autoloads nil "gh-users" "gh-users.el" (22221 60701 569000
;;;;;; 0))
;;; Generated autoloads from gh-users.el
(require 'eieio)
(eieio-defclass-autoload 'gh-users-api '(gh-api-v3) "gh-users" "Users API")
(eieio-defclass-autoload 'gh-users-user '(gh-user) "gh-users" nil)
;;;***
;;;### (autoloads nil nil ("gh-pkg.el" "gh-profile.el" "gh.el") (22221
;;;;;; 60701 645865 81000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; gh-autoloads.el ends here

View File

@ -0,0 +1,136 @@
;;; gh-cache.el --- caching for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'pcache)
(defconst gh-cache-outdated-expiration-delay (* 60 60 24))
(defconst gh-cache-internal-version-constant 3)
(defconst gh-cache-version-constant
(format "%s/gh-%s" pcache-version-constant gh-cache-internal-version-constant))
(defclass gh-cache (pcache-repository)
((version-constant :allocation :class)
(entries :initarg :entries :initform (make-hash-table :test 'equal))
(safe-methods :allocation :class :initform ("HEAD" "GET" "OPTIONS" "TRACE"))
(invalidation-chain :allocation :class :initform nil)
(entry-cls :initarg :entry-cls :initform gh-cache-entry)))
(oset-default 'gh-cache version-constant gh-cache-version-constant)
(defclass gh-cache-entry (pcache-entry)
((etag :initarg :etag :initform nil)
(outdated :initarg :outdated :initform nil)
;; (ttl :initarg :ttl :initform 0)
))
(defmethod pcache-invalidate :after ((cache gh-cache) key)
(let ((resource (car key)))
(pcache-map cache #'(lambda (k v)
(when (equal (car k) resource)
(pcache-invalidate cache k))))
(dolist (next (oref cache invalidation-chain))
(let ((nextresource
(replace-regexp-in-string (car next) (cdr next) resource)))
(when (not (equal nextresource resource))
(pcache-map cache #'(lambda (k v)
(when (equal (car k) nextresource)
(pcache-invalidate cache k)))))))))
(defmethod pcache-get ((cache gh-cache) key &optional default)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(if (not entry)
default
(unless (pcache-entry-valid-p entry)
(oset entry :outdated t))
(oref entry :value))))
(defmethod pcache-has ((cache pcache-repository) key)
(let* ((default (make-symbol ":nil"))
(table (oref cache :entries))
(entry (gethash key table default)))
(not (eq entry default))))
(defmethod pcache-purge-invalid ((cache gh-cache))
(let ((table (oref cache :entries)))
(maphash #'(lambda (k e)
(unless (gh-cache-expired-p e)
(remhash k table)))
table)
(pcache-save cache)))
(defmethod gh-cache-outdated-p ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oref entry :outdated))))
(defmethod gh-cache-expired-p ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and (gh-cache-outdated-p cache key)
(not
(let ((time (float-time (current-time))))
(< time (+ gh-cache-outdated-expiration-delay
(oref entry :timestamp))))))))
(defmethod gh-cache-revive ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oset entry :outdated nil)
(oset entry :timestamp (float-time (current-time)))
t)))
(defmethod gh-cache-etag ((cache gh-cache) key)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oref entry :etag))))
(defmethod gh-cache-set-etag ((cache gh-cache) key etag)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(and entry
(oset entry :etag etag))))
(provide 'gh-cache)
;;; gh-cache.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,116 @@
;;; gh-common.el --- common objects for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-profile)
(defgroup gh nil
"Github API client libraries."
:group 'applications)
(defclass gh-object ()
())
(defmethod gh-object-read :static ((obj gh-object) data)
(let ((target (if (object-p obj) obj
(make-instance obj))))
(when data
(gh-object-read-into target data))
target))
(defmethod gh-object-reader :static ((obj gh-object))
(apply-partially 'gh-object-read obj))
(defmethod gh-object-list-read :static ((obj gh-object) data)
(mapcar (gh-object-reader obj) data))
(defmethod gh-object-list-reader :static ((obj gh-object))
(apply-partially 'gh-object-list-read obj))
(defmethod gh-object-read-into ((obj gh-object) data))
(defmethod slot-unbound ((obj gh-object) cls slot-name fn)
(if (eq fn 'oref) nil
(call-next-method)))
(defclass gh-user (gh-object)
((login :initarg :login)
(id :initarg :id)
(avatar-url :initarg :avatar-url)
(gravatar-url :initarg :gravatar-url)
(url :initarg :url))
"Github user object")
(defmethod gh-object-read-into ((user gh-user) data)
(call-next-method)
(with-slots (login id avatar-url gravatar-url url)
user
(setq login (gh-read data 'login)
id (gh-read data 'id)
avatar-url (gh-read data 'avatar_url)
gravatar-url (gh-read data 'gravatar_url)
url (gh-read data 'url))))
(defun gh-read (obj field)
(cdr (assoc field obj)))
(defun gh-namespaced-key (key)
(let ((profile (gh-profile-current-profile)))
(concat "github."
(if (string= profile gh-profile-default-profile)
""
(concat profile "."))
key)))
(defun gh-config (key)
"Returns a GitHub specific value from the global Git config."
(let ((strip (lambda (string)
(if (> (length string) 0)
(substring string 0 (- (length string) 1))))))
(funcall strip (gh-command-to-string "config" (gh-namespaced-key key)))))
(defun gh-set-config (key value)
"Sets a GitHub specific value to the global Git config."
(gh-command-to-string "config" "--global" (gh-namespaced-key key) value))
(defun gh-command-to-string (&rest args)
(let ((git (executable-find "git")))
(with-output-to-string
(apply 'process-file git nil standard-output nil args))))
(provide 'gh-common)
;;; gh-common.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,191 @@
;;; gh-gist.el --- gist module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-gist-api (gh-api-v3)
((gist-cls :allocation :class :initform gh-gist-gist))
"Gist API")
;;;###autoload
(defclass gh-gist-gist-stub (gh-object)
((files :initarg :files :type list :initform nil)
(public :initarg :public)
(description :initarg :description)
(file-cls :allocation :class :initform gh-gist-gist-file))
"Class for user-created gist objects")
(defmethod gh-object-read-into ((stub gh-gist-gist-stub) data)
(call-next-method)
(with-slots (files public description)
stub
(setq files (gh-object-list-read (oref stub file-cls)
(gh-read data 'files))
public (gh-read data 'public)
description (gh-read data 'description))))
;;;###autoload
(defclass gh-gist-gist (gh-gist-gist-stub)
((date :initarg :date)
(update :initarg :update)
(push-url :initarg :push-url)
(pull-url :initarg :pull-url)
(html-url :initarg :html-url)
(comments :initarg :comments)
(user :initarg :user :initform nil)
(id :initarg :id :type string)
(url :initarg :url :type string)
(forks :initarg :forks :initform nil)
(user-cls :allocation :class :initform gh-user))
"Gist object")
(defmethod gh-object-read-into ((gist gh-gist-gist) data)
(call-next-method)
(with-slots (date update push-url pull-url html-url comments user
id url forks)
gist
(setq date (gh-read data 'created_at)
update (gh-read data 'updated_at)
push-url (gh-read data 'git_push_url)
pull-url (gh-read data 'git_pull_url)
html-url (gh-read data 'html_url)
comments (gh-read data 'comments)
user (gh-object-read (or (oref gist :user)
(oref gist user-cls))
(gh-read data 'user))
id (gh-read data 'id)
url (gh-read data 'url)
forks (gh-read data 'forks))))
(defclass gh-gist-gist-file (gh-object)
((filename :initarg :filename)
(size :initarg :size)
(url :initarg :url)
(content :initarg :content)))
(defmethod gh-object-read-into ((file gh-gist-gist-file) data)
(call-next-method)
(with-slots (filename size url content)
file
(setq
filename (gh-read data 'filename)
size (gh-read data 'size)
url (gh-read data 'raw_url)
content (gh-read data 'content))))
(defmethod gh-gist-gist-to-obj ((gist gh-gist-gist-stub))
`(("description" . ,(oref gist :description))
("public" . ,(oref gist :public))
("files" . ,(mapcar 'gh-gist-gist-file-to-obj (oref gist :files)))))
(defmethod gh-gist-gist-has-files ((gist gh-gist-gist-stub))
(not (memq nil (mapcar (lambda (f)
(oref f :content)) (oref gist :files)))))
(defmethod gh-gist-gist-file-to-obj ((file gh-gist-gist-file))
`(,(oref file :filename) . (("filename" . ,(oref file :filename))
("content" . ,(oref file :content)))))
(defmethod gh-gist-list ((api gh-gist-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET"
(format "/users/%s/gists" (or username (gh-api-get-username api)))))
(defmethod gh-gist-list-public ((api gh-gist-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/public"))
(defmethod gh-gist-list-starred ((api gh-gist-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/starred"))
(defmethod gh-gist-get ((api gh-gist-api) gist-or-id)
(let (id transformer)
(if (stringp gist-or-id)
(setq id gist-or-id
transformer (gh-object-reader (oref api gist-cls)))
(setq id (oref gist-or-id :id)
transformer (gh-object-reader gist-or-id)))
(gh-api-authenticated-request
api transformer "GET" (format "/gists/%s" id))))
(defmethod gh-gist-new ((api gh-gist-api) gist-stub)
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "POST" "/gists"
(gh-gist-gist-to-obj gist-stub)))
(defmethod gh-gist-edit ((api gh-gist-api) gist)
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "PATCH"
(format "/gists/%s"
(oref gist :id))
(gh-gist-gist-to-obj gist)))
(defmethod gh-gist-set-star ((api gh-gist-api) gist-or-id star)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore (if star "PUT" "DELETE")
(format "/gists/%s/star" id))))
(defmethod gh-gist-get-star ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore "GET" (format "/gists/%s/star" id))))
(defmethod gh-gist-fork ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api (gh-object-reader (oref api gist-cls)) "POST"
(format "/gists/%s/forks" id))))
(defmethod gh-gist-delete ((api gh-gist-api) gist-or-id)
(let ((id (if (stringp gist-or-id) gist-or-id
(oref gist-or-id :id))))
(gh-api-authenticated-request
api 'ignore "DELETE" (format "/gists/%s" id))))
(provide 'gh-gist)
;;; gh-gist.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,110 @@
;;; gh-issue-comments.el --- issue comments api for github
;; Copyright (C) 2014 Travis Thieman
;; Author: Travis Thieman <travis.thieman@gmail.com>
;; Keywords:
;; 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:
;; TODOS:
;; * Support listing all comments in a repository
;; Basic usage:
;; (setf api (gh-issue-comments-api "api" :sync nil :cache nil :num-retries 1))
;; (setf comments (gh-issue-comments-list api "user" "repo" "issue id"))
;; (setq my-comment (make-instance 'gh-issue-comments-comment :body "This is great!"))
;; (gh-issue-comments-new api "user" "repo" "issue id" my-comment)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(require 'gh-issues)
(defclass gh-issue-comments-api (gh-api-v3)
((comment-cls :allocation :class :initform gh-issue-comments-comment))
"GitHub Issue Comments api")
(defclass gh-issue-comments-comment (gh-object)
((url :initarg :url)
(html-url :initarg :html-url)
(body :initarg :body)
(user :initarg :user :initform nil)
(created-at :initarg :created_at)
(updated-at :initarg :updated_at)
(user-cls :allocation :class :initform gh-user))
"issues comment")
(defmethod gh-object-read-into ((comment gh-issue-comments-comment) data)
(call-next-method)
(with-slots (url html-url body user created-at updated-at)
comment
(setq url (gh-read data 'url)
html-url (gh-read data 'html-url)
body (gh-read data 'body)
user (gh-object-read (or (oref comment :user)
(oref comment user-cls))
(gh-read data 'user))
created-at (gh-read data 'created_at)
updated-at (gh-read data 'updated_at))))
(defmethod gh-issue-comments-list ((api gh-issue-comments-api) user repo issue-id)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api comment-cls)) "GET"
(format "/repos/%s/%s/issues/%s/comments" user repo issue-id)))
(defmethod gh-issue-comments-get ((api gh-issue-comments-api) user repo comment-id)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "GET"
(format "/repos/%s/%s/issues/comments/%s" user repo comment-id)))
(defmethod gh-issue-comments-req-to-update ((req gh-issue-comments-comment))
`(("body" . ,(oref req body))))
(defmethod gh-issue-comments-update ((api gh-issue-comments-api) user repo comment-id comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "PATCH"
(format "/repos/%s/%s/issues/comments/%s" user repo comment-id)
(gh-issue-comments-req-to-update comment)))
(defmethod gh-issue-comments-new ((api gh-issue-comments-api) user repo issue-id comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api comment-cls)) "POST"
(format "/repos/%s/%s/issues/%s/comments" user repo issue-id)
(gh-issue-comments-req-to-update comment)))
(defmethod gh-issue-comments-delete ((api gh-issue-comments-api) user repo comment-id)
(gh-api-authenticated-request
api nil "DELETE"
(format "/repos/%s/%s/issues/comments/%s" user repo comment-id)))
(provide 'gh-issue-comments)
;;; gh-issue-comments.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,308 @@
;;; gh-issues.el --- issues api for github
;; Copyright (C) 2012 Raimon Grau
;; Author: Raimon Grau <raimonster@gmail.com>
;; Keywords:
;; 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:
;; Basic usage:
;; (setf api (gh-issues-api "api" :sync nil :cache nil :num-retries 1))
;; (setf issues (gh-issues-list api "user" "repo"))
;; (last (oref issues data)) ; get one issue
;; (setq mi (make-instance 'gh-issues-issue :body "issue body" :title "issue title"))
;; (gh-issues-issue-new api "user" "repo" mi)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(require 'gh-repos)
(defclass gh-issues-api (gh-api-v3)
((issue-cls :allocation :class :initform gh-issues-issue)
(milestone-cls :allocation :class :initform gh-issues-milestone)
(label-cls :allocation :class :initform gh-issues-label))
"Github Issues api")
(defclass gh-issues-issue (gh-object)
((url :initarg :url)
(html-url :initarg :html-url)
(number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(body :initarg :body)
(user :initarg :user :initform nil)
(labels :initarg :labels :initform nil)
(assignee :initarg :assignee :initform nil)
(milestone :initarg :milestone :initform nil)
(open_issues :initarg :open_issues)
(closed_issues :initarg :closed_issues)
(created_at :initarg :created_at)
(due_on :initarg :due_on)
(user-cls :allocation :class :initform gh-user)
(milestone-cls :allocation :class :initform gh-issues-milestone))
"issues request")
(defclass gh-issues-label (gh-object)
((url :initarg :url)
(name :initarg :name)
(color :initarg :color)))
(defclass gh-issues-milestone (gh-object)
((url :initarg :url)
(number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(description :initarg :description)
(creator :initarg :creator :initform nil)
(open_issues :initarg :open_issues)
(closed_issues :initarg :closed_issues)
(created_at :initarg :created_at)
(due_on :initarg :due_on)
(user-cls :allocation :class :initform gh-user))
"github milestone")
(defmethod gh-object-read-into ((issue gh-issues-issue) data)
(call-next-method)
(with-slots (url html-url number state title body
user labels assignee milestone open_issues
closed_issues created_at due_on)
issue
(setq url (gh-read data 'url)
html-url (gh-read data 'html_url)
number (gh-read data 'number)
state (gh-read data 'state)
title (gh-read data 'title)
body (gh-read data 'body)
user (gh-object-read (or (oref issue :user)
(oref issue user-cls))
(gh-read data 'user))
labels (gh-read data 'labels)
assignee (gh-object-read (or (oref issue :assignee)
(oref issue user-cls))
(gh-read data 'assignee))
milestone (gh-object-read (or (oref issue :milestone)
(oref issue milestone-cls))
(gh-read data 'milestone))
open_issues (gh-read data 'open_issues)
closed_issues (gh-read data 'closed_issues)
created_at (gh-read data 'created_at)
due_on (gh-read data 'due_on))))
(defmethod gh-object-read-into ((milestone gh-issues-milestone) data)
(call-next-method)
(with-slots (url number state title description creator
open_issues closed_issues
created_at due_on)
milestone
(setq url (gh-read data 'url)
number (gh-read data 'number)
state (gh-read data 'state)
title (gh-read data 'title)
description (gh-read data 'description)
creator (gh-object-read (or (oref milestone :creator)
(oref milestone user-cls))
(gh-read data 'creator))
open_issues (gh-read data 'open_issues)
closed_issues (gh-read data 'closed_issues)
created_at (gh-read data 'created_at)
due_on (gh-read data 'due_on))))
(defmethod gh-issues-issue-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api issue-cls)) "GET"
(format "/repos/%s/%s/issues" user repo)))
(defmethod gh-issues-milestone-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api milestone-cls)) "GET"
(format "/repos/%s/%s/milestones" user repo)))
(defmethod gh-issues-milestone-get ((api gh-issues-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "GET"
(format "/repos/%s/%s/milestones/%s" user repo id)))
(defmethod gh-issues-milestone-new ((api gh-issues-api) user repo milestone)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "POST"
(format "/repos/%s/%s/milestones" user repo)
(gh-issues-milestone-req-to-update milestone)))
(defmethod gh-issues-milestone-update ((api gh-issues-api) user repo
id milestone)
(gh-api-authenticated-request
api (gh-object-reader (oref api milestone-cls)) "PATCH"
(format "/repos/%s/%s/milestones/%s" user repo id)
(gh-issues-milestone-req-to-update milestone)))
(defmethod gh-issues-milestone-req-to-update ((milestone gh-issues-milestone))
(let ((state (oref milestone state) )
(description (oref milestone description))
(due_on (oref milestone due_on))
(to-update `(("title" . ,(oref milestone title)))))
(when state (nconc to-update `(("state" . ,state))))
(when description (nconc to-update `(("description" . ,description))))
(when due_on (nconc to-update `(("due_on" . ,due_on))))
to-update))
(defmethod gh-issues-issue-get ((api gh-issues-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "GET"
(format "/repos/%s/%s/issues/%s" user repo id)))
(defmethod gh-issues-issue-req-to-update ((req gh-issues-issue))
(let ((assignee (oref req assignee))
;; (labels (oref req labels))
(milestone (oref req milestone))
(to-update `(("title" . ,(oref req title))
("state" . ,(oref req state))
("body" . ,(oref req body)))))
;; (when labels (nconc to-update `(("labels" . ,(oref req labels) ))))
(when milestone
(nconc to-update `(("milestone" . ,(oref milestone number)))))
(when assignee
(nconc to-update `(("assignee" . ,(oref assignee login) ))))
to-update))
(defmethod gh-issues-issue-update ((api gh-issues-api) user repo id req)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "PATCH"
(format "/repos/%s/%s/issues/%s" user repo id)
(gh-issues-issue-req-to-update req)))
(defmethod gh-issues-issue-new ((api gh-issues-api) user repo issue)
(gh-api-authenticated-request
api (gh-object-reader (oref api issue-cls)) "POST"
(format "/repos/%s/%s/issues" user repo)
(gh-issues-issue-req-to-update issue)))
;;; labels
(defclass gh-issues-label (gh-object)
((url :initarg :url)
(name :initarg :name)
(color :initarg :color)))
(defmethod gh-object-read-into ((label gh-issues-label) data)
(call-next-method)
(with-slots (url name color)
label
(setq url (gh-read data 'url)
name (gh-read data 'name)
color (gh-read data 'color))))
(defmethod gh-issues-label-req-to-update ((label gh-issues-label))
`(("name" . ,(oref label name))
("color" . ,(oref label color))))
(defmethod gh-issues-label-get ((api gh-issues-api) user repo name)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/labels/%s" user repo name)))
(defmethod gh-issues-label-list ((api gh-issues-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/labels" user repo )))
(defmethod gh-issues-label-new ((api gh-issues-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "POST"
(format "/repos/%s/%s/labels" user repo)
(gh-issues-label-req-to-update req)))
(defmethod gh-issues-label-update ((api gh-issues-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "POST"
(format "/repos/%s/%s/labels/%s" user repo (oref req name))
(gh-issues-label-req-to-update req)))
(defmethod gh-issues-label-delete ((api gh-issues-api) user repo name)
(gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "DELETE"
(format "/repos/%s/%s/labels/%s" user repo name)))
(defmethod gh-issues-labels-in-issue ((api gh-issues-api) user repo
issue-or-issue-id)
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
(defmethod gh-issues-labels-add-to-issue ((api gh-issues-api) user repo
issue-or-issue-id labels)
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "PUT"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id)
(mapcar #'gh-issues--label-name labels))))
(defmethod gh-issues-labels-remove-all-from-issue ((api gh-issues-api) user repo
issue-or-issue-id )
(let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
(gh-api-authenticated-request
api (lambda (x) x) "DELETE"
(format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
(defmethod gh-issues-labels-in-milestone ((api gh-issues-api) user repo
milestone-or-milestone-id)
(let ((milestone-id (gh-issues--milestone-id milestone-or-milestone-id)))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api label-cls)) "GET"
(format "/repos/%s/%s/milestones/%s/labels" user repo milestone-id))))
;;; helpers
(defun gh-issues--issue-id (issue-or-issue-id)
(if (eieio-object-p issue-or-issue-id)
(oref issue-or-issue-id id)
issue-or-issue-id))
(defun gh-issues--milestone-id (milestone-or-milestone-id)
(if (eieio-object-p milestone-or-milestone-id)
(oref milestone-or-milestone-id id)
milestone-or-milestone-id))
(defun gh-issues--label-name (label-or-label-name)
(if (eieio-object-p label-or-label-name)
(oref label-or-label-name name)
label-or-label-name))
(provide 'gh-issues)
;;; gh-issues.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,119 @@
;;; gh-oauth.el --- oauth module for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-oauth-api (gh-api-v3)
((auth-cls :allocation :class :initform gh-oauth-authorization))
"OAuth API")
(defclass gh-oauth-password-authenticator (gh-password-authenticator)
((remember :allocation :class :initform nil)))
(defmethod constructor :static ((api gh-oauth-api) &rest args)
;; force password authentication for this API
(let ((gh-api-v3-authenticator 'gh-oauth-password-authenticator))
(call-next-method)))
(defclass gh-oauth-authorization (gh-object)
((id :initarg :id)
(url :initarg :url)
(scopes :initarg :scopes)
(token :initarg :token)
(app :initarg :app :initform nil)
(updated-at :initarg :updated-at)
(created-at :initarg :created-at)
(app-cls :allocation :class :initform gh-oauth-app)))
(defmethod gh-object-read-into ((auth gh-oauth-authorization) data)
(call-next-method)
(with-slots (id url scopes token app updated-at created-at)
auth
(setq id (gh-read data 'id)
url (gh-read data 'url)
scopes (gh-read data 'scopes)
token (gh-read data 'token)
app (gh-object-read (or (oref auth :app)
(oref auth app-cls))
(gh-read data 'app))
updated-at (gh-read data 'updated_at)
created-at (gh-read data 'created_at))))
(defclass gh-oauth-app (gh-object)
((url :initarg :url)
(name :initarg :name)))
(defmethod gh-object-read-into ((app gh-oauth-app) data)
(call-next-method)
(with-slots (url name)
app
(setq url (gh-read data 'url)
name (gh-read data 'name))))
(defmethod gh-oauth-auth-list ((api gh-oauth-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api auth-cls)) "GET"
(format "/authorizations")))
(defmethod gh-oauth-auth-get ((api gh-oauth-api) id)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "GET"
(format "/authorizations/%s" id)))
(defmethod gh-oauth-auth-new ((api gh-oauth-api) &optional scopes)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "POST"
(format "/authorizations") (list (cons 'scopes scopes)
(cons 'note (format "gh.el - %s"
(system-name))))))
(defmethod gh-oauth-auth-update ((api gh-oauth-api) id &optional scopes)
(gh-api-authenticated-request
api (gh-object-reader (oref api auth-cls)) "PATCH"
(format "/authorizations/%s" id) (list (cons 'scopes scopes))))
(defmethod gh-oauth-auth-delete ((api gh-oauth-api) id)
(gh-api-authenticated-request
api nil "DELETE" (format "/authorizations/%s" id)))
(provide 'gh-oauth)
;;; gh-oauth.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,163 @@
;;; gh-org.el --- orgs module for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-orgs-api (gh-api-v3)
((org-cls :allocation :class :initform gh-orgs-org))
"Orgs API")
;;;###autoload
(defclass gh-orgs-org-stub (gh-object)
((login :initarg :login)
(id :initarg :id)
(url :initarg :url)
(avatar-url :initarg :avatar-url)))
(defmethod gh-object-read-into ((stub gh-orgs-org-stub) data)
(call-next-method)
(with-slots (login id url avatar-url)
stub
(setq login (gh-read data 'login)
id (gh-read data 'id)
url (gh-read data 'url)
avatar-url (gh-read data 'avatar_url))))
(defclass gh-orgs-plan (gh-object)
((name :initarg :name)
(space :initarg :space)
(private-repos :initarg :private-repos)))
(defmethod gh-object-read-into ((plan gh-orgs-plan) data)
(call-next-method)
(with-slots (name space private-repos)
plan
(setq name (gh-read data 'name)
space (gh-read data 'space)
private-repos (gh-read data 'private_repos))))
(defclass gh-orgs-org (gh-orgs-org-stub)
((name :initarg :name)
(company :initarg :company)
(blog :initarg :blog)
(location :initarg :location)
(email :initarg :email)
(public-repos :initarg :public-repos)
(public-gists :initarg :public-gists)
(followers :initarg :followers)
(following :initarg :following)
(html-url :initarg :html-url)
(created-at :initarg :created-at)
(type :initarg :type)
(total-private-repos :initarg :total-private-repos)
(owned-private-repos :initarg :owned-private-repos)
(private-gists :initarg :private-gists)
(disk-usage :initarg :disk-usage)
(collaborators :initarg :collaborators)
(billing-email :initarg :billing-email)
(plan :initarg :plan :initform nil)
(plan-cls :allocation :class :initform gh-orgs-plan))
"Class for GitHub organizations")
(defmethod gh-object-read-into ((org gh-orgs-org) data)
(call-next-method)
(with-slots (name company blog location email
public-repos public-gists followers following
html-url created-at type
total-private-repos owned-private-repos
private-gists disk-usage collaborators
billing-email plan)
org
(setq name (gh-read data 'name)
company (gh-read data 'company)
blog (gh-read data 'blog)
location (gh-read data 'location)
email (gh-read data 'email)
public-repos (gh-read data 'public_repos)
public-gists (gh-read data 'public_gists)
followers (gh-read data 'followers)
following (gh-read data 'following)
html-url (gh-read data 'html_url)
created-at (gh-read data 'created_at)
type (gh-read data 'type)
total-private-repos (gh-read data 'total_private_repos)
owned-private-repos (gh-read data 'owned_private_repos)
private-gists (gh-read data 'private_gists)
disk-usage (gh-read data 'disk_usage)
collaborators (gh-read data 'collaborators)
billing-email (gh-read data 'billing_email)
plan (gh-object-read (or (oref org :plan)
(oref org plan-cls))
(gh-read data 'plan)))))
(defmethod gh-orgs-org-to-obj ((org gh-orgs-org))
`(,@(when (slot-boundp org :billing-email)
(list (cons "billing_email" (oref org :billing-email))))
,@(when (slot-boundp org :blog)
(list (cons "blog" (oref org :blog))))
,@(when (slot-boundp org :company)
(list (cons "company" (oref org :company))))
,@(when (slot-boundp org :email)
(list (cons "email" (oref org :email))))
,@(when (slot-boundp org :location)
(list (cons "location" (oref org :location))))
,@(when (slot-boundp org :name)
(list (cons "name" (oref org :name))))))
(defmethod gh-orgs-list ((api gh-orgs-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api org-cls)) "GET"
(format "/users/%s/orgs" (or username (gh-api-get-username api)))))
(defmethod gh-orgs-get ((api gh-orgs-api) org)
(gh-api-authenticated-request
api (gh-object-reader (oref api org-cls)) "GET"
(format "/orgs/%s" org)))
(defmethod gh-orgs-update ((api gh-orgs-api) org-obj)
(gh-api-authenticated-request
api (gh-object-reader (oref api org-cls)) "PATCH"
(format "/orgs/%s" (oref org-obj :login))
(apply 'gh-orgs-org-to-obj org-obj nil)))
(provide 'gh-orgs)
;;; gh-org.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,7 @@
(define-package "gh" "20160222.1811" "A GitHub library for Emacs"
'((emacs "24.4")
(pcache "0.3.1")
(logito "0.1")))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,103 @@
;;; gh-profile.el --- profile support for gh.el
;; Copyright (C) 2013 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
(require 'rx)
(require 'url-parse)
(defgroup gh-profile nil
"Github profile."
:group 'gh)
(defun gh-profile-remote-regexp (domain)
(eval
`(rx bol (or ,(concat "git@" domain ":")
(and (or "git" "ssh" "http" "https") "://"
(* nonl) (? "@") ,domain "/"))
(and (group (* nonl)) "/" (group (* nonl))) (? ".git"))))
(defcustom gh-profile-alist `(("github"
:url "https://api.github.com"
:remote-regexp
,(gh-profile-remote-regexp "github.com")))
"List of profiles for Github access. List every Github
Enterprise server and/or Github accounts you have access
to here."
:type '(alist :key-type string
:value-type (plist :key-type (choice (const :url)
(const :username)
(const :password)
(const :token)
(const :remote-regexp))
:value-type string))
:group 'gh-profile)
(defun gh-profile-get-remote-regexp (profile)
(let* ((profile-plist (cdr (assoc profile gh-profile-alist)))
(regexp (plist-get profile-plist :remote-regexp)))
(if regexp
regexp
;; try to guess remote format (just use the hostname)
(let* ((url (url-generic-parse-url (plist-get profile-plist :url)))
(host (url-host url)))
(gh-profile-remote-regexp host)))))
(defcustom gh-profile-default-profile "github"
"Default profile. This needs to be a key present in
`gh-profile-alist'"
:type 'string
:group 'gh-profile)
(defvar gh-profile-current-profile nil)
(make-variable-buffer-local 'gh-profile-current-profile)
(defun gh-profile-current-profile ()
(or gh-profile-current-profile
gh-profile-default-profile))
(defun gh-profile-url ()
(plist-get (cdr (assoc (or gh-profile-current-profile
gh-profile-default-profile)
gh-profile-alist)) :url))
(defun gh-profile-completing-read ()
(let ((profiles (mapcar #'car gh-profile-alist)))
(if (> (length profiles) 1)
(completing-read "Github profile: " profiles nil t nil nil (first profiles))
(car profiles))))
(defun gh-profile-get-remote-profile (remote-url)
(loop for (id . props) in gh-profile-alist
if (string-match (gh-profile-get-remote-regexp id)
remote-url)
return id))
(provide 'gh-profile)
;;; gh-profile.el ends here

View File

@ -0,0 +1,139 @@
;;; gh-pull-comments.el --- pull request comments api for github
;; Copyright (C) 2014 Toni Reina
;; Author: Toni Reina <areina0@gmail.com>
;; Keywords:
;; 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:
;; TODOS:
;; * Support listing all comments in a repository
;; Basic usage:
;; (setf api (gh-pull-comments-api "api" :sync nil :cache nil :num-retries 1))
;; (setf comments (gh-pull-comments-list api "user" "repo" "pull request id"))
;; (setq my-comment (make-instance 'gh-pull-comments-comment
;; :body "This is great!"
;; :path "README.md"
;; :position 2
;; :commit-id "commit sha"))
;; (gh-pull-comments-new api "user" "repo" "pull request id" my-comment)
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(defclass gh-pull-comments-api (gh-api-v3)
((pull-comment-cls :allocation :class :initform gh-pull-comments-comment))
"GitHub Pull Request Comments API")
(defclass gh-pull-comments-comment (gh-object)
((url :initarg :url)
(html-url :initarg :html-url)
(id :initarg :id)
(body :initarg :body)
(user :initarg :user :initform nil)
(path :initarg :path)
(diff-hunk :initarg :diff-hunk)
(position :initarg :position)
(original-position :initarg :original-position)
(commit-id :initarg :commit-id)
(original-commit-id :initarg :original-commit-id)
(in-reply-to :initarg :in-reply-to :initform nil)
(created-at :initarg :created_at)
(updated-at :initarg :updated_at)
(user-cls :allocation :class :initform gh-user))
"Class for Pull Requests comments")
(defmethod gh-object-read-into ((comment gh-pull-comments-comment) data)
(call-next-method)
(with-slots (url html-url id body user path diff-hunk position
original-position commit-id original-commit-id in-reply-to
created-at updated-at)
comment
(setq url (gh-read data 'url)
html-url (gh-read data 'html-url)
id (gh-read data 'id)
body (gh-read data 'body)
user (gh-object-read (or (oref comment :user)
(oref comment user-cls))
(gh-read data 'user))
path (gh-read data 'path)
diff-hunk (gh-read data 'diff_hunk)
position (gh-read data 'position)
original-position (gh-read data 'original_position)
commit-id (gh-read data 'commit_id)
original-commit-id (gh-read data 'original_commit_id)
in-reply-to (gh-read data 'in_reply_to)
created-at (gh-read data 'created_at)
updated-at (gh-read data 'updated_at))))
(defmethod gh-pull-comments-list ((api gh-pull-comments-api) user repo pull-id)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api pull-comment-cls)) "GET"
(format "/repos/%s/%s/pulls/%s/comments" user repo pull-id)))
(defmethod gh-pull-comments-get ((api gh-pull-comments-api) user repo pull-id)
(gh-api-authenticated-request
api (gh-object-reader (oref api pull-comment-cls)) "GET"
(format "/repos/%s/%s/pulls/comments/%s" user repo pull-id)))
(defmethod gh-pull-comments-req-to-create ((req gh-pull-comments-comment))
(let ((in-reply-to (oref req in-reply-to))
(to-update `(("body" . ,(oref req body)))))
(if in-reply-to
(nconc to-update `(("in_reply_to" . ,in-reply-to)))
(nconc to-update `(("commit_id" . ,(oref req commit-id))
("path" . ,(oref req path))
("position" . ,(oref req position)))))
to-update))
(defmethod gh-pull-comments-req-to-update ((req gh-pull-comments-comment))
`(("body" . ,(oref req body))))
(defmethod gh-pull-comments-update ((api gh-pull-comments-api) user repo comment-id comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api pull-comment-cls)) "PATCH"
(format "/repos/%s/%s/pulls/comments/%s" user repo comment-id)
(gh-pull-comments-req-to-update comment)))
(defmethod gh-pull-comments-new ((api gh-pull-comments-api) user repo pull-id comment)
(gh-api-authenticated-request
api (gh-object-reader (oref api pull-comment-cls)) "POST"
(format "/repos/%s/%s/pulls/%s/comments" user repo pull-id)
(gh-pull-comments-req-to-create comment)))
(defmethod gh-pull-comments-delete ((api gh-pull-comments-api) user repo comment-id)
(gh-api-authenticated-request
api nil "DELETE"
(format "/repos/%s/%s/pulls/comments/%s" user repo comment-id)))
(provide 'gh-pull-comments)
;;; gh-pull-comments.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,172 @@
;;; gh-pulls.el --- pull requests module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
(require 'gh-repos)
(defclass gh-pulls-cache (gh-cache)
((invalidation-chain :allocation :class
:initform '(("^/repos/.*/.*/pulls$" . "\0")
("^/repos/.*/.*/pulls/.*$" . "\0")))))
;;;###autoload
(defclass gh-pulls-api (gh-api-v3)
((cache-cls :allocation :class :initform gh-pulls-cache)
(req-cls :allocation :class :initform gh-pulls-request))
"Git pull requests API")
(defclass gh-pulls-request-stub (gh-object)
((url :initarg :url)
(html-url :initarg :html-url)
(diff-url :initarg :diff-url)
(patch-url :initarg :patch-url)
(issue-url :initarg :issue-url)
(number :initarg :number)
(state :initarg :state)
(title :initarg :title)
(body :initarg :body)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at)
(closed-at :initarg :closed-at)
(merged-at :initarg :merged-at)
(head :initarg :head :initform nil)
(base :initarg :base :initform nil)
(ref-cls :allocation :class :initform gh-repos-ref)))
(defmethod gh-object-read-into ((stub gh-pulls-request-stub) data)
(call-next-method)
(with-slots (url html-url diff-url patch-url issue-url number
state title body created-at updated-at
closed-at merged-at head base)
stub
(setq url (gh-read data 'url)
html-url (gh-read data 'html_url)
diff-url (gh-read data 'diff_url)
patch-url (gh-read data 'patch_url)
issue-url (gh-read data 'issue_url)
number (gh-read data 'number)
state (gh-read data 'state)
title (gh-read data 'title)
body (gh-read data 'body)
created-at (gh-read data 'created_at)
updated-at (gh-read data 'updated_at)
closed-at (gh-read data 'closed_at)
merged-at (gh-read data 'merged_at)
head (gh-object-read (or (oref stub :head)
(oref stub ref-cls))
(gh-read data 'head))
base (gh-object-read (or (oref stub :base)
(oref stub ref-cls))
(gh-read data 'base)))))
;;;###autoload
(defclass gh-pulls-request (gh-pulls-request-stub)
((merged :initarg :merged)
(mergeable :initarg :mergeable)
(merged-by :initarg :merged-by)
(comments :initarg :comments)
(user :initarg :user :initform nil)
(commits :initarg :commits)
(additions :initarg :additions)
(deletions :initarg :deletions)
(changed-files :initarg :changed-files)
(ref-cls :allocation :class :initform gh-repos-ref)
(user-cls :allocation :class :initform gh-user))
"Git pull requests API")
(defmethod gh-object-read-into ((req gh-pulls-request) data)
(call-next-method)
(with-slots (merged mergeable
merged-by comments user commits additions
deletions changed-files)
req
(setq merged (gh-read data 'merged)
mergeable (gh-read data 'mergeable)
merged-by (gh-read data 'merged_by)
comments (gh-read data 'comments)
user (gh-object-read (or (oref req :user)
(oref req user-cls))
(gh-read data 'user))
commits (gh-read data 'commits)
additions (gh-read data 'additions)
deletions (gh-read data 'deletions)
changed-files (gh-read data 'changed_files))))
(defmethod gh-pulls-req-to-new ((req gh-pulls-request))
(let ((head (oref req :head))
(base (oref req :base)))
`(("title" . ,(oref req :title))
("body" . ,(oref req :body))
("head" . ,(or (oref head :ref) (oref head :sha)))
("base" . ,(or (oref base :ref) (oref base :sha))))))
(defmethod gh-pulls-req-to-update ((req gh-pulls-request-stub))
`(("title" . ,(oref req :title))
("body" . ,(oref req :body))
("state" . ,(oref req :state))))
(defmethod gh-pulls-list ((api gh-pulls-api) user repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api req-cls)) "GET"
(format "/repos/%s/%s/pulls" user repo)))
(defmethod gh-pulls-get ((api gh-pulls-api) user repo id)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "GET"
(format "/repos/%s/%s/pulls/%s" user repo id)))
(defmethod gh-pulls-new ((api gh-pulls-api) user repo req)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "POST"
(format "/repos/%s/%s/pulls" user repo)
(gh-pulls-req-to-new req)))
(defmethod gh-pulls-update ((api gh-pulls-api) user repo id req)
(gh-api-authenticated-request
api (gh-object-reader (oref api req-cls)) "PATCH"
(format "/repos/%s/%s/pulls/%s" user repo id)
(gh-pulls-req-to-update req)))
(provide 'gh-pulls)
;;; gh-pulls.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,390 @@
;;; gh-repos.el --- repos module for gh.el
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-repos-api (gh-api-v3)
((repo-cls :allocation :class :initform gh-repos-repo)
(user-cls :allocation :class :initform gh-user))
"Repos API")
;;;###autoload
(defclass gh-repos-repo-stub (gh-object)
((name :initarg :name)
(description :initarg :description)
(homepage :initarg :homepage)
(private :initarg :private))
"Class for user-created repository objects")
(defmethod gh-object-read-into ((stub gh-repos-repo-stub) data)
(call-next-method)
(with-slots (name description homepage private)
stub
(setq name (gh-read data 'name)
description (gh-read data 'description)
homepage (gh-read data 'homepage)
private (gh-read data 'private))))
;;;###autoload
(defclass gh-repos-repo (gh-repos-repo-stub)
((url :initarg :url)
(html-url :initarg :html-url)
(clone-url :initarg :clone-url)
(git-url :initarg :git-url)
(ssh-url :initarg :ssh-url)
(svn-url :initarg :svn-url)
(mirror-url :initarg :mirror-url)
(owner :initarg :owner :initform nil)
(id :initarg :id)
(full-name :initarg full-name)
(language :initarg :language)
(fork :initarg :fork)
(forks :initarg :forks)
(forks-count :initarg forks-count)
(watchers :initarg :watchers)
(watchers-count :initarg watchers-count)
(size :initarg :size)
(master-branch :initarg :master-branch)
(open-issues :initarg :open-issues)
(pushed-at :initarg :pushed-at)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at)
(organisation :initarg :organisation :initform nil)
(parent :initarg :parent)
(source :initarg :source)
(has-issues :initarg :has-issues)
(has-wiki :initarg :has-wiki)
(has-downloads :initarg :has-downloads)
(owner-cls :allocation :class :initform gh-user)
(organisation-cls :allocation :class :initform gh-user)
(parent-cls :allocation :class :initform gh-repos-repo)
(source-cls :allocation :class :initform gh-repos-repo))
"Class for GitHub repositories")
(defmethod gh-object-read-into ((repo gh-repos-repo) data)
(call-next-method)
(with-slots (url html-url clone-url git-url ssh-url svn-url mirror-url
id owner full-name language fork forks forks-count
watchers watchers-count size master-branch open-issues
pushed-at created-at organisation parent source
has-issues has-wiki has-downloads)
repo
(setq url (gh-read data 'url)
html-url (gh-read data 'html_url)
clone-url (gh-read data 'clone_url)
git-url (gh-read data 'git_url)
ssh-url (gh-read data 'ssh_url)
svn-url (gh-read data 'svn_url)
mirror-url (gh-read data 'mirror_url)
id (gh-read data 'id)
owner (gh-object-read (or (oref repo :owner)
(oref repo owner-cls))
(gh-read data 'owner))
full-name (gh-read data 'full_name)
language (gh-read data 'language)
fork (gh-read data 'fork)
forks (gh-read data 'forks)
forks-count (gh-read data 'forks_count)
watchers (gh-read data 'watchers)
watchers-count (gh-read data 'watchers_count)
size (gh-read data 'size)
master-branch (gh-read data 'master_branch)
open-issues (gh-read data 'open_issues)
pushed-at (gh-read data 'pushed_at)
created-at (gh-read data 'created_at)
organisation (gh-object-read (or (oref repo :organisation)
(oref repo organisation-cls))
(gh-read data 'organisation))
parent (gh-object-read (oref repo parent-cls)
(gh-read data 'parent))
source (gh-object-read (oref repo source-cls)
(gh-read data 'source))
has-issues (gh-read data 'has_issues)
has-wiki (gh-read data 'has_wiki)
has-downloads (gh-read data 'has_downloads))))
(defclass gh-repos-ref (gh-object)
((label :initarg :label)
(ref :initarg :ref :initform nil)
(sha :initarg :sha :initform nil)
(user :initarg :user :initform nil)
(repo :initarg :repo :initform nil)
(user-cls :allocation :class :initform gh-user)
(repo-cls :allocation :class :initform gh-repos-repo)))
(defmethod gh-object-read-into ((r gh-repos-ref) data)
(call-next-method)
(with-slots (label ref sha user repo)
r
(setq label (gh-read data 'label)
ref (gh-read data 'ref)
sha (gh-read data 'sha)
user (gh-object-read (or (oref r :user)
(oref r user-cls))
(gh-read data 'user))
repo (gh-object-read (or (oref r :repo)
(oref r repo-cls))
(gh-read data 'repo)))))
(defmethod gh-repos-user-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/repos" (or username (gh-api-get-username api)))))
(defmethod gh-repos-org-list ((api gh-repos-api) org)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/orgs/%s/repos" org)))
(defmethod gh-repos-repo-to-obj ((repo gh-repos-repo-stub)
&rest caps)
(let ((has_issues (plist-member caps :issues))
(has_wiki (plist-member caps :wiki))
(has_downloads (plist-member caps :downloads)))
`(("name" . ,(oref repo :name))
,@(when (slot-boundp repo :homepage)
(list (cons "homepage" (oref repo :homepage))))
,@(when (slot-boundp repo :description)
(list (cons "description" (oref repo :description))))
,@(when (slot-boundp repo :private)
(list (cons "public" (not (oref repo :private)))))
,@(when has_issues
(list (cons "has_issues" (plist-get caps :issues))))
,@(when has_wiki
(list (cons "has_wiki" (plist-get caps :wiki))))
,@(when has_downloads
(list (cons "has_downloads" (plist-get caps :downloads)))))))
(defmethod gh-repos-repo-new ((api gh-repos-api) repo-stub
&optional org &rest caps)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "POST"
(if org (format "/orgs/%s/repos" org)
"/user/repos")
(apply 'gh-repos-repo-to-obj repo-stub caps)))
(defmethod gh-repos-repo-get ((api gh-repos-api) repo-id &optional user)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
repo-id)))
(defmethod gh-repos-repo-update ((api gh-repos-api) repo-stub
&optional user &rest caps)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "PATCH"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
(oref repo-stub :name))
(apply 'gh-repos-repo-to-obj repo-stub caps)))
(defmethod gh-repos-repo-rename ((api gh-repos-api) repo-stub new-name
&optional user)
(let ((new-stub (gh-repos-repo-stub "repo" :name new-name)))
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "PATCH"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
(oref repo-stub :name))
(gh-repos-repo-to-obj new-stub))))
(defmethod gh-repos-repo-delete ((api gh-repos-api) repo-id
&optional user)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "DELETE"
(format "/repos/%s/%s"
(or user (gh-api-get-username api))
repo-id)))
;; TODO gh-repos-repo-move
(defmethod gh-repos-repo-contributors ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s/contributors"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO: generate some useful objects with the return values
(defmethod gh-repos-repo-languages ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/languages"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-teams ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/teams"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-tags ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/tags"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-repo-branches ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "GET" (format "/repos/%s/%s/branches"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO gh-repos-repo-branch-commits
;;; TODO Collaborators sub-API
;;; TODO Comments sub-API
;;; TODO Commits sub-API
;;; TODO Contents sub-API
;;; TODO Downloads sub-API
;;; Forks sub-API
(defmethod gh-repos-forks-list ((api gh-repos-api) repo &optional recursive)
(let ((resp (gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/repos/%s/%s/forks"
(oref (oref repo :owner) :login)
(oref repo :name)))))
(when recursive
(let ((forks (oref resp :data)))
(oset resp :data
(apply 'nconc forks
(mapcar
(lambda (f)
(oref (gh-repos-forks-list api f t) data))
forks)))))
resp))
(defmethod gh-repos-fork ((api gh-repos-api) repo &optional org)
(gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "POST"
(format "/repos/%s/%s/forks"
(oref (oref repo :owner) :login)
(oref repo :name))
nil (when org `(("org" . ,org)))))
;;; TODO Keys sub-API
;;; TODO Hooks sub-API
;;; TODO Merging sub-API
;;; Starring sub-API
(defmethod gh-repos-stargazers ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET"
(format "/repos/%s/%s/stargazers"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-starred-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/starred" (or username (gh-api-get-username api)))))
(defmethod gh-repos-starred-p ((api gh-repos-api) repo)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name)))
:http-status)
204))
(defmethod gh-repos-star ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "PUT"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-unstar ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "DELETE"
(format "/user/starred/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
;;; TODO Statuses sub-API
;;; Watching sub-API
(defmethod gh-repos-watchers ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET"
(format "/repos/%s/%s/subscribers"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-watched-list ((api gh-repos-api) &optional username)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api repo-cls)) "GET"
(format "/users/%s/subscriptions"
(or username (gh-api-get-username api)))))
(defmethod gh-repos-watched-p ((api gh-repos-api) repo)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name)))
:http-status)
204))
(defmethod gh-repos-watch ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "PUT"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-unwatch ((api gh-repos-api) repo)
(gh-api-authenticated-request
api nil "DELETE"
(format "/user/subscriptions/%s/%s"
(oref (oref repo :owner) :login)
(oref repo :name))))
(provide 'gh-repos)
;;; gh-repos.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,190 @@
;;; gh-url.el --- url wrapper for gh.el
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'url-http)
(defclass gh-url-request ()
((method :initarg :method :type string)
(url :initarg :url :type string)
(query :initarg :query :initform nil)
(headers :initarg :headers :initform nil)
(data :initarg :data :initform "" :type string)
(async :initarg :async :initform nil)
(num-retries :initarg :num-retries :initform 0)
(install-callbacks :initarg :install-callbacks :initform nil)
(default-response-cls :allocation :class :initform gh-url-response)))
(defclass gh-url-response ()
((data-received :initarg :data-received :initform nil)
(data :initarg :data :initform nil)
(headers :initarg :headers :initform nil)
(http-status :initarg :http-status :initform nil)
(callbacks :initarg :callbacks :initform nil)
(transform :initarg :transform :initform nil)
(-req :initarg :-req :initform nil)))
(defmethod gh-url-response-set-data ((resp gh-url-response) data)
(let ((transform (oref resp :transform)))
(oset resp :data
(if transform
(funcall transform data)
data))
(oset resp :data-received t)))
(defclass gh-url-callback ()
nil)
(defmethod gh-url-callback-run ((cb gh-url-callback) resp)
nil)
(defmethod gh-url-response-run-callbacks ((resp gh-url-response))
(let ((copy-list (lambda (list)
(if (consp list)
(let ((res nil))
(while (consp list) (push (pop list) res))
(prog1 (nreverse res) (setcdr res list)))
(car list)))))
(let ((data (oref resp :data)))
(dolist (cb (funcall copy-list (oref resp :callbacks)))
(cond ((and (object-p cb)
(object-of-class-p cb 'gh-url-callback))
(gh-url-callback-run cb resp))
((or (functionp cb) (symbolp cb))
(funcall cb data))
(t (apply (car cb) data (cdr cb))))
(object-remove-from-list resp :callbacks cb))))
resp)
(defmethod gh-url-add-response-callback ((resp gh-url-response) callback)
(object-add-to-list resp :callbacks callback t)
(if (oref resp :data-received)
(gh-url-response-run-callbacks resp)
resp))
;;; code borrowed from nicferrier's web.el
(defun gh-url-parse-headers (data)
(let* ((headers nil)
(header-lines (split-string data "\n"))
(status-line (car header-lines)))
(when (string-match
"HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*"
status-line)
(push (cons 'status-version (match-string 1 status-line)) headers)
(push (cons 'status-code (match-string 2 status-line)) headers)
(push (cons 'status-string
(or (match-string 4 status-line) ""))
headers))
(loop for line in (cdr header-lines)
if (string-match
"^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)"
line)
do
(let ((name (match-string 1 line))
(value (match-string 2 line)))
(push (cons name value) headers)))
headers))
(defmethod gh-url-response-finalize ((resp gh-url-response))
(when (oref resp :data-received)
(gh-url-response-run-callbacks resp)))
(defmethod gh-url-response-init ((resp gh-url-response)
buffer)
(declare (special url-http-end-of-headers))
(unwind-protect
(with-current-buffer buffer
(let ((headers (gh-url-parse-headers
(buffer-substring
(point-min) (1+ url-http-end-of-headers)))))
(oset resp :headers headers)
(oset resp :http-status (read (cdr (assoc 'status-code headers)))))
(goto-char (1+ url-http-end-of-headers))
(let ((raw (buffer-substring (point) (point-max))))
(gh-url-response-set-data resp raw)))
(kill-buffer buffer))
(gh-url-response-finalize resp)
resp)
(defun gh-url-set-response (status req-resp)
(set-buffer-multibyte t)
(destructuring-bind (req resp) req-resp
(condition-case err
(progn
(oset resp :-req req)
(gh-url-response-init resp (current-buffer)))
(error
(let ((num (oref req :num-retries)))
(if (or (null num) (zerop num))
(signal (car err) (cdr err))
(oset req :num-retries (1- num))
(gh-url-run-request req resp)))))))
(defun gh-url-form-encode (form)
(mapconcat (lambda (x) (format "%s=%s" (car x) (cdr x)))
form "&"))
(defun gh-url-params-encode (form)
(concat "?" (gh-url-form-encode form)))
(defmethod gh-url-run-request ((req gh-url-request) &optional resp)
(let ((url-registered-auth-schemes
'(("basic" ignore . 4))) ;; don't let default handlers kick in
(url-privacy-level 'high)
(url-request-method (oref req :method))
(url-request-data (oref req :data))
(url-request-extra-headers (oref req :headers))
(url (concat (oref req :url)
(let ((params (oref req :query)))
(if params
(gh-url-params-encode params)
"")))))
(if (oref req :async)
(let* ((resp (or resp (make-instance (oref req default-response-cls))))
(req-resp (list req resp)))
(with-current-buffer
(url-retrieve url 'gh-url-set-response (list req-resp))
(set (make-local-variable 'url-registered-auth-schemes)
url-registered-auth-schemes)))
(let* ((resp (or resp (make-instance (oref req default-response-cls))))
(req-resp (list req resp)))
(with-current-buffer (url-retrieve-synchronously url)
(gh-url-set-response nil req-resp)))))
(mapc (lambda (cb)
(gh-url-add-response-callback resp cb))
(oref req :install-callbacks))
resp)
(provide 'gh-url)
;;; gh-url.el ends here

View File

@ -0,0 +1,120 @@
;;; gh-users.el --- users module for gh.el
;; Copyright (C) 2013 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(eval-when-compile
(require 'cl))
;;;###autoload
(require 'eieio)
(require 'gh-api)
(require 'gh-auth)
(require 'gh-common)
;;;###autoload
(defclass gh-users-api (gh-api-v3)
((users-cls :allocation :class :initform gh-users-user))
"Users API")
;;;###autoload
(defclass gh-users-user (gh-user)
((gravatar-id :initarg :gravatar-id)
(html-url :initarg :html-url)
(followers-url :initarg :followers-url)
(following-url :initarg :following-url)
(gists-url :initarg :gists-url)
(starred-url :initarg :starred-url)
(subscriptions-url :initarg :subscriptions-url)
(organizations-url :initarg :organizations-url)
(repos-url :initarg :repos-url)
(events-url :initarg :events-url)
(received-events-url :initarg :received-events-url)
(type :initarg :type)
(site-admin :initarg :site-admin)
(name :initarg :name)
(company :initarg :company)
(blog :initarg :blog)
(location :initarg :location)
(email :initarg :email)
(hireable :initarg :hireable)
(bio :initarg :bio)
(public-repos :initarg :public-repos)
(public-gists :initarg :public-gists)
(followers :initarg :followers)
(following :initarg :following)
(created-at :initarg :created-at)
(update-at :initarg :update-at)))
(defmethod gh-object-read-into ((user gh-users-user) data)
(call-next-method)
(with-slots (gravatar-id html-url followers-url following-url
gists-url starred-url subscriptions-url organizations-url
repos-url events-url received-events-url type site-admin name
company blog location email hireable bio public-repos
public-gists followers following created-at update-at)
user
(setq gravatar-id (gh-read data 'gravatar_id)
html-url (gh-read data 'html_url)
following-url (gh-read data 'following_url)
gists-url (gh-read data 'gists_url)
starred-url (gh-read data 'starred_url)
subscriptions-url (gh-read data 'subscriptions_url)
organizations-url (gh-read data 'organizations_url)
repos-url (gh-read data 'repos_url)
events-url (gh-read data 'events_url)
received-events-url (gh-read data 'received_events_url)
type (gh-read data 'type)
site-admin (gh-read data 'site_admin)
name (gh-read data 'name)
company (gh-read data 'company)
blog (gh-read data 'blog)
location (gh-read data 'location)
email (gh-read data 'email)
hireable (gh-read data 'hireable)
bio (gh-read data 'bio)
public-repos (gh-read data 'public_repos)
public-gists (gh-read data 'public_gists)
followers (gh-read data 'followers)
following (gh-read data 'following)
created-at (gh-read data 'created_at)
update-at (gh-read data 'update_at))))
(defmethod gh-users-get ((api gh-users-api) &optional username)
(gh-api-authenticated-request
api (gh-object-reader (oref api users-cls)) "GET"
(if username
(format "/users/%s" username)
"/user")))
(defmethod gh-users-list ((api gh-users-api))
(gh-api-authenticated-request
api (gh-object-list-reader (oref api users-cls)) "GET"
"/users"))
(provide 'gh-users)
;;; gh-users.el ends here

View File

@ -0,0 +1,39 @@
;;; gh.el --- Github API client libraries
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yhodique@gmail.com>
;; Keywords:
;; 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 2, 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 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:
;;
;;; Code:
(require 'gh-gist)
(require 'gh-pulls)
(require 'gh-issues)
(require 'gh-users)
(provide 'gh)
;;; gh.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End:

View File

@ -0,0 +1,35 @@
;;; git-commit-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-commit" "git-commit.el" (22221 60698 575000
;;;;;; 0))
;;; Generated autoloads from git-commit.el
(defvar global-git-commit-mode t "\
Non-nil if Global-Git-Commit mode is enabled.
See the command `global-git-commit-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-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)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; git-commit-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "git-commit" "20160130.649" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160128.1201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc"))

View File

@ -0,0 +1,676 @@
;;; git-commit.el --- Edit Git commit messages -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 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 "24.4") (dash "20151021.113") (with-editor "20160128.1201"))
;; Keywords: git tools vc
;; Package-Version: 20160130.649
;; 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-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. Some people like that nagging, I don't, so you'll have to
;; enable it. Which brings me to the last point. Like any
;; respectable Emacs package, this one too is highly customizable:
;;
;; M-x customize-group RET git-commit RET
;;; Code:
;;;; Dependencies
(require 'dash)
(require 'log-edit)
(require 'ring)
(require 'server)
(require 'with-editor)
(eval-when-compile (require 'recentf))
;;;; Declarations
(defvar flyspell-generic-check-word-predicate)
(declare-function magit-expand-git-file-name 'magit-git)
;;; Options
;;;; Variables
(defgroup git-commit nil
"Edit Git commit messages."
:prefix "git-commit-"
: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")))
(unless (find-lisp-object-file-name 'git-commit-setup-hook 'defvar)
(add-hook 'git-commit-setup-hook 'with-editor-usage-message)
(add-hook 'git-commit-setup-hook 'git-commit-propertize-diff)
(add-hook 'git-commit-setup-hook 'git-commit-turn-on-auto-fill)
(add-hook 'git-commit-setup-hook 'git-commit-setup-changelog-support)
(add-hook 'git-commit-setup-hook 'git-commit-save-message))
(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
: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
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-summary-max-length 50
"Fontify characters beyond this column in summary lines as errors."
:group 'git-commit
:safe 'numberp
:type 'number)
(defcustom git-commit-fill-column 72
"Automatically wrap commit message lines beyond this column."
:group 'git-commit
:safe 'numberp
:type 'number)
(defcustom git-commit-known-pseudo-headers
'("Signed-off-by" "Acked-by" "Cc"
"Suggested-by" "Reported-by" "Tested-by" "Reviewed-by")
"A list of Git pseudo headers to be highlighted."
:group 'git-commit
:safe (lambda (val) (and (listp val) (-all-p 'stringp val)))
:type '(repeat string))
;;;; Faces
(defgroup git-commit-faces nil
"Faces for highlighting Git commit messages."
:prefix "git-commit-"
:group 'git-commit
:group 'faces)
(defface git-commit-summary
'((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))
"Font 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
'((t :inherit font-lock-variable-name-face))
"Face used for branch names in commit message comments."
:group 'git-commit-faces)
(defface git-commit-comment-detached
'((t :inherit git-commit-comment-branch))
"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 git-commit-comment-branch))
"Face used for actions in commit message comments."
:group 'git-commit-faces)
;;; Keymap
(defvar git-commit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-s") 'git-commit-signoff)
(define-key map (kbd "C-c C-a") 'git-commit-ack)
(define-key map (kbd "C-c C-t") 'git-commit-test)
(define-key map (kbd "C-c C-r") 'git-commit-review)
(define-key map (kbd "C-c C-o") 'git-commit-cc)
(define-key map (kbd "C-c C-p") 'git-commit-reported)
(define-key map (kbd "C-c C-i") 'git-commit-suggested)
(define-key map (kbd "C-c M-s") 'git-commit-save-message)
(define-key map (kbd "M-p") 'git-commit-prev-message)
(define-key map (kbd "M-n") 'git-commit-next-message)
;; Old bindings to avoid confusion
(define-key map (kbd "C-c C-x s") 'git-commit-signoff)
(define-key map (kbd "C-c C-x a") 'git-commit-ack)
(define-key map (kbd "C-c C-x t") 'git-commit-test)
(define-key map (kbd "C-c C-x r") 'git-commit-review)
(define-key map (kbd "C-c C-x o") 'git-commit-cc)
(define-key map (kbd "C-c C-x p") 'git-commit-reported)
map)
"Key map used by `git-commit-mode'.")
;;; Menu
(require 'easymenu)
(easy-menu-define git-commit-mode-menu git-commit-mode-map
"Git Commit Mode Menu"
'("Commit"
["Previous" git-commit-prev-message t]
["Next" git-commit-next-message t]
"-"
["Ack" git-commit-ack :active t
:help "Insert an 'Acked-by' header"]
["Sign-Off" git-commit-signoff :active t
:help "Insert a 'Signed-off-by' header"]
["Tested-by" git-commit-test :active t
:help "Insert a 'Tested-by' header"]
["Reviewed-by" git-commit-review :active t
:help "Insert a 'Reviewed-by' header"]
["CC" git-commit-cc t
:help "Insert a 'Cc' header"]
["Reported" git-commit-reported :active t
:help "Insert a 'Reported-by' header"]
["Suggested" git-commit-suggested t
:help "Insert a 'Suggested-by' header"]
"-"
["Save" git-commit-save-message t]
["Cancel" with-editor-cancel t]
["Commit" with-editor-finish t]))
;;; Hooks
(defconst git-commit-filename-regexp "/\\(\
\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\
\\|BRANCH_DESCRIPTION\\)\\'")
(eval-after-load 'recentf
'(add-to-list 'recentf-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)
(defun git-commit-setup-check-buffer ()
(and buffer-file-name
(string-match-p git-commit-filename-regexp buffer-file-name)
(git-commit-setup)))
(defun git-commit-setup ()
;; cygwin git will pass a cygwin path (/cygdrive/c/foo/.git/...),
;; try to handle this in window-nt Emacs.
(--when-let
(and (eq system-type 'windows-nt)
(not (file-accessible-directory-p default-directory))
(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))
(find-alternate-file it)))
(when git-commit-major-mode
(funcall git-commit-major-mode))
(setq with-editor-show-usage nil)
(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)
(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 (= (line-beginning-position)
(line-end-position))
(open-line 1)))
(run-hooks 'git-commit-setup-hook)
(set-buffer-modified-p nil))
(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 font-lock-multiline t)
(font-lock-add-keywords nil (git-commit-mode-font-lock-keywords) t))
(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.
And set `fill-column' to `git-commit-fill-column'."
(setq fill-column git-commit-fill-column)
(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)
(flyspell-buffer))
(defun git-commit-flyspell-verify ()
(not (= (char-after (line-beginning-position)) ?#)))
(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.
This makes sure the summary line isn't too long and that the
second line is empty."
(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 (equal (match-string 2) "")
(y-or-n-p "Summary line is too long. Commit anyway? "))
(or (equal (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))
(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))
(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-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
(defconst git-commit-comment-headings
'("Changes to be committed:"
"Untracked files:"
"Changed but not updated:"
"Changes not staged for commit:"
"Unmerged paths:"))
(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-mode-font-lock-keywords ()
`(;; Comments
(,(format "^%s.*" comment-start)
(0 'font-lock-comment-face))
(,(format "^%s On branch \\(.*\\)" comment-start)
(1 'git-commit-comment-branch t))
(,(format "^%s Not currently on any branch." comment-start)
(1 'git-commit-comment-detached t))
(,(format "^%s %s" comment-start
(regexp-opt git-commit-comment-headings t))
(1 'git-commit-comment-heading t))
(,(format "^%s\t\\(?:\\([^:\n]+\\):\\s-+\\)?\\(.*\\)" comment-start)
(1 'git-commit-comment-action t t)
(2 'git-commit-comment-file t))
;; Pseudo headers
(,(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
(,(git-commit-summary-regexp)
(1 'git-commit-summary t))
;; - Note (overrides summary)
("\\[.+?\\]"
(0 'git-commit-note t))
;; - Non-empty second line (overrides summary and note)
(,(git-commit-summary-regexp)
(2 'git-commit-overlong-summary t t)
(3 'git-commit-nonempty-second-line t t))))
(defun git-commit-propertize-diff ()
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^diff --git" nil t)
(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)))))
(diff-mode)
(let (font-lock-verbose font-lock-support-mode)
(if (fboundp 'font-lock-flush)
(font-lock-flush)
(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)))
(buffer-string)))))))
;;; git-commit.el ends soon
(provide 'git-commit)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; git-commit.el ends here

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -0,0 +1,15 @@
;;; logito-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("logito.el") (22221 60700 987613 744000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; logito-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "logito" "20120225.1255" "logging library for Emacs" '((eieio "1.3")) :keywords '("lisp" "tool"))

View File

@ -0,0 +1,98 @@
;;; logito.el --- logging library for Emacs
;; Copyright (C) 2012 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords: lisp, tool
;; Package-Version: 20120225.1255
;; Version: 0.1
;; Package-Requires: ((eieio "1.3"))
;; 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 2, 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 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 module provides logging facility for Emacs
;;; Code:
(eval-when-compile
(require 'cl))
(require 'eieio)
(defclass logito-object ()
((level :initarg :level :initform nil)))
(defmethod logito-insert-log ((log logito-object) format &rest objects)
"Base implementation, do nothing")
(defmethod logito-should-log ((log logito-object) level)
(let ((l (oref log :level)))
(and (integerp l)
(<= level l))))
(defmethod logito-log ((log logito-object) level tag string &rest objects)
(when (logito-should-log log level)
(apply 'logito-insert-log log (format "[%s] %s" tag string) objects)))
(defmethod logito-log (log level tag string &rest objects)
"Fallback implementation, do nothing. This allows in particular
to pass nil as the log object."
nil)
(defclass logito-message-object (logito-object)
())
(defmethod logito-insert-log ((log logito-message-object) format &rest objects)
(apply 'message format objects))
(defclass logito-buffer-object (logito-object)
((buffer :initarg :buffer :initform nil)))
(defmethod logito-should-log ((log logito-buffer-object) level)
(and (oref log :buffer)
(call-next-method)))
(defmethod logito-insert-log ((log logito-buffer-object) format &rest objects)
(let ((buffer (get-buffer-create (oref log :buffer))))
(with-current-buffer buffer
(goto-char (point-max))
(insert (apply 'format format objects) "\n\n"))))
(defmacro logito-def-level (sym val &optional pkg)
"Define a constant logito-<SYM>-level and a macro logito:<SYM>
associated with this level."
(let* ((pkg (or pkg 'logito))
(const (intern (format "%s:%s-level"
(symbol-name pkg) (symbol-name sym))))
(mac (intern (format "%s:%s"
(symbol-name pkg) (symbol-name sym)))))
`(progn
(defconst ,const ,val)
(defmacro ,mac (log string &rest objects)
(append
(list 'logito-log log ,const '',sym string)
objects)))))
;; built-in log levels
(logito-def-level error 0)
(logito-def-level info 5)
(logito-def-level verbose 10)
(logito-def-level debug 15)
(provide 'logito)
;;; logito.el ends here

File diff suppressed because one or more lines are too long

View File

@ -1,307 +0,0 @@
;;; magit-blame.el --- blame support for Magit
;; Copyright (C) 2012-2015 The Magit Project Developers
;;
;; For a full list of contributors, see the AUTHORS.md file
;; at the top-level directory of this distribution and at
;; https://raw.github.com/magit/magit/master/AUTHORS.md
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Package: magit
;; Contains code from Egg (Emacs Got Git) <https://github.com/byplayer/egg>,
;; released under the GNU General Public License version 3 or later.
;; Magit is free software; you can redistribute it and/or modify it
;; 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:
;; Control git-blame from Magit.
;; This code has been backported from Egg (Magit fork) to Magit.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'magit)
(require 'easymenu)
;;; Options
(defgroup magit-blame nil
"Git-blame support for Magit."
:group 'magit-extensions)
(defcustom magit-blame-ignore-whitespace t
"Ignore whitespace when determining blame information."
:group 'magit-blame
:type 'boolean)
(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
"How to format time in magit-blame header."
:group 'magit-blame
:type 'string)
(defface magit-blame-header
'((t :inherit magit-section-title))
"Face for blame header."
:group 'magit-faces)
(defface magit-blame-sha1
'((t :inherit (magit-log-sha1 magit-blame-header)))
"Face for blame sha1."
:group 'magit-faces)
(defface magit-blame-culprit
'((t :inherit magit-blame-header))
"Face for blame culprit."
:group 'magit-faces)
(defface magit-blame-time
'((t :inherit magit-blame-header))
"Face for blame time."
:group 'magit-faces)
(defface magit-blame-subject
'((t :inherit (magit-log-message magit-blame-header)))
"Face for blame tag line."
:group 'magit-faces)
;;; Keymaps
(defvar magit-blame-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "l") 'magit-blame-locate-commit)
(define-key map (kbd "RET") 'magit-blame-locate-commit)
(define-key map (kbd "q") 'magit-blame-mode)
(define-key map (kbd "n") 'magit-blame-next-chunk)
(define-key map (kbd "p") 'magit-blame-previous-chunk)
map)
"Keymap for an annotated section.\\{magit-blame-map}")
(easy-menu-define magit-blame-mode-menu magit-blame-map
"Magit blame menu"
'("Blame"
["Locate Commit" magit-blame-locate-commit t]
["Next" magit-blame-next-chunk t]
["Previous" magit-blame-previous-chunk t]
"---"
["Quit" magit-blame-mode t]))
;;; Mode
(defvar-local magit-blame-buffer-read-only nil)
;;;###autoload
(define-minor-mode magit-blame-mode
"Display blame information inline."
:keymap magit-blame-map
:lighter " blame"
(unless (buffer-file-name)
(user-error "Current buffer has no associated file!"))
(when (and (buffer-modified-p)
(y-or-n-p (format "save %s first? " (buffer-file-name))))
(save-buffer))
(cond (magit-blame-mode
(setq magit-blame-buffer-read-only buffer-read-only)
(magit-blame-file-on (current-buffer))
(set-buffer-modified-p nil)
(setq buffer-read-only t))
(t
(magit-blame-file-off (current-buffer))
(set-buffer-modified-p nil)
(setq buffer-read-only magit-blame-buffer-read-only))))
(defun magit-blame-file-off (buffer)
(save-excursion
(save-restriction
(with-current-buffer buffer
(widen)
(mapc (lambda (ov)
(when (overlay-get ov :blame)
(delete-overlay ov)))
(overlays-in (point-min) (point-max)))))))
(defun magit-blame-file-on (buffer)
(magit-blame-file-off buffer)
(save-excursion
(with-current-buffer buffer
(save-restriction
(with-temp-buffer
(apply 'magit-git-insert "blame" "--porcelain"
`(,@(and magit-blame-ignore-whitespace (list "-w")) "--"
,(file-name-nondirectory (buffer-file-name buffer))))
(magit-blame-parse buffer (current-buffer)))))))
;;; Commands
(defun magit-blame-locate-commit (pos)
"Jump to a commit in the branch history from an annotated blame section."
(interactive "d")
(let ((overlays (overlays-at pos))
sha1)
(dolist (ov overlays)
(when (overlay-get ov :blame)
(setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
(when sha1
(magit-show-commit sha1))))
(defun magit-blame-next-chunk ()
"Go to the next blame chunk."
(interactive)
(let ((next (next-single-property-change (point) :blame)))
(when next
(goto-char next))))
(defun magit-blame-previous-chunk ()
"Go to the previous blame chunk."
(interactive)
(let ((prev (previous-single-property-change (point) :blame)))
(when prev
(goto-char prev))))
;;; Parse
(defun magit-blame-decode-time (unixtime &optional tz)
"Decode UNIXTIME into (HIGH LOW) format.
The second argument TZ can be used to add the timezone in (-)HHMM
format to UNIXTIME. UNIXTIME should be either a number
containing seconds since epoch or Emacs's (HIGH LOW . IGNORED)
format."
(when (numberp tz)
(unless (numberp unixtime)
(setq unixtime (float-time unixtime)))
(let* ((ptz (abs tz))
(min (+ (* (/ ptz 100) 60)
(mod ptz 100))))
(setq unixtime (+ (* (if (< tz 0) (- min) min) 60) unixtime))))
(when (numberp unixtime)
(setq unixtime (seconds-to-time unixtime)))
unixtime)
(defun magit-blame-format-time-string (format &optional unixtime tz)
"Use FORMAT to format the time UNIXTIME, or now if omitted.
UNIXTIME is specified as a number containing seconds since epoch
or Emacs's (HIGH LOW . IGNORED) format. The optional argument TZ
can be used to set the time zone. If TZ is a number it is
treated as a (-)HHMM offset to Universal Time. If TZ is not
a number and non-nil the time is printed in UTC. If TZ is nil
the local zime zone is used. The format of the function is
similar to `format-time-string' except for %Z which is not
officially supported at the moment."
(unless unixtime
(setq unixtime (current-time)))
(when (numberp tz) ;; TODO add support for %Z
(setq format (replace-regexp-in-string "%z" (format "%+05d" tz) format)))
(format-time-string format (magit-blame-decode-time unixtime tz) tz))
(defun magit-blame-parse (target-buf blame-buf)
"Parse blame-info in buffer BLAME-BUF and decorate TARGET-BUF buffer."
(save-match-data
(let ((blank (propertize " " 'face 'magit-blame-header))
(nl (propertize "\n" 'face 'magit-blame-header))
(commit-hash (make-hash-table :test 'equal :size 577))
commit commit-info old-line new-line num old-file subject author
author-time author-timezone info ov beg end blame)
(with-current-buffer blame-buf
(goto-char (point-min))
;; search for a ful commit info
(while (re-search-forward
"^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$"
nil t)
(setq commit (match-string-no-properties 1)
old-line (string-to-number
(match-string-no-properties 2))
new-line (string-to-number
(match-string-no-properties 3))
num (string-to-number
(match-string-no-properties 4)))
;; was this commit already seen (and stored in the hash)?
(setq commit-info (gethash commit commit-hash))
;; Nope, this is the 1st time, the full commit-info follow.
(unless commit-info
(re-search-forward "^author \\(.+\\)$")
(setq author (match-string-no-properties 1))
(re-search-forward "^author-time \\(.+\\)$")
(setq author-time (string-to-number
(match-string-no-properties 1)))
(re-search-forward "^author-tz \\(.+\\)$")
(setq author-timezone (string-to-number
(match-string-no-properties 1)))
(re-search-forward "^summary \\(.+\\)$")
(setq subject (match-string-no-properties 1))
(re-search-forward "^filename \\(.+\\)$")
(setq old-file (match-string-no-properties 1))
(setq commit-info (list :sha1 commit :author author
:author-time author-time
:author-timezone author-timezone
:subject subject :file old-file))
;; save it in the hash
(puthash commit commit-info commit-hash))
;; add the current blame-block into the list INFO.
(setq info (cons (list old-line new-line num commit-info)
info))))
;; now do from beginning
(setq info (nreverse info))
(with-current-buffer target-buf
;; for every blame chunk
(dolist (chunk info)
(setq commit-info (nth 3 chunk)
old-line (nth 0 chunk)
new-line (nth 1 chunk)
num (nth 2 chunk)
commit (plist-get commit-info :sha1)
author (plist-get commit-info :author)
author-time (plist-get commit-info :author-time)
author-timezone (plist-get commit-info :author-timezone)
subject (plist-get commit-info :subject))
(goto-char (point-min))
(forward-line (1- new-line))
(setq beg (line-beginning-position)
end (save-excursion
(forward-line num)
(line-beginning-position)))
;; mark the blame chunk
(put-text-property beg end :blame chunk)
;; make an overlay with blame info as 'before-string
;; on the current chunk.
(setq ov (make-overlay beg end))
(overlay-put ov :blame chunk)
(setq blame (concat
(propertize (substring-no-properties commit 0 8)
'face 'magit-blame-sha1)
blank
(propertize (format "%-20s" author)
'face 'magit-blame-culprit)
blank
(propertize (magit-blame-format-time-string
magit-time-format-string
author-time author-timezone)
'face 'magit-blame-time)
blank
(propertize subject 'face 'magit-blame-subject)
blank nl))
(overlay-put ov 'before-string blame))))))
(provide 'magit-blame)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-blame.el ends here

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,7 +1,12 @@
Authors
=======
Also see https://github.com/magit/magit/graphs/contributors.
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 http://magit.vc/stats/authors.html.
Names below are sorted alphabetically.
Author
@ -14,11 +19,18 @@ Maintainer
- Jonas Bernoulli <jonas@bernoul.li>
Retired Maintainers
-------------------
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>
@ -26,14 +38,16 @@ Retired Maintainers
Contributors
------------
- aaa707 <aaa707b@gmail.com>
- Aaron Culich <aculich@gmail.com>
- Abdo Roig-Maranges <abdo.roig@gmail.com>
- acple <silentsphere110@gmail.com>
- Adam Spiers <emacs@adamspiers.org>
- Adeodato Simó <dato@net.com.org.es>
- Ævar Arnfjörð Bjarmason <avarab@gmail.com>
- Alan Falloon <alan.falloon@gmail.com>
- Alex Dunn <adunn@ucsb.edu>
- Alexey Voinov <alexey.v.voinov@gmail.com>
- Alex Kost <alezost@gmail.com>
- Alex Ott <alexott@gmail.com>
- Andreas Fuchs <asf@boinkor.net>
- Andreas Liljeqvist <andreas.liljeqvist@robacks.se>
@ -42,12 +56,16 @@ Contributors
- 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>
- Barak A. Pearlmutter <barak+git@pearlmutter.net>
- Bastian Beischer <beischer@physik.rwth-aachen.de>
- Ben Walton <bwalton@artsci.utoronto.ca>
- Bradley Wright <brad@intranation.com>
- Brandon W Maister <quodlibetor@gmail.com>
- Brian Warner <warner@lothar.com>
- Bryan Shell <bryan.shell@orbitz.com>
- Carl Lieberman <liebermancarl@gmail.com>
- Chris Bernard <cebernard@gmail.com>
- Chris Done <chrisdone@gmail.com>
- Chris Moore <dooglus@gmail.com>
@ -58,13 +76,14 @@ Contributors
- Cornelius Mika <cornelius.mika@gmail.com>
- Craig Andera <candera@wangdera.com>
- Dale Hagglund <dale.hagglund@gmail.com>
- Damien Cassou <damien.cassou@gmail.com>
- Damien Cassou <damien@cassou.me>
- Daniel Brockman <daniel@gointeractive.se>
- Daniel Farina <drfarina@acm.org>
- Daniel Hackney <dan@haxney.org>
- Dan LaManna <dan.lamanna@gmail.com>
- David Abrahams <dave@boostpro.com>
- David Hull <david.hull@openx.com>
- David L. Rager <ragerdl@gmail.com>
- David Wallin <david.wallin@gmail.com>
- Dennis Paskorz <dennis@walltowall.com>
- Divye Kapoor <divye@google.com>
@ -75,25 +94,34 @@ Contributors
- Evgkeni Sampelnikof <esabof@gmail.com>
- Felix Geller <fgeller@gmail.com>
- Feng Li <fengli@blackmagicdesign.com>
- Florian Ragwitz <rafl@debian.org>
- Geoff Shannon <geoffpshannon@gmail.com>
- George Kadianakis <desnacked@gmail.com>
- Graham Clark <grclark@gmail.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>
- Jan Tatarik <jan.tatarik@xing.com>
- Jasper St. Pierre <jstpierre@mecheye.net>
- Jeff Bellegarde <jbellegarde@whitepages.com>
- Jeff Dairiki <dairiki@dairiki.org>
- Jesse Alama <jesse.alama@gmail.com>
- Johann Klähn <kljohann@gmail.com>
- John Mastro <john.b.mastro@gmail.com>
- John Wiegley <johnw@newartisans.com>
- Jonas Bernoulli <jonas@bernoul.li>
- Jonathan Roes <jroes@jroes.net>
- Jordan Greenberg <jordan@softwareslave.com>
- Josiah Schwab <jschwab@gmail.com>
- Julien Danjou <julien@danjou.info>
- Justin Caratzas <justin.caratzas@gmail.com>
- Kan-Ru Chen <kanru@kanru.info>
- Kan-Ru Chen <koster@debian.org>
- Kimberly Wolk <kimwolk@hotmail.com>
- Kyle Meyer <kyle@kyleam.com>
- Laurent Laffont <laurent.laffont@gmail.com>
@ -101,6 +129,7 @@ Contributors
- Lele Gaifax <lele@metapensiero.it>
- Leo Liu <sdl.web@gmail.com>
- Leonardo Etcheverry <leo@kalio.net>
- Lingchao Xin <douglarek@users.noreply.github.com>
- Lluís Vilanova <vilanova@ac.upc.edu>
- Loic Dachary <loic@dachary.org>
- Luís Borges de Oliveira <lbo@siscog.pt>
@ -113,45 +142,60 @@ Contributors
- Marian Schubert <marian.schubert@gooddata.com>
- Marius Vollmer <marius.vollmer@gmail.com>
- Mark Hepburn <Mark.Hepburn@csiro.au>
- Mark Karpov <markkarpov@opmbx.org>
- Mark Oteiza <mvoteiza@udel.edu>
- 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>
- Miles Bader <miles@gnu.org>
- Miloš Mošić <mosic.milos@gmail.com>
- Mitchel Humpherys <mitch.special@gmail.com>
- Moritz Bunkus <moritz@bunkus.org>
- Nathan Weizenbaum <nex342@gmail.com>
- 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>
- Ole Arndt <oliver.arndt@cegedim.com>
- Oleh Krehel <ohwoeowho@gmail.com>
- Ó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>
- Philip Weaver <philip.weaver@gmail.com>
- Phil Jackson <phil@shellarchive.co.uk>
- Phil Sainty <phil@catalyst.net.nz>
- Pieter Praet <pieter@praet.org>
- Prathamesh Sonpatki <csonpatki@gmail.com>
- rabio <rabiodev@o2.pl>
- Rafael Laboissiere <rafael@laboissiere.net>
- Raimon Grau <raimonster@gmail.com>
- 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.de>
- Rüdiger Sonderfeld <ruediger@c-plusplus.net>
- Ryan C. Thompson <rct@thompsonclan.org>
- Samuel Bronson <naesten@gmail.com>
@ -165,20 +209,33 @@ Contributors
- Servilio Afre Puentes <afrepues@mcmaster.ca>
- Š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>
- Vineet Naik <vineet@helpshift.com>
- Wei Huang <weih@opera.com>
- Wilfred Hughes <me@wilfred.me.uk>
- Win Treese <treese@acm.org>
- Xavier Noria <fxn@hashref.com>
- Yann Hodique <yann.hodique@gmail.com>
- York Zhao <gtdplatform@gmail.com>
- Yuichi Higashi <aaa707b@gmail.com>
- Zach Latta <zach@zachlatta.com>

View File

@ -0,0 +1,676 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.

View File

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

View File

@ -0,0 +1,461 @@
;;; git-rebase.el --- Edit Git rebase files -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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.
;;
;; RET Show the commit at point in another buffer.
;; 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)
(eval-when-compile (require 'recentf))
;;; Options
;;;; Variables
(defgroup git-rebase nil
"Edit Git 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
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"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)
;;; Keymaps
(defvar git-rebase-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map (kbd "q") 'undefined)
(define-key map [remap undo] 'git-rebase-undo)
(define-key map (kbd "RET") 'git-rebase-show-commit)
(define-key map (kbd "SPC") 'magit-diff-show-or-scroll-up)
(define-key map (kbd "x") 'git-rebase-exec)
(define-key map (kbd "c") 'git-rebase-pick)
(define-key map (kbd "r") 'git-rebase-reword)
(define-key map (kbd "w") 'git-rebase-reword)
(define-key map (kbd "e") 'git-rebase-edit)
(define-key map (kbd "s") 'git-rebase-squash)
(define-key map (kbd "f") 'git-rebase-fixup)
(define-key map (kbd "y") 'git-rebase-insert)
(define-key map (kbd "k") 'git-rebase-kill-line)
(define-key map (kbd "C-k") 'git-rebase-kill-line)
(define-key map (kbd "p") 'git-rebase-backward-line)
(define-key map (kbd "n") 'forward-line)
(define-key map (kbd "M-p") 'git-rebase-move-line-up)
(define-key map (kbd "M-n") 'git-rebase-move-line-down)
(define-key map (kbd "M-<up>") 'git-rebase-move-line-up)
(define-key map (kbd "M-<down>") 'git-rebase-move-line-down)
(define-key map (kbd "C-x C-t") 'git-rebase-move-line-up)
map)
"Keymap for Git-Rebase mode.")
(put 'git-rebase-reword :advertised-binding "r")
(put 'git-rebase-move-line-up :advertised-binding (kbd "M-p"))
(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]
["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")
(previous-line . "move point to previous line")
(next-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-commit . "show the commit at point in another buffer")
(undo . "undo last change")
(git-rebase-kill-line . "drop the commit 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"))
(defconst git-rebase-line
"^\\(#?\\(?:[fprse]\\|pick\\|reword\\|edit\\|squash\\|fixup\\|exec\\)\\) \
\\(?:\\([^ \n]+\\) \\(.*\\)\\)?")
(defun git-rebase-set-action (action)
(goto-char (line-beginning-position))
(if (and (looking-at git-rebase-line)
(not (string-match-p "\\(e\\|exec\\)$" (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")
(-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) ?#)))
(let ((inhibit-read-only t))
(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 "^#?\\(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-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 ()
"Show the commit on the current line if any."
(interactive)
(save-excursion
(goto-char (line-beginning-position))
(--if-let (and (looking-at git-rebase-line)
(match-string 2))
(apply #'magit-show-commit it (magit-diff-arguments))
(ding))))
(defun git-rebase-backward-line (&optional n)
"Move N lines backward (forward if N is negative).
Like `forward-line' but go into the opposite direction."
(interactive "p")
(forward-line (- n)))
;;; 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 font-lock-defaults '(git-rebase-mode-font-lock-keywords t t))
(unless git-rebase-show-instructions
(let ((inhibit-read-only t))
(flush-lines "^\\($\\|#\\)")))
(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))
(defun git-rebase-cancel-confirm (force)
(or (not (buffer-modified-p)) force (y-or-n-p "Abort this rebase? ")))
(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)))
(defconst git-rebase-mode-font-lock-keywords
`(("^\\([efprs]\\|pick\\|reword\\|edit\\|squash\\|fixup\\) \\([^ \n]+\\) \\(.*\\)"
(1 'font-lock-keyword-face)
(2 'git-rebase-hash)
(3 'git-rebase-description))
("^\\(exec\\) \\(.*\\)"
(1 'font-lock-keyword-face)
(2 'git-rebase-description))
("^#.*" 0 'font-lock-comment-face)
("^#[^ \n].*" 0 'git-rebase-killed-action t))
"Font lock keywords for Git-Rebase mode.")
(defun git-rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(when (and git-rebase-show-instructions
(re-search-forward "^# Commands:\n" nil t))
(--each git-rebase-command-descriptions
(insert (format "# %-8s %s\n"
(substitute-command-keys (format "\\[%s]" (car it)))
(cdr it))))
(while (re-search-forward "^#\\( ?\\)\\([^,],\\) \\([^ ]+\\) = " 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
(--filter (not (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))
(provide 'git-rebase)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; git-rebase.el ends here

View File

@ -0,0 +1,559 @@
;;; magit-apply.el --- apply Git diffs -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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-anti-stage 'magit-rockstar)
(declare-function magit-am-popup 'magit-sequence)
;; For `magit-discard-files'
(declare-function magit-checkout-stage 'magit)
(declare-function magit-checkout-read-stage 'magit)
(defvar auto-revert-verbose)
(require 'dired)
;;; Options
(defcustom magit-delete-by-moving-to-trash t
"Whether Magit uses the system's trash can."
:package-version '(magit . "2.1.0")
:group 'magit
: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 concern 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)
;;; Commands
;;;; Apply
(defun magit-apply (&rest args)
"Apply the change at point.
With a prefix argument and if necessary, attempt a 3-way merge."
(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))
(`(,_ file) (magit-apply-diff it args))
(`(,_ files) (magit-apply-diffs it args)))))
(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)
(buffer-substring (magit-section-content s)
(magit-section-end 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)
(buffer-substring (magit-section-content section)
(magit-section-end section)))))
(defun magit-apply-hunks (sections &rest args)
(let ((section (magit-section-parent (car sections))))
(when (string-match "^diff --cc" (magit-section-value section))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(magit-apply-patch section args
(concat (magit-section-diff-header section)
(mapconcat
(lambda (s)
(buffer-substring (magit-section-start s)
(magit-section-end s)))
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 (magit-section-parent section) args
(concat (magit-diff-file-header section)
(buffer-substring (magit-section-start section)
(magit-section-end 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 (magit-section-parent section) 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 (magit-section-value section:s))
(mapcar 'magit-section-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)
(let ((section (magit-current-section)))
(pcase (magit-section-type section)
((or `hunk `file) section)
((or `staged `unstaged `untracked
`stashed-index `stashed-worktree `stashed-untracked)
(magit-section-children section))
(_ (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 . ,(magit-section-value it)))
(magit-section-ident magit-root-section)))
(error "Cannot get required diff headers"))
sections))
(t sections)))
;;;; Stage
(defun magit-stage ()
"Add the change at point to the staging area."
(interactive)
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(untracked ,_) (magit-stage-untracked))
(`(unstaged region) (magit-apply-region it "--cached"))
(`(unstaged hunk) (magit-apply-hunk it "--cached"))
(`(unstaged hunks) (magit-apply-hunks it "--cached"))
(`(unstaged file) (magit-stage-1 "-u" (list (magit-section-value it))))
(`(unstaged files) (magit-stage-1 "-u" (magit-region-values)))
(`(unstaged list) (magit-stage-1 "-u"))
(`(staged ,_) (user-error "Already staged"))
(`(committed ,_) (user-error "Cannot stage committed changes"))
(`(undefined ,_) (user-error "Cannot stage this change")))))
;;;###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-when (file)))
(current (magit-file-relative-name))
(choices (nconc (magit-modified-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.
\('git add --update|--all .')."
(interactive (progn (unless (or (not (magit-anything-staged-p))
(magit-confirm 'stage-all-changes))
(user-error "Abort"))
(list current-prefix-arg)))
(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 ()
(let* ((section (magit-current-section))
(files (pcase (magit-diff-scope)
(`file (list (magit-section-value section)))
(`files (magit-region-values))
(`list (magit-untracked-files))))
plain repos)
(dolist (file files)
(if (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" "--" plain)
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
(dolist (repo repos)
(save-excursion
(goto-char (magit-section-start
(magit-get-section
`((file . ,repo) (untracked) (status)))))
(call-interactively 'magit-submodule-add)))
(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))
(`(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) (magit-unstage-1 (list (magit-section-value it))))
(`(staged files) (magit-unstage-1 (magit-region-values)))
(`(staged list) (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-when (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 (and (not (magit-anything-unstaged-p))
(not (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)
(when (magit-confirm 'discard "Discard region")
(magit-discard-apply section 'magit-apply-region)))
(defun magit-discard-hunk (section)
(when (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 (eq (magit-section-type section) 'file)
(magit-section-value section)
(magit-section-parent-value section)))
(progn (let ((inhibit-magit-refresh t))
(funcall apply section "--reverse" "--cached")
(funcall apply section "--reverse"))
(magit-refresh))
(funcall apply section "--reverse" "--index"))))
(defun magit-discard-hunks (sections)
(when (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 (eq (magit-section-type section) 'file)
(magit-section-value section)
(magit-section-parent-value section)))
(progn (let ((inhibit-magit-refresh t))
(funcall apply sections "--reverse" "--cached")
(funcall apply sections "--reverse"))
(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 (magit-section-value section)))
(push file files)
(pcase (cons (pcase type
(`staged ?X)
(`unstaged ?Y)
(`untracked ?Z))
(cddr (assoc file status)))
(`(?Z) (--each (magit-untracked-files nil file)
(push it 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
(dolist (file (nreverse resolve))
(magit-checkout-stage file (magit-checkout-read-stage file))))
(magit-discard-files--resurrect (nreverse resurrect))
(magit-discard-files--delete (nreverse delete) status)
(magit-discard-files--rename (nreverse rename) status)
(magit-discard-files--discard (nreverse discard)
(nreverse discard-new))
(magit-wip-commit-after-apply files " after discard"))
(magit-refresh))))
(defun magit-discard-files--resurrect (files)
(when (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)
(when (if magit-delete-by-moving-to-trash
(magit-confirm-files 'trash files)
(magit-confirm-files 'delete files))
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
(dolist (file files)
(if (memq (magit-diff-type) '(unstaged untracked))
(dired-delete-file file dired-recursive-deletes
magit-delete-by-moving-to-trash)
(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)
(when (magit-confirm 'rename "Undo rename %s" "Undo %i renames"
(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)
(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 (mapcar #'magit-section-value sections)))
(when (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
(--filter (not (member (magit-section-value it) binaries))
sections)))
(if (= (length sections) 1)
(magit-discard-apply (car sections) 'magit-apply-diff)
(magit-discard-apply-n sections 'magit-apply-diffs))
(when binaries
(let ((modified (magit-modified-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."
(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)
(when (magit-confirm 'reverse "Reverse region")
(apply 'magit-apply-region section "--reverse" args)))
(defun magit-reverse-hunk (section args)
(when (magit-confirm 'reverse "Reverse hunk")
(apply 'magit-apply-hunk section "--reverse" args)))
(defun magit-reverse-hunks (sections args)
(when (magit-confirm 'reverse
(format "Reverse %s hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-apply-hunks sections "--reverse" args)))
(defun magit-reverse-file (section args)
(magit-reverse-files (list section) args))
(defun magit-reverse-files (sections args)
(-let [(binaries sections)
(let ((bs (magit-staged-binary-files)))
(--separate (member (magit-section-value it) bs) sections))]
(when (magit-confirm-files 'reverse (mapcar #'magit-section-value sections))
(if (= (length sections) 1)
(magit-apply-diff (car sections) "--reverse" args)
(magit-apply-diffs sections "--reverse" args)))
(when binaries
(user-error "Cannot reverse binary files"))))
(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)))
;;; magit-apply.el ends soon
(provide 'magit-apply)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-apply.el ends here

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,260 @@
;;; magit-autorevert.el --- revert buffers when files in repository change -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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)
(defgroup magit-auto-revert nil
"Revert buffers when files in repository change."
:group 'auto-revert
:group 'magit-extensions)
(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
: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)
(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)))
(auto-revert-mode))))
;;;###autoload
(defvar magit-revert-buffers t)
(make-obsolete-variable 'magit-revert-buffers 'magit-auto-revert-mode
"Magit 2.4.0")
;;;###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")
:group 'magit
:group 'magit-auto-revert
;; When `global-auto-revert-mode' is enabled, then this mode is
;; redundant. When `magit-revert-buffers' is nil, then the user has
;; opted out of the automatic reverts while the old implementation
;; was still in use. In all other cases enable the mode because if
;; buffers are not automatically reverted that would make many very
;; common tasks much more cumbersome.
:init-value (and magit-revert-buffers
(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."
;; `magit-revert-buffers' may have been set to nil before the alias
;; had been established, so consult the value of both variables.
(if (and magit-auto-revert-mode magit-revert-buffers)
(let ((start (current-time)))
(message "Turning on magit-auto-revert-mode...")
(magit-auto-revert-mode 1)
(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)
(custom-add-to-group 'magit 'auto-revert-check-vc-info 'custom-variable)
;;; magit-autorevert.el ends soon
(provide 'magit-autorevert)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-autorevert.el ends here

View File

@ -0,0 +1,200 @@
;;; magit-bisect.el --- bisect support for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2011-2016 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)
(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)
;;;###autoload (autoload 'magit-bisect-popup "magit-bisect" nil t)
(magit-define-popup magit-bisect-popup
"Popup console for bisect commands."
'magit-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)))
(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)
(when (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 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)))
(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$"))
(magit-insert-section (bisect-output t)
(magit-insert-heading
(propertize (or (and (string-match done-re (car lines)) (pop lines))
(--first (string-match done-re it) lines)
(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 %s" "--decorate=full"))))
(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-log 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-log)
(insert hash " is the first bad commit\n"))))))
;;; magit-bisect.el ends soon
(provide 'magit-bisect)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-bisect.el ends here

View File

@ -0,0 +1,519 @@
;;; magit-blame.el --- blame support for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 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."
:group 'magit-extensions)
(defcustom magit-blame-heading-format "%-20a %C %s"
"Format string used for blame headings.
The following placeholders are recognized:
%H hash
%s summary
%a author
%A author time
%c committer
%C committer time
The author and committer time formats can be specified with
`magit-blame-time-format'."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-time-format "%F %H:%M"
"Format for time strings in blame headings."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-show-headings t
"Whether to initially show blame block headings.
The headings can also be toggled locally using command
`magit-blame-toggle-headings'."
: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")))
(make-variable-buffer-local 'magit-blame-disabled-modes)
(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))
(unless (find-lisp-object-file-name 'magit-blame-goto-chunk-hook 'defvar)
(add-hook 'magit-blame-goto-chunk-hook 'magit-blame-maybe-update-revision-buffer))
(defcustom magit-blame-goto-chunk-hook '(magit-blame-maybe-update-revision-buffer)
"Hook run by `magit-blame-next-chunk' and `magit-blame-previous-chunk'."
:package-version '(magit . "2.1.0")
:group 'magit-blame
:type 'hook
:options '(magit-blame-maybe-update-revision-buffer))
(defface magit-blame-heading
'((((class color) (background light))
:background "grey80"
:foreground "black")
(((class color) (background dark))
:background "grey25"
:foreground "black"))
"Face for blame headings."
:group 'magit-faces)
(defface magit-blame-summary
'((t :inherit magit-blame-heading))
"Face used for commit summary in blame headings."
:group 'magit-faces)
(defface magit-blame-hash
'((t :inherit magit-blame-heading))
"Face used for commit hash in blame headings."
:group 'magit-faces)
(defface magit-blame-name
'((t :inherit magit-blame-heading))
"Face used for author and committer names in blame headings."
:group 'magit-faces)
(defface magit-blame-date
'((t :inherit magit-blame-heading))
"Face used for dates in blame headings."
:group 'magit-faces)
;;; Code
(defvar magit-blame-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'magit-show-commit)
(define-key map "\s" 'magit-diff-show-or-scroll-up)
(define-key map "\d" 'magit-diff-show-or-scroll-down)
(define-key map "b" 'magit-blame-popup)
(define-key map "n" 'magit-blame-next-chunk)
(define-key map "N" 'magit-blame-next-chunk-same-commit)
(define-key map "p" 'magit-blame-previous-chunk)
(define-key map "P" 'magit-blame-previous-chunk-same-commit)
(define-key map "q" 'magit-blame-quit)
(define-key map "t" 'magit-blame-toggle-headings)
(define-key map "\M-w" 'magit-blame-copy-hash)
map)
"Keymap for `magit-blame-mode'.")
(defun magit-blame-put-keymap-before-view-mode ()
"Put `magit-blame-mode' ahead of `view-mode' in `minor-mode-map-alist'."
(--when-let (assq 'magit-blame-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)
(defvar-local magit-blame-buffer-read-only nil)
(defvar-local magit-blame-cache nil)
(defvar-local magit-blame-process nil)
(defvar-local magit-blame-recursive-p nil)
(defvar-local magit-blame-separator nil)
(define-minor-mode magit-blame-mode
"Display blame information inline.
\n\\{magit-blame-mode-map}"
: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'")))
(setq magit-blame-buffer-read-only buffer-read-only)
(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)))
(t
(unless magit-blame-buffer-read-only
(read-only-mode -1))
(dolist (mode magit-blame-disabled-modes)
(funcall mode 1))
(when (process-live-p magit-blame-process)
(kill-process magit-blame-process))
(save-excursion
(save-restriction
(widen)
(dolist (ov (overlays-in (point-min) (point-max)))
(when (overlay-get ov 'magit-blame)
(delete-overlay ov))))))))
(defun auto-revert-handler--unless-magit-blame-mode ()
"If Magit-Blame mode is on, then do nothing. See #1731."
magit-blame-mode)
(advice-add 'auto-revert-handler :before-until
'auto-revert-handler--unless-magit-blame-mode)
;;;###autoload (autoload 'magit-blame-popup "magit-blame" nil t)
(magit-define-popup magit-blame-popup
"Popup console for blame commands."
'magit-commands
:man-page "git-blame"
:switches '((?w "Ignore whitespace" "-w")
(?r "Do not treat root commits as boundaries" "--root"))
:options '((?C "Detect lines moved or copied within a file" "-C")
(?M "Detect lines moved or copied between files" "-M"))
:actions '((?b "Blame" magit-blame))
:default-arguments '("-w")
:default-action 'magit-blame)
;;;###autoload
(defun magit-blame (revision file &optional args line)
"Display edit history of FILE up to REVISION.
Interactively blame the file being visited in the current buffer.
If the buffer visits a revision of that file, then blame up to
that revision, otherwise blame the file's full history, including
uncommitted changes.
If Magit-Blame mode is already turned on then blame recursively, by
visiting REVISION:FILE (using `magit-find-file'), where revision
is the revision before the revision that added the lines at
point.
ARGS is a list of additional arguments to pass to `git blame';
only arguments available from `magit-blame-popup' should be used.
\n(fn REVISION FILE &optional ARGS)" ; LINE is for internal use
(interactive
(let ((args (magit-blame-arguments)))
(if magit-blame-mode
(--if-let (magit-blame-chunk-get :previous-hash)
(list it (magit-blame-chunk-get :previous-file)
args (magit-blame-chunk-get :previous-start))
(user-error "Block has no further history"))
(--if-let (magit-file-relative-name nil 'tracked)
(list (or magit-buffer-refname magit-buffer-revision) it args)
(if buffer-file-name
(user-error "Buffer isn't visiting a tracked file")
(user-error "Buffer isn't visiting a file"))))))
(magit-with-toplevel
(if revision
(magit-find-file revision file)
(let ((default-directory default-directory))
(--if-let (find-buffer-visiting file)
(progn (switch-to-buffer it)
(save-buffer))
(find-file file))))
;; ^ Make sure this doesn't affect the value used below. b640c6f
(widen)
(when line
(setq magit-blame-recursive-p t)
(goto-char (point-min))
(forward-line (1- line)))
(unless magit-blame-mode
(setq magit-blame-cache (make-hash-table :test 'equal))
(let ((show-headings magit-blame-show-headings))
(magit-blame-mode 1)
(setq-local magit-blame-show-headings show-headings))
(message "Blaming...")
(let ((magit-process-popup-time -1)
(inhibit-magit-refresh t))
(magit-run-git-async
"blame" "--incremental" args
"-L" (format "%s,%s"
(line-number-at-pos (window-start))
(line-number-at-pos (1- (window-end nil t))))
revision "--" file))
(setq magit-blame-process magit-this-process)
(set-process-filter magit-this-process 'magit-blame-process-filter)
(set-process-sentinel
magit-this-process
`(lambda (process event)
(when (memq (process-status process) '(exit signal))
(magit-process-sentinel process event)
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((magit-process-popup-time -1)
(inhibit-magit-refresh t)
(default-directory ,default-directory))
(magit-run-git-async "blame" "--incremental" ,@args
,revision "--" ,file))
(setq magit-blame-process magit-this-process)
(set-process-filter
magit-this-process 'magit-blame-process-filter)
(set-process-sentinel
magit-this-process 'magit-blame-process-sentinel)))))))))
(defun magit-blame-process-sentinel (process event)
(let ((status (process-status process)))
(when (memq status '(exit signal))
(magit-process-sentinel process event)
(if (eq status 'exit)
(message "Blaming...done")
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(magit-blame-mode -1))
(message "Blaming...failed")))))
(defvar magit-blame-log nil
"Whether to log blame output to the process buffer.
This is intended for debugging purposes.")
(defun magit-blame-process-filter (process string)
(when magit-blame-log
(magit-process-filter process string))
(--when-let (process-get process 'partial-line)
(setq string (concat it string))
(setf (process-get process 'partial-line) nil))
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((chunk (process-get process 'chunk))
(lines (split-string string "\n" t)))
(unless (string-match-p "\n\\'" string)
(process-put process 'chunk chunk)
(process-put process 'partial-line (car (last lines)))
(setq lines (butlast lines)))
(dolist (line lines)
(cond
((equal line ""))
((not chunk)
(string-match
"^\\(.\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" line)
(setq chunk
(list :hash (let ((hash (match-string 1 line)))
(unless (equal hash (make-string 40 ?0))
hash))
:previous-start (string-to-number (match-string 2 line))
:start (string-to-number (match-string 3 line))
:lines (string-to-number (match-string 4 line)))))
((string-match "^filename \\(.+\\)" line)
(let* ((hash (plist-get chunk :hash))
(file (match-string 1 line)))
(--if-let (gethash hash magit-blame-cache)
(setq chunk (nconc chunk it))
(plist-put chunk :filename file)
(puthash hash chunk magit-blame-cache)))
(magit-blame-make-overlay chunk)
(setq chunk nil))
((string-match "^previous \\(.\\{40\\}\\) \\(.+\\)" line)
(plist-put chunk :previous-hash (match-string 1 line))
(plist-put chunk :previous-file (match-string 2 line)))
((string-match "^\\([^ ]+?-mail\\) <\\([^>]+\\)>" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(string-to-number (match-string 2 line))))
((string-match "^\\([^ ]+?-\\(?:time\\|tz\\)\\) \\(.+\\)" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(string-to-number (match-string 2 line))))
((string-match "^\\([^ ]+\\) \\(.+\\)" line)
(plist-put chunk (intern (concat ":" (match-string 1 line)))
(match-string 2 line))))
(process-put process 'chunk chunk))))))
(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")))
(defun magit-blame-make-overlay (chunk)
(let ((ov (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(forward-line (1- (plist-get chunk :start)))
(--when-let (--first (overlay-get it 'magit-blame)
(overlays-at (point)))
(delete-overlay it))
(make-overlay (point)
(progn (forward-line
(plist-get chunk :lines))
(point))))))
(heading (magit-blame-format-heading chunk)))
(overlay-put ov 'magit-blame chunk)
(overlay-put ov 'magit-blame-heading heading)
(overlay-put ov 'before-string
(if magit-blame-show-headings
heading
magit-blame-separator))))
(defun magit-blame-format-separator ()
(propertize
(concat (propertize " " 'display '(space :height (2)))
(propertize "\n" 'line-height t))
'face (list :background (face-attribute 'magit-blame-heading :background))))
(defun magit-blame-format-heading (chunk)
(with-temp-buffer
(insert (format-spec
(concat magit-blame-heading-format "\n")
`((?H . ,(propertize (or (plist-get chunk :hash) "")
'face 'magit-blame-hash))
(?s . ,(propertize (or (plist-get chunk :summary) "")
'face 'magit-blame-summary))
(?a . ,(propertize (or (plist-get chunk :author) "")
'face 'magit-blame-name))
(?A . ,(propertize (magit-blame-format-time-string
magit-blame-time-format
(plist-get chunk :author-time)
(plist-get chunk :author-tz))
'face 'magit-blame-date))
(?c . ,(propertize (or (plist-get chunk :committer) "")
'face 'magit-blame-name))
(?C . ,(propertize (magit-blame-format-time-string
magit-blame-time-format
(plist-get chunk :committer-time)
(plist-get chunk :committer-tz))
'face 'magit-blame-date)))))
(goto-char (point-min))
(while (not (eobp))
(let ((face (get-text-property (point) 'face))
(next (or (next-single-property-change (point) 'face)
(point-max))))
(unless face
(put-text-property (point) next 'face 'magit-blame-heading))
(goto-char next)))
(buffer-string)))
(defun magit-blame-format-time-string (format time tz)
(format-time-string
format (seconds-to-time (+ time (* (/ tz 100) 60 60) (* (% tz 100) 60)))))
(defun magit-blame-quit ()
"Turn off Magit-Blame mode.
If the buffer was created during a recursive blame,
then also kill the buffer."
(interactive)
(if magit-blame-recursive-p
(kill-buffer)
(magit-blame-mode -1)))
(defun magit-blame-next-chunk ()
"Move to the next chunk."
(interactive)
(--if-let (next-single-char-property-change (point) 'magit-blame)
(progn (goto-char it)
(run-hooks 'magit-blame-goto-chunk-hook))
(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)
(progn (goto-char it)
(run-hooks 'magit-blame-goto-chunk-hook))
(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 (hash (magit-blame-chunk-get :hash))
(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)))
(--when-let (magit-blame-overlay-at pos)
(when (equal (magit-blame-chunk-get :hash pos) hash)
(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-toggle-headings ()
"Show or hide blame chunk headings."
(interactive)
(setq-local magit-blame-show-headings (not magit-blame-show-headings))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (not (eobp))
(let ((next (next-single-char-property-change (point) 'magit-blame)))
(--when-let (magit-blame-overlay-at (point))
(overlay-put it 'before-string
(if magit-blame-show-headings
(overlay-get it 'magit-blame-heading)
magit-blame-separator)))
(goto-char (or next (point-max))))))))
(defun magit-blame-copy-hash ()
"Save hash of the current chunk's commit to the kill ring."
(interactive)
(kill-new (message "%s" (magit-blame-chunk-get :hash))))
(defun magit-blame-chunk-get (key &optional pos)
(--when-let (magit-blame-overlay-at pos)
(plist-get (overlay-get it 'magit-blame) key)))
(defun magit-blame-overlay-at (&optional pos)
(--first (overlay-get it 'magit-blame)
(overlays-at (or pos (point)))))
(defun magit-blame-maybe-update-revision-buffer ()
(unless magit--update-revision-buffer
(setq magit--update-revision-buffer nil)
(-when-let* ((commit (magit-blame-chunk-get :hash))
(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 ()
(-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))))))))))
;;; magit-blame.el ends soon
(provide 'magit-blame)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-blame.el ends here

View File

@ -0,0 +1,402 @@
;;; magit-commit.el --- create Git commits -*- lexical-binding: t -*-
;; Copyright (C) 2008-2016 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))
(declare-function epg-sub-key-id 'epg)
(declare-function epg-key-sub-key-list 'epg)
(declare-function epg-key-user-id-list 'epg)
(declare-function epg-user-id-string 'epg)
(declare-function epg-decode-dn 'epg)
(declare-function epg-list-keys 'epg)
;;; Options
(defcustom magit-commit-arguments nil
"The arguments used when committing."
:group 'magit-commands
:type '(repeat (string :tag "Argument")))
(defcustom magit-commit-ask-to-stage 'verbose
"Whether to ask to stage everything 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)
;;; Code
(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")
(?n "Bypass git 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="))
: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))
(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)))))
;;;###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 (setq args (magit-commit-assert args))
(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-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)))
(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)))
(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))
(if (and commit
(or confirmed
(not (or rebase
current-prefix-arg
magit-commit-squash-confirm))))
(let ((magit-commit-show-diff nil))
(magit-run-git-with-editor "commit"
(unless edit "--no-edit")
(concat option "=" commit)
args))
(magit-log-select
`(lambda (commit)
(magit-commit-squash-internal ,option commit ',args ,rebase ,edit t)
,@(when rebase
`((magit-rebase-interactive-1 commit
(list "--autosquash" "--autostash")
"" "true"))))
(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-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 everything? ")
(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"))))
(defun magit-commit-diff ()
(--when-let (and git-commit-mode
magit-commit-show-diff
(pcase last-command
(`magit-commit
(apply-partially 'magit-diff-staged nil))
(`magit-commit-amend 'magit-diff-while-amending)
(`magit-commit-reword 'magit-diff-while-amending)))
(condition-case nil
(let ((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)")
(funcall it (car (magit-diff-arguments))))
(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))
(defvar magit-gpg-secret-key-hist nil)
(defun magit-read-gpg-secret-key (prompt &optional _initial-input)
(require 'epa)
(let ((keys (--map (list (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))))
(magit-completing-read prompt keys nil nil nil 'magit-gpg-secret-key-hist
(car (or magit-gpg-secret-key-hist keys)))))
(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 (magit-section-when 'hunk it))
(log (magit-commit-message-buffer)) buf pos)
(save-window-excursion
(call-interactively #'magit-diff-visit-file)
(setq buf (current-buffer)
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))
(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))))))
;;; magit-commit.el ends soon
(provide 'magit-commit)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-commit.el ends here

View File

@ -0,0 +1,77 @@
;;; magit-core.el --- core functionality -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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-utils)
(require 'magit-section)
(require 'magit-git)
(require 'magit-mode)
(require 'magit-popup)
(require 'magit-process)
(require 'magit-autorevert)
(defgroup magit nil
"Controlling Git from Emacs."
:group 'tools)
(defgroup magit-commands nil
"Options controlling behavior of certain commands."
:group 'magit)
(defgroup magit-modes nil
"Modes used or provided by Magit."
:group 'magit)
(defgroup magit-extensions nil
"Extensions to Magit."
:group 'magit)
(defgroup magit-faces nil
"Faces used by Magit."
:group 'magit
:group 'faces)
(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)
(custom-add-to-group 'magit 'vc-follow-symlinks 'custom-variable)
;;; magit-core.el ends soon
(provide 'magit-core)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-core.el ends here

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,431 @@
;;; magit-ediff.el --- Ediff extension for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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)
(defgroup magit-ediff nil
"Ediff support for Magit."
:group 'magit-extensions)
(unless (find-lisp-object-file-name 'magit-ediff-quit-hook 'defvar)
(add-hook 'magit-ediff-quit-hook 'magit-ediff-restore-previous-winconf)
(add-hook 'magit-ediff-quit-hook 'magit-ediff-cleanup-auxiliary-buffers))
(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
: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)
(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."
'magit-diff nil nil
: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))
: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" nil
(magit-tracked-files) 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)))
(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))
(or bufC (find-file-noselect file))
`((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 (-let [(revA revB) (magit-ediff-compare--read-revisions
nil current-prefix-arg)]
(nconc (list revA revB)
(magit-ediff-compare--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)))
revA revB)
(if (string-match magit-range-re input)
(progn (setq revA (or (match-string 1 input) "HEAD")
revB (or (match-string 3 input) "HEAD"))
(when (string= (match-string 2 input) "...")
(setq revA (magit-git-string "merge-base" revA revB))))
(setq revA input))
(list revA revB)))
(defun magit-ediff-compare--read-files (revA revB &optional fileB)
(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 "File in %s to compare with %s in %s"
revA fileB (or revB "the working tree"))))
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 (magit-section-start (magit-section-parent it)))
(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
revB value))
((pred stringp)
(-let [(a b) (magit-ediff-compare--read-revisions range)]
(setq command #'magit-ediff-compare
revA a
revB b)))
(_
(when (derived-mode-p 'magit-diff-mode)
(pcase (magit-diff-type)
(`committed (-let [(a b) (magit-ediff-compare--read-revisions
(car magit-refresh-args))]
(setq revA a 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-compare--read-files revA revB file)))
((eq command 'magit-ediff-show-commit)
(magit-ediff-show-commit 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-modified-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-compare--read-files revA revB (magit-current-file)))))
(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))
;;; magit-ediff.el ends soon
(provide 'magit-ediff)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-ediff.el ends here

View File

@ -0,0 +1,203 @@
;;; magit-extras.el --- additional functionality for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2008-2016 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)
(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 (expand-file-name
"gitk" (file-name-nondirectory magit-git-executable))))
(and (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
(call-process 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")
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 #'call-process 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)
(call-process magit-gitk-executable nil 0))
;;;###autoload
(defun magit-run-gitk-branches ()
"Run `gitk --branches' in the current repository."
(interactive)
(call-process magit-gitk-executable nil 0 nil "--branches"))
;;;###autoload
(defun magit-run-gitk-all ()
"Run `gitk --all' in the current repository."
(interactive)
(call-process magit-gitk-executable nil 0 nil "--all"))
;;; 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
(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)
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))
;;; magit-extras.el ends soon
(provide 'magit-extras)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-extras.el ends here

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,962 @@
;;; magit-mode.el --- create and refresh Magit buffers -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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 the abstract major-mode `magit-mode' from
;; which almost all other Magit major-modes derive. The code in here
;; is mostly concerned with creating and refreshing Magit buffers.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'magit-section)
(require 'magit-git)
;; For `magit-xref-insert-buttons' from `magit'
(defvar magit-diff-show-xref-buttons)
(defvar magit-revision-show-xref-buttons)
;; For `magit-refresh' and `magit-refresh-all'
(declare-function magit-auto-revert-buffers 'magit-autorevert)
(require 'format-spec)
(require 'help-mode)
;;; Options
(defcustom magit-mode-hook
'(magit-load-config-extensions
magit-xref-setup)
"Hook run when entering a mode derived from Magit mode."
:group 'magit-modes
:type 'hook
:options '(magit-load-config-extensions
magit-xref-setup
bug-reference-mode))
(defcustom magit-mode-setup-hook
'(magit-maybe-save-repository-buffers
magit-maybe-show-margin)
"Hook run by `magit-mode-setup'."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'hook
:options '(magit-maybe-save-repository-buffers
magit-maybe-show-margin))
(defcustom magit-pre-refresh-hook '(magit-maybe-save-repository-buffers)
"Hook run before refreshing in `magit-refresh'.
This hook, or `magit-post-refresh-hook', should be used
for functions that are not tied to a particular buffer.
To run a function with a particular buffer current, use
`magit-refresh-buffer-hook' and use `derived-mode-p'
inside your function."
:package-version '(magit . "2.4.0")
:group 'magit-modes
:type 'hook
:options '(magit-maybe-save-repository-buffers))
(defcustom magit-post-refresh-hook nil
"Hook run after refreshing in `magit-refresh'.
This hook, or `magit-pre-refresh-hook', should be used
for functions that are not tied to a particular buffer.
To run a function with a particular buffer current, use
`magit-refresh-buffer-hook' and use `derived-mode-p'
inside your function."
:package-version '(magit . "2.4.0")
:group 'magit-modes
:type 'hook)
(defcustom magit-display-buffer-function 'magit-display-buffer-traditional
"The function used display a Magit buffer.
All Magit buffers (buffers whose major-modes derive from
`magit-mode') are displayed using `magit-display-buffer',
which in turn uses the function specified here."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type '(radio (function-item magit-display-buffer-traditional)
(function-item display-buffer)
(function :tag "Function")))
(unless (find-lisp-object-file-name 'magit-pre-display-buffer-hook 'defvar)
(add-hook 'magit-pre-display-buffer-hook 'magit-save-window-configuration))
(defcustom magit-pre-display-buffer-hook '(magit-save-window-configuration)
"Hook run by `magit-display-buffer' before displaying the buffer."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'hook
:options '(magit-save-window-configuration))
(unless (find-lisp-object-file-name 'magit-post-display-buffer-hook 'defvar)
(add-hook 'magit-post-display-buffer-hook 'magit-maybe-set-dedicated))
(defcustom magit-post-display-buffer-hook '(magit-maybe-set-dedicated)
"Hook run by `magit-display-buffer' after displaying the buffer."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'hook
:options '(magit-maybe-set-dedicated))
(defcustom magit-generate-buffer-name-function
'magit-generate-buffer-name-default-function
"The function used to generate the name for a Magit buffer."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type '(radio (function-item magit-generate-buffer-name-default-function)
(function :tag "Function")))
(defcustom magit-buffer-name-format "*%M%v: %t"
"The format string used to name Magit buffers.
The following %-sequences are supported:
`%m' The name of the major-mode, but with the `-mode' suffix
removed.
`%M' Like \"%m\" but abbreviate `magit-status-mode' as `magit'.
`%v' The value the buffer is locked to, in parentheses, or an empty
string if the buffer is not locked to a value.
`%V' Like \"%v\", but the string is prefixed with a space, unless it
is an empty string.
`%t' The top-level directory of the working tree of the
repository, or if `magit-uniquify-buffer-names' is non-nil
an abbreviation of that.
The value should always contain either \"%m\" or \"%M\" as well as
\"%t\". If `magit-uniquify-buffer-names' is non-nil, then the
value must end with \"%t\".
This is used by `magit-generate-buffer-name-default-function'.
If another `magit-generate-buffer-name-function' is used, then
it may not respect this option, or on the contrary it may
support additional %-sequences."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'string)
(defcustom magit-uniquify-buffer-names t
"Whether to uniquify the names of Magit buffers."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'boolean)
(defcustom magit-bury-buffer-function 'magit-restore-window-configuration
"The function used to bury or kill the current Magit buffer."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type '(radio (function-item quit-window)
(function-item magit-mode-quit-window)
(function-item magit-restore-window-configuration)
(function :tag "Function")))
(defcustom magit-region-highlight-hook
'(magit-section-update-region magit-diff-update-hunk-region)
"Functions used to highlight the region.
Each function is run with the current section as only argument
until one of them returns non-nil. When multiple sections are
selected, then this hook does not run and the region is not
displayed. Otherwise fall back to regular region highlighting."
:package-version '(magit . "2.1.0")
:group 'magit-modes
:type 'hook
:options '(magit-section-update-region magit-diff-update-hunk-region))
(defcustom magit-refresh-verbose nil
"Whether to revert Magit buffers verbosely."
:package-version '(magit . "2.1.0")
:group 'magit-modes
:type 'boolean)
(defcustom magit-refresh-buffer-hook nil
"Normal hook for `magit-refresh-buffer' to run after refreshing."
:package-version '(magit . "2.1.0")
:group 'magit-modes
:type 'hook)
(defcustom magit-refresh-status-buffer t
"Whether the status buffer is refreshed after running git.
When this is non-nil, then the status buffer is automatically
refreshed after running git for side-effects, in addition to the
current Magit buffer, which is always refreshed automatically.
Only set this to nil after exhausting all other options to
improve performance."
:package-version '(magit . "2.4.0")
:group 'magit-status
:type 'boolean)
(defcustom magit-save-repository-buffers t
"Whether to save file-visiting buffers when appropriate.
If this is non-nil then all modified file-visiting buffers
belonging to the current repository may be saved before running
commands, before creating new Magit buffers, and before
explicitly refreshing such buffers. If this is `dontask' then
this is done without user intervention, if it is t then the user
has to confirm each save. `dontask' is the recommended setting."
:group 'magit
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" t)
(const :tag "Save without asking" dontask)))
(defcustom magit-keep-region-overlay nil
"Whether to keep the region overlay when there is a valid selection.
By default Magit removes the regular region overlay if, and only
if, that region constitutes a valid selection as understood by
Magit commands. Otherwise it does not remove that overlay, and
the region looks like it would in other buffers.
There are two types of such valid selections: hunk-internal
regions and regions that select two or more sibling sections.
In such cases Magit removes the region overlay and instead
highlights a slightly larger range. All text (for hunk-internal
regions) or the headings of all sections (for sibling selections)
that are inside that range (not just inside the region) are acted
on by commands such as the staging command. This buffer range
begins at the beginning of the line on which the region begins
and ends at the end of the line on which the region ends.
Because Magit acts on this larger range and not the region, it is
actually quite important to visualize that larger range. If we
don't do that, then one might think that these commands act on
the region instead. If you want to *also* visualize the region,
then set this option to t. But please note that when the region
does *not* constitute a valid selection, then the region is
*always* visualized as usual, and that it is usually under such
circumstances that you want to use a non-magit command to act on
the region.
Besides keeping the region overlay, setting this option to t also
causes all face properties, except for `:foreground', to be
ignored for the faces used to highlight headings of selected
sections. This avoids the worst conflicts that result from
displaying the region and the selection overlays at the same
time. We are not interested in dealing with other conflicts.
In fact we *already* provide a way to avoid all of these
conflicts: *not* changing the value of this option.
It should be clear by now that we consider it a mistake to set
this to display the region when the Magit selection is also
visualized, but since it has been requested a few times and
because it doesn't cost much to offer this option we do so.
However that might change. If the existence of this option
starts complicating other things, then it will be removed."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'boolean)
;;; Magit Mode
(defvar magit-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(define-key map "\t" 'magit-section-toggle)
(define-key map [C-tab] 'magit-section-cycle)
(define-key map [M-tab] 'magit-section-cycle-diffs)
(define-key map [s-tab] 'magit-section-cycle-global)
(define-key map [backtab] 'magit-section-cycle-global)
(define-key map "^" 'magit-section-up)
(define-key map "n" 'magit-section-forward)
(define-key map "p" 'magit-section-backward)
(define-key map "\M-n" 'magit-section-forward-sibling)
(define-key map "\M-p" 'magit-section-backward-sibling)
(define-key map "+" 'magit-diff-more-context)
(define-key map "-" 'magit-diff-less-context)
(define-key map "0" 'magit-diff-default-context)
(define-key map "1" 'magit-section-show-level-1)
(define-key map "2" 'magit-section-show-level-2)
(define-key map "3" 'magit-section-show-level-3)
(define-key map "4" 'magit-section-show-level-4)
(define-key map "\M-1" 'magit-section-show-level-1-all)
(define-key map "\M-2" 'magit-section-show-level-2-all)
(define-key map "\M-3" 'magit-section-show-level-3-all)
(define-key map "\M-4" 'magit-section-show-level-4-all)
(define-key map "g" 'magit-refresh)
(define-key map "G" 'magit-refresh-all)
(define-key map "q" 'magit-mode-bury-buffer)
(define-key map "$" 'magit-process-buffer)
(define-key map "a" 'magit-cherry-apply)
(define-key map "A" 'magit-cherry-pick-popup)
(define-key map "b" 'magit-branch-popup)
(define-key map "B" 'magit-bisect-popup)
(define-key map "c" 'magit-commit-popup)
(define-key map "d" 'magit-diff-popup)
(define-key map "D" 'magit-diff-refresh-popup)
(define-key map "h" 'magit-dispatch-popup)
(define-key map "?" 'magit-dispatch-popup)
(define-key map "\C-c\C-c" 'magit-dispatch-popup)
(define-key map "\C-c\C-e" 'magit-dispatch-popup)
(define-key map "e" 'magit-ediff-dwim)
(define-key map "E" 'magit-ediff-popup)
(define-key map "f" 'magit-fetch-popup)
(define-key map "F" 'magit-pull-popup)
(define-key map "i" 'magit-gitignore)
(define-key map "I" 'magit-gitignore-locally)
(define-key map "k" 'magit-delete-thing)
(define-key map "K" 'magit-file-untrack)
(define-key map "l" 'magit-log-popup)
(define-key map "L" 'magit-log-refresh-popup)
(define-key map "m" 'magit-merge-popup)
(define-key map "M" 'magit-remote-popup)
(define-key map "o" 'magit-submodule-popup)
(define-key map "P" 'magit-push-popup)
(define-key map "r" 'magit-rebase-popup)
(define-key map "R" 'magit-file-rename)
(define-key map "t" 'magit-tag-popup)
(define-key map "T" 'magit-notes-popup)
(define-key map "\r" 'magit-visit-thing)
(define-key map [C-return] 'magit-visit-thing)
(define-key map [M-return] 'magit-dired-jump)
(define-key map "\s" 'magit-diff-show-or-scroll-up)
(define-key map "\d" 'magit-diff-show-or-scroll-down)
(define-key map "s" 'magit-stage-file)
(define-key map "S" 'magit-stage-modified)
(define-key map "u" 'magit-unstage-file)
(define-key map "U" 'magit-unstage-all)
(define-key map "v" 'magit-revert-no-commit)
(define-key map "V" 'magit-revert-popup)
(define-key map "w" 'magit-am-popup)
(define-key map "W" 'magit-patch-popup)
(define-key map "x" 'magit-reset)
(define-key map "y" 'magit-show-refs-popup)
(define-key map "Y" 'magit-cherry)
(define-key map "z" 'magit-stash-popup)
(define-key map "Z" 'magit-stash-popup)
(define-key map ":" 'magit-git-command)
(define-key map "!" 'magit-run-popup)
(define-key map "\C-xa" 'magit-add-change-log-entry)
(define-key map "\C-x4a" 'magit-add-change-log-entry-other-window)
(define-key map "\C-w" 'magit-copy-section-value)
(define-key map "\M-w" 'magit-copy-buffer-revision)
(define-key map [remap evil-previous-line] 'evil-previous-visual-line)
(define-key map [remap evil-next-line] 'evil-next-visual-line)
map)
"Parent keymap for all keymaps of modes derived from `magit-mode'.")
(defun magit-delete-thing ()
"This is a placeholder command.
Where applicable, section-specific keymaps bind another command
which deletes the thing at point."
(interactive)
(user-error "There is no thing at point that could be deleted"))
(defun magit-visit-thing ()
"This is a placeholder command.
Where applicable, section-specific keymaps bind another command
which visits the thing at point."
(interactive)
(user-error "There is no thing at point that could be visited"))
(easy-menu-define magit-mode-menu magit-mode-map
"Magit menu"
'("Magit"
["Refresh" magit-refresh t]
["Refresh all" magit-refresh-all t]
"---"
["Stage" magit-stage t]
["Stage modified" magit-stage-modified t]
["Unstage" magit-unstage t]
["Reset index" magit-reset-index t]
["Commit" magit-commit-popup t]
["Add log entry" magit-commit-add-log t]
["Tag" magit-tag t]
"---"
["Diff working tree" magit-diff-working-tree t]
["Diff" magit-diff t]
("Log"
["Log" magit-log t]
["Reflog" magit-reflog t]
["Extended..." magit-log-popup t])
"---"
["Cherry pick" magit-cherry-pick t]
["Revert commit" magit-revert-popup t]
"---"
["Ignore" magit-gitignore t]
["Ignore locally" magit-gitignore-locally t]
["Discard" magit-discard t]
["Reset head" magit-reset-head t]
["Stash" magit-stash t]
["Snapshot" magit-snapshot t]
"---"
["Branch..." magit-checkout t]
["Merge" magit-merge t]
["Ediff resolve" magit-ediff-resolve t]
["Rebase..." magit-rebase-popup t]
"---"
["Push" magit-push t]
["Pull" magit-pull t]
["Remote update" magit-fetch-all t]
("Submodule"
["Submodule update" magit-submodule-update t]
["Submodule update and init" magit-submodule-setup t]
["Submodule init" magit-submodule-init t]
["Submodule sync" magit-submodule-sync t])
"---"
("Extensions")
"---"
["Display Git output" magit-process-buffer t]
["Quit Magit" magit-mode-bury-buffer t]))
(defun magit-load-config-extensions ()
"Load Magit extensions that are defined at the Git config layer."
(dolist (ext (magit-get-all "magit.extension"))
(let ((sym (intern (format "magit-%s-mode" ext))))
(when (fboundp sym)
(funcall sym 1)))))
(define-derived-mode magit-mode special-mode "Magit"
"Parent major mode from which Magit major modes inherit.
Magit is documented in info node `(magit)'."
:group 'magit-modes
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
(setq-local line-move-visual t) ; see #1771
(setq show-trailing-whitespace nil)
(setq list-buffers-directory default-directory)
(hack-dir-local-variables-non-file-buffer)
(make-local-variable 'text-property-default-nonsticky)
(push (cons 'keymap t) text-property-default-nonsticky)
(add-hook 'post-command-hook #'magit-section-update-highlight t t)
(setq-local redisplay-highlight-region-function 'magit-highlight-region)
(setq-local redisplay-unhighlight-region-function 'magit-unhighlight-region)
(when (fboundp 'linum-mode)
(linum-mode -1)))
(defvar-local magit-region-overlays nil)
(defun magit-highlight-region (start end window rol)
(mapc #'delete-overlay magit-region-overlays)
(if (and (run-hook-with-args-until-success 'magit-region-highlight-hook
(magit-current-section))
(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 magit-unhighlight-region (rol)
(setq magit-section-highlighted-section nil)
(mapc #'delete-overlay magit-region-overlays)
(funcall (default-value 'redisplay-unhighlight-region-function) rol))
(defvar-local magit-refresh-args nil
"The arguments used to refresh the current buffer.")
(put 'magit-refresh-args 'permanent-local t)
(defvar-local magit-previous-section nil)
(put 'magit-previous-section 'permanent-local t)
(defun magit-mode-setup (mode &rest args)
"Setup up a MODE buffer using ARGS to generate its content."
(let ((buffer (magit-mode-get-buffer mode t))
(section (magit-current-section)))
(with-current-buffer buffer
(setq magit-previous-section section)
(setq magit-refresh-args args)
(funcall mode))
(magit-display-buffer buffer)
(with-current-buffer buffer
(run-hooks 'magit-mode-setup-hook)
(magit-refresh-buffer))))
(defvar magit-display-buffer-noselect nil
"If non-nil, then `magit-display-buffer' doesn't call `select-window'.")
(defun magit-display-buffer (buffer)
"Display BUFFER in some window and maybe select it.
Display the buffer using `magit-display-buffer-function' and
then, unless `magit-display-buffer-noselect' is non-nil, select
the window which was used to display the buffer.
Also run the hooks `magit-pre-display-buffer-hook'
and `magit-post-display-buffer-hook'."
(with-current-buffer buffer
(run-hooks 'magit-pre-display-buffer-hook))
(let ((window (funcall magit-display-buffer-function buffer)))
(unless magit-display-buffer-noselect
(select-window window)))
(with-current-buffer buffer
(run-hooks 'magit-post-display-buffer-hook)))
(defun magit-display-buffer-traditional (buffer)
"Display BUFFER the way this has traditionally been done."
(display-buffer
buffer (if (and (derived-mode-p 'magit-mode)
(not (memq (with-current-buffer buffer major-mode)
'(magit-process-mode
magit-revision-mode
magit-diff-mode
magit-stash-mode
magit-status-mode))))
'(display-buffer-same-window)
nil))) ; display in another window
(defun magit-maybe-set-dedicated ()
"Mark the selected window as dedicated if appropriate.
If a new window was created to display the buffer, then remember
that fact. That information is used by `magit-mode-quit-window',
to determine whether the window should be deleted when its last
Magit buffer is buried."
(let ((window (get-buffer-window (current-buffer))))
(when (and (window-live-p window)
(not (window-prev-buffers window)))
(set-window-parameter window 'magit-dedicated t))))
(defvar-local magit--default-directory nil
"Value of `default-directory' when buffer is generated.
This exists to prevent a let-bound `default-directory' from
tricking `magit-mode-get-buffer' or `magit-mode-get-buffers' into
thinking a buffer belongs to a repo that it doesn't.")
(put 'magit--default-directory 'permanent-local t)
(defun magit-mode-get-buffers ()
(let ((topdir (magit-toplevel)))
(--filter (with-current-buffer it
(and (derived-mode-p 'magit-mode)
(equal magit--default-directory topdir)))
(buffer-list))))
(defvar-local magit-buffer-locked-p nil)
(put 'magit-buffer-locked-p 'permanent-local t)
(defun magit-mode-get-buffer (mode &optional create frame)
(-if-let (topdir (magit-toplevel))
(or (--first (with-current-buffer it
(and (eq major-mode mode)
(equal magit--default-directory topdir)
(not magit-buffer-locked-p)))
(if frame
(-map #'window-buffer
(window-list (unless (eq frame t) frame)))
(buffer-list)))
(and create
(let ((default-directory topdir))
(magit-generate-new-buffer mode))))
(user-error "Not inside a Git repository")))
(defun magit-generate-new-buffer (mode)
(let* ((name (funcall magit-generate-buffer-name-function mode))
(buffer (generate-new-buffer name)))
(with-current-buffer buffer
(setq magit--default-directory default-directory))
(when magit-uniquify-buffer-names
(add-to-list 'uniquify-list-buffers-directory-modes mode)
(with-current-buffer buffer
(setq list-buffers-directory default-directory))
(let ((uniquify-buffer-name-style
(if (memq uniquify-buffer-name-style '(nil forward))
'post-forward-angle-brackets
uniquify-buffer-name-style)))
(uniquify-rationalize-file-buffer-names
name (file-name-directory (directory-file-name default-directory))
buffer)))
buffer))
(defun magit-generate-buffer-name-default-function (mode &optional value)
(let ((m (substring (symbol-name mode) 0 -5))
(v (and value (format "%s" (if (listp value) value (list value))))))
(format-spec
magit-buffer-name-format
`((?m . ,m)
(?M . ,(if (eq mode 'magit-status-mode) "magit" m))
(?v . ,(or v ""))
(?V . ,(if v (concat " " v) ""))
(?t . ,(if magit-uniquify-buffer-names
(file-name-nondirectory
(directory-file-name default-directory))
default-directory))))))
(defun magit-toggle-buffer-lock ()
"Lock the current buffer to its value or unlock it.
Locking a buffer to its value, prevents it from being reused to
display another value. The name of a locked buffer contains its
value, which allows telling it apart from other locked buffers
and the unlocked buffer.
Not all Magit buffers can be locked to their values, for example
it wouldn't make sense to lock a status buffer.
There can only be a single unlocked buffer using a certain
major-mode per repository. So when a buffer is being unlocked
and another unlocked buffer already exists for that mode and
repository, then the former buffer is instead deleted and the
latter is displayed in its place."
(interactive)
(if magit-buffer-locked-p
(-if-let (unlocked (magit-mode-get-buffer major-mode))
(let ((locked (current-buffer)))
(set-buffer unlocked)
(kill-buffer locked))
(setq magit-buffer-locked-p nil)
(rename-buffer (funcall magit-generate-buffer-name-function
major-mode)))
(setq magit-buffer-locked-p
(cond ((memq major-mode '(magit-cherry-mode
magit-log-mode
magit-reflog-mode
magit-refs-mode
magit-revision-mode
magit-stash-mode
magit-stashes-mode))
(car magit-refresh-args))
((eq major-mode 'magit-diff-mode)
(let ((rev (nth 0 magit-refresh-args))
(args (nth 1 magit-refresh-args)))
(cond
((member "--no-index" args)
(nth 3 magit-refresh-args))
(rev (if args (cons rev args) rev))
(t (if (member "--cached" args) "staged" "unstaged")))))))
(if magit-buffer-locked-p
(rename-buffer (funcall magit-generate-buffer-name-function
major-mode magit-buffer-locked-p))
(user-error "Buffer has no value it could be locked to"))))
(defun magit-mode-bury-buffer (&optional kill-buffer)
"Bury the current buffer.
With a prefix argument, kill the buffer instead.
This is done using `magit-bury-buffer-function'."
(interactive "P")
(funcall magit-bury-buffer-function kill-buffer))
(defun magit-mode-quit-window (kill-buffer)
"Quit the selected window and bury its buffer.
This behaves similar to `quit-window', but when the window
was originally created to display a Magit buffer and the
current buffer is the last remaining Magit buffer that was
ever displayed in the selected window, then delete that
window."
(if (or (one-window-p)
(--first (let ((buffer (car it)))
(and (not (eq buffer (current-buffer)))
(buffer-live-p buffer)
(or (not (window-parameter nil 'magit-dedicated))
(with-current-buffer buffer
(derived-mode-p 'magit-mode
'magit-process-mode)))))
(window-prev-buffers)))
(quit-window kill-buffer)
(let ((window (selected-window)))
(quit-window kill-buffer)
(when (window-live-p window)
(delete-window window)))))
;;; Refresh Magit Buffers
(defvar inhibit-magit-refresh nil)
(defun magit-refresh ()
"Refresh some buffers belonging to the current repository.
Refresh the current buffer if its major mode derives from
`magit-mode', and refresh the corresponding status buffer.
Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(interactive)
(unless inhibit-magit-refresh
(magit-run-hook-with-benchmark 'magit-pre-refresh-hook)
(when (derived-mode-p 'magit-mode)
(magit-refresh-buffer))
(--when-let (and magit-refresh-status-buffer
(not (derived-mode-p 'magit-status-mode))
(magit-mode-get-buffer 'magit-status-mode))
(with-current-buffer it
(magit-refresh-buffer)))
(magit-auto-revert-buffers)
(magit-run-hook-with-benchmark 'magit-post-refresh-hook)))
(defun magit-refresh-all ()
"Refresh all buffers belonging to the current repository.
Refresh all Magit buffers belonging to the current repository,
and revert buffers that visit files located inside the current
repository.
Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(interactive)
(magit-run-hook-with-benchmark 'magit-pre-refresh-hook)
(dolist (buffer (magit-mode-get-buffers))
(with-current-buffer buffer (magit-refresh-buffer)))
(magit-auto-revert-buffers)
(magit-run-hook-with-benchmark 'magit-post-refresh-hook))
(defvar-local magit-refresh-start-time nil)
(defun magit-refresh-buffer ()
"Refresh the current Magit buffer."
(setq magit-refresh-start-time (current-time))
(let ((refresh (intern (format "%s-refresh-buffer"
(substring (symbol-name major-mode) 0 -5)))))
(when (functionp refresh)
(when magit-refresh-verbose
(message "Refreshing buffer `%s'..." (buffer-name)))
(let* ((buffer (current-buffer))
(windows
(--mapcat (with-selected-window it
(with-current-buffer buffer
(-when-let (section (magit-current-section))
(list
(nconc (list it section)
(magit-refresh-get-relative-position))))))
(or (get-buffer-window-list buffer nil t)
(list (selected-window))))))
(deactivate-mark)
(setq magit-section-highlight-overlays nil
magit-section-highlighted-section nil
magit-section-highlighted-sections nil
magit-section-unhighlight-sections nil)
(let ((inhibit-read-only t))
(erase-buffer)
(save-excursion
(apply refresh magit-refresh-args)))
(dolist (window windows)
(with-selected-window (car window)
(with-current-buffer buffer
(apply #'magit-section-goto-successor (cdr window)))))
(run-hooks 'magit-refresh-buffer-hook)
(magit-section-update-highlight)
(set-buffer-modified-p nil))
(when magit-refresh-verbose
(message "Refreshing buffer `%s'...done (%.3fs)" (buffer-name)
(float-time (time-subtract (current-time)
magit-refresh-start-time)))))))
(defun magit-refresh-get-relative-position ()
(-when-let (section (magit-current-section))
(let ((start (magit-section-start section)))
(list (count-lines start (point))
(- (point) (line-beginning-position))
(and (eq (magit-section-type section) 'hunk)
(region-active-p)
(progn (goto-char (line-beginning-position))
(when (looking-at "^[-+]") (forward-line))
(while (looking-at "^[ @]") (forward-line))
(let ((beg (point)))
(cond ((looking-at "^[-+]")
(forward-line)
(while (looking-at "^[-+]") (forward-line))
(while (looking-at "^ ") (forward-line))
(forward-line -1)
(regexp-quote (buffer-substring-no-properties
beg (line-end-position))))
(t t)))))))))
;;; Save File-Visiting Buffers
(defvar disable-magit-save-buffers nil)
(defun magit-pre-command-hook ()
(setq disable-magit-save-buffers nil))
(add-hook 'pre-command-hook #'magit-pre-command-hook)
(defvar magit-after-save-refresh-buffers nil)
(defun magit-after-save-refresh-buffers ()
(dolist (buffer magit-after-save-refresh-buffers)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(magit-refresh-buffer))))
(setq magit-after-save-refresh-buffers nil)
(remove-hook 'post-command-hook 'magit-after-save-refresh-buffers))
(defun magit-after-save-refresh-status ()
"Refresh the status buffer of the current repository.
This function is intended to be added to `after-save-hook'.
If the status buffer does not exist or the file being visited in
the current buffer isn't inside a repository, then do nothing.
Note that refreshing a Magit buffer is done by re-creating its
contents from scratch, which can be slow in large repositories.
If you are not satisfied with Magit's performance, then you
should obviously not add this function to that hook."
(unless disable-magit-save-buffers
(--when-let (ignore-errors (magit-mode-get-buffer 'magit-status-mode))
(add-to-list 'magit-after-save-refresh-buffers it)
(add-hook 'post-command-hook 'magit-after-save-refresh-buffers))))
(defun magit-maybe-save-repository-buffers ()
"Maybe save file-visiting buffers belonging to the current repository.
Do so if `magit-save-repository-buffers' is non-nil. You should
not remove this from any hooks, instead set that variable to nil
if you so desire."
(when (and magit-save-repository-buffers
(not disable-magit-save-buffers))
(setq disable-magit-save-buffers t)
(let ((msg (current-message)))
(magit-save-repository-buffers
(eq magit-save-repository-buffers 'dontask))
(when (and msg (not (equal msg (current-message))))
(message "%s" msg)))))
(add-hook 'magit-pre-refresh-hook #'magit-maybe-save-repository-buffers)
(add-hook 'magit-pre-call-git-hook #'magit-maybe-save-repository-buffers)
(add-hook 'magit-pre-start-git-hook #'magit-maybe-save-repository-buffers)
(defun magit-save-repository-buffers (&optional arg)
"Save file-visiting buffers belonging to the current repository.
After any buffer where `buffer-save-without-query' is non-nil
is saved without asking, the user is asked about each modified
buffer which visits a file in the current repository. Optional
argument (the prefix) non-nil means save all with no questions."
(interactive "P")
(-when-let (topdir (magit-rev-parse-safe "--show-toplevel"))
(save-some-buffers
arg (-partial (lambda (topdir)
(and buffer-file-name
;; Avoid needlessly connecting to unrelated remotes.
(string-prefix-p topdir buffer-file-name)
(equal (magit-rev-parse-safe "--show-toplevel")
topdir)))
topdir))))
;;; Restore Window Configuration
(defvar magit-inhibit-save-previous-winconf nil)
(defvar-local magit-previous-window-configuration nil)
(put 'magit-previous-window-configuration 'permanent-local t)
(defun magit-save-window-configuration ()
"Save the current window configuration.
Later, when the buffer is buried, it may be restored by
`magit-restore-window-configuration'."
(if magit-inhibit-save-previous-winconf
(when (eq magit-inhibit-save-previous-winconf 'unset)
(setq magit-previous-window-configuration nil))
(unless (get-buffer-window (current-buffer) (selected-frame))
(setq magit-previous-window-configuration
(current-window-configuration)))))
(defun magit-restore-window-configuration (&optional kill-buffer)
"Bury or kill the current buffer and restore previous window configuration."
(let ((winconf magit-previous-window-configuration)
(buffer (current-buffer))
(frame (selected-frame)))
(quit-window kill-buffer (selected-window))
(when (and winconf (equal frame (window-configuration-frame winconf)))
(set-window-configuration winconf)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq magit-previous-window-configuration nil))))))
;;; Buffer History
(defun magit-go-backward ()
"Move backward in current buffer's history."
(interactive)
(if help-xref-stack
(help-xref-go-back (current-buffer))
(user-error "No previous entry in buffer's history")))
(defun magit-go-forward ()
"Move forward in current buffer's history."
(interactive)
(if help-xref-forward-stack
(help-xref-go-forward (current-buffer))
(user-error "No next entry in buffer's history")))
(defun magit-insert-xref-buttons (&optional _)
"Insert xref buttons."
(when (or help-xref-stack help-xref-forward-stack)
(when help-xref-stack
(magit-xref-insert-button help-back-label 'magit-xref-backward))
(when help-xref-forward-stack
(when help-xref-stack
(insert " "))
(magit-xref-insert-button help-forward-label 'magit-xref-forward))))
(defun magit-xref-insert-button (label type)
(magit-insert-section (button label)
(insert-text-button label 'type type
'help-args (list (current-buffer)))))
(define-button-type 'magit-xref-backward
:supertype 'help-back
'mouse-face 'magit-section-highlight
'help-echo (purecopy "mouse-2, RET: go back to previous history entry"))
(define-button-type 'magit-xref-forward
:supertype 'help-forward
'mouse-face 'magit-section-highlight
'help-echo (purecopy "mouse-2, RET: go back to next history entry"))
(defun magit-xref-setup ()
"Insert backward/forward buttons if the major-mode supports it.
Currently `magit-log-mode', `magit-reflog-mode',
`magit-diff-mode', and `magit-revision-mode' support it"
(when (memq major-mode '(magit-log-mode
magit-reflog-mode
magit-diff-mode
magit-revision-mode))
(when help-xref-stack-item
(push (cons (point) help-xref-stack-item) help-xref-stack)
(setq help-xref-forward-stack nil))
(when (called-interactively-p 'interactive)
(--when-let (nthcdr 10 help-xref-stack)
(setcdr it nil)))
(setq help-xref-stack-item
`(magit-xref-restore ,default-directory ,@magit-refresh-args))))
(defun magit-xref-restore (&rest args)
(magit-xref-setup)
(setq default-directory (car args))
(setq magit-refresh-args (cdr args))
(magit-refresh-buffer))
;;; Utilities
(defun magit-run-hook-with-benchmark (hook)
(when hook
(if magit-refresh-verbose
(let ((start (current-time)))
(message "Running %s..." hook)
(run-hooks hook)
(message "Running %s...done (%.3fs)" hook
(float-time (time-subtract (current-time) start))))
(run-hooks hook))))
;;; magit-mode.el ends soon
(provide 'magit-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-mode.el ends here

View File

@ -0,0 +1,12 @@
(define-package "magit" "20160223.828" "A Git porcelain inside Emacs"
'((emacs "24.4")
(async "20150909.2257")
(dash "20151021.113")
(with-editor "20160128.1201")
(git-commit "20160119.1409")
(magit-popup "20160119.1409"))
:url "https://github.com/magit/magit" :keywords
'("git" "tools" "vc"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,836 @@
;;; magit-process.el --- process functionality -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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 the tools used to run Git for side-effects.
;; Note that the functions used to run Git and then consume its
;; output, are defined in `magit-git.el'. There's a bit of overlap
;; though.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'with-editor)
(require 'magit-utils)
(require 'magit-section)
(require 'magit-git)
(require 'magit-mode)
(eval-when-compile (require 'dired))
(declare-function dired-uncache 'dired)
;;; Options
(defcustom magit-process-connection-type (not (eq system-type 'cygwin))
"Connection type used for the Git process.
If nil, use pipes: this is usually more efficient, and works on Cygwin.
If t, use ptys: this enables Magit to prompt for passphrases when needed."
:group 'magit-process
:type '(choice (const :tag "pipe" nil)
(const :tag "pty" t)))
(defcustom magit-need-cygwin-noglob
(equal "x0\n" (with-temp-buffer
(let ((process-environment
(append magit-git-environment process-environment)))
(process-file magit-git-executable
nil (current-buffer) nil
"-c" "alias.echo=!echo" "echo" "x{0}"))
(buffer-string)))
"Whether to use a workaround for Cygwin's globbing behavior.
If non-nil, add environment variables to `process-environment' to
prevent the git.exe distributed by Cygwin and MSYS2 from
attempting to perform glob expansion when called from a native
Windows build of Emacs. See #2246."
:package-version '(magit . "2.3.0")
:group 'magit-process
:type '(choice (const :tag "Yes" t)
(const :tag "No" nil)))
(defcustom magit-process-popup-time -1
"Popup the process buffer if a command takes longer than this many seconds."
:group 'magit-process
:type '(choice (const :tag "Never" -1)
(const :tag "Immediately" 0)
(integer :tag "After this many seconds")))
(defcustom magit-process-log-max 32
"Maximum number of sections to keep in a process log buffer.
When adding a new section would go beyond the limit set here,
then the older half of the sections are remove. Sections that
belong to processes that are still running are never removed.
When this is nil, no sections are ever removed."
:package-version '(magit . "2.1.0")
:group 'magit-process
:type '(choice (const :tag "Never remove old sections" nil) integer))
(defcustom magit-credential-cache-daemon-socket
(--some (-let [(prog . args) (split-string it)]
(if (string-match-p
"\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)
(or (cl-loop for (opt val) on args
if (string= opt "--socket")
return val)
(expand-file-name "~/.git-credential-cache/socket"))))
;; Note: `magit-process-file' is not yet defined when
;; evaluating this form, so we use `process-lines'.
(ignore-errors
(let ((process-environment
(append magit-git-environment process-environment)))
(process-lines magit-git-executable
"config" "--get-all" "credential.helper"))))
"If non-nil, start a credential cache daemon using this socket.
When using Git's cache credential helper in the normal way, Emacs
sends a SIGHUP to the credential daemon after the git subprocess
has exited, causing the daemon to also quit. This can be avoided
by starting the `git-credential-cache--daemon' process directly
from Emacs.
The function `magit-maybe-start-credential-cache-daemon' takes
care of starting the daemon if necessary, using the value of this
option as the socket. If this option is nil, then it does not
start any daemon. Likewise if another daemon is already running,
then it starts no new daemon. This function has to be a member
of the hook variable `magit-credential-hook' for this to work.
If an error occurs while starting the daemon, most likely because
the necessary executable is missing, then the function removes
itself from the hook, to avoid further futile attempts."
:package-version '(magit . "2.3.0")
:group 'magit-process
:type '(choice (file :tag "Socket")
(const :tag "Don't start a cache daemon" nil)))
(defcustom magit-process-yes-or-no-prompt-regexp
" [\[(]\\([Yy]\\(?:es\\)?\\)[/|]\\([Nn]o?\\)[\])] ?[?:] ?$"
"Regexp matching Yes-or-No prompts of Git and its subprocesses."
:package-version '(magit . "2.1.0")
:group 'magit-process
:type 'regexp)
(defcustom magit-process-password-prompt-regexps
'("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$"
;; match-group 99 is used to identify a host
"^\\(Enter \\)?[Pp]assword\\( for '\\(?99:.*\\)'\\)?: ?$"
"^.*'s password: ?$"
"^Yubikey for .*: ?$")
"List of regexps matching password prompts of Git and its subprocesses.
Also see `magit-process-find-password-functions'."
:package-version '(magit . "2.1.0")
:group 'magit-process
:type '(repeat (regexp)))
(defcustom magit-process-find-password-functions nil
"List of functions to try in sequence to get a password.
These functions may be called when git asks for a password, which
is detected using `magit-process-password-prompt-regexps'. They
are called if and only if matching the prompt resulted in the
value of the 99th submatch to be non-nil. Therefore users can
control for which prompts these functions should be called by
putting the host name in the 99th submatch, or not.
If the functions are called, then they are called in the order
given, with the host name as only argument, until one of them
returns non-nil. If they are not called or none of them returns
non-nil, then the password is read from the user instead."
:package-version '(magit . "2.3.0")
:group 'magit-process
:type 'hook
:options '(magit-process-password-auth-source))
(defcustom magit-process-username-prompt-regexps
'("^Username for '.*': ?$")
"List of regexps matching username prompts of Git and its subprocesses."
:package-version '(magit . "2.1.0")
:group 'magit-process
:type '(repeat (regexp)))
(defface magit-process-ok
'((t :inherit magit-section-heading :foreground "green"))
"Face for zero exit-status."
:group 'magit-faces)
(defface magit-process-ng
'((t :inherit magit-section-heading :foreground "red"))
"Face for non-zero exit-status."
:group 'magit-faces)
;;; Process Mode
(defvar magit-process-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-mode-map)
map)
"Keymap for `magit-process-mode'.")
(define-derived-mode magit-process-mode magit-mode "Magit Process"
"Mode for looking at Git process output."
:group 'magit-process
(hack-dir-local-variables-non-file-buffer))
(defun magit-process-buffer (&optional nodisplay)
"Display the current repository's process buffer.
If that buffer doesn't exist yet, then create it.
Non-interactively return the buffer and unless
optional NODISPLAY is non-nil also display it."
(interactive)
(let ((topdir (magit-toplevel)))
(unless topdir
(magit--with-safe-default-directory nil
(setq topdir default-directory)
(let (prev)
(while (not (equal topdir prev))
(setq prev topdir)
(setq topdir (file-name-directory (directory-file-name topdir)))))))
(let ((buffer (or (--first (with-current-buffer it
(and (eq major-mode 'magit-process-mode)
(equal default-directory topdir)))
(buffer-list))
(let ((default-directory topdir))
(magit-generate-new-buffer 'magit-process-mode)))))
(with-current-buffer buffer
(if magit-root-section
(when magit-process-log-max
(magit-process-truncate-log))
(magit-process-mode)
(let ((inhibit-read-only t))
(make-local-variable 'text-property-default-nonsticky)
(magit-insert-section (processbuf)
(insert "\n")))))
(unless nodisplay
(magit-display-buffer buffer))
buffer)))
(defun magit-process-kill ()
"Kill the process at point."
(interactive)
(magit-section-when process
(let ((process (magit-section-value it)))
(if (eq (process-status process) 'run)
(when (magit-confirm 'kill-process)
(kill-process process))
(user-error "Process isn't running")))))
;;; Synchronous Processes
(defvar magit-process-raise-error nil)
(defun magit-git (&rest args)
"Call Git synchronously in a separate process, for side-effects.
Option `magit-git-executable' specifies the Git executable.
The arguments ARGS specify arguments to Git, they are flattened
before use.
Process output goes into a new section in the buffer returned by
`magit-process-buffer'. If Git exits with a non-zero status,
then raise an error."
(let ((magit-process-raise-error t))
(magit-call-git args)))
(defun magit-run-git (&rest args)
"Call Git synchronously in a separate process, and refresh.
Option `magit-git-executable' specifies the Git executable and
option `magit-git-global-arguments' specifies constant arguments.
The arguments ARGS specify arguments to Git, they are flattened
before use.
After Git returns, the current buffer (if it is a Magit buffer)
as well as the current repository's status buffer are refreshed.
Process output goes into a new section in the buffer returned by
`magit-process-buffer'."
(magit-call-git args)
(magit-refresh))
(defvar magit-pre-call-git-hook nil)
(defun magit-call-git (&rest args)
"Call Git synchronously in a separate process.
Option `magit-git-executable' specifies the Git executable and
option `magit-git-global-arguments' specifies constant arguments.
The arguments ARGS specify arguments to Git, they are flattened
before use.
Process output goes into a new section in the buffer returned by
`magit-process-buffer'."
(run-hooks 'magit-pre-call-git-hook)
(apply #'magit-call-process magit-git-executable
(magit-process-git-arguments args)))
(defun magit-call-process (program &rest args)
"Call PROGRAM synchronously in a separate process.
Process output goes into a new section in the buffer returned by
`magit-process-buffer'."
(-let [(process-buf . section) (magit-process-setup program args)]
(magit-process-finish
(let ((inhibit-read-only t))
(apply #'magit-process-file program nil process-buf nil args))
process-buf (current-buffer) default-directory section)))
(defun magit-process-file (&rest args)
"Process files synchronously in a separate process.
Identical to `process-file' but temporarily enable Cygwin's
\"noglob\" option during the call."
(let ((process-environment (append (magit-cygwin-env-vars)
process-environment)))
(apply #'process-file args)))
(defun magit-cygwin-env-vars ()
(append magit-git-environment
(when magit-need-cygwin-noglob
(mapcar (lambda (var)
(concat var "=" (--if-let (getenv var)
(concat it " noglob")
"noglob")))
'("CYGWIN" "MSYS")))))
(defvar magit-this-process nil)
(defun magit-run-git-with-input (&rest args)
"Call Git in a separate process.
ARGS is flattened and then used as arguments to Git.
The current buffer's content is used as the process' standard
input.
Option `magit-git-executable' specifies the Git executable and
option `magit-git-global-arguments' specifies constant arguments.
The remaining arguments ARGS specify arguments to Git, they are
flattened before use."
(declare (indent 1))
(if (file-remote-p default-directory)
;; We lack `process-file-region', so fall back to asynch +
;; waiting in remote case.
(progn
(magit-start-git (current-buffer) args)
(while (and magit-this-process
(eq (process-status magit-this-process) 'run))
(sleep-for 0.005)))
(run-hooks 'magit-pre-call-git-hook)
(-let* ((process-environment (append (magit-cygwin-env-vars)
process-environment))
(flat-args (magit-process-git-arguments args))
((process-buf . section)
(magit-process-setup magit-git-executable flat-args))
(inhibit-read-only t))
(magit-process-finish
(apply #'call-process-region (point-min) (point-max)
magit-git-executable nil process-buf nil flat-args)
process-buf nil default-directory section))))
(defun magit-run-git-with-logfile (file &rest args)
"Call Git in a separate process and log its output to FILE.
This function might have a short halflive."
(apply #'magit-process-file magit-git-executable nil `(:file ,file) nil
(magit-process-git-arguments args))
(magit-refresh))
;;; Asynchronous Processes
(defun magit-run-git-async (&rest args)
"Start Git, prepare for refresh, and return the process object.
ARGS is flattened and then used as arguments to Git.
Display the command line arguments in the echo area.
After Git returns some buffers are refreshed: the buffer that was
current when this function was called (if it is a Magit buffer
and still alive), as well as the respective Magit status buffer.
See `magit-start-process' for more information."
(message "Running %s %s" magit-git-executable
(let ((m (mapconcat #'identity (-flatten args) " ")))
(remove-list-of-text-properties 0 (length m) '(face) m)
m))
(magit-start-git nil args))
(defun magit-run-git-with-editor (&rest args)
"Export GIT_EDITOR and start Git.
Also prepare for refresh and return the process object.
ARGS is flattened and then used as arguments to Git.
Display the command line arguments in the echo area.
After Git returns some buffers are refreshed: the buffer that was
current when this function was called (if it is a Magit buffer
and still alive), as well as the respective Magit status buffer.
See `magit-start-process' and `with-editor' for more information."
(with-editor "GIT_EDITOR"
(let ((magit-process-popup-time -1))
(magit-run-git-async args))))
(defun magit-run-git-sequencer (&rest args)
"Export GIT_EDITOR and start Git.
Also prepare for refresh and return the process object.
ARGS is flattened and then used as arguments to Git.
Display the command line arguments in the echo area.
After Git returns some buffers are refreshed: the buffer that was
current when this function was called (if it is a Magit buffer
and still alive), as well as the respective Magit status buffer.
If the sequence stops at a commit, make the section representing
that commit the current section by moving `point' there.
See `magit-start-process' and `with-editor' for more information."
(with-editor "GIT_EDITOR"
(let ((magit-process-popup-time -1))
(magit-run-git-async args)))
(set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel)
magit-this-process)
(defvar magit-pre-start-git-hook nil)
(defun magit-start-git (input &rest args)
"Start Git, prepare for refresh, and return the process object.
If INPUT is non-nil, it has to be a buffer or the name of an
existing buffer. The buffer content becomes the processes
standard input.
Option `magit-git-executable' specifies the Git executable and
option `magit-git-global-arguments' specifies constant arguments.
The remaining arguments ARGS specify arguments to Git, they are
flattened before use.
After Git returns some buffers are refreshed: the buffer that was
current when this function was called (if it is a Magit buffer
and still alive), as well as the respective Magit status buffer.
See `magit-start-process' for more information."
(run-hooks 'magit-pre-start-git-hook)
(apply #'magit-start-process magit-git-executable input
(magit-process-git-arguments args)))
(defun magit-start-process (program &optional input &rest args)
"Start PROGRAM, prepare for refresh, and return the process object.
If optional argument INPUT is non-nil, it has to be a buffer or
the name of an existing buffer. The buffer content becomes the
processes standard input.
The process is started using `start-file-process' and then setup
to use the sentinel `magit-process-sentinel' and the filter
`magit-process-filter'. Information required by these functions
is stored in the process object. When this function returns the
process has not started to run yet so it is possible to override
the sentinel and filter.
After the process returns, `magit-process-sentinel' refreshes the
buffer that was current when `magit-start-process' was called (if
it is a Magit buffer and still alive), as well as the respective
Magit status buffer."
(-let* (((process-buf . section)
(magit-process-setup program args))
(process
(let ((process-connection-type
;; Don't use a pty, because it would set icrnl
;; which would modify the input (issue #20).
(and (not input) magit-process-connection-type))
(process-environment (append (magit-cygwin-env-vars)
process-environment)))
(apply #'start-file-process
(file-name-nondirectory program)
process-buf program args))))
(with-editor-set-process-filter process #'magit-process-filter)
(set-process-sentinel process #'magit-process-sentinel)
(set-process-buffer process process-buf)
(process-put process 'section section)
(process-put process 'command-buf (current-buffer))
(process-put process 'default-dir default-directory)
(when inhibit-magit-refresh
(process-put process 'inhibit-refresh t))
(setf (magit-section-process section) process)
(with-current-buffer process-buf
(set-marker (process-mark process) (point)))
(when input
(with-current-buffer input
(process-send-region process (point-min) (point-max))
(process-send-eof process)))
(setq magit-this-process process)
(setf (magit-section-value section) process)
(magit-process-display-buffer process)
process))
;;; Process Internals
(defun magit-process-setup (program args)
(magit-process-set-mode-line program args)
(let ((pwd default-directory)
(buf (magit-process-buffer t)))
(cons buf (with-current-buffer buf
(prog1 (magit-process-insert-section pwd program args nil nil)
(backward-char 1))))))
(defun magit-process-insert-section (pwd program args &optional errcode errlog)
(let ((inhibit-read-only t)
(magit-insert-section--parent magit-root-section))
(goto-char (1- (point-max)))
(magit-insert-section (process)
(insert (if errcode
(format "%3s " (propertize (number-to-string errcode)
'face 'magit-process-ng))
"run "))
(unless (equal (expand-file-name pwd)
(expand-file-name default-directory))
(insert (file-relative-name pwd default-directory) ?\s))
(insert (propertize program 'face 'magit-section-heading))
(insert " ")
(when (and args (equal program magit-git-executable))
(setq args (-split-at (length magit-git-global-arguments) args))
(insert (propertize (char-to-string magit-ellipsis)
'face 'magit-section-heading
'help-echo (mapconcat #'identity (car args) " ")))
(insert " ")
(setq args (cadr args)))
(insert (propertize (mapconcat #'identity args " ")
'face 'magit-section-heading))
(magit-insert-heading)
(when errlog
(insert-file-contents errlog)
(goto-char (1- (point-max))))
(insert "\n"))))
(defun magit-process-truncate-log ()
(let* ((head nil)
(tail (magit-section-children magit-root-section))
(count (length tail)))
(when (> (1+ count) magit-process-log-max)
(while (and (cdr tail)
(> count (/ magit-process-log-max 2)))
(let* ((inhibit-read-only t)
(section (car tail))
(process (magit-section-process section)))
(cond ((not process))
((memq (process-status process) '(exit signal))
(delete-region (magit-section-start section)
(1+ (magit-section-end section)))
(cl-decf count))
(t
(push section head))))
(pop tail))
(setf (magit-section-children magit-root-section)
(nconc (reverse head) tail)))))
(defun magit-process-sentinel (process event)
"Default sentinel used by `magit-start-process'."
(when (memq (process-status process) '(exit signal))
(setq event (substring event 0 -1))
(when (string-match "^finished" event)
(message (concat (capitalize (process-name process)) " finished")))
(magit-process-finish process)
(when (eq process magit-this-process)
(setq magit-this-process nil))
(unless (process-get process 'inhibit-refresh)
(let ((command-buf (process-get process 'command-buf)))
(if (buffer-live-p command-buf)
(with-current-buffer command-buf
(magit-refresh))
(with-temp-buffer
(setq default-directory (process-get process 'default-dir))
(magit-refresh)))))))
(defun magit-sequencer-process-sentinel (process event)
"Special sentinel used by `magit-run-git-sequencer'."
(when (memq (process-status process) '(exit signal))
(magit-process-sentinel process event)
(--when-let (magit-mode-get-buffer 'magit-status-mode)
(with-current-buffer it
(--when-let
(magit-get-section
`((commit . ,(magit-rev-parse "HEAD"))
(,(pcase (car (cadr (-split-at
(1+ (length magit-git-global-arguments))
(process-command process))))
((or "rebase" "am") 'rebase-sequence)
((or "cherry-pick" "revert") 'sequence)))
(status)))
(goto-char (magit-section-start it))
(magit-section-update-highlight))))))
(defun magit-process-filter (proc string)
"Default filter used by `magit-start-process'."
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t))
(magit-process-yes-or-no-prompt proc string)
(magit-process-username-prompt proc string)
(magit-process-password-prompt proc string)
(goto-char (process-mark proc))
(setq string (propertize string 'magit-section
(process-get proc 'section)))
;; Find last ^M in string. If one was found, ignore
;; everything before it and delete the current line.
(let ((ret-pos (length string)))
(while (and (>= (cl-decf ret-pos) 0)
(/= ?\r (aref string ret-pos))))
(if (< ret-pos 0)
(insert string)
(delete-region (line-beginning-position) (point))
(insert (substring string (1+ ret-pos)))))
(set-marker (process-mark proc) (point)))))
(defmacro magit-process-kill-on-abort (proc &rest body)
(declare (indent 1) (debug (form body)))
(let ((map (cl-gensym)))
`(let ((,map (make-sparse-keymap)))
(set-keymap-parent ,map minibuffer-local-map)
(define-key ,map "\C-g"
(lambda ()
(interactive)
(ignore-errors (kill-process ,proc))
(abort-recursive-edit)))
(let ((minibuffer-local-map ,map))
,@body))))
(defun magit-process-yes-or-no-prompt (process string)
"Forward Yes-or-No prompts to the user."
(-when-let (beg (string-match magit-process-yes-or-no-prompt-regexp string))
(let ((max-mini-window-height 30))
(process-send-string
process
(downcase
(concat
(match-string
(if (save-match-data
(magit-process-kill-on-abort process
(yes-or-no-p (substring string 0 beg)))) 1 2)
string)
"\n"))))))
(defun magit-process-password-auth-source (key)
"Use `auth-source-search' to get a password.
If found, return the password. Otherwise, return nil."
(require 'auth-source)
(let ((secret (plist-get (car (auth-source-search :max 1 :host key
:require '(:host)))
:secret)))
(if (functionp secret)
(funcall secret)
secret)))
(defun magit-process-password-prompt (process string)
"Find a password based on prompt STRING and send it to git.
First try the functions in `magit-process-find-password-functions'.
If none of them returns a password, then read it from the user
instead."
(--when-let (magit-process-match-prompt
magit-process-password-prompt-regexps string)
(process-send-string
process (magit-process-kill-on-abort process
(concat (or (--when-let (match-string 99 string)
(run-hook-with-args-until-success
'magit-process-find-password-functions it))
(read-passwd it))
"\n")))))
(defun magit-process-username-prompt (process string)
"Forward username prompts to the user."
(--when-let (magit-process-match-prompt
magit-process-username-prompt-regexps string)
(process-send-string
process (magit-process-kill-on-abort process
(concat (read-string it nil nil (user-login-name)) "\n")))))
(defun magit-process-match-prompt (prompts string)
"Match STRING against PROMPTS and set match data.
Return the matched string suffixed with \": \", if needed."
(when (--any? (string-match it string) prompts)
(let ((prompt (match-string 0 string)))
(cond ((string-suffix-p ": " prompt) prompt)
((string-suffix-p ":" prompt) (concat prompt " "))
(t (concat prompt ": "))))))
(defvar magit-credential-hook nil
"Hook run before Git needs credentials.")
(defvar magit-credential-cache-daemon-process nil)
(defun magit-maybe-start-credential-cache-daemon ()
"Maybe start a `git-credential-cache--daemon' process.
If such a process is already running or if the value of option
`magit-credential-cache-daemon-socket' is nil, then do nothing.
Otherwise start the process passing the value of that options
as argument."
(unless (or (not magit-credential-cache-daemon-socket)
(process-live-p magit-credential-cache-daemon-process)
(memq magit-credential-cache-daemon-process
(list-system-processes)))
(setq magit-credential-cache-daemon-process
(or (--first (-let (((&alist 'comm comm 'user user)
(process-attributes it)))
(and (string= comm "git-credential-cache--daemon")
(string= user user-login-name)))
(list-system-processes))
(condition-case nil
(start-process "git-credential-cache--daemon"
" *git-credential-cache--daemon*"
magit-git-executable
"credential-cache--daemon"
magit-credential-cache-daemon-socket)
;; Some Git implementations (e.g. Windows) won't have
;; this program; if we fail the first time, stop trying.
((debug error)
(remove-hook 'magit-credential-hook
#'magit-maybe-start-credential-cache-daemon)))))))
(add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon)
(defun tramp-sh-handle-start-file-process--magit-tramp-process-environment
(fn name buffer program &rest args)
(if magit-tramp-process-environment
(apply fn name buffer
(car magit-tramp-process-environment)
(append (cdr magit-tramp-process-environment)
(cons program args)))
(apply fn name buffer program args)))
(advice-add 'tramp-sh-handle-start-file-process :around
'tramp-sh-handle-start-file-process--magit-tramp-process-environment)
(defun tramp-sh-handle-process-file--magit-tramp-process-environment
(fn program &optional infile destination display &rest args)
(if magit-tramp-process-environment
(apply fn "env" infile destination display
(append magit-tramp-process-environment
(cons program args)))
(apply fn program infile destination display args)))
(advice-add 'tramp-sh-handle-process-file :around
'tramp-sh-handle-process-file--magit-tramp-process-environment)
(defun magit-process-set-mode-line (program args)
(when (equal program magit-git-executable)
(setq args (nthcdr (length magit-git-global-arguments) args)))
(let ((str (concat " " program (and args (concat " " (car args))))))
(dolist (buf (magit-mode-get-buffers))
(with-current-buffer buf (setq mode-line-process str)))))
(defun magit-process-unset-mode-line ()
(dolist (buf (magit-mode-get-buffers))
(with-current-buffer buf (setq mode-line-process nil))))
(defvar magit-process-error-message-re
(concat "^\\(?:error\\|fatal\\|git\\): \\(.*\\)" paragraph-separate))
(define-error 'magit-git-error "Git error")
(defvar-local magit-this-error nil)
(defun magit-process-finish (arg &optional process-buf command-buf
default-dir section)
(unless (integerp arg)
(setq process-buf (process-buffer arg)
command-buf (process-get arg 'command-buf)
default-dir (process-get arg 'default-dir)
section (process-get arg 'section)
arg (process-exit-status arg)))
(magit-process-unset-mode-line)
(when (featurep 'dired)
(dired-uncache default-dir))
(when (buffer-live-p process-buf)
(with-current-buffer process-buf
(let ((inhibit-read-only t)
(marker (magit-section-start section)))
(goto-char marker)
(save-excursion
(delete-char 3)
(set-marker-insertion-type marker nil)
(insert (propertize (format "%3s" arg)
'magit-section section
'face (if (= arg 0)
'magit-process-ok
'magit-process-ng)))
(set-marker-insertion-type marker t))
(if (= (magit-section-end section)
(+ (line-end-position) 2))
(save-excursion
(goto-char (1+ (line-end-position)))
(delete-char -1)
(setf (magit-section-content section) nil))
(let ((buf (magit-process-buffer t)))
(when (and (= arg 0)
(not (--any-p (eq (window-buffer it) buf)
(window-list))))
(magit-section-hide section)))))))
(unless (= arg 0)
(let ((msg (or (and (buffer-live-p process-buf)
(with-current-buffer process-buf
(save-excursion
(goto-char (magit-section-end section))
(--when-let (magit-section-content section)
(when (re-search-backward
magit-process-error-message-re it t)
(match-string 1))))))
"Git failed")))
(if magit-process-raise-error
(signal 'magit-git-error (format "%s (in %s)" msg default-dir))
(--when-let (magit-mode-get-buffer 'magit-status-mode)
(setq magit-this-error msg))
(message "%s ... [%s buffer %s for details]" msg
(-if-let (key (and (buffer-live-p command-buf)
(with-current-buffer command-buf
(car (where-is-internal
'magit-process-buffer)))))
(format "Hit %s to see" (key-description key))
"See")
(buffer-name process-buf)))))
arg)
(defun magit-process-display-buffer (process)
(when (process-live-p process)
(let ((buf (process-buffer process)))
(cond ((not (buffer-live-p buf)))
((= magit-process-popup-time 0)
(if (minibufferp)
(switch-to-buffer-other-window buf)
(pop-to-buffer buf)))
((> magit-process-popup-time 0)
(run-with-timer magit-process-popup-time nil
(lambda (p)
(when (eq (process-status p) 'run)
(let ((buf (process-buffer p)))
(when (buffer-live-p buf)
(if (minibufferp)
(switch-to-buffer-other-window buf)
(pop-to-buffer buf))))))
process))))))
;;; magit-process.el ends soon
(provide 'magit-process)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-process.el ends here

View File

@ -0,0 +1,719 @@
;;; magit-remote.el --- transfer Git commits -*- lexical-binding: t -*-
;; Copyright (C) 2008-2016 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 interacting with remote
;; repositories. Commands for cloning, fetching, pulling, and
;; pushing are defined here.
;;; Code:
(require 'magit)
;;; Clone
(defcustom magit-clone-set-remote-head nil
"Whether cloning creates the symbolic-ref `<remote>/HEAD'."
:package-version '(magit . "2.4.2")
:group 'magit-commands
:type 'boolean)
(defcustom magit-clone-set-remote.pushDefault 'ask
"Whether to set the value of `remote.pushDefault' after cloning.
If t, then set without asking. If nil, then don't set. If
`ask', then ask."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(choice (const :tag "set" t)
(const :tag "ask" ask)
(const :tag "don't set" nil)))
;;;###autoload
(defun magit-clone (repository directory)
"Clone the REPOSITORY to DIRECTORY.
Then show the status buffer for the new repository."
(interactive
(let ((url (magit-read-string-ns "Clone repository")))
(list url (read-directory-name
"Clone to: " nil nil nil
(and (string-match "\\([^./]+\\)\\(\\.git\\)?$" url)
(match-string 1 url))))))
(setq directory (file-name-as-directory (expand-file-name directory)))
(message "Cloning %s..." repository)
(when (= (magit-call-git "clone" repository
;; Stop cygwin git making a "c:" directory.
(magit-convert-git-filename directory))
0)
(let ((default-directory directory))
(when (or (eq magit-clone-set-remote.pushDefault t)
(and magit-clone-set-remote.pushDefault
(y-or-n-p "Set `remote.pushDefault' to \"origin\"? ")))
(magit-call-git "config" "remote.pushDefault" "origin"))
(unless magit-clone-set-remote-head
(magit-remote-unset-head "origin")))
(message "Cloning %s...done" repository)
(magit-status-internal directory)))
;;; Setup
(defcustom magit-remote-add-set-remote.pushDefault 'ask-if-unset
"Whether to set the value of `remote.pushDefault' after adding a remote.
If `ask', then always ask. If `ask-if-unset', then ask, but only
if the variable isn't set already. If nil, then don't ever set.
If the value is a string, then set without asking, provided the
name of the name of the added remote is equal to that string and
the variable isn't already set."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(choice (const :tag "ask if unset" ask-if-unset)
(const :tag "always ask" ask)
(string :tag "set if named")
(const :tag "don't set")))
;;;###autoload (autoload 'magit-remote-popup "magit-remote" nil t)
(magit-define-popup magit-remote-popup
"Popup console for remote commands."
'magit-commands nil nil
:man-page "git-remote"
:actions '((?a "Add" magit-remote-add)
(?r "Rename" magit-remote-rename)
(?k "Remove" magit-remote-remove)
(?u "Set url" magit-remote-set-url)))
(defun magit-read-url (prompt &optional initial-input)
(let ((url (magit-read-string-ns prompt initial-input)))
(if (string-prefix-p "~" url)
(expand-file-name url)
url)))
;;;###autoload
(defun magit-remote-add (remote url)
"Add a remote named REMOTE and fetch it."
(interactive (list (magit-read-string-ns "Remote name")
(magit-read-url "Remote url")))
(if (pcase (list magit-remote-add-set-remote.pushDefault
(magit-get "remote.defaultPush"))
(`(,(pred stringp) ,_) t)
((or `(ask ,_) `(ask-if-unset nil))
(y-or-n-p (format "Set `remote.pushDefault' to \"%s\"? " remote))))
(progn (magit-call-git "remote" "add" "-f" remote url)
(magit-call-git "config" "remote.pushDefault" remote)
(magit-refresh))
(magit-run-git-async "remote" "add" "-f" remote url)))
;;;###autoload
(defun magit-remote-rename (old new)
"Rename the remote named OLD to NEW."
(interactive
(let ((remote (magit-read-remote "Rename remote")))
(list remote (magit-read-string-ns (format "Rename %s to" remote)))))
(unless (string= old new)
(magit-run-git "remote" "rename" old new)))
;;;###autoload
(defun magit-remote-set-url (remote url)
"Change the url of the remote named REMOTE to URL."
(interactive
(let ((remote (magit-read-remote "Set url of remote")))
(list remote (magit-read-url
"Url" (magit-get "remote" remote "url")))))
(magit-run-git "remote" "set-url" remote url))
;;;###autoload
(defun magit-remote-remove (remote)
"Delete the remote named REMOTE."
(interactive (list (magit-read-remote "Delete remote")))
(magit-run-git "remote" "rm" remote))
;;;###autoload
(defun magit-remote-set-head (remote &optional branch)
"Set the local representation of REMOTE's default branch.
Query REMOTE and set the symbolic-ref refs/remotes/<remote>/HEAD
accordingly. With a prefix argument query for the branch to be
used, which allows you to select an incorrect value if you fancy
doing that."
(interactive
(let ((remote (magit-read-remote "Set HEAD for remote")))
(list remote
(and current-prefix-arg
(magit-read-remote-branch (format "Set %s/HEAD to" remote)
remote nil nil t)))))
(magit-run-git "remote" "set-head" remote (or branch "--auto")))
;;;###autoload
(defun magit-remote-unset-head (remote)
"Unset the local representation of REMOTE's default branch.
Delete the symbolic-ref \"refs/remotes/<remote>/HEAD\"."
(interactive (list (magit-read-remote "Unset HEAD for remote")))
(magit-run-git "remote" "set-head" remote "--delete"))
;;; Fetch
;;;###autoload (autoload 'magit-fetch-popup "magit-remote" nil t)
(magit-define-popup magit-fetch-popup
"Popup console for fetch commands."
'magit-commands
:man-page "git-fetch"
:switches '((?p "Prune deleted branches" "--prune"))
:actions '("Fetch from"
(?p magit-get-push-remote magit-fetch-from-pushremote)
(?u magit-get-remote magit-fetch-from-upstream)
(?e "elsewhere" magit-fetch)
(?a "all remotes" magit-fetch-all)
"Fetch"
(?m "submodules" magit-submodule-fetch))
:default-action 'magit-fetch
:max-action-columns 1)
(defun magit-git-fetch (remote args)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "fetch" remote args))
;;;###autoload
(defun magit-fetch-from-pushremote (args)
"Fetch from the push-remote of the current branch."
(interactive (list (magit-fetch-arguments)))
(--if-let (magit-get-push-remote)
(magit-git-fetch it args)
(--if-let (magit-get-current-branch)
(user-error "No push-remote is configured for %s" it)
(user-error "No branch is checked out"))))
;;;###autoload
(defun magit-fetch-from-upstream (args)
"Fetch from the upstream repository of the current branch."
(interactive (list (magit-fetch-arguments)))
(--if-let (magit-get-remote)
(magit-git-fetch it args)
(--if-let (magit-get-current-branch)
(user-error "No upstream is configured for %s" it)
(user-error "No branch is checked out"))))
;;;###autoload
(defun magit-fetch (remote args)
"Fetch from another repository."
(interactive (list (magit-read-remote "Fetch remote")
(magit-fetch-arguments)))
(magit-git-fetch remote args))
;;;###autoload
(defun magit-fetch-all (args)
"Fetch from all remotes."
(interactive (list (magit-fetch-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update" args))
;;;###autoload
(defun magit-fetch-all-prune ()
"Fetch from all remotes, and prune.
Prune remote tracking branches for branches that have been
removed on the respective remote."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update" "--prune"))
;;;###autoload
(defun magit-fetch-all-no-prune ()
"Fetch from all remotes."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update"))
;;; Pull
;;;###autoload (autoload 'magit-pull-popup "magit-remote" nil t)
(magit-define-popup magit-pull-popup
"Popup console for pull commands."
'magit-commands
:man-page "git-pull"
:variables '("Variables"
(?r "branch.%s.rebase"
magit-cycle-branch*rebase
magit-pull-format-branch*rebase))
:actions '((lambda ()
(--if-let (magit-get-current-branch)
(concat
(propertize "Pull into " 'face 'magit-popup-heading)
(propertize it 'face 'magit-branch-local)
(propertize " from" 'face 'magit-popup-heading))
(propertize "Pull from" 'face 'magit-popup-heading)))
(?p magit-get-push-branch magit-pull-from-pushremote)
(?u magit-get-upstream-branch magit-pull-from-upstream)
(?e "elsewhere" magit-pull))
:default-action 'magit-pull
:max-action-columns 1)
;;;###autoload (autoload 'magit-pull-and-fetch-popup "magit-remote" nil t)
(magit-define-popup magit-pull-and-fetch-popup
"Popup console for pull and fetch commands.
This popup is intended as a replacement for the separate popups
`magit-pull-popup' and `magit-fetch-popup'. To use it, add this
to your init file:
(with-eval-after-load \\='magit-remote
(define-key magit-mode-map \"f\" \\='magit-pull-and-fetch-popup)
(define-key magit-mode-map \"F\" nil))
The combined popup does not offer all commands and arguments
available from the individual popups. Instead of the argument
`--prune' and the command `magit-fetch-all' it uses two commands
`magit-fetch-prune' and `magit-fetch-no-prune'. And the commands
`magit-fetch-from-pushremote' and `magit-fetch-from-upstream' are
missing. To add them use something like:
(with-eval-after-load \\='magit-remote
(magit-define-popup-action \\='magit-pull-and-fetch-popup ?U
\\='magit-get-upstream-branch
\\='magit-fetch-from-upstream-remote ?F)
(magit-define-popup-action \\='magit-pull-and-fetch-popup ?P
\\='magit-get-push-branch
\\='magit-fetch-from-push-remote ?F))"
'magit-commands
:man-page "git-pull"
:variables '("Pull variables"
(?r "branch.%s.rebase"
magit-cycle-branch*rebase
magit-pull-format-branch*rebase))
:actions '((lambda ()
(--if-let (magit-get-current-branch)
(concat
(propertize "Pull into " 'face 'magit-popup-heading)
(propertize it 'face 'magit-branch-local)
(propertize " from" 'face 'magit-popup-heading))
(propertize "Pull from" 'face 'magit-popup-heading)))
(?p magit-get-push-branch magit-pull-from-pushremote)
(?u magit-get-upstream-branch magit-pull-from-upstream)
(?e "elsewhere" magit-pull)
"Fetch from"
(?f "remotes" magit-fetch-all-no-prune)
(?F "remotes and prune" magit-fetch-all-prune)
"Fetch"
(?m "submodules" magit-submodule-fetch))
:default-action 'magit-fetch
:max-action-columns 1)
(defun magit-pull-format-branch*rebase ()
(magit-popup-format-variable (format "branch.%s.rebase"
(or (magit-get-current-branch) "<name>"))
'("true" "false")
"false" "pull.rebase"))
(defun magit-git-pull (source args)
(run-hooks 'magit-credential-hook)
(-let [(remote . branch)
(magit-split-branch-name source)]
(magit-run-git-with-editor "pull" args remote branch)))
;;;###autoload
(defun magit-pull-from-pushremote (args)
"Pull from the push-remote of the current branch."
(interactive (list (magit-pull-arguments)))
(--if-let (magit-get-push-branch)
(magit-git-pull it args)
(--if-let (magit-get-current-branch)
(user-error "No push-remote is configured for %s" it)
(user-error "No branch is checked out"))))
;;;###autoload
(defun magit-pull-from-upstream (args)
"Pull from the upstream of the current branch."
(interactive (list (magit-pull-arguments)))
(--if-let (magit-get-upstream-branch)
(magit-git-pull it args)
(--if-let (magit-get-current-branch)
(user-error "No upstream is configured for %s" it)
(user-error "No branch is checked out"))))
;;;###autoload
(defun magit-pull (source args)
"Pull from a branch read in the minibuffer."
(interactive (list (magit-read-remote-branch "Pull" nil nil nil t)
(magit-pull-arguments)))
(magit-git-pull source args))
;;; Push
(defcustom magit-push-current-set-remote-if-missing t
"Whether to configure missing remotes before pushing.
When nil, then the command `magit-push-current-to-pushremote' and
`magit-push-current-to-upstream' do not appear in the push popup
if the push-remote resp. upstream is not configured. If the user
invokes one of these commands anyway, then it raises an error.
When non-nil, then these commands always appear in the push
popup. But if the required configuration is missing, then they
do appear in a way that indicates that this is the case. If the
user invokes one of them, then it asks for the necessary
configuration, stores the configuration, and then uses it to push
a first time.
This option also affects whether the argument `--set-upstream' is
available in the popup. If the value is t, then that argument is
redundant. But note that changing the value of this option does
not take affect immediately, the argument will only be added or
removed after restarting Emacs."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type 'boolean)
;;;###autoload (autoload 'magit-push-popup "magit-remote" nil t)
(magit-define-popup magit-push-popup
"Popup console for push commands."
'magit-commands
:man-page "git-push"
:switches `((?f "Force" "--force-with-lease")
(?h "Disable hooks" "--no-verify")
(?d "Dry run" "--dry-run")
,@(and (not magit-push-current-set-remote-if-missing)
'((?u "Set upstream" "--set-upstream"))))
:actions '((lambda ()
(--when-let (magit-get-current-branch)
(concat (propertize "Push " 'face 'magit-popup-heading)
(propertize it 'face 'magit-branch-local)
(propertize " to" 'face 'magit-popup-heading))))
(?p magit--push-current-to-pushremote-desc
magit-push-current-to-pushremote)
(?u magit--push-current-to-upstream-desc
magit-push-current-to-upstream)
(?e "elsewhere\n" magit-push-current)
"Push"
(?o "another branch" magit-push)
(?T "a tag" magit-push-tag)
(?r "explicit refspecs" magit-push-refspecs)
(?t "all tags" magit-push-tags)
(?m "matching branches" magit-push-matching))
:max-action-columns 2)
(defun magit-git-push (branch target args)
(run-hooks 'magit-credential-hook)
(-let [(remote . target)
(magit-split-branch-name target)]
(magit-run-git-async "push" "-v" args remote
(format "%s:refs/heads/%s" branch target))))
;;;###autoload
(defun magit-push-current-to-pushremote (args &optional push-remote)
"Push the current branch to `branch.<name>.pushRemote'.
If that variable is unset, then push to `remote.pushDefault'.
When `magit-push-current-set-remote-if-missing' is non-nil and
the push-remote is not configured, then read the push-remote from
the user, set it, and then push to it. With a prefix argument
the push-remote can be changed before pushed to it."
(interactive
(list (magit-push-arguments)
(and (magit--push-current-set-pushremote-p current-prefix-arg)
(magit-read-remote (format "Set push-remote of %s and push there"
(magit-get-current-branch))))))
(--if-let (magit-get-current-branch)
(progn (when push-remote
(magit-call-git "config"
(format "branch.%s.pushRemote"
(magit-get-current-branch))
push-remote))
(-if-let (remote (magit-get-push-remote it))
(if (member remote (magit-list-remotes))
(magit-git-push it (concat remote "/" it) args)
(user-error "Remote `%s' doesn't exist" remote))
(user-error "No push-remote is configured for %s" it)))
(user-error "No branch is checked out")))
(defun magit--push-current-set-pushremote-p (&optional change)
(and (or change
(and magit-push-current-set-remote-if-missing
(not (magit-get-push-remote))))
(magit-get-current-branch)))
(defun magit--push-current-to-pushremote-desc ()
(--if-let (magit-get-push-branch)
(concat (magit-branch-set-face it) "\n")
(and (magit--push-current-set-pushremote-p)
(concat (propertize "pushRemote" 'face 'bold)
", after setting that\n"))))
;;;###autoload
(defun magit-push-current-to-upstream (args &optional upstream)
"Push the current branch to its upstream branch.
When `magit-push-current-set-remote-if-missing' is non-nil and
the upstream is not configured, then read the upstream from the
user, set it, and then push to it. With a prefix argument the
upstream can be changed before pushed to it."
(interactive
(list (magit-push-arguments)
(and (magit--push-current-set-upstream-p current-prefix-arg)
(magit-read-upstream-branch))))
(--if-let (magit-get-current-branch)
(progn
(when upstream
(magit-set-branch*merge/remote it upstream))
(-if-let (target (magit-get-upstream-branch it))
(magit-git-push it target args)
(user-error "No upstream is configured for %s" it)))
(user-error "No branch is checked out")))
(defun magit--push-current-set-upstream-p (&optional change)
(and (or change
(and magit-push-current-set-remote-if-missing
(not (magit-get-upstream-branch))))
(magit-get-current-branch)))
(defun magit--push-current-to-upstream-desc ()
(--if-let (magit-get-upstream-branch)
(concat (magit-branch-set-face it) "\n")
(and (magit--push-current-set-upstream-p)
(concat (propertize "@{upstream}" 'face 'bold)
", after setting that\n"))))
;;;###autoload
(defun magit-push-current (target args)
"Push the current branch to a branch read in the minibuffer."
(interactive
(--if-let (magit-get-current-branch)
(list (magit-read-remote-branch (format "Push %s to" it)
nil nil it 'confirm)
(magit-push-arguments))
(user-error "No branch is checked out")))
(magit-git-push (magit-get-current-branch) target args))
;;;###autoload
(defun magit-push (source target args)
"Push an arbitrary branch or commit somewhere.
Both the source and the target are read in the minibuffer."
(interactive
(let ((source (magit-read-local-branch-or-commit "Push")))
(list source
(magit-read-remote-branch (format "Push %s to" source) nil
(magit-get-upstream-branch source)
source 'confirm)
(magit-push-arguments))))
(magit-git-push source target args))
;;;###autoload
(defun magit-push-refspecs (remote refspecs args)
"Push one or multiple REFSPECS to a REMOTE.
Both the REMOTE and the REFSPECS are read in the minibuffer. To
use multiple REFSPECS, separate them with commas. Completion is
only available for the part before the colon, or when no colon
is used."
(interactive
(list (magit-read-remote "Push to remote")
(completing-read-multiple
"Push refspec,s: "
(cons "HEAD" (magit-list-local-branch-names)))
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote refspecs))
;;;###autoload
(defun magit-push-matching (remote &optional args)
"Push all matching branches to another repository.
If multiple remotes exist, then read one from the user.
If just one exists, use that without requiring confirmation."
(interactive (list (magit-read-remote "Push matching branches to" nil t)
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote ":"))
;;;###autoload
(defun magit-push-tags (remote &optional args)
"Push all tags to another repository.
If only one remote exists, then push to that. Otherwise prompt
for a remote, offering the remote configured for the current
branch as default."
(interactive (list (magit-read-remote "Push tags to remote" nil t)
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" remote "--tags" args))
;;;###autoload
(defun magit-push-tag (tag remote &optional args)
"Push a tag to another repository."
(interactive
(let ((tag (magit-read-tag "Push tag")))
(list tag (magit-read-remote (format "Push %s to remote" tag) nil t)
(magit-push-arguments))))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" remote tag args))
;;;###autoload
(defun magit-push-implicitly (args)
"Push somewhere without using an explicit refspec.
This command simply runs \"git push -v [ARGS]\". ARGS are the
arguments specified in the popup buffer. No explicit refspec
arguments are used. Instead the behavior depends on at least
these Git variables: `push.default', `remote.pushDefault',
`branch.<branch>.pushRemote', `branch.<branch>.remote',
`branch.<branch>.merge', and `remote.<remote>.push'.
To add this command to the push popup add this to your init file:
(with-eval-after-load \\='magit-remote
(magit-define-popup-action \\='magit-push-popup ?P
'magit-push-implicitly--desc
'magit-push-implicitly ?p t))
The function `magit-push-implicitly--desc' attempts to predict
what this command will do, the value it returns is displayed in
the popup buffer."
(interactive (list (magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args))
(defun magit-push-implicitly--desc ()
(let ((default (magit-get "push.default")))
(unless (equal default "nothing")
(or (-when-let* ((remote (or (magit-get-remote)
(magit-remote-p "origin")))
(refspec (magit-get "remote" remote "push")))
(format "%s using %s"
(propertize remote 'face 'magit-branch-remote)
(propertize refspec 'face 'bold)))
(--when-let (and (not (magit-get-push-branch))
(magit-get-upstream-branch))
(format "%s aka %s\n"
(magit-branch-set-face it)
(propertize "@{upstream}" 'face 'bold)))
(--when-let (magit-get-push-branch)
(format "%s aka %s\n"
(magit-branch-set-face it)
(propertize "pushRemote" 'face 'bold)))
(--when-let (magit-get-@{push}-branch)
(format "%s aka %s\n"
(magit-branch-set-face it)
(propertize "@{push}" 'face 'bold)))
(format "using %s (%s is %s)\n"
(propertize "git push" 'face 'bold)
(propertize "push.default" 'face 'bold)
(propertize default 'face 'bold))))))
;;;###autoload
(defun magit-push-to-remote (remote args)
"Push to REMOTE without using an explicit refspec.
The REMOTE is read in the minibuffer.
This command simply runs \"git push -v [ARGS] REMOTE\". ARGS
are the arguments specified in the popup buffer. No refspec
arguments are used. Instead the behavior depends on at least
these Git variables: `push.default', `remote.pushDefault',
`branch.<branch>.pushRemote', `branch.<branch>.remote',
`branch.<branch>.merge', and `remote.<remote>.push'.
To add this command to the push popup add this to your init file:
(with-eval-after-load \\='magit-remote
(magit-define-popup-action \\='magit-push-popup ?r
'magit-push-to-remote--desc
'magit-push-to-remote ?p t))"
(interactive (list (magit-read-remote "Push to remote")
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote))
(defun magit-push-to-remote--desc ()
(format "using %s\n" (propertize "git push <remote>" 'face 'bold)))
;;; Email
;;;###autoload (autoload 'magit-patch-popup "magit-remote" nil t)
(magit-define-popup magit-patch-popup
"Popup console for patch commands."
'magit-commands
:man-page "git-format-patch"
:switches '("Switches for formatting patches"
(?l "Add cover letter" "--cover-letter"))
:options '("Options for formatting patches"
(?f "From" "--from=")
(?t "To" "--to=")
(?c "CC" "--cc=")
(?r "In reply to" "--in-reply-to=")
(?v "Reroll count" "--reroll-count=")
(?s "Thread style" "--thread=")
(?U "Context lines" "-U")
(?M "Detect renames" "-M")
(?C "Detect copies" "-C")
(?A "Diff algorithm" "--diff-algorithm="
magit-diff-select-algorithm)
(?o "Output directory" "--output-directory="))
:actions '((?p "Format patches" magit-format-patch)
(?r "Request pull" magit-request-pull))
:default-action 'magit-format-patch)
;;;###autoload
(defun magit-format-patch (range args)
"Create patches for the commits in RANGE.
When a single commit is given for RANGE, create a patch for the
changes introduced by that commit (unlike 'git format-patch'
which creates patches for all commits that are reachable from
HEAD but not from the specified commit)."
(interactive
(list (-if-let (revs (magit-region-values 'commit))
(concat (car (last revs)) "^.." (car revs))
(let ((range (magit-read-range-or-commit "Format range or commit")))
(if (string-match-p "\\.\\." range)
range
(format "%s~..%s" range range))))
(magit-patch-arguments)))
(magit-call-git "format-patch" range args)
(when (member "--cover-letter" args)
(find-file
(expand-file-name
"0000-cover-letter.patch"
(let ((topdir (magit-toplevel)))
(or (--some (and (string-match "--output-directory=\\(.+\\)" it)
(expand-file-name (match-string 1 it) topdir))
args)
topdir))))))
;;;###autoload
(defun magit-request-pull (url start end)
"Request upstream to pull from you public repository.
URL is the url of your publically accessible repository.
START is a commit that already is in the upstream repository.
END is the last commit, usually a branch name, which upstream
is asked to pull. START has to be reachable from that commit."
(interactive
(list (magit-get "remote" (magit-read-remote "Remote") "url")
(magit-read-branch-or-commit "Start" (magit-get-upstream-branch))
(magit-read-branch-or-commit "End")))
(let ((dir default-directory))
;; mu4e changes default-directory
(compose-mail)
(setq default-directory dir))
(message-goto-body)
(magit-git-insert "request-pull" start url end)
(set-buffer-modified-p nil))
;;; magit-remote.el ends soon
(provide 'magit-remote)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-remote.el ends here

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,651 @@
;;; magit-sequence.el --- history manipulation in Magit -*- lexical-binding: t -*-
;; Copyright (C) 2011-2016 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:
;; Support for Git commands that replay commits and help the user make
;; changes along the way. Supports `cherry-pick', `revert', `rebase',
;; `rebase--interactive' and `am'.
;;; Code:
(require 'magit)
;;; Options
;;;; Faces
(defface magit-sequence-pick
'((t :inherit default))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-stop
'((((class color) (background light)) :foreground "DarkOliveGreen4")
(((class color) (background dark)) :foreground "DarkSeaGreen2"))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-part
'((((class color) (background light)) :foreground "Goldenrod4")
(((class color) (background dark)) :foreground "LightGoldenrod2"))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-head
'((((class color) (background light)) :foreground "SkyBlue4")
(((class color) (background dark)) :foreground "LightSkyBlue1"))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-drop
'((((class color) (background light)) :foreground "IndianRed")
(((class color) (background dark)) :foreground "IndianRed"))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-done
'((t :inherit magit-hash))
"Face used in sequence sections."
:group 'magit-faces)
(defface magit-sequence-onto
'((t :inherit magit-sequence-done))
"Face used in sequence sections."
:group 'magit-faces)
;;; Common
;;;###autoload
(defun magit-sequencer-continue ()
"Resume the current cherry-pick or revert sequence."
(interactive)
(if (magit-sequencer-in-progress-p)
(if (magit-anything-unstaged-p t)
(user-error "Cannot continue due to unstaged changes")
(magit-run-git-sequencer
(if (magit-revert-in-progress-p) "revert" "cherry-pick") "--continue"))
(user-error "No cherry-pick or revert in progress")))
;;;###autoload
(defun magit-sequencer-skip ()
"Skip the stopped at commit during a cherry-pick or revert sequence."
(interactive)
(if (magit-sequencer-in-progress-p)
(progn (magit-call-git "reset" "--hard")
(magit-sequencer-continue))
(user-error "No cherry-pick or revert in progress")))
;;;###autoload
(defun magit-sequencer-abort ()
"Abort the current cherry-pick or revert sequence.
This discards all changes made since the sequence started."
(interactive)
(if (magit-sequencer-in-progress-p)
(magit-run-git-sequencer
(if (magit-revert-in-progress-p) "revert" "cherry-pick") "--abort")
(user-error "No cherry-pick or revert in progress")))
(defun magit-sequencer-in-progress-p ()
(or (magit-cherry-pick-in-progress-p)
(magit-revert-in-progress-p)))
;;; Cherry-Pick
;;;###autoload (autoload 'magit-cherry-pick-popup "magit-sequence" nil t)
(magit-define-popup magit-cherry-pick-popup
"Popup console for cherry-pick commands."
'magit-commands
:man-page "git-cherry-pick"
:switches '((?s "Add Signed-off-by lines" "--signoff")
(?e "Edit commit messages" "--edit")
(?x "Reference cherry in commit message" "-x")
(?F "Attempt fast-forward" "--ff")
(?m "Reply merge relative to parent" "--mainline="))
:options '((?s "Strategy" "--strategy="))
:actions '((?A "Cherry Pick" magit-cherry-pick)
(?a "Cherry Apply" magit-cherry-apply))
:sequence-actions '((?A "Continue" magit-sequencer-continue)
(?s "Skip" magit-sequencer-skip)
(?a "Abort" magit-sequencer-abort))
:sequence-predicate 'magit-sequencer-in-progress-p
:default-arguments '("--ff"))
(defun magit-cherry-pick-read-args (prompt)
(list (or (nreverse (magit-region-values 'commit))
(magit-read-other-branch-or-commit prompt))
(magit-cherry-pick-arguments)))
;;;###autoload
(defun magit-cherry-pick (commit &optional args)
"Cherry-pick COMMIT.
Prompt for a commit, defaulting to the commit at point. If
the region selects multiple commits, then pick all of them,
without prompting."
(interactive (magit-cherry-pick-read-args "Cherry-pick"))
(magit-assert-one-parent (car (if (listp commit)
commit
(split-string commit "\\.\\.")))
"cherry-pick")
(magit-run-git-sequencer "cherry-pick" args commit))
;;;###autoload
(defun magit-cherry-apply (commit &optional args)
"Apply the changes in COMMIT but do not commit them.
Prompt for a commit, defaulting to the commit at point. If
the region selects multiple commits, then apply all of them,
without prompting."
(interactive (magit-cherry-pick-read-args "Apply changes from commit"))
(magit-assert-one-parent commit "cherry-pick")
(magit-run-git-sequencer "cherry-pick" "--no-commit"
(remove "--ff" args) commit))
(defun magit-cherry-pick-in-progress-p ()
;; .git/sequencer/todo does not exist when there is only one commit left.
(file-exists-p (magit-git-dir "CHERRY_PICK_HEAD")))
;;; Revert
;;;###autoload (autoload 'magit-revert-popup "magit-sequence" nil t)
(magit-define-popup magit-revert-popup
"Popup console for revert commands."
'magit-commands
:man-page "git-revert"
:switches '((?s "Add Signed-off-by lines" "--signoff"))
:options '((?s "Strategy" "--strategy="))
:actions '((?V "Revert commit(s)" magit-revert)
(?v "Revert changes" magit-revert-no-commit))
:sequence-actions '((?V "Continue" magit-sequencer-continue)
(?s "Skip" magit-sequencer-skip)
(?a "Abort" magit-sequencer-abort))
:sequence-predicate 'magit-sequencer-in-progress-p)
(defun magit-revert-read-args (prompt)
(list (or (magit-region-values 'commit)
(magit-read-branch-or-commit prompt))
(magit-revert-arguments)))
;;;###autoload
(defun magit-revert (commit &optional args)
"Revert COMMIT by creating a new commit.
Prompt for a commit, defaulting to the commit at point. If
the region selects multiple commits, then revert all of them,
without prompting."
(interactive (magit-revert-read-args "Revert commit"))
(magit-assert-one-parent commit "revert")
(magit-run-git-sequencer "revert" args commit))
;;;###autoload
(defun magit-revert-no-commit (commit &optional args)
"Revert COMMIT by applying it in reverse to the worktree.
Prompt for a commit, defaulting to the commit at point. If
the region selects multiple commits, then revert all of them,
without prompting."
(interactive (magit-revert-read-args "Revert changes"))
(magit-assert-one-parent commit "revert")
(magit-run-git-sequencer "revert" "--no-commit" args commit))
(defun magit-revert-in-progress-p ()
;; .git/sequencer/todo does not exist when there is only one commit left.
(file-exists-p (magit-git-dir "REVERT_HEAD")))
;;; Patch
;;;###autoload (autoload 'magit-am-popup "magit-sequence" nil t)
(magit-define-popup magit-am-popup
"Popup console for mailbox commands."
'magit-commands
:man-page "git-am"
:switches '((?3 "Fall back on 3way merge" "--3way")
(?s "Add Signed-off-by lines" "--signoff")
(?c "Remove text before scissors line" "--scissors")
(?k "Inhibit removal of email cruft" "--keep")
(?b "Limit removal of email cruft" "--keep-non-patch")
(?d "Use author date as committer date"
"--committer-date-is-author-date")
(?D "Use committer date as author date" "--ignore-date"))
:options '((?p "Remove leading slashes from paths" "-p"
magit-popup-read-number))
:actions '((?w "Apply patches" magit-am-apply-patches)
(?m "Apply maildir" magit-am-apply-maildir))
:default-arguments '("--3way")
:default-actions 'magit-am-apply-patches
:sequence-actions '((?w "Continue" magit-am-continue)
(?s "Skip" magit-am-skip)
(?a "Abort" magit-am-abort))
:sequence-predicate 'magit-am-in-progress-p)
;;;###autoload
(defun magit-am-apply-patches (&optional files args)
"Apply the patches FILES."
(interactive (list (or (magit-region-values 'file)
(list (let ((default (magit-file-at-point)))
(read-file-name
(if default
(format "Apply patch (%s): " default)
"Apply patch: ")
nil default))))
(magit-am-arguments)))
(magit-run-git-sequencer "am" args "--" (mapcar 'expand-file-name files)))
;;;###autoload
(defun magit-am-apply-maildir (&optional maildir args)
"Apply the patches from MAILDIR."
(interactive (list (read-file-name "Apply mbox or Maildir: ")
(magit-am-arguments)))
(magit-run-git-sequencer "am" args (expand-file-name maildir)))
;;;###autoload
(defun magit-am-continue ()
"Resume the current patch applying sequence."
(interactive)
(if (magit-am-in-progress-p)
(if (magit-anything-unstaged-p t)
(error "Cannot continue due to unstaged changes")
(magit-run-git-sequencer "am" "--continue"))
(user-error "Not applying any patches")))
;;;###autoload
(defun magit-am-skip ()
"Skip the stopped at patch during a patch applying sequence."
(interactive)
(if (magit-am-in-progress-p)
(magit-run-git-sequencer "am" "--skip")
(user-error "Not applying any patches")))
;;;###autoload
(defun magit-am-abort ()
"Abort the current patch applying sequence.
This discards all changes made since the sequence started."
(interactive)
(if (magit-am-in-progress-p)
(magit-run-git "am" "--abort")
(user-error "Not applying any patches")))
(defun magit-am-in-progress-p ()
(file-exists-p (magit-git-dir "rebase-apply/applying")))
;;; Rebase
;;;###autoload (autoload 'magit-rebase-popup "magit-sequence" nil t)
(magit-define-popup magit-rebase-popup
"Key menu for rebasing."
'magit-commands
:man-page "git-rebase"
:switches '((?k "Keep empty commits" "--keep-empty")
(?p "Preserve merges" "--preserve-merges")
(?c "Lie about author date" "--committer-date-is-author-date")
(?a "Autosquash" "--autosquash")
(?A "Autostash" "--autostash")
(?i "Interactive" "--interactive"))
:actions '((lambda ()
(concat (propertize "Rebase " 'face 'magit-popup-heading)
(propertize (or (magit-get-current-branch) "HEAD")
'face 'magit-branch-local)
(propertize " onto" 'face 'magit-popup-heading)))
(?p (lambda ()
(--when-let (magit-get-push-branch) (concat it "\n")))
magit-rebase-onto-pushremote)
(?u (lambda ()
(--when-let (magit-get-upstream-branch) (concat it "\n")))
magit-rebase-onto-upstream)
(?e "elsewhere" magit-rebase)
"Rebase"
(?i "interactively" magit-rebase-interactive)
(?m "to edit a commit" magit-rebase-edit-commit)
(?s "subset" magit-rebase-subset)
(?w "to reword a commit" magit-rebase-reword-commit) nil
(?f "to autosquash" magit-rebase-autosquash))
:sequence-actions '((?r "Continue" magit-rebase-continue)
(?s "Skip" magit-rebase-skip)
(?e "Edit" magit-rebase-edit)
(?a "Abort" magit-rebase-abort))
:sequence-predicate 'magit-rebase-in-progress-p
:max-action-columns 2)
(defun magit-git-rebase (target args)
(magit-run-git-sequencer "rebase" target args))
;;;###autoload
(defun magit-rebase-onto-pushremote (args)
"Rebase the current branch onto `branch.<name>.pushRemote'.
If that variable is unset, then rebase onto `remote.pushDefault'."
(interactive (list (magit-rebase-arguments)))
(--if-let (magit-get-current-branch)
(-if-let (remote (magit-get-push-remote it))
(if (member remote (magit-list-remotes))
(magit-git-rebase (concat remote "/" it) args)
(user-error "Remote `%s' doesn't exist" remote))
(user-error "No push-remote is configured for %s" it))
(user-error "No branch is checked out")))
;;;###autoload
(defun magit-rebase-onto-upstream (args)
"Rebase the current branch onto its upstream branch."
(interactive (list (magit-rebase-arguments)))
(--if-let (magit-get-current-branch)
(-if-let (target (magit-get-upstream-branch it))
(magit-git-rebase target args)
(user-error "No upstream is configured for %s" it))
(user-error "No branch is checked out")))
;;;###autoload
(defun magit-rebase (target args)
"Rebase the current branch onto a branch read in the minibuffer.
All commits that are reachable from head but not from the
selected branch TARGET are being rebased."
(interactive (list (magit-read-other-branch-or-commit "Rebase onto")
(magit-rebase-arguments)))
(message "Rebasing...")
(magit-git-rebase target args)
(message "Rebasing...done"))
;;;###autoload
(defun magit-rebase-subset (newbase start args)
"Rebase a subset of the current branches history onto a new base.
Rebase commits from START to `HEAD' onto NEWBASE.
START has to be selected from a list of recent commits."
(interactive (list (magit-read-other-branch-or-commit
"Rebase subset onto" nil
(magit-get-upstream-branch))
nil
(magit-rebase-arguments)))
(if start
(progn (message "Rebasing...")
(magit-run-git-sequencer "rebase" "--onto" newbase start args)
(message "Rebasing...done"))
(magit-log-select
`(lambda (commit)
(magit-rebase-subset ,newbase (concat commit "^") (list ,@args)))
(concat "Type %p on a commit to rebase it "
"and commits above it onto " newbase ","))))
(defun magit-rebase-interactive-1 (commit args message &optional editor)
(declare (indent 2))
(when commit
(if (eq commit :merge-base)
(setq commit (--if-let (magit-get-upstream-branch)
(magit-git-string "merge-base" it "HEAD")
nil))
(when (magit-git-failure "merge-base" "--is-ancestor" commit "HEAD")
(user-error "%s isn't an ancestor of HEAD" commit))
(if (magit-commit-parents commit)
(setq commit (concat commit "^"))
(setq args (cons "--root" args)))))
(when (and commit
(magit-git-lines "rev-list" "--merges" (concat commit "..HEAD")))
(magit-read-char-case "Proceed despite merge in rebase range? " nil
(?c "[c]ontinue")
(?s "[s]elect other" (setq commit nil))
(?a "[a]bort" (user-error "Quit"))))
(if commit
(let ((process-environment process-environment))
(when editor
(push (concat "GIT_SEQUENCE_EDITOR=" editor) process-environment))
(magit-run-git-sequencer "rebase" "-i" args
(unless (member "--root" args) commit)))
(magit-log-select
`(lambda (commit)
(magit-rebase-interactive-1 commit (list ,@args) ,message ,editor))
message)))
;;;###autoload
(defun magit-rebase-interactive (commit args)
"Start an interactive rebase sequence."
(interactive (list (magit-commit-at-point)
(magit-rebase-arguments)))
(magit-rebase-interactive-1 commit args
"Type %p on a commit to rebase it and all commits above it,"))
;;;###autoload
(defun magit-rebase-autosquash (args)
"Combine squash and fixup commits with their intended targets."
(interactive (list (magit-rebase-arguments)))
(magit-rebase-interactive-1 :merge-base (cons "--autosquash" args)
"Type %p on a commit to squash into it and then rebase as necessary,"
"true"))
;;;###autoload
(defun magit-rebase-edit-commit (commit args)
"Edit a single older commit using rebase."
(interactive (list (magit-commit-at-point)
(magit-rebase-arguments)))
(magit-rebase-interactive-1 commit args
"Type %p on a commit to edit it,"
"perl -i -p -e '++$x if not $x and s/^pick/edit/'"))
;;;###autoload
(defun magit-rebase-reword-commit (commit args)
"Reword a single older commit using rebase."
(interactive (list (magit-commit-at-point)
(magit-rebase-arguments)))
(magit-rebase-interactive-1 commit args
"Type %p on a commit to reword its message,"
"perl -i -p -e '++$x if not $x and s/^pick/reword/'"))
;;;###autoload
(defun magit-rebase-continue ()
"Restart the current rebasing operation."
(interactive)
(if (magit-rebase-in-progress-p)
(if (magit-anything-unstaged-p t)
(user-error "Cannot continue rebase with unstaged changes")
(magit-run-git-sequencer "rebase" "--continue"))
(user-error "No rebase in progress")))
;;;###autoload
(defun magit-rebase-skip ()
"Skip the current commit and restart the current rebase operation."
(interactive)
(if (magit-rebase-in-progress-p)
(magit-run-git-sequencer "rebase" "--skip")
(user-error "No rebase in progress")))
;;;###autoload
(defun magit-rebase-edit ()
"Edit the todo list of the current rebase operation."
(interactive)
(if (magit-rebase-in-progress-p)
(magit-run-git-sequencer "rebase" "--edit-todo")
(user-error "No rebase in progress")))
;;;###autoload
(defun magit-rebase-abort ()
"Abort the current rebase operation, restoring the original branch."
(interactive)
(if (magit-rebase-in-progress-p)
(magit-run-git "rebase" "--abort")
(user-error "No rebase in progress")))
(defun magit-rebase-in-progress-p ()
"Return t if a rebase is in progress."
(or (file-exists-p (magit-git-dir "rebase-merge"))
(file-exists-p (magit-git-dir "rebase-apply/onto"))))
;;; Sections
(defun magit-insert-sequencer-sequence ()
"Insert section for the on-going cherry-pick or revert sequence.
If no such sequence is in progress, do nothing."
(let ((picking (magit-cherry-pick-in-progress-p)))
(when (or picking (magit-revert-in-progress-p))
(magit-insert-section (sequence)
(magit-insert-heading (if picking "Cherry Picking" "Reverting"))
(-when-let (lines (cdr (magit-file-lines (magit-git-dir "sequencer/todo"))))
(dolist (line (nreverse lines))
(when (string-match "^\\(pick\\|revert\\) \\([^ ]+\\) \\(.*\\)$" line)
(magit-bind-match-strings (cmd hash msg) line
(magit-insert-section (commit hash)
(insert (propertize cmd 'face 'magit-sequence-pick)
" " (propertize hash 'face 'magit-hash)
" " msg "\n"))))))
(magit-sequence-insert-sequence
(magit-file-line (magit-git-dir (if picking
"CHERRY_PICK_HEAD"
"REVERT_HEAD")))
(magit-file-line (magit-git-dir "sequencer/head")))
(insert "\n")))))
(defun magit-insert-am-sequence ()
"Insert section for the on-going patch applying sequence.
If no such sequence is in progress, do nothing."
(when (magit-am-in-progress-p)
(magit-insert-section (rebase-sequence)
(magit-insert-heading "Applying patches")
(let ((patches (nreverse (magit-rebase-patches)))
patch commit)
(while patches
(setq patch (pop patches)
commit (magit-rev-verify-commit
(cadr (split-string (magit-file-line patch)))))
(cond ((and commit patches)
(magit-sequence-insert-commit
"pick" commit 'magit-sequence-pick))
(patches
(magit-sequence-insert-am-patch
"pick" patch 'magit-sequence-pick))
(commit
(magit-sequence-insert-sequence commit "ORIG_HEAD"))
(t
(magit-sequence-insert-am-patch
"stop" patch 'magit-sequence-stop)
(magit-sequence-insert-sequence nil "ORIG_HEAD")))))
(insert ?\n))))
(defun magit-sequence-insert-am-patch (type patch face)
(magit-insert-section (file patch)
(insert (propertize type 'face face)
?\s (propertize (file-name-nondirectory patch) 'face 'magit-hash)
?\n)))
(defun magit-insert-rebase-sequence ()
"Insert section for the on-going rebase sequence.
If no such sequence is in progress, do nothing."
(when (magit-rebase-in-progress-p)
(let* ((interactive (file-directory-p (magit-git-dir "rebase-merge")))
(dir (if interactive "rebase-merge/" "rebase-apply/"))
(name (-> (concat dir "head-name") magit-git-dir magit-file-line))
(onto (-> (concat dir "onto") magit-git-dir magit-file-line))
(onto (or (magit-rev-name onto name)
(magit-rev-name onto "refs/heads/*") onto))
(name (or (magit-rev-name name "refs/heads/*") name)))
(magit-insert-section (rebase-sequence)
(magit-insert-heading (format "Rebasing %s onto %s" name onto))
(if interactive
(magit-rebase-insert-merge-sequence)
(magit-rebase-insert-apply-sequence))
(magit-sequence-insert-sequence
(magit-file-line
(magit-git-dir
(concat dir (if interactive "stopped-sha" "original-commit"))))
onto (--map (cadr (split-string it))
(magit-file-lines (magit-git-dir "rebase-merge/done"))))
(insert ?\n)))))
(defun magit-rebase-insert-merge-sequence ()
(dolist (line (nreverse
(magit-file-lines
(magit-git-dir "rebase-merge/git-rebase-todo"))))
(when (string-match "^\\([^# ]+\\) \\([^ ]+\\) .*$" line)
(magit-bind-match-strings (action hash) line
(magit-sequence-insert-commit action hash 'magit-sequence-pick)))))
(defun magit-rebase-insert-apply-sequence ()
(dolist (patch (nreverse (cdr (magit-rebase-patches))))
(magit-sequence-insert-commit
"pick" (cadr (split-string (magit-file-line patch))) 'magit-sequence-pick)))
(defun magit-rebase-patches ()
(directory-files (magit-git-dir "rebase-apply") t "^[0-9]\\{4\\}$"))
(defun magit-sequence-insert-sequence (stop onto &optional orig)
(let ((head (magit-rev-parse "HEAD")) done)
(setq onto (if onto (magit-rev-parse onto) head))
(setq done (magit-git-lines "log" "--format=%H" (concat onto "..HEAD")))
(when (and stop (not (member stop done)))
(let ((id (magit-patch-id stop)))
(--if-let (--first (equal (magit-patch-id it) id) done)
(setq stop it)
(cond
((--first (magit-rev-equal it stop) done)
;; The commit's testament has been executed.
(magit-sequence-insert-commit "void" stop 'magit-sequence-drop))
;; The faith of the commit is still undecided...
((magit-anything-unmerged-p)
;; ...and time travel isn't for the faint of heart.
(magit-sequence-insert-commit "join" stop 'magit-sequence-part))
((magit-anything-modified-p t)
;; ...and the dust hasn't settled yet...
(magit-sequence-insert-commit
(let ((staged (magit-commit-tree "oO" nil "HEAD"))
(unstaged (magit-commit-worktree "oO" "--reset")))
(cond
;; ...but we could end up at the same tree just by committing.
((or (magit-rev-equal staged stop)
(magit-rev-equal unstaged stop)) "goal")
;; ...but the changes are still there, untainted.
((or (equal (magit-patch-id staged) id)
(equal (magit-patch-id unstaged) id)) "same")
;; ...and some changes are gone and/or others were added.
(t "work")))
stop 'magit-sequence-part))
;; The commit is definitely gone...
((--first (magit-rev-equal it stop) done)
;; ...but all of its changes are still in effect.
(magit-sequence-insert-commit "poof" stop 'magit-sequence-drop))
(t
;; ...and some changes are gone and/or other changes were added.
(magit-sequence-insert-commit "gone" stop 'magit-sequence-drop)))
(setq stop nil))))
(dolist (rev done)
(apply 'magit-sequence-insert-commit
(cond ((equal rev stop)
;; ...but its reincarnation lives on.
;; Or it didn't die in the first place.
(list (if (and (equal rev head)
(equal (magit-patch-id (concat stop "^"))
(magit-patch-id (car (last orig 2)))))
"stop" ; We haven't done anything yet.
"same") ; There are new commits.
rev (if (equal rev head)
'magit-sequence-head
'magit-sequence-stop)))
((equal rev head)
(list "done" rev 'magit-sequence-head))
(t
(list "done" rev 'magit-sequence-done)))))
(magit-sequence-insert-commit "onto" onto
(if (equal onto head)
'magit-sequence-head
'magit-sequence-onto))))
(defun magit-sequence-insert-commit (type hash face)
(magit-insert-section (commit hash)
(insert (propertize type 'face face) ?\s
(magit-format-rev-summary hash) ?\n)))
;;; magit-sequence.el ends soon
(provide 'magit-sequence)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-sequence.el ends here

View File

@ -0,0 +1,400 @@
;;; magit-stash.el --- stash support for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2008-2016 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:
;; Support for Git stashes.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-stash-popup "magit-stash" nil t)
(magit-define-popup magit-stash-popup
"Popup console for stash commands."
'magit-commands
:man-page "git-stash"
:switches '((?u "Also save untracked files" "--include-untracked")
(?a "Also save untracked and ignored files" "--all"))
:actions '((?z "Save" magit-stash)
(?Z "Snapshot" magit-snapshot)
(?p "Pop" magit-stash-pop)
(?i "Save index" magit-stash-index)
(?I "Snapshot index" magit-snapshot-index)
(?a "Apply" magit-stash-apply)
(?w "Save worktree" magit-stash-worktree)
(?W "Snapshot worktree" magit-snapshot-worktree)
(?l "List" magit-stash-list)
(?x "Save keeping index" magit-stash-keep-index)
(?r "Snapshot to wipref" magit-wip-commit)
(?v "Show" magit-stash-show)
(?b "Branch" magit-stash-branch)
(?k "Drop" magit-stash-drop) nil
(?f "Format patch" magit-stash-format-patch))
:default-action 'magit-stash
:max-action-columns 3)
;;;###autoload
(defun magit-stash (message &optional include-untracked)
"Create a stash of the index and working tree.
Untracked files are included according to popup arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-stash-read-args))
(magit-stash-save message t t include-untracked t))
;;;###autoload
(defun magit-stash-index (message)
"Create a stash of the index only.
Unstaged and untracked changes are not stashed. The stashed
changes are applied in reverse to both the index and the
worktree. This command can fail when the worktree is not clean.
Applying the resulting stash has the inverse effect."
(interactive (list (magit-stash-read-message)))
(magit-stash-save message t nil nil t 'worktree))
;;;###autoload
(defun magit-stash-worktree (message &optional include-untracked)
"Create a stash of the working tree only.
Untracked files are included according to popup arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-stash-read-args))
(magit-stash-save message nil t include-untracked t 'index))
;;;###autoload
(defun magit-stash-keep-index (message &optional include-untracked)
"Create a stash of the index and working tree, keeping index intact.
Untracked files are included according to popup arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-stash-read-args))
(magit-stash-save message t t include-untracked t 'index))
(defun magit-stash-read-args ()
(list (magit-stash-read-message)
(magit-stash-read-untracked)))
(defun magit-stash-read-untracked ()
(let ((prefix (prefix-numeric-value current-prefix-arg))
(args (magit-stash-arguments)))
(cond ((or (= prefix 16) (member "--all" args)) 'all)
((or (= prefix 4) (member "--include-untracked" args)) t))))
(defun magit-stash-read-message ()
(let* ((default (format "On %s: "
(or (magit-get-current-branch) "(no branch)")))
(input (magit-read-string "Stash message" default)))
(if (equal input default)
(concat default (magit-rev-format "%h %s"))
input)))
;;;###autoload
(defun magit-snapshot (&optional include-untracked)
"Create a snapshot of the index and working tree.
Untracked files are included according to popup arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-snapshot-read-args))
(magit-snapshot-save t t include-untracked t))
;;;###autoload
(defun magit-snapshot-index ()
"Create a snapshot of the index only.
Unstaged and untracked changes are not stashed."
(interactive)
(magit-snapshot-save t nil nil t))
;;;###autoload
(defun magit-snapshot-worktree (&optional include-untracked)
"Create a snapshot of the working tree only.
Untracked files are included according to popup arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-snapshot-read-args))
(magit-snapshot-save nil t include-untracked t))
(defun magit-snapshot-read-args ()
(list (magit-stash-read-untracked)))
(defun magit-snapshot-save (index worktree untracked &optional refresh)
(magit-stash-save (concat "WIP on " (magit-stash-summary))
index worktree untracked refresh t))
;;;###autoload
(defun magit-stash-apply (stash)
"Apply a stash to the working tree.
Try to preserve the stash index. If that fails because there
are staged changes, apply without preserving the stash index."
(interactive (list (magit-read-stash "Apply stash" t)))
(if (= (magit-call-git "stash" "apply" "--index" stash) 0)
(magit-refresh)
(magit-run-git "stash" "apply" stash)))
(defun magit-stash-pop (stash)
"Apply a stash to the working tree and remove it from stash list.
Try to preserve the stash index. If that fails because there
are staged changes, apply without preserving the stash index
and forgo removing the stash."
(interactive (list (magit-read-stash "Apply pop" t)))
(if (= (magit-call-git "stash" "apply" "--index" stash) 0)
(magit-stash-drop stash)
(magit-run-git "stash" "apply" stash)))
;;;###autoload
(defun magit-stash-drop (stash)
"Remove a stash from the stash list.
When the region is active offer to drop all contained stashes."
(interactive (list (--if-let (magit-region-values 'stash)
(magit-confirm t nil "Drop %i stashes" it)
(magit-read-stash "Drop stash"))))
(dolist (stash (if (listp stash)
(nreverse (prog1 stash (setq stash (car stash))))
(list stash)))
(message "Deleted refs/%s (was %s)" stash
(magit-rev-parse "--short" stash))
(magit-call-git "reflog" "delete" "--updateref" "--rewrite" stash))
(-when-let (ref (and (string-match "\\(.+\\)@{[0-9]+}$" stash)
(match-string 1 stash)))
(unless (string-match "^refs/" ref)
(setq ref (concat "refs/" ref)))
(unless (magit-rev-verify (concat ref "@{0}"))
(magit-run-git "update-ref" "-d" ref)))
(magit-refresh))
;;;###autoload
(defun magit-stash-clear (ref)
"Remove all stashes saved in REF's reflog by deleting REF."
(interactive
(let ((ref (or (magit-section-when 'stashes) "refs/stash")))
(if (magit-confirm t (format "Drop all stashes in %s" ref))
(list ref)
(user-error "Abort"))))
(magit-run-git "update-ref" "-d" ref))
;;;###autoload
(defun magit-stash-branch (stash branch)
"Create and checkout a new BRANCH from STASH."
(interactive (list (magit-read-stash "Branch stash" t)
(magit-read-string-ns "Branch name")))
(magit-run-git "stash" "branch" branch stash))
;;;###autoload
(defun magit-stash-format-patch (stash)
"Create a patch from STASH"
(interactive (list (magit-read-stash "Create patch from stash" t)))
(with-temp-file (magit-rev-format "0001-%f.patch" stash)
(magit-git-insert "stash" "show" "-p" stash))
(magit-refresh))
;;; Plumbing
(defun magit-stash-save (message index worktree untracked
&optional refresh keep noerror ref)
(if (or (and index (magit-staged-files t))
(and worktree (magit-modified-files t))
(and untracked (magit-untracked-files (eq untracked 'all))))
(magit-with-toplevel
(magit-stash-store message (or ref "refs/stash")
(magit-stash-create message index worktree untracked))
(if (eq keep 'worktree)
(with-temp-buffer
(magit-git-insert "diff" "--cached")
(magit-run-git-with-input
"apply" "--reverse" "--cached" "--ignore-space-change" "-")
(magit-run-git-with-input
"apply" "--reverse" "--ignore-space-change" "-"))
(unless (eq keep t)
(if (eq keep 'index)
(magit-call-git "checkout" "--" ".")
(magit-call-git "reset" "--hard" "HEAD"))
(when untracked
(magit-call-git "clean" "-f" (and (eq untracked 'all) "-x")))))
(when refresh
(magit-refresh)))
(unless noerror
(user-error "No %s changes to save" (cond ((not index) "unstaged")
((not worktree) "staged")
(t "local"))))))
(defun magit-stash-store (message ref commit)
(magit-update-ref ref message commit t))
(defun magit-stash-create (message index worktree untracked)
(unless (magit-rev-parse "--verify" "HEAD")
(error "You do not have the initial commit yet"))
(let ((magit-git-global-arguments (nconc (list "-c" "commit.gpgsign=false")
magit-git-global-arguments))
(default-directory (magit-toplevel))
(summary (magit-stash-summary))
(head "HEAD"))
(when (and worktree (not index))
(setq head (magit-commit-tree "pre-stash index" nil "HEAD")))
(or (setq index (magit-commit-tree (concat "index on " summary) nil head))
(error "Cannot save the current index state"))
(and untracked
(setq untracked (magit-untracked-files (eq untracked 'all)))
(setq untracked (magit-with-temp-index nil nil
(or (and (magit-update-files untracked)
(magit-commit-tree
(concat "untracked files on " summary)))
(error "Cannot save the untracked files")))))
(magit-with-temp-index index "-m"
(when worktree
(or (magit-update-files (magit-git-items "diff" "-z" "--name-only" head))
(error "Cannot save the current worktree state")))
(or (magit-commit-tree message nil head index untracked)
(error "Cannot save the current worktree state")))))
(defun magit-stash-summary ()
(concat (or (magit-get-current-branch) "(no branch)")
": " (magit-rev-format "%h %s")))
;;; Sections
(defvar magit-stashes-section-map
(let ((map (make-sparse-keymap)))
(define-key map [remap magit-delete-thing] 'magit-stash-clear)
map)
"Keymap for `stashes' section.")
(defvar magit-stash-section-map
(let ((map (make-sparse-keymap)))
(define-key map [remap magit-visit-thing] 'magit-stash-show)
(define-key map [remap magit-delete-thing] 'magit-stash-drop)
(define-key map "a" 'magit-stash-apply)
(define-key map "A" 'magit-stash-pop)
map)
"Keymap for `stash' sections.")
(magit-define-section-jumper magit-jump-to-stashes
"Stashes" stashes "refs/stash")
(cl-defun magit-insert-stashes (&optional (ref "refs/stash")
(heading "Stashes:"))
"Insert `stashes' section showing reflog for \"refs/stash\".
If optional REF is non-nil show reflog for that instead.
If optional HEADING is non-nil use that as section heading
instead of \"Stashes:\"."
(when (magit-rev-verify ref)
(magit-insert-section (stashes ref (not magit-status-expand-stashes))
(magit-insert-heading heading)
(magit-git-wash (apply-partially 'magit-log-wash-log 'stash)
"reflog" "--format=%gd %at %gs" ref))))
;;; List Stashes
;;;###autoload
(defun magit-stash-list ()
"List all stashes in a buffer."
(interactive)
(magit-mode-setup #'magit-stashes-mode "refs/stash"))
(define-derived-mode magit-stashes-mode magit-reflog-mode "Magit Stashes"
"Mode for looking at lists of stashes."
:group 'magit-log
(hack-dir-local-variables-non-file-buffer))
(cl-defun magit-stashes-refresh-buffer (ref)
(magit-insert-section (stashesbuf)
(magit-insert-heading (if (equal ref "refs/stash")
"Stashes:"
(format "Stashes [%s]:" ref)))
(magit-git-wash (apply-partially 'magit-log-wash-log 'stash)
"reflog" "--format=%gd %at %gs" ref)))
;;; Show Stash
(defcustom magit-stash-sections-hook
'(magit-insert-stash-worktree
magit-insert-stash-index
magit-insert-stash-untracked)
"Hook run to insert sections into stash buffers."
:package-version '(magit . "2.1.0")
:group 'magit-log
:type 'hook)
;;;###autoload
(defun magit-stash-show (stash &optional args files)
"Show all diffs of a stash in a buffer."
(interactive (cons (or (and (not current-prefix-arg)
(magit-stash-at-point))
(magit-read-stash "Show stash"))
(-let [(args files) (magit-diff-arguments)]
(list (delete "--stat" args) files))))
(magit-mode-setup #'magit-stash-mode stash nil args files))
(define-derived-mode magit-stash-mode magit-diff-mode "Magit Stash"
"Mode for looking at individual stashes."
:group 'magit-diff
(hack-dir-local-variables-non-file-buffer))
(defun magit-stash-refresh-buffer (stash _const _args _files)
(setq header-line-format
(concat
"\s" (propertize (capitalize stash) 'face 'magit-section-heading)
"\s" (magit-rev-format "%s" stash)))
(magit-insert-section (stash)
(run-hooks 'magit-stash-sections-hook)))
(defun magit-stash-insert-section (commit range message &optional files)
(magit-insert-section (commit commit)
(magit-insert-heading message)
(magit-git-wash #'magit-diff-wash-diffs
"diff" range "-p" "--no-prefix"
(nth 2 magit-refresh-args)
"--" (or files (nth 3 magit-refresh-args)))))
(defun magit-insert-stash-index ()
"Insert section showing the index commit of the stash."
(let ((stash (car magit-refresh-args)))
(magit-stash-insert-section (format "%s^2" stash)
(format "%s^..%s^2" stash stash)
"Index")))
(defun magit-insert-stash-worktree ()
"Insert section showing the worktree commit of the stash."
(let ((stash (car magit-refresh-args)))
(magit-stash-insert-section stash
(format "%s^2..%s" stash stash)
"Working tree")))
(defun magit-insert-stash-untracked ()
"Insert section showing the untracked files commit of the stash."
(let ((stash (car magit-refresh-args))
(rev (concat (car magit-refresh-args) "^3")))
(when (magit-rev-verify rev)
(magit-stash-insert-section (format "%s^3" stash)
(format "%s^..%s^3" stash stash)
"Untracked files"
(magit-git-items "ls-tree" "-z" "--name-only"
"--full-tree" rev)))))
;;; magit-stash.el ends soon
(provide 'magit-stash)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-stash.el ends here

View File

@ -0,0 +1,174 @@
;;; magit-submodule.el --- submodule support for Magit -*- lexical-binding: t -*-
;; Copyright (C) 2011-2015 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 'magit)
;;; Commands
;;;###autoload (autoload 'magit-submodule-popup "magit-submodule" nil t)
(magit-define-popup magit-submodule-popup
"Popup console for submodule commands."
'magit-commands nil nil
:man-page "git-submodule"
:actions '((?a "Add" magit-submodule-add)
(?b "Setup" magit-submodule-setup)
(?i "Init" magit-submodule-init)
(?u "Update" magit-submodule-update)
(?s "Sync" magit-submodule-sync)
(?f "Fetch" magit-submodule-fetch)
(?d "Deinit" magit-submodule-deinit)))
;;;###autoload
(defun magit-submodule-add (url &optional path)
"Add the repository at URL as a submodule.
Optional PATH is the path to the submodule relative to the root
of the superproject. If it is nil then the path is determined
based on URL."
(interactive
(magit-with-toplevel
(let ((path (read-file-name
"Add submodule: " nil nil nil
(magit-section-when [file untracked]
(directory-file-name (magit-section-value it))))))
(when path
(setq path (file-name-as-directory (expand-file-name path)))
(when (member path (list "" default-directory))
(setq path nil)))
(list (magit-read-string-ns
"Remote url"
(and path (magit-git-repo-p path t)
(let ((default-directory path))
(magit-get "remote" (or (magit-get-remote) "origin")
"url"))))
(and path (directory-file-name (file-relative-name path)))))))
(magit-run-git "submodule" "add" url path))
;;;###autoload
(defun magit-submodule-setup ()
"Clone and register missing submodules and checkout appropriate commits."
(interactive)
(magit-submodule-update t))
;;;###autoload
(defun magit-submodule-init ()
"Register submodules listed in \".gitmodules\" into \".git/config\"."
(interactive)
(magit-with-toplevel
(magit-run-git-async "submodule" "init")))
;;;###autoload
(defun magit-submodule-update (&optional init)
"Clone missing submodules and checkout appropriate commits.
With a prefix argument also register submodules in \".git/config\"."
(interactive "P")
(magit-with-toplevel
(magit-run-git-async "submodule" "update" (and init "--init"))))
;;;###autoload
(defun magit-submodule-sync ()
"Update each submodule's remote URL according to \".gitmodules\"."
(interactive)
(magit-with-toplevel
(magit-run-git-async "submodule" "sync")))
;;;###autoload
(defun magit-submodule-fetch (&optional all)
"Fetch all submodules.
With a prefix argument fetch all remotes."
(interactive "P")
(magit-with-toplevel
(magit-run-git-async "submodule" "foreach"
(format "git fetch %s || true" (if all "--all" "")))))
;;;###autoload
(defun magit-submodule-deinit (path)
"Unregister the submodule at PATH."
(interactive
(list (magit-completing-read "Deinit module" (magit-get-submodules)
nil t nil nil (magit-section-when module))))
(magit-with-toplevel
(magit-run-git-async "submodule" "deinit" path)))
;;; Sections
;;;###autoload
(defun magit-insert-submodule-commits (section range)
"For internal use, don't add to a hook."
(if (magit-section-hidden section)
(setf (magit-section-washer section)
(apply-partially #'magit-insert-submodule-commits section range))
(magit-git-wash (apply-partially 'magit-log-wash-log 'module)
"log" "--oneline" range)
(when (> (point) (magit-section-content section))
(delete-char -1))))
;;;###autoload
(defun magit-insert-unpulled-module-commits ()
"Insert sections for all submodules with unpulled commits.
These sections can be expanded to show the respective commits."
(-when-let (modules (magit-get-submodules))
(magit-insert-section section (unpulled-modules)
(magit-insert-heading "Unpulled modules:")
(magit-with-toplevel
(dolist (module modules)
(let ((default-directory
(expand-file-name (file-name-as-directory module))))
(-when-let (tracked (magit-get-upstream-ref))
(magit-insert-section sec (file module t)
(magit-insert-heading
(concat (propertize module 'face 'magit-diff-file-heading) ":"))
(magit-insert-submodule-commits
section (concat "HEAD.." tracked)))))))
(if (> (point) (magit-section-content section))
(insert ?\n)
(magit-cancel-section)))))
;;;###autoload
(defun magit-insert-unpushed-module-commits ()
"Insert sections for all submodules with unpushed commits.
These sections can be expanded to show the respective commits."
(-when-let (modules (magit-get-submodules))
(magit-insert-section section (unpushed-modules)
(magit-insert-heading "Unpushed modules:")
(magit-with-toplevel
(dolist (module modules)
(let ((default-directory
(expand-file-name (file-name-as-directory module))))
(-when-let (tracked (magit-get-upstream-ref))
(magit-insert-section sec (file module t)
(magit-insert-heading
(concat (propertize module 'face 'magit-diff-file-heading) ":"))
(magit-insert-submodule-commits
section (concat tracked "..HEAD")))))))
(if (> (point) (magit-section-content section))
(insert ?\n)
(magit-cancel-section)))))
;;; magit-submodule.el ends soon
(provide 'magit-submodule)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-submodule.el ends here

View File

@ -0,0 +1,414 @@
;;; magit-utils.el --- various utilities -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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>
;; Contains code from GNU Emacs https://www.gnu.org/software/emacs,
;; released under the GNU General Public License version 3 or later.
;; 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 several utility functions used by several
;; other libraries which cannot depend on one another (because
;; circular dependencies are not good). Luckily most (all) of these
;; functions have very little (nothing) to do with Git, so we not only
;; have to do this, it even makes sense.
;; Unfortunately there are also some options which are used by several
;; libraries which cannot depend on one another, they are defined here
;; too.
;;; Code:
(require 'cl-lib)
(require 'dash)
(eval-when-compile (require 'ido))
(declare-function ido-completing-read+ 'ido-completing-read+)
(defvar magit-wip-before-change-mode)
;;; Options
(defcustom magit-completing-read-function 'magit-builtin-completing-read
"Function to be called when requesting input from the user.
For Helm users, the simplest way to get Helm completion is to
turn on `helm-mode' and leave this option set to the default
value. However, if you prefer to not use `helm-mode' but still
want Magit to use Helm for completion, you can set this option to
`helm--completing-read-default'."
:group 'magit
:type '(radio (function-item magit-builtin-completing-read)
(function-item magit-ido-completing-read)
(function-item helm--completing-read-default)
(function :tag "Other")))
(defcustom magit-no-confirm nil
"A list of symbols for actions Magit should not confirm, or t.
Many potentially dangerous commands by default ask the user for
confirmation. Each of the below symbols stands for an action
which, when invoked unintentionally or without being fully aware
of the consequences, could lead to tears. In many cases there
are several commands that perform variations of a certain action,
so we don't use the command names but more generic symbols.
Applying changes:
`discard' Discarding one or more changes (i.e. hunks or the
complete diff for a file) loses that change, obviously.
`reverse' Reverting one or more changes can usually be undone
by reverting the reversion.
`stage-all-changes', `unstage-all-changes' When there are both
staged and unstaged changes, then un-/staging everything would
destroy that distinction. Of course that also applies when
un-/staging a single change, but then less is lost and one does
that so often that having to confirm every time would be
unacceptable.
Files:
`delete' When a file that isn't yet tracked by Git is deleted
then it is completely lost, not just the last changes. Very
dangerous.
`trash' Instead of deleting a file it can also be move to the
system trash. Obviously much less dangerous than deleting it.
Also see option `magit-delete-by-moving-to-trash'.
`resurrect' A deleted file can easily be resurrected by
\"deleting\" the deletion, which is done using the same command
that was used to delete the same file in the first place.
`rename' Renaming a file can easily be undone.
Sequences:
`reset-bisect' Aborting (known to Git as \"resetting\") a
bisect operation loses all information collected so far.
`abort-merge' Aborting a merge throws away all conflict
resolutions which has already been carried out by the user.
`merge-dirty' Merging with a dirty worktree can make it hard to
go back to the state before the merge was initiated.
References:
`delete-unmerged-branch' Once a branch has been deleted it can
only be restored using low-level recovery tools provided by
Git. And even then the reflog is gone. The user always has
to confirm the deletion of a branch by accepting the default
choice (or selecting another branch), but when a branch has
not been merged yet, also make sure the user is aware of that.
`drop-stashes' Dropping a stash is dangerous because Git stores
stashes in the reflog. Once a stash is removed, there is no
going back without using low-level recovery tools provided by
Git. When a single stash is dropped, then the user always has
to confirm by accepting the default (or selecting another).
This action only concerns the deletion of multiple stashes at
once.
Various:
`kill-process' There seldom is a reason to kill a process.
Global settings:
Instead of adding all of the above symbols to the value of this
option you can also set it to the atom `t', which has the same
effect as adding all of the above symbols. Doing that most
certainly is a bad idea, especially because other symbols might
be added in the future. So even if you don't want to be asked
for confirmation for any of these actions, you are still better
of adding all of the respective symbols individually.
When `magit-wip-before-change-mode' is enabled then these actions
can fairly easily be undone: `discard', `reverse',
`stage-all-changes', and `unstage-all-changes'. If and only if
this mode is enabled then `safe-with-wip' has the same effect
as adding all of these symbols individually."
:package-version '(magit . "2.1.0")
:group 'magit
:type '(choice (const :tag "No confirmation needed" t)
(set (const reverse) (const discard)
(const rename) (const resurrect)
(const trash) (const delete)
(const abort-merge) (const merge-dirty)
(const drop-stashes) (const resect-bisect)
(const kill-process) (const delete-unmerged-branch)
(const stage-all-changes) (const unstage-all-changes)
(const safe-with-wip))))
(defcustom magit-ellipsis ?…
"Character used to abbreviate text."
:package-version '(magit . "2.1.0")
:group 'magit-modes
:type 'character)
(defcustom magit-update-other-window-delay 0.2
"Delay before automatically updating the other window.
When moving around in certain buffers certain other buffers,
which are being displayed in another window, may optionally be
updated to display information about the section at point.
When holding down a key to move by more than just one section,
then that would update that buffer for each section on the way.
To prevent that, updating the revision buffer is delayed, and
this option controls for how long. For optimal experience you
might have to adjust this delay and/or the keyboard repeat rate
and delay of your graphical environment or operating system."
:package-version '(magit . "2.3.0")
:group 'magit-modes
:type 'number)
;;; User Input
(defun magit-completing-read
(prompt collection &optional predicate require-match initial-input hist def)
"Magit wrapper around `completing-read' or an alternative function.
Option `magit-completing-read-function' can be used to wrap
around another `completing-read'-like function. Unless it
doesn't have the exact same signature, an additional wrapper is
required. Even if it has the same signature it might be a good
idea to wrap it, so that `magit-prompt-with-default' can be used.
See `completing-read' for the meanings of the arguments, but note
that this wrapper makes the following changes:
- If REQUIRE-MATCH is nil and the user exits without a choice,
then return nil instead of an empty string.
- If REQUIRE-MATCH is non-nil and the users exits without a
choice, then raise an user-error.
- \": \" is appended to PROMPT.
- If a `magit-completing-read-function' is used which in turn
uses `magit-prompt-with-completion' and DEF is non-nil, then
PROMPT is modified to end with \" (default DEF): \".
The use of another completing function and/or wrapper obviously
results in additional differences."
(let ((reply (funcall magit-completing-read-function
(concat prompt ": ") collection predicate
require-match initial-input hist def)))
(if (string= reply "")
(if require-match
(user-error "Nothing selected")
nil)
reply)))
(defun magit-builtin-completing-read
(prompt choices &optional predicate require-match initial-input hist def)
"Magit wrapper for standard `completing-read' function."
(completing-read (magit-prompt-with-default prompt def)
choices predicate require-match
initial-input hist def))
(defun magit-ido-completing-read
(prompt choices &optional predicate require-match initial-input hist def)
"Ido-based `completing-read' almost-replacement.
Unfortunately `ido-completing-read' is not suitable as a
drop-in replacement for `completing-read', instead we use
`ido-completing-read+' from the third-party package by the
same name."
(if (require 'ido-completing-read+ nil t)
(ido-completing-read+ prompt choices predicate require-match
initial-input hist def)
(display-warning 'magit "ido-completing-read+ is not installed
To use Ido completion with Magit you need to install the
third-party `ido-completing-read+' packages. Falling
back to built-in `completing-read' for now." :error)
(magit-builtin-completing-read prompt choices predicate require-match
initial-input hist def)))
(defun magit-prompt-with-default (prompt def)
(if (and def (> (length prompt) 2)
(string-equal ": " (substring prompt -2)))
(format "%s (default %s): " (substring prompt 0 -2) def)
prompt))
(defvar magit-minibuffer-local-ns-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\s" 'magit-whitespace-disallowed)
(define-key map "\t" 'magit-whitespace-disallowed)
map))
(defun magit-whitespace-disallowed ()
"Beep to tell the user that whitespace is not allowed."
(interactive)
(ding)
(message "Whitespace isn't allowed here")
(setq defining-kbd-macro nil)
(force-mode-line-update))
(defun magit-read-string (prompt &optional initial-input history default-value
inherit-input-method no-whitespace)
"Read a string from the minibuffer, prompting with string PROMPT.
This is similar to `read-string', but
* empty input is only allowed if DEFAULT-VALUE is non-nil in
which case that is returned,
* whitespace is not allowed if NO-WHITESPACE is non-nil,
* \": \" is appended to PROMPT, and
* an invalid DEFAULT-VALUE is silently ignored."
(when default-value
(when (consp default-value)
(setq default-value (car default-value)))
(unless (stringp default-value)
(setq default-value nil)))
(let* ((minibuffer-completion-table nil)
(val (read-from-minibuffer
(magit-prompt-with-default (concat prompt ": ") default-value)
initial-input (and no-whitespace magit-minibuffer-local-ns-map)
nil history default-value inherit-input-method)))
(when (and (string= val "") default-value)
(setq val default-value))
(cond ((string= val "")
(user-error "Need non-empty input"))
((and no-whitespace (string-match-p "[\s\t\n]" val))
(user-error "Input contains whitespace"))
(t val))))
(defun magit-read-string-ns (prompt &optional initial-input history
default-value inherit-input-method)
"Call `magit-read-string' with non-nil NO-WHITESPACE."
(magit-read-string prompt initial-input history default-value
inherit-input-method t))
(defmacro magit-read-char-case (prompt verbose &rest clauses)
(declare (indent 2)
(debug (form form &rest (characterp form body))))
`(pcase (read-char-choice
(concat ,prompt
,(concat (mapconcat 'cadr clauses ", ")
(and verbose ", or [C-g] to abort") " "))
',(mapcar 'car clauses))
,@(--map `(,(car it) ,@(cddr it)) clauses)))
(cl-defun magit-confirm (action &optional prompt prompt-n (items nil sitems))
(declare (indent defun))
(setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items))
prompt (format (concat (or prompt (magit-confirm-make-prompt action))
"? ")
(car items)))
(cond ((and (not (eq action t))
(or (eq magit-no-confirm t)
(memq action
`(,@magit-no-confirm
,@(and magit-wip-before-change-mode
(memq 'safe-with-wip magit-no-confirm)
`(discard reverse
stage-all-changes
unstage-all-changes))))))
(or (not sitems) items))
((not sitems)
(y-or-n-p prompt))
((= (length items) 1)
(and (y-or-n-p prompt) items))
((> (length items) 1)
(let ((buffer (get-buffer-create " *Magit Confirm*")))
(with-current-buffer buffer
(with-current-buffer-window
buffer (cons 'display-buffer-below-selected
'((window-height . fit-window-to-buffer)))
(lambda (window _value)
(with-selected-window window
(unwind-protect (and (y-or-n-p prompt-n) items)
(when (window-live-p window)
(quit-restore-window window 'kill)))))
(dolist (item items)
(insert item "\n"))))))))
(defun magit-confirm-files (action files &optional prompt)
(when files
(unless prompt
(setq prompt (magit-confirm-make-prompt action)))
(magit-confirm action
(concat prompt " %s")
(concat prompt " %i files")
files)))
(defun magit-confirm-make-prompt (action)
(let ((prompt (symbol-name action)))
(replace-regexp-in-string
"-" " " (concat (upcase (substring prompt 0 1)) (substring prompt 1)))))
;;; Text Utilities
(defmacro magit-bind-match-strings (varlist string &rest body)
"Bind variables to submatches according to VARLIST then evaluate BODY.
Bind the symbols in VARLIST to submatches of the current match
data, starting with 1 and incrementing by 1 for each symbol. If
the last match was against a string then that has to be provided
as STRING."
(declare (indent 2) (debug (listp form body)))
(let ((s (cl-gensym "string"))
(i 0))
`(let ((,s ,string))
(let ,(save-match-data
(--map (list it (list 'match-string (cl-incf i) s)) varlist))
,@body))))
(defun magit-delete-line ()
"Delete the rest of the current line."
(delete-region (point) (1+ (line-end-position))))
(defun magit-delete-match (&optional num)
"Delete text matched by last search.
If optional NUM is specified only delete that subexpression."
(delete-region (match-beginning (or num 0))
(match-end (or num 0))))
(defun magit-file-line (file)
"Return the first line of FILE as a string."
(when (file-regular-p file)
(with-temp-buffer
(insert-file-contents file)
(buffer-substring-no-properties (point-min)
(line-end-position)))))
(defun magit-file-lines (file &optional keep-empty-lines)
"Return a list of strings containing one element per line in FILE.
Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines."
(when (file-regular-p file)
(with-temp-buffer
(insert-file-contents file)
(split-string (buffer-string) "\n" (not keep-empty-lines)))))
;;; magit-utils.el ends soon
(provide 'magit-utils)
;; Local Variables:
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
;;; magit-utils.el ends here

View File

@ -0,0 +1,288 @@
;;; magit-wip.el --- commit snapshots to work-in-progress refs -*- lexical-binding: t -*-
;; Copyright (C) 2010-2016 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 tree global modes which automatically commit
;; snapshots to branch specific work-in-progress refs before and after
;; making changes, and two commands which can be used to do so on
;; demand.
;;; Code:
(require 'magit-core)
(require 'magit-log)
;;; Options
(defgroup magit-wip nil
"Automatically commit to work-in-progress refs."
:group 'magit-extensions)
(defcustom magit-wip-after-save-local-mode-lighter " sWip"
"Lighter for Magit-Wip-After-Save-Local mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:type 'string)
(defcustom magit-wip-after-apply-mode-lighter " aWip"
"Lighter for Magit-Wip-After-Apply mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:type 'string)
(defcustom magit-wip-before-change-mode-lighter " cWip"
"Lighter for Magit-Wip-Before-Change mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:type 'string)
(defcustom magit-wip-namespace "refs/wip/"
"Namespace used for work-in-progress refs.
The wip refs are named \"<namespace/>index/<branchref>\"
and \"<namespace/>wtree/<branchref>\". When snapshots
are created while the `HEAD' is detached then \"HEAD\"
is used as `branch-ref'."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:type 'string)
;;; Modes
(define-minor-mode magit-wip-after-save-local-mode
"After saving, also commit to a worktree work-in-progress ref.
After saving the current file-visiting buffer this mode also
commits the changes to the worktree work-in-progress ref for
the current branch.
This mode should be enabled globally by turning on the globalized
variant `magit-wip-after-save-mode'."
:package-version '(magit . "2.1.0")
:lighter magit-wip-after-save-local-mode-lighter
(if magit-wip-after-save-local-mode
(if (and buffer-file-name (magit-inside-worktree-p))
(add-hook 'after-save-hook 'magit-wip-commit-buffer-file t t)
(setq magit-wip-after-save-local-mode nil)
(user-error "Need a worktree and a file"))
(remove-hook 'after-save-hook 'magit-wip-commit-buffer-file t)))
(defun magit-wip-after-save-local-mode-turn-on ()
(and buffer-file-name
(ignore-errors (magit-inside-worktree-p))
(magit-file-tracked-p buffer-file-name)
(magit-wip-after-save-local-mode)))
;;;###autoload
(define-globalized-minor-mode magit-wip-after-save-mode
magit-wip-after-save-local-mode magit-wip-after-save-local-mode-turn-on
:package-version '(magit . "2.1.0")
:group 'magit-wip)
(defun magit-wip-commit-buffer-file ()
"Commit visited file to a worktree work-in-progress ref.
Also see `magit-wip-after-save-mode' which calls this function
automatically whenever a buffer visiting a tracked file is saved."
(interactive)
(--when-let (magit-wip-get-ref)
(magit-with-toplevel
(let ((file (file-relative-name buffer-file-name)))
(magit-wip-commit-worktree
it (list file) (if (called-interactively-p 'any)
(format "wip-save %s after save" file)
(format "autosave %s after save" file)))))))
;;;###autoload
(define-minor-mode magit-wip-after-apply-mode
"Commit to work-in-progress refs.
After applying a change using any \"apply variant\"
command (apply, stage, unstage, discard, and reverse) commit the
affected files to the current wip refs. For each branch there
may be two wip refs; one contains snapshots of the files as found
in the worktree and the other contains snapshots of the entries
in the index."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:lighter magit-wip-after-change-mode-lighter
:global t)
(defun magit-wip-commit-after-apply (&optional files msg)
(when magit-wip-after-apply-mode
(magit-wip-commit files msg)))
;;;###autoload
(define-minor-mode magit-wip-before-change-mode
"Commit to work-in-progress refs before certain destructive changes.
Before invoking a revert command or an \"apply variant\"
command (apply, stage, unstage, discard, and reverse) commit the
affected tracked files to the current wip refs. For each branch
there may be two wip refs; one contains snapshots of the files
as found in the worktree and the other contains snapshots of the
entries in the index.
Only changes to files which could potentially be affected by the
command which is about to be called are committed."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:lighter magit-wip-before-change-mode-lighter
:global t)
(defun magit-wip-commit-before-change (&optional files msg)
(when magit-wip-before-change-mode
(magit-with-toplevel
(magit-wip-commit files msg))))
;;; Core
(defun magit-wip-commit (&optional files msg)
"Commit all tracked files to the work-in-progress refs.
Interactively, commit all changes to all tracked files using
a generic commit message. With a prefix-argument the commit
message is read in the minibuffer.
Non-interactively, only commit changes to FILES using MSG as
commit message."
(interactive (list nil (if current-prefix-arg
(magit-read-string "Wip commit message")
"wip-save tracked files")))
(--when-let (magit-wip-get-ref)
(magit-wip-commit-index it files msg)
(magit-wip-commit-worktree it files msg)))
(defun magit-wip-commit-index (ref files msg &optional cached-only)
(let* ((wipref (concat magit-wip-namespace "index/" ref))
(parent (magit-wip-get-parent ref wipref)))
(when (magit-git-failure "diff-index" "--quiet"
(and cached-only "--cached")
parent "--" files)
(magit-wip-update-wipref wipref (magit-git-string "write-tree")
parent files msg "index"))))
(defun magit-wip-commit-worktree (ref files msg)
(let* ((wipref (concat magit-wip-namespace "wtree/" ref))
(parent (magit-wip-get-parent ref wipref))
(tree (magit-with-temp-index parent "--reset"
(if files
(magit-call-git "add" "--" files)
(magit-with-toplevel
(magit-call-git "add" "-u" ".")))
(magit-git-string "write-tree"))))
(when (magit-git-failure "diff-tree" "--quiet" parent tree "--" files)
(magit-wip-update-wipref wipref tree parent files msg "worktree"))))
(defun magit-wip-update-wipref (wipref tree parent files msg start-msg)
(let ((len (length files)))
(unless (and msg (not (= (aref msg 0) ?\s)))
(setq msg (concat
(cond ((= len 0) "autosave tracked files")
((> len 1) (format "autosave %s files" len))
(t (concat "autosave "
(file-relative-name (car files)
(magit-toplevel)))))
msg)))
(unless (equal parent wipref)
(setq start-msg (concat "restart autosaving " start-msg))
(magit-update-ref wipref start-msg
(magit-git-string "commit-tree" "-p" parent
"-m" start-msg
(concat parent "^{tree}")))
(setq parent wipref))
(magit-update-ref wipref msg
(magit-git-string "commit-tree" tree
"-p" parent "-m" msg))))
(defun magit-wip-get-ref ()
(let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD")))
(when (magit-rev-verify ref)
ref)))
(defun magit-wip-get-parent (ref wipref)
(if (and (magit-rev-verify wipref)
(equal (magit-git-string "merge-base" wipref ref)
(magit-rev-verify ref)))
wipref
ref))
;;; Log
(defun magit-wip-log-current (branch args files count)
"Show log for the current branch and its wip refs.
With a negative prefix argument only show the worktree wip ref.
The absolute numeric value of the prefix argument controls how
many \"branches\" of each wip ref are shown."
(interactive
(nconc (list (or (magit-get-current-branch) "HEAD"))
(magit-log-arguments)
(list (prefix-numeric-value current-prefix-arg))))
(magit-wip-log branch args files count))
(defun magit-wip-log (branch args files count)
"Show log for a branch and its wip refs.
With a negative prefix argument only show the worktree wip ref.
The absolute numeric value of the prefix argument controls how
many \"branches\" of each wip ref are shown."
(interactive
(nconc (list (magit-completing-read
"Log branch and its wip refs"
(-snoc (magit-list-local-branch-names) "HEAD")
nil t nil 'magit-revision-history
(or (magit-branch-at-point)
(magit-get-current-branch)
"HEAD")))
(magit-log-arguments)
(list (prefix-numeric-value current-prefix-arg))))
(unless (equal branch "HEAD")
(setq branch (concat "refs/heads/" branch)))
(magit-log (nconc (list branch)
(magit-wip-log-get-tips
(concat magit-wip-namespace "wtree/" branch)
(abs count))
(and (>= count 0)
(magit-wip-log-get-tips
(concat magit-wip-namespace "index/" branch)
(abs count))))
args files))
(defun magit-wip-log-get-tips (wipref count)
(-when-let (reflog (magit-git-lines "reflog" wipref))
(let (tips)
(while (and reflog (> count 1))
(setq reflog (cl-member "^[^ ]+ [^:]+: restart autosaving"
reflog :test #'string-match-p))
(when (and (cadr reflog)
(string-match "^[^ ]+ \\([^:]+\\)" (cadr reflog)))
(push (match-string 1 (cadr reflog)) tips))
(setq reflog (cddr reflog))
(cl-decf count))
(cons wipref (nreverse tips)))))
;;; magit-wip.el ends soon
(provide 'magit-wip)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-wip.el ends here

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,164 @@
This is magit.info, produced by makeinfo version 5.2 from magit.texi.
Magit is an interface to the version control system Git, implemented as
an Emacs package. Magit aspires to be a complete Git porcelain. While
we cannot (yet) claim that Magit wraps and improves upon each and every
Git command, it is complete enough to allow even experienced Git users
to perform almost all of their daily version control tasks directly from
within Emacs. While many fine Git clients exist, only Magit and Git
itself deserve to be called porcelains.
Copyright (C) 2015-2016 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document 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 document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Magit: (magit). Using Git from Emacs with Magit.
END-INFO-DIR-ENTRY

Indirect:
magit.info-1: 1222
magit.info-2: 316256

Tag Table:
(Indirect)
Node: Top1222
Node: Introduction5928
Node: Installation10621
Node: Updating from an older release10996
Node: Installing from an Elpa archive12591
Node: Installing from the Git repository13930
Node: Post-installation tasks16726
Node: Getting started18115
Node: Interface concepts23850
Node: Modes and Buffers24124
Node: Switching Buffers25870
Node: Naming Buffers28934
Node: Quitting Windows31769
Node: Automatic Refreshing of Magit Buffers33401
Node: Automatic Saving of File-Visiting Buffers36169
Node: Automatic Reverting of File-Visiting Buffers37354
Node: Risk of Reverting Automatically42350
Node: Sections44733
Node: Section movement45674
Node: Section visibility49601
Node: Section hooks53192
Node: Section types and values55473
Node: Section options56743
Node: Popup buffers and prefix commands57215
Node: Completion and confirmation58529
Node: Running Git61435
Node: Viewing Git output61671
Node: Running Git manually62671
Node: Git executable64797
Node: Global Git arguments66804
Node: Inspecting67611
Node: Status buffer68738
Node: Status sections71261
Node: Status header sections76008
Node: Status options78567
Node: Logging79291
Node: Refreshing logs81820
Node: Log Buffer83205
Node: Select from log86294
Node: Reflog87234
Node: Diffing87712
Node: Refreshing diffs90524
Node: Diff buffer93505
Node: Diff options95407
Node: Revision buffer97039
Node: Ediffing97994
Node: References buffer101043
Node: References sections105753
Node: Bisecting106628
Node: Visiting blobs108124
Node: Blaming108633
Node: Manipulating111953
Node: Repository setup112245
Node: Staging and unstaging113285
Node: Staging from file-visiting buffers117180
Node: Applying118348
Node: Committing119991
Node: Initiating a commit120574
Node: Editing commit messages123886
Node: Branching134282
Node: Merging147096
Node: Rebasing149180
Node: Editing rebase sequences152128
Node: Rebase sequence log155162
Node: Cherry picking161906
Node: Reverting163512
Node: Resetting164875
Node: Stashing166385
Node: Transferring169530
Node: Remotes169768
Node: Fetching171054
Node: Pulling172148
Node: Pushing172994
Node: Creating and sending patches177443
Node: Applying patches178138
Node: Miscellaneous179136
Node: Tagging179427
Node: Notes180212
Node: Submodules182737
Node: Common commands184057
Node: Wip modes185805
Node: Minor mode for buffers visiting files192541
Node: Minor mode for buffers visiting blobs194684
Node: Customizing195489
Node: Per-repository configuration197161
Node: Essential settings198795
Node: Safety199119
Node: Performance200952
Node: Committing Performance207625
Node: Plumbing208606
Node: Calling Git209234
Node: Getting a value from Git210757
Node: Calling Git for effect213861
Node: Section plumbing220365
Node: Creating sections220593
Node: Section selection224396
Node: Matching sections226076
Node: Refreshing buffers231278
Node: Conventions234413
Node: Confirmation and completion234590
Node: Theming Faces235488
Node: FAQ243639
Node: Magit is slow244972
Node: I changed several thousand files at once and now Magit is unusable245173
Node: I am having problems committing245889
Node: I don't understand how branching and pushing work246347
Node: I don't like the key binding in v24246716
Node: I cannot install the pre-requisites for Magit v2247055
Node: I am using an Emacs release older than v244247520
Node: I am using a Git release older than v194249133
Node: I am using MS Windows and cannot push with Magit250120
Node: How to install the gitman info manual?250699
Node: How can I show Git's output?253227
Node: Expanding a file to show the diff causes it to disappear254039
Node: Point is wrong in the COMMIT_EDITMSG buffer254565
Node: Can Magit be used as ediff-version-control-package?255583
Node: How to show diffs for gpg-encrypted files?257607
Node: Emacs 245 hangs when loading Magit258198
Node: Symbol's value as function is void --some258767
Node: Where is the branch manager259087
Node: Keystroke Index259372
Node: Command Index286718
Node: Function Index316256
Node: Variable Index328039

End Tag Table

Local Variables:
coding: utf-8
End:

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -0,0 +1,16 @@
;;; magit-gerrit-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("magit-gerrit.el") (22221 60707 386755
;;;;;; 352000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; magit-gerrit-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "magit-gerrit" "20160128.1926" "Magit plugin for Gerrit Code Review" '((magit "2.3.1")) :url "https://github.com/terranpro/magit-gerrit")

View File

@ -0,0 +1,590 @@
;;; magit-gerrit.el --- Magit plugin for Gerrit Code Review
;;
;; Copyright (C) 2013 Brian Fransioli
;;
;; Author: Brian Fransioli <assem@terranpro.org>
;; URL: https://github.com/terranpro/magit-gerrit
;; Package-Version: 20160128.1926
;; Package-Requires: ((magit "2.3.1"))
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see http://www.gnu.org/licenses/.
;;; Commentary:
;;
;; Magit plugin to make Gerrit code review easy-to-use from emacs and
;; without the need for a browser!
;;
;; Currently uses the [deprecated] gerrit ssh interface, which has
;; meant that obtaining the list of reviewers is not possible, only
;; the list of approvals (those who have already verified and/or code
;; reviewed).
;;
;;; To Use:
;;
;; (require 'magit-gerrit)
;; (setq-default magit-gerrit-ssh-creds "myid@gerrithost.org")
;;
;;
;; M-x `magit-status'
;; h R <= magit-gerrit uses the R prefix, see help
;;
;;; Workflow:
;;
;; 1) *check out branch => changes => (ma)git commit*
;; 2) R P <= [ger*R*it *P*ush for review]
;; 3) R A <= [ger*R*it *A*dd reviewer] (by email address)
;; 4) *wait for verification/code reviews* [approvals shown in status]
;; 5) R S <= [ger*R*it *S*ubmit review]
;;
;;; Other Comments:
;; `magit-gerrit-ssh-creds' is buffer local, so if you work with
;; multiple Gerrit's, you can make this a file or directory local
;; variable for one particular project.
;;
;; If your git remote for gerrit is not the default "origin", then
;; `magit-gerrit-remote' should be adjusted accordingly (e.g. "gerrit")
;;
;; Recommended to auto add reviewers via git hooks (precommit), rather
;; than manually performing 'R A' for every review.
;;
;; `magit-gerrit' will be enabled automatically on `magit-status' if
;; the git remote repo uses the same creds found in
;; `magit-gerrit-ssh-creds'.
;;
;; Ex: magit-gerrit-ssh-creds == br.fransioli@gerrit.org
;; $ cd ~/elisp; git remote -v => https://github.com/terranpro/magit-gerrit.git
;; ^~~ `magit-gerrit-mode' would *NOT* be enabled here
;;
;; $ cd ~/gerrit/prja; git remote -v => ssh://br.fransioli@gerrit.org/.../prja
;; ^~~ `magit-gerrit-mode' *WOULD* be enabled here
;;
;;; Code:
(require 'magit)
(if (locate-library "magit-popup")
(require 'magit-popup))
(require 'json)
(eval-when-compile
(require 'cl-lib))
;; Define a defvar-local macro for Emacs < 24.3
(unless (fboundp 'defvar-local)
(defmacro defvar-local (var val &optional docstring)
`(progn
(defvar ,var ,val ,docstring)
(make-variable-buffer-local ',var))))
(defvar-local magit-gerrit-ssh-creds nil
"Credentials used to execute gerrit commands via ssh of the form ID@Server")
(defvar-local magit-gerrit-remote "origin"
"Default remote name to use for gerrit (e.g. \"origin\", \"gerrit\")")
(defcustom magit-gerrit-popup-prefix (kbd "R")
"Key code to open magit-gerrit popup"
:group 'magit-gerrit
:type 'key-sequence)
(defun gerrit-command (cmd &rest args)
(let ((gcmd (concat
"-x -p 29418 "
(or magit-gerrit-ssh-creds
(error "`magit-gerrit-ssh-creds' must be set!"))
" "
"gerrit "
cmd
" "
(mapconcat 'identity args " "))))
;; (message (format "Using cmd: %s" gcmd))
gcmd))
(defun gerrit-query (prj &optional status)
(gerrit-command "query"
"--format=JSON"
"--all-approvals"
"--comments"
"--current-patch-set"
(concat "project:" prj)
(concat "status:" (or status "open"))))
(defun gerrit-review ())
(defun gerrit-ssh-cmd (cmd &rest args)
(apply #'call-process
"ssh" nil nil nil
(split-string (apply #'gerrit-command cmd args))))
(defun gerrit-review-abandon (prj rev)
(gerrit-ssh-cmd "review" "--project" prj "--abandon" rev))
(defun gerrit-review-submit (prj rev &optional msg)
(gerrit-ssh-cmd "review" "--project" prj "--submit"
(if msg msg "") rev))
(defun gerrit-code-review (prj rev score &optional msg)
(gerrit-ssh-cmd "review" "--project" prj "--code-review" score
(if msg msg "") rev))
(defun gerrit-review-verify (prj rev score &optional msg)
(gerrit-ssh-cmd "review" "--project" prj "--verified" score
(if msg msg "") rev))
(defun magit-gerrit-get-remote-url ()
(magit-git-string "ls-remote" "--get-url" magit-gerrit-remote))
(defun magit-gerrit-get-project ()
(let* ((regx (rx (zero-or-one ?:) (zero-or-more (any digit)) ?/
(group (not (any "/")))
(group (one-or-more (not (any "."))))))
(str (or (magit-gerrit-get-remote-url) ""))
(sstr (car (last (split-string str "//")))))
(when (string-match regx sstr)
(concat (match-string 1 sstr)
(match-string 2 sstr)))))
(defun magit-gerrit-string-trunc (str maxlen)
(if (> (length str) maxlen)
(concat (substring str 0 maxlen)
"...")
str))
(defun magit-gerrit-create-branch-force (branch parent)
"Switch 'HEAD' to new BRANCH at revision PARENT and update working tree.
Fails if working tree or staging area contain uncommitted changes.
Succeed even if branch already exist
\('git checkout -B BRANCH REVISION')."
(cond ((run-hook-with-args-until-success
'magit-create-branch-hook branch parent))
((and branch (not (string= branch "")))
(magit-save-repository-buffers)
(magit-run-git "checkout" "-B" branch parent))))
(defun magit-gerrit-pretty-print-reviewer (name email crdone vrdone)
(let* ((wid (1- (window-width)))
(crstr (propertize (if crdone (format "%+2d" (string-to-number crdone)) " ")
'face '(magit-diff-lines-heading
bold)))
(vrstr (propertize (if vrdone (format "%+2d" (string-to-number vrdone)) " ")
'face '(magit-diff-added-highlight
bold)))
(namestr (propertize (or name "") 'face 'magit-refname))
(emailstr (propertize (if email (concat "(" email ")") "")
'face 'change-log-name)))
(format "%-12s%s %s" (concat crstr " " vrstr) namestr emailstr)))
(defun magit-gerrit-pretty-print-review (num subj owner-name &optional draft)
;; window-width - two prevents long line arrow from being shown
(let* ((wid (- (window-width) 2))
(numstr (propertize (format "%-10s" num) 'face 'magit-hash))
(nlen (length numstr))
(authmaxlen (/ wid 4))
(author (propertize (magit-gerrit-string-trunc owner-name authmaxlen)
'face 'magit-log-author))
(subjmaxlen (- wid (length author) nlen 6))
(subjstr (propertize (magit-gerrit-string-trunc subj subjmaxlen)
'face
(if draft
'magit-signature-bad
'magit-signature-good)))
(authsubjpadding (make-string
(max 0 (- wid (+ nlen 1 (length author) (length subjstr))))
? )))
(format "%s%s%s%s\n"
numstr subjstr authsubjpadding author)))
(defun magit-gerrit-wash-approval (approval)
(let* ((approver (cdr-safe (assoc 'by approval)))
(approvname (cdr-safe (assoc 'name approver)))
(approvemail (cdr-safe (assoc 'email approver)))
(type (cdr-safe (assoc 'type approval)))
(verified (string= type "Verified"))
(codereview (string= type "Code-Review"))
(score (cdr-safe (assoc 'value approval))))
(magit-insert-section (section approval)
(insert (magit-gerrit-pretty-print-reviewer approvname approvemail
(and codereview score)
(and verified score))
"\n"))))
(defun magit-gerrit-wash-approvals (approvals)
(mapc #'magit-gerrit-wash-approval approvals))
(defun magit-gerrit-wash-review ()
(let* ((beg (point))
(jobj (json-read))
(end (point))
(num (cdr-safe (assoc 'number jobj)))
(subj (cdr-safe (assoc 'subject jobj)))
(owner (cdr-safe (assoc 'owner jobj)))
(owner-name (cdr-safe (assoc 'name owner)))
(owner-email (cdr-safe (assoc 'email owner)))
(patchsets (cdr-safe (assoc 'currentPatchSet jobj)))
;; compare w/t since when false the value is => :json-false
(isdraft (eq (cdr-safe (assoc 'isDraft patchsets)) t))
(approvs (cdr-safe (if (listp patchsets)
(assoc 'approvals patchsets)
(assoc 'approvals (aref patchsets 0))))))
(if (and beg end)
(delete-region beg end))
(when (and num subj owner-name)
(magit-insert-section (section subj)
(insert (propertize
(magit-gerrit-pretty-print-review num subj owner-name isdraft)
'magit-gerrit-jobj
jobj))
(unless (magit-section-hidden (magit-current-section))
(magit-gerrit-wash-approvals approvs))
(add-text-properties beg (point) (list 'magit-gerrit-jobj jobj)))
t)))
(defun magit-gerrit-wash-reviews (&rest args)
(magit-wash-sequence #'magit-gerrit-wash-review))
(defun magit-gerrit-section (section title washer &rest args)
(let ((magit-git-executable "ssh")
(magit-git-global-arguments nil))
(magit-insert-section (section title)
(magit-insert-heading title)
(magit-git-wash washer (split-string (car args)))
(insert "\n"))))
(defun magit-gerrit-remote-update (&optional remote)
nil)
(defun magit-gerrit-review-at-point ()
(get-text-property (point) 'magit-gerrit-jobj))
(defun magit-gerrit-view-patchset-diff ()
"View the Diff for a Patchset"
(interactive)
(let ((jobj (magit-gerrit-review-at-point)))
(when jobj
(let ((ref (cdr (assoc 'ref (assoc 'currentPatchSet jobj))))
(dir default-directory))
(let* ((magit-proc (magit-fetch magit-gerrit-remote ref)))
(message (format "Waiting a git fetch from %s to complete..."
magit-gerrit-remote))
(magit-process-wait))
(message (format "Generating Gerrit Patchset for refs %s dir %s" ref dir))
(magit-diff "FETCH_HEAD~1..FETCH_HEAD")))))
(defun magit-gerrit-download-patchset ()
"Download a Gerrit Review Patchset"
(interactive)
(let ((jobj (magit-gerrit-review-at-point)))
(when jobj
(let ((ref (cdr (assoc 'ref (assoc 'currentPatchSet jobj))))
(dir default-directory)
(branch (format "review/%s/%s"
(cdr (assoc 'username (assoc 'owner jobj)))
(cdr (or (assoc 'topic jobj) (assoc 'number jobj))))))
(let* ((magit-proc (magit-fetch magit-gerrit-remote ref)))
(message (format "Waiting a git fetch from %s to complete..."
magit-gerrit-remote))
(magit-process-wait))
(message (format "Checking out refs %s to %s in %s" ref branch dir))
(magit-gerrit-create-branch-force branch "FETCH_HEAD")))))
(defun magit-gerrit-browse-review ()
"Browse the Gerrit Review with a browser."
(interactive)
(let ((jobj (magit-gerrit-review-at-point)))
(if jobj
(browse-url (cdr (assoc 'url jobj))))))
(defun magit-gerrit-copy-review (with-commit-message)
"Copy review url and commit message."
(let ((jobj (magit-gerrit-review-at-point)))
(if jobj
(with-temp-buffer
(insert
(concat (cdr (assoc 'url jobj))
(if with-commit-message
(concat " " (car (split-string (cdr (assoc 'commitMessage jobj)) "\n" t))))))
(clipboard-kill-region (point-min) (point-max))))))
(defun magit-gerrit-copy-review-url ()
"Copy review url only"
(interactive)
(magit-gerrit-copy-review nil))
(defun magit-gerrit-copy-review-url-commit-message ()
"Copy review url with commit message"
(interactive)
(magit-gerrit-copy-review t))
(defun magit-insert-gerrit-reviews ()
(magit-gerrit-section 'gerrit-reviews
"Reviews:" 'magit-gerrit-wash-reviews
(gerrit-query (magit-gerrit-get-project))))
(defun magit-gerrit-add-reviewer ()
(interactive)
"ssh -x -p 29418 user@gerrit gerrit set-reviewers --project toplvlroot/prjname --add email@addr"
(gerrit-ssh-cmd "set-reviewers"
"--project" (magit-gerrit-get-project)
"--add" (read-string "Reviewer Name/Email: ")
(cdr-safe (assoc 'id (magit-gerrit-review-at-point)))))
(defun magit-gerrit-popup-args (&optional something)
(or (magit-gerrit-arguments) (list "")))
(defun magit-gerrit-verify-review (args)
"Verify a Gerrit Review"
(interactive (magit-gerrit-popup-args))
(let ((score (completing-read "Score: "
'("-2" "-1" "0" "+1" "+2")
nil t
"+1"))
(rev (cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point))))))
(prj (magit-gerrit-get-project)))
(gerrit-review-verify prj rev score args)
(magit-refresh)))
(defun magit-gerrit-code-review (args)
"Perform a Gerrit Code Review"
(interactive (magit-gerrit-popup-args))
(let ((score (completing-read "Score: "
'("-2" "-1" "0" "+1" "+2")
nil t
"+1"))
(rev (cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point))))))
(prj (magit-gerrit-get-project)))
(gerrit-code-review prj rev score args)
(magit-refresh)))
(defun magit-gerrit-submit-review (args)
"Submit a Gerrit Code Review"
;; "ssh -x -p 29418 user@gerrit gerrit review REVISION -- --project PRJ --submit "
(interactive (magit-gerrit-popup-args))
(gerrit-ssh-cmd "review"
(cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point)))))
"--project"
(magit-gerrit-get-project)
"--submit"
args)
(magit-fetch-from-upstream ""))
(defun magit-gerrit-push-review (status)
(let* ((branch (or (magit-get-current-branch)
(error "Don't push a detached head. That's gross")))
(commitid (or (when (eq (magit-section-type (magit-current-section))
'commit)
(magit-section-value (magit-current-section)))
(error "Couldn't find a commit at point")))
(rev (magit-rev-parse (or commitid
(error "Select a commit for review"))))
(branch-remote (and branch (magit-get "branch" branch "remote"))))
;; (message "Args: %s "
;; (concat rev ":" branch-pub))
(let* ((branch-merge (if (or (null branch-remote)
(string= branch-remote "."))
(completing-read
"Remote Branch: "
(let ((rbs (magit-list-remote-branch-names)))
(mapcar
#'(lambda (rb)
(and (string-match (rx bos
(one-or-more (not (any "/")))
"/"
(group (one-or-more any))
eos)
rb)
(concat "refs/heads/" (match-string 1 rb))))
rbs)))
(and branch (magit-get "branch" branch "merge"))))
(branch-pub (progn
(string-match (rx "refs/heads" (group (one-or-more any)))
branch-merge)
(format "refs/%s%s/%s" status (match-string 1 branch-merge) branch))))
(when (or (null branch-remote)
(string= branch-remote "."))
(setq branch-remote magit-gerrit-remote))
(magit-run-git-async "push" "-v" branch-remote
(concat rev ":" branch-pub)))))
(defun magit-gerrit-create-review ()
(interactive)
(magit-gerrit-push-review 'publish))
(defun magit-gerrit-create-draft ()
(interactive)
(magit-gerrit-push-review 'drafts))
(defun magit-gerrit-publish-draft ()
(interactive)
(let ((prj (magit-gerrit-get-project))
(id (cdr-safe (assoc 'id
(magit-gerrit-review-at-point))))
(rev (cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point)))))))
(gerrit-ssh-cmd "review" "--project" prj "--publish" rev))
(magit-refresh))
(defun magit-gerrit-delete-draft ()
(interactive)
(let ((prj (magit-gerrit-get-project))
(id (cdr-safe (assoc 'id
(magit-gerrit-review-at-point))))
(rev (cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point)))))))
(gerrit-ssh-cmd "review" "--project" prj "--delete" rev))
(magit-refresh))
(defun magit-gerrit-abandon-review ()
(interactive)
(let ((prj (magit-gerrit-get-project))
(id (cdr-safe (assoc 'id
(magit-gerrit-review-at-point))))
(rev (cdr-safe (assoc
'revision
(cdr-safe (assoc 'currentPatchSet
(magit-gerrit-review-at-point)))))))
;; (message "Prj: %s Rev: %s Id: %s" prj rev id)
(gerrit-review-abandon prj rev)
(magit-refresh)))
(defun magit-gerrit-read-comment (&rest args)
(format "\'\"%s\"\'"
(read-from-minibuffer "Message: ")))
(defun magit-gerrit-create-branch (branch parent))
(magit-define-popup magit-gerrit-popup
"Popup console for magit gerrit commands."
'magit-gerrit
:actions '((?P "Push Commit For Review" magit-gerrit-create-review)
(?W "Push Commit For Draft Review" magit-gerrit-create-draft)
(?p "Publish Draft Patchset" magit-gerrit-publish-draft)
(?k "Delete Draft" magit-gerrit-delete-draft)
(?A "Add Reviewer" magit-gerrit-add-reviewer)
(?V "Verify" magit-gerrit-verify-review)
(?C "Code Review" magit-gerrit-code-review)
(?d "View Patchset Diff" magit-gerrit-view-patchset-diff)
(?D "Download Patchset" magit-gerrit-download-patchset)
(?S "Submit Review" magit-gerrit-submit-review)
(?B "Abandon Review" magit-gerrit-abandon-review)
(?b "Browse Review" magit-gerrit-browse-review))
:options '((?m "Comment" "--message " magit-gerrit-read-comment)))
;; Attach Magit Gerrit to Magit's default help popup
(magit-define-popup-action 'magit-dispatch-popup ?R "Gerrit"
'magit-gerrit-popup)
(magit-define-popup magit-gerrit-copy-review-popup
"Popup console for copy review to clipboard."
'magit-gerrit
:actions '((?C "url and commit message" magit-gerrit-copy-review-url-commit-message)
(?c "url only" magit-gerrit-copy-review-url)))
(magit-define-popup-action 'magit-gerrit-popup ?c "Copy Review"
'magit-gerrit-copy-review-popup)
(defvar magit-gerrit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map magit-gerrit-popup-prefix 'magit-gerrit-popup)
map))
(define-minor-mode magit-gerrit-mode "Gerrit support for Magit"
:lighter " Gerrit" :require 'magit-topgit :keymap 'magit-gerrit-mode-map
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(or magit-gerrit-ssh-creds
(error "You *must* set `magit-gerrit-ssh-creds' to enable magit-gerrit-mode"))
(or (magit-gerrit-get-remote-url)
(error "You *must* set `magit-gerrit-remote' to a valid Gerrit remote"))
(cond
(magit-gerrit-mode
(magit-add-section-hook 'magit-status-sections-hook
'magit-insert-gerrit-reviews
'magit-insert-stashes t t)
(add-hook 'magit-create-branch-command-hook
'magit-gerrit-create-branch nil t)
;(add-hook 'magit-pull-command-hook 'magit-gerrit-pull nil t)
(add-hook 'magit-remote-update-command-hook
'magit-gerrit-remote-update nil t)
(add-hook 'magit-push-command-hook
'magit-gerrit-push nil t))
(t
(remove-hook 'magit-after-insert-stashes-hook
'magit-insert-gerrit-reviews t)
(remove-hook 'magit-create-branch-command-hook
'magit-gerrit-create-branch t)
;(remove-hook 'magit-pull-command-hook 'magit-gerrit-pull t)
(remove-hook 'magit-remote-update-command-hook
'magit-gerrit-remote-update t)
(remove-hook 'magit-push-command-hook
'magit-gerrit-push t)))
(when (called-interactively-p 'any)
(magit-refresh)))
(defun magit-gerrit-detect-ssh-creds (remote-url)
"Derive magit-gerrit-ssh-creds from remote-url.
Assumes remote-url is a gerrit repo if scheme is ssh
and port is the default gerrit ssh port."
(let ((url (url-generic-parse-url remote-url)))
(when (and (string= "ssh" (url-type url))
(eq 29418 (url-port url)))
(set (make-local-variable 'magit-gerrit-ssh-creds)
(format "%s@%s" (url-user url) (url-host url)))
(message "Detected magit-gerrit-ssh-creds=%s" magit-gerrit-ssh-creds))))
(defun magit-gerrit-check-enable ()
(let ((remote-url (magit-gerrit-get-remote-url)))
(when (and remote-url
(or magit-gerrit-ssh-creds
(magit-gerrit-detect-ssh-creds remote-url))
(string-match magit-gerrit-ssh-creds remote-url))
;; update keymap with prefix incase it has changed
(define-key magit-gerrit-mode-map magit-gerrit-popup-prefix 'magit-gerrit-popup)
(magit-gerrit-mode t))))
;; Hack in dir-local variables that might be set for magit gerrit
(add-hook 'magit-status-mode-hook #'hack-dir-local-variables-non-file-buffer t)
;; Try to auto enable magit-gerrit in the magit-status buffer
(add-hook 'magit-status-mode-hook #'magit-gerrit-check-enable t)
(add-hook 'magit-log-mode-hook #'magit-gerrit-check-enable t)
(provide 'magit-gerrit)
;;; magit-gerrit.el ends here

View File

@ -0,0 +1,27 @@
;;; magit-gh-pulls-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "magit-gh-pulls" "magit-gh-pulls.el" (22221
;;;;;; 60704 390000 0))
;;; Generated autoloads from magit-gh-pulls.el
(autoload 'magit-gh-pulls-mode "magit-gh-pulls" "\
Pull requests support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-gh-pulls "magit-gh-pulls" "\
Unconditionally turn on `magit-pulls-mode'.
\(fn)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; magit-gh-pulls-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "magit-gh-pulls" "20160222.1802" "GitHub pull requests extension for Magit" '((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1")) :url "https://github.com/sigma/magit-gh-pulls" :keywords '("git" "tools"))

View File

@ -0,0 +1,596 @@
;;; magit-gh-pulls.el --- GitHub pull requests extension for Magit
;; Copyright (C) 2011-2015 Yann Hodique, Alexander Yakushev
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords: git tools
;; Package-Version: 20160222.1802
;; Version: 0.5.2
;; URL: https://github.com/sigma/magit-gh-pulls
;; Package-Requires: ((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1"))
;; 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 2, 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 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 is a Magit extension for manipulating GitHub pull requests
;; No configuration is needed in the repository if any of your remotes contain a
;; URL to Github's remote repository. If for some reason you don't have any
;; Github remotes in your config, you can specify username and repository
;; explicitly:
;; $ git config magit.gh-pulls-repo <user>/<repo> # your github repository
;; Add these lines to your init.el:
;; (require 'magit-gh-pulls)
;; (add-hook 'magit-mode-hook 'turn-on-magit-gh-pulls)
;; These are the bindings for pull requests, defined in magit-gh-pulls-mode-map:
;; # g --- refreshes the list of pull requests
;; # f --- fetches the commits associated with the pull request at point
;; # b --- helps you creating a topic branch from a review request
;; # m --- merges the PR on top of the current branch
;; # c --- creates a PR from the current branch
;; # o --- opens a pull request on GitHub in your default browser
;; Then, you can do whatever you want with the commit objects associated with
;; the pull request (merge, cherry-pick, diff, ...)
;; When you create a new pull request, you can enable -w option to automatically
;; open it on GitHub in your default browser.
;;; Code:
(require 'eieio)
(require 'magit)
(require 'git-commit)
(require 'gh)
(require 'gh-pulls)
(require 'pcache)
(require 's)
(defgroup magit-gh-pulls nil
"Github.com pull-requests for Magit."
:group 'magit-extensions)
(defcustom magit-gh-pulls-open-new-pr-in-browser nil
"DEPRECATED: use magit switch instead."
:group 'magit-gh-pulls
:type 'boolean)
(defvar magit-gh-pulls-maybe-filter-pulls 'identity
"Filter function which should validate pulls you want to be
viewed in magit. It receives a list of pull requests and should
return a list of pull requests.")
(defvar magit-gh-pulls-collapse-commits t
"Collapse commits in pull requests listing.")
(defvar magit-gh-pulls-pull-detail-limit 10
"Pull in additional information for each pull request in the
status buffer only if the total number of open PRs is <=
this number. Additional information includes individual
commits in each PR and highlighting based on the merge
status of the PR. Increasing this number may adversely
affect performance on repos with many PRs.")
(defvar-local magit-gh-pulls-previous-winconf nil)
(defvar magit-gh-pulls-editor-mode-map
(let ((map (make-keymap)))
(define-key map (kbd "C-c C-c") 'magit-gh-pulls-pull-editor-finish)
(define-key map (kbd "C-c C-k") 'magit-gh-pulls-pull-editor-quit)
map))
(define-derived-mode magit-gh-pulls-editor-mode text-mode "Magit GitHub Pulls Editor"
(font-lock-add-keywords nil (git-commit-mode-font-lock-keywords) t))
(easy-menu-define magit-gh-pulls-editor-mode-menu magit-gh-pulls-editor-mode-map
"Magit GitHub Pulls Editor Menu"
'("Magit GitHub Pulls"
["Submit Pull Request" magit-gh-pulls-pull-editor-finish t]
["Cancel" magit-gh-pulls-pull-editor-quit t]))
(defun magit-gh-pulls-get-api ()
(gh-pulls-api "api" :sync t :num-retries 1 :cache (gh-cache "cache")))
(defun magit-gh-pulls-get-repo-from-config ()
"Return (user . project) pair read from magit.gh-pulls-repo
config option."
(let* ((cfg (magit-get "magit" "gh-pulls-repo")))
(when cfg
(let* ((split (split-string cfg "/")))
(cons (car split) (cadr split))))))
;;Find all the Hostname Lines until we hit the end of config-lines or the
;;next Host line. Return '(remaining-config-lines list-of-hostnames)
(defun magit-gh-pulls-collect-hostnames (config-lines)
(let ((cur-line (car config-lines))
(rest config-lines)
(result '()))
(while (and cur-line (not (string= (cadr cur-line) "Host")))
(setq result (cons (cadr (cdr cur-line)) result))
(setq rest (cdr rest))
(setq cur-line (car rest)))
(list rest result)))
(defun magit-gh-pulls-get-host-hostnames (config-lines)
(let (result-alist
(curline (car config-lines))
(rest-lines (cdr config-lines)))
(while rest-lines
(if (string= (cadr curline) "Host")
(let ((hosts (s-split "\\s*" (cadr (cdr curline)))) ;;List of the host aliases
(rest-result (magit-gh-pulls-collect-hostnames rest-lines)))
(dolist (host hosts)
;;Host must be lowercase because the url parser lowercases the string
(setq result-alist (cons (cons (downcase host) (cadr rest-result)) result-alist)))
(setq curline (caar rest-result))
(setq rest-lines (cdar rest-result)))
(progn
(setq curline (car rest-lines))
(setq rest-lines (cdr rest-lines)))))
result-alist))
(defun -magit-gh-pulls-filter-and-split-host-lines (lines)
(delq nil
(mapcar (lambda (line)
(s-match "^[ \t]*\\(Host\\|HostName\\|Hostname\\)[ \t]+\\(.+\\)$" line))
lines)))
;; Port of github/hub's SSHConfig
(defun magit-gh-pulls-get-ssh-config-hosts ()
(let* ((file-lines (mapcar (lambda (path)
(if (file-exists-p path)
(with-temp-buffer
(insert-file-contents path)
(split-string (buffer-string) "\n" t))
'()))
(list
(concat (file-name-as-directory (getenv "HOME")) ".ssh/config")
"/etc/ssh_config"
"/etc/ssh/ssh_config")))
(all-lines (apply #'append file-lines))
(matched-lines (-magit-gh-pulls-filter-and-split-host-lines all-lines)))
(magit-gh-pulls-get-host-hostnames matched-lines)))
;; Port of github/hub's ParseURL, with modifications to align with existing parse-url
(defun magit-gh-pulls-parse-url (url ssh-config-hosts)
(let* ((fixed-url (if (and (not (s-matches? "^[a-zA-Z_-]+://" url))
(s-matches? ":" url)
(not (s-matches? "\\\\\\\\" url))) ;;Two literal backlashes
(concat "ssh://" (s-replace ":" "/" url))
url))
(parsed-url (url-generic-parse-url fixed-url))
(ssh-host (when (string= (url-type parsed-url) "ssh")
(assoc (url-host parsed-url) ssh-config-hosts))))
(when (and ssh-host (cadr ssh-host))
(setf (url-host parsed-url) (cadr ssh-host)))
(when (and
(string= (url-host parsed-url) "github.com")
(s-matches? "\\(git\\|ssh\\|https?\\)" (url-type parsed-url)))
(let ((creds (s-match "/\\(.+\\)/\\([^/]+\\)/?$" (url-filename parsed-url))))
(when creds
(cons (cadr creds) (s-chop-suffix ".git" (cadr (cdr creds)))))))))
(defun magit-gh-pulls-guess-repo-from-origin ()
"Return (user . project) pair inferred from remotes in
.git/config."
(let ((creds nil)
(ssh-config-hosts (magit-gh-pulls-get-ssh-config-hosts)))
(dolist (remote (magit-git-lines "remote") creds)
(let ((parsed (magit-gh-pulls-parse-url
(magit-get "remote" remote "url")
ssh-config-hosts)))
(when parsed
(setq creds parsed))))))
(defun magit-gh-pulls-guess-repo ()
"Return (user . project) pair obtained either from explicit
option, or inferred from remotes."
(or (magit-gh-pulls-get-repo-from-config)
(magit-gh-pulls-guess-repo-from-origin)))
(defun magit-gh-pulls-requests-cached-p (api user proj)
"Returns T if the API request to the given USER and PROJ is cached."
(let ((cache-repo (format "/repos/%s/%s/pulls" user proj))
(cached? nil))
(pcache-map (oref api :cache)
(lambda (key _) (when (equal (car key) cache-repo)
(setq cached? t))))
cached?))
(defun magit-gh-pulls-insert-gh-pulls ()
(condition-case-unless-debug print-section
(progn
(let* ((repo (magit-gh-pulls-guess-repo)))
(when repo
(let* ((api (magit-gh-pulls-get-api))
(user (car repo))
(proj (cdr repo))
(cached? (magit-gh-pulls-requests-cached-p api user proj))
(stubs (when cached?
(funcall magit-gh-pulls-maybe-filter-pulls
(oref (gh-pulls-list api user proj) :data))))
(num-total-stubs (length stubs))
(branch (magit-get-current-branch)))
(when (or (> (length stubs) 0) (not cached?))
(magit-insert-section (pulls)
(magit-insert-heading "Pull Requests:")
(dolist (stub stubs)
(let* ((id (oref stub :number))
(req (oref (gh-pulls-get api user proj id) :data))
(base-sha (oref (oref req :base) :sha))
(base-ref (oref (oref req :base) :ref))
(head-sha (oref (oref req :head) :sha))
;; branch has been deleted in the meantime...
(invalid (equal (oref (oref req :head) :ref) head-sha))
(have-commits
(and (>= magit-gh-pulls-pull-detail-limit num-total-stubs)
(eql 0 (magit-git-exit-code "cat-file" "-e" base-sha))
(eql 0 (magit-git-exit-code "cat-file" "-e" head-sha))))
(applied (and have-commits
(magit-git-string "branch" branch
(format "--contains=%s" head-sha))))
(heading
(format "[%s@%s] %s\n"
(propertize (number-to-string id)
'face 'magit-tag)
(if (string= base-ref branch)
(propertize base-ref
'face 'magit-branch-local)
base-ref)
(propertize
(oref req :title) 'face
(cond (applied 'magit-cherry-equivalent)
(have-commits nil)
(invalid 'error)
(t 'italic)))))
(info (list user proj id)))
(cond
(have-commits
(magit-insert-section
(pull info magit-gh-pulls-collapse-commits)
(insert heading)
(magit-insert-heading)
(when (and have-commits (not applied))
(magit-git-wash
(apply-partially 'magit-log-wash-log 'cherry)
"cherry" "-v" (magit-abbrev-arg)
base-sha head-sha))))
(invalid
(magit-insert-section (invalid-pull info)
(insert heading)))
(t
(magit-insert-section (unfetched-pull info)
(insert heading))))))
(when (not cached?)
(insert "Press `# g` to update the pull request list.\n\n"))
(when (> (length stubs) 0)
(insert "\n"))))))))
(error nil)))
(defun magit-gh-pulls-guess-topic-name (req)
(let ((user (oref (oref req :user) :login))
(topic (oref (oref req :head) :ref)))
(format "%s/%s" user topic)))
(defun magit-gh-section-req-data (&optional section)
(oref (apply #'gh-pulls-get
(magit-gh-pulls-get-api)
(magit-section-value (or section (magit-current-section))))
:data))
(defun magit-gh-pulls-diff-pull-request ()
(interactive)
(magit-section-case
(pull
(let* ((req (magit-gh-section-req-data))
(inhibit-magit-refresh t))
(magit-diff (concat (oref (oref req :base) :sha) ".."
(oref (oref req :head) :sha))))
(magit-refresh))
(unfetched-pull
(error "Please fetch pull request commits first"))
(invalid-pull
(error "This pull request refers to invalid reference"))))
(defun magit-gh-pulls-create-branch ()
(interactive)
(magit-section-case
(pull
(let* ((req (magit-gh-section-req-data))
(branch (read-from-minibuffer
"Branch name: " (magit-gh-pulls-guess-topic-name req)))
(base (magit-read-branch-or-commit
"Branch base: "
(oref (oref req :base) :ref)))
(inhibit-magit-refresh t))
(magit-branch-and-checkout branch base)
(magit-merge (oref (oref req :head) :sha)))
(magit-refresh))
(unfetched-pull
(error "Please fetch pull request commits first"))
(invalid-pull
(error "This pull request refers to invalid reference"))))
(defun magit-gh-pulls-merge-pull-request ()
(interactive)
(magit-section-case
(pull
(let* ((req (magit-gh-section-req-data))
(branch (magit-gh-pulls-guess-topic-name req))
(base (oref (oref req :base) :ref))
(inhibit-magit-refresh t))
(magit-branch-and-checkout branch base)
(magit-merge (oref (oref req :head) :sha))
(magit-checkout base)
(magit-merge branch (when (member "--no-ff" (magit-gh-pulls-arguments))
'("--no-ff")))
(magit-call-git "branch" "-D" branch))
(magit-refresh))
(unfetched-pull
(error "Please fetch pull request commits first"))
(invalid-pull
(error "This pull request refers to invalid reference"))))
(defun magit-gh-pulls-fetch-commits ()
(interactive)
(magit-section-case
(unfetched-pull
(let* ((req (magit-gh-section-req-data))
(head (oref req :head)))
(magit-run-git "fetch" (oref (oref head :repo) :git-url)
(oref head :ref))))
(pull nil)
(invalid-pull
(error "This pull request refers to invalid reference"))))
(defun magit-gh-pulls-url-for-pull (info)
"Return github url for a pull request using INFO."
(let ((url "https://github.com/%s/%s/pull/%s"))
(apply 'format url info)))
(defun magit-gh-pulls-open-in-browser ()
(interactive)
(let ((info (magit-section-value (magit-current-section))))
(magit-section-case
(pull (browse-url (magit-gh-pulls-url-for-pull info)))
(unfetched-pull (browse-url (magit-gh-pulls-url-for-pull info))))))
(defun magit-gh-pulls-purge-cache ()
(let* ((api (magit-gh-pulls-get-api))
(cache (oref api :cache))
(repo (magit-gh-pulls-guess-repo)))
(pcache-map cache (lambda (k v)
(when (string-match
(format "/repos/%s/%s/" (car repo) (cdr repo))
(car k))
(pcache-invalidate cache k))))))
(defun magit-gh-pulls-get-remote-default (&optional remote-name-override)
(let ((remote-name (or remote-name-override "origin"))
(remote-branches (magit-git-lines "branch" "-r"))
remote-head)
(while (and remote-branches (not remote-head))
(let ((m (s-match (format "^\\s-*%s/HEAD -> %s/\\(\\w*\\)" remote-name remote-name) (car remote-branches))))
(if m
(setq remote-head (cadr m))
(setq remote-branches (cdr remote-branches)))))
remote-head))
(defun magit-gh-pulls-build-req (api user proj callback)
"Builds a request entity for a new pull request. Under
synchronous flow (editor disabled), fires CALLBACK with
API, USER, PROJ and the new REQUEST as args. Under
asynchronous flow, passes all ARGS through to the PR
editor which is responsible for continuing the flow."
(let* ((current (magit-get-current-branch))
(current-default (magit-gh-pulls-get-remote-default))
(base-branch (magit-read-other-branch-or-commit "Base" nil current-default))
(head-branch (magit-read-other-branch-or-commit "Head" nil current)))
(let* ((head-remote (concat (magit-get-remote base-branch) "/" head-branch))
(pushed-p (and (magit-branch-p head-remote)
(null (magit-git-lines "diff" (concat head-remote ".." head-branch))))))
(when (and (not pushed-p)
(yes-or-no-p "PR branch doesn't appear to be pushed. Push it?"))
(magit-push current (magit-get-remote base-branch))))
(let* ((base
(make-instance 'gh-repos-ref :user (make-instance 'gh-users-user :name user)
:repo (make-instance 'gh-repos-repo :name proj)
:ref base-branch))
(head
(make-instance 'gh-repos-ref :user (make-instance 'gh-users-user :name user)
:repo (make-instance 'gh-repos-repo :name proj)
:ref head-branch))
(default-title (magit-git-string "log"
(format "%s..%s" base-branch head-branch)
"--format=%s" "--reverse"))
(default-body (mapconcat 'identity (magit-git-lines "log"
(format "%s..%s" base-branch head-branch)
"-1" "--format=%b") " ")))
(if (member "--use-pr-editor" (magit-gh-pulls-arguments))
(magit-gh-pulls-init-pull-editor api user proj default-title default-body base head callback)
(let* ((title (read-string "Title: " default-title))
(body (read-string "Description: " default-body))
(req (make-instance 'gh-pulls-request :head head :base base :body body :title title)))
(funcall callback api user proj req))))))
(defun magit-gh-pulls-init-pull-editor (api user proj default-title default-body base head callback)
"Create a new buffer for editing this pull request and
switch to it. The context needed to finalize the
pull request is stored in a buffer-local var in the
newly created buffer."
(let ((winconf (current-window-configuration))
(buffer (get-buffer-create (format "*magit-gh-pulls: %s*" proj)))
(context (make-hash-table :test 'equal)))
(dolist (var '(api user proj base head callback))
(puthash (symbol-name var) (eval var) context))
(split-window-vertically)
(other-window 1)
(switch-to-buffer buffer)
(funcall 'magit-gh-pulls-editor-mode)
(insert (or default-title "") "\n\n" default-body)
(goto-char (point-min))
(message "Opening pull request editor. C-c C-c to finish, C-c C-k to quit.")
(setq-local magit-gh-pulls-editor-context context)
(setq magit-gh-pulls-previous-winconf winconf)))
(defun magit-gh-pulls-pull-editor-finish ()
"Finish editing the current pull request and continue
to submit it. This should be called interactively
from within a pull request editor buffer."
(interactive)
(if (eq nil magit-gh-pulls-editor-context)
(message "This function can only be run in a pull editor buffer.")
(let* ((context magit-gh-pulls-editor-context)
(end-of-first-line (save-excursion
(beginning-of-buffer)
(line-end-position)))
(title (s-trim (buffer-substring-no-properties 1 end-of-first-line)))
(body (s-trim (buffer-substring-no-properties end-of-first-line (point-max))))
(req (make-instance 'gh-pulls-request
:head (gethash "head" context)
:base (gethash "base" context)
:body body :title title)))
(funcall (gethash "callback" context)
(gethash "api" context)
(gethash "user" context)
(gethash "proj" context)
req)
(magit-gh-pulls-pull-editor-quit))))
(defun magit-gh-pulls-pull-editor-quit ()
"Cleanup the current pull request editor and restore
the previous window config."
(interactive)
(if (eq nil magit-gh-pulls-editor-context)
(message "This function can only be run in a pull editor buffer.")
(let ((winconf magit-gh-pulls-previous-winconf))
(kill-buffer)
(kill-local-variable 'magit-gh-pulls-previous-winconf)
(when winconf
(set-window-configuration winconf)))))
(defun magit-gh-pulls-create-pull-request ()
"Entrypoint for creating a new pull request."
(interactive)
(let ((repo (magit-gh-pulls-guess-repo)))
(when repo
(let* ((current-branch (magit-get-current-branch))
(api (magit-gh-pulls-get-api))
(user (car repo))
(proj (cdr repo)))
(magit-gh-pulls-build-req api user proj 'magit-gh-pulls-submit-pull-request)))))
(defun magit-gh-pulls-submit-pull-request (api user proj req)
"Endpoint for creating a new pull request. Sync and async
flows should both call this function to finish creating
a new pull request."
(interactive)
(let* ((a (gh-pulls-new api user proj req)))
(if (not (= (oref a :http-status) 201))
(message "Error creating pull-request: %s. Have you pushed the branch to github?" (cdr (assoc "Status" (oref a :headers))))
(let ((url (oref (oref a :data) :html-url)))
(message (concat "Created pull-request and copied URL to kill ring: " url))
(when (member "--open-new-in-browser" (magit-gh-pulls-arguments))
(browse-url url))
(kill-new url)))))
(defun magit-gh-pulls-reload ()
(interactive)
(let ((creds (magit-gh-pulls-guess-repo)))
(if (not (and creds (car creds) (cdr creds)))
(message "Remote repository is not configured or incorrect.")
(magit-gh-pulls-purge-cache)
(gh-pulls-list (magit-gh-pulls-get-api) (car creds) (cdr creds))
(magit-refresh))))
(easy-menu-define magit-gh-pulls-extension-menu
nil
"GitHub Pull Requests extension menu"
'("GitHub Pull Requests"
:visible magit-gh-pulls-mode
["Reload pull request" magit-gh-pulls-reload]
["Create pull request branch" magit-gh-pulls-create-branch]
["Fetch pull request commits" magit-gh-pulls-fetch-commits]
["Open pull request in browser" magit-gh-pulls-open-in-browser]
))
(easy-menu-add-item 'magit-mode-menu
'("Extensions")
magit-gh-pulls-extension-menu)
(magit-define-section-jumper magit-jump-to-pulls "Pull Requests" pulls)
(define-key magit-status-mode-map (kbd "jq") 'magit-jump-to-pulls)
(defvar magit-gh-pulls-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "#") 'magit-gh-pulls-popup)
map))
(defvar magit-gh-pulls-mode-lighter " Pulls")
;;;###autoload
(define-minor-mode magit-gh-pulls-mode "Pull requests support for Magit"
:lighter magit-gh-pulls-mode-lighter
:require 'magit-gh-pulls
:keymap 'magit-gh-pulls-mode-map
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(if magit-gh-pulls-mode
(magit-add-section-hook
'magit-status-sections-hook
'magit-gh-pulls-insert-gh-pulls
'magit-insert-stashes)
(remove-hook 'magit-status-sections-hook 'magit-gh-pulls-insert-gh-pulls))
(when (called-interactively-p 'any)
(magit-refresh)))
;;;###autoload
(defun turn-on-magit-gh-pulls ()
"Unconditionally turn on `magit-pulls-mode'."
(magit-gh-pulls-mode 1))
(magit-define-popup magit-gh-pulls-popup
"Show popup buffer featuring Github Pull Requests commands."
'magit-commands
:switches '((?c "Produce merge commit" "--no-ff")
(?w "Open new PR in browser" "--open-new-in-browser")
(?e "Edit PR in full buffer" "--use-pr-editor"))
:actions '((?g "Reload" magit-gh-pulls-reload)
(?f "Fetch" magit-gh-pulls-fetch-commits)
(?d "Diff" magit-gh-pulls-diff-pull-request)
(?b "Make branch" magit-gh-pulls-create-branch)
(?m "Merge" magit-gh-pulls-merge-pull-request)
(?c "Create new PR" magit-gh-pulls-create-pull-request)
(?o "Open in browser" magit-gh-pulls-open-in-browser))
:default-action 'magit-gh-pulls-reload)
(provide 'magit-gh-pulls)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-gh-pulls.el ends here

View File

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" 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-Popup: (magit-popup). Infix arguments with feedback.

View File

@ -0,0 +1,16 @@
;;; magit-popup-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("magit-popup-pkg.el" "magit-popup.el")
;;;;;; (22221 60697 911041 79000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; magit-popup-autoloads.el ends here

View File

@ -0,0 +1,9 @@
(define-package "magit-popup" "20160130.649" "Define prefix-infix-suffix command combos"
'((emacs "24.4")
(async "20150909.2257")
(dash "20151021.113"))
:url "https://github.com/magit/magit" :keywords
'("bindings"))
;; Local Variables:
;; no-byte-compile: t
;; End:

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,710 @@
This is magit-popup.info, produced by makeinfo version 5.2 from
magit-popup.texi.
Taking inspiration from regular prefix commands and prefix arguments,
this library implements a similar abstraction; a new kind of prefix
command that is associated with a specific set of infix arguments and
suffix commands.
Copyright (C) 2015-2016 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document 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 document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Magit-Popup: (magit-popup). Infix arguments with feedback.
END-INFO-DIR-ENTRY

File: magit-popup.info, Node: Top, Next: Introduction, Up: (dir)
Magit-Popup User Manual
***********************
Taking inspiration from regular prefix commands and prefix arguments,
this library implements a similar abstraction; a new kind of prefix
command that is associated with a specific set of infix arguments and
suffix commands.
Copyright (C) 2015-2016 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document 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 document 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.
* Menu:
* Introduction::
* Usage::
* Defining prefix and suffix commands::
— The Detailed Node Listing —
Usage
* Customizing existing popups::
* Other options::
Defining prefix and suffix commands
* Defining prefix commands::
* Defining suffix commands::

File: magit-popup.info, Node: Introduction, Next: Usage, Prev: Top, Up: Top
1 Introduction
**************
Taking inspiration from regular prefix commands and prefix arguments,
this library implements a similar abstraction; a new kind of prefix
command that is associated with a specific set of infix arguments and
suffix commands.
Invoking such a prefix command displays a popup buffer which lists
the associated infix arguments and suffix commands. In that buffer each
argument is prefixes with the key sequence that can be used to toggle it
or change its value. Likewise each suffix command is prefixed with the
key used to invoke it. Such a popup buffer might look like this:
,-----------------------------------------
|Switches
| -l Show graph (--graph)
| -d Show refnames (--decorate)
|
|Options
| =m Search messages (--grep="popup")
| =p Search patches (-G)
|
|Action
| l Show log for current branch
| o Show log for another branch
'-----------------------------------------
The user could then for example type -l to toggle the --graph
*switch* (when it is on then it is shown in green, otherwise in gray),
or =m to change the value of the *option* --grep.
Once all arguments are as desired one invokes a suffix command, which
causes the popup buffer to disappears. The suffix command should then
retrieve the infix arguments in its interactive form like this is done
for prefix arguments.
While such "prefix-infix-suffix" combos were inspired by regular
prefix commands and prefix arguments, they are also quite different.
This should illustrate the most basic differences:
• A regular prefix commands
/- command1
prefix --- command2
\- command3
• Prefix arguments
/- command1
C-u ... --- command2
\- well *any* command
• A Prefix-Infix-Suffix combo
/- argument1 -\ /- suffix1
prefix----- argument2 --+-- suffix2
^ \- argument3 -/
| |
'--------'
(refresh buffer)
This library was written as a replacement for magit-key-mode which
was used in Magit releases before 2.1.0. It is used to implement all
"popups" in the current Magit release but a future release will switch
to yet another implementation.
This library does not depend on any other Magit libraries and it is
distributed as a separate package, which makes it possible to use it in
packages that are not related to Magit. But keep in mind that it will
be deprecated eventually.

File: magit-popup.info, Node: Usage, Next: Defining prefix and suffix commands, Prev: Introduction, Up: Top
2 Usage
*******
Every popup buffers created with a prefix command contains a section
named "Actions" listing the available suffix commands. Most buffers
also contain a "Switches" and/or an "Options" section which list the two
types of infix arguments separately.
Switches are arguments that can be toggled on or off. When a switch
is active then it is shown in color, when it is off then it is shown in
gray (of course the details depend on the color theme in use).
Options are arguments that have a value. When an option has a value
then that is shown after the option itself. Because for some options
the empty string is a valid value, options are additionally colorized
like switches to indicate whether they are active or not.
The events bound to suffix commands are always single alphabetic
characters. The bindings for arguments are always two events long. For
switches the first key is always -, for options it is always =. The
second key is always an alphabetic character.
By default popup buffers also feature a section listing commands
common to all popups. To avoid conflicts with suffix commands, the
bindings of these common commands are not alphabetic characters. This
section is shown by default so that documentation-resistant users get a
change to notice them.
-- User Option: magit-popup-show-common-commands
This option controls whether the section which lists the commands
that are common to all popups is initially show. We recommend you
set this to nil - after you have memorized that it can be shown
on demand using C-t.
C-t (magit-popup-toggle-show-common-commands)
Show or hide the section listing the commands shared by all popups.
C-g (magit-popup-quit)
Quit popup buffer without invoking a suffix command.
Without further action, setting arguments only affects the next
suffix command. Invoking the same prefix command again resets the
arguments to their default value, but the defaults can be changed
directly from the popup buffer itself. For a prefix command named
NAME-popup the default values are stored as the value of the custom
option named NAME-arguments. While this option can be customized
using the Custom interface, it is better to do so directly from the
popup buffer.
C-c C-c (magit-popup-set-default-arguments)
This sets the default value for the arguments for the current
popup.
Then the popup buffer is closed without invoking a suffix command;
unless a prefix argument is used in which case the popup remains
open.
C-x C-s (magit-popup-save-default-arguments)
This sets the default value for the arguments for the current popup
and saves it for future Emacs sessions.
Then the popup buffer is closed without invoking an action; unless
a prefix argument is used in which case the popup remains open.
It is also possible to add additional arguments and commands to an
existing popup, but that cannot be done directly from the popup (or the
Custom interface). See *note Customizing existing popups: Customizing
existing popups.
Documentation about a popups arguments and commands can be shown
directly from the popup.
C-h i (magit-popup-info)
Show this manual.
? (magit-popup-help)
This command reads a key sequence and then shows the documentation
of the argument or command that sequence is bound to. In other
words type the same keys that you would use to invoke the argument
or command, but prefix the sequence with ?.
For suffix commands this shows the doc-string. For arguments this
command can only show something for popups that have an associated
man-page. If the man-page is set, then this command displays it in
a separate buffer and puts point on the entry about the argument in
question.
The buffer which is used to display the documentation is selected.
Simply press q to leave that buffer and restore the old window
configuration.
While it isnt very useful, it is possible to move around in a popup
buffer using C-p and C-n, and to invoke the argument or command at
point using RET. But it is much more efficient to use the dedicated
key bindings instead, so these commands are not listed in popup buffers
along with the other common commands.
* Menu:
* Customizing existing popups::
* Other options::

File: magit-popup.info, Node: Customizing existing popups, Next: Other options, Up: Usage
2.1 Customizing existing popups
===============================
It is possible to define additional infix arguments and suffix commands
to an existing popup using the following functions.
You can find some examples which use the below commands at
<https://github.com/magit/magit/wiki/Additional-proposed-infix-arguments-and-suffix-commands>.
-- Function: magit-define-popup-switch popup key desc switch &optional
enable at prepend
In POPUP, define KEY as SWITCH.
POPUP is a popup command defined using magit-define-popup.
SWITCH is a string representing an argument that takes no value.
KEY is a character representing the second event in the sequence of
keystrokes used to toggle the argument. (The first event, the
prefix, is shared among all switches, defaults to -, and can be
changed in magit-popup-mode-keymap).
DESC is a string describing the purpose of the argument, it is
displayed in the popup.
If optional ENABLE is non-nil then the switch is on by default.
SWITCH is inserted after all other switches already defined for
POPUP, unless optional PREPEND is non-nil, in which case it is
placed first. If optional AT is non-nil then it should be the KEY
of another switch already defined for POPUP, the argument is then
placed before or after AT, depending on PREPEND.
-- Function: magit-define-popup-option popup key desc option &optional
reader value at prepend
In POPUP, define KEY as OPTION.
POPUP is a popup command defined using magit-define-popup.
OPTION is a string representing an argument that takes a value.
KEY is a character representing the second event in the sequence of
keystrokes used to set the arguments value. (The first event, the
prefix, is shared among all options, defaults to =, and can be
changed in magit-popup-mode-keymap).
DESC is a string describing the purpose of the argument, it is
displayed in the popup.
If optional VALUE is non-nil then the option is on by default, and
VALUE is its default value.
OPTION is inserted after all other options already defined for
POPUP, unless optional PREPEND is non-nil, in which case it is
placed first. If optional AT is non-nil then it should be the KEY
of another option already defined for POPUP, the argument is then
placed before or after AT, depending on PREPEND.
-- Function: magit-define-popup-action popup key desc command &optional
at prepend
In POPUP, define KEY as COMMAND.
POPUP is a popup command defined using magit-define-popup.
COMMAND can be any command but should usually consume the popup
arguments in its interactive form. KEY is a character
representing the event used invoke the action, i.e. to
interactively call the COMMAND.
DESC is a string describing the purpose of the action, it is
displayed in the popup.
COMMAND is inserted after all other commands already defined for
POPUP, unless optional PREPEND is non-nil, in which case it is
placed first. If optional AT is non-nil then it should be the KEY
of another command already defined for POPUP, the command is then
placed before or after AT, depending on PREPEND.
-- Function: magit-define-popup-sequence-action popup key desc command
&optional at prepend
Like magit-define-popup-action, but modifies the value of the
:sequence-actions property instead of :actions.
-- Function: magit-define-popup-variable popup key desc command
formatter &optional at prepend
In POPUP, define KEY as COMMAND.
POPUP is a popup command defined using magit-define-popup.
COMMAND is a command which calls magit-popup-set-variable.
FORMATTER is a function which calls magit-popup-format-variable.
These two functions have to be called with the same arguments.
KEY is a character representing the event used interactively call
the COMMAND.
DESC is the variable or a representation thereof. Its not
actually used for anything.
COMMAND is inserted after all other commands already defined for
POPUP, unless optional PREPEND is non-nil, in which case it is
placed first. If optional AT is non-nil then it should be the KEY
of another command already defined for POPUP, the command is then
placed before or after AT, depending on PREPEND."
-- Function: magit-change-popup-key popup type from to
In POPUP, bind TO to what FROM was bound to. TYPE is one of
:action, :sequence-action, :switch, or :option. Bind TO
and unbind FROM, both are characters.
-- Function: magit-remove-popup-key popup type key
In POPUP, remove KEYs binding of TYPE. POPUP is a popup command
defined using magit-define-popup. TYPE is one of :action,
:sequence-action, :switch, or :option. KEY is the character
which is to be unbound.
It is also possible to change other aspects of a popup by setting a
property using plist-put. See *note Defining prefix commands:
Defining prefix commands. for valid properties. The most likely change
Magit users might want to make is:
(plist-put magit-show-refs-popup :use-prefix nil)

File: magit-popup.info, Node: Other options, Prev: Customizing existing popups, Up: Usage
2.2 Other options
=================
-- User Option: magit-popup-use-prefix-argument
This option controls the effect that the use of a prefix argument
before entering a popup has. The *intended* default is default,
but the *actual* default is disabled. This is necessary because
the old popup implementation did simply forward such a pre-popup
prefix argument to the suffix command invoked from the popup, and
changing that without users being aware of it could lead to tears.
disabled
Bring up a Custom option buffer so that the user reads this
and then makes an informed choice.
default
With a prefix argument directly invoke the popups default
action (an Emacs command), instead of bringing up the popup.
popup
With a prefix argument bring up the popup, otherwise directly
invoke the popups default action.
nil
Ignore prefix arguments.
This option can be overridden for individual popups.
magit-show-refs-popup for example defaults to invoking the
default action directly. It only shows the popup buffer when a
prefix argument is used. See *note Customizing existing popups:
Customizing existing popups.
-- User Option: magit-popup-manpage-package
The Emacs package used to display man-pages, one of man or
woman.
-- User Option: magit-popup-display-buffer-action
The option controls how the window used to display a popup buffer
is created. Popup buffers are displayed using display-buffer
with the value of this option as ACTION argument. You can also set
this to nil and instead add an entry to display-buffer-alist.
To emphasize the default action by making it bold use this:
(button-type-put 'magit-popup-action-button 'format " %k %D")

File: magit-popup.info, Node: Defining prefix and suffix commands, Prev: Usage, Up: Top
3 Defining prefix and suffix commands
*************************************
If you write an extension for Magit then you should use this library now
and later when transient is released port to that.
If you are considering using this library to define popups for
packages not related to Magit, then keep in mind that it will be
superseded eventually. Once transient has been released I will only
fix bugs in magit-popup but not implement any new features.
Also consider using hydra instead. To some extend magit-popup
and hydra are similar but have a different focus. The main purpose of
magit-popup is to pass infix arguments to suffix commands. If all you
need is a command dispatcher then you are better of using hydra. Of
course hydra may also be a better fit not only because of the features
it lacks, but also because of the features it provides, which are in
turn missing from magit-popup.
Here is an example of how one defines a prefix command along with its
infix arguments, and then also one of its suffix commands.
;;;###autoload (autoload 'magit-tag-popup "magit" nil t)
(magit-define-popup magit-tag-popup
"Show popup buffer featuring tagging commands."
'magit-commands
:man-page "git-tag"
:switches '((?a "Annotate" "--annotate")
(?s "Sign" "--sign")
(?f "Force" "--force"))
:actions '((?t "Create" magit-tag)
(?k "Delete" magit-tag-delete)
(?p "Prune" magit-tag-prune))
:default-action 'magit-tag)
;;;###autoload
(defun magit-tag (name rev &optional args)
"Create a new tag with the given NAME at REV."
(interactive (list (magit-read-tag "Tag name")
(magit-read-branch-or-commit "Place tag on")
(magit-tag-arguments)))
(magit-run-git-with-editor "tag" args name rev))
* Menu:
* Defining prefix commands::
* Defining suffix commands::

File: magit-popup.info, Node: Defining prefix commands, Next: Defining suffix commands, Up: Defining prefix and suffix commands
3.1 Defining prefix commands
============================
Prefix commands and their infix arguments are defined using the macro
magit-define-popup. The key bindings and descriptions of suffix
commands are also defined using that macro, but the actual interactive
commands have to be defined separately using plain defun.
-- Macro: magit-define-popup name doc [group [mode [option]]] :keyword
value…
This macro defines a popup named NAME. The NAME should begin with
the package prefix and by convention end with -popup, it is used
as the name of the command which shows the popup and for an
internal variable (whose value is used to store information about
the popup and should not be accessed directly). DOC is the
doc-string of the popup command.
This macro also defines an option and a function both named
SHORTNAME-arguments, where SHORTNAME is NAME with the trailing
-popup removed. The name of this option and this function can be
overwritten using the optional argument OPTION, but that is rarely
advisable. As a special case if OPTION is specified but nil,
then this option and this function are not defined at all, which is
useful for popups that are used as simple dispatchers that offer no
arguments.
The option SHORTNAME-arguments holds the value for the popup
arguments. It can be customized from within the popup or using the
Custom interface. It can also have a buffer local value in any
non-popup buffer. The local value for the buffer from which the
popup command was invoked, can be set from within the popup buffer.
The function SHORTNAME-arguments returns the currently effective
value of the variable by the same name. See below for more
information.
The optional argument GROUP specifies the Custom group in which the
option is placed. If omitted then the option is placed in some
group the same way it is done when directly using defcustom and
omitting the group.
The optional argument MODE specifies the mode used by the popup
buffer. If it is omitted or nil then magit-popup-mode is used.
The remaining arguments should have the form [KEYWORD VALUE]....
The following keywords are meaningful (and by convention are
usually specified in that order):
:actions
The actions which can be invoked from the popup. VALUE is a
list whose members have the form (KEY DESC COMMAND), see
magit-define-popup-action for details.
How the actions are split into rows and columns currently
depends on the available space and :max-action-columns.
WARNING: This will likely be change to use a more explicit
format (((KEY DESC COMMAND)…)…) before the release.
Actions are regular Emacs commands, which usually have an
interactive form setup to consume the values of the popup
:switches and :options when invoked from the corresponding
popup, else when invoked as the default action or directly
without using the popup, the default value of the variable
SHORTNAME-arguments. This is usually done by calling the
function SHORTNAME-arguments.
Members of VALUE may also be strings, assuming the first
member is also a string. Instead of just one action section
with the heading \"Actions\", multiple sections are then
inserted into the popup buffer, using these strings as
headings.
Members of VALUE may also be nil. This should only be used
together with :max-action-columns and allows having gaps in
the action grit, which can help arranging actions sensibly.
:default-action
The default action of the popup which is used directly instead
of displaying the popup buffer, when the popup is invoked with
a prefix argument. Also see magit-popup-use-prefix-argument
and :use-prefix, which can be used to inverse the meaning of
the prefix argument.
:use-prefix
Controls when to display the popup buffer and when to invoke
the default action (if any) directly. This overrides the
global default set using magit-popup-use-prefix-argument.
The value, if specified, should be one of default or
prefix.
:switches
The popup arguments which can be toggled on and off. VALUE is
a list whose members have the form (KEY DESC SWITCH), see
magit-define-popup-switch for details.
:options
The popup arguments which take a value, as in "opt~OPTVAL".
VALUE is a list whose members have the form (KEY DESC OPTION
READER), see magit-define-popup-option for details.
:variables
Git variables which can be set from the popup. VALUE is a
list whose members have the form (KEY DESC COMMAND FORMATTER),
see magit-define-popup-variable for details.
:default-arguments
The default arguments, a list of switches (which are then
enabled by default) and options with there default values, as
in "OPT~OPTVAL\".
:sequence-predicate
When this function returns non-nil, then the popup uses
:sequence-actions instead of :actions, and does not show
the :switches and :options.
:sequence-actions
The actions which can be invoked from the popup, when
:sequence-predicate returns non-nil.
:setup-function
When this function is specified, then it is used instead of
magit-popup-default-setup.
:refresh-function
When this function is specified, then it is used instead of
calling magit-popup-insert-section three times with symbols
magit-popup-switch-button, magit-popup-option-button, and
finally magit-popup-action-button as argument.
:man-page
The name of the manpage to be displayed when the user requests
help for an argument.

File: magit-popup.info, Node: Defining suffix commands, Prev: Defining prefix commands, Up: Defining prefix and suffix commands
3.2 Defining suffix commands
============================
Commands intended to be invoked from a particular popup should determine
the currently effective arguments by calling the function
SHORTNAME-arguments inside their interactive form. This function is
created by the magit-define-popup macro. For a popup named
prefix-foo-popup the name of this function is prefix-foo-arguments.
When the command was invoked as an action in the respective popup,
then this function returns the arguments that were set in the popup.
Otherwise when the command was invoked as the default of the popup (by
calling the popup command with a prefix argument), or without using the
popup command at all, then this function returns the buffer-local or
global value of the variable SHORTNAME-arguments.
Internally arguments are handled as a list of strings. This might
not be appropriate for the intended use inside commands, or it might be
necessary to manipulate that list somehow, i.e. to split "ARG=VAL"
into "ARG""VAL". This should be done by advising or redefining the
function SHORTNAME-arguments.
Internally SHORNAME-arguments used following variables and
function. Except when redefining the former, you should not use these
directly.
-- Variable: magit-current-popup
The popup from which this editing command was invoked.
-- Variable: magit-current-popup-args
The value of the popup arguments for this editing command.
If the current command was invoked from a popup, then this is a
list of strings of all the set switches and options. This includes
arguments which are set by default not only those explicitly set
during this invocation.
When the value is nil, then that can be because no argument is set,
or because the current command wasnt invoked from a popup at all.
-- Function: magit-current-popup-args &rest args
This function returns the value of the popup arguments for this
editing command. The value is the same as that of the variable by
the same name, except that FILTER is applied. FILTER is a list of
regexps; only arguments that match one of them are returned. The
first element of FILTER may also be :not in which case only
arguments that dont match any of the regexps are returned, or
:only which doesnt change the behavior.

Tag Table:
Node: Top994
Node: Introduction2168
Node: Usage4745
Node: Customizing existing popups9402
Node: Other options14930
Node: Defining prefix and suffix commands16979
Node: Defining prefix commands19075
Node: Defining suffix commands25755

End Tag Table

Local Variables:
coding: utf-8
End:

View File

@ -0,0 +1,34 @@
This package provides two commands which manipulate author and
committer dates. You could use it to make yourself look like
a rockstar programmer who hammers out commits at one commit per
minute. But the real purpose is to recover from heavy
re-arrangements of commits, that have causes the existing author
and committer dates to become meaningless.
I add these commands to the appropriate popups like this:
(magit-define-popup-action 'magit-rebase-popup
?R "Rockstar" 'magit-rockstar)
(magit-define-popup-action 'magit-commit-popup
?n "Reshelve" 'magit-reshelve)
Also included are tools that are either only useful for people
working on Magit itself and/or that aren't ready to be added to
Magit yet. These tools might change at any time, without prior
notice or way to appeal. This is a staging ground. It's okay
if things ain't perfect, or if they only do what *I currently*
need but not what you (or I) think they should (eventually) be
doing instead.
Currently my init file also contains this:
(magit-define-popup-action 'magit-fetch-popup
?P "Pull request" 'magit-branch-pull-request)
To use the "anti-stage" feature add this:
(setq magit-unstage-use-anti-stage t)
(magit-define-popup-action 'magit-revert-popup
?e "Revert & edit HEAD" 'magit-uncommit-extend)

View File

@ -0,0 +1,24 @@
This package provides very basic support for TopGit.
TopGit is a patch queue manager that aims to make handling
of large amounts of interdependent topic branches easier.
For information about TopGit see https://github.com/greenrd/topgit.
When `magit-topgit-mode' is turned on then the list of TopGit
topics is displayed in the status buffer. While point is on such
a topic it can checked out using `RET' and discarded using `k'.
Other TopGit commands are available from the TopGit popup on `T'.
To enable the mode in a particular repository use:
cd /path/to/repository
git config --add magit.extension topgit
To enable the mode for all repositories use:
git config --global --add magit.extension topgit
To enable the mode globally without dropping to a shell:
(add-hook 'magit-mode-hook 'magit-topgit-mode)

View File

@ -0,0 +1,15 @@
;;; pcache-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("pcache.el") (22221 60696 480763 960000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; pcache-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "pcache" "20151109.639" "persistent caching for Emacs." '((eieio "1.3")))

View File

@ -0,0 +1,226 @@
;;; pcache.el --- persistent caching for Emacs.
;; Copyright (C) 2011 Yann Hodique
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; Package-Version: 20151109.639
;; Version: 0.3.2
;; Package-Requires: ((eieio "1.3"))
;; 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 2, 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 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:
;; pcache provides a persistent way of caching data, in a hashtable-like
;; structure. It relies on `eieio-persistent' in the backend, so that any
;; object that can be serialized by EIEIO can be stored with pcache.
;; pcache handles objects called "repositories" (`pcache-repository') and
;; "entries" (`pcache-entry'). Each repository is identified by a unique name,
;; that defines an entry in `pcache-directory'. Subdirectories are allowed, by
;; the use of a directory separator in the repository name.
;; Example:
;; (let ((repo (pcache-repository "plop")))
;; (pcache-put repo 'foo 42) ; store value 42 with key 'foo
;; (pcache-get repo 'foo) ; => 42
;; )
;; Keys can be pretty much any Lisp object, and are compared for equality using
;; `eql'
;; Optionally, cache entries can expire:
;; (let ((repo (pcache-repository "plop")))
;; (pcache-put repo 'foo 42 1) ; store value 42 with key 'foo for 1 second
;; (sleep-for 1)
;; (pcache-get repo 'foo) ; => nil
;; )
;;; Code:
(eval-when-compile
(require 'cl))
(require 'eieio)
(require 'eieio-base)
(defvar pcache-directory
(let ((dir (concat user-emacs-directory "var/pcache/")))
(make-directory dir t)
dir))
(defvar *pcache-repositories* (make-hash-table :test 'equal))
(defconst pcache-default-save-delay 300)
(defconst pcache-version-constant "0.3")
(defclass pcache-repository (eieio-persistent eieio-named)
((version :initarg :version :initform nil)
(version-constant :allocation :class)
(entries :initarg :entries :initform (make-hash-table))
(entry-cls :initarg :entry-cls :initform pcache-entry)
(timestamp :initarg :timestamp :initform (float-time (current-time)))
(save-delay :initarg :save-delay)))
(oset-default 'pcache-repository :save-delay pcache-default-save-delay)
(oset-default 'pcache-repository version-constant pcache-version-constant)
(defvar *pcache-repository-name* nil)
(defmethod constructor :static ((cache pcache-repository) &rest args)
(let* ((newname (or (and (stringp (car args)) (car args))
(plist-get args :object-name)
*pcache-repository-name*
(symbol-name cache)))
(e (gethash newname *pcache-repositories*))
(path (concat pcache-directory newname)))
(setq args (append args (list :object-name newname)))
(or e
(and (not (boundp 'pcache-avoid-recursion))
(file-exists-p path)
(condition-case nil
(let* ((pcache-avoid-recursion t)
(*pcache-repository-name* newname)
(obj (eieio-persistent-read path 'pcache-repository t)))
(and (or (equal (oref obj :version)
(oref-default (object-class obj) version-constant))
(error "wrong version"))
(puthash newname obj *pcache-repositories*)
obj))
(error nil)))
(let ((obj (call-next-method))
(dir (file-name-directory path)))
(unless (file-exists-p dir)
(make-directory dir t))
(oset obj :file path)
(puthash newname obj *pcache-repositories*)
obj))))
(defclass pcache-entry ()
((timestamp :initarg :timestamp
:initform (float-time (current-time)))
(ttl :initarg :ttl :initform nil)
(value :initarg :value :initform nil)))
(defmethod pcache-entry-valid-p ((entry pcache-entry))
(let ((ttl (oref entry :ttl)))
(or (null ttl)
(let ((time (float-time (current-time))))
(< time (+ ttl (oref entry :timestamp)))))))
(defmethod pcache-get ((cache pcache-repository) key &optional default)
(let* ((table (oref cache :entries))
(entry (gethash key table)))
(if entry
(if (pcache-entry-valid-p entry)
(oref entry :value)
(remhash key table)
default)
default)))
(defmethod pcache-has ((cache pcache-repository) key)
(let* ((default (make-symbol ":nil"))
(table (oref cache :entries))
(entry (gethash key table default)))
(if (eq entry default) nil
(if (pcache-entry-valid-p entry)
t nil))))
(defmethod pcache-put ((cache pcache-repository) key value &optional ttl)
(let ((table (oref cache :entries))
(entry (or (and (eieio-object-p value)
(object-of-class-p value 'pcache-entry)
value)
(make-instance (oref cache :entry-cls) :value value))))
(when ttl
(oset entry :ttl ttl))
(prog1
(puthash key entry table)
(pcache-save cache))))
(defmethod pcache-invalidate ((cache pcache-repository) key)
(let ((table (oref cache :entries)))
(remhash key table)
(pcache-save cache)))
(defmethod pcache-clear ((cache pcache-repository))
(let* ((entries (oref cache :entries))
(test (hash-table-test entries))
(resize (hash-table-rehash-size entries))
(threshold (hash-table-rehash-threshold entries))
(weakness (hash-table-weakness entries)))
(oset cache :entries (make-hash-table :test test :rehash-size resize
:rehash-threshold threshold
:weakness weakness)))
(pcache-save cache))
(defmethod pcache-purge-invalid ((cache pcache-repository))
(let ((table (oref cache :entries)))
(maphash #'(lambda (k e)
(unless (pcache-entry-valid-p e)
(remhash k table)))
table)
(pcache-save cache)))
(defmethod pcache-save ((cache pcache-repository) &optional force)
(let ((timestamp (oref cache :timestamp))
(delay (oref cache :save-delay))
(time (float-time (current-time))))
(when (or force (> time (+ timestamp delay)))
(oset cache :timestamp time)
;; make sure version is saved to file
(oset cache :version (oref-default (object-class cache) version-constant))
(eieio-persistent-save cache))))
(defmethod pcache-map ((cache pcache-repository) func)
(let ((table (oref cache :entries)))
(maphash func table)))
(defun pcache-kill-emacs-hook ()
(maphash #'(lambda (k v)
(condition-case nil
(pcache-purge-invalid v)
(error nil))
(condition-case nil
(pcache-save v t)
(error nil)))
*pcache-repositories*))
(defun pcache-destroy-repository (name)
(remhash name *pcache-repositories*)
(let ((fname (concat pcache-directory name)))
(when (file-exists-p fname)
(delete-file fname))))
(add-hook 'kill-emacs-hook 'pcache-kill-emacs-hook)
;; in case we reload in place, clean all repositories with invalid version
(let (to-clean)
(maphash #'(lambda (k v)
(condition-case nil
(unless (eql (oref v :version)
pcache-version-constant)
(signal 'error nil))
(error
(setq to-clean (cons k to-clean)))))
*pcache-repositories*)
(dolist (k to-clean)
(remhash k *pcache-repositories*)))
(provide 'pcache)
;;; pcache.el ends here

View File

@ -0,0 +1,15 @@
;;; s-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("s.el") (22221 60695 988837 699000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; s-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "s" "20160115.58" "The long lost Emacs string manipulation library." 'nil :keywords '("strings"))

618
elpa/s-20160115.58/s.el Normal file
View File

@ -0,0 +1,618 @@
;;; s.el --- The long lost Emacs string manipulation library.
;; Copyright (C) 2012-2015 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 1.10.0
;; Package-Version: 20160115.58
;; Keywords: strings
;; 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:
;; The long lost Emacs string manipulation library.
;;
;; See documentation on https://github.com/magnars/s.el#functions
;;; Code:
(require 'ucs-normalize)
(defun s-trim-left (s)
"Remove whitespace at the beginning of S."
(if (string-match "\\`[ \t\n\r]+" s)
(replace-match "" t t s)
s))
(defun s-trim-right (s)
"Remove whitespace at the end of S."
(if (string-match "[ \t\n\r]+\\'" s)
(replace-match "" t t s)
s))
(defun s-trim (s)
"Remove whitespace at the beginning and end of S."
(s-trim-left (s-trim-right s)))
(defun s-collapse-whitespace (s)
"Convert all adjacent whitespace characters to a single space."
(replace-regexp-in-string "[ \t\n\r]+" " " s))
(defun s-split (separator s &optional omit-nulls)
"Split S into substrings bounded by matches for regexp SEPARATOR.
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
This is a simple wrapper around the built-in `split-string'."
(split-string s separator omit-nulls))
(defun s-split-up-to (separator s n &optional omit-nulls)
"Split S up to N times into substrings bounded by matches for regexp SEPARATOR.
If OMIT-NULLS is non-nil, zero-length substrings are omitted.
See also `s-split'."
(save-match-data
(let ((op 0)
(r nil))
(with-temp-buffer
(insert s)
(setq op (goto-char (point-min)))
(while (and (re-search-forward separator nil t)
(< 0 n))
(let ((sub (buffer-substring-no-properties op (match-beginning 0))))
(unless (and omit-nulls
(equal sub ""))
(push sub r)))
(setq op (goto-char (match-end 0)))
(setq n (1- n)))
(let ((sub (buffer-substring-no-properties op (point-max))))
(unless (and omit-nulls
(equal sub ""))
(push sub r))))
(nreverse r))))
(defun s-lines (s)
"Splits S into a list of strings on newline characters."
(s-split "\\(\r\n\\|[\n\r]\\)" s))
(defun s-join (separator strings)
"Join all the strings in STRINGS with SEPARATOR in between."
(mapconcat 'identity strings separator))
(defun s-concat (&rest strings)
"Join all the string arguments into one string."
(apply 'concat strings))
(defun s-prepend (prefix s)
"Concatenate PREFIX and S."
(concat prefix s))
(defun s-append (suffix s)
"Concatenate S and SUFFIX."
(concat s suffix))
(defun s-repeat (num s)
"Make a string of S repeated NUM times."
(let (ss)
(while (> num 0)
(setq ss (cons s ss))
(setq num (1- num)))
(apply 'concat ss)))
(defun s-chop-suffix (suffix s)
"Remove SUFFIX if it is at end of S."
(let ((pos (- (length suffix))))
(if (and (>= (length s) (length suffix))
(string= suffix (substring s pos)))
(substring s 0 pos)
s)))
(defun s-chop-suffixes (suffixes s)
"Remove SUFFIXES one by one in order, if they are at the end of S."
(while suffixes
(setq s (s-chop-suffix (car suffixes) s))
(setq suffixes (cdr suffixes)))
s)
(defun s-chop-prefix (prefix s)
"Remove PREFIX if it is at the start of S."
(let ((pos (length prefix)))
(if (and (>= (length s) (length prefix))
(string= prefix (substring s 0 pos)))
(substring s pos)
s)))
(defun s-chop-prefixes (prefixes s)
"Remove PREFIXES one by one in order, if they are at the start of S."
(while prefixes
(setq s (s-chop-prefix (car prefixes) s))
(setq prefixes (cdr prefixes)))
s)
(defun s-shared-start (s1 s2)
"Returns the longest prefix S1 and S2 have in common."
(let ((search-length (min (length s1) (length s2)))
(i 0))
(while (and (< i search-length)
(= (aref s1 i) (aref s2 i)))
(setq i (1+ i)))
(substring s1 0 i)))
(defun s-shared-end (s1 s2)
"Returns the longest suffix S1 and S2 have in common."
(let* ((l1 (length s1))
(l2 (length s2))
(search-length (min l1 l2))
(i 0))
(while (and (< i search-length)
(= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))
(setq i (1+ i)))
;; If I is 0, then it means that there's no common suffix between
;; S1 and S2.
;;
;; However, since (substring s (- 0)) will return the whole
;; string, `s-shared-end' should simply return the empty string
;; when I is 0.
(if (zerop i)
""
(substring s1 (- i)))))
(defun s-chomp (s)
"Remove one trailing `\\n`, `\\r` or `\\r\\n` from S."
(s-chop-suffixes '("\n" "\r") s))
(defun s-truncate (len s)
"If S is longer than LEN, cut it down to LEN - 3 and add ... at the end."
(if (> (length s) len)
(format "%s..." (substring s 0 (- len 3)))
s))
(defun s-word-wrap (len s)
"If S is longer than LEN, wrap the words with newlines."
(with-temp-buffer
(insert s)
(let ((fill-column len))
(fill-region (point-min) (point-max)))
(buffer-substring-no-properties (point-min) (point-max))))
(defun s-center (len s)
"If S is shorter than LEN, pad it with spaces so it is centered."
(let ((extra (max 0 (- len (length s)))))
(concat
(make-string (ceiling extra 2) ? )
s
(make-string (floor extra 2) ? ))))
(defun s-pad-left (len padding s)
"If S is shorter than LEN, pad it with PADDING on the left."
(let ((extra (max 0 (- len (length s)))))
(concat (make-string extra (string-to-char padding))
s)))
(defun s-pad-right (len padding s)
"If S is shorter than LEN, pad it with PADDING on the right."
(let ((extra (max 0 (- len (length s)))))
(concat s
(make-string extra (string-to-char padding)))))
(defun s-left (len s)
"Returns up to the LEN first chars of S."
(if (> (length s) len)
(substring s 0 len)
s))
(defun s-right (len s)
"Returns up to the LEN last chars of S."
(let ((l (length s)))
(if (> l len)
(substring s (- l len) l)
s)))
(defun s-ends-with? (suffix s &optional ignore-case)
"Does S end with SUFFIX?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences.
Alias: `s-suffix?'"
(let ((start-pos (- (length s) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
s start-pos nil ignore-case)))))
(defalias 's-ends-with-p 's-ends-with?)
(defun s-starts-with? (prefix s &optional ignore-case)
"Does S start with PREFIX?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences.
Alias: `s-prefix?'. This is a simple wrapper around the built-in
`string-prefix-p'."
(string-prefix-p prefix s ignore-case))
(defalias 's-starts-with-p 's-starts-with?)
(defalias 's-suffix? 's-ends-with?)
(defalias 's-prefix? 's-starts-with?)
(defalias 's-suffix-p 's-ends-with?)
(defalias 's-prefix-p 's-starts-with?)
(defun s--truthy? (val)
(not (null val)))
(defun s-contains? (needle s &optional ignore-case)
"Does S contain NEEDLE?
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((case-fold-search ignore-case))
(s--truthy? (string-match-p (regexp-quote needle) s))))
(defalias 's-contains-p 's-contains?)
(defun s-equals? (s1 s2)
"Is S1 equal to S2?
This is a simple wrapper around the built-in `string-equal'."
(string-equal s1 s2))
(defalias 's-equals-p 's-equals?)
(defun s-less? (s1 s2)
"Is S1 less than S2?
This is a simple wrapper around the built-in `string-lessp'."
(string-lessp s1 s2))
(defalias 's-less-p 's-less?)
(defun s-matches? (regexp s &optional start)
"Does REGEXP match S?
If START is non-nil the search starts at that index.
This is a simple wrapper around the built-in `string-match-p'."
(s--truthy? (string-match-p regexp s start)))
(defalias 's-matches-p 's-matches?)
(defun s-blank? (s)
"Is S nil or the empty string?"
(or (null s) (string= "" s)))
(defun s-present? (s)
"Is S anything but nil or the empty string?"
(not (s-blank? s)))
(defun s-presence (s)
"Return S if it's `s-present?', otherwise return nil."
(and (s-present? s) s))
(defun s-lowercase? (s)
"Are all the letters in S in lower case?"
(let ((case-fold-search nil))
(not (string-match-p "[[:upper:]]" s))))
(defun s-uppercase? (s)
"Are all the letters in S in upper case?"
(let ((case-fold-search nil))
(not (string-match-p "[[:lower:]]" s))))
(defun s-mixedcase? (s)
"Are there both lower case and upper case letters in S?"
(let ((case-fold-search nil))
(s--truthy?
(and (string-match-p "[[:lower:]]" s)
(string-match-p "[[:upper:]]" s)))))
(defun s-capitalized? (s)
"In S, is the first letter upper case, and all other letters lower case?"
(let ((case-fold-search nil))
(s--truthy?
(string-match-p "^[[:upper:]][^[:upper:]]*$" s))))
(defun s-numeric? (s)
"Is S a number?"
(s--truthy?
(string-match-p "^[0-9]+$" s)))
(defun s-replace (old new s)
"Replaces OLD with NEW in S."
(replace-regexp-in-string (regexp-quote old) new s t t))
(defun s--aget (alist key)
(cdr (assoc key alist)))
(defun s-replace-all (replacements s)
"REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in S."
(replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
(lambda (it) (s--aget replacements it))
s))
(defun s-downcase (s)
"Convert S to lower case.
This is a simple wrapper around the built-in `downcase'."
(downcase s))
(defun s-upcase (s)
"Convert S to upper case.
This is a simple wrapper around the built-in `upcase'."
(upcase s))
(defun s-capitalize (s)
"Convert the first word's first character to upper case and the rest to lower case in S."
(concat (upcase (substring s 0 1)) (downcase (substring s 1))))
(defun s-titleize (s)
"Convert each word's first character to upper case and the rest to lower case in S.
This is a simple wrapper around the built-in `capitalize'."
(capitalize s))
(defmacro s-with (s form &rest more)
"Threads S through the forms. Inserts S as the last item
in the first form, making a list of it if it is not a list
already. If there are more forms, inserts the first form as the
last item in second form, etc."
(declare (debug (form &rest [&or (function &rest form) fboundp])))
(if (null more)
(if (listp form)
`(,(car form) ,@(cdr form) ,s)
(list form s))
`(s-with (s-with ,s ,form) ,@more)))
(put 's-with 'lisp-indent-function 1)
(defun s-index-of (needle s &optional ignore-case)
"Returns first index of NEEDLE in S, or nil.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((case-fold-search ignore-case))
(string-match-p (regexp-quote needle) s)))
(defun s-reverse (s)
"Return the reverse of S."
(if (multibyte-string-p s)
(let ((input (string-to-list s))
(output ()))
(while input
;; Handle entire grapheme cluster as a single unit
(let ((grapheme (list (pop input))))
(while (memql (car input) ucs-normalize-combining-chars)
(push (pop input) grapheme))
(setq output (nconc (nreverse grapheme) output))))
(concat output))
(concat (nreverse (string-to-list s)))))
(defun s-match-strings-all (regex string)
"Return a list of matches for REGEX in STRING.
Each element itself is a list of matches, as per
`match-string'. Multiple matches at the same position will be
ignored after the first."
(let ((all-strings ())
(i 0))
(while (and (< i (length string))
(string-match regex string i))
(setq i (1+ (match-beginning 0)))
(let (strings
(num-matches (/ (length (match-data)) 2))
(match 0))
(while (/= match num-matches)
(push (match-string match string) strings)
(setq match (1+ match)))
(push (nreverse strings) all-strings)))
(nreverse all-strings)))
(defun s-matched-positions-all (regexp string &optional subexp-depth)
"Return a list of matched positions for REGEXP in STRING.
SUBEXP-DEPTH is 0 by default."
(if (null subexp-depth)
(setq subexp-depth 0))
(let ((pos 0) result)
(while (and (string-match regexp string pos)
(< pos (length string)))
(let ((m (match-end subexp-depth)))
(push (cons (match-beginning subexp-depth) (match-end subexp-depth)) result)
(setq pos m)))
(nreverse result)))
(defun s-match (regexp s &optional start)
"When the given expression matches the string, this function returns a list
of the whole matching string and a string for each matched subexpressions.
If it did not match the returned value is an empty list (nil).
When START is non-nil the search will start at that index."
(save-match-data
(if (string-match regexp s start)
(let ((match-data-list (match-data))
result)
(while match-data-list
(let* ((beg (car match-data-list))
(end (cadr match-data-list))
(subs (if (and beg end) (substring s beg end) nil)))
(setq result (cons subs result))
(setq match-data-list
(cddr match-data-list))))
(nreverse result)))))
(defun s-slice-at (regexp s)
"Slices S up at every index matching REGEXP."
(save-match-data
(let (i)
(setq i (string-match regexp s 1))
(if i
(cons (substring s 0 i)
(s-slice-at regexp (substring s i)))
(list s)))))
(defun s-split-words (s)
"Split S into list of words."
(s-split
"[^[:word:]0-9]+"
(let ((case-fold-search nil))
(replace-regexp-in-string
"\\([[:lower:]]\\)\\([[:upper:]]\\)" "\\1 \\2"
(replace-regexp-in-string "\\([[:upper:]]\\)\\([[:upper:]][0-9[:lower:]]\\)" "\\1 \\2" s)))
t))
(defun s--mapcar-head (fn-head fn-rest list)
"Like MAPCAR, but applies a different function to the first element."
(if list
(cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))
(defun s-lower-camel-case (s)
"Convert S to lowerCamelCase."
(s-join "" (s--mapcar-head 'downcase 'capitalize (s-split-words s))))
(defun s-upper-camel-case (s)
"Convert S to UpperCamelCase."
(s-join "" (mapcar 'capitalize (s-split-words s))))
(defun s-snake-case (s)
"Convert S to snake_case."
(s-join "_" (mapcar 'downcase (s-split-words s))))
(defun s-dashed-words (s)
"Convert S to dashed-words."
(s-join "-" (mapcar 'downcase (s-split-words s))))
(defun s-capitalized-words (s)
"Convert S to Capitalized words."
(let ((words (s-split-words s)))
(s-join " " (cons (capitalize (car words)) (mapcar 'downcase (cdr words))))))
(defun s-titleized-words (s)
"Convert S to Titleized Words."
(s-join " " (mapcar 's-titleize (s-split-words s))))
(defun s-word-initials (s)
"Convert S to its initials."
(s-join "" (mapcar (lambda (ss) (substring ss 0 1))
(s-split-words s))))
;; Errors for s-format
(progn
(put 's-format-resolve
'error-conditions
'(error s-format s-format-resolve))
(put 's-format-resolve
'error-message
"Cannot resolve a template to values"))
(defun s-format (template replacer &optional extra)
"Format TEMPLATE with the function REPLACER.
REPLACER takes an argument of the format variable and optionally
an extra argument which is the EXTRA value from the call to
`s-format'.
Several standard `s-format' helper functions are recognized and
adapted for this:
(s-format \"${name}\" 'gethash hash-table)
(s-format \"${name}\" 'aget alist)
(s-format \"$0\" 'elt sequence)
The REPLACER function may be used to do any other kind of
transformation."
(let ((saved-match-data (match-data)))
(unwind-protect
(replace-regexp-in-string
"\\$\\({\\([^}]+\\)}\\|[0-9]+\\)"
(lambda (md)
(let ((var
(let ((m (match-string 2 md)))
(if m m
(string-to-number (match-string 1 md)))))
(replacer-match-data (match-data)))
(unwind-protect
(let ((v
(cond
((eq replacer 'gethash)
(funcall replacer var extra))
((eq replacer 'aget)
(funcall 's--aget extra var))
((eq replacer 'elt)
(funcall replacer extra var))
(t
(set-match-data saved-match-data)
(if extra
(funcall replacer var extra)
(funcall replacer var))))))
(if v v (signal 's-format-resolve md)))
(set-match-data replacer-match-data)))) template
;; Need literal to make sure it works
t t)
(set-match-data saved-match-data))))
(defvar s-lex-value-as-lisp nil
"If `t' interpolate lisp values as lisp.
`s-lex-format' inserts values with (format \"%S\").")
(defun s-lex-fmt|expand (fmt)
"Expand FMT into lisp."
(list 's-format fmt (quote 'aget)
(append '(list)
(mapcar
(lambda (matches)
(list
'cons
(cadr matches)
`(format
(if s-lex-value-as-lisp "%S" "%s")
,(intern (cadr matches)))))
(s-match-strings-all "${\\([^}]+\\)}" fmt)))))
(defmacro s-lex-format (format-str)
"`s-format` with the current environment.
FORMAT-STR may use the `s-format' variable reference to refer to
any variable:
(let ((x 1))
(s-lex-format \"x is: ${x}\"))
The values of the variables are interpolated with \"%s\" unless
the variable `s-lex-value-as-lisp' is `t' and then they are
interpolated with \"%S\"."
(declare (debug (form)))
(s-lex-fmt|expand format-str))
(defun s-count-matches (regexp s &optional start end)
"Count occurrences of `regexp' in `s'.
`start', inclusive, and `end', exclusive, delimit the part of `s'
to match. "
(with-temp-buffer
(insert s)
(goto-char (point-min))
(count-matches regexp (or start 1) (or end (point-max)))))
(defun s-wrap (s prefix &optional suffix)
"Wrap string S with PREFIX and optionally SUFFIX.
Return string S with PREFIX prepended. If SUFFIX is present, it
is appended, otherwise PREFIX is used as both prefix and
suffix."
(concat prefix s (or suffix prefix)))
(provide 's)
;;; s.el ends here

View File

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" 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
* With-Editor: (with-editor). Using the Emacsclient as $EDITOR.

View File

@ -0,0 +1,16 @@
;;; with-editor-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("with-editor-pkg.el" "with-editor.el")
;;;;;; (22221 60698 212139 491000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; with-editor-autoloads.el ends here

View File

@ -0,0 +1,9 @@
(define-package "with-editor" "20160223.1155" "Use the Emacsclient as $EDITOR"
'((emacs "24.4")
(async "1.5")
(dash "2.12.1"))
:url "https://github.com/magit/with-editor" :keywords
'("tools"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -0,0 +1,732 @@
;;; with-editor.el --- Use the Emacsclient as $EDITOR -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 The Magit Project Contributors
;;
;; You should have received a copy of the AUTHORS.md file. If not,
;; see https://github.com/magit/with-editor/blob/master/AUTHORS.md.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Package-Requires: ((emacs "24.4") (async "1.5") (dash "2.12.1"))
;; Keywords: tools
;; Homepage: https://github.com/magit/with-editor
;; 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 Magit. If not, see http://www.gnu.org/licenses.
;;; Commentary:
;; This library makes it possible to reliably use the Emacsclient as
;; the `$EDITOR' of child processes. It makes sure that they know how
;; to call home. For remote processes a substitute is provided, which
;; communicates with Emacs on standard output/input instead of using a
;; socket as the Emacsclient does.
;; It provides the commands `with-editor-async-shell-command' and
;; `with-editor-shell-command', which are intended as replacements
;; for `async-shell-command' and `shell-command'. They automatically
;; export `$EDITOR' making sure the executed command uses the current
;; Emacs instance as "the editor". With a prefix argument these
;; commands prompt for an alternative environment variable such as
;; `$GIT_EDITOR'. To always use these variants add this to your init
;; file:
;;
;; (define-key (current-global-map)
;; [remap async-shell-command] 'with-editor-async-shell-command)
;; (define-key (current-global-map)
;; [remap shell-command] 'with-editor-shell-command)
;; Alternatively use the global `shell-command-with-editor-mode',
;; which always sets `$EDITOR' for all Emacs commands which ultimately
;; use `shell-command' to asynchronously run some shell command.
;; The command `with-editor-export-editor' exports `$EDITOR' or
;; another such environment variable in `shell-mode', `term-mode' and
;; `eshell-mode' buffers. Use this Emacs command before executing a
;; shell command which needs the editor set, or always arrange for the
;; current Emacs instance to be used as editor by adding it to the
;; appropriate mode hooks:
;;
;; (add-hook 'shell-mode-hook 'with-editor-export-editor)
;; (add-hook 'term-mode-hook 'with-editor-export-editor)
;; (add-hook 'eshell-mode-hook 'with-editor-export-editor)
;; Some variants of this function exist, these two forms are
;; equivalent:
;;
;; (add-hook 'shell-mode-hook
;; (apply-partially 'with-editor-export-editor "GIT_EDITOR"))
;; (add-hook 'shell-mode-hook 'with-editor-export-git-editor)
;; This library can also be used by other packages which need to use
;; the current Emacs instance as editor. In fact this library was
;; written for Magit and its `git-commit-mode' and `git-rebase-mode'.
;; Consult `git-rebase.el' and the related code in `magit-sequence.el'
;; for a simple example.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'server)
(require 'tramp)
(require 'tramp-sh nil t)
(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
(progn (require 'dired nil t)
(require 'eshell nil t)
(require 'term nil t)
(require 'warnings nil t)))
(declare-function dired-get-filename 'dired)
(declare-function term-emulate-terminal 'term)
(defvar eshell-preoutput-filter-functions)
;;; Options
(defgroup with-editor nil
"Use the Emacsclient as $EDITOR."
:group 'external
:group 'server)
(defun with-editor-locate-emacsclient ()
"Search for a suitable Emacsclient executable."
(--if-let (with-editor-locate-emacsclient-1 (with-editor-emacsclient-path) 3)
it
(display-warning 'with-editor (format "\
Cannot determine a suitable Emacsclient
Determining an Emacsclient executable suitable for the
current Emacs instance failed. For more information
please see https://github.com/magit/magit/wiki/Emacsclient."))
nil))
(defun with-editor-locate-emacsclient-1 (path depth)
(let* ((version-lst (-take depth (split-string emacs-version "\\.")))
(version-reg (concat "^" (mapconcat #'identity version-lst "\\."))))
(or (locate-file-internal
"emacsclient" path
(cl-mapcan
(lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes))
(nconc (cl-mapcon (lambda (v)
(setq v (mapconcat #'identity (reverse v) "."))
(list v (concat "-" v) (concat ".emacs" v)))
(reverse version-lst))
(list "" "-snapshot")))
(lambda (exec)
(ignore-errors
(string-match-p version-reg
(with-editor-emacsclient-version exec)))))
(and (> depth 1)
(with-editor-locate-emacsclient-1 path (1- depth))))))
(defun with-editor-emacsclient-version (exec)
(-when-let (1st-line (car (process-lines exec "--version")))
(cadr (split-string 1st-line))))
(defun with-editor-emacsclient-path ()
(let ((path exec-path))
(when invocation-directory
(push (directory-file-name invocation-directory) path)
(let* ((linkname (expand-file-name invocation-name invocation-directory))
(truename (file-chase-links linkname)))
(unless (equal truename linkname)
(push (directory-file-name (file-name-directory truename)) path)))
(when (eq system-type 'darwin)
(let ((dir (expand-file-name "bin" invocation-directory)))
(when (file-directory-p dir)
(push dir path)))
(when (string-match-p "Cellar" invocation-directory)
(let ((dir (expand-file-name "../../../bin" invocation-directory)))
(when (file-directory-p dir)
(push dir path))))))
(cl-remove-duplicates path :test 'equal)))
(defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient)
"The Emacsclient executable used by the `with-editor' macro."
:group 'with-editor
:type '(choice (string :tag "Executable")
(const :tag "Don't use Emacsclient" nil)))
(defcustom with-editor-sleeping-editor "\
sh -c '\
echo \"WITH-EDITOR: $$ OPEN $0\"; \
sleep 604800 & sleep=$!; \
trap \"kill $sleep; exit 0\" USR1; \
trap \"kill $sleep; exit 1\" USR2; \
wait $sleep'"
"The sleeping editor, used when the Emacsclient cannot be used.
This fallback is used for asynchronous process started inside the
macro `with-editor', when the process runs on a remote machine or
for local processes when `with-editor-emacsclient-executable' is
nil (i.e. when no suitable Emacsclient was found, or the user
decided not to use it).
Where the latter uses a socket to communicate with Emacs' server,
this substitute prints edit requests to its standard output on
which a process filter listens for such requests. As such it is
not a complete substitute for a proper Emacsclient, it can only
be used as $EDITOR of child process of the current Emacs instance."
:group 'with-editor
:type 'string)
(defcustom with-editor-finish-query-functions nil
"List of functions called to query before finishing session.
The buffer in question is current while the functions are called.
If any of them returns nil, then the session is not finished 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 that and return non-nil."
:group 'with-editor
:type 'hook)
(put 'with-editor-finish-query-functions 'permanent-local t)
(defcustom with-editor-cancel-query-functions nil
"List of functions called to query before canceling session.
The buffer in question is current while the functions are called.
If any of them returns nil, then the session is not canceled 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 canceling the session despite issues. Functions should
usually honor that and return non-nil."
:group 'with-editor
:type 'hook)
(put 'with-editor-cancel-query-functions 'permanent-local t)
(defcustom with-editor-mode-lighter " WE"
"The mode-line lighter of the With-Editor mode."
:group 'with-editor
:type '(choice (const :tag "No lighter" "") string))
(defvar with-editor-server-window-alist nil
"Alist of filename patterns vs corresponding `server-window'.
Each element looks like (REGEXP . FUNCTION). Files matching
REGEXP are selected using FUNCTION instead of the default in
`server-window'.
Note that when a package adds an entry here then it probably
has a reason to disrespect `server-window' and it likely is
not a good idea to change such entries.")
;;; Mode Commands
(defvar with-editor-pre-finish-hook nil)
(defvar with-editor-pre-cancel-hook nil)
(defvar with-editor-post-finish-hook nil)
(defvar with-editor-post-finish-hook-1 nil)
(defvar with-editor-post-cancel-hook nil)
(defvar with-editor-post-cancel-hook-1 nil)
(defvar with-editor-cancel-alist nil)
(put 'with-editor-pre-finish-hook 'permanent-local t)
(put 'with-editor-pre-cancel-hook 'permanent-local t)
(put 'with-editor-post-finish-hook 'permanent-local t)
(put 'with-editor-post-cancel-hook 'permanent-local t)
(defvar with-editor-show-usage t)
(defvar with-editor-cancel-message nil)
(defvar with-editor-previous-winconf nil)
(make-variable-buffer-local 'with-editor-show-usage)
(make-variable-buffer-local 'with-editor-cancel-message)
(make-variable-buffer-local 'with-editor-previous-winconf)
(put 'with-editor-cancel-message 'permanent-local t)
(put 'with-editor-previous-winconf 'permanent-local t)
(defvar-local with-editor--pid nil "For internal use.")
(put 'with-editor--pid 'permanent-local t)
(defun with-editor-finish (force)
"Finish the current edit session."
(interactive "P")
(when (run-hook-with-args-until-failure
'with-editor-finish-query-functions force)
(let ((with-editor-post-finish-hook-1
(ignore-errors (delq t with-editor-post-finish-hook))))
(run-hooks 'with-editor-pre-finish-hook)
(with-editor-return nil)
(accept-process-output nil 0.1)
(run-hooks 'with-editor-post-finish-hook-1))))
(defun with-editor-cancel (force)
"Cancel the current edit session."
(interactive "P")
(when (run-hook-with-args-until-failure
'with-editor-cancel-query-functions force)
(let ((message with-editor-cancel-message))
(when (functionp message)
(setq message (funcall message)))
(let ((with-editor-post-cancel-hook-1
(ignore-errors (delq t with-editor-post-cancel-hook)))
(with-editor-cancel-alist nil))
(run-hooks 'with-editor-pre-cancel-hook)
(with-editor-return t)
(accept-process-output nil 0.1)
(run-hooks 'with-editor-post-cancel-hook-1))
(message (or message "Canceled by user")))))
(defun with-editor-return (cancel)
(let ((winconf with-editor-previous-winconf)
(clients server-buffer-clients)
(dir default-directory)
(pid with-editor--pid))
(remove-hook 'kill-buffer-query-functions
'with-editor-kill-buffer-noop t)
(cond (cancel
(save-buffer)
(if clients
(dolist (client clients)
(ignore-errors
(server-send-string client "-error Canceled by user"))
(delete-process client))
;; Fallback for when emacs was used as $EDITOR instead
;; of emacsclient or the sleeping editor. See #2258.
(ignore-errors (delete-file buffer-file-name))
(kill-buffer)))
(t
(save-buffer)
(if clients
;; Don't use `server-edit' because we do not want to show
;; another buffer belonging to another client. See #2197.
(server-done)
(kill-buffer))))
(when pid
(let ((default-directory dir))
(process-file "kill" nil nil nil
"-s" (if cancel "USR2" "USR1") pid)))
(when (and winconf (eq (window-configuration-frame winconf)
(selected-frame)))
(set-window-configuration winconf))))
;;; Mode
(defvar with-editor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'with-editor-finish)
(define-key map [remap server-edit] 'with-editor-finish)
(define-key map [remap evil-save-and-close] 'with-editor-finish)
(define-key map [remap evil-save-modified-and-close] 'with-editor-finish)
(define-key map "\C-c\C-k" 'with-editor-cancel)
(define-key map [remap kill-buffer] 'with-editor-cancel)
(define-key map [remap ido-kill-buffer] 'with-editor-cancel)
(define-key map [remap iswitchb-kill-buffer] 'with-editor-cancel)
(define-key map [remap evil-quit] 'with-editor-cancel)
map))
(define-minor-mode with-editor-mode
"Edit a file as the $EDITOR of an external process."
:lighter with-editor-mode-lighter
;; Protect the user from killing the buffer without using
;; either `with-editor-finish' or `with-editor-cancel',
;; and from removing the key bindings for these commands.
(unless with-editor-mode
(error "With-Editor mode cannot be turned off"))
(add-hook 'kill-buffer-query-functions
'with-editor-kill-buffer-noop nil t)
;; `server-execute' displays a message which is not
;; correct when using this mode.
(when with-editor-show-usage
(with-editor-usage-message)))
(put 'with-editor-mode 'permanent-local t)
(defun with-editor-kill-buffer-noop ()
(message (substitute-command-keys "\
Don't kill this buffer. Instead cancel using \\[with-editor-cancel]")))
(defun with-editor-usage-message ()
;; Run after `server-execute', which is run using
;; a timer which starts immediately.
(run-with-timer
0.01 nil `(lambda ()
(with-current-buffer ,(current-buffer)
(message (substitute-command-keys "\
Type \\[with-editor-finish] to finish, \
or \\[with-editor-cancel] to cancel"))))))
;;; Wrappers
(defvar with-editor--envvar nil "For internal use.")
(defmacro with-editor (&rest body)
"Use the Emacsclient as $EDITOR while evaluating BODY.
Modify the `process-environment' for processes started in BODY,
instructing them to use the Emacsclient as $EDITOR. If optional
ENVVAR is provided then bind that environment variable instead.
\n(fn [ENVVAR] BODY...)"
(declare (indent defun) (debug (body)))
`(let ((with-editor--envvar ,(if (stringp (car body))
(pop body)
'(or with-editor--envvar "EDITOR")))
(process-environment process-environment))
(if (or (not with-editor-emacsclient-executable)
(file-remote-p default-directory))
(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
process-environment)
;; Make sure server-use-tcp's value is valid.
(unless (featurep 'make-network-process '(:family local))
(setq server-use-tcp t))
;; Make sure the server is running.
(unless server-process
(when (server-running-p server-name)
(setq server-name (format "server%s" (emacs-pid)))
(when (server-running-p server-name)
(server-force-delete server-name)))
(server-start))
;; Tell $EDITOR to use the Emacsclient.
(push (concat with-editor--envvar "="
(shell-quote-argument with-editor-emacsclient-executable)
;; Tell the process where the server file is.
(and (not server-use-tcp)
(concat " --socket-name="
(shell-quote-argument
(expand-file-name server-name
server-socket-dir)))))
process-environment)
(when server-use-tcp
(push (concat "EMACS_SERVER_FILE="
(expand-file-name server-name server-auth-dir))
process-environment))
;; As last resort fallback to the sleeping editor.
(push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor)
process-environment))
,@body))
(defun with-editor-server-window ()
(or (and buffer-file-name
(cdr (--first (string-match-p (car it) buffer-file-name)
with-editor-server-window-alist)))
server-window))
(defun server-switch-buffer--with-editor-server-window-alist
(fn &optional next-buffer killed-one filepos)
"Honor `with-editor-server-window-alist' (which see)."
(let ((server-window (with-current-buffer
(or next-buffer (current-buffer))
(when with-editor-mode
(setq with-editor-previous-winconf
(current-window-configuration)))
(with-editor-server-window))))
(funcall fn next-buffer killed-one filepos)))
(advice-add 'server-switch-buffer :around
'server-switch-buffer--with-editor-server-window-alist)
(defun start-file-process--with-editor-process-filter
(fn name buffer program &rest program-args)
"When called inside a `with-editor' form and the Emacsclient
cannot be used, then give the process the filter function
`with-editor-process-filter'. To avoid overriding the filter
being added here you should use `with-editor-set-process-filter'
instead of `set-process-filter' inside `with-editor' forms.
When the `default-directory' is located on a remote machine,
then also manipulate PROGRAM and PROGRAM-ARGS in order to set
the appropriate editor environment variable."
(if (not with-editor--envvar)
(apply fn name buffer program program-args)
(when (file-remote-p default-directory)
(unless (equal program "env")
(push program program-args)
(setq program "env"))
(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
program-args))
(let ((process (apply fn name buffer program program-args)))
(set-process-filter process 'with-editor-process-filter)
(process-put process 'default-dir default-directory)
process)))
(advice-add 'start-file-process :around
'start-file-process--with-editor-process-filter)
(defun with-editor-set-process-filter (process filter)
"Like `set-process-filter' but keep `with-editor-process-filter'.
Give PROCESS the new FILTER but keep `with-editor-process-filter'
if that was added earlier by the adviced `start-file-process'.
Do so by wrapping the two filter functions using a lambda, which
becomes the actual filter. It calls `with-editor-process-filter'
first, passing t as NO-STANDARD-FILTER. Then it calls FILTER,
which may or may not insert the text into the PROCESS' buffer."
(set-process-filter
process
(if (eq (process-filter process) 'with-editor-process-filter)
`(lambda (proc str)
(,filter proc str)
(with-editor-process-filter proc str t))
filter)))
(defvar with-editor-filter-visit-hook nil)
(defun with-editor-output-filter (string)
(save-match-data
(if (string-match "^WITH-EDITOR: \\([0-9]+\\) OPEN \\(.+?\\)\r?$" string)
(let ((pid (match-string 1 string))
(file (match-string 2 string)))
(with-current-buffer
(find-file-noselect
(if (file-name-absolute-p file)
(if (tramp-tramp-file-p default-directory)
(with-parsed-tramp-file-name default-directory nil
(tramp-make-tramp-file-name method user host file hop))
file)
(expand-file-name file)))
(with-editor-mode 1)
(setq with-editor--pid pid)
(run-hooks 'with-editor-filter-visit-hook)
(funcall (or (with-editor-server-window) 'switch-to-buffer)
(current-buffer))
(kill-local-variable 'server-window))
nil)
string)))
(defun with-editor-process-filter
(process string &optional no-default-filter)
"Listen for edit requests by child processes."
(let ((default-directory (process-get process 'default-dir)))
(with-editor-output-filter string))
(unless no-default-filter
(internal-default-process-filter process string)))
;;; Augmentations
(cl-defun with-editor-export-editor (&optional (envvar "EDITOR"))
"Teach subsequent commands to use current Emacs instance as editor.
Set and export the environment variable ENVVAR, by default
\"EDITOR\". The value is automatically generated to teach
commands use the current Emacs instance as \"the editor\".
This works in `shell-mode', `term-mode' and `eshell-mode'."
(interactive (list (with-editor-read-envvar)))
(cond
((derived-mode-p 'comint-mode 'term-mode)
(let* ((process (get-buffer-process (current-buffer)))
(filter (process-filter process)))
(set-process-filter process 'ignore)
(goto-char (process-mark process))
(process-send-string
process (format "export %s=%s\n" envvar
(shell-quote-argument with-editor-sleeping-editor)))
(while (accept-process-output process 0.1))
(set-process-filter process filter)
(if (derived-mode-p 'term-mode)
(with-editor-set-process-filter process 'with-editor-emulate-terminal)
(add-hook 'comint-output-filter-functions 'with-editor-output-filter
nil t))))
((derived-mode-p 'eshell-mode)
(add-to-list 'eshell-preoutput-filter-functions
'with-editor-output-filter)
(setenv envvar with-editor-sleeping-editor))
(t
(error "Cannot export environment variables in this buffer")))
(message "Successfully exported %s" envvar))
(defun with-editor-export-git-editor ()
"Like `with-editor-export-editor' but always set `$GIT_EDITOR'."
(interactive)
(with-editor-export-editor "GIT_EDITOR"))
(defun with-editor-export-hg-editor ()
"Like `with-editor-export-editor' but always set `$HG_EDITOR'."
(interactive)
(with-editor-export-editor "HG_EDITOR"))
(defun with-editor-emulate-terminal (process string)
"Like `term-emulate-terminal' but also handle edit requests."
(when (with-editor-output-filter string)
(term-emulate-terminal process string)))
(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR"))
(cl-defun with-editor-read-envvar
(&optional (prompt "Set environment variable")
(default "EDITOR"))
(let ((reply (completing-read (if default
(format "%s (%s): " prompt default)
(concat prompt ": "))
with-editor-envvars nil nil nil nil default)))
(if (string= reply "") (user-error "Nothing selected") reply)))
(define-minor-mode shell-command-with-editor-mode
"Teach `shell-command' to use current Emacs instance as editor.
Teach `shell-command', and all commands that ultimately call that
command, to use the current Emacs instance as editor by executing
\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\".
CLIENT is automatically generated; EDITOR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming no other variable overrides the effect of \"$EDITOR\".
CLIENT may be the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Alternatively you can use the `with-editor-async-shell-command',
which also allows the use of another variable instead of
\"EDITOR\"."
:global t)
(defun with-editor-async-shell-command
(command &optional output-buffer error-buffer envvar)
"Like `async-shell-command' but with `$EDITOR' set.
Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell;
display output, if any. With a prefix argument prompt for an
environment variable, otherwise the default \"EDITOR\" variable
is used. With a negative prefix argument additionally insert
the COMMAND's output at point.
CLIENT is automatically generated; ENVVAR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming it respects ENVVAR as an \"EDITOR\"-like variable.
CLIENT maybe the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Also see `async-shell-command' and `shell-command'."
(interactive (with-editor-shell-command-read-args "Async shell command: " t))
(let ((with-editor--envvar envvar))
(with-editor
(async-shell-command command output-buffer error-buffer))))
(defun with-editor-shell-command
(command &optional output-buffer error-buffer envvar)
"Like `shell-command' or `with-editor-async-shell-command'.
If COMMAND ends with \"&\" behave like the latter,
else like the former."
(interactive (with-editor-shell-command-read-args "Shell command: "))
(if (string-match "&[ \t]*\\'" command)
(with-editor-async-shell-command
command output-buffer error-buffer envvar)
(shell-command command output-buffer error-buffer)))
(defun with-editor-shell-command-read-args (prompt &optional async)
(let ((command (read-shell-command
prompt nil nil
(--when-let (or buffer-file-name
(and (eq major-mode 'dired-mode)
(dired-get-filename nil t)))
(file-relative-name it)))))
(list command
(if (or async (setq async (string-match-p "&[ \t]*\\'" command)))
(< (prefix-numeric-value current-prefix-arg) 0)
current-prefix-arg)
shell-command-default-error-buffer
(and async current-prefix-arg (with-editor-read-envvar)))))
(defun shell-command--shell-command-with-editor-mode
(fn command &optional output-buffer error-buffer)
(cond ((or (not (or with-editor--envvar shell-command-with-editor-mode))
(not (string-match-p "&\\'" command)))
(funcall fn command output-buffer error-buffer))
((and with-editor-emacsclient-executable
(not (file-remote-p default-directory)))
(with-editor (funcall fn command output-buffer error-buffer)))
(t
(apply fn (format "%s=%s %s"
(or with-editor--envvar "EDITOR")
(shell-quote-argument with-editor-sleeping-editor)
command)
output-buffer error-buffer)
(ignore-errors
(let ((process (get-buffer-process
(or output-buffer
(get-buffer "*Async Shell Command*")))))
(set-process-filter
process (lambda (proc str)
(comint-output-filter proc str)
(with-editor-process-filter proc str t)))
process)))))
(advice-add 'shell-command :around
'shell-command--shell-command-with-editor-mode)
;;; with-editor.el ends soon
(defun with-editor-debug ()
"Debug configuration issues.
See `with-editor.info' for instructions."
(interactive)
(with-current-buffer (get-buffer-create "*with-editor-debug*")
(pop-to-buffer (current-buffer))
(erase-buffer)
(ignore-errors (with-editor))
(insert
(format "with-editor: %s\n" (locate-library "with-editor.el"))
(format "emacs: %s (%s)\n"
(expand-file-name invocation-name invocation-directory)
emacs-version)
"system:\n"
(format " system-type: %s\n" system-type)
(format " system-configuration: %s\n" system-configuration)
(format " system-configuration-options: %s\n" system-configuration-options)
"server:\n"
(format " server-running-p: %s\n" (server-running-p))
(format " server-process: %S\n" server-process)
(format " server-use-tcp: %s\n" server-use-tcp)
(format " server-name: %s\n" server-name)
(format " server-socket-dir: %s\n" server-socket-dir))
(if (and server-socket-dir (file-accessible-directory-p server-socket-dir))
(--each (directory-files server-socket-dir nil "^[^.]")
(insert (format " %s\n" it)))
(insert (format " %s: not an accessible directory\n"
(if server-use-tcp "WARNING" "ERROR"))))
(insert (format " server-auth-dir: %s\n" server-auth-dir))
(if (file-accessible-directory-p server-auth-dir)
(--each (directory-files server-auth-dir nil "^[^.]")
(insert (format " %s\n" it)))
(insert (format " %s: not an accessible directory\n"
(if server-use-tcp "ERROR" "WARNING"))))
(let ((val with-editor-emacsclient-executable)
(def (default-value 'with-editor-emacsclient-executable))
(fun (let ((warning-minimum-level :error)
(warning-minimum-log-level :error))
(with-editor-locate-emacsclient))))
(insert "magit-emacsclient-executable:\n"
(format " value: %s (%s)\n" val
(and val (with-editor-emacsclient-version val)))
(format " default: %s (%s)\n" def
(and def (with-editor-emacsclient-version def)))
(format " funcall: %s (%s)\n" fun
(and fun (with-editor-emacsclient-version fun)))))
(insert "path:\n"
(format " $PATH: %S\n" (getenv "PATH"))
(format " exec-path: %s\n" exec-path))
(insert (format " with-editor-emacsclient-path:\n"))
(--each (with-editor-emacsclient-path)
(insert (format " %s (%s)\n" it (car (file-attributes it))))
(when (file-directory-p it)
(dolist (exec (directory-files it t "emacsclient"))
(insert (format " %s (%s)\n" exec
(with-editor-emacsclient-version exec))))))))
(defconst with-editor-font-lock-keywords
'(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face))))
(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords)
(provide 'with-editor)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; with-editor.el ends here

View File

@ -0,0 +1,323 @@
This is with-editor.info, produced by makeinfo version 5.2 from
with-editor.texi.
The library with-editor makes it easy to use the Emacsclient as the
$EDITOR of child processes, making sure they know how to call home.
For remote processes a substitute is provided, which communicates with
Emacs on standard output instead of using a socket as the Emacsclient
does.
This library was written because Magit has to be able to do the above
to allow the user to edit commit messages gracefully and to edit rebase
sequences, which wouldnt be possible at all otherwise.
Because other packages can benefit from such functionality, this
library is made available as a separate package. It also defines some
additional functionality which makes it useful even for end-users, who
dont use Magit or another package which uses it internally.
Copyright (C) 2015-2016 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document 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 document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* With-Editor: (with-editor). Using the Emacsclient as $EDITOR.
END-INFO-DIR-ENTRY

File: with-editor.info, Node: Top, Next: Using the With-Editor package, Up: (dir)
With-Editor User Manual
***********************
The library with-editor makes it easy to use the Emacsclient as the
$EDITOR of child processes, making sure they know how to call home.
For remote processes a substitute is provided, which communicates with
Emacs on standard output instead of using a socket as the Emacsclient
does.
This library was written because Magit has to be able to do the above
to allow the user to edit commit messages gracefully and to edit rebase
sequences, which wouldnt be possible at all otherwise.
Because other packages can benefit from such functionality, this
library is made available as a separate package. It also defines some
additional functionality which makes it useful even for end-users, who
dont use Magit or another package which uses it internally.
Copyright (C) 2015-2016 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document 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 document 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.
* Menu:
* Using the With-Editor package::
* Using With-Editor as a library::
* Debugging::
— The Detailed Node Listing —
Using the With-Editor package
* Configuring With-Editor::
* Using With-Editor commands::

File: with-editor.info, Node: Using the With-Editor package, Next: Using With-Editor as a library, Prev: Top, Up: Top
1 Using the With-Editor package
*******************************
The With-Editor package is used internally by Magit when editing
commit messages and rebase sequences. It also provides some commands
and features which are useful by themselves, even if you dont use
Magit.
For information about using this library in you own package, see
*note Using With-Editor as a library: Using With-Editor as a library.
* Menu:
* Configuring With-Editor::
* Using With-Editor commands::

File: with-editor.info, Node: Configuring With-Editor, Next: Using With-Editor commands, Up: Using the With-Editor package
1.1 Configuring With-Editor
===========================
With-Editor tries very hard to locate a suitable emacsclient executable,
so ideally you should never have to customize the option
with-editor-emacsclient-executable. When it fails to do so, then the
most likely reason is that someone found yet another way to package
Emacs (most likely on OS X) without putting the executable on $PATH,
and we have to add another kludge to find it anyway.
-- User Option: with-editor-emacsclient-executable
The emacsclient executable used as the editor by child process of
this Emacs instance. By using this executable, child processes can
call home to their parent process.
This option is automatically set at startup by looking in
exec-path, and other places where the executable could be
installed, to find the emacsclient executable most suitable for the
current emacs instance.
You should *not* customize this option permanently. If you have to
do it, then you should consider that a temporary kludge and inform
the Magit maintainer as described in *note Debugging: Debugging.
If With-Editor fails to find a suitable emacsclient on you system,
then this should be fixed for all users at once, by teaching
with-editor-locate-emacsclient how to so on your system and
system like yours. Doing it this way has the advantage, that you
wont have do it again every time you update Emacs, and that other
users who have installed Emacs the same way as you have, wont have
to go through the same trouble.
Note that there also is a nuclear option; setting this variable to
nil causes the "sleeping editor" described below to be used even
for local child processes. Obviously we dont recommend that you
use this except in "emergencies", i.e. before we had a change to
add a kludge appropriate for you setup.
-- Function: with-editor-locate-emacsclient
The function used to set the initial value of the option
with-editor-emacsclient-executable. Theres a lot of voodoo
here.
The emacsclient cannot be used when using Tramp to run a process on a
remote machine. (Theoretically it could, but that would be hard to
setup, very fragile, and rather insecure).
With-Editor provides an alternative "editor" which can be used by
remote processes in much the same way as local processes use an
emacsclient executable. This alternative is known as the "sleeping
editor" because it is implemented as a shell script which sleeps until
it receives a signal.
-- User Option: with-editor-sleeping-editor
The sleeping editor is a shell script used as the editor of child
processes when the emacsclient executable cannot be used.
This fallback is used for asynchronous process started inside the
macro with-editor, when the process runs on a remote machine or
for local processes when with-editor-emacsclient-executable is
nil.
Where the latter uses a socket to communicate with Emacs server,
this substitute prints edit requests to its standard output on
which a process filter listens for such requests. As such it is
not a complete substitute for a proper Emacsclient, it can only be
used as $EDITOR of child process of the current Emacs instance.
It is unlikely that you should ever have to customize this option.

File: with-editor.info, Node: Using With-Editor commands, Prev: Configuring With-Editor, Up: Using the With-Editor package
1.2 Using With-Editor commands
==============================
This section describes how to use the with-editor library _outside_ of
Magit. You dont need to know any of this just to create commits using
Magit.
The commands with-editor-async-shell-command and
with-editor-shell-command are intended as drop in replacements for
async-shell-command and shell-command. They automatically export
$EDITOR making sure the executed command uses the current Emacs
instance as "the editor". With a prefix argument these commands prompt
for an alternative environment variable such as $GIT_EDITOR.
-- Command: with-editor-async-shell-command
Like async-shell-command, but the command is run with the current
Emacs instance exported as $EDITOR.
-- Command: with-editor-shell-command
Like async-shell-command, but the command is run with the current
Emacs instance exported as $EDITOR. This only has an effect if
the command is run asynchronously, i.e. when the command ends with
&.
To always use these variants add this to you init file:
(define-key (current-global-map)
[remap async-shell-command] 'with-editor-async-shell-command)
(define-key (current-global-map)
[remap shell-command] 'with-editor-shell-command)
Alternatively use the global shell-command-with-editor-mode.
-- Variable: shell-command-with-editor-mode
When this mode is active, then $EDITOR is exported whenever
ultimately shell-command is called to asynchronously run some
shell command. This affects most variants of that command, whether
they are defined in Emacs or in some third-party package.
The command with-editor-export-editor exports $EDITOR or another
such environment variable in shell-mode, term-mode and eshell-mode
buffers. Use this Emacs command before executing a shell command which
needs the editor set, or always arrange for the current Emacs instance
to be used as editor by adding it to the appropriate mode hooks:
(add-hook 'shell-mode-hook 'with-editor-export-editor)
(add-hook 'term-mode-hook 'with-editor-export-editor)
(add-hook 'eshell-mode-hook 'with-editor-export-editor)
Some variants of this function exist; these two forms are equivalent:
(add-hook 'shell-mode-hook
(apply-partially 'with-editor-export-editor "GIT_EDITOR"))
(add-hook 'shell-mode-hook 'with-editor-export-git-editor)
-- Command: with-editor-export-editor
When invoked in a shell-mode, term-mode, or eshell-mode
buffer, this command teaches shell commands to use the current
Emacs instance as the editor, by exporting $EDITOR.
-- Command: with-editor-export-git-editor
Like with-editor-export-editor but exports $GIT_EDITOR.
-- Command: with-editor-export-hg-editor
Like with-editor-export-editor but exports $HG_EDITOR.

File: with-editor.info, Node: Using With-Editor as a library, Next: Debugging, Prev: Using the With-Editor package, Up: Top
2 Using With-Editor as a library
********************************
This section describes how to use the with-editor library _outside_ of
Magit to teach another package how to have its child processes call
home, just like Magit does. You dont need to know any of this just to
create commits using Magit. You can also ignore this if you use
with-editor outside of Magit, but only as an end-user.
For information about interactive use and options which affect both
interactive and non-interactive use, see *note Using the With-Editor
package: Using the With-Editor package.
-- Macro: with-editor &rest body
This macro arranges for the emacsclient or the sleeping editor to
be used as the editor of child processes, effectively teaching them
to call home to the current emacs instance when they require that
the user edits a file.
This is essentially done by establishing a local binding for
process-environment and changing the value of the $EDITOR
environment variable. This affects all processes started by forms
inside BODY.
-- Function: with-editor-set-process-filter process filter
This function is like set-process-filter but ensures that adding
the new FILTER does not remove the with-editor-process-filter.
This is done by wrapping the two filter functions using a lambda,
which becomes the actual filter. It calls
with-editor-process-filter first, passing t as
NO-STANDARD-FILTER. Then it calls FILTER.

File: with-editor.info, Node: Debugging, Prev: Using With-Editor as a library, Up: Top
3 Debugging
***********
With-Editor tries very hard to locate a suitable emacsclient executable,
and then sets option with-editor-emacsclient-executable accordingly.
In very rare cases this fails. When it does fail, then the most likely
reason is that someone found yet another way to package Emacs (most
likely on OS X) without putting the executable on $PATH, and we have
to add another kludge to find it anyway.
If you are having problems using with-editor, e.g. you cannot
commit in Magit, then please open a new issue at
<https://github.com/magit/magit/issues> and provide information about
your Emacs installation. Most importantly how did you install Emacs and
what is the output of M-x with-editor-debug?

Tag Table:
Node: Top1545
Node: Using the With-Editor package3237
Node: Configuring With-Editor3853
Node: Using With-Editor commands7460
Node: Using With-Editor as a library10623
Node: Debugging12295

End Tag Table

Local Variables:
coding: utf-8
End: