Update magit
This commit is contained in:
parent
73722de18c
commit
d2f9933975
|
@ -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
|
|
@ -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
|
|
@ -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:
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
@ -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:
|
|
@ -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:
|
|
@ -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
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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
|
|
@ -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:
|
|
@ -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:
|
|
@ -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:
|
|
@ -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
|
|
@ -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
|
|
@ -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:
|
|
@ -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
|
|
@ -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"))
|
|
@ -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
|
|
@ -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
|
|
@ -1 +0,0 @@
|
|||
(define-package "git-commit-mode" "1.0.0" "Major mode for editing git commit messages" 'nil)
|
|
@ -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
|
|
@ -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
|
|
@ -1 +0,0 @@
|
|||
(define-package "git-rebase-mode" "1.0.0" "Major mode for editing git rebase files" 'nil)
|
|
@ -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
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
(define-package "logito" "20120225.1255" "logging library for Emacs" '((eieio "1.3")) :keywords '("lisp" "tool"))
|
|
@ -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
|
@ -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
|
|
@ -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
|
|
@ -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")))
|
|
@ -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
|
@ -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>
|
|
@ -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>.
|
||||
|
|
@ -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.
|
|
@ -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
|
|
@ -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
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
@ -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
|
|
@ -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
|
@ -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
|
|
@ -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:
|
|
@ -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
|
|
@ -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
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
@ -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.
|
@ -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
|
|
@ -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")
|
|
@ -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
|
|
@ -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
|
|
@ -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"))
|
|
@ -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
|
|
@ -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.
|
|
@ -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
|
|
@ -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
|
@ -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 popup’s 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 isn’t 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 argument’s 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. It’s 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 KEY’s 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 popup’s default
|
||||
action (an Emacs command), instead of bringing up the popup.
|
||||
|
||||
• ‘popup’
|
||||
|
||||
With a prefix argument bring up the popup, otherwise directly
|
||||
invoke the popup’s 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 wasn’t 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 don’t match any of the regexps are returned, or
|
||||
‘:only’ which doesn’t 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:
|
|
@ -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)
|
|
@ -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)
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
(define-package "pcache" "20151109.639" "persistent caching for Emacs." '((eieio "1.3")))
|
|
@ -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
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
(define-package "s" "20160115.58" "The long lost Emacs string manipulation library." 'nil :keywords '("strings"))
|
|
@ -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
|
|
@ -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.
|
|
@ -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
|
|
@ -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:
|
|
@ -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
|
|
@ -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 wouldn’t 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
|
||||
don’t 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 wouldn’t 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
|
||||
don’t 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 don’t 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
|
||||
won’t have do it again every time you update Emacs, and that other
|
||||
users who have installed Emacs the same way as you have, won’t 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 don’t 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’. There’s 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 don’t 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 don’t 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:
|
Loading…
Reference in New Issue