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