2913 lines
121 KiB
EmacsLisp
2913 lines
121 KiB
EmacsLisp
;;; magit-git.el --- Git functionality -*- lexical-binding:t -*-
|
||
|
||
;; Copyright (C) 2008-2025 The Magit Project Contributors
|
||
|
||
;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev>
|
||
;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev>
|
||
|
||
;; SPDX-License-Identifier: GPL-3.0-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 of the License, 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 <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This library implements wrappers for various Git plumbing commands.
|
||
|
||
;;; Code:
|
||
|
||
(require 'magit-base)
|
||
|
||
(require 'format-spec)
|
||
|
||
;; From `magit-branch'.
|
||
(defvar magit-branch-prefer-remote-upstream)
|
||
(defvar magit-published-branches)
|
||
|
||
;; From `magit-margin'.
|
||
(declare-function magit-maybe-make-margin-overlay "magit-margin" ())
|
||
|
||
;; From `magit-mode'.
|
||
(declare-function magit-buffer-file-name "magit-mode" ())
|
||
(declare-function magit-get-mode-buffer "magit-mode"
|
||
(mode &optional value frame))
|
||
(declare-function magit-refresh "magit-mode" ())
|
||
(defvar magit-buffer-diff-type)
|
||
(defvar magit-buffer-diff-args)
|
||
(defvar magit-buffer-file-name)
|
||
(defvar magit-buffer-log-args)
|
||
(defvar magit-buffer-log-files)
|
||
(defvar magit-buffer-refname)
|
||
(defvar magit-buffer-revision)
|
||
|
||
;; From `magit-process'.
|
||
(declare-function magit-call-git "magit-process" (&rest args))
|
||
(declare-function magit-git "magit-process" (&rest args))
|
||
(declare-function magit-process-buffer "magit-process" (&optional nodisplay))
|
||
(declare-function magit-process-file "magit-process"
|
||
(process &optional infile buffer display &rest args))
|
||
(declare-function magit-process-finish-section "magit-process"
|
||
(section exit-code))
|
||
(declare-function magit-process-git "magit-process" (destination &rest args))
|
||
(declare-function magit-process-insert-section "magit-process"
|
||
(pwd program args &optional errcode errlog face))
|
||
(defvar magit-this-error)
|
||
(defvar magit-process-error-message-regexps)
|
||
|
||
;; From `magit-status'.
|
||
(defvar magit-status-show-untracked-files)
|
||
|
||
(eval-and-compile
|
||
(cl-pushnew 'orig-rev eieio--known-slot-names)
|
||
(cl-pushnew 'number eieio--known-slot-names))
|
||
|
||
;;; 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
|
||
(or (and (eq system-type 'windows-nt)
|
||
;; Avoid the wrappers "cmd/git.exe" and "cmd/git.cmd",
|
||
;; which are much slower than using "bin/git.exe" directly.
|
||
(and-let ((exec (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
|
||
exec "-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
|
||
exec "-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))))
|
||
(and (eq system-type 'darwin)
|
||
(executable-find "git"))
|
||
"git")
|
||
"The Git executable used by Magit on the local host.
|
||
On remote machines `magit-remote-git-executable' is used instead."
|
||
:package-version '(magit . "3.2.0")
|
||
:group 'magit-process
|
||
:type 'string)
|
||
|
||
(defcustom magit-remote-git-executable "git"
|
||
"The Git executable used by Magit on remote machines.
|
||
On the local host `magit-git-executable' is used instead.
|
||
Consider customizing `tramp-remote-path' instead of this
|
||
option."
|
||
:package-version '(magit . "3.2.0")
|
||
:group 'magit-process
|
||
:type 'string)
|
||
|
||
(defcustom magit-git-global-arguments
|
||
`("--no-pager" "--literal-pathspecs"
|
||
"-c" "core.preloadindex=true"
|
||
"-c" "log.showSignature=false"
|
||
"-c" "color.ui=false"
|
||
"-c" "color.diff=false"
|
||
"-c" "diff.noPrefix=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 . "4.3.2")
|
||
:group 'magit-commands
|
||
:group 'magit-process
|
||
:type '(repeat string))
|
||
|
||
(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 most commands
|
||
that change the upstream and many that create new branches."
|
||
:package-version '(magit . "2.4.2")
|
||
:group 'magit-commands
|
||
:type 'boolean)
|
||
|
||
(defcustom magit-list-refs-namespaces
|
||
'("refs/heads"
|
||
"refs/remotes"
|
||
"refs/tags")
|
||
"List of ref namespaces considered when reading a ref.
|
||
|
||
This controls which refs are returned by `magit-list-refs', which
|
||
is called by functions like `magit-list-branch-names' to generate
|
||
the collection of refs. Additionally namespaces appear in the same
|
||
order as specified here."
|
||
:package-version '(magit . "4.4.0")
|
||
:group 'magit-commands
|
||
:type '(repeat string))
|
||
|
||
(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\".
|
||
|
||
Regardless of what is specified here, refs are first sorted by
|
||
namespace, according to the order of `magit-list-refs-namespaces'.
|
||
|
||
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-miscellaneous
|
||
:type '(choice string (repeat string)))
|
||
|
||
;;; Git
|
||
|
||
(defvar magit-git-debug nil
|
||
"Whether and how to enable additional debugging of git errors.
|
||
|
||
Use `magit-toggle-git-debug' (which see) to toggle the boolean value of
|
||
this variable. This can also manually be set to `include-success', in
|
||
which case successful git invocations are also logged.
|
||
|
||
This can also be a function, which takes one argument, the error output
|
||
as a string. This is intended for internal use and is established using
|
||
let-bindings around critical code (i.e., in `magit--assert-usable-git').")
|
||
|
||
(defun magit-toggle-git-debug ()
|
||
"Toggle whether additional git errors are reported.
|
||
|
||
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-mode-map>\\[magit-process-buffer].
|
||
|
||
When git's output is consumed in some way, then it would be too
|
||
expensive to also insert it into this buffer, but with this command
|
||
that can be enabled temporarily. In that case, if git returns with
|
||
a non-zero exit status, then at least its standard error is inserted
|
||
into this buffer.
|
||
|
||
See info node `(magit)Debugging Tools' for more information."
|
||
(interactive)
|
||
(setq magit-git-debug (not magit-git-debug))
|
||
(message "Additional reporting of Git errors %s"
|
||
(if magit-git-debug "enabled" "disabled")))
|
||
|
||
(defvar magit--refresh-cache nil)
|
||
|
||
(defmacro magit--with-refresh-cache (key &rest body)
|
||
(declare (indent 1) (debug (form body)))
|
||
(let ((k (gensym))
|
||
(hit (gensym)))
|
||
`(if magit--refresh-cache
|
||
(let ((,k ,key))
|
||
(if-let ((,hit (assoc ,k (cdr magit--refresh-cache))))
|
||
(progn (cl-incf (caar magit--refresh-cache))
|
||
(cdr ,hit))
|
||
(cl-incf (cdar magit--refresh-cache))
|
||
(let ((value ,(macroexp-progn body)))
|
||
(push (cons ,k value)
|
||
(cdr magit--refresh-cache))
|
||
value)))
|
||
,@body)))
|
||
|
||
(defvar magit-with-editor-envvar "GIT_EDITOR"
|
||
"The environment variable exported by `magit-with-editor'.
|
||
Set this to \"GIT_SEQUENCE_EDITOR\" if you do not want to use
|
||
Emacs to edit commit messages but would like to do so to edit
|
||
rebase sequences.")
|
||
|
||
(defmacro magit-with-editor (&rest body)
|
||
"Like `with-editor*' but let-bind some more variables.
|
||
Also respect the value of `magit-with-editor-envvar'."
|
||
(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* magit-with-editor-envvar
|
||
,@body)))
|
||
|
||
(defmacro magit--with-temp-process-buffer (&rest body)
|
||
"Like `with-temp-buffer', but always propagate `process-environment'.
|
||
When that var is buffer-local in the calling buffer, it is not
|
||
propagated by `with-temp-buffer', so we explicitly ensure that
|
||
happens, so that processes will be invoked consistently. BODY is
|
||
as for that macro."
|
||
(declare (indent 0) (debug (body)))
|
||
(let ((p (gensym)))
|
||
`(let ((,p process-environment))
|
||
(with-temp-buffer
|
||
(setq-local process-environment ,p)
|
||
,@body))))
|
||
|
||
(defsubst magit-git-executable ()
|
||
"Return value of `magit-git-executable' or `magit-remote-git-executable'.
|
||
The variable is chosen depending on whether `default-directory'
|
||
is remote."
|
||
(if (file-remote-p default-directory)
|
||
magit-remote-git-executable
|
||
magit-git-executable))
|
||
|
||
(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.
|
||
|
||
* Prepend `magit-git-global-arguments' to ARGS.
|
||
* Flatten ARGS, removing nil arguments.
|
||
* If `system-type' is `windows-nt', encode ARGS to `w32-ansi-code-page'."
|
||
(setq args (append magit-git-global-arguments (flatten-tree 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."
|
||
(magit-process-git nil 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-string-p (&rest args)
|
||
"Execute Git with ARGS, returning the first line of its output.
|
||
If the exit code isn't zero or if there is no output, then return
|
||
nil. Neither of these results is considered an error; if that is
|
||
what you want, then use `magit-git-string-ng' instead.
|
||
|
||
This is an experimental replacement for `magit-git-string', and
|
||
still subject to major changes."
|
||
(magit--with-refresh-cache (cons default-directory args)
|
||
(magit--with-temp-process-buffer
|
||
(and (zerop (magit-process-git t args))
|
||
(not (bobp))
|
||
(progn
|
||
(goto-char (point-min))
|
||
(buffer-substring-no-properties (point) (line-end-position)))))))
|
||
|
||
(defun magit-git-string-ng (&rest args)
|
||
"Execute Git with ARGS, returning the first line of its output.
|
||
If the exit code isn't zero or if there is no output, then that
|
||
is considered an error, but instead of actually signaling an
|
||
error, return nil. Additionally the output is put in the process
|
||
buffer (creating it if necessary) and the error message is shown
|
||
in the status buffer (provided it exists).
|
||
|
||
This is an experimental replacement for `magit-git-string', and
|
||
still subject to major changes. Also see `magit-git-string-p'."
|
||
(magit--with-refresh-cache
|
||
(list default-directory 'magit-git-string-ng args)
|
||
(magit--with-temp-process-buffer
|
||
(let* ((args (magit-process-git-arguments args))
|
||
(status (magit-process-git t args)))
|
||
(if (zerop status)
|
||
(and (not (bobp))
|
||
(progn
|
||
(goto-char (point-min))
|
||
(buffer-substring-no-properties
|
||
(point) (line-end-position))))
|
||
(let ((buf (current-buffer)))
|
||
(with-current-buffer (magit-process-buffer t)
|
||
(magit-process-insert-section default-directory
|
||
magit-git-executable args
|
||
status buf
|
||
'magit-section-secondary-heading)))
|
||
(when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode)))
|
||
(let ((msg (magit--locate-error-message)))
|
||
(with-current-buffer status-buf
|
||
(setq magit-this-error msg))))
|
||
nil)))))
|
||
|
||
(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-tree args))
|
||
(magit--with-refresh-cache (cons default-directory args)
|
||
(magit--with-temp-process-buffer
|
||
(magit-process-git (list t nil) 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-tree args))
|
||
(magit--with-refresh-cache (cons default-directory args)
|
||
(magit--with-temp-process-buffer
|
||
(magit-process-git (list t nil) 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 (list 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 (list output)))))
|
||
|
||
(defun magit-git-config-p (variable &optional default)
|
||
"Return the boolean value of the Git variable VARIABLE.
|
||
VARIABLE has to be specified as a string. Return DEFAULT (which
|
||
defaults to nil) if VARIABLE is unset. If VARIABLE's value isn't
|
||
a boolean, then raise an error."
|
||
(let ((args (list "config" "--bool" "--default" (if default "true" "false")
|
||
variable)))
|
||
(magit--with-refresh-cache (cons default-directory args)
|
||
(magit--with-temp-process-buffer
|
||
(let ((status (magit-process-git t args))
|
||
(output (buffer-substring (point-min) (1- (point-max)))))
|
||
(if (zerop status)
|
||
(equal output "true")
|
||
(signal 'magit-invalid-git-boolean (list output))))))))
|
||
|
||
(defun magit-git-insert (&rest args)
|
||
"Execute Git with ARGS, insert stdout at point and return exit code.
|
||
If `magit-git-debug' is non-nil and the exit code is non-zero, then
|
||
insert the run command and stderr into the process buffer."
|
||
(apply #'magit--git-insert nil args))
|
||
|
||
(defun magit--git-insert (return-error &rest args)
|
||
(setq args (flatten-tree args))
|
||
(if (or return-error magit-git-debug)
|
||
(let (log)
|
||
(unwind-protect
|
||
(let (exit errmsg)
|
||
(setq log (make-temp-file "magit-stderr"))
|
||
(delete-file log)
|
||
(setq exit (magit-process-git (list t log) args))
|
||
(when (or (> exit 0) (eq magit-git-debug 'include-success))
|
||
(when (file-exists-p log)
|
||
(with-temp-buffer
|
||
(insert-file-contents log)
|
||
(goto-char (point-max))
|
||
(setq errmsg
|
||
(cond
|
||
((eq return-error 'full)
|
||
(let ((str (buffer-string)))
|
||
(and (not (equal str "")) str)))
|
||
((functionp magit-git-debug)
|
||
(funcall magit-git-debug (buffer-string)))
|
||
((magit--locate-error-message)))))
|
||
(when magit-git-debug
|
||
(let ((magit-git-debug nil))
|
||
(with-current-buffer (magit-process-buffer t)
|
||
(magit-process-finish-section
|
||
(magit-process-insert-section
|
||
default-directory magit-git-executable
|
||
(magit-process-git-arguments args)
|
||
exit log 'magit-section-secondary-heading)
|
||
exit)))))
|
||
(cond ((not magit-git-debug))
|
||
(errmsg (message "%s" errmsg))
|
||
((zerop exit))
|
||
((message "Git returned with exit-code %s" exit))))
|
||
(or errmsg exit))
|
||
(ignore-errors (delete-file log))))
|
||
(magit-process-git (list t nil) args)))
|
||
|
||
(defun magit--locate-error-message ()
|
||
(goto-char (point-max))
|
||
(and (run-hook-wrapped 'magit-process-error-message-regexps
|
||
(##re-search-backward % nil t))
|
||
(match-str 1)))
|
||
|
||
(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-tree args))
|
||
(magit--with-refresh-cache (cons default-directory args)
|
||
(magit--with-temp-process-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, show a message and add
|
||
a section in the respective process buffer."
|
||
(magit--with-temp-process-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, show a message and add
|
||
a section in the respective process buffer."
|
||
(magit--with-temp-process-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.
|
||
|
||
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 finally call function
|
||
WASHER with ARGS as its sole argument.
|
||
|
||
If git exits with a non-zero exit status, apply the `error' face to
|
||
the error message, instead of calling WASHER. To instead cancel the
|
||
section use `magit--git-wash'."
|
||
(declare (indent 1))
|
||
(apply #'magit--git-wash washer t args))
|
||
|
||
(defun magit--git-wash (washer keep-error &rest args)
|
||
"Execute git with ARGS, inserting washed output at point.
|
||
|
||
Like `magit-git-wash' but if KEEP-ERROR is nil and an error occurs, also
|
||
insert standard error. If KEEP-ERROR is `wash-anyway', insert and wash
|
||
standard output even in case of an error."
|
||
(declare (indent 2))
|
||
(setq args (flatten-tree args))
|
||
(let ((beg (point))
|
||
(exit (magit--git-insert (and keep-error 'full) args)))
|
||
(when (stringp exit)
|
||
(goto-char beg)
|
||
(insert (magit--propertize-face exit 'error))
|
||
(insert (if (bolp) "\n" "\n\n")))
|
||
(if (= (point) beg)
|
||
(magit-cancel-section)
|
||
(unless (bolp)
|
||
(insert "\n"))
|
||
(when (or (equal exit 0)
|
||
(eq keep-error 'wash-anyway))
|
||
(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)))
|
||
exit))
|
||
|
||
(defun magit-git-executable-find (command)
|
||
"Search for COMMAND in Git's exec path, falling back to `exec-path'.
|
||
Like `executable-find', return the absolute file name of the
|
||
executable."
|
||
(or (locate-file command
|
||
(list (concat
|
||
(file-remote-p default-directory)
|
||
(or (magit-git-string "--exec-path")
|
||
(error "`git --exec-path' failed"))))
|
||
exec-suffixes
|
||
#'file-executable-p)
|
||
(compat-call executable-find command t)))
|
||
|
||
;;; Git Version
|
||
|
||
(defconst magit--git-version-regexp
|
||
"\\`git version \\([0-9]+\\(\\.[0-9]+\\)\\{1,2\\}\\)")
|
||
|
||
(defvar magit--host-git-version-cache nil)
|
||
|
||
(defun magit-git-version>= (n)
|
||
"Return t if `magit-git-version's value is greater than or equal to N."
|
||
(magit--version>= (magit-git-version) n))
|
||
|
||
(defun magit-git-version< (n)
|
||
"Return t if `magit-git-version's value is smaller than N."
|
||
(version< (magit-git-version) n))
|
||
|
||
(defun magit-git-version ()
|
||
"Return the Git version used for `default-directory'.
|
||
Raise an error if Git cannot be found, if it exits with a
|
||
non-zero status, or the output does not have the expected
|
||
format."
|
||
(magit--with-refresh-cache default-directory
|
||
(let ((host (file-remote-p default-directory)))
|
||
(or (cdr (assoc host magit--host-git-version-cache))
|
||
(magit--with-temp-process-buffer
|
||
;; Unset global arguments for ancient Git versions.
|
||
(let* ((magit-git-global-arguments nil)
|
||
(status (magit-process-git t "version"))
|
||
(output (buffer-string)))
|
||
(cond
|
||
((not (zerop status))
|
||
(display-warning
|
||
'magit
|
||
(format "%S\n\nRunning \"%s --version\" failed with output:\n\n%s"
|
||
(if host
|
||
(format "Magit cannot find Git on host %S.\n
|
||
Check the value of `magit-remote-git-executable' using
|
||
`magit-debug-git-executable' and consult the info node
|
||
`(tramp)Remote programs'." host)
|
||
"Magit cannot find Git.\n
|
||
Check the values of `magit-git-executable' and `exec-path'
|
||
using `magit-debug-git-executable'.")
|
||
(magit-git-executable)
|
||
output)))
|
||
((save-match-data
|
||
(and (string-match magit--git-version-regexp output)
|
||
(let ((version (match-str 1 output)))
|
||
(push (cons host version)
|
||
magit--host-git-version-cache)
|
||
version))))
|
||
((error "Unexpected \"%s --version\" output: %S"
|
||
(magit-git-executable)
|
||
output)))))))))
|
||
|
||
(defun magit-git-version-assert (&optional minimal who)
|
||
"Assert that the used Git version is greater than or equal to MINIMAL.
|
||
If optional MINIMAL is nil, compare with `magit--minimal-git'
|
||
instead. Optional WHO if non-nil specifies what functionality
|
||
needs at least MINIMAL, otherwise it defaults to \"Magit\"."
|
||
(when (magit-git-version< (or minimal magit--minimal-git))
|
||
(let* ((host (file-remote-p default-directory))
|
||
(msg (format-spec
|
||
(cond (host "\
|
||
%w requires Git %m or greater, but on %h the version is %v.
|
||
|
||
If multiple Git versions are installed on the host, then the
|
||
problem might be that TRAMP uses the wrong executable.
|
||
|
||
Check the value of `magit-remote-git-executable' and consult
|
||
the info node `(tramp)Remote programs'.\n")
|
||
(t "\
|
||
%w requires Git %m or greater, but you are using %v.
|
||
|
||
If you have multiple Git versions installed, then check the
|
||
values of `magit-remote-git-executable' and `exec-path'.\n"))
|
||
`((?w . ,(or who "Magit"))
|
||
(?m . ,(or minimal magit--minimal-git))
|
||
(?v . ,(magit-git-version))
|
||
(?h . ,host)))))
|
||
(display-warning 'magit msg :error))))
|
||
|
||
(defun magit--safe-git-version ()
|
||
"Return the Git version used for `default-directory' or an error message."
|
||
(magit--with-temp-process-buffer
|
||
(let* ((magit-git-global-arguments nil)
|
||
(status (magit-process-git t "version"))
|
||
(output (buffer-string)))
|
||
(cond ((not (zerop status)) output)
|
||
((save-match-data
|
||
(and (string-match magit--git-version-regexp output)
|
||
(match-str 1 output))))
|
||
(output)))))
|
||
|
||
(defun magit-debug-git-executable ()
|
||
"Display a buffer with information about `magit-git-executable'.
|
||
Also include information about `magit-remote-git-executable'.
|
||
See info node `(magit)Debugging Tools' for more information."
|
||
(interactive)
|
||
(with-current-buffer (get-buffer-create "*magit-git-executable*")
|
||
(pop-to-buffer (current-buffer))
|
||
(erase-buffer)
|
||
(insert (format "magit-remote-git-executable: %S\n"
|
||
magit-remote-git-executable))
|
||
(insert (concat
|
||
(format "magit-git-executable: %S" magit-git-executable)
|
||
(and (not (file-name-absolute-p magit-git-executable))
|
||
(format " [%S]" (executable-find magit-git-executable)))
|
||
(format " (%s)\n" (magit--safe-git-version))))
|
||
(insert (format "exec-path: %S\n" exec-path))
|
||
(when-let ((diff (cl-set-difference
|
||
(seq-filter #'file-exists-p (remq nil (parse-colon-path
|
||
(getenv "PATH"))))
|
||
(seq-filter #'file-exists-p (remq nil exec-path))
|
||
:test #'file-equal-p)))
|
||
(insert (format " entries in PATH, but not in exec-path: %S\n" diff)))
|
||
(dolist (execdir exec-path)
|
||
(insert (format " %s (%s)\n" execdir (car (file-attributes execdir))))
|
||
(when (file-directory-p execdir)
|
||
(dolist (exec (directory-files
|
||
execdir t (concat
|
||
"\\`git" (regexp-opt exec-suffixes) "\\'")))
|
||
(insert (format " %s (%s)\n" exec
|
||
(magit--safe-git-version))))))))
|
||
|
||
;;; Variables
|
||
|
||
(defun magit-config-get-from-cached-list (key)
|
||
(gethash
|
||
;; `git config --list' downcases first and last components of the key.
|
||
(let* ((key (replace-regexp-in-string "\\`[^.]+" #'downcase key t t))
|
||
(key (replace-regexp-in-string "[^.]+\\'" #'downcase key t t)))
|
||
key)
|
||
(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 (string-join keys ".")))
|
||
(if (and magit--refresh-cache (not arg))
|
||
(magit-config-get-from-cached-list key)
|
||
(magit-git-items "config" arg "-z" "--get-all" "--include" key))))
|
||
|
||
(defun magit-get-boolean (&rest keys)
|
||
"Return the boolean value of the Git variable specified by KEYS.
|
||
Also see `magit-git-config-p'."
|
||
(let ((arg (and (or (null (car keys))
|
||
(string-prefix-p "--" (car keys)))
|
||
(pop keys)))
|
||
(key (string-join keys ".")))
|
||
(equal (if magit--refresh-cache
|
||
(car (last (magit-config-get-from-cached-list key)))
|
||
(magit-git-str "config" arg "--bool" "--include" 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 (string-join 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 (string-join keys ".")))
|
||
(when (magit-get var)
|
||
(magit-call-git "config" arg "--unset-all" var))
|
||
(dolist (v values)
|
||
(magit-call-git "config" arg "--add" var v))))
|
||
|
||
;;; 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 (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)
|
||
"Like (expand-file-name PATH (magit-gitdir)) or just (magit-gitdir)."
|
||
(declare (obsolete magit-gitdir "Magit 4.0.0"))
|
||
(and$ (magit-gitdir)
|
||
(if path (expand-file-name (convert-standard-filename path) $) $)))
|
||
|
||
(defun magit-gitdir (&optional directory)
|
||
"Return the absolute and resolved path of the .git directory.
|
||
|
||
If the `GIT_DIR' environment variable is defined, return that.
|
||
Otherwise return the .git directory for DIRECTORY, or if that is
|
||
nil, then for `default-directory' instead. If the directory is
|
||
not located inside a Git repository, then return nil."
|
||
(let ((default-directory (or directory default-directory)))
|
||
(magit--with-refresh-cache (list default-directory 'magit-gitdir)
|
||
(magit--with-safe-default-directory nil
|
||
(and-let*
|
||
((dir (magit-rev-parse-safe "--git-dir"))
|
||
(dir (file-name-as-directory (magit-expand-git-file-name dir))))
|
||
(if (file-remote-p dir)
|
||
dir
|
||
(concat (file-remote-p default-directory) dir)))))))
|
||
|
||
(defvar magit--separated-gitdirs nil)
|
||
|
||
(defun magit--record-separated-gitdir ()
|
||
(let ((topdir (magit-toplevel))
|
||
(gitdir (magit-gitdir)))
|
||
;; 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
|
||
(cond-let*
|
||
([topdir (magit-rev-parse-safe "--show-toplevel")]
|
||
[topdir (magit-expand-git-file-name topdir)]
|
||
(cond-let*
|
||
(;; 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.
|
||
[updir (file-name-as-directory
|
||
(magit-rev-parse-safe "--show-cdup"))]
|
||
[updir (if (file-name-absolute-p updir)
|
||
(concat (file-remote-p default-directory) updir)
|
||
(expand-file-name updir))]
|
||
[updir->topdir
|
||
(let ((default-directory updir))
|
||
(and (string-equal (magit-rev-parse-safe "--show-cdup") "")
|
||
(magit-rev-parse-safe "--show-toplevel")))]
|
||
[_(string-equal (magit-expand-git-file-name updir->topdir) topdir)]
|
||
updir)
|
||
((concat (file-remote-p default-directory)
|
||
(file-name-as-directory topdir)))))
|
||
([gitdir (magit-rev-parse-safe "--git-dir")]
|
||
[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)))]
|
||
(cond-let*
|
||
((magit-bare-repo-p) gitdir)
|
||
;; Return the linked working tree, if any.
|
||
([link (expand-file-name "gitdir" gitdir)]
|
||
[wtree (and (file-exists-p link)
|
||
(magit-file-line link))]
|
||
;; Ignore ".git/gitdir" files that result from a Git bug.
|
||
;; This has long been fixed, but old repository may still
|
||
;; exist that contain such a file. See #2364.
|
||
[_(not (equal wtree ".git"))]
|
||
(concat (file-remote-p default-directory)
|
||
(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)))
|
||
;; Step outside the control directory to enter the working tree.
|
||
((file-name-directory (directory-file-name gitdir)))))))))
|
||
|
||
(defun magit--toplevel-safe ()
|
||
(or (magit-toplevel)
|
||
(magit--not-inside-repository-error)))
|
||
|
||
(defmacro magit-with-toplevel (&rest body)
|
||
(declare (indent defun) (debug (body)))
|
||
`(let ((default-directory (magit--toplevel-safe)))
|
||
,@body))
|
||
|
||
(define-error 'magit-outside-git-repo "Not inside Git repository")
|
||
(define-error 'magit-corrupt-git-config "Corrupt Git configuration")
|
||
(define-error 'magit-git-executable-not-found
|
||
(concat "Git executable cannot be found "
|
||
"(see https://magit.vc/goto/e6a78ed2)"))
|
||
|
||
(defun magit--assert-usable-git ()
|
||
(if (not (compat-call executable-find (magit-git-executable) t))
|
||
(signal 'magit-git-executable-not-found (magit-git-executable))
|
||
(let ((magit-git-debug
|
||
(lambda (err)
|
||
(signal 'magit-corrupt-git-config
|
||
(format "%s: %s" default-directory err)))))
|
||
;; This should always succeed unless there is a corrupt
|
||
;; config (or possibly a similarly severe failing state).
|
||
(magit-git-string "config" "--default=_" "core.bare"))
|
||
nil))
|
||
|
||
(defun magit--not-inside-repository-error ()
|
||
(magit--assert-usable-git)
|
||
(signal 'magit-outside-git-repo default-directory))
|
||
|
||
(defun magit-inside-gitdir-p (&optional 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-gitdir)))
|
||
(cond (gitdir (file-in-directory-p default-directory gitdir))
|
||
(noerror nil)
|
||
((signal 'magit-outside-git-repo default-directory))))))
|
||
|
||
(defun magit-inside-worktree-p (&optional noerror)
|
||
"Return t if `default-directory' is below a 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))))))
|
||
|
||
(cl-defgeneric 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))))))
|
||
|
||
(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."
|
||
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
|
||
(and-let* ((file (or file
|
||
(magit-buffer-file-name)
|
||
(and (derived-mode-p 'dired-mode)
|
||
default-directory)))
|
||
(dir (magit-toplevel (magit--safe-default-directory
|
||
(file-name-parent-directory file))))
|
||
(_(or (not tracked)
|
||
(magit-file-tracked-p file))))
|
||
(file-relative-name file dir))))
|
||
|
||
(defun magit-file-ignored-p (file)
|
||
(magit-git-string-p "ls-files" "--others" "--ignored" "--exclude-standard"
|
||
"--" (magit-convert-filename-for-git file)))
|
||
|
||
(defun magit-file-tracked-p (file)
|
||
(magit-git-success "ls-files" "--error-unmatch"
|
||
"--" (magit-convert-filename-for-git file)))
|
||
|
||
(defun magit-list-files (&rest args)
|
||
(apply #'magit-git-items "ls-files" "-z" "--full-name" args))
|
||
|
||
(defun magit-tracked-files (&rest args)
|
||
(magit-list-files "--cached" args))
|
||
|
||
(defun magit-untracked-files (&optional all files &rest args)
|
||
"Return a list of untracked files.
|
||
|
||
Note that when using \"--directory\", the rules from \".gitignore\"
|
||
files from sub-directories are ignore, which is probably a Git bug.
|
||
See also `magit-list-untracked-files', which does not have this
|
||
issue."
|
||
(magit-list-files "--other" args
|
||
(and (not all) "--exclude-standard")
|
||
"--" files))
|
||
|
||
(defun magit-list-untracked-files (&optional files)
|
||
"Return a list of untracked files.
|
||
|
||
List files if `magit-status-show-untracked-files' is non-nil, but also
|
||
take the local value of Git variable `status.showUntrackedFiles' into
|
||
account. The local value of the Lisp variable takes precedence over the
|
||
local value of the Git variable. The global value of the Git variable
|
||
is always ignored.
|
||
|
||
See also `magit-untracked-files'."
|
||
(and-let*
|
||
((value (or (and (local-variable-p 'magit-status-show-untracked-files)
|
||
magit-status-show-untracked-files)
|
||
(pcase (magit-get "--local" "status.showUntrackedFiles")
|
||
((or "no" "off" "false" "0") 'no)
|
||
((or "yes" "on" "true" "1") t)
|
||
("all" 'all))
|
||
magit-status-show-untracked-files))
|
||
(_(not (eq value 'no))))
|
||
(seq-keep (##and (eq (aref % 0) ??)
|
||
(substring % 3))
|
||
(apply #'magit-git-items "status" "-z" "--porcelain"
|
||
(format "--untracked-files=%s"
|
||
(if (eq value 'all) "all" "normal"))
|
||
"--" files))))
|
||
|
||
(defun magit-ignored-files (&rest args)
|
||
(magit-list-files "--others" "--ignored" "--exclude-standard" args))
|
||
|
||
(defun magit-modified-files (&optional nomodules files)
|
||
(magit-git-items "diff-index" "-z" "--name-only"
|
||
;; Work around a bug in Git v2.46.0. See #5212 and #5221.
|
||
(if nomodules "--ignore-submodules" "--submodule=short")
|
||
(magit-headish) "--" files))
|
||
|
||
(defun magit-unstaged-files (&optional nomodules files)
|
||
(magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=u"
|
||
;; Work around a bug in Git v2.46.0. See #5212 and #5221.
|
||
(if nomodules "--ignore-submodules" "--submodule=short")
|
||
"--" files))
|
||
|
||
(defun magit-staged-files (&optional nomodules files)
|
||
(magit-git-items "diff-index" "-z" "--name-only" "--cached"
|
||
;; Work around a bug in Git v2.46.0. See #5212 and #5221.
|
||
(if nomodules "--ignore-submodules" "--submodule=short")
|
||
(magit-headish) "--" files))
|
||
|
||
(defun magit-binary-files (&rest args)
|
||
(seq-keep (##and (string-match "^-\t-\t\\(.+\\)" %)
|
||
(match-str 1 %))
|
||
(apply #'magit-git-items
|
||
"diff" "-z" "--numstat" "--ignore-submodules"
|
||
args)))
|
||
|
||
(defun magit-unmerged-files ()
|
||
(magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=U"))
|
||
|
||
(defun magit-stashed-files (stash)
|
||
(magit-git-items "stash" "show" "-z" "--name-only" stash))
|
||
|
||
(defun magit-skip-worktree-files (&rest args)
|
||
(seq-keep (##and (= (aref % 0) ?S)
|
||
(substring % 2))
|
||
(magit-list-files "-t" args)))
|
||
|
||
(defun magit-assume-unchanged-files (&rest args)
|
||
(seq-keep (##and (memq (aref % 0) '(?h ?s ?m ?r ?c ?k))
|
||
(substring % 2))
|
||
(magit-list-files "-v" args)))
|
||
|
||
(defun magit-revision-files (rev)
|
||
(magit-with-toplevel
|
||
(magit-git-items "ls-tree" "-z" "-r" "--name-only" rev)))
|
||
|
||
(defun magit-revision-directories (rev)
|
||
"List directories that contain a tracked file in revision REV."
|
||
(magit-with-toplevel
|
||
(mapcar #'file-name-as-directory
|
||
(magit-git-items "ls-tree" "-z" "-r" "-d" "--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)
|
||
(mapcar (pcase-lambda (`(,_status ,fileA ,fileB))
|
||
(cons fileA fileB))
|
||
(seq-partition (magit-git-items "diff" "-z" "--name-status"
|
||
"--find-renames"
|
||
"--diff-filter=R" revA revB)
|
||
3)))
|
||
|
||
(defun magit--rev-file-name (file rev other-rev)
|
||
"For FILE, potentially renamed between REV and OTHER-REV, return name in REV.
|
||
Return nil, if FILE appears neither in REV nor OTHER-REV,
|
||
or if no rename is detected."
|
||
(or (car (member file (magit-revision-files rev)))
|
||
(and$ (magit-renamed-files rev other-rev)
|
||
(car (rassoc file $)))))
|
||
|
||
(defun magit-file-status (&rest args)
|
||
(magit--with-temp-process-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
|
||
(and (eq system-type 'windows-nt)
|
||
(cl-sort (mapcar
|
||
(lambda (mount)
|
||
(if (string-match "^\\(.*\\) on \\(.*\\) type" mount)
|
||
(cons (file-name-as-directory (match-str 2 mount))
|
||
(file-name-as-directory (match-str 1 mount)))
|
||
(lwarn '(magit) :error
|
||
"Failed to parse Cygwin mount: %S" mount)))
|
||
;; 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 (and (not (file-remote-p default-directory)) ; see #4976
|
||
(cl-assoc filename magit-cygwin-mount-points
|
||
:test (##string-prefix-p %2 %1)))))
|
||
(concat (cdr cyg:win)
|
||
(substring filename (length (car cyg:win))))
|
||
filename))
|
||
|
||
(defun magit-convert-filename-for-git (filename)
|
||
"Convert FILENAME so that it can be passed to git.
|
||
1. If it is a absolute filename, then pass it through
|
||
`expand-file-name' to replace things such as \"~/\" that
|
||
Git does not understand.
|
||
2. If it is a remote filename, then remove the remote part.
|
||
3. Deal with an `windows-nt' Emacs vs. Cygwin Git incompatibility."
|
||
(cond-let
|
||
((not (file-name-absolute-p filename))
|
||
filename)
|
||
([cyg:win (cl-rassoc filename magit-cygwin-mount-points
|
||
:test (##string-prefix-p %2 %1))]
|
||
(concat (car cyg:win)
|
||
(substring filename (length (cdr cyg:win)))))
|
||
([expanded (expand-file-name filename)]
|
||
(or (file-remote-p expanded 'localname)
|
||
expanded))))
|
||
|
||
(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 (&optional expand assert)
|
||
(cond-let
|
||
([file (magit-section-case
|
||
(file (oref it value))
|
||
(hunk (magit-section-parent-value it)))]
|
||
(if expand
|
||
(expand-file-name file (magit-toplevel))
|
||
file))
|
||
(assert
|
||
(user-error "No file at point"))))
|
||
|
||
(defun magit-current-file ()
|
||
(or (magit-file-relative-name)
|
||
(magit-file-at-point)
|
||
(and (derived-mode-p 'magit-log-mode)
|
||
(car magit-buffer-log-files))))
|
||
|
||
;;; 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."
|
||
;; The "--submodule=short" is needed to work around a bug in Git v2.46.0
|
||
;; and v2.46.1. See #5212 and #5221. There are actually two related
|
||
;; bugs, both of which are fixed in v2.46.2, with the following commits,
|
||
;; but there is no workaround for the second bug.
|
||
;; 11591850dd diff: report dirty submodules as changes in builtin_diff()
|
||
;; 87cf96094a diff: report copies and renames as changes in run_diff_cmd()
|
||
(magit-git-failure "diff" "--quiet" "--cached"
|
||
(if ignore-submodules
|
||
"--ignore-submodules"
|
||
"--submodule=short")
|
||
"--" 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"
|
||
(if ignore-submodules
|
||
"--ignore-submodules"
|
||
;; Work around a bug in Git v2.46.0. See #5212 and #5221.
|
||
"--submodule=short")
|
||
"--" 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 ".git" module))))
|
||
|
||
(defun magit-module-no-worktree-p (module)
|
||
(not (magit-module-worktree-p module)))
|
||
|
||
(defun magit-ignore-submodules-p (&optional return-argument)
|
||
(or (cl-find-if (##string-prefix-p "--ignore-submodules" %)
|
||
magit-buffer-diff-args)
|
||
(and$ (magit-get "diff.ignoreSubmodules")
|
||
(if return-argument
|
||
(concat "--ignore-submodules=" $)
|
||
(concat "diff.ignoreSubmodules=" $)))))
|
||
|
||
;;; 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-git-string-p "rev-parse" "--verify" rev))
|
||
|
||
(defun magit-commit-p (rev)
|
||
"Return full hash for REV if it names an existing commit."
|
||
(magit-rev-verify (magit--rev-dereference rev)))
|
||
|
||
(defalias 'magit-rev-verify-commit #'magit-commit-p)
|
||
|
||
(defalias 'magit-rev-hash #'magit-commit-p)
|
||
|
||
(defun magit--rev-dereference (rev)
|
||
"Return a rev that forces Git to interpret REV as a commit.
|
||
If REV is nil or has the form \":/TEXT\", return REV itself."
|
||
(cond ((not rev) nil)
|
||
((string-match-p "^:/" rev) rev)
|
||
((concat rev "^{commit}"))))
|
||
|
||
(defun magit-rev-equal (a b)
|
||
"Return t if there are no differences between the commits A and B."
|
||
(magit-git-success "diff" "--quiet" a b))
|
||
|
||
(defun magit-rev-eq (a b)
|
||
"Return t if A and B refer to the same commit."
|
||
(let ((a (magit-commit-p a))
|
||
(b (magit-commit-p 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-search ".." 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 not-anchored)
|
||
"Return a symbolic name for REV using `git-name-rev'.
|
||
|
||
PATTERN can be used to limit the result to a matching ref. Unless
|
||
NOT-ANCHORED is non-nil, the beginning of the ref must match PATTERN.
|
||
An anchored lookup is done using the arguments \"--exclude=*/<PATTERN>\"
|
||
and \"--exclude=*/HEAD\", in addition to \"--refs=<PATTERN>\"."
|
||
(magit-git-string "name-rev" "--name-only" "--no-undefined"
|
||
(and pattern (concat "--refs=" pattern))
|
||
(and pattern
|
||
(not not-anchored)
|
||
(list "--exclude=*/HEAD"
|
||
(concat "--exclude=*/" pattern)))
|
||
rev))
|
||
|
||
(defun magit-rev-branch (rev)
|
||
(and$ (magit-rev-name rev "refs/heads/*")
|
||
(and (not (string-match-p "[~^]" $)) $)))
|
||
|
||
(defun magit-rev-fixup-target (rev)
|
||
(let ((msg (magit-rev-format "%s" rev)))
|
||
(save-match-data
|
||
(and (string-match "\\`\\(squash!\\|fixup!\\|amend!\\) \\(.+\\)" msg)
|
||
(magit-rev-format
|
||
"%h" (format "%s^{/^%s}" rev
|
||
(magit--ext-regexp-quote (match-str 2 msg))))))))
|
||
|
||
(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-str 1 name))
|
||
name
|
||
(match-str 1 name)))
|
||
((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)
|
||
(and$ (magit-rev-name rev "refs/heads/*")
|
||
(and (or lax (not (string-match-p "[~^]" $))) $)))
|
||
|
||
(defun magit-name-remote-branch (rev &optional lax)
|
||
(and$ (magit-rev-name rev "refs/remotes/*")
|
||
(and (or lax (not (string-match-p "[~^]" $)))
|
||
(substring $ 8))))
|
||
|
||
(defun magit-name-tag (rev &optional lax)
|
||
(and-let ((name (magit-rev-name rev "refs/tags/*")))
|
||
(progn
|
||
(when (string-suffix-p "^0" name)
|
||
(setq name (substring name 0 -2)))
|
||
(and (or lax (not (string-match-p "[~^]" name)))
|
||
(substring name 5)))))
|
||
|
||
(defun magit-ref-abbrev (refname)
|
||
"Return an unambiguous abbreviation of REFNAME."
|
||
(magit-rev-parse "--verify" "--abbrev-ref" refname))
|
||
|
||
(defun magit-ref-fullname (refname)
|
||
"Return fully qualified refname for REFNAME.
|
||
If REFNAME is ambiguous, return nil."
|
||
(magit-rev-parse "--verify" "--symbolic-full-name" refname))
|
||
|
||
(defun magit-ref-ambiguous-p (refname)
|
||
(save-match-data
|
||
(if (string-match "\\`\\([^^~]+\\)\\(.*\\)" refname)
|
||
(not (magit-ref-fullname (match-str 1 refname)))
|
||
(error "%S has an unrecognized format" refname))))
|
||
|
||
(defun magit-ref-maybe-qualify (refname &optional prefix)
|
||
"If REFNAME is ambiguous, try to disambiguate it by prepend PREFIX to it.
|
||
Return an unambiguous refname, either REFNAME or that prefixed
|
||
with PREFIX, nil otherwise. If REFNAME has an offset suffix
|
||
such as \"~1\", then that is preserved. If optional PREFIX is
|
||
nil, then use \"heads/\"."
|
||
(if (magit-ref-ambiguous-p refname)
|
||
(let ((refname (concat (or prefix "heads/") refname)))
|
||
(and (not (magit-ref-ambiguous-p refname)) refname))
|
||
refname))
|
||
|
||
(defun magit-ref-exists-p (ref)
|
||
(magit-git-success "show-ref" "--verify" ref))
|
||
|
||
(defun magit-ref-equal (a b)
|
||
"Return t if the refnames 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. Refnames
|
||
may be abbreviated."
|
||
(let ((a (magit-ref-fullname a))
|
||
(b (magit-ref-fullname b)))
|
||
(and a b (equal a b))))
|
||
|
||
(defun magit-ref-eq (a b)
|
||
"Return t if the refnames 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 the `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))))
|
||
(pullreq (and (fboundp 'forge--pullreq-branch)
|
||
(magit-branch-p
|
||
(forge--pullreq-branch (oref it value)))))
|
||
(related-refs (magit--painted-branch-at-point))
|
||
((unpulled unpushed)
|
||
(magit-ref-abbrev
|
||
(replace-regexp-in-string "\\.\\.\\.?" "" (oref it value))))))
|
||
|
||
(defun magit--painted-branch-at-point (&optional type)
|
||
(or (and (not (eq type 'remote))
|
||
(memq (get-text-property (magit-point) 'font-lock-face)
|
||
(list 'magit-branch-local
|
||
'magit-branch-current))
|
||
(and$ (magit-thing-at-point 'git-revision t)
|
||
(cdr (magit-split-branch-name $))))
|
||
(and (not (eq type 'local))
|
||
(memq (get-text-property (magit-point) 'font-lock-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)
|
||
(magit-thing-at-point 'git-revision t)
|
||
(and-let ((chunk (and (bound-and-true-p magit-blame-mode)
|
||
(fboundp 'magit-current-blame-chunk)
|
||
(magit-current-blame-chunk))))
|
||
(oref chunk orig-rev))
|
||
(and (derived-mode-p 'magit-stash-mode
|
||
'magit-merge-preview-mode
|
||
'magit-revision-mode)
|
||
magit-buffer-revision)))
|
||
|
||
(defun magit-branch-or-commit-at-point ()
|
||
(or (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) rev))))
|
||
(tag (magit-ref-maybe-qualify (oref it value) "tags/"))
|
||
(pullreq (or (and (fboundp 'forge--pullreq-branch)
|
||
(magit-branch-p
|
||
(forge--pullreq-branch (oref it value))))
|
||
(magit-ref-p (format "refs/pullreqs/%s"
|
||
(oref (oref it value) number)))))
|
||
((unpulled unpushed)
|
||
(magit-ref-abbrev
|
||
(replace-regexp-in-string "\\.\\.\\.?" "" (oref it value)))))
|
||
(magit-thing-at-point 'git-revision t)
|
||
(and-let ((chunk (and (bound-and-true-p magit-blame-mode)
|
||
(fboundp 'magit-current-blame-chunk)
|
||
(magit-current-blame-chunk))))
|
||
(oref chunk orig-rev))
|
||
(and magit-buffer-file-name
|
||
magit-buffer-refname)
|
||
(and (derived-mode-p 'magit-stash-mode
|
||
'magit-merge-preview-mode
|
||
'magit-revision-mode)
|
||
magit-buffer-revision)))
|
||
|
||
(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 remote] (magit-section-parent-value it))))
|
||
|
||
(defun magit-module-at-point (&optional predicate)
|
||
(when (magit-section-match 'module)
|
||
(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 (cond ((> (- (float-time) t0) magit-get-previous-branch-timeout)
|
||
(setq prev nil))
|
||
((setq prev (magit-rev-verify (format "@{-%d}" i)))
|
||
(or (not (setq prev (magit-rev-branch prev)))
|
||
(equal prev current))))
|
||
(cl-incf i))
|
||
prev))
|
||
|
||
(defun magit--set-default-branch (newname oldname)
|
||
(let ((remote (or (magit-primary-remote)
|
||
(user-error "Cannot determine primary remote")))
|
||
(branches (mapcar (##split-string % "\t")
|
||
(magit-git-lines
|
||
"for-each-ref" "refs/heads"
|
||
"--format=%(refname:short)\t%(upstream:short)"))))
|
||
(when-let ((old (assoc oldname branches))
|
||
(_(not (assoc newname branches))))
|
||
(magit-call-git "branch" "-m" oldname newname)
|
||
(setcar old newname))
|
||
(let ((new (if (magit-branch-p newname)
|
||
newname
|
||
(concat remote "/" newname))))
|
||
(pcase-dolist (`(,branch ,upstream) branches)
|
||
(cond
|
||
((equal upstream oldname)
|
||
(magit-set-upstream-branch branch new))
|
||
((equal upstream (concat remote "/" oldname))
|
||
(magit-set-upstream-branch branch (concat remote "/" newname))))))))
|
||
|
||
(defun magit--get-default-branch (&optional update)
|
||
(let ((remote (magit-primary-remote)))
|
||
(when update
|
||
(if (not remote)
|
||
(user-error "Cannot determine primary remote")
|
||
(message "Determining default branch...")
|
||
(magit-git "fetch" "--prune")
|
||
(magit-git "remote" "set-head" "--auto" remote)
|
||
(message "Determining default branch...done")))
|
||
(let ((branch (magit-git-string "symbolic-ref" "--short"
|
||
(format "refs/remotes/%s/HEAD" remote))))
|
||
(when (and update (not branch))
|
||
(error "Cannot determine new default branch"))
|
||
(list remote (and branch (cdr (magit-split-branch-name branch)))))))
|
||
|
||
(defun magit-set-upstream-branch (branch upstream)
|
||
"Set UPSTREAM as the upstream of BRANCH.
|
||
If UPSTREAM is nil, then unset BRANCH's upstream.
|
||
Otherwise UPSTREAM has to be an existing branch."
|
||
(if upstream
|
||
(magit-call-git "branch" "--set-upstream-to" upstream branch)
|
||
(magit-call-git "branch" "--unset-upstream" branch)))
|
||
|
||
(defun magit-get-upstream-ref (&optional branch)
|
||
"Return the upstream branch of BRANCH as a fully qualified ref.
|
||
It BRANCH is nil, then return the upstream of the current branch,
|
||
if any, nil otherwise. If the upstream is not configured, the
|
||
configured remote is an url, or the named branch does not exist,
|
||
then return nil. I.e., return an existing local or
|
||
remote-tracking branch ref."
|
||
(and$ (or branch (magit-get-current-branch))
|
||
(magit-ref-fullname (concat $ "@{upstream}"))))
|
||
|
||
(defun magit-get-upstream-branch (&optional branch)
|
||
"Return the name of the upstream branch of BRANCH.
|
||
It BRANCH is nil, then return the upstream of the current branch
|
||
if any, nil otherwise. If the upstream is not configured, the
|
||
configured remote is an url, or the named branch does not exist,
|
||
then return nil. I.e., return the name of an existing local or
|
||
remote-tracking branch. The returned string is colorized
|
||
according to the branch type."
|
||
(magit--with-refresh-cache
|
||
(list default-directory 'magit-get-upstream-branch branch)
|
||
(and-let* ((branch (or branch (magit-get-current-branch)))
|
||
(upstream (magit-ref-abbrev (concat branch "@{upstream}"))))
|
||
(magit--propertize-face
|
||
upstream (if (equal (magit-get "branch" branch "remote") ".")
|
||
'magit-branch-local
|
||
'magit-branch-remote)))))
|
||
|
||
(defun magit-get-local-upstream-branch (&optional branch)
|
||
(and-let* ((upstream (magit-get-upstream-branch branch))
|
||
(upstream (cdr (magit-split-branch-name upstream))))
|
||
(and (magit-branch-p 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
|
||
(seq-some (##if (magit-git-success "check-ref-format" "--branch" %)
|
||
(equal % branch)
|
||
(string-match-p % 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...
|
||
(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 allow-unnamed)
|
||
(and-let* ((branch (or branch (magit-get-current-branch)))
|
||
(remote (magit-get "branch" branch "remote")))
|
||
(and (not (equal remote "."))
|
||
(cond ((member remote (magit-list-remotes))
|
||
(magit--propertize-face remote 'magit-branch-remote))
|
||
((and allow-unnamed
|
||
(string-match-p "\\(\\`.\\{0,2\\}/\\|[:@]\\)" remote))
|
||
(magit--propertize-face remote 'bold))))))
|
||
|
||
(defun magit-get-unnamed-upstream (&optional branch)
|
||
(and-let* ((branch (or branch (magit-get-current-branch)))
|
||
(remote (magit-get "branch" branch "remote"))
|
||
(merge (magit-get "branch" branch "merge")))
|
||
(and (magit--unnamed-upstream-p remote merge)
|
||
(list (magit--propertize-face remote 'bold)
|
||
(magit--propertize-face merge 'magit-branch-remote)))))
|
||
|
||
(defun magit--unnamed-upstream-p (remote merge)
|
||
(and remote (string-match-p "\\(\\`\\.\\{0,2\\}/\\|[:@]\\)" remote)
|
||
merge (string-prefix-p "refs/" merge)))
|
||
|
||
(defun magit--valid-upstream-p (remote merge)
|
||
(and (or (equal remote ".")
|
||
(member remote (magit-list-remotes)))
|
||
(string-prefix-p "refs/" merge)))
|
||
|
||
(defun magit-get-current-remote (&optional allow-unnamed)
|
||
(or (magit-get-upstream-remote nil allow-unnamed)
|
||
(and-let* ((remotes (magit-list-remotes))
|
||
(remote (if (length= remotes 1)
|
||
(car remotes)
|
||
(magit-primary-remote))))
|
||
(magit--propertize-face remote 'magit-branch-remote))))
|
||
|
||
(defun magit-get-push-remote (&optional branch)
|
||
(and-let ((remote
|
||
(or (and (or branch (setq branch (magit-get-current-branch)))
|
||
(magit-get "branch" branch "pushRemote"))
|
||
(magit-get "remote.pushDefault"))))
|
||
(magit--propertize-face remote 'magit-branch-remote)))
|
||
|
||
(defun magit-get-push-branch (&optional branch verify)
|
||
(magit--with-refresh-cache
|
||
(list default-directory 'magit-get-push-branch branch verify)
|
||
(and-let* ((branch (or branch (setq branch (magit-get-current-branch))))
|
||
(remote (magit-get-push-remote branch))
|
||
(target (concat remote "/" branch)))
|
||
(and (or (not verify)
|
||
(magit-rev-verify target))
|
||
(magit--propertize-face target 'magit-branch-remote)))))
|
||
|
||
(defun magit-get-@{push}-branch (&optional branch)
|
||
(let ((ref (magit-rev-parse "--symbolic-full-name"
|
||
(concat branch "@{push}"))))
|
||
(and ref
|
||
(string-prefix-p "refs/remotes/" ref)
|
||
(substring ref 13))))
|
||
|
||
(defun magit-get-remote (&optional branch)
|
||
(and (or branch (setq branch (magit-get-current-branch)))
|
||
(let ((remote (magit-get "branch" branch "remote")))
|
||
(and (not (equal remote "."))
|
||
remote))))
|
||
|
||
(defun magit-get-some-remote (&optional branch)
|
||
(or (magit-get-remote branch)
|
||
(and$ (magit-main-branch)
|
||
(magit-get-remote $))
|
||
(magit-primary-remote)
|
||
(car (magit-list-remotes))))
|
||
|
||
(defvar magit-primary-remote-names
|
||
'("upstream" "origin"))
|
||
|
||
(defun magit-primary-remote ()
|
||
"Return the primary remote.
|
||
|
||
The primary remote is the remote that tracks the repository that
|
||
other repositories are forked from. It often is called \"origin\"
|
||
but because many people name their own fork \"origin\", using that
|
||
term would be ambiguous. Likewise we avoid the term \"upstream\"
|
||
because a branch's @{upstream} branch may be a local branch or a
|
||
branch from a remote other than the primary remote.
|
||
|
||
If a remote exists whose name matches `magit.primaryRemote', then
|
||
that is considered the primary remote. If no remote by that name
|
||
exists, then remotes in `magit-primary-remote-names' are tried in
|
||
order and the first remote from that list that actually exists in
|
||
the current repository is considered its primary remote."
|
||
(let ((remotes (magit-list-remotes)))
|
||
(seq-find (##member % remotes)
|
||
(delete-dups
|
||
(delq nil
|
||
(cons (magit-get "magit.primaryRemote")
|
||
magit-primary-remote-names))))))
|
||
|
||
(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 ((upstream (and (magit-branch-p branch)
|
||
(magit-get-upstream-branch branch))))
|
||
(magit-rev-ancestor-p branch upstream)
|
||
t)
|
||
(cond-let
|
||
((eq target t)
|
||
(delete (magit-name-local-branch branch)
|
||
(magit-list-containing-branches branch)))
|
||
([target (or target (magit-get-current-branch))]
|
||
(magit-rev-ancestor-p branch target)))))
|
||
|
||
(defun magit-get-tracked (refname)
|
||
"Return the remote branch tracked by the remote-tracking branch REFNAME.
|
||
The returned value has the form (REMOTE . REF), where REMOTE is
|
||
the name of a remote and REF is the ref local to the remote."
|
||
(and-let ((ref (magit-ref-fullname refname)))
|
||
(save-match-data
|
||
(seq-some (lambda (line)
|
||
(and (string-match "\
|
||
\\`remote\\.\\([^.]+\\)\\.fetch=\\+?\\([^:]+\\):\\(.+\\)" line)
|
||
(let ((rmt (match-str 1 line))
|
||
(src (match-str 2 line))
|
||
(dst (match-str 3 line)))
|
||
(and (string-match (format "\\`%s\\'"
|
||
(string-replace
|
||
"*" "\\(.+\\)" dst))
|
||
ref)
|
||
(cons rmt (string-replace
|
||
"*" (match-str 1 ref) src))))))
|
||
(magit-git-lines "config" "--local" "--list")))))
|
||
|
||
(defun magit-split-branch-name (branch)
|
||
(cond ((member branch (magit-list-local-branch-names))
|
||
(cons "." branch))
|
||
((string-match "/" branch)
|
||
(or (seq-some (lambda (remote)
|
||
(and (string-match
|
||
(format "\\`\\(%s\\)/\\(.+\\)\\'" remote)
|
||
branch)
|
||
(cons (match-str 1 branch)
|
||
(match-str 2 branch))))
|
||
(magit-list-remotes))
|
||
(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."
|
||
(and-let ((str (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\\)?$" str)
|
||
(if with-distance
|
||
`(,(match-str 1 str)
|
||
,(string-to-number (or (match-str 2 str) "0"))
|
||
,@(and (match-str 3 str) (list t)))
|
||
(match-str 1 str)))))
|
||
|
||
(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."
|
||
(and-let ((str (magit-git-str "describe" "--contains" (or rev "HEAD"))))
|
||
(save-match-data
|
||
(when (string-match "^[^^~]+" str)
|
||
(setq str (match-str 0 str))
|
||
(unless (equal str (magit-get-current-tag rev))
|
||
(if with-distance
|
||
(list str (car (magit-rev-diff-count str rev)))
|
||
str))))))
|
||
|
||
(defun magit-list-refs (&optional namespaces format sortby)
|
||
"Return list of references, excluding symbolic 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)\".
|
||
|
||
SORTBY is a key or list of keys to pass to the `--sort' flag
|
||
of `git for-each-ref' to sort the refs within each namespace.
|
||
When nil, use `magit-list-refs-sortby'. If both are nil, use
|
||
\"version:refname\", but only for \"refs/tags\"."
|
||
(let ((format (concat "--format=%(symref) " (or format "%(refname)")))
|
||
(sortby (mapcar (##concat "--sort=" %)
|
||
(ensure-list (or sortby magit-list-refs-sortby)))))
|
||
(seq-keep (lambda (line)
|
||
(pcase-let* ((`(,symrefp ,value)
|
||
(split-string line " "))
|
||
(symrefp (not (equal symrefp ""))))
|
||
(and (not symrefp) value)))
|
||
(mapcan (lambda (ns)
|
||
(if (and (not sortby)
|
||
(equal ns "refs/tags"))
|
||
(magit-git-lines "for-each-ref" format
|
||
"--sort=-version:refname" ns)
|
||
(magit-git-lines "for-each-ref" format sortby ns)))
|
||
(ensure-list
|
||
(or namespaces magit-list-refs-namespaces))))))
|
||
|
||
(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 rev &rest args)
|
||
(seq-remove (##string-match-p "\\(\\`(HEAD\\|HEAD -> \\)" %)
|
||
(mapcar (##substring % 2)
|
||
(magit-git-lines "branch" args relation rev))))
|
||
|
||
(defun magit-list-containing-branches (&optional rev &rest args)
|
||
(magit-list-related-branches "--contains" rev args))
|
||
|
||
(defun magit-list-publishing-branches (&optional rev)
|
||
(seq-filter (##magit-rev-ancestor-p (or rev "HEAD") %)
|
||
magit-published-branches))
|
||
|
||
(defun magit-list-merged-branches (&optional rev &rest args)
|
||
(magit-list-related-branches "--merged" rev args))
|
||
|
||
(defun magit-list-unmerged-branches (&optional rev &rest args)
|
||
(magit-list-related-branches "--no-merged" rev args))
|
||
|
||
(defun magit-list-unmerged-to-upstream-branches ()
|
||
(seq-filter (##and-let ((upstream (magit-get-upstream-branch %)))
|
||
(member % (magit-list-unmerged-branches upstream)))
|
||
(magit-list-local-branch-names)))
|
||
|
||
(defun magit-list-branches-pointing-at (rev)
|
||
(let ((re (format "\\`%s refs/\\(heads\\|remotes\\)/\\(.*\\)\\'"
|
||
(magit-rev-verify rev))))
|
||
(seq-keep (##and (string-match re %)
|
||
(let ((name (match-str 2 %)))
|
||
(and (not (string-suffix-p "HEAD" name))
|
||
name)))
|
||
(magit-git-lines "show-ref"))))
|
||
|
||
(defun magit-list-refnames (&optional namespaces include-special)
|
||
(nconc (magit-list-refs namespaces "%(refname:short)")
|
||
(and include-special
|
||
(magit-list-special-refnames))))
|
||
|
||
(defvar magit-special-refnames
|
||
'("HEAD" "ORIG_HEAD" "FETCH_HEAD" "MERGE_HEAD" "CHERRY_PICK_HEAD"))
|
||
|
||
(defun magit-list-special-refnames ()
|
||
(let ((gitdir (magit-gitdir)))
|
||
(cl-remove-if-not (##file-exists-p (expand-file-name % gitdir))
|
||
magit-special-refnames)))
|
||
|
||
(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)))
|
||
(seq-keep (##and (string-match regexp %)
|
||
(match-str 1 %))
|
||
(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-search "\f" format)
|
||
(mapcar (##split-string % "\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 ()
|
||
(mapcar (##substring % 6) (magit-list-refnames "refs/notes")))
|
||
|
||
(defun magit-remote-list-tags (remote)
|
||
(seq-keep (##and (not (string-suffix-p "^{}" %))
|
||
(substring % 51))
|
||
(magit-git-lines "ls-remote" "--tags" remote)))
|
||
|
||
(defun magit-remote-list-branches (remote)
|
||
(seq-keep (##and (not (string-suffix-p "^{}" %))
|
||
(substring % 52))
|
||
(magit-git-lines "ls-remote" "--heads" remote)))
|
||
|
||
(defun magit-remote-list-refs (remote)
|
||
(seq-keep (##and (not (string-suffix-p "^{}" %))
|
||
(substring % 41))
|
||
(magit-git-lines "ls-remote" remote)))
|
||
|
||
(defun magit-remote-head (remote)
|
||
(and$ (cl-find-if (##string-match
|
||
"\\`ref: refs/heads/\\([^\s\t]+\\)[\s\t]HEAD\\'" %)
|
||
(magit-git-lines "ls-remote" "--symref" remote "HEAD"))
|
||
(match-str 1 $)))
|
||
|
||
(defun magit-list-modified-modules ()
|
||
(seq-keep (##and (string-match "\\`\\+\\([^ ]+\\) \\(.+\\) (.+)\\'" %)
|
||
(match-str 2 %))
|
||
(magit-git-lines "submodule" "status")))
|
||
|
||
(defun magit-list-module-paths ()
|
||
(magit-with-toplevel
|
||
(seq-keep (##and (string-match "^160000 [0-9a-z]\\{40,\\} 0\t\\(.+\\)$" %)
|
||
(match-str 1 %))
|
||
(magit-git-items "ls-files" "-z" "--stage"))))
|
||
|
||
(defun magit-list-module-names ()
|
||
(mapcar #'magit-get-submodule-name (magit-list-module-paths)))
|
||
|
||
(defun magit-get-submodule-name (path)
|
||
"Return the name of the submodule at PATH.
|
||
PATH has to be relative to the super-repository."
|
||
(if (magit-git-version>= "2.38.0")
|
||
;; "git submodule--helper name" was removed,
|
||
;; but might still come back in another form.
|
||
(substring
|
||
(car (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"))
|
||
10 -5)
|
||
(magit-git-string "submodule--helper" "name" path)))
|
||
|
||
(defun magit-list-worktrees ()
|
||
"Return list of the worktrees of this repository.
|
||
|
||
The returned list has the form (PATH COMMIT BRANCH BARE DETACHED
|
||
LOCKED PRUNABLE). The last four elements are booleans, with the
|
||
exception of LOCKED and PRUNABLE, which may also be strings.
|
||
See git-worktree(1) manpage for the meaning of the various parts.
|
||
|
||
This function corrects a situation where \"git worktree list\"
|
||
would claim a worktree is bare, even though the working tree is
|
||
specified using `core.worktree'."
|
||
(let ((remote (file-remote-p default-directory))
|
||
worktrees worktree)
|
||
(dolist (line (if (magit-git-version>= "2.36")
|
||
(magit-git-items "worktree" "list" "--porcelain" "-z")
|
||
(magit-git-lines "worktree" "list" "--porcelain")))
|
||
(cond ((string-prefix-p "worktree" line)
|
||
(let ((path (substring line 9)))
|
||
(when remote
|
||
(setq path (concat remote path)))
|
||
;; If the git directory is separate from the main
|
||
;; worktree, then "git worktree" returns the git
|
||
;; directory instead of the worktree, which isn't
|
||
;; what it is supposed to do and not what we want.
|
||
;; However, if the worktree has been removed, then
|
||
;; we want to return it anyway; instead of nil.
|
||
(setq path (or (magit-toplevel path) path))
|
||
(setq worktree (list path nil nil nil nil nil nil))
|
||
(push worktree worktrees)))
|
||
((string-prefix-p "HEAD" line)
|
||
(setf (nth 1 worktree) (substring line 5)))
|
||
((string-prefix-p "branch" line)
|
||
(setf (nth 2 worktree) (substring line 18)))
|
||
((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 3 worktree) t))))
|
||
((string-equal line "detached")
|
||
(setf (nth 4 worktree) t))
|
||
((string-prefix-p line "locked")
|
||
(setf (nth 5 worktree)
|
||
(if (> (length line) 6) (substring line 7) t)))
|
||
((string-prefix-p line "prunable")
|
||
(setf (nth 6 worktree)
|
||
(if (> (length line) 8) (substring line 9) t)))))
|
||
(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 "refs/")))
|
||
(car (member rev (magit-list-refnames "refs/")))))
|
||
|
||
(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)
|
||
(magit--propertize-face branch (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))))
|
||
|
||
(defvar magit-main-branch-names
|
||
'("main" "master" "trunk" "development")
|
||
"Branch names reserved for use by the primary branch.
|
||
Use function `magit-main-branch' to get the name actually used in
|
||
the current repository.")
|
||
|
||
(defvar magit-long-lived-branches
|
||
(append magit-main-branch-names (list "maint" "next"))
|
||
"Branch names reserved for use by long lived branches.")
|
||
|
||
(defun magit-main-branch ()
|
||
"Return the main branch.
|
||
|
||
If a branch exists whose name matches `init.defaultBranch', then
|
||
that is considered the main branch. If no branch by that name
|
||
exists, then the branch names in `magit-main-branch-names' are
|
||
tried in order. The first branch from that list that actually
|
||
exists in the current repository is considered its main branch."
|
||
(let ((branches (magit-list-local-branch-names)))
|
||
(seq-find (##member % branches)
|
||
(delete-dups
|
||
(delq nil
|
||
(cons (magit-get "init.defaultBranch")
|
||
magit-main-branch-names))))))
|
||
|
||
(defun magit-rev-diff-count (a b &optional first-parent)
|
||
"Return the commits in A but not B and vice versa.
|
||
Return a list of two integers: (A>B B>A).
|
||
|
||
If `first-parent' is set, traverse only first parents."
|
||
(mapcar #'string-to-number
|
||
(split-string (magit-git-string "rev-list"
|
||
"--count" "--left-right"
|
||
(and first-parent "--first-parent")
|
||
(concat a "..." b))
|
||
"\t")))
|
||
|
||
(defun magit-abbrev-length ()
|
||
(cond-let*
|
||
([abbrev (magit-get "core.abbrev")]
|
||
[_(not (equal abbrev "auto"))]
|
||
(string-to-number abbrev))
|
||
;; 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. See #3034.
|
||
([head (magit-rev-parse "--short" "HEAD")]
|
||
[head-len (length head)]
|
||
(min head-len
|
||
(if-let ((rev (magit-rev-parse "--short" "HEAD~")))
|
||
(length rev)
|
||
head-len)))
|
||
;; We're on an unborn branch, but perhaps the repository has
|
||
;; other commits. See #4123.
|
||
([commits (magit-git-lines "rev-list" "-n2" "--all" "--abbrev-commit")]
|
||
(apply #'min (mapcar #'length commits)))
|
||
;; A commit does not exist. Fall back to the default of 7.
|
||
(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--abbrev-if-hash (rev)
|
||
(cond ((or (magit-ref-p rev) (member rev '("{index}" "{worktree}"))) rev)
|
||
((magit-rev-parse (magit-abbrev-arg "short") rev))
|
||
(rev)))
|
||
|
||
(defun magit-commit-children (rev &optional args)
|
||
(seq-keep (lambda (line)
|
||
(pcase-let ((`(,child . ,parents) (split-string line " ")))
|
||
(and (member rev parents) child)))
|
||
(magit-git-lines "log" "--format=%H %P"
|
||
(or args (list "--branches" "--tags" "--remotes"))
|
||
"--not" rev)))
|
||
|
||
(defun magit-commit-parents (rev)
|
||
(and$ (magit-git-string "rev-list" "-1" "--parents" rev)
|
||
(cdr (split-string $))))
|
||
|
||
(defun magit-patch-id (rev)
|
||
(with-connection-local-variables
|
||
(magit--with-temp-process-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)
|
||
;; Prefer `git log --no-walk' to `git show --no-patch' because it
|
||
;; performs better in some scenarios.
|
||
(let ((str (magit-git-string "log" "--no-walk"
|
||
(concat "--format=" format) args
|
||
(if rev (magit--rev-dereference rev) "HEAD")
|
||
"--")))
|
||
(and (not (string-equal str ""))
|
||
str)))
|
||
|
||
(defun magit-rev-insert-format (format &optional rev args)
|
||
;; Prefer `git log --no-walk' to `git show --no-patch' because it
|
||
;; performs better in some scenarios.
|
||
(magit-git-insert "log" "--no-walk"
|
||
(concat "--format=" format) args
|
||
(if rev (magit--rev-dereference rev) "HEAD")
|
||
"--"))
|
||
|
||
(defun magit-format-rev-summary (rev)
|
||
(and-let ((str (magit-rev-format "%h %s" rev)))
|
||
(progn
|
||
(magit--put-face 0 (string-match " " str) 'magit-hash str)
|
||
str)))
|
||
|
||
(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.
|
||
|
||
In log and revision buffers the first regexp submatch becomes the
|
||
\"label\" that represents the ref and is propertized with FONT.
|
||
In refs buffers the displayed text is controlled by other means
|
||
and this option only controls what face is used.")
|
||
|
||
(defun magit-format-ref-labels (string)
|
||
(save-match-data
|
||
(let ((refs (split-string
|
||
(replace-regexp-in-string "\\(tag: \\|HEAD -> \\)" "" string)
|
||
", " t))
|
||
state head upstream tags branches remotes other combined)
|
||
(dolist (ref refs)
|
||
(let* ((face (cdr (seq-find (##string-match (car %) ref)
|
||
magit-ref-namespaces)))
|
||
(name (match-str 1 ref))
|
||
(name (if (and name
|
||
(not (string-prefix-p "refs/tags/" ref))
|
||
(magit-rev-verify (concat "refs/tags/" name)))
|
||
(magit-ref-abbrev ref)
|
||
(or name ref)))
|
||
(name (magit--propertize-face name face)))
|
||
(cl-case face
|
||
((magit-bisect-bad magit-bisect-skip magit-bisect-good)
|
||
(setq state name))
|
||
(magit-head
|
||
(setq head (magit--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
|
||
(seq-keep
|
||
(lambda (name)
|
||
(if (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" name)
|
||
(let ((r (match-str 1 name))
|
||
(b (match-str 2 name)))
|
||
(and (not (equal b "HEAD"))
|
||
(if (equal (concat "refs/remotes/" name)
|
||
(magit-git-string
|
||
"symbolic-ref"
|
||
(format "refs/remotes/%s/HEAD" r)))
|
||
(magit--propertize-face
|
||
name 'magit-branch-remote-head)
|
||
name)))
|
||
name))
|
||
remotes))
|
||
(let* ((current (magit-get-current-branch))
|
||
(target (magit-get-upstream-branch current)))
|
||
(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
|
||
(magit--propertize-face
|
||
name 'magit-branch-current))))
|
||
((equal name target)
|
||
(setq upstream
|
||
(concat push
|
||
(magit--propertize-face
|
||
name '(magit-branch-upstream
|
||
magit-branch-local)))))
|
||
((push (concat push name) combined)))))
|
||
(cond-let
|
||
((or upstream (not target)))
|
||
((member target remotes)
|
||
(magit--add-face-text-property
|
||
0 (length target) 'magit-branch-upstream nil target)
|
||
(setq upstream target)
|
||
(setq remotes (delete target remotes)))
|
||
([target (car (member target combined))]
|
||
(magit--add-face-text-property
|
||
0 (length target) 'magit-branch-upstream nil target)
|
||
(setq upstream target)
|
||
(setq combined (delete target combined)))))
|
||
(string-join (flatten-tree `(,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 (rev file &rest body)
|
||
(declare (indent 2)
|
||
(debug (form form body)))
|
||
`(magit--with-temp-process-buffer
|
||
(let ((buffer-file-name ,file))
|
||
(save-excursion
|
||
(magit-git-insert "cat-file" "-p"
|
||
(concat ,rev ":" 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 (gensym "file")))
|
||
`(let ((magit--refresh-cache nil)
|
||
(,file (magit-convert-filename-for-git
|
||
(make-temp-name
|
||
(expand-file-name "index.magit." (magit-gitdir))))))
|
||
(unwind-protect
|
||
(magit-with-toplevel
|
||
(when-let* ((tree ,tree)
|
||
(_(not (magit-git-success
|
||
"read-tree" ,arg tree
|
||
(concat "--index-output=" ,file)))))
|
||
(error "Cannot read tree %s" tree))
|
||
(with-environment-variables (("GIT_INDEX_FILE" ,file))
|
||
,@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
|
||
(mapcan (##list "-p" %) (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)
|
||
(let ((magit--refresh-cache nil))
|
||
(unless (zerop (magit-call-git "update-ref" "--create-reflog"
|
||
"-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 &optional abbrev)
|
||
(pcase-let* ((`(,beg ,end ,sep) (magit--split-range-raw range))
|
||
(beg (or beg "HEAD"))
|
||
(end (or end "HEAD")))
|
||
(when abbrev
|
||
(setq beg (magit--abbrev-if-hash beg))
|
||
(setq end (magit--abbrev-if-hash end)))
|
||
(pcase sep
|
||
(".." (cons beg end))
|
||
("..." (and$ (magit-git-string "merge-base" beg end)
|
||
(cons (if abbrev (magit-rev-abbrev $) $)
|
||
end))))))
|
||
|
||
(defun magit--split-range-raw (range)
|
||
(and (string-match magit-range-re range)
|
||
(magit-bind-match-strings (beg sep end) range
|
||
(and (or beg end)
|
||
(list beg end sep)))))
|
||
|
||
(defun magit-hash-range (range)
|
||
(if (string-match magit-range-re range)
|
||
(magit-bind-match-strings (beg sep end) range
|
||
(and (or beg end)
|
||
(let ((beg-hash (and beg (magit-rev-hash beg)))
|
||
(end-hash (and end (magit-rev-hash end))))
|
||
(and (or (not beg) beg-hash)
|
||
(or (not end) end-hash)
|
||
(concat beg-hash sep end-hash)))))
|
||
(magit-rev-hash range)))
|
||
|
||
(defvar magit-revision-faces
|
||
'(magit-hash
|
||
magit-tag
|
||
magit-branch-remote
|
||
magit-branch-remote-head
|
||
magit-branch-local
|
||
magit-branch-current
|
||
magit-branch-upstream
|
||
magit-branch-warning
|
||
magit-head
|
||
magit-refname
|
||
magit-refname-stash
|
||
magit-refname-wip
|
||
magit-refname-pullreq))
|
||
|
||
(put 'git-revision 'thing-at-point #'magit-thingatpt--git-revision)
|
||
(defun magit-thingatpt--git-revision (&optional disallow)
|
||
;; Support hashes and references.
|
||
(and-let* ((bounds
|
||
(let ((c (concat "\s\n\t~^:?*[\\" disallow)))
|
||
(cl-letf
|
||
(((get 'git-revision 'beginning-op)
|
||
(lambda ()
|
||
(if (re-search-backward (format "[%s]" c) nil t)
|
||
(forward-char)
|
||
(goto-char (point-min)))))
|
||
((get 'git-revision 'end-op)
|
||
(lambda ()
|
||
(re-search-forward (format "\\=[^%s]*" c) nil t))))
|
||
(bounds-of-thing-at-point 'git-revision))))
|
||
(string (buffer-substring-no-properties (car bounds) (cdr bounds)))
|
||
;; References are allowed to contain most parentheses and
|
||
;; most punctuation, but if those characters appear at the
|
||
;; edges of a possible reference in arbitrary text, then
|
||
;; they are much more likely to be intended as just that:
|
||
;; punctuation and delimiters.
|
||
(string (thread-first string
|
||
(string-trim-left "[(</]")
|
||
(string-trim-right "[])>/.,;!]"))))
|
||
(let (disallow)
|
||
(when (or (string-match-p "\\.\\." string)
|
||
(string-match-p "/\\." string))
|
||
(setq disallow (concat disallow ".")))
|
||
(when (string-match-p "@{" string)
|
||
(setq disallow (concat disallow "@{")))
|
||
(if disallow
|
||
;; These additional restrictions overcompensate,
|
||
;; but that only matters in rare cases.
|
||
(magit-thingatpt--git-revision disallow)
|
||
(and (not (equal string "@"))
|
||
(or (and (>= (length string) 7)
|
||
(string-match-p "[a-z]" string)
|
||
(magit-commit-p string))
|
||
(and (magit-ref-p string)
|
||
(member (get-text-property (point) 'face)
|
||
magit-revision-faces)))
|
||
string)))))
|
||
|
||
(put 'git-revision-range 'thing-at-point #'magit-thingatpt--git-revision-range)
|
||
(defun magit-thingatpt--git-revision-range ()
|
||
;; Support hashes but no references.
|
||
(and-let* ((bounds
|
||
(cl-letf (((get 'git-revision 'beginning-op)
|
||
(lambda ()
|
||
(if (re-search-backward "[^a-z0-9.]" nil t)
|
||
(forward-char)
|
||
(goto-char (point-min)))))
|
||
((get 'git-revision 'end-op)
|
||
(lambda ()
|
||
(and (re-search-forward "[^a-z0-9.]" nil t)
|
||
(backward-char)))))
|
||
(bounds-of-thing-at-point 'git-revision)))
|
||
(range (buffer-substring-no-properties (car bounds) (cdr bounds))))
|
||
;; Validate but return as-is.
|
||
(and (magit-hash-range range) range)))
|
||
|
||
;;; Completion
|
||
|
||
(defvar magit-revision-history nil)
|
||
|
||
(defun magit--minibuf-default-add-commit ()
|
||
(let ((fn minibuffer-default-add-function))
|
||
(setq-local
|
||
minibuffer-default-add-function
|
||
(lambda ()
|
||
(let ((rest (and (functionp fn) (funcall fn))))
|
||
(if-let ((commit (with-selected-window (minibuffer-selected-window)
|
||
(or (magit-thing-at-point 'git-revision-range t)
|
||
(magit-commit-at-point)))))
|
||
(let ((rest (cons commit (delete commit rest)))
|
||
(def minibuffer-default))
|
||
(if (listp def)
|
||
(append def rest)
|
||
(cons def (delete def rest))))
|
||
rest))))))
|
||
|
||
(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 exclude)
|
||
(let* ((current (magit-get-current-branch))
|
||
(branch-at-point (magit-branch-at-point))
|
||
(commit-at-point (magit-commit-at-point))
|
||
(exclude (ensure-list exclude))
|
||
(choices (cl-set-difference (magit-list-refnames nil t)
|
||
exclude :test #'equal)))
|
||
(when (member current exclude)
|
||
(setq current nil))
|
||
(when (member branch-at-point exclude)
|
||
(setq branch-at-point nil))
|
||
(when (and commit-at-point (not branch-at-point))
|
||
(setq choices (cons commit-at-point choices)))
|
||
(minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
|
||
(magit-completing-read
|
||
prompt choices nil 'any nil 'magit-revision-history
|
||
(or branch-at-point commit-at-point secondary-default current)))))
|
||
|
||
(defun magit-read-range-or-commit (prompt &optional secondary-default)
|
||
(magit-read-range
|
||
prompt
|
||
(or (and-let ((revs (magit-region-values '(commit branch) t)))
|
||
(prog1 (concat (car (last revs)) ".." (car revs))
|
||
(deactivate-mark)))
|
||
(magit-branch-or-commit-at-point)
|
||
secondary-default
|
||
(magit-get-current-branch))))
|
||
|
||
(defun magit-read-range (prompt &optional default)
|
||
(minibuffer-with-setup-hook
|
||
(lambda ()
|
||
(magit--minibuf-default-add-commit)
|
||
(setq-local crm-separator "\\.\\.\\.?"))
|
||
(magit-completing-read-multiple
|
||
(concat prompt ": ")
|
||
(magit-list-refnames)
|
||
nil 'any nil 'magit-revision-history default nil t)))
|
||
|
||
(defun magit-read-remote-branch
|
||
(prompt &optional remote default local-branch require-match)
|
||
(let ((choice (magit-completing-read
|
||
prompt
|
||
(cl-union (and local-branch
|
||
(if remote
|
||
(list local-branch)
|
||
(mapcar (##concat % "/" local-branch)
|
||
(magit-list-remotes))))
|
||
(magit-list-remote-branch-names remote t)
|
||
:test #'equal)
|
||
nil (or require-match 'any)
|
||
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"))
|
||
nil 'any))
|
||
|
||
(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 ((choices (nconc (magit-list-local-branch-names)
|
||
(magit-list-special-refnames)))
|
||
(commit (magit-commit-at-point)))
|
||
(when commit
|
||
(push commit choices))
|
||
(minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
|
||
(magit-completing-read prompt choices
|
||
nil 'any nil 'magit-revision-history
|
||
(or (magit-local-branch-at-point) commit)))))
|
||
|
||
(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)
|
||
(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 t 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))
|
||
(not (and (not current)
|
||
(magit-rev-equal atpoint "HEAD")))
|
||
atpoint)
|
||
(and (not (equal current exclude)) current)
|
||
secondary-default
|
||
(magit-get-previous-branch))))
|
||
(minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
|
||
(magit-completing-read prompt (delete exclude (magit-list-refnames))
|
||
nil 'any nil 'magit-revision-history default))))
|
||
|
||
(defun magit-read-other-local-branch
|
||
(prompt &optional exclude secondary-default)
|
||
(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 t 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))
|
||
(seq-find (##not (equal % current)) atrev)
|
||
(magit-get-previous-branch)
|
||
(car atrev)))))
|
||
|
||
(defun magit-read-upstream-branch (&optional branch prompt)
|
||
"Read the upstream for BRANCH using PROMPT.
|
||
If optional BRANCH is nil, then read the upstream for the
|
||
current branch, or raise an error if no branch is checked
|
||
out. Only existing branches can be selected."
|
||
(unless branch
|
||
(setq branch (or (magit-get-current-branch)
|
||
(error "Need a branch to set its upstream"))))
|
||
(let ((branches (delete branch (magit-list-branch-names))))
|
||
(magit-completing-read
|
||
(or prompt (format "Change upstream of %s to" branch))
|
||
branches nil t nil 'magit-revision-history
|
||
(or (let ((r (car (member (magit-remote-branch-at-point) branches)))
|
||
(l (car (member (magit-local-branch-at-point) branches))))
|
||
(if magit-prefer-remote-upstream (or r l) (or l r)))
|
||
(and-let ((main (magit-main-branch)))
|
||
(let ((r (car (member (concat "origin/" main) branches)))
|
||
(l (car (member main branches))))
|
||
(if magit-prefer-remote-upstream (or r l) (or l r))))
|
||
(car (member (magit-get-previous-branch) branches))))))
|
||
|
||
(defun magit-read-starting-point (prompt &optional branch default)
|
||
(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 " " (magit--propertize-face
|
||
branch 'magit-branch-local))))
|
||
" starting at")
|
||
(nconc (list "HEAD")
|
||
(magit-list-refnames)
|
||
(directory-files (magit-gitdir) nil "_HEAD\\'"))
|
||
nil 'any nil 'magit-revision-history
|
||
(or default (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)
|
||
(magit-completing-read prompt (magit-list-tags) nil t nil
|
||
'magit-revision-history
|
||
(magit-tag-at-point)))
|
||
|
||
(defun magit-read-stash (prompt)
|
||
(let* ((atpoint (magit-stash-at-point))
|
||
(default (and atpoint
|
||
(concat atpoint (magit-rev-format " %s" atpoint))))
|
||
(choices (mapcar (lambda (c)
|
||
(pcase-let ((`(,rev ,msg) (split-string c "\0")))
|
||
(concat (propertize rev 'face 'magit-hash)
|
||
" " msg)))
|
||
(magit-list-stashes "%gd%x00%s")))
|
||
(choice (magit-completing-read prompt choices
|
||
nil t nil nil
|
||
default
|
||
(car choices))))
|
||
(and choice
|
||
(string-match "^\\([^ ]+\\) \\(.+\\)" choice)
|
||
(substring-no-properties (match-str 1 choice)))))
|
||
|
||
(defun magit-read-shelved-branch (prompt)
|
||
(magit-completing-read
|
||
prompt
|
||
(mapcar (##substring % 8)
|
||
(nreverse (magit-list-refnames "refs/shelved")))
|
||
nil t nil nil
|
||
(and$ (magit-section-value-if 'shelved-branch)
|
||
(substring $ 13))))
|
||
|
||
(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 'any 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)
|
||
;; Some predicates use the inefficient `magit-toplevel'
|
||
;; and some repositories have thousands of submodules.
|
||
(let ((magit--refresh-cache (list (cons 0 0)))
|
||
(modules nil))
|
||
(cond (current-prefix-arg
|
||
(setq modules (magit-list-module-paths))
|
||
(when predicate
|
||
(setq modules (seq-filter predicate modules)))
|
||
(unless modules
|
||
(if predicate
|
||
(user-error "No modules satisfying %s available" predicate)
|
||
(user-error "No modules available"))))
|
||
(t
|
||
(setq modules (magit-region-values 'module))
|
||
(when modules
|
||
(when predicate
|
||
(setq modules (seq-filter predicate modules)))
|
||
(unless modules
|
||
(user-error "No modules satisfying %s selected" predicate)))))
|
||
(if (or (length> modules 1) current-prefix-arg)
|
||
(magit-confirm t nil (format "%s %%d modules" verb) nil modules)
|
||
(list (magit-read-module-path (format "%s module" verb) predicate)))))
|
||
|
||
;;; _
|
||
(provide 'magit-git)
|
||
;; Local Variables:
|
||
;; read-symbol-shorthands: (
|
||
;; ("and$" . "cond-let--and$")
|
||
;; ("and>" . "cond-let--and>")
|
||
;; ("and-let" . "cond-let--and-let")
|
||
;; ("if-let" . "cond-let--if-let")
|
||
;; ("when-let" . "cond-let--when-let")
|
||
;; ("while-let" . "cond-let--while-let")
|
||
;; ("match-string" . "match-string")
|
||
;; ("match-str" . "match-string-no-properties"))
|
||
;; End:
|
||
;;; magit-git.el ends here
|