forked from ben/dotfiles
2137 lines
89 KiB
EmacsLisp
2137 lines
89 KiB
EmacsLisp
;;; magit-git.el --- Git functionality -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2010-2018 The Magit Project Contributors
|
|
;;
|
|
;; You should have received a copy of the AUTHORS.md file which
|
|
;; lists all contributors. If not, see http://magit.vc/authors.
|
|
|
|
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
|
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
|
|
|
|
;; Magit is free software; you can redistribute it and/or modify it
|
|
;; under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
;;
|
|
;; Magit is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
|
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
|
|
;; License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with Magit. If not, see http://www.gnu.org/licenses.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This library implements wrappers for various Git plumbing commands.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'dash)
|
|
|
|
(require 'magit-popup)
|
|
(require 'magit-utils)
|
|
(require 'magit-section)
|
|
|
|
(declare-function magit-call-git "magit-process" (&rest args))
|
|
(declare-function magit-maybe-make-margin-overlay "magit-margin" ())
|
|
(declare-function magit-process-buffer "magit-process" (&optional nodisplay))
|
|
(declare-function magit-process-file "magit-process" (&rest args))
|
|
(declare-function magit-process-insert-section "magit-process"
|
|
(pwe program args &optional errcode errlog))
|
|
(declare-function magit-refresh "magit-mode" ())
|
|
(defvar magit-process-error-message-regexps)
|
|
(defvar magit-refresh-args) ; from `magit-mode' for `magit-current-file'
|
|
(defvar magit-branch-prefer-remote-upstream)
|
|
(defvar magit-published-branches)
|
|
(defvar magit-diff-section-arguments)
|
|
|
|
(defvar magit-tramp-process-environment nil)
|
|
|
|
;;; Options
|
|
|
|
;; For now this is shared between `magit-process' and `magit-git'.
|
|
(defgroup magit-process nil
|
|
"Git and other external processes used by Magit."
|
|
:group 'magit)
|
|
|
|
(defvar magit-git-environment
|
|
(list (format "INSIDE_EMACS=%s,magit" emacs-version))
|
|
"Prepended to `process-environment' while running git.")
|
|
|
|
(defcustom magit-git-output-coding-system
|
|
(and (eq system-type 'windows-nt) 'utf-8)
|
|
"Coding system for receiving output from Git.
|
|
|
|
If non-nil, the Git config value `i18n.logOutputEncoding' should
|
|
be set via `magit-git-global-arguments' to value consistent with
|
|
this."
|
|
:package-version '(magit . "2.9.0")
|
|
:group 'magit-process
|
|
:type '(choice (coding-system :tag "Coding system to decode Git output")
|
|
(const :tag "Use system default" nil)))
|
|
|
|
(defvar magit-git-w32-path-hack nil
|
|
"Alist of (EXE . (PATHENTRY)).
|
|
This specifies what additional PATH setting needs to be added to
|
|
the environment in order to run the non-wrapper git executables
|
|
successfully.")
|
|
|
|
(defcustom magit-git-executable
|
|
;; Git might be installed in a different location on a remote, so
|
|
;; it is better not to use the full path to the executable, except
|
|
;; on Window were we would otherwise end up using one one of the
|
|
;; wrappers "cmd/git.exe" or "cmd/git.cmd", which are much slower
|
|
;; than using "bin/git.exe" directly.
|
|
(or (and (eq system-type 'windows-nt)
|
|
(--when-let (executable-find "git")
|
|
(ignore-errors
|
|
;; Git for Windows 2.x provides cygpath so we can
|
|
;; ask it for native paths.
|
|
(let* ((core-exe
|
|
(car
|
|
(process-lines
|
|
it "-c"
|
|
"alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
|
|
"X" "git")))
|
|
(hack-entry (assoc core-exe magit-git-w32-path-hack))
|
|
;; Running the libexec/git-core executable
|
|
;; requires some extra PATH entries.
|
|
(path-hack
|
|
(list (concat "PATH="
|
|
(car (process-lines
|
|
it "-c"
|
|
"alias.P=!cygpath -wp \"$PATH\""
|
|
"P"))))))
|
|
;; The defcustom STANDARD expression can be
|
|
;; evaluated many times, so make sure it is
|
|
;; idempotent.
|
|
(if hack-entry
|
|
(setcdr hack-entry path-hack)
|
|
(push (cons core-exe path-hack) magit-git-w32-path-hack))
|
|
core-exe))))
|
|
"git")
|
|
"The Git executable used by Magit."
|
|
:group 'magit-process
|
|
:type 'string)
|
|
|
|
(defcustom magit-git-global-arguments
|
|
`("--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true"
|
|
"-c" "log.showSignature=false"
|
|
,@(and (eq system-type 'windows-nt)
|
|
(list "-c" "i18n.logOutputEncoding=UTF-8")))
|
|
"Global Git arguments.
|
|
|
|
The arguments set here are used every time the git executable is
|
|
run as a subprocess. They are placed right after the executable
|
|
itself and before the git command - as in `git HERE... COMMAND
|
|
REST'. See the manpage `git(1)' for valid arguments.
|
|
|
|
Be careful what you add here, especially if you are using Tramp
|
|
to connect to servers with ancient Git versions. Never remove
|
|
anything that is part of the default value, unless you really
|
|
know what you are doing. And think very hard before adding
|
|
something; it will be used every time Magit runs Git for any
|
|
purpose."
|
|
:package-version '(magit . "2.9.0")
|
|
:group 'magit-git-arguments
|
|
:group 'magit-process
|
|
:type '(repeat string))
|
|
|
|
(defvar magit-git-debug nil
|
|
"Whether to enable additional reporting of git errors.
|
|
|
|
Magit basically calls git for one of these two reasons: for
|
|
side-effects or to do something with its standard output.
|
|
|
|
When git is run for side-effects then its output, including error
|
|
messages, go into the process buffer which is shown when using \
|
|
\\<magit-status-mode-map>\\[magit-process].
|
|
|
|
When git's output is consumed in some way, then it would be too
|
|
expensive to also insert it into this buffer, but when this
|
|
option is non-nil and git returns with a non-zero exit status,
|
|
then at least its standard error is inserted into this buffer.
|
|
|
|
This is only intended for debugging purposes. Do not enable this
|
|
permanently, that would negatively affect performance.")
|
|
|
|
|
|
(defcustom magit-prefer-remote-upstream nil
|
|
"Whether to favor remote branches when reading the upstream branch.
|
|
|
|
This controls whether commands that read a branch from the user
|
|
and then set it as the upstream branch, offer a local or a remote
|
|
branch as default completion candidate, when they have the choice.
|
|
|
|
This affects all commands that use `magit-read-upstream-branch'
|
|
or `magit-read-starting-point', which includes all commands that
|
|
change the upstream and many which create new branches."
|
|
:package-version '(magit . "2.4.2")
|
|
:group 'magit-commands
|
|
:type 'boolean)
|
|
|
|
(defcustom magit-list-refs-sortby nil
|
|
"How to sort the ref collection in the prompt.
|
|
|
|
This affects commands that read a ref. More specifically, it
|
|
controls the order of refs returned by `magit-list-refs', which
|
|
is called by functions like `magit-list-branch-names' to generate
|
|
the collection of refs. By default, refs are sorted according to
|
|
their full refname (i.e., 'refs/...').
|
|
|
|
Any value accepted by the `--sort' flag of `git for-each-ref' can
|
|
be used. For example, \"-creatordate\" places refs with more
|
|
recent committer or tagger dates earlier in the list. A list of
|
|
strings can also be given in order to pass multiple sort keys to
|
|
`git for-each-ref'.
|
|
|
|
Note that, depending on the completion framework you use, this
|
|
may not be sufficient to change the order in which the refs are
|
|
displayed. It only controls the order of the collection passed
|
|
to `magit-completing-read' or, for commands that support reading
|
|
multiple strings, `read-from-minibuffer'. The completion
|
|
framework ultimately determines how the collection is displayed."
|
|
:package-version '(magit . "2.11.0")
|
|
:group 'magit-miscellanous
|
|
:type '(choice string (repeat string)))
|
|
|
|
;;; Git
|
|
|
|
(defvar magit--refresh-cache nil)
|
|
|
|
(defmacro magit--with-refresh-cache (key &rest body)
|
|
(declare (indent 1) (debug (form body)))
|
|
(let ((k (cl-gensym)))
|
|
`(if magit--refresh-cache
|
|
(let ((,k ,key))
|
|
(--if-let (assoc ,k (cdr magit--refresh-cache))
|
|
(progn (cl-incf (caar magit--refresh-cache))
|
|
(cdr it))
|
|
(cl-incf (cdar magit--refresh-cache))
|
|
(let ((value ,(macroexp-progn body)))
|
|
(push (cons ,k value)
|
|
(cdr magit--refresh-cache))
|
|
value)))
|
|
,@body)))
|
|
|
|
(defmacro magit-with-editor (&rest body)
|
|
"Like `with-editor' but let-bind some more variables."
|
|
(declare (indent 0) (debug (body)))
|
|
`(let ((magit-process-popup-time -1)
|
|
;; The user may have customized `shell-file-name' to
|
|
;; something which results in `w32-shell-dos-semantics' nil
|
|
;; (which changes the quoting style used by
|
|
;; `shell-quote-argument'), but Git for Windows expects shell
|
|
;; quoting in the dos style.
|
|
(shell-file-name (if (and (eq system-type 'windows-nt)
|
|
;; If we have Cygwin mount points,
|
|
;; the git flavor is cygwin, so dos
|
|
;; shell quoting is probably wrong.
|
|
(not magit-cygwin-mount-points))
|
|
"cmdproxy"
|
|
shell-file-name)))
|
|
(with-editor "GIT_EDITOR"
|
|
,@body)))
|
|
|
|
(defun magit-process-git-arguments (args)
|
|
"Prepare ARGS for a function that invokes Git.
|
|
|
|
Magit has many specialized functions for running Git; they all
|
|
pass arguments through this function before handing them to Git,
|
|
to do the following.
|
|
|
|
* Flatten ARGS, removing nil arguments.
|
|
* Prepend `magit-git-global-arguments' to ARGS.
|
|
* On w32 systems, encode to `w32-ansi-code-page'."
|
|
(setq args (append magit-git-global-arguments (-flatten args)))
|
|
(if (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page))
|
|
;; On w32, the process arguments *must* be encoded in the
|
|
;; current code-page (see #3250).
|
|
(mapcar (lambda (arg)
|
|
(encode-coding-string
|
|
arg (intern (format "cp%d" w32-ansi-code-page))))
|
|
args)
|
|
args))
|
|
|
|
(defun magit-git-exit-code (&rest args)
|
|
"Execute Git with ARGS, returning its exit code."
|
|
(apply #'magit-process-file magit-git-executable nil nil nil
|
|
(magit-process-git-arguments args)))
|
|
|
|
(defun magit-git-success (&rest args)
|
|
"Execute Git with ARGS, returning t if its exit code is 0."
|
|
(= (magit-git-exit-code args) 0))
|
|
|
|
(defun magit-git-failure (&rest args)
|
|
"Execute Git with ARGS, returning t if its exit code is 1."
|
|
(= (magit-git-exit-code args) 1))
|
|
|
|
(defun magit-git-str (&rest args)
|
|
"Execute Git with ARGS, returning the first line of its output.
|
|
If there is no output, return nil. If the output begins with a
|
|
newline, return an empty string. Like `magit-git-string' but
|
|
ignore `magit-git-debug'."
|
|
(setq args (-flatten args))
|
|
(magit--with-refresh-cache (cons default-directory args)
|
|
(with-temp-buffer
|
|
(apply #'magit-process-file magit-git-executable nil (list t nil) nil
|
|
(magit-process-git-arguments args))
|
|
(unless (bobp)
|
|
(goto-char (point-min))
|
|
(buffer-substring-no-properties (point) (line-end-position))))))
|
|
|
|
(defun magit-git-output (&rest args)
|
|
"Execute Git with ARGS, returning its output."
|
|
(setq args (-flatten args))
|
|
(magit--with-refresh-cache (cons default-directory args)
|
|
(with-temp-buffer
|
|
(apply #'magit-process-file magit-git-executable nil (list t nil) nil
|
|
(magit-process-git-arguments args))
|
|
(buffer-substring-no-properties (point-min) (point-max)))))
|
|
|
|
(define-error 'magit-invalid-git-boolean "Not a Git boolean")
|
|
|
|
(defun magit-git-true (&rest args)
|
|
"Execute Git with ARGS, returning t if it prints \"true\".
|
|
If it prints \"false\", then return nil. For any other output
|
|
signal `magit-invalid-git-boolean'."
|
|
(pcase (magit-git-output args)
|
|
((or "true" "true\n") t)
|
|
((or "false" "false\n") nil)
|
|
(output (signal 'magit-invalid-git-boolean output))))
|
|
|
|
(defun magit-git-false (&rest args)
|
|
"Execute Git with ARGS, returning t if it prints \"false\".
|
|
If it prints \"true\", then return nil. For any other output
|
|
signal `magit-invalid-git-boolean'."
|
|
(pcase (magit-git-output args)
|
|
((or "true" "true\n") nil)
|
|
((or "false" "false\n") t)
|
|
(output (signal 'magit-invalid-git-boolean output))))
|
|
|
|
(defun magit-git-insert (&rest args)
|
|
"Execute Git with ARGS, inserting its output at point.
|
|
If Git exits with a non-zero exit status, then show a message and
|
|
add a section in the respective process buffer."
|
|
(setq args (magit-process-git-arguments args))
|
|
(if magit-git-debug
|
|
(let (log)
|
|
(unwind-protect
|
|
(progn
|
|
(setq log (make-temp-file "magit-stderr"))
|
|
(delete-file log)
|
|
(let ((exit (apply #'magit-process-file magit-git-executable
|
|
nil (list t log) nil args)))
|
|
(when (> exit 0)
|
|
(let ((msg "Git failed"))
|
|
(when (file-exists-p log)
|
|
(setq msg (with-temp-buffer
|
|
(insert-file-contents log)
|
|
(goto-char (point-max))
|
|
(cond
|
|
((functionp magit-git-debug)
|
|
(funcall magit-git-debug (buffer-string)))
|
|
((run-hook-wrapped
|
|
'magit-process-error-message-regexps
|
|
(lambda (re) (re-search-backward re nil t)))
|
|
(match-string-no-properties 1)))))
|
|
(let ((magit-git-debug nil))
|
|
(with-current-buffer (magit-process-buffer t)
|
|
(magit-process-insert-section default-directory
|
|
magit-git-executable
|
|
args exit log))))
|
|
(message "%s" msg)))
|
|
exit))
|
|
(ignore-errors (delete-file log))))
|
|
(apply #'magit-process-file magit-git-executable
|
|
nil (list t nil) nil args)))
|
|
|
|
(defun magit-git-string (&rest args)
|
|
"Execute Git with ARGS, returning the first line of its output.
|
|
If there is no output, return nil. If the output begins with a
|
|
newline, return an empty string."
|
|
(setq args (-flatten args))
|
|
(magit--with-refresh-cache (cons default-directory args)
|
|
(with-temp-buffer
|
|
(apply #'magit-git-insert args)
|
|
(unless (bobp)
|
|
(goto-char (point-min))
|
|
(buffer-substring-no-properties (point) (line-end-position))))))
|
|
|
|
(defun magit-git-lines (&rest args)
|
|
"Execute Git with ARGS, returning its output as a list of lines.
|
|
Empty lines anywhere in the output are omitted.
|
|
|
|
If Git exits with a non-zero exit status, then report show a
|
|
message and add a section in the respective process buffer."
|
|
(with-temp-buffer
|
|
(apply #'magit-git-insert args)
|
|
(split-string (buffer-string) "\n" t)))
|
|
|
|
(defun magit-git-items (&rest args)
|
|
"Execute Git with ARGS, returning its null-separated output as a list.
|
|
Empty items anywhere in the output are omitted.
|
|
|
|
If Git exits with a non-zero exit status, then report show a
|
|
message and add a section in the respective process buffer."
|
|
(with-temp-buffer
|
|
(apply #'magit-git-insert args)
|
|
(split-string (buffer-string) "\0" t)))
|
|
|
|
(defun magit-git-wash (washer &rest args)
|
|
"Execute Git with ARGS, inserting washed output at point.
|
|
Actually first insert the raw output at point. If there is no
|
|
output, call `magit-cancel-section'. Otherwise temporarily narrow
|
|
the buffer to the inserted text, move to its beginning, and then
|
|
call function WASHER with ARGS as its sole argument."
|
|
(declare (indent 1))
|
|
(let ((beg (point)))
|
|
(setq args (-flatten args))
|
|
(magit-git-insert args)
|
|
(if (= (point) beg)
|
|
(magit-cancel-section)
|
|
(unless (bolp)
|
|
(insert "\n"))
|
|
(save-restriction
|
|
(narrow-to-region beg (point))
|
|
(goto-char beg)
|
|
(funcall washer args))
|
|
(when (or (= (point) beg)
|
|
(= (point) (1+ beg)))
|
|
(magit-cancel-section))
|
|
(magit-maybe-make-margin-overlay))))
|
|
|
|
(defun magit-git-version (&optional raw)
|
|
(--when-let (let (magit-git-global-arguments)
|
|
(ignore-errors (substring (magit-git-string "version") 12)))
|
|
(if raw it (and (string-match "^\\([0-9]+\\.[0-9]+\\.[0-9]+\\)" it)
|
|
(match-string 1 it)))))
|
|
|
|
;;; Files
|
|
|
|
(defun magit--safe-default-directory (&optional file)
|
|
(catch 'unsafe-default-dir
|
|
(let ((dir (file-name-as-directory
|
|
(expand-file-name (or file default-directory))))
|
|
(previous nil))
|
|
(while (not (magit-file-accessible-directory-p dir))
|
|
(setq dir (file-name-directory (directory-file-name dir)))
|
|
(when (equal dir previous)
|
|
(throw 'unsafe-default-dir nil))
|
|
(setq previous dir))
|
|
dir)))
|
|
|
|
(defmacro magit--with-safe-default-directory (file &rest body)
|
|
(declare (indent 1) (debug (form body)))
|
|
`(when-let ((default-directory (magit--safe-default-directory ,file)))
|
|
,@body))
|
|
|
|
(defun magit-git-dir (&optional path)
|
|
"Return absolute path to the control directory of the current repository.
|
|
|
|
All symlinks are followed. If optional PATH is non-nil, then
|
|
it has to be a path relative to the control directory and its
|
|
absolute path is returned."
|
|
(magit--with-refresh-cache (list default-directory 'magit-git-dir path)
|
|
(magit--with-safe-default-directory nil
|
|
(when-let ((dir (magit-rev-parse-safe "--git-dir")))
|
|
(setq dir (file-name-as-directory (magit-expand-git-file-name dir)))
|
|
(unless (file-remote-p dir)
|
|
(setq dir (concat (file-remote-p default-directory) dir)))
|
|
(if path (expand-file-name (convert-standard-filename path) dir) dir)))))
|
|
|
|
(defvar magit--separated-gitdirs nil)
|
|
|
|
(defun magit--record-separated-gitdir ()
|
|
(let ((topdir (magit-toplevel))
|
|
(gitdir (magit-git-dir)))
|
|
;; Kludge: git-annex converts submodule gitdirs to symlinks. See #3599.
|
|
(when (file-symlink-p (directory-file-name gitdir))
|
|
(setq gitdir (file-truename gitdir)))
|
|
;; We want to delete the entry for `topdir' here, rather than within
|
|
;; (unless ...), in case a `--separate-git-dir' repository was switched to
|
|
;; the standard structure (i.e., "topdir/.git/").
|
|
(setq magit--separated-gitdirs (cl-delete topdir
|
|
magit--separated-gitdirs
|
|
:key #'car :test #'equal))
|
|
(unless (equal (file-name-as-directory (expand-file-name ".git" topdir))
|
|
gitdir)
|
|
(push (cons topdir gitdir) magit--separated-gitdirs))))
|
|
|
|
(defun magit-toplevel (&optional directory)
|
|
"Return the absolute path to the toplevel of the current repository.
|
|
|
|
From within the working tree or control directory of a repository
|
|
return the absolute path to the toplevel directory of the working
|
|
tree. As a special case, from within a bare repository return
|
|
the control directory instead. When called outside a repository
|
|
then return nil.
|
|
|
|
When optional DIRECTORY is non-nil then return the toplevel for
|
|
that directory instead of the one for `default-directory'.
|
|
|
|
Try to respect the option `find-file-visit-truename', i.e. when
|
|
the value of that option is nil, then avoid needlessly returning
|
|
the truename. When a symlink to a sub-directory of the working
|
|
tree is involved, or when called from within a sub-directory of
|
|
the gitdir or from the toplevel of a gitdir, which itself is not
|
|
located within the working tree, then it is not possible to avoid
|
|
returning the truename."
|
|
(magit--with-refresh-cache
|
|
(cons (or directory default-directory) 'magit-toplevel)
|
|
(magit--with-safe-default-directory directory
|
|
(if-let ((topdir (magit-rev-parse-safe "--show-toplevel")))
|
|
(let (updir)
|
|
(setq topdir (magit-expand-git-file-name topdir))
|
|
(if (and
|
|
;; Always honor these settings.
|
|
(not find-file-visit-truename)
|
|
(not (getenv "GIT_WORK_TREE"))
|
|
;; `--show-cdup' is the relative path to the toplevel
|
|
;; from `(file-truename default-directory)'. Here we
|
|
;; pretend it is relative to `default-directory', and
|
|
;; go to that directory. Then we check whether
|
|
;; `--show-toplevel' still returns the same value and
|
|
;; whether `--show-cdup' now is the empty string. If
|
|
;; both is the case, then we are at the toplevel of
|
|
;; the same working tree, but also avoided needlessly
|
|
;; following any symlinks.
|
|
(progn
|
|
(setq updir (file-name-as-directory
|
|
(magit-rev-parse-safe "--show-cdup")))
|
|
(setq updir (if (file-name-absolute-p updir)
|
|
(concat (file-remote-p default-directory) updir)
|
|
(expand-file-name updir)))
|
|
(let ((default-directory updir))
|
|
(and (string-equal (magit-rev-parse-safe "--show-cdup") "")
|
|
(--when-let (magit-rev-parse-safe "--show-toplevel")
|
|
(string-equal (magit-expand-git-file-name it)
|
|
topdir))))))
|
|
updir
|
|
(concat (file-remote-p default-directory)
|
|
(file-name-as-directory topdir))))
|
|
(when-let ((gitdir (magit-rev-parse-safe "--git-dir")))
|
|
(setq gitdir (file-name-as-directory
|
|
(if (file-name-absolute-p gitdir)
|
|
;; We might have followed a symlink.
|
|
(concat (file-remote-p default-directory)
|
|
(magit-expand-git-file-name gitdir))
|
|
(expand-file-name gitdir))))
|
|
(if (magit-bare-repo-p)
|
|
gitdir
|
|
(let* ((link (expand-file-name "gitdir" gitdir))
|
|
(wtree (and (file-exists-p link)
|
|
(magit-file-line link))))
|
|
(cond
|
|
((and wtree
|
|
;; Ignore .git/gitdir files that result from a
|
|
;; Git bug. See #2364.
|
|
(not (equal wtree ".git")))
|
|
;; Return the linked working tree.
|
|
(file-name-directory wtree))
|
|
;; The working directory may not be the parent directory of
|
|
;; .git if it was set up with `git init --separate-git-dir'.
|
|
;; See #2955.
|
|
((car (rassoc gitdir magit--separated-gitdirs)))
|
|
(t
|
|
;; Step outside the control directory to enter the working tree.
|
|
(file-name-directory (directory-file-name gitdir)))))))))))
|
|
|
|
(defmacro magit-with-toplevel (&rest body)
|
|
(declare (indent defun) (debug (body)))
|
|
(let ((toplevel (cl-gensym "toplevel")))
|
|
`(let ((,toplevel (magit-toplevel)))
|
|
(if ,toplevel
|
|
(let ((default-directory ,toplevel))
|
|
,@body)
|
|
(magit--not-inside-repository-error)))))
|
|
|
|
(define-error 'magit-outside-git-repo "Not inside Git repository")
|
|
(define-error 'magit-git-executable-not-found
|
|
"Git executable cannot be found (see https://magit.vc/goto/e6a78ed2)")
|
|
|
|
(defun magit--not-inside-repository-error ()
|
|
(if (executable-find magit-git-executable)
|
|
(signal 'magit-outside-git-repo default-directory)
|
|
(signal 'magit-git-executable-not-found magit-git-executable)))
|
|
|
|
(defun magit-inside-gitdir-p (&optioal noerror)
|
|
"Return t if `default-directory' is below the repository directory.
|
|
If it is below the working directory, then return nil.
|
|
If it isn't below either, then signal an error unless NOERROR
|
|
is non-nil, in which case return nil."
|
|
(and (magit--assert-default-directory noerror)
|
|
;; Below a repository directory that is not located below the
|
|
;; working directory "git rev-parse --is-inside-git-dir" prints
|
|
;; "false", which is wrong.
|
|
(let ((gitdir (magit-git-dir)))
|
|
(cond (gitdir (file-in-directory-p default-directory gitdir))
|
|
(noerror nil)
|
|
(t (signal 'magit-outside-git-repo default-directory))))))
|
|
|
|
(defun magit-inside-worktree-p (&optional noerror)
|
|
"Return t if `default-directory' is below the working directory.
|
|
If it is below the repository directory, then return nil.
|
|
If it isn't below either, then signal an error unless NOERROR
|
|
is non-nil, in which case return nil."
|
|
(and (magit--assert-default-directory noerror)
|
|
(condition-case nil
|
|
(magit-rev-parse-true "--is-inside-work-tree")
|
|
(magit-invalid-git-boolean
|
|
(and (not noerror)
|
|
(signal 'magit-outside-git-repo default-directory))))))
|
|
|
|
(defun magit-bare-repo-p (&optional noerror)
|
|
"Return t if the current repository is bare.
|
|
If it is non-bare, then return nil. If `default-directory'
|
|
isn't below a Git repository, then signal an error unless
|
|
NOERROR is non-nil, in which case return nil."
|
|
(and (magit--assert-default-directory noerror)
|
|
(condition-case nil
|
|
(magit-rev-parse-true "--is-bare-repository")
|
|
(magit-invalid-git-boolean
|
|
(and (not noerror)
|
|
(signal 'magit-outside-git-repo default-directory))))))
|
|
|
|
(defun magit--assert-default-directory (&optional noerror)
|
|
(or (file-directory-p default-directory)
|
|
(and (not noerror)
|
|
(let ((exists (file-exists-p default-directory)))
|
|
(signal (if exists 'file-error 'file-missing)
|
|
(list "Running git in directory"
|
|
(if exists
|
|
"Not a directory"
|
|
"No such file or directory")
|
|
default-directory))))))
|
|
|
|
(defun magit-git-repo-p (directory &optional non-bare)
|
|
"Return t if DIRECTORY is a Git repository.
|
|
When optional NON-BARE is non-nil also return nil if DIRECTORY is
|
|
a bare repository."
|
|
(and (file-directory-p directory) ; Avoid archives, see #3397.
|
|
(or (file-regular-p (expand-file-name ".git" directory))
|
|
(file-directory-p (expand-file-name ".git" directory))
|
|
(and (not non-bare)
|
|
(file-regular-p (expand-file-name "HEAD" directory))
|
|
(file-directory-p (expand-file-name "refs" directory))
|
|
(file-directory-p (expand-file-name "objects" directory))))))
|
|
|
|
(defvar-local magit-buffer-revision nil)
|
|
(defvar-local magit-buffer-refname nil)
|
|
(defvar-local magit-buffer-file-name nil)
|
|
(put 'magit-buffer-revision 'permanent-local t)
|
|
(put 'magit-buffer-refname 'permanent-local t)
|
|
(put 'magit-buffer-file-name 'permanent-local t)
|
|
|
|
(defun magit-file-relative-name (&optional file tracked)
|
|
"Return the path of FILE relative to the repository root.
|
|
|
|
If optional FILE is nil or omitted, return the relative path of
|
|
the file being visited in the current buffer, if any, else nil.
|
|
If the file is not inside a Git repository, then return nil.
|
|
|
|
If TRACKED is non-nil, return the path only if it matches a
|
|
tracked file."
|
|
(unless file
|
|
(with-current-buffer (or (buffer-base-buffer)
|
|
(current-buffer))
|
|
(setq file (or magit-buffer-file-name buffer-file-name
|
|
(and (derived-mode-p 'dired-mode) default-directory)))))
|
|
(when (and file (or (not tracked)
|
|
(magit-file-tracked-p (file-relative-name file))))
|
|
(--when-let (magit-toplevel
|
|
(magit--safe-default-directory
|
|
(directory-file-name (file-name-directory file))))
|
|
(file-relative-name file it))))
|
|
|
|
(defun magit-file-tracked-p (file)
|
|
(magit-git-success "ls-files" "--error-unmatch" file))
|
|
|
|
(defun magit-list-files (&rest args)
|
|
(apply #'magit-git-items "ls-files" "-z" "--full-name" args))
|
|
|
|
(defun magit-tracked-files ()
|
|
(magit-list-files "--cached"))
|
|
|
|
(defun magit-untracked-files (&optional all files)
|
|
(magit-list-files "--other" (unless all "--exclude-standard") "--" files))
|
|
|
|
(defun magit-unstaged-files (&optional nomodules files)
|
|
(magit-git-items "diff-files" "-z" "--name-only"
|
|
(and nomodules "--ignore-submodules")
|
|
"--" files))
|
|
|
|
(defun magit-staged-files (&optional nomodules files)
|
|
(magit-git-items "diff-index" "-z" "--name-only" "--cached"
|
|
(and nomodules "--ignore-submodules")
|
|
(magit-headish) "--" files))
|
|
|
|
(defun magit-staged-binary-files ()
|
|
(--mapcat (and (string-match "^-\t-\t\\(.+\\)" it)
|
|
(list (match-string 1 it)))
|
|
(magit-git-items "diff" "-z" "--cached"
|
|
"--numstat" "--ignore-submodules")))
|
|
|
|
(defun magit-unmerged-files ()
|
|
(magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=U"))
|
|
|
|
(defun magit-ignored-files ()
|
|
(magit-git-items "ls-files" "-z" "--others" "--ignored"
|
|
"--exclude-standard" "--directory"))
|
|
|
|
(defun magit-revision-files (rev)
|
|
(magit-with-toplevel
|
|
(magit-git-items "ls-tree" "-z" "-r" "--name-only" rev)))
|
|
|
|
(defun magit-changed-files (rev-or-range &optional other-rev)
|
|
"Return list of files the have changed between two revisions.
|
|
If OTHER-REV is non-nil, REV-OR-RANGE should be a revision, not a
|
|
range. Otherwise, it can be any revision or range accepted by
|
|
\"git diff\" (i.e., <rev>, <revA>..<revB>, or <revA>...<revB>)."
|
|
(magit-with-toplevel
|
|
(magit-git-items "diff" "-z" "--name-only" rev-or-range other-rev)))
|
|
|
|
(defun magit-renamed-files (revA revB)
|
|
(--map (cons (nth 1 it) (nth 2 it))
|
|
(-partition 3 (magit-git-items
|
|
"diff-tree" "-r" "--diff-filter=R" "-z" "-M"
|
|
revA revB))))
|
|
|
|
(defun magit-file-status (&rest args)
|
|
(with-temp-buffer
|
|
(save-excursion (magit-git-insert "status" "-z" args))
|
|
(let ((pos (point)) status)
|
|
(while (> (skip-chars-forward "[:print:]") 0)
|
|
(let ((x (char-after pos))
|
|
(y (char-after (1+ pos)))
|
|
(file (buffer-substring (+ pos 3) (point))))
|
|
(forward-char)
|
|
(if (memq x '(?R ?C))
|
|
(progn
|
|
(setq pos (point))
|
|
(skip-chars-forward "[:print:]")
|
|
(push (list file (buffer-substring pos (point)) x y) status)
|
|
(forward-char))
|
|
(push (list file nil x y) status)))
|
|
(setq pos (point)))
|
|
status)))
|
|
|
|
(defcustom magit-cygwin-mount-points
|
|
(when (eq system-type 'windows-nt)
|
|
(cl-sort (--map (if (string-match "^\\(.*\\) on \\(.*\\) type" it)
|
|
(cons (file-name-as-directory (match-string 2 it))
|
|
(file-name-as-directory (match-string 1 it)))
|
|
(lwarn '(magit) :error
|
|
"Failed to parse Cygwin mount: %S" it))
|
|
;; If --exec-path is not a native Windows path,
|
|
;; then we probably have a cygwin git.
|
|
(let ((process-environment
|
|
(append magit-git-environment process-environment)))
|
|
(and (not (string-match-p
|
|
"\\`[a-zA-Z]:"
|
|
(car (process-lines
|
|
magit-git-executable "--exec-path"))))
|
|
(ignore-errors (process-lines "mount")))))
|
|
#'> :key (pcase-lambda (`(,cyg . ,_win)) (length cyg))))
|
|
"Alist of (CYGWIN . WIN32) directory names.
|
|
Sorted from longest to shortest CYGWIN name."
|
|
:package-version '(magit . "2.3.0")
|
|
:group 'magit-process
|
|
:type '(alist :key-type string :value-type directory))
|
|
|
|
(defun magit-expand-git-file-name (filename)
|
|
(unless (file-name-absolute-p filename)
|
|
(setq filename (expand-file-name filename)))
|
|
(-if-let ((cyg . win)
|
|
(cl-assoc filename magit-cygwin-mount-points
|
|
:test (lambda (f cyg) (string-prefix-p cyg f))))
|
|
(concat win (substring filename (length cyg)))
|
|
filename))
|
|
|
|
(defun magit-convert-filename-for-git (filename)
|
|
"Convert FILENAME so that it can be passed to git.
|
|
1. If it's a remote filename, then remove the remote part.
|
|
2. Deal with an `windows-nt' Emacs vs. Cygwin Git incompatibility."
|
|
(if (file-name-absolute-p filename)
|
|
(-if-let ((cyg . win)
|
|
(cl-rassoc filename magit-cygwin-mount-points
|
|
:test (lambda (f win) (string-prefix-p win f))))
|
|
(concat cyg (substring filename (length win)))
|
|
(or (file-remote-p filename 'localname)
|
|
filename))
|
|
filename))
|
|
|
|
(defun magit-decode-git-path (path)
|
|
(if (eq (aref path 0) ?\")
|
|
(decode-coding-string (read path)
|
|
(or magit-git-output-coding-system
|
|
(car default-process-coding-system))
|
|
t)
|
|
path))
|
|
|
|
(defun magit-file-at-point ()
|
|
(magit-section-case
|
|
(file (oref it value))
|
|
(hunk (magit-section-parent-value it))))
|
|
|
|
(defun magit-current-file ()
|
|
(or (magit-file-relative-name)
|
|
(magit-file-at-point)
|
|
(and (derived-mode-p 'magit-log-mode)
|
|
(car (nth 2 magit-refresh-args)))))
|
|
|
|
;;; Predicates
|
|
|
|
(defun magit-no-commit-p ()
|
|
"Return t if there is no commit in the current Git repository."
|
|
(not (magit-rev-verify "HEAD")))
|
|
|
|
(defun magit-merge-commit-p (commit)
|
|
"Return t if COMMIT is a merge commit."
|
|
(> (length (magit-commit-parents commit)) 1))
|
|
|
|
(defun magit-anything-staged-p (&optional ignore-submodules &rest files)
|
|
"Return t if there are any staged changes.
|
|
If optional FILES is non-nil, then only changes to those files
|
|
are considered."
|
|
(magit-git-failure "diff" "--quiet" "--cached"
|
|
(and ignore-submodules "--ignore-submodules")
|
|
"--" files))
|
|
|
|
(defun magit-anything-unstaged-p (&optional ignore-submodules &rest files)
|
|
"Return t if there are any unstaged changes.
|
|
If optional FILES is non-nil, then only changes to those files
|
|
are considered."
|
|
(magit-git-failure "diff" "--quiet"
|
|
(and ignore-submodules "--ignore-submodules")
|
|
"--" files))
|
|
|
|
(defun magit-anything-modified-p (&optional ignore-submodules &rest files)
|
|
"Return t if there are any staged or unstaged changes.
|
|
If optional FILES is non-nil, then only changes to those files
|
|
are considered."
|
|
(or (apply 'magit-anything-staged-p ignore-submodules files)
|
|
(apply 'magit-anything-unstaged-p ignore-submodules files)))
|
|
|
|
(defun magit-anything-unmerged-p (&rest files)
|
|
"Return t if there are any merge conflicts.
|
|
If optional FILES is non-nil, then only conflicts in those files
|
|
are considered."
|
|
(and (magit-git-string "ls-files" "--unmerged" files) t))
|
|
|
|
(defun magit-module-worktree-p (module)
|
|
(magit-with-toplevel
|
|
(file-exists-p (expand-file-name (expand-file-name ".git" module)))))
|
|
|
|
(defun magit-module-no-worktree-p (module)
|
|
(not (magit-module-worktree-p module)))
|
|
|
|
(defun magit-ignore-submodules-p ()
|
|
(cl-find-if (lambda (arg)
|
|
(string-prefix-p "--ignore-submodules" arg))
|
|
magit-diff-section-arguments))
|
|
|
|
;;; Revisions and References
|
|
|
|
(defun magit-rev-parse (&rest args)
|
|
"Execute `git rev-parse ARGS', returning first line of output.
|
|
If there is no output, return nil."
|
|
(apply #'magit-git-string "rev-parse" args))
|
|
|
|
(defun magit-rev-parse-safe (&rest args)
|
|
"Execute `git rev-parse ARGS', returning first line of output.
|
|
If there is no output, return nil. Like `magit-rev-parse' but
|
|
ignore `magit-git-debug'."
|
|
(apply #'magit-git-str "rev-parse" args))
|
|
|
|
(defun magit-rev-parse-true (&rest args)
|
|
"Execute `git rev-parse ARGS', returning t if it prints \"true\".
|
|
If it prints \"false\", then return nil. For any other output
|
|
signal an error."
|
|
(magit-git-true "rev-parse" args))
|
|
|
|
(defun magit-rev-parse-false (&rest args)
|
|
"Execute `git rev-parse ARGS', returning t if it prints \"false\".
|
|
If it prints \"true\", then return nil. For any other output
|
|
signal an error."
|
|
(magit-git-false "rev-parse" args))
|
|
|
|
(defun magit-rev-parse-p (&rest args)
|
|
"Execute `git rev-parse ARGS', returning t if it prints \"true\".
|
|
Return t if the first (and usually only) output line is the
|
|
string \"true\", otherwise return nil."
|
|
(equal (magit-git-str "rev-parse" args) "true"))
|
|
|
|
(defun magit-rev-verify (rev)
|
|
(magit-rev-parse-safe "--verify" rev))
|
|
|
|
(defun magit-rev-verify-commit (rev)
|
|
"Return full hash for REV if it names an existing commit."
|
|
(magit-rev-verify (concat rev "^{commit}")))
|
|
|
|
(defun magit-rev-equal (a b)
|
|
(magit-git-success "diff" "--quiet" a b))
|
|
|
|
(defun magit-rev-eq (a b)
|
|
(let ((a (magit-rev-verify a))
|
|
(b (magit-rev-verify b)))
|
|
(and a b (equal a b))))
|
|
|
|
(defun magit-rev-ancestor-p (a b)
|
|
"Return non-nil if commit A is an ancestor of commit B."
|
|
(magit-git-success "merge-base" "--is-ancestor" a b))
|
|
|
|
(defun magit-rev-head-p (rev)
|
|
(or (equal rev "HEAD")
|
|
(and rev
|
|
(not (string-match-p "\\.\\." rev))
|
|
(equal (magit-rev-parse rev)
|
|
(magit-rev-parse "HEAD")))))
|
|
|
|
(defun magit-rev-author-p (rev)
|
|
"Return t if the user is the author of REV.
|
|
More precisely return t if `user.name' is equal to the author
|
|
name of REV and/or `user.email' is equal to the author email
|
|
of REV."
|
|
(or (equal (magit-get "user.name") (magit-rev-format "%an" rev))
|
|
(equal (magit-get "user.email") (magit-rev-format "%ae" rev))))
|
|
|
|
(defun magit-rev-name (rev &optional pattern)
|
|
"Return a symbolic name for REV.
|
|
PATTERN is passed to the `--refs' flag of `git-name-rev' and can
|
|
be used to limit the result to a matching ref. When structured
|
|
as \"refs/<subdir>/*\", PATTERN is taken as a namespace. In this
|
|
case, the name returned by `git-name-rev' is discarded if it
|
|
corresponds to a ref outside of the namespace."
|
|
(--when-let (magit-git-string "name-rev" "--name-only" "--no-undefined"
|
|
(and pattern (concat "--refs=" pattern))
|
|
rev)
|
|
;; We can't use name-rev's --exclude to filter out "*/PATTERN"
|
|
;; because --exclude wasn't added until Git v2.13.0.
|
|
(if (and pattern
|
|
(string-match-p "\\`refs/[^/]+/\\*\\'" pattern))
|
|
(let ((namespace (substring pattern 0 -1)))
|
|
(unless (and (string-match-p namespace it)
|
|
(not (magit-rev-verify (concat namespace it))))
|
|
it))
|
|
it)))
|
|
|
|
(defun magit-rev-branch (rev)
|
|
(--when-let (magit-rev-name rev "refs/heads/*")
|
|
(unless (string-match-p "[~^]" it) it)))
|
|
|
|
(defun magit-get-shortname (rev)
|
|
(let* ((fn (apply-partially 'magit-rev-name rev))
|
|
(name (or (funcall fn "refs/tags/*")
|
|
(funcall fn "refs/heads/*")
|
|
(funcall fn "refs/remotes/*"))))
|
|
(cond ((not name)
|
|
(magit-rev-parse "--short" rev))
|
|
((string-match "^\\(?:tags\\|remotes\\)/\\(.+\\)" name)
|
|
(if (magit-ref-ambiguous-p (match-string 1 name))
|
|
name
|
|
(match-string 1 name)))
|
|
(t (magit-ref-maybe-qualify name)))))
|
|
|
|
(defun magit-name-branch (rev &optional lax)
|
|
(or (magit-name-local-branch rev)
|
|
(magit-name-remote-branch rev)
|
|
(and lax (or (magit-name-local-branch rev t)
|
|
(magit-name-remote-branch rev t)))))
|
|
|
|
(defun magit-name-local-branch (rev &optional lax)
|
|
(--when-let (magit-rev-name rev "refs/heads/*")
|
|
(and (or lax (not (string-match-p "[~^]" it))) it)))
|
|
|
|
(defun magit-name-remote-branch (rev &optional lax)
|
|
(--when-let (magit-rev-name rev "refs/remotes/*")
|
|
(and (or lax (not (string-match-p "[~^]" it)))
|
|
(substring it 8))))
|
|
|
|
(defun magit-name-tag (rev &optional lax)
|
|
(--when-let (magit-rev-name rev "refs/tags/*")
|
|
(and (or lax (not (string-match-p "[~^]" it)))
|
|
(substring it 5))))
|
|
|
|
(defun magit-ref-fullname (name)
|
|
"Return fully qualified refname for NAME.
|
|
If NAME is ambiguous, return nil. NAME may include suffixes such
|
|
as \"^1\" and \"~3\". "
|
|
(save-match-data
|
|
(if (string-match "\\`\\([^^~]+\\)\\(.*\\)" name)
|
|
(--when-let (magit-rev-parse "--symbolic-full-name"
|
|
(match-string 1 name))
|
|
(concat it (match-string 2 name)))
|
|
(error "`name' has an unrecognized format"))))
|
|
|
|
(defun magit-ref-ambiguous-p (name)
|
|
(not (magit-ref-fullname name)))
|
|
|
|
(cl-defun magit-ref-maybe-qualify (name &optional (prefix "heads/"))
|
|
"If NAME is ambiguous, prepend PREFIX to it."
|
|
(concat (and (magit-ref-ambiguous-p name)
|
|
prefix)
|
|
name))
|
|
|
|
(defun magit-ref-exists-p (ref)
|
|
(magit-git-success "show-ref" "--verify" ref))
|
|
|
|
(defun magit-ref-equal (a b)
|
|
"Return t if the refs A and B are `equal'.
|
|
A symbolic-ref pointing to some ref, is `equal' to that ref,
|
|
as are two symbolic-refs pointing to the same ref."
|
|
(equal (magit-ref-fullname a)
|
|
(magit-ref-fullname b)))
|
|
|
|
(defun magit-ref-eq (a b)
|
|
"Return t if the refs A and B are `eq'.
|
|
A symbolic-ref is `eq' to itself, but not to the ref it points
|
|
to, or to some other symbolic-ref that points to the same ref."
|
|
(let ((symbolic-a (magit-symbolic-ref-p a))
|
|
(symbolic-b (magit-symbolic-ref-p b)))
|
|
(or (and symbolic-a
|
|
symbolic-b
|
|
(equal a b))
|
|
(and (not symbolic-a)
|
|
(not symbolic-b)
|
|
(magit-ref-equal a b)))))
|
|
|
|
(defun magit-headish ()
|
|
"Return \"HEAD\" or if that doesn't exist the hash of the empty tree."
|
|
(if (magit-no-commit-p)
|
|
(magit-git-string "mktree")
|
|
"HEAD"))
|
|
|
|
(defun magit-branch-at-point ()
|
|
(magit-section-case
|
|
(branch (oref it value))
|
|
(commit (or (magit--painted-branch-at-point)
|
|
(magit-name-branch (oref it value))))))
|
|
|
|
(defun magit--painted-branch-at-point (&optional type)
|
|
(or (and (not (eq type 'remote))
|
|
(memq (get-text-property (point) 'face)
|
|
(list 'magit-branch-local
|
|
'magit-branch-current))
|
|
(cdr (magit-split-branch-name
|
|
(thing-at-point 'git-revision t))))
|
|
(and (not (eq type 'local))
|
|
(memq (get-text-property (point) 'face)
|
|
(list 'magit-branch-remote
|
|
'magit-branch-remote-head))
|
|
(thing-at-point 'git-revision t))))
|
|
|
|
(defun magit-local-branch-at-point ()
|
|
(magit-section-case
|
|
(branch (let ((branch (magit-ref-maybe-qualify (oref it value))))
|
|
(when (member branch (magit-list-local-branch-names))
|
|
branch)))
|
|
(commit (or (magit--painted-branch-at-point 'local)
|
|
(magit-name-local-branch (oref it value))))))
|
|
|
|
(defun magit-remote-branch-at-point ()
|
|
(magit-section-case
|
|
(branch (let ((branch (oref it value)))
|
|
(when (member branch (magit-list-remote-branch-names))
|
|
branch)))
|
|
(commit (or (magit--painted-branch-at-point 'remote)
|
|
(magit-name-remote-branch (oref it value))))))
|
|
|
|
(defun magit-commit-at-point ()
|
|
(or (magit-section-value-if 'commit)
|
|
(and (derived-mode-p 'magit-revision-mode)
|
|
(car magit-refresh-args))))
|
|
|
|
(defun magit-branch-or-commit-at-point ()
|
|
(or magit-buffer-refname
|
|
(magit-section-case
|
|
(branch (magit-ref-maybe-qualify (oref it value)))
|
|
(commit (or (magit--painted-branch-at-point)
|
|
(let ((rev (oref it value)))
|
|
(or (magit-name-branch rev)
|
|
(magit-get-shortname rev)
|
|
rev))))
|
|
(tag (magit-ref-maybe-qualify (oref it value) "tags/")))
|
|
(thing-at-point 'git-revision t)
|
|
(and (derived-mode-p 'magit-revision-mode
|
|
'magit-merge-preview-mode)
|
|
(car magit-refresh-args))))
|
|
|
|
(defun magit-tag-at-point ()
|
|
(magit-section-case
|
|
(tag (oref it value))
|
|
(commit (magit-name-tag (oref it value)))))
|
|
|
|
(defun magit-stash-at-point ()
|
|
(magit-section-value-if 'stash))
|
|
|
|
(defun magit-remote-at-point ()
|
|
(magit-section-case
|
|
(remote (oref it value))
|
|
(branch (magit-section-parent-value it))))
|
|
|
|
(defun magit-module-at-point (&optional predicate)
|
|
(when (magit-section-match 'magit-module-section)
|
|
(let ((module (oref (magit-current-section) value)))
|
|
(and (or (not predicate)
|
|
(funcall predicate module))
|
|
module))))
|
|
|
|
(defun magit-get-current-branch ()
|
|
"Return the refname of the currently checked out branch.
|
|
Return nil if no branch is currently checked out."
|
|
(magit-git-string "symbolic-ref" "--short" "HEAD"))
|
|
|
|
(defvar magit-get-previous-branch-timeout 0.5
|
|
"Maximum time to spend in `magit-get-previous-branch'.
|
|
Given as a number of seconds.")
|
|
|
|
(defun magit-get-previous-branch ()
|
|
"Return the refname of the previously checked out branch.
|
|
Return nil if no branch can be found in the `HEAD' reflog
|
|
which is different from the current branch and still exists.
|
|
The amount of time spent searching is limited by
|
|
`magit-get-previous-branch-timeout'."
|
|
(let ((t0 (float-time))
|
|
(current (magit-get-current-branch))
|
|
(i 1) prev)
|
|
(while (if (> (- (float-time) t0) magit-get-previous-branch-timeout)
|
|
(setq prev nil) ;; Timed out.
|
|
(and (setq prev (magit-rev-verify (format "@{-%i}" i)))
|
|
(or (not (setq prev (magit-rev-branch prev)))
|
|
(equal prev current))))
|
|
(cl-incf i))
|
|
prev))
|
|
|
|
(defun magit-get-upstream-ref (&optional branch)
|
|
(and (or branch (setq branch (magit-get-current-branch)))
|
|
(let ((remote (magit-get "branch" branch "remote"))
|
|
(merge (magit-get "branch" branch "merge")))
|
|
(when (and remote merge)
|
|
(cond ((string-equal remote ".") merge)
|
|
((string-prefix-p "refs/heads/" merge)
|
|
(concat "refs/remotes/" remote "/" (substring merge 11))))))))
|
|
|
|
(defun magit-get-upstream-branch (&optional branch verify)
|
|
(and (or branch (setq branch (magit-get-current-branch)))
|
|
(when-let ((remote (magit-get "branch" branch "remote"))
|
|
(merge (magit-get "branch" branch "merge")))
|
|
(and (string-prefix-p "refs/heads/" merge)
|
|
(let* ((upstream (substring merge 11))
|
|
(upstream
|
|
(cond ((string-equal remote ".")
|
|
(propertize upstream 'face 'magit-branch-local))
|
|
((string-match-p "[@:]" remote)
|
|
(propertize (concat remote " " upstream)
|
|
'face 'magit-branch-remote))
|
|
(t
|
|
(propertize (concat remote "/" upstream)
|
|
'face 'magit-branch-remote)))))
|
|
(and (or (not verify)
|
|
(magit-rev-verify upstream))
|
|
upstream))))))
|
|
|
|
(defun magit-get-indirect-upstream-branch (branch &optional force)
|
|
(let ((remote (magit-get "branch" branch "remote")))
|
|
(and remote (not (equal remote "."))
|
|
;; The user has opted in...
|
|
(or force
|
|
(--some (if (magit-git-success "check-ref-format" "--branch" it)
|
|
(equal it branch)
|
|
(string-match-p it branch))
|
|
magit-branch-prefer-remote-upstream))
|
|
;; and local BRANCH tracks a remote branch...
|
|
(let ((upstream (magit-get-upstream-branch branch)))
|
|
;; whose upstream...
|
|
(and upstream
|
|
;; has the same name as BRANCH and...
|
|
(equal (substring upstream (1+ (length remote))) branch)
|
|
;; and can be fast-forwarded to BRANCH.
|
|
(magit-rev-ancestor-p upstream branch)
|
|
upstream)))))
|
|
|
|
(defun magit-get-upstream-remote (&optional branch)
|
|
(and (or branch (setq branch (magit-get-current-branch)))
|
|
(magit-get "branch" branch "remote")))
|
|
|
|
(defun magit-get-push-remote (&optional branch)
|
|
(or (and (or branch (setq branch (magit-get-current-branch)))
|
|
(magit-get "branch" branch "pushRemote"))
|
|
(magit-get "remote.pushDefault")))
|
|
|
|
(defun magit-get-push-branch (&optional branch verify)
|
|
(and (or branch (setq branch (magit-get-current-branch)))
|
|
(when-let ((remote (magit-get-push-remote branch))
|
|
(push-branch (concat remote "/" branch)))
|
|
(and (or (not verify)
|
|
(magit-rev-verify push-branch))
|
|
push-branch))))
|
|
|
|
(defun magit-get-@{push}-branch (&optional branch)
|
|
(let ((ref (magit-rev-parse "--symbolic-full-name"
|
|
(concat branch "@{push}"))))
|
|
(when (and ref (string-prefix-p "refs/remotes/" ref))
|
|
(substring ref 13))))
|
|
|
|
(defun magit-get-remote (&optional branch)
|
|
(when (or branch (setq branch (magit-get-current-branch)))
|
|
(let ((remote (magit-get "branch" branch "remote")))
|
|
(unless (equal remote ".")
|
|
remote))))
|
|
|
|
(defun magit-get-some-remote (&optional branch)
|
|
(or (magit-get-remote branch)
|
|
(and (magit-branch-p "master")
|
|
(magit-get-remote "master"))
|
|
(let ((remotes (magit-list-remotes)))
|
|
(or (car (member "origin" remotes))
|
|
(car remotes)))))
|
|
|
|
(defun magit-branch-merged-p (branch &optional target)
|
|
"Return non-nil if BRANCH is merged into its upstream and TARGET.
|
|
|
|
TARGET defaults to the current branch. If `HEAD' is detached and
|
|
TARGET is nil, then always return nil. As a special case, if
|
|
TARGET is t, then return non-nil if BRANCH is merged into any one
|
|
of the other local branches.
|
|
|
|
If, and only if, BRANCH has an upstream, then only return non-nil
|
|
if BRANCH is merged into both TARGET (as described above) as well
|
|
as into its upstream."
|
|
(and (--if-let (and (magit-branch-p branch)
|
|
(magit-get-upstream-branch branch))
|
|
(magit-git-success "merge-base" "--is-ancestor" branch it)
|
|
t)
|
|
(if (eq target t)
|
|
(delete (magit-name-local-branch branch)
|
|
(magit-list-containing-branches branch))
|
|
(--when-let (or target (magit-get-current-branch))
|
|
(magit-git-success "merge-base" "--is-ancestor" branch it)))))
|
|
|
|
(defun magit-split-branch-name (branch)
|
|
(cond ((member branch (magit-list-local-branch-names))
|
|
(cons "." branch))
|
|
((string-match " " branch)
|
|
(pcase-let ((`(,url ,branch) (split-string branch " ")))
|
|
(cons url branch)))
|
|
((string-match "/" branch)
|
|
(let ((remote (substring branch 0 (match-beginning 0))))
|
|
(if (save-match-data (member remote (magit-list-remotes)))
|
|
(cons remote (substring branch (match-end 0)))
|
|
(error "Invalid branch name %s" branch))))))
|
|
|
|
(defun magit-get-current-tag (&optional rev with-distance)
|
|
"Return the closest tag reachable from REV.
|
|
|
|
If optional REV is nil, then default to `HEAD'.
|
|
If optional WITH-DISTANCE is non-nil then return (TAG COMMITS),
|
|
if it is `dirty' return (TAG COMMIT DIRTY). COMMITS is the number
|
|
of commits in `HEAD' but not in TAG and DIRTY is t if there are
|
|
uncommitted changes, nil otherwise."
|
|
(--when-let (magit-git-str "describe" "--long" "--tags"
|
|
(and (eq with-distance 'dirty) "--dirty") rev)
|
|
(save-match-data
|
|
(string-match
|
|
"\\(.+\\)-\\(?:0[0-9]*\\|\\([0-9]+\\)\\)-g[0-9a-z]+\\(-dirty\\)?$" it)
|
|
(if with-distance
|
|
`(,(match-string 1 it)
|
|
,(string-to-number (or (match-string 2 it) "0"))
|
|
,@(and (match-string 3 it) (list t)))
|
|
(match-string 1 it)))))
|
|
|
|
(defun magit-get-next-tag (&optional rev with-distance)
|
|
"Return the closest tag from which REV is reachable.
|
|
|
|
If optional REV is nil, then default to `HEAD'.
|
|
If no such tag can be found or if the distance is 0 (in which
|
|
case it is the current tag, not the next), return nil instead.
|
|
If optional WITH-DISTANCE is non-nil, then return (TAG COMMITS)
|
|
where COMMITS is the number of commits in TAG but not in REV."
|
|
(--when-let (magit-git-str "describe" "--contains" (or rev "HEAD"))
|
|
(save-match-data
|
|
(when (string-match "^[^^~]+" it)
|
|
(setq it (match-string 0 it))
|
|
(unless (equal it (magit-get-current-tag rev))
|
|
(if with-distance
|
|
(list it (car (magit-rev-diff-count it rev)))
|
|
it))))))
|
|
|
|
(defvar magit-list-refs-namespaces
|
|
'("refs/heads" "refs/remotes" "refs/tags" "refs/pull"))
|
|
|
|
(defun magit-list-refs (&optional namespaces format sortby)
|
|
"Return list of references.
|
|
|
|
When NAMESPACES is non-nil, list refs from these namespaces
|
|
rather than those from `magit-list-refs-namespaces'.
|
|
|
|
FORMAT is passed to the `--format' flag of `git for-each-ref'
|
|
and defaults to \"%(refname)\". If the format is \"%(refname)\"
|
|
or \"%(refname:short)\", then drop the symbolic-ref \"HEAD\".
|
|
|
|
SORTBY is a key or list of keys to pass to the `--sort' flag of
|
|
`git for-each-ref'. When nil, use `magit-list-refs-sortby'"
|
|
(unless format
|
|
(setq format "%(refname)"))
|
|
(let ((refs (magit-git-lines "for-each-ref"
|
|
(concat "--format=" format)
|
|
(--map (concat "--sort=" it)
|
|
(pcase (or sortby magit-list-refs-sortby)
|
|
((and val (pred stringp)) (list val))
|
|
((and val (pred listp)) val)))
|
|
(or namespaces magit-list-refs-namespaces))))
|
|
(if (member format '("%(refname)" "%(refname:short)"))
|
|
(--remove (string-match-p "\\(\\`\\|/\\)HEAD\\'" it) refs)
|
|
refs)))
|
|
|
|
(defun magit-list-branches ()
|
|
(magit-list-refs (list "refs/heads" "refs/remotes")))
|
|
|
|
(defun magit-list-local-branches ()
|
|
(magit-list-refs "refs/heads"))
|
|
|
|
(defun magit-list-remote-branches (&optional remote)
|
|
(magit-list-refs (concat "refs/remotes/" remote)))
|
|
|
|
(defun magit-list-related-branches (relation &optional commit arg)
|
|
(--remove (string-match-p "\\(\\`(HEAD\\|HEAD -> \\)" it)
|
|
(--map (substring it 2)
|
|
(magit-git-lines "branch" arg relation commit))))
|
|
|
|
(defun magit-list-containing-branches (&optional commit arg)
|
|
(magit-list-related-branches "--contains" commit arg))
|
|
|
|
(defun magit-list-publishing-branches (&optional commit)
|
|
(--filter (magit-rev-ancestor-p commit it)
|
|
magit-published-branches))
|
|
|
|
(defun magit-list-merged-branches (&optional commit arg)
|
|
(magit-list-related-branches "--merged" commit arg))
|
|
|
|
(defun magit-list-unmerged-branches (&optional commit arg)
|
|
(magit-list-related-branches "--no-merged" commit arg))
|
|
|
|
(defun magit-list-unmerged-to-upstream-branches ()
|
|
(--filter (when-let ((upstream (magit-get-upstream-branch it)))
|
|
(member it (magit-list-unmerged-branches upstream)))
|
|
(magit-list-local-branch-names)))
|
|
|
|
(defun magit-list-branches-pointing-at (commit)
|
|
(let ((re (format "\\`%s refs/\\(heads\\|remotes\\)/\\(.*\\)\\'"
|
|
(magit-rev-verify commit))))
|
|
(--keep (and (string-match re it)
|
|
(let ((name (match-string 2 it)))
|
|
(and (not (string-suffix-p "HEAD" name))
|
|
name)))
|
|
(magit-git-lines "show-ref"))))
|
|
|
|
(defun magit-list-refnames (&optional namespaces)
|
|
(magit-list-refs namespaces "%(refname:short)"))
|
|
|
|
(defun magit-list-branch-names ()
|
|
(magit-list-refnames (list "refs/heads" "refs/remotes")))
|
|
|
|
(defun magit-list-local-branch-names ()
|
|
(magit-list-refnames "refs/heads"))
|
|
|
|
(defun magit-list-remote-branch-names (&optional remote relative)
|
|
(if (and remote relative)
|
|
(let ((regexp (format "^refs/remotes/%s/\\(.+\\)" remote)))
|
|
(--mapcat (when (string-match regexp it)
|
|
(list (match-string 1 it)))
|
|
(magit-list-remote-branches remote)))
|
|
(magit-list-refnames (concat "refs/remotes/" remote))))
|
|
|
|
(defun magit-format-refs (format &rest args)
|
|
(let ((lines (magit-git-lines
|
|
"for-each-ref" (concat "--format=" format)
|
|
(or args (list "refs/heads" "refs/remotes" "refs/tags")))))
|
|
(if (string-match-p "\f" format)
|
|
(--map (split-string it "\f") lines)
|
|
lines)))
|
|
|
|
(defun magit-list-remotes ()
|
|
(magit-git-lines "remote"))
|
|
|
|
(defun magit-list-tags ()
|
|
(magit-git-lines "tag"))
|
|
|
|
(defun magit-list-stashes (&optional format)
|
|
(magit-git-lines "stash" "list" (concat "--format=" (or format "%gd"))))
|
|
|
|
(defun magit-list-active-notes-refs ()
|
|
"Return notes refs according to `core.notesRef' and `notes.displayRef'."
|
|
(magit-git-lines "for-each-ref" "--format=%(refname)"
|
|
(or (magit-get "core.notesRef") "refs/notes/commits")
|
|
(magit-get-all "notes.displayRef")))
|
|
|
|
(defun magit-list-notes-refnames ()
|
|
(--map (substring it 6) (magit-list-refnames "refs/notes")))
|
|
|
|
(defun magit-remote-list-tags (remote)
|
|
(--keep (and (not (string-match-p "\\^{}$" it))
|
|
(substring it 51))
|
|
(magit-git-lines "ls-remote" "--tags" remote)))
|
|
|
|
(defun magit-remote-list-branches (remote)
|
|
(--keep (and (not (string-match-p "\\^{}$" it))
|
|
(substring it 52))
|
|
(magit-git-lines "ls-remote" "--heads" remote)))
|
|
|
|
(defun magit-remote-list-refs (remote)
|
|
(--keep (and (not (string-match-p "\\^{}$" it))
|
|
(substring it 41))
|
|
(magit-git-lines "ls-remote" remote)))
|
|
|
|
(defun magit-list-module-paths ()
|
|
(--mapcat (and (string-match "^160000 [0-9a-z]\\{40\\} 0\t\\(.+\\)$" it)
|
|
(list (match-string 1 it)))
|
|
(magit-git-items "ls-files" "-z" "--stage")))
|
|
|
|
(defun magit-get-submodule-name (path)
|
|
"Return the name of the submodule at PATH.
|
|
PATH has to be relative to the super-repository."
|
|
(cadr (split-string
|
|
(car (or (magit-git-items
|
|
"config" "-z"
|
|
"-f" (expand-file-name ".gitmodules" (magit-toplevel))
|
|
"--get-regexp" "^submodule\\..*\\.path$"
|
|
(concat "^" (regexp-quote (directory-file-name path)) "$"))
|
|
(error "No such submodule `%s'" path)))
|
|
"\n")))
|
|
|
|
(defun magit-list-worktrees ()
|
|
(let (worktrees worktree)
|
|
(dolist (line (let ((magit-git-global-arguments
|
|
;; KLUDGE At least in v2.8.3 this triggers a segfault.
|
|
(remove "--no-pager" magit-git-global-arguments)))
|
|
(magit-git-lines "worktree" "list" "--porcelain")))
|
|
(cond ((string-prefix-p "worktree" line)
|
|
(push (setq worktree (list (substring line 9) nil nil nil))
|
|
worktrees))
|
|
((string-equal line "bare")
|
|
(let* ((default-directory (car worktree))
|
|
(wt (and (not (magit-get-boolean "core.bare"))
|
|
(magit-get "core.worktree"))))
|
|
(if (and wt (file-exists-p (expand-file-name wt)))
|
|
(progn (setf (nth 0 worktree) (expand-file-name wt))
|
|
(setf (nth 2 worktree) (magit-rev-parse "HEAD"))
|
|
(setf (nth 3 worktree) (magit-get-current-branch)))
|
|
(setf (nth 1 worktree) t))))
|
|
((string-prefix-p "HEAD" line)
|
|
(setf (nth 2 worktree) (substring line 5)))
|
|
((string-prefix-p "branch" line)
|
|
(setf (nth 3 worktree) (substring line 18)))
|
|
((string-equal line "detached"))))
|
|
(nreverse worktrees)))
|
|
|
|
(defun magit-symbolic-ref-p (name)
|
|
(magit-git-success "symbolic-ref" "--quiet" name))
|
|
|
|
(defun magit-ref-p (rev)
|
|
(or (car (member rev (magit-list-refs)))
|
|
(car (member rev (magit-list-refnames)))))
|
|
|
|
(defun magit-branch-p (rev)
|
|
(or (car (member rev (magit-list-branches)))
|
|
(car (member rev (magit-list-branch-names)))))
|
|
|
|
(defun magit-local-branch-p (rev)
|
|
(or (car (member rev (magit-list-local-branches)))
|
|
(car (member rev (magit-list-local-branch-names)))))
|
|
|
|
(defun magit-remote-branch-p (rev)
|
|
(or (car (member rev (magit-list-remote-branches)))
|
|
(car (member rev (magit-list-remote-branch-names)))))
|
|
|
|
(defun magit-branch-set-face (branch)
|
|
(propertize branch 'face (if (magit-local-branch-p branch)
|
|
'magit-branch-local
|
|
'magit-branch-remote)))
|
|
|
|
(defun magit-tag-p (rev)
|
|
(car (member rev (magit-list-tags))))
|
|
|
|
(defun magit-remote-p (string)
|
|
(car (member string (magit-list-remotes))))
|
|
|
|
(defun magit-rev-diff-count (a b)
|
|
"Return the commits in A but not B and vice versa.
|
|
Return a list of two integers: (A>B B>A)."
|
|
(mapcar 'string-to-number
|
|
(split-string (magit-git-string "rev-list"
|
|
"--count" "--left-right"
|
|
(concat a "..." b))
|
|
"\t")))
|
|
|
|
(defun magit-abbrev-length ()
|
|
(--if-let (magit-get "core.abbrev")
|
|
(string-to-number it)
|
|
;; Guess the length git will be using based on an example
|
|
;; abbreviation. Actually HEAD's abbreviation might be an
|
|
;; outlier, so use the shorter of the abbreviations for two
|
|
;; commits. When a commit does not exist, then fall back
|
|
;; to the default of 7. See #3034.
|
|
(min (--if-let (magit-rev-parse "--short" "HEAD") (length it) 7)
|
|
(--if-let (magit-rev-parse "--short" "HEAD~") (length it) 7))))
|
|
|
|
(defun magit-abbrev-arg (&optional arg)
|
|
(format "--%s=%d" (or arg "abbrev") (magit-abbrev-length)))
|
|
|
|
(defun magit-rev-abbrev (rev)
|
|
(magit-rev-parse (magit-abbrev-arg "short") rev))
|
|
|
|
(defun magit-commit-children (commit &optional args)
|
|
(mapcar #'car
|
|
(--filter (member commit (cdr it))
|
|
(--map (split-string it " ")
|
|
(magit-git-lines
|
|
"log" "--format=%H %P"
|
|
(or args (list "--branches" "--tags" "--remotes"))
|
|
"--not" commit)))))
|
|
|
|
(defun magit-commit-parents (commit)
|
|
(--when-let (magit-git-string "rev-list" "-1" "--parents" commit)
|
|
(cdr (split-string it))))
|
|
|
|
(defun magit-patch-id (rev)
|
|
(with-temp-buffer
|
|
(magit-process-file
|
|
shell-file-name nil '(t nil) nil shell-command-switch
|
|
(let ((exec (shell-quote-argument magit-git-executable)))
|
|
(format "%s diff-tree -u %s | %s patch-id" exec rev exec)))
|
|
(car (split-string (buffer-string)))))
|
|
|
|
(defun magit-rev-format (format &optional rev args)
|
|
(let ((str (magit-git-string "show" "--no-patch"
|
|
(concat "--format=" format) args
|
|
(if rev (concat rev "^{commit}") "HEAD") "--")))
|
|
(unless (string-equal str "")
|
|
str)))
|
|
|
|
(defun magit-rev-insert-format (format &optional rev args)
|
|
(magit-git-insert "show" "--no-patch"
|
|
(concat "--format=" format) args
|
|
(if rev (concat rev "^{commit}") "HEAD") "--"))
|
|
|
|
(defun magit-format-rev-summary (rev)
|
|
(--when-let (magit-rev-format "%h %s" rev)
|
|
(string-match " " it)
|
|
(put-text-property 0 (match-beginning 0) 'face 'magit-hash it)
|
|
it))
|
|
|
|
(defvar magit-ref-namespaces
|
|
'(("\\`HEAD\\'" . magit-head)
|
|
("\\`refs/tags/\\(.+\\)" . magit-tag)
|
|
("\\`refs/heads/\\(.+\\)" . magit-branch-local)
|
|
("\\`refs/remotes/\\(.+\\)" . magit-branch-remote)
|
|
("\\`refs/bisect/\\(bad\\)" . magit-bisect-bad)
|
|
("\\`refs/bisect/\\(skip.*\\)" . magit-bisect-skip)
|
|
("\\`refs/bisect/\\(good.*\\)" . magit-bisect-good)
|
|
("\\`refs/stash$" . magit-refname-stash)
|
|
("\\`refs/wip/\\(.+\\)" . magit-refname-wip)
|
|
("\\`refs/pullreqs/\\(.+\\)" . magit-refname-pullreq)
|
|
("\\`\\(bad\\):" . magit-bisect-bad)
|
|
("\\`\\(skip\\):" . magit-bisect-skip)
|
|
("\\`\\(good\\):" . magit-bisect-good)
|
|
("\\`\\(.+\\)" . magit-refname))
|
|
"How refs are formatted for display.
|
|
|
|
Each entry controls how a certain type of ref is displayed, and
|
|
has the form (REGEXP . FACE). REGEXP is a regular expression
|
|
used to match full refs. The first entry whose REGEXP matches
|
|
the reference is used. The first regexp submatch becomes the
|
|
\"label\" that represents the ref and is propertized with FONT.")
|
|
|
|
(defun magit-format-ref-labels (string)
|
|
;; To support Git <2.2.0, we remove the surrounding parentheses here
|
|
;; rather than specifying that STRING should be generated with Git's
|
|
;; "%D" placeholder.
|
|
(setq string (->> string
|
|
(replace-regexp-in-string "\\`\\s-*(" "")
|
|
(replace-regexp-in-string ")\\s-*\\'" "")))
|
|
(save-match-data
|
|
(let ((regexp "\\(, \\|tag: \\|HEAD -> \\)")
|
|
names)
|
|
(if (and (derived-mode-p 'magit-log-mode)
|
|
(member "--simplify-by-decoration" (cadr magit-refresh-args)))
|
|
(let ((branches (magit-list-local-branch-names))
|
|
(re (format "^%s/.+" (regexp-opt (magit-list-remotes)))))
|
|
(setq names
|
|
(--map (cond ((string-equal it "HEAD") it)
|
|
((string-prefix-p "refs/" it) it)
|
|
((member it branches) (concat "refs/heads/" it))
|
|
((string-match re it) (concat "refs/remotes/" it))
|
|
(t (concat "refs/" it)))
|
|
(split-string
|
|
(replace-regexp-in-string "tag: " "refs/tags/" string)
|
|
regexp t))))
|
|
(setq names (split-string string regexp t)))
|
|
(let (state head upstream tags branches remotes other combined)
|
|
(dolist (ref names)
|
|
(let* ((face (cdr (--first (string-match (car it) ref)
|
|
magit-ref-namespaces)))
|
|
(name (propertize (or (match-string 1 ref) ref) 'face face)))
|
|
(cl-case face
|
|
((magit-bisect-bad magit-bisect-skip magit-bisect-good)
|
|
(setq state name))
|
|
(magit-head
|
|
(setq head (propertize "@" 'face 'magit-head)))
|
|
(magit-tag (push name tags))
|
|
(magit-branch-local (push name branches))
|
|
(magit-branch-remote (push name remotes))
|
|
(t (push name other)))))
|
|
(setq remotes
|
|
(-keep
|
|
(lambda (name)
|
|
(if (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" name)
|
|
(let ((r (match-string 1 name))
|
|
(b (match-string 2 name)))
|
|
(and (not (equal b "HEAD"))
|
|
(if (equal (concat "refs/remotes/" name)
|
|
(magit-git-string
|
|
"symbolic-ref"
|
|
(format "refs/remotes/%s/HEAD" r)))
|
|
(propertize name
|
|
'face 'magit-branch-remote-head)
|
|
name)))
|
|
name))
|
|
remotes))
|
|
(let* ((current (magit-get-current-branch))
|
|
(target (magit-get-upstream-branch current t)))
|
|
(dolist (name branches)
|
|
(let ((push (car (member (magit-get-push-branch name) remotes))))
|
|
(when push
|
|
(setq remotes (delete push remotes))
|
|
(string-match "^[^/]*/" push)
|
|
(setq push (substring push 0 (match-end 0))))
|
|
(cond
|
|
((equal name current)
|
|
(setq head
|
|
(concat push
|
|
(propertize name 'face 'magit-branch-current))))
|
|
((equal name target)
|
|
(setq upstream
|
|
(concat push
|
|
(propertize name 'face '(magit-branch-upstream
|
|
magit-branch-local)))))
|
|
(t
|
|
(push (concat push name) combined)))))
|
|
(when (and target (not upstream))
|
|
(if (member target remotes)
|
|
(progn
|
|
(add-face-text-property 0 (length target)
|
|
'magit-branch-upstream nil target)
|
|
(setq upstream target)
|
|
(setq remotes (delete target remotes)))
|
|
(when-let ((target (car (member target combined))))
|
|
(add-face-text-property 0 (length target)
|
|
'magit-branch-upstream nil target)
|
|
(setq upstream target)
|
|
(setq combined (delete target combined))))))
|
|
(mapconcat #'identity
|
|
(-flatten `(,state
|
|
,head
|
|
,upstream
|
|
,@(nreverse tags)
|
|
,@(nreverse combined)
|
|
,@(nreverse remotes)
|
|
,@other))
|
|
" ")))))
|
|
|
|
(defun magit-object-type (object)
|
|
(magit-git-string "cat-file" "-t" object))
|
|
|
|
(defmacro magit-with-blob (commit file &rest body)
|
|
(declare (indent 2)
|
|
(debug (form form body)))
|
|
`(with-temp-buffer
|
|
(let ((buffer-file-name ,file))
|
|
(save-excursion
|
|
(magit-git-insert "cat-file" "-p"
|
|
(concat ,commit ":" buffer-file-name)))
|
|
(decode-coding-inserted-region
|
|
(point-min) (point-max) buffer-file-name t nil nil t)
|
|
,@body)))
|
|
|
|
(defmacro magit-with-temp-index (tree arg &rest body)
|
|
(declare (indent 2) (debug (form form body)))
|
|
(let ((file (cl-gensym "file")))
|
|
`(let ((magit--refresh-cache nil)
|
|
(,file (magit-convert-filename-for-git
|
|
(make-temp-name (magit-git-dir "index.magit.")))))
|
|
(unwind-protect
|
|
(progn (--when-let ,tree
|
|
(or (magit-git-success "read-tree" ,arg it
|
|
(concat "--index-output=" ,file))
|
|
(error "Cannot read tree %s" it)))
|
|
(if (file-remote-p default-directory)
|
|
(let ((magit-tramp-process-environment
|
|
(cons (concat "GIT_INDEX_FILE=" ,file)
|
|
magit-tramp-process-environment)))
|
|
,@body)
|
|
(let ((process-environment
|
|
(cons (concat "GIT_INDEX_FILE=" ,file)
|
|
process-environment)))
|
|
,@body)))
|
|
(ignore-errors
|
|
(delete-file (concat (file-remote-p default-directory) ,file)))))))
|
|
|
|
(defun magit-commit-tree (message &optional tree &rest parents)
|
|
(magit-git-string "commit-tree" "--no-gpg-sign" "-m" message
|
|
(--mapcat (list "-p" it) (delq nil parents))
|
|
(or tree
|
|
(magit-git-string "write-tree")
|
|
(error "Cannot write tree"))))
|
|
|
|
(defun magit-commit-worktree (message &optional arg &rest other-parents)
|
|
(magit-with-temp-index "HEAD" arg
|
|
(and (magit-update-files (magit-unstaged-files))
|
|
(apply #'magit-commit-tree message nil "HEAD" other-parents))))
|
|
|
|
(defun magit-update-files (files)
|
|
(magit-git-success "update-index" "--add" "--remove" "--" files))
|
|
|
|
(defun magit-update-ref (ref message rev &optional stashish)
|
|
(let ((magit--refresh-cache nil))
|
|
(or (if (not (version< (magit-git-version) "2.6.0"))
|
|
(zerop (magit-call-git "update-ref" "--create-reflog"
|
|
"-m" message ref rev
|
|
(or (magit-rev-verify ref) "")))
|
|
;; `--create-reflog' didn't exist before v2.6.0
|
|
(let ((oldrev (magit-rev-verify ref))
|
|
(logfile (magit-git-dir (concat "logs/" ref))))
|
|
(unless (file-exists-p logfile)
|
|
(when oldrev
|
|
(magit-git-success "update-ref" "-d" ref oldrev))
|
|
(make-directory (file-name-directory logfile) t)
|
|
(with-temp-file logfile)
|
|
(when (and oldrev (not stashish))
|
|
(magit-git-success "update-ref" "-m" "enable reflog"
|
|
ref oldrev ""))))
|
|
(magit-git-success "update-ref" "-m" message ref rev
|
|
(or (magit-rev-verify ref) "")))
|
|
(error "Cannot update %s with %s" ref rev))))
|
|
|
|
(defconst magit-range-re
|
|
(concat "\\`\\([^ \t]*[^.]\\)?" ; revA
|
|
"\\(\\.\\.\\.?\\)" ; range marker
|
|
"\\([^.][^ \t]*\\)?\\'")) ; revB
|
|
|
|
(defun magit-split-range (range)
|
|
(and (string-match magit-range-re range)
|
|
(let ((beg (or (match-string 1 range) "HEAD"))
|
|
(end (or (match-string 3 range) "HEAD")))
|
|
(cons (if (string-equal (match-string 2 range) "...")
|
|
(magit-git-string "merge-base" beg end)
|
|
beg)
|
|
end))))
|
|
|
|
(defvar magit-thingatpt--git-revision-chars "-_./[:alnum:]@{}^~!"
|
|
"Characters allowable in filenames, excluding space and colon.")
|
|
|
|
(put 'git-revision 'end-op
|
|
(lambda ()
|
|
(re-search-forward
|
|
(concat "\\=[" magit-thingatpt--git-revision-chars "]*")
|
|
nil t)))
|
|
|
|
(put 'git-revision 'beginning-op
|
|
(lambda ()
|
|
(if (re-search-backward
|
|
(concat "[^" magit-thingatpt--git-revision-chars "]") nil t)
|
|
(forward-char)
|
|
(goto-char (point-min)))))
|
|
|
|
(put 'git-revision 'thing-at-point 'magit-thingatpt--git-revision)
|
|
|
|
(defun magit-thingatpt--git-revision ()
|
|
(--when-let (bounds-of-thing-at-point 'git-revision)
|
|
(let ((text (buffer-substring-no-properties (car it) (cdr it))))
|
|
(and (magit-rev-verify-commit text) text))))
|
|
|
|
;;; Completion
|
|
|
|
(defvar magit-revision-history nil)
|
|
|
|
(defun magit-read-branch (prompt &optional secondary-default)
|
|
(magit-completing-read prompt (magit-list-branch-names)
|
|
nil t nil 'magit-revision-history
|
|
(or (magit-branch-at-point)
|
|
secondary-default
|
|
(magit-get-current-branch))))
|
|
|
|
(defun magit-read-branch-or-commit (prompt &optional secondary-default)
|
|
(or (magit-completing-read prompt (cons "HEAD" (magit-list-refnames))
|
|
nil nil nil 'magit-revision-history
|
|
(or (magit-branch-or-commit-at-point)
|
|
secondary-default
|
|
(magit-get-current-branch)))
|
|
(user-error "Nothing selected")))
|
|
|
|
(defun magit-read-range-or-commit (prompt &optional secondary-default)
|
|
(magit-read-range
|
|
prompt
|
|
(or (--when-let (magit-region-values '(commit branch) t)
|
|
(deactivate-mark)
|
|
(concat (car (last it)) ".." (car it)))
|
|
(magit-branch-or-commit-at-point)
|
|
secondary-default
|
|
(magit-get-current-branch))))
|
|
|
|
(defun magit-read-range (prompt &optional default)
|
|
(magit-completing-read-multiple prompt
|
|
(magit-list-refnames)
|
|
"\\.\\.\\.?"
|
|
default 'magit-revision-history))
|
|
|
|
(defun magit-read-remote-branch
|
|
(prompt &optional remote default local-branch require-match)
|
|
(let ((choice (magit-completing-read
|
|
prompt
|
|
(-union (and local-branch
|
|
(if remote
|
|
(concat remote "/" local-branch)
|
|
(--map (concat it "/" local-branch)
|
|
(magit-list-remotes))))
|
|
(magit-list-remote-branch-names remote t))
|
|
nil require-match nil 'magit-revision-history default)))
|
|
(if (or remote (string-match "\\`\\([^/]+\\)/\\(.+\\)" choice))
|
|
choice
|
|
(user-error "`%s' doesn't have the form REMOTE/BRANCH" choice))))
|
|
|
|
(defun magit-read-refspec (prompt remote)
|
|
(magit-completing-read prompt
|
|
(prog2 (message "Determining available refs...")
|
|
(magit-remote-list-refs remote)
|
|
(message "Determining available refs...done"))))
|
|
|
|
(defun magit-read-local-branch (prompt &optional secondary-default)
|
|
(magit-completing-read prompt (magit-list-local-branch-names)
|
|
nil t nil 'magit-revision-history
|
|
(or (magit-local-branch-at-point)
|
|
secondary-default
|
|
(magit-get-current-branch))))
|
|
|
|
(defun magit-read-local-branch-or-commit (prompt)
|
|
(let ((branches (magit-list-local-branch-names))
|
|
(commit (magit-commit-at-point)))
|
|
(or (magit-completing-read prompt
|
|
(if commit (cons commit branches) branches)
|
|
nil nil nil 'magit-revision-history
|
|
(or (magit-local-branch-at-point) commit))
|
|
(user-error "Nothing selected"))))
|
|
|
|
(defun magit-read-local-branch-or-ref (prompt &optional secondary-default)
|
|
(magit-completing-read prompt (nconc (magit-list-local-branch-names)
|
|
(magit-list-refs "refs/"))
|
|
nil t nil 'magit-revision-history
|
|
(or (magit-local-branch-at-point)
|
|
secondary-default
|
|
(magit-get-current-branch))))
|
|
|
|
(defun magit-read-other-branch
|
|
(prompt &optional exclude secondary-default no-require-match)
|
|
(let* ((current (magit-get-current-branch))
|
|
(atpoint (magit-branch-at-point))
|
|
(exclude (or exclude current))
|
|
(default (or (and (not (equal atpoint exclude)) atpoint)
|
|
(and (not (equal current exclude)) current)
|
|
secondary-default
|
|
(magit-get-previous-branch))))
|
|
(magit-completing-read prompt (delete exclude (magit-list-branch-names))
|
|
nil (not no-require-match)
|
|
nil 'magit-revision-history default)))
|
|
|
|
(defun magit-read-other-branch-or-commit
|
|
(prompt &optional exclude secondary-default)
|
|
(let* ((current (magit-get-current-branch))
|
|
(atpoint (magit-branch-or-commit-at-point))
|
|
(exclude (or exclude current))
|
|
(default (or (and (not (equal atpoint exclude)) atpoint)
|
|
(and (not (equal current exclude)) current)
|
|
secondary-default
|
|
(magit-get-previous-branch))))
|
|
(or (magit-completing-read prompt (delete exclude (magit-list-refnames))
|
|
nil nil nil 'magit-revision-history default)
|
|
(user-error "Nothing selected"))))
|
|
|
|
(defun magit-read-other-local-branch
|
|
(prompt &optional exclude secondary-default no-require-match)
|
|
(let* ((current (magit-get-current-branch))
|
|
(atpoint (magit-local-branch-at-point))
|
|
(exclude (or exclude current))
|
|
(default (or (and (not (equal atpoint exclude)) atpoint)
|
|
(and (not (equal current exclude)) current)
|
|
secondary-default
|
|
(magit-get-previous-branch))))
|
|
(magit-completing-read prompt
|
|
(delete exclude (magit-list-local-branch-names))
|
|
nil (not no-require-match)
|
|
nil 'magit-revision-history default)))
|
|
|
|
(defun magit-read-branch-prefer-other (prompt)
|
|
(let* ((current (magit-get-current-branch))
|
|
(commit (magit-commit-at-point))
|
|
(atrev (and commit (magit-list-branches-pointing-at commit)))
|
|
(atpoint (magit--painted-branch-at-point)))
|
|
(magit-completing-read prompt (magit-list-branch-names)
|
|
nil t nil 'magit-revision-history
|
|
(or (magit-section-value-if 'branch)
|
|
atpoint
|
|
(and (not (cdr atrev)) (car atrev))
|
|
(--first (not (equal it current)) atrev)
|
|
(magit-get-previous-branch)
|
|
(car atrev)))))
|
|
|
|
(cl-defun magit-read-upstream-branch
|
|
(&optional (branch (magit-get-current-branch)) prompt)
|
|
(magit-completing-read
|
|
(or prompt (format "Change upstream of %s to" branch))
|
|
(-union (--map (concat it "/" branch)
|
|
(magit-list-remotes))
|
|
(delete branch (magit-list-branch-names)))
|
|
nil nil nil 'magit-revision-history
|
|
(or (let ((r (magit-remote-branch-at-point))
|
|
(l (magit-branch-at-point)))
|
|
(when (and l (equal l branch))
|
|
(setq l nil))
|
|
(if magit-prefer-remote-upstream (or r l) (or l r)))
|
|
(let ((r (magit-branch-p "origin/master"))
|
|
(l (and (not (equal branch "master"))
|
|
(magit-branch-p "master"))))
|
|
(if magit-prefer-remote-upstream (or r l) (or l r)))
|
|
(let ((previous (magit-get-previous-branch)))
|
|
(and (not (equal previous branch)) previous)))))
|
|
|
|
(defun magit-read-starting-point (prompt &optional branch)
|
|
(or (magit-completing-read
|
|
(concat prompt
|
|
(and branch
|
|
(if (bound-and-true-p ivy-mode)
|
|
;; Ivy-mode strips faces from prompt.
|
|
(format " `%s'" branch)
|
|
(concat " "
|
|
(propertize branch 'face 'magit-branch-local))))
|
|
" starting at")
|
|
(nconc (list "HEAD")
|
|
(magit-list-refnames)
|
|
(directory-files (magit-git-dir) nil "_HEAD\\'"))
|
|
nil nil nil 'magit-revision-history
|
|
(magit--default-starting-point))
|
|
(user-error "Nothing selected")))
|
|
|
|
(defun magit--default-starting-point ()
|
|
(or (let ((r (magit-remote-branch-at-point))
|
|
(l (magit-local-branch-at-point)))
|
|
(if magit-prefer-remote-upstream (or r l) (or l r)))
|
|
(magit-commit-at-point)
|
|
(magit-stash-at-point)
|
|
(magit-get-current-branch)))
|
|
|
|
(defun magit-read-tag (prompt &optional require-match)
|
|
(magit-completing-read prompt (magit-list-tags) nil
|
|
require-match nil 'magit-revision-history
|
|
(magit-tag-at-point)))
|
|
|
|
(defun magit-read-stash (prompt)
|
|
(let ((stashes (magit-list-stashes)))
|
|
(magit-completing-read prompt stashes nil t nil nil
|
|
(magit-stash-at-point)
|
|
(car stashes))))
|
|
|
|
(defun magit-read-remote (prompt &optional default use-only)
|
|
(let ((remotes (magit-list-remotes)))
|
|
(if (and use-only (= (length remotes) 1))
|
|
(car remotes)
|
|
(magit-completing-read prompt remotes
|
|
nil t nil nil
|
|
(or default
|
|
(magit-remote-at-point)
|
|
(magit-get-remote))))))
|
|
|
|
(defun magit-read-remote-or-url (prompt &optional default)
|
|
(magit-completing-read prompt
|
|
(nconc (magit-list-remotes)
|
|
(list "https://" "git://" "git@"))
|
|
nil nil nil nil
|
|
(or default
|
|
(magit-remote-at-point)
|
|
(magit-get-remote))))
|
|
|
|
(defun magit-read-module-path (prompt &optional predicate)
|
|
(magit-completing-read prompt (magit-list-module-paths)
|
|
predicate t nil nil
|
|
(magit-module-at-point predicate)))
|
|
|
|
(defun magit-module-confirm (verb &optional predicate)
|
|
(let (modules)
|
|
(if current-prefix-arg
|
|
(progn
|
|
(setq modules (magit-list-module-paths))
|
|
(when predicate
|
|
(setq modules (-filter predicate modules)))
|
|
(unless modules
|
|
(if predicate
|
|
(user-error "No modules satisfying %s available" predicate)
|
|
(user-error "No modules available"))))
|
|
(setq modules (magit-region-values 'magit-module-section))
|
|
(when modules
|
|
(when predicate
|
|
(setq modules (-filter predicate modules)))
|
|
(unless modules
|
|
(user-error "No modules satisfying %s selected" predicate))))
|
|
(if (> (length modules) 1)
|
|
(magit-confirm t nil (format "%s %%i modules" verb) nil modules)
|
|
(list (magit-read-module-path (format "%s module" verb) predicate)))))
|
|
|
|
;;; Variables
|
|
|
|
(defun magit-config-get-from-cached-list (key)
|
|
(gethash
|
|
;; `git config --list' downcases first and last components of the key.
|
|
(--> key
|
|
(replace-regexp-in-string "\\`[^.]+" #'downcase it t t)
|
|
(replace-regexp-in-string "[^.]+\\'" #'downcase it t t))
|
|
(magit--with-refresh-cache (cons (magit-toplevel) 'config)
|
|
(let ((configs (make-hash-table :test 'equal)))
|
|
(dolist (conf (magit-git-items "config" "--list" "-z"))
|
|
(let* ((nl-pos (cl-position ?\n conf))
|
|
(key (substring conf 0 nl-pos))
|
|
(val (if nl-pos (substring conf (1+ nl-pos)) "")))
|
|
(puthash key (nconc (gethash key configs) (list val)) configs)))
|
|
configs))))
|
|
|
|
(defun magit-get (&rest keys)
|
|
"Return the value of the Git variable specified by KEYS."
|
|
(car (last (apply 'magit-get-all keys))))
|
|
|
|
(defun magit-get-all (&rest keys)
|
|
"Return all values of the Git variable specified by KEYS."
|
|
(let ((magit-git-debug nil)
|
|
(arg (and (or (null (car keys))
|
|
(string-prefix-p "--" (car keys)))
|
|
(pop keys)))
|
|
(key (mapconcat 'identity keys ".")))
|
|
(if (and magit--refresh-cache (not arg))
|
|
(magit-config-get-from-cached-list key)
|
|
(magit-git-items "config" arg "-z" "--get-all" key))))
|
|
|
|
(defun magit-get-boolean (&rest keys)
|
|
"Return the boolean value of the Git variable specified by KEYS."
|
|
(let ((key (mapconcat 'identity keys ".")))
|
|
(if magit--refresh-cache
|
|
(equal "true" (car (last (magit-config-get-from-cached-list key))))
|
|
(equal (magit-git-str "config" "--bool" key) "true"))))
|
|
|
|
(defun magit-set (value &rest keys)
|
|
"Set the value of the Git variable specified by KEYS to VALUE."
|
|
(let ((arg (and (or (null (car keys))
|
|
(string-prefix-p "--" (car keys)))
|
|
(pop keys)))
|
|
(key (mapconcat 'identity keys ".")))
|
|
(if value
|
|
(magit-git-success "config" arg key value)
|
|
(magit-git-success "config" arg "--unset" key))
|
|
value))
|
|
|
|
(gv-define-setter magit-get (val &rest keys)
|
|
`(magit-set ,val ,@keys))
|
|
|
|
(defun magit-set-all (values &rest keys)
|
|
"Set all values of the Git variable specified by KEYS to VALUES."
|
|
(let ((arg (and (or (null (car keys))
|
|
(string-prefix-p "--" (car keys)))
|
|
(pop keys)))
|
|
(var (mapconcat 'identity keys ".")))
|
|
(when (magit-get var)
|
|
(magit-call-git "config" arg "--unset-all" var))
|
|
(dolist (v values)
|
|
(magit-call-git "config" arg "--add" var v))))
|
|
|
|
;;;; Variables in Popups
|
|
|
|
(defun magit--format-popup-variable:value (variable width &optional global)
|
|
(concat variable
|
|
(make-string (max 1 (- width 3 (length variable))) ?\s)
|
|
(if-let ((value (magit-get (and global "--global") variable)))
|
|
(propertize value 'face 'magit-popup-option-value)
|
|
(propertize "unset" 'face 'magit-popup-disabled-argument))))
|
|
|
|
(defun magit--format-popup-variable:values (variable width &optional global)
|
|
(concat variable
|
|
(make-string (max 1 (- width 3 (length variable))) ?\s)
|
|
(if-let ((values (magit-get-all (and global "--global") variable)))
|
|
(concat
|
|
(propertize (car values) 'face 'magit-popup-option-value)
|
|
(mapconcat
|
|
(lambda (value)
|
|
(concat "\n" (make-string width ?\s)
|
|
(propertize value
|
|
'face 'magit-popup-option-value)))
|
|
(cdr values) ""))
|
|
(propertize "unset" 'face 'magit-popup-disabled-argument))))
|
|
|
|
(defun magit--set-popup-variable
|
|
(variable choices &optional default other)
|
|
(magit-set (--if-let (magit-git-string "config" "--local" variable)
|
|
(cadr (member it choices))
|
|
(car choices))
|
|
variable)
|
|
(magit-with-pre-popup-buffer
|
|
(magit-refresh))
|
|
(message "%s %s" variable
|
|
(magit--format-popup-variable:choices*
|
|
variable choices default other)))
|
|
|
|
(defun magit--format-popup-variable:choices
|
|
(variable choices &optional default other width)
|
|
(concat variable
|
|
(if width (make-string (- width (length variable)) ?\s) " ")
|
|
(magit--format-popup-variable:choices*
|
|
variable choices default other)))
|
|
|
|
(defun magit--format-popup-variable:choices*
|
|
(variable choices &optional default other)
|
|
(let ((local (magit-git-string "config" "--local" variable))
|
|
(global (magit-git-string "config" "--global" variable)))
|
|
(when other
|
|
(setq other (--when-let (magit-get other)
|
|
(concat other ":" it))))
|
|
(concat
|
|
(propertize "[" 'face 'magit-popup-disabled-argument)
|
|
(mapconcat
|
|
(lambda (choice)
|
|
(propertize choice 'face (if (equal choice local)
|
|
'magit-popup-option-value
|
|
'magit-popup-disabled-argument)))
|
|
choices
|
|
(propertize "|" 'face 'magit-popup-disabled-argument))
|
|
(when (or global other default)
|
|
(concat
|
|
(propertize "|" 'face 'magit-popup-disabled-argument)
|
|
(cond (global
|
|
(propertize (concat "global:" global)
|
|
'face (cond (local
|
|
'magit-popup-disabled-argument)
|
|
((member global choices)
|
|
'magit-popup-option-value)
|
|
(t
|
|
'font-lock-warning-face))))
|
|
(other
|
|
(propertize other
|
|
'face (if local
|
|
'magit-popup-disabled-argument
|
|
'magit-popup-option-value)))
|
|
(default
|
|
(propertize (concat "default:" default)
|
|
'face (if local
|
|
'magit-popup-disabled-argument
|
|
'magit-popup-option-value))))))
|
|
(propertize "]" 'face 'magit-popup-disabled-argument))))
|
|
|
|
(provide 'magit-git)
|
|
;;; magit-git.el ends here
|