fordon_greeman / voidfiles

Branch: main
Switch branches/tags
main
theidioticdev add emacs 2079ec5 1d ago
3267 lines · 137.2 KB Raw Blame History
1 ;;; magit-git.el --- Git functionality -*- lexical-binding:t -*-
2
3 ;; Copyright (C) 2008-2026 The Magit Project Contributors
4
5 ;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev>
6 ;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev>
7
8 ;; SPDX-License-Identifier: GPL-3.0-or-later
9
10 ;; Magit is free software: you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14 ;;
15 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
17 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
18 ;; License for more details.
19 ;;
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with Magit. If not, see <https://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; This library implements wrappers for various Git plumbing commands.
26
27 ;;; Code:
28
29 (eval-when-compile (require 'subr-x)) ; For macros thread-{first,last}.
30
31 (require 'magit-base)
32
33 (require 'server)
34
35 ;; From `magit-branch'.
36 (defvar magit-branch-prefer-remote-upstream)
37 (defvar magit-published-branches)
38
39 ;; From `magit-margin'.
40 (declare-function magit-maybe-make-margin-overlay "magit-margin" ())
41
42 ;; From `magit-mode'.
43 (declare-function magit-buffer-file-name "magit-mode" ())
44 (declare-function magit-get-mode-buffer "magit-mode"
45 (mode &optional value frame))
46 (declare-function magit-refresh "magit-mode" ())
47 (defvar magit-buffer-diff-type)
48 (defvar magit-buffer-diff-args)
49 (defvar magit-buffer-file-name)
50 (defvar magit-buffer-log-args)
51 (defvar magit-buffer-log-files)
52 (defvar magit-buffer-revision)
53
54 ;; From `magit-process'.
55 (declare-function magit-call-git "magit-process" (&rest args))
56 (declare-function magit-git "magit-process" (&rest args))
57 (declare-function magit-process-buffer "magit-process" (&optional nodisplay))
58 (declare-function magit-process-file "magit-process"
59 (process &optional infile buffer display &rest args))
60 (declare-function magit-process-finish-section "magit-process"
61 (section exit-code))
62 (declare-function magit-process-git "magit-process" (destination &rest args))
63 (declare-function magit-process-insert-section "magit-process"
64 (pwd program args &optional errcode errlog face))
65 (defvar magit-this-error)
66 (defvar magit-process-error-message-regexps)
67
68 ;; From `magit-status'.
69 (defvar magit-status-show-untracked-files)
70
71 (eval-and-compile ;declare slot names
72 (cl-pushnew 'orig-rev eieio--known-slot-names)
73 (cl-pushnew 'number eieio--known-slot-names))
74
75 (defvar crm-prompt) ; Emacs 31.1
76
77 ;;; Options
78
79 ;; For now this is shared between `magit-process' and `magit-git'.
80 (defgroup magit-process nil
81 "Git and other external processes used by Magit."
82 :group 'magit)
83
84 (defvar magit-git-environment
85 (list (format "INSIDE_EMACS=%s,magit" emacs-version))
86 "Prepended to `process-environment' while running git.")
87
88 (defcustom magit-git-output-coding-system
89 (and (eq system-type 'windows-nt) 'utf-8)
90 "Coding system for receiving output from Git.
91
92 If non-nil, the Git config value `i18n.logOutputEncoding' should
93 be set via `magit-git-global-arguments' to value consistent with
94 this."
95 :package-version '(magit . "2.9.0")
96 :group 'magit-process
97 :type '(choice (coding-system :tag "Coding system to decode Git output")
98 (const :tag "Use system default" nil)))
99
100 (defun magit--early-process-lines (program &rest args)
101 "Only used to initialize custom options."
102 ;; `magit-process-environment' isn't defined yet
103 ;; and uses this function, so it cannot be used here.
104 (let ((process-environment
105 (append magit-git-environment process-environment)))
106 (ignore-error file-missing
107 (apply #'process-lines-ignore-status program args))))
108
109 (defvar magit--git-w32-path-hack nil
110 "Alist of (EXE . (PATHENTRY)).
111 This specifies what additional PATH setting needs to be added to
112 the environment in order to run the non-wrapper git executables
113 successfully. Set when `magit-git-executable' is (re)initialized.")
114
115 (defcustom magit-git-executable
116 (or (and (eq system-type 'windows-nt)
117 ;; Avoid the wrappers "cmd/git.exe" and "cmd/git.cmd",
118 ;; which are much slower than using "bin/git.exe" directly.
119 (and-let ((exec (executable-find "git")))
120 ;; Git for Windows 2.x provides cygpath so we can
121 ;; ask it for native paths.
122 (let* ((core-exe
123 (car (magit--early-process-lines
124 exec "-c"
125 "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
126 "X" "git")))
127 (hack-entry (assoc core-exe magit--git-w32-path-hack))
128 ;; Running the libexec/git-core executable
129 ;; requires some extra PATH entries.
130 (path-hack
131 (list (concat "PATH="
132 (car (magit--early-process-lines
133 exec "-c"
134 "alias.P=!cygpath -wp \"$PATH\""
135 "P"))))))
136 ;; The defcustom STANDARD expression can be
137 ;; evaluated many times, so make sure it is
138 ;; idempotent.
139 (if hack-entry
140 (setcdr hack-entry path-hack)
141 (push (cons core-exe path-hack) magit--git-w32-path-hack))
142 core-exe)))
143 (and (eq system-type 'darwin)
144 (executable-find "git"))
145 "git")
146 "The Git executable used by Magit on the local host.
147 On remote machines `magit-remote-git-executable' is used instead."
148 :package-version '(magit . "3.2.0")
149 :group 'magit-process
150 :type 'string)
151
152 (defcustom magit-remote-git-executable "git"
153 "The Git executable used by Magit on remote machines.
154 On the local host `magit-git-executable' is used instead.
155 Consider customizing `tramp-remote-path' instead of this
156 option."
157 :package-version '(magit . "3.2.0")
158 :group 'magit-process
159 :type 'string)
160
161 (defcustom magit-run-hooks-from-githooks t
162 "Whether Git hooks may run Lisp hooks.
163
164 By default the Lisp hook `magit-common-git-post-commit-functions' is
165 run by the Git hooks `post-commit', `post-merge' and `post-rewrite'.
166 Use `magit-user-githook-file' (which see) to define additional hooks.
167
168 Git hooks can only run Lisp hooks, if Magit invokes Git asynchronously
169 and on the local machine, `with-editor-emacsclient-executable' is set,
170 and at least Git v2.54.0 is used."
171 :package-version '(magit . "4.6.0")
172 :group 'magit-process
173 :type 'boolean)
174
175 (defcustom magit-user-githook-file (locate-user-emacs-file "magit-githooks")
176 "File containing user Git hook to Lisp hook mappings.
177
178 Magit ships with one such mapping, defined in the included file
179 \"githooks/config\", which looks like this:
180
181 [hook \"magit-common-post-commit\"]
182 event = post-commit
183 event = post-merge
184 event = post-rewrite
185 command = magit-run-git-hook magit-common-git-post-commit-functions
186
187 That file should not be edited by users, as those edits would be lost
188 when Magit is updated; instead the file specified by this option, has
189 to be used, to add additional mappings.
190
191 See the git-hook(1) and githooks(5) manpages for details about the
192 Git part. The command should always use the \"magit-run-git-hook\"
193 executable, which takes the name of the Lisp hook to be run as the
194 first argument.
195
196 See also `magit-run-hooks-from-githooks'."
197 :package-version '(magit . "4.6.0")
198 :group 'magit-process
199 :type 'file)
200
201 (defvar magit-githook-directory nil
202 "Directory containing files Magit needs to map Git to Lisp hooks.
203
204 This directory must contains two files; \"config\", which maps Git
205 hooks to the `magit-common-git-post-commit-functions' hook, and an
206 executable \"magit-run-git-hook\", which is used in that, and
207 potentially other hooks.
208
209 The value of this variable is set by `magit-process-git-arguments',
210 when it is first needed. Users can set it to another directory,
211 but that should rarely be necessary. Additional hook mappings
212 should instead be defined in `magit-user-githook-file'.")
213
214 (defcustom magit-git-global-arguments
215 `("--no-pager" "--literal-pathspecs"
216 "-c" "core.preloadIndex=true"
217 "-c" "log.showSignature=false"
218 "-c" "color.ui=false"
219 "-c" "color.diff=false"
220 "-c" "diff.noPrefix=false"
221 ,@(and (eq system-type 'windows-nt)
222 (list "-c" "i18n.logOutputEncoding=UTF-8")))
223 "Global Git arguments.
224
225 The arguments set here are used every time the git executable is run
226 as a subprocess. They are placed right after the executable itself
227 and before the git command - as in \"git HERE... COMMAND REST\".
228 See the manpage `git(1)' for valid arguments.
229
230 Be careful what you add here, especially if you are using Tramp to
231 connect to servers with ancient Git versions. Never remove anything
232 that is part of the default value, unless you really know what you
233 are doing. And think very hard before adding something; it will be
234 used every time Magit runs Git for any purpose."
235 :package-version '(magit . "4.3.2")
236 :group 'magit-commands
237 :group 'magit-process
238 :type '(repeat string))
239
240 (defcustom magit-prefer-remote-upstream nil
241 "Whether to favor remote branches when reading the upstream branch.
242
243 This controls whether commands that read a branch from the user
244 and then set it as the upstream branch, offer a local or a remote
245 branch as default completion candidate, when they have the choice.
246
247 This affects all commands that use `magit-read-upstream-branch'
248 or `magit-read-starting-point', which includes most commands
249 that change the upstream and many that create new branches."
250 :package-version '(magit . "2.4.2")
251 :group 'magit-commands
252 :type 'boolean)
253
254 (defcustom magit-list-refs-namespaces
255 '("refs/heads"
256 "refs/remotes"
257 "refs/tags")
258 "List of ref namespaces considered when reading a ref.
259
260 This controls which refs are returned by `magit-list-refs', which
261 is called by functions like `magit-list-branch-names' to generate
262 the collection of refs. Additionally namespaces appear in the same
263 order as specified here."
264 :package-version '(magit . "4.4.0")
265 :group 'magit-commands
266 :type '(repeat string))
267
268 (defcustom magit-list-refs-sortby nil
269 "How to sort the ref collection in the prompt.
270
271 This affects commands that read a ref. More specifically, it
272 controls the order of refs returned by `magit-list-refs', which
273 is called by functions like `magit-list-branch-names' to generate
274 the collection of refs. By default, refs are sorted according to
275 their full refname (i.e., \"refs/...\").
276
277 Any value accepted by the \"--sort\" flag of \"git for-each-ref\" can
278 be used. For example, \"-creatordate\" places refs with more
279 recent committer or tagger dates earlier in the list. A list of
280 strings can also be given in order to pass multiple sort keys to
281 \"git for-each-ref\".
282
283 Regardless of what is specified here, refs are first sorted by
284 namespace, according to the order of `magit-list-refs-namespaces'.
285
286 Note that, depending on the completion framework you use, this
287 may not be sufficient to change the order in which the refs are
288 displayed. It only controls the order of the collection passed
289 to `magit-completing-read' or, for commands that support reading
290 multiple strings, `read-from-minibuffer'. The completion
291 framework ultimately determines how the collection is displayed."
292 :package-version '(magit . "2.11.0")
293 :group 'magit-miscellaneous
294 :type '(choice string (repeat string)))
295
296 (defcustom magit-cygwin-mount-points
297 (and (eq system-type 'windows-nt)
298 (compat-call
299 sort (mapcar (lambda (mount)
300 (if (string-match "^\\(.*\\) on \\(.*\\) type" mount)
301 (cons (file-name-as-directory (match-str 2 mount))
302 (file-name-as-directory (match-str 1 mount)))
303 (lwarn '(magit) :error
304 "Failed to parse Cygwin mount: %S" mount)))
305 ;; If --exec-path is not a native Windows path,
306 ;; then we probably have a cygwin git.
307 (and-let ((dirs (magit--early-process-lines
308 magit-git-executable "--exec-path")))
309 (and (not (string-match-p "\\`[a-zA-Z]:" (car dirs)))
310 (magit--early-process-lines "mount"))))
311 :lessp #'< :reverse t :key (pcase-lambda (`(,cyg . ,_win)) (length cyg))))
312 "Alist of (CYGWIN . WIN32) directory names.
313 Sorted from longest to shortest CYGWIN name."
314 :package-version '(magit . "2.3.0")
315 :group 'magit-process
316 :type '(alist :key-type string :value-type directory))
317
318 ;;; Git
319
320 (defvar magit-git-debug nil
321 "Whether and how to enable additional debugging of git errors.
322
323 Use `magit-toggle-git-debug' (which see) to toggle the boolean value of
324 this variable. This can also manually be set to `include-success', in
325 which case successful git invocations are also logged.
326
327 This can also be a function, which takes one argument, the error output
328 as a string. This is intended for internal use and is established using
329 let-bindings around critical code (i.e., in `magit--assert-usable-git').")
330
331 (defun magit-toggle-git-debug ()
332 "Toggle whether additional git errors are reported.
333
334 Magit basically calls git for one of these two reasons: for
335 side-effects or to do something with its standard output.
336
337 When git is run for side-effects then its output, including error
338 messages, go into the process buffer which is shown when using \
339 \\<magit-mode-map>\\[magit-process-buffer].
340
341 When git's output is consumed in some way, then it would be too
342 expensive to also insert it into this buffer, but with this command
343 that can be enabled temporarily. In that case, if git returns with
344 a non-zero exit status, then at least its standard error is inserted
345 into this buffer.
346
347 See info node `(magit)Debugging Tools' for more information."
348 (interactive)
349 (setq magit-git-debug (not magit-git-debug))
350 (message "Additional reporting of Git errors %s"
351 (if magit-git-debug "enabled" "disabled")))
352
353 (defvar magit--refresh-cache nil
354 "Cache used during refreshes and other expensive operations.
355
356 If non-nil, this has the form ((HITS . COUNT) . ENTRIES). HITS is how
357 many times any of the cached ENTRIES were accessed. COUNT is the number
358 of ENTRIES. Each entry has the form (KEY . VALUE). KEY can have one
359 of two forms (TOPDIR . ARGUMENTS) or (TOPDIR . ACTION). TOPDIR is the
360 top-level directory of a repository. ARGUMENTS are arguments to git.
361 ACTION is a symbol identifying an action other than calling git. VALUE
362 is the cached value.")
363
364 (defmacro magit--with-refresh-cache (key &rest body)
365 (declare (indent 1) (debug (form body)))
366 (let ((k (gensym))
367 (hit (gensym)))
368 `(if magit--refresh-cache
369 (let ((,k ,key))
370 (unless (zerop (recursion-depth))
371 (setq magit--refresh-cache nil))
372 (if-let ((,hit (assoc ,k (cdr magit--refresh-cache))))
373 (progn (incf (caar magit--refresh-cache))
374 (cdr ,hit))
375 (let ((value ,(macroexp-progn body)))
376 (when (zerop (recursion-depth))
377 (incf (cdar magit--refresh-cache))
378 (push (cons ,k value)
379 (cdr magit--refresh-cache)))
380 value)))
381 ,@body)))
382
383 (defvar magit-with-editor-envvar "GIT_EDITOR"
384 "The environment variable exported by `magit-with-editor'.
385 Set this to \"GIT_SEQUENCE_EDITOR\" if you do not want to use
386 Emacs to edit commit messages but would like to do so to edit
387 rebase sequences.")
388
389 (defmacro magit-with-editor (&rest body)
390 "Like `with-editor*' but let-bind some more variables.
391 Also respect the value of `magit-with-editor-envvar', prevent the
392 process buffer from popping up, and on Windows possibly employ a
393 kludge to fix an unusable value of `shell-file-name'."
394 (declare (indent 0) (debug (body)))
395 `(let ((magit-process-popup-time -1)
396 ;; The user may have customized `shell-file-name' to something
397 ;; which results in `w32-shell-dos-semantics' being nil (which
398 ;; changes the quoting style used by `shell-quote-argument'),
399 ;; but Git for Windows expects shell quoting in the dos style.
400 (shell-file-name (if (and (eq system-type 'windows-nt)
401 ;; If we have Cygwin mount points,
402 ;; the git flavor is cygwin, so dos
403 ;; shell quoting is probably wrong.
404 (not magit-cygwin-mount-points))
405 "cmdproxy"
406 shell-file-name)))
407 (with-editor* magit-with-editor-envvar
408 ,@body)))
409
410 (defmacro magit--with-temp-process-buffer (&rest body)
411 "Like `with-temp-buffer', but propagate `process-environment' binding.
412
413 When that variable is buffer-local in the previously current buffer,
414 it is not propagated by `with-temp-buffer', so we explicitly ensure
415 that happens, so that processes are invoked consistently. BODY is
416 as for that macro.
417
418 Note that itself Magit does not ever make this variable buffer-local.
419 This macro only exists to cope with third-party code doing that."
420 (declare (indent 0) (debug (body)))
421 (let ((p (gensym)))
422 `(let ((,p process-environment))
423 (with-temp-buffer
424 (let ((process-environment ,p))
425 ,@body)))))
426
427 (defsubst magit-git-executable ()
428 "Return value of `magit-git-executable' or `magit-remote-git-executable'.
429 The variable is chosen depending on whether `default-directory'
430 is remote."
431 (if (file-remote-p default-directory)
432 magit-remote-git-executable
433 magit-git-executable))
434
435 (defun magit-process-git-arguments--split (program args)
436 (if (equal program (magit-git-executable))
437 (let* ((length (length magit-git-global-arguments))
438 (global (seq-take args length))
439 (local (seq-drop args length)))
440 (while (equal (car local) "-c")
441 (setq global (append global (seq-take local 2)))
442 (setq local (seq-drop local 2)))
443 (list global local))
444 (list nil args)))
445
446 (defun magit-process-git-arguments (args &optional async)
447 "Prepare ARGS for a function that invokes Git.
448
449 Magit has many specialized functions for running Git; they all
450 pass arguments through this function before handing them to Git,
451 to do the following.
452
453 * Prepend `magit-git-global-arguments' to ARGS.
454 * If ASYNC is non-nil, potentially add additional arguments to load
455 the hook configuration in \"/path/to/magit/githooks/config\" and/or
456 `magit-user-githook-file'.
457 * Flatten ARGS, removing nil arguments.
458 * If `system-type' is `windows-nt', encode ARGS to `w32-ansi-code-page'."
459 (let ((githookp (and async
460 (magit-git-version>= "2.54")
461 (not (file-remote-p default-directory)))))
462 (cond
463 ((not githookp))
464 (magit-githook-directory)
465 ((and (stringp magit-run-hooks-from-githooks)
466 (file-directory-p magit-run-hooks-from-githooks))
467 (setq magit-githook-directory
468 (magit-convert-filename-for-git
469 magit-run-hooks-from-githooks)))
470 (magit-run-hooks-from-githooks
471 (setq magit-githook-directory
472 (magit-convert-filename-for-git
473 (expand-file-name "githooks"
474 (locate-dominating-file
475 (locate-library "magit.el") "githooks"))))))
476 (setq args
477 (append magit-git-global-arguments
478 (and githookp
479 magit-githook-directory
480 `("-c" ,(format "include.path=%s/config"
481 magit-githook-directory)
482 ,@(and magit-user-githook-file
483 (file-exists-p magit-user-githook-file)
484 `("-c" ,(concat "include.path="
485 magit-user-githook-file)))))
486 (flatten-tree args))))
487 (if (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page))
488 ;; On w32, the process arguments *must* be encoded in the
489 ;; current code-page (see #3250).
490 (let ((coding (intern (format "cp%d" w32-ansi-code-page))))
491 (mapcar (##encode-coding-string % coding) args))
492 args))
493
494 (defun magit-git-exit-code (&rest args)
495 "Execute Git with ARGS, returning its exit code."
496 (magit-process-git nil args))
497
498 (defun magit-git-success (&rest args)
499 "Execute Git with ARGS, returning t if its exit code is 0."
500 (= (magit-git-exit-code args) 0))
501
502 (defun magit-git-failure (&rest args)
503 "Execute Git with ARGS, returning t if its exit code is 1."
504 (= (magit-git-exit-code args) 1))
505
506 (defun magit-git-string-ng (&rest args)
507 "Execute Git with ARGS, returning the first line of its output.
508 If the exit code isn't zero or if there is no output, then that
509 is considered an error, but instead of actually signaling an
510 error, return nil. Additionally the output is put in the process
511 buffer (creating it if necessary) and the error message is shown
512 in the status buffer (provided it exists).
513
514 This is an experimental replacement for `magit-git-string', and
515 still subject to major changes."
516 (magit--with-refresh-cache
517 (list default-directory 'magit-git-string-ng args)
518 (magit--with-temp-process-buffer
519 (let* ((args (magit-process-git-arguments args))
520 (status (magit-process-git t args)))
521 (if (zerop status)
522 (and (not (bobp))
523 (progn
524 (goto-char (point-min))
525 (buffer-substring-no-properties
526 (point) (line-end-position))))
527 (let ((buf (current-buffer)))
528 (with-current-buffer (magit-process-buffer t)
529 (magit-process-insert-section default-directory
530 magit-git-executable args
531 status buf
532 'magit-section-secondary-heading)))
533 (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode)))
534 (let ((msg (magit--locate-error-message)))
535 (with-current-buffer status-buf
536 (setq magit-this-error msg))))
537 nil)))))
538
539 (defun magit-git-str (&rest args)
540 "Execute Git with ARGS, returning the first line of its output.
541 If there is no output, return nil. If the output begins with a
542 newline, return an empty string. Like `magit-git-string' but
543 ignore `magit-git-debug'."
544 (setq args (flatten-tree args))
545 (magit--with-refresh-cache (cons default-directory args)
546 (magit--with-temp-process-buffer
547 (magit-process-git (list t nil) args)
548 (unless (bobp)
549 (goto-char (point-min))
550 (buffer-substring-no-properties (point) (line-end-position))))))
551
552 (defun magit-git-output (&rest args)
553 "Execute Git with ARGS, returning its output."
554 (setq args (flatten-tree args))
555 (magit--with-refresh-cache (cons default-directory args)
556 (magit--with-temp-process-buffer
557 (magit-process-git (list t nil) args)
558 (buffer-substring-no-properties (point-min) (point-max)))))
559
560 (define-error 'magit-invalid-git-boolean "Not a Git boolean")
561
562 (defun magit-git-true (&rest args)
563 "Execute Git with ARGS, returning t if it prints \"true\".
564 If it prints \"false\", then return nil. For any other output
565 signal `magit-invalid-git-boolean'."
566 (pcase (magit-git-output args)
567 ((or "true" "true\n") t)
568 ((or "false" "false\n") nil)
569 (output (signal 'magit-invalid-git-boolean (list output)))))
570
571 (defun magit-git-false (&rest args)
572 "Execute Git with ARGS, returning t if it prints \"false\".
573 If it prints \"true\", then return nil. For any other output
574 signal `magit-invalid-git-boolean'."
575 (pcase (magit-git-output args)
576 ((or "true" "true\n") nil)
577 ((or "false" "false\n") t)
578 (output (signal 'magit-invalid-git-boolean (list output)))))
579
580 (defun magit-git-config-p (variable &optional default)
581 "Return the boolean value of the Git variable VARIABLE.
582 VARIABLE has to be specified as a string. If VARIABLE is unset,
583 return nil by default, unless DEFAULT is non-nil, in which case
584 return t. Signal an error if VARIABLE is set but not a boolean."
585 (let ((args (list "config" "--bool" "--default" (if default "true" "false")
586 variable)))
587 (magit--with-refresh-cache (cons default-directory args)
588 (magit--with-temp-process-buffer
589 (let ((status (magit-process-git t args))
590 (output (buffer-substring (point-min) (1- (point-max)))))
591 (if (zerop status)
592 (equal output "true")
593 (signal 'magit-invalid-git-boolean (list output))))))))
594
595 (defun magit-git-insert (&rest args)
596 "Execute Git with ARGS, insert stdout at point and return exit code.
597 If `magit-git-debug' is non-nil and the exit code is non-zero, then
598 insert the run command and stderr into the process buffer."
599 (apply #'magit--git-insert nil args))
600
601 (defun magit--git-insert (return-error &rest args)
602 (setq args (flatten-tree args))
603 (if (or return-error magit-git-debug)
604 (let (log)
605 (unwind-protect
606 (let (exit errmsg)
607 (setq log (make-nearby-temp-file "magit-stderr"))
608 (delete-file log)
609 (setq exit (magit-process-git (list t log) args))
610 (when (or (> exit 0) (eq magit-git-debug 'include-success))
611 (when (file-exists-p log)
612 (with-temp-buffer
613 (insert-file-contents log)
614 (goto-char (point-max))
615 (setq errmsg
616 (cond
617 ((eq return-error 'full)
618 (let ((str (buffer-string)))
619 (and (not (equal str "")) str)))
620 ((functionp magit-git-debug)
621 (funcall magit-git-debug (buffer-string)))
622 ((magit--locate-error-message)))))
623 (when magit-git-debug
624 (let ((magit-git-debug nil))
625 (with-current-buffer (magit-process-buffer t)
626 (magit-process-finish-section
627 (magit-process-insert-section
628 default-directory magit-git-executable
629 (magit-process-git-arguments args)
630 exit log 'magit-section-secondary-heading)
631 exit)))))
632 (cond ((not magit-git-debug))
633 (errmsg (message "magit--git-insert: %S" errmsg))
634 ((zerop exit))
635 ((message "magit--git-insert: %s %s"
636 "Git returned with exit-code" exit))))
637 (or (and return-error errmsg)
638 exit))
639 (ignore-errors (delete-file log))))
640 (magit-process-git (list t nil) args)))
641
642 (defun magit--locate-error-message ()
643 (goto-char (point-max))
644 (and (run-hook-wrapped 'magit-process-error-message-regexps
645 (##re-search-backward % nil t))
646 (match-str 1)))
647
648 (defun magit-git-string (&rest args)
649 "Execute Git with ARGS, returning the first line of its output (stdout).
650 If the exit code isn't zero or if there is no output, then return nil.
651 Neither of these results is considered an error; if that is what you
652 want, then use `magit-git-string-ng' instead."
653 (setq args (flatten-tree args))
654 (magit--with-refresh-cache (cons default-directory args)
655 (magit--with-temp-process-buffer
656 (and (zerop (apply #'magit-git-insert args))
657 (not (bobp))
658 (progn
659 (goto-char (point-min))
660 (buffer-substring-no-properties (point) (line-end-position)))))))
661
662 (defun magit-git-lines (&rest args)
663 "Execute Git with ARGS, returning its output as a list of lines.
664 Empty lines anywhere in the output are omitted.
665
666 If Git exits with a non-zero exit status, show a message and add
667 a section in the respective process buffer."
668 (magit--with-temp-process-buffer
669 (apply #'magit-git-insert args)
670 (split-string (buffer-string) "\n" t)))
671
672 (defun magit-git-items (&rest args)
673 "Execute Git with ARGS, returning its null-separated output as a list.
674 Empty items anywhere in the output are omitted.
675
676 If Git exits with a non-zero exit status, show a message and add
677 a section in the respective process buffer."
678 (magit--with-temp-process-buffer
679 (apply #'magit-git-insert args)
680 (split-string (buffer-string) "\0" t)))
681
682 (defun magit-git-wash (washer &rest args)
683 "Execute git with ARGS, inserting washed output at point.
684
685 First insert the raw output at point. If there is no output, call
686 `magit-cancel-section'. Otherwise temporarily narrow the buffer to
687 the inserted text, move to its beginning, and finally call function
688 WASHER with ARGS as its sole argument.
689
690 If git exits with a non-zero exit status, apply the `error' face to
691 the error message, instead of calling WASHER. To instead cancel the
692 section use `magit--git-wash'."
693 (declare (indent 1))
694 (apply #'magit--git-wash washer t args))
695
696 (defun magit--git-wash (washer keep-error &rest args)
697 "Execute git with ARGS, inserting washed output at point.
698
699 Like `magit-git-wash' but if KEEP-ERROR is nil and an error occurs, also
700 insert standard error. If KEEP-ERROR is `wash-anyway', insert and wash
701 standard output even in case of an error."
702 (declare (indent 2))
703 (setq args (flatten-tree args))
704 (let ((beg (point))
705 (exit (magit--git-insert (and keep-error 'full) args)))
706 (when (stringp exit)
707 (goto-char beg)
708 (insert (magit--propertize-face exit 'error))
709 (insert (if (bolp) "\n" "\n\n")))
710 (if (= (point) beg)
711 (magit-cancel-section)
712 (unless (bolp)
713 (insert "\n"))
714 (when (or (equal exit 0)
715 (eq keep-error 'wash-anyway))
716 (save-restriction
717 (narrow-to-region beg (point))
718 (goto-char beg)
719 (funcall washer args))
720 (when (or (= (point) beg)
721 (= (point) (1+ beg)))
722 (magit-cancel-section))
723 (magit-maybe-make-margin-overlay)))
724 exit))
725
726 (defun magit-git-executable-find (command)
727 "Search for COMMAND in Git's exec path, falling back to `exec-path'.
728 Like `executable-find', return the absolute file name of the
729 executable."
730 (or (locate-file command
731 (list (concat
732 (file-remote-p default-directory)
733 (or (magit-git-string "--exec-path")
734 (error "\"git --exec-path\" failed"))))
735 exec-suffixes
736 #'file-executable-p)
737 (executable-find command t)))
738
739 ;;; Git Version
740
741 (defconst magit--git-version-regexp
742 "\\`git version \\([0-9]+\\(\\.[0-9]+\\)\\{1,2\\}\\)")
743
744 (defvar magit--host-git-version-cache nil)
745
746 (defun magit-git-version>= (n)
747 "Return t if `magit-git-version's value is greater than or equal to N."
748 (magit--version>= (magit-git-version) n))
749
750 (defun magit-git-version< (n)
751 "Return t if `magit-git-version's value is smaller than N."
752 (version< (magit-git-version) n))
753
754 (defun magit-git-version ()
755 "Return the Git version used for `default-directory'.
756 Raise an error if Git cannot be found, if it exits with a
757 non-zero status, or the output does not have the expected
758 format."
759 (magit--with-refresh-cache (list default-directory)
760 (let ((host (file-remote-p default-directory)))
761 (or (cdr (assoc host magit--host-git-version-cache))
762 (magit--with-temp-process-buffer
763 ;; Unset global arguments for ancient Git versions.
764 (let* ((magit-git-global-arguments nil)
765 (status (magit-process-git t "version"))
766 (output (buffer-string)))
767 (cond
768 ((not (zerop status))
769 (display-warning
770 'magit
771 (format "%S\n\nRunning \"%s --version\" failed with output:\n\n%s"
772 (if host
773 (format "Magit cannot find Git on host %S.\n
774 Check the value of `magit-remote-git-executable' using
775 `magit-debug-git-executable' and consult the info node
776 `(tramp)Remote programs'." host)
777 "Magit cannot find Git.\n
778 Check the values of `magit-git-executable' and `exec-path'
779 using `magit-debug-git-executable'.")
780 (magit-git-executable)
781 output)))
782 ((save-match-data
783 (and (string-match magit--git-version-regexp output)
784 (let ((version (match-str 1 output)))
785 (push (cons host version)
786 magit--host-git-version-cache)
787 version))))
788 ((error "Unexpected \"%s --version\" output: %S"
789 (magit-git-executable)
790 output)))))))))
791
792 (defun magit-git-version-assert (&optional minimal who)
793 "Assert that the used Git version is greater than or equal to MINIMAL.
794 If optional MINIMAL is nil, compare with `magit--minimal-git'
795 instead. Optional WHO if non-nil specifies what functionality
796 needs at least MINIMAL, otherwise it defaults to \"Magit\"."
797 (when (magit-git-version< (or minimal magit--minimal-git))
798 (let* ((host (file-remote-p default-directory))
799 (msg (format-spec
800 (cond (host "\
801 %w requires Git %m or greater, but on %h the version is %v.
802
803 If multiple Git versions are installed on the host, then the
804 problem might be that TRAMP uses the wrong executable.
805
806 Check the value of `magit-remote-git-executable' and consult
807 the info node `(tramp)Remote programs'.\n")
808 (t "\
809 %w requires Git %m or greater, but you are using %v.
810
811 If you have multiple Git versions installed, then check the
812 values of `magit-remote-git-executable' and `exec-path'.\n"))
813 `((?w . ,(or who "Magit"))
814 (?m . ,(or minimal magit--minimal-git))
815 (?v . ,(magit-git-version))
816 (?h . ,host)))))
817 (display-warning 'magit msg :error))))
818
819 (defun magit--safe-git-version ()
820 "Return the Git version used for `default-directory' or an error message."
821 (magit--with-temp-process-buffer
822 (let* ((magit-git-global-arguments nil)
823 (status (magit-process-git t "version"))
824 (output (buffer-string)))
825 (cond ((not (zerop status)) output)
826 ((save-match-data
827 (and (string-match magit--git-version-regexp output)
828 (match-str 1 output))))
829 (output)))))
830
831 (defun magit-debug-git-executable ()
832 "Display a buffer with information about `magit-git-executable'.
833 Also include information about `magit-remote-git-executable'.
834 See info node `(magit)Debugging Tools' for more information."
835 (interactive)
836 (with-current-buffer (get-buffer-create "*magit-git-executable*")
837 (pop-to-buffer (current-buffer))
838 (erase-buffer)
839 (insert (format "magit-remote-git-executable: %S\n"
840 magit-remote-git-executable))
841 (insert (concat
842 (format "magit-git-executable: %S" magit-git-executable)
843 (and (not (file-name-absolute-p magit-git-executable))
844 (format " [%S]" (executable-find magit-git-executable)))
845 (format " (%s)\n" (magit--safe-git-version))))
846 (insert (format "exec-path: %S\n" exec-path))
847 (when-let ((diff (cl-set-difference
848 (seq-filter #'file-exists-p (remq nil (parse-colon-path
849 (getenv "PATH"))))
850 (seq-filter #'file-exists-p (remq nil exec-path))
851 :test #'file-equal-p)))
852 (insert (format " entries in PATH, but not in exec-path: %S\n" diff)))
853 (dolist (execdir exec-path)
854 (insert (format " %s (%s)\n" execdir (car (file-attributes execdir))))
855 (when (file-directory-p execdir)
856 (dolist (exec (directory-files
857 execdir t (concat
858 "\\`git" (regexp-opt exec-suffixes) "\\'")))
859 (insert (format " %s (%s)\n" exec
860 (magit--safe-git-version))))))))
861
862 ;;; Variables
863
864 (defun magit-config-get-from-cached-list (key)
865 (gethash
866 (thread$ key
867 ;; "git config --list" downcases first and last components.
868 (replace-regexp-in-string "\\`[^.]+" #'downcase $ t t)
869 (replace-regexp-in-string "[^.]+\\'" #'downcase $ t t))
870 (magit--with-refresh-cache (cons (magit-toplevel) 'config)
871 (let ((configs (make-hash-table :test #'equal)))
872 (dolist (conf (magit-git-items "config" "--list" "-z"))
873 (let* ((nl-pos (cl-position ?\n conf))
874 (key (substring conf 0 nl-pos))
875 (val (if nl-pos (substring conf (1+ nl-pos)) "")))
876 (puthash key (nconc (gethash key configs) (list val)) configs)))
877 configs))))
878
879 (defun magit-get (&rest keys)
880 "Return the value of the Git variable specified by KEYS."
881 (car (last (apply #'magit-get-all keys))))
882
883 (defun magit-get-all (&rest keys)
884 "Return all values of the Git variable specified by KEYS."
885 (let ((magit-git-debug nil)
886 (arg (and (or (null (car keys))
887 (string-prefix-p "--" (car keys)))
888 (pop keys)))
889 (key (string-join keys ".")))
890 (if (and magit--refresh-cache (not arg))
891 (magit-config-get-from-cached-list key)
892 (magit-git-items "config" arg "-z" "--get-all" "--include" key))))
893
894 (defun magit-get-boolean (&rest keys)
895 "Return the boolean value of the Git variable specified by KEYS.
896 Also see `magit-git-config-p'."
897 (let ((arg (and (or (null (car keys))
898 (string-prefix-p "--" (car keys)))
899 (pop keys)))
900 (key (string-join keys ".")))
901 (equal (if magit--refresh-cache
902 (car (last (magit-config-get-from-cached-list key)))
903 (magit-git-str "config" arg "--bool" "--include" key))
904 "true")))
905
906 (defun magit-set (value &rest keys)
907 "Set the value of the Git variable specified by KEYS to VALUE."
908 (let ((arg (and (or (null (car keys))
909 (string-prefix-p "--" (car keys)))
910 (pop keys)))
911 (key (string-join keys ".")))
912 (if value
913 (magit-git-success "config" arg key value)
914 (magit-git-success "config" arg "--unset" key))
915 value))
916
917 (gv-define-setter magit-get (val &rest keys)
918 `(magit-set ,val ,@keys))
919
920 (defun magit-set-all (values &rest keys)
921 "Set all values of the Git variable specified by KEYS to VALUES."
922 (let ((arg (and (or (null (car keys))
923 (string-prefix-p "--" (car keys)))
924 (pop keys)))
925 (var (string-join keys ".")))
926 (when (magit-get var)
927 (magit-call-git "config" arg "--unset-all" var))
928 (dolist (v values)
929 (magit-call-git "config" arg "--add" var v))))
930
931 ;;; Repository
932 ;;;; Repository Locations
933
934 (defun magit--safe-default-directory (&optional file)
935 (catch 'unsafe-default-dir
936 (let ((dir (file-name-as-directory
937 (expand-file-name (or file default-directory))))
938 (previous nil))
939 (while (not (file-accessible-directory-p dir))
940 ;; Do not use file-name-parent-directory.
941 (setq dir (file-name-directory (directory-file-name dir)))
942 (when (equal dir previous)
943 (throw 'unsafe-default-dir nil))
944 (setq previous dir))
945 dir)))
946
947 (defmacro magit--with-safe-default-directory (file &rest body)
948 (declare (indent 1) (debug (form body)))
949 `(when-let ((default-directory (magit--safe-default-directory ,file)))
950 ,@body))
951
952 (defun magit-git-dir (&optional path)
953 "Like (expand-file-name PATH (magit-gitdir)) or just (magit-gitdir)."
954 (declare (obsolete magit-gitdir "Magit 4.0.0"))
955 (and$ (magit-gitdir)
956 (if path (expand-file-name (convert-standard-filename path) $) $)))
957
958 (defun magit-gitdir (&optional directory common)
959 "Return the absolute and resolved path of the .git directory.
960
961 If the `GIT_DIR' environment variable is defined, return that.
962 Otherwise return the .git directory for DIRECTORY, or if that is
963 nil, then for `default-directory' instead. If the directory is
964 not located inside a Git repository, then return nil.
965
966 For a linked worktree, the worktree-specific .git directory is returned
967 by default. If COMMON is non-nil, return the `GIT_COMMON_DIR'
968 environment variable, if defined. Otherwise return the common .git
969 directory, falling back to the main .git directory when DIRECTORY does
970 not belong to a linked worktree."
971 (let ((default-directory (or directory default-directory)))
972 (magit--with-refresh-cache (list default-directory 'magit-gitdir)
973 (magit--with-safe-default-directory nil
974 (and-let*
975 ((dir (magit-rev-parse-safe (if common "--git-common-dir" "--git-dir")))
976 (dir (file-name-as-directory (magit-expand-git-file-name dir))))
977 (if (file-remote-p dir)
978 dir
979 (concat (file-remote-p default-directory) dir)))))))
980
981 (defvar magit--separated-gitdirs nil)
982
983 (defun magit--record-separated-gitdir ()
984 (let ((topdir (magit-toplevel))
985 (gitdir (magit-gitdir)))
986 ;; Kludge: git-annex converts submodule gitdirs to symlinks. See #3599.
987 (when (file-symlink-p (directory-file-name gitdir))
988 (setq gitdir (file-truename gitdir)))
989 ;; We want to delete the entry for `topdir' here, rather than
990 ;; within (unless ...), in case a "--separate-git-dir" repository
991 ;; was switched to the standard structure (i.e., "topdir/.git/").
992 (setq magit--separated-gitdirs (cl-delete topdir
993 magit--separated-gitdirs
994 :key #'car :test #'equal))
995 (unless (equal (file-name-as-directory (expand-file-name ".git" topdir))
996 gitdir)
997 (push (cons topdir gitdir) magit--separated-gitdirs))))
998
999 (defun magit-toplevel (&optional directory)
1000 "Return the absolute path to the toplevel of the current repository.
1001
1002 From within the working tree or control directory of a repository
1003 return the absolute path to the toplevel directory of the working
1004 tree. As a special case, from within a bare repository return the
1005 control directory instead. When called outside a repository, return
1006 nil.
1007
1008 When optional DIRECTORY is non-nil, return the toplevel for that
1009 directory, instead of the one for `default-directory'.
1010
1011 Try to respect the option `find-file-visit-truename', i.e., when the
1012 value of that option is nil, avoid needlessly returning the truename.
1013 When a symlink to a sub-directory of the working tree is involved,
1014 or when called from within a sub-directory of the gitdir or from the
1015 toplevel of a gitdir, which itself is not located within the working
1016 tree, then it is not possible to avoid returning the truename."
1017 (magit--with-refresh-cache
1018 (cons (or directory default-directory) 'magit-toplevel)
1019 (magit--with-safe-default-directory directory
1020 (cond-let*
1021 ([topdir (magit-rev-parse-safe "--show-toplevel")]
1022 [topdir (magit-expand-git-file-name topdir)]
1023 (cond-let*
1024 (;; Always honor these settings.
1025 [_(not find-file-visit-truename)]
1026 [_(not (getenv "GIT_WORK_TREE"))]
1027 ;; "--show-cdup" is the relative path to the toplevel from
1028 ;; (file-truename default-directory). Here we pretend it is
1029 ;; relative to `default-directory', and go to that directory.
1030 ;; Then we check whether "--show-toplevel" still returns the
1031 ;; same value and whether "--show-cdup" now is the empty
1032 ;; string. If both is the case, then we are at the toplevel
1033 ;; of the same working tree, but also avoided needlessly
1034 ;; following any symlinks.
1035 [updir (file-name-as-directory
1036 (magit-rev-parse-safe "--show-cdup"))]
1037 [updir (if (file-name-absolute-p updir)
1038 (concat (file-remote-p default-directory) updir)
1039 (expand-file-name updir))]
1040 [updir->topdir
1041 (let ((default-directory updir))
1042 (and (string-equal (magit-rev-parse-safe "--show-cdup") "")
1043 (magit-rev-parse-safe "--show-toplevel")))]
1044 [_(string-equal (magit-expand-git-file-name updir->topdir) topdir)]
1045 updir)
1046 ((concat (file-remote-p default-directory)
1047 (file-name-as-directory topdir)))))
1048 ([gitdir (magit-rev-parse-safe "--git-dir")]
1049 [gitdir (file-name-as-directory
1050 (if (file-name-absolute-p gitdir)
1051 ;; We might have followed a symlink.
1052 (concat (file-remote-p default-directory)
1053 (magit-expand-git-file-name gitdir))
1054 (expand-file-name gitdir)))]
1055 (cond-let*
1056 ;; Return the linked working tree, if any.
1057 ([link (expand-file-name "gitdir" gitdir)]
1058 [wtree (and (file-exists-p link)
1059 (magit-file-line link))]
1060 ;; Ignore ".git/gitdir" files that result from a Git bug.
1061 ;; This has long been fixed, but old repository may still
1062 ;; exist that contain such a file. See #2364.
1063 [_(not (equal wtree ".git"))]
1064 (file-name-directory (expand-file-name wtree default-directory)))
1065 ;; Keep the bare repo check after the linked working tree
1066 ;; check. See #5636.
1067 ((magit-bare-repo-p) gitdir)
1068 ;; The working directory may not be the parent
1069 ;; directory of .git if it was set up with
1070 ;; "git init --separate-git-dir". See #2955.
1071 ((car (rassoc gitdir magit--separated-gitdirs)))
1072 ;; We might be inside the nested gitdir of a submodule.
1073 ([parts (nreverse (file-name-split gitdir))]
1074 [_(equal (nth 2 parts) "modules")]
1075 [_(equal (nth 3 parts) ".git")]
1076 [default-directory (file-name-parent-directory gitdir)]
1077 [default-directory (magit-toplevel)]
1078 [path (magit-git-string "config" "-f" ".gitmodules"
1079 (format "submodule.%s.path" (nth 1 parts)))]
1080 [default-directory (expand-file-name path)]
1081 [_(file-equal-p (magit-gitdir) gitdir)]
1082 default-directory)
1083 ;; Step outside the control directory to enter the working tree.
1084 ((file-name-parent-directory gitdir))))))))
1085
1086 (defun magit--toplevel-safe ()
1087 (or (magit-toplevel)
1088 (magit--not-inside-repository-error)))
1089
1090 (defmacro magit-with-toplevel (&rest body)
1091 (declare (indent defun) (debug (body)))
1092 `(let ((default-directory (magit--toplevel-safe)))
1093 ,@body))
1094
1095 ;;;; Repository Predicates
1096
1097 (define-error 'magit-outside-git-repo "Not inside Git repository")
1098 (define-error 'magit-corrupt-git-config "Corrupt Git configuration")
1099 (define-error 'magit-git-executable-not-found "Git executable cannot be found")
1100
1101 (defun magit--assert-usable-git ()
1102 (if (not (executable-find (magit-git-executable) t))
1103 (signal 'magit-git-executable-not-found (magit-git-executable))
1104 (let ((magit-git-debug
1105 (lambda (err)
1106 (signal 'magit-corrupt-git-config
1107 (format "%s: %s" default-directory err)))))
1108 ;; This should always succeed unless there is a corrupt
1109 ;; config (or possibly a similarly severe failing state).
1110 (magit-git-string "config" "--default=_" "core.bare"))
1111 nil))
1112
1113 (defun magit--not-inside-repository-error ()
1114 (magit--assert-usable-git)
1115 (signal 'magit-outside-git-repo default-directory))
1116
1117 (defun magit-inside-gitdir-p (&optional noerror)
1118 "Return t if `default-directory' is below the repository directory.
1119 If it is below the working directory, then return nil.
1120 If it isn't below either, then signal an error unless NOERROR
1121 is non-nil, in which case return nil."
1122 (and (magit--assert-default-directory noerror)
1123 ;; Below a repository directory that is not located below the
1124 ;; working directory "git rev-parse --is-inside-git-dir" prints
1125 ;; "false", which is wrong.
1126 (let ((gitdir (magit-gitdir)))
1127 (cond (gitdir (file-in-directory-p default-directory gitdir))
1128 (noerror nil)
1129 ((signal 'magit-outside-git-repo default-directory))))))
1130
1131 (defun magit-inside-worktree-p (&optional noerror)
1132 "Return t if `default-directory' is below a working directory.
1133 If it is below the repository directory, then return nil.
1134 If it isn't below either, then signal an error unless NOERROR
1135 is non-nil, in which case return nil."
1136 (and (magit--assert-default-directory noerror)
1137 (condition-case nil
1138 (magit-rev-parse-true "--is-inside-work-tree")
1139 (magit-invalid-git-boolean
1140 (and (not noerror)
1141 (signal 'magit-outside-git-repo default-directory))))))
1142
1143 (cl-defgeneric magit-bare-repo-p (&optional noerror)
1144 "Return t if the current repository is bare.
1145 If it is non-bare, then return nil. If `default-directory'
1146 isn't below a Git repository, then signal an error unless
1147 NOERROR is non-nil, in which case return nil."
1148 (and (magit--assert-default-directory noerror)
1149 (condition-case nil
1150 (magit-rev-parse-true "--is-bare-repository")
1151 (magit-invalid-git-boolean
1152 (and (not noerror)
1153 (signal 'magit-outside-git-repo default-directory))))))
1154
1155 (defun magit--assert-default-directory (&optional noerror)
1156 (or (file-directory-p default-directory)
1157 (and (not noerror)
1158 (let ((exists (file-exists-p default-directory)))
1159 (signal (if exists 'file-error 'file-missing)
1160 (list "Running git in directory"
1161 (if exists
1162 "Not a directory"
1163 "No such file or directory")
1164 default-directory))))))
1165
1166 (defun magit-git-repo-p (directory &optional non-bare)
1167 "Return t if DIRECTORY is a Git repository.
1168 When optional NON-BARE is non-nil also return nil if DIRECTORY is
1169 a bare repository."
1170 (and (file-directory-p directory) ; Avoid archives, see #3397.
1171 (or (file-regular-p (expand-file-name ".git" directory))
1172 (file-directory-p (expand-file-name ".git" directory))
1173 (and (not non-bare)
1174 (file-regular-p (expand-file-name "HEAD" directory))
1175 (file-directory-p (expand-file-name "refs" directory))
1176 (file-directory-p (expand-file-name "objects" directory))))))
1177
1178 ;;; Files
1179 ;;;; File Predicates
1180
1181 (defun magit-file-ignored-p (file)
1182 (magit-git-string "ls-files" "--others" "--ignored" "--exclude-standard"
1183 "--" (magit-convert-filename-for-git file)))
1184
1185 (defun magit-file-tracked-p (file)
1186 (magit-git-success "ls-files" "--error-unmatch"
1187 "--" (magit-convert-filename-for-git file)))
1188
1189 ;;;; File Lists
1190
1191 (defun magit-list-files (&rest args)
1192 (magit-with-toplevel
1193 (apply #'magit-git-items "ls-files" "-z" args)))
1194
1195 (defun magit-tracked-files (&rest args)
1196 (magit-list-files "--cached" args))
1197
1198 (defun magit-untracked-files (&optional include-ignored directory)
1199 "Return a list of untracked files.
1200 If optional INCLUDE-IGNORED is non-nil, include ignored files.
1201 If optional DIRECTORY is non-nil, then limit to that directory.
1202 DIRECTORY can also be a list of files and directories."
1203 (magit-with-toplevel
1204 (seq-keep (##and (memq (aref % 0) '(?? ?!))
1205 (substring % 3))
1206 (magit-git-items "status" "-z" "--porcelain"
1207 (and include-ignored "--ignored")
1208 "--untracked-files=all"
1209 "--" directory))))
1210
1211 (defun magit--untracked-directories (&optional include-ignored directory)
1212 "Return a list of directories containing only untracked files.
1213 If optional INCLUDE-IGNORED is non-nil, consider ignored files.
1214 If optional DIRECTORY is non-nil, then limit to that directory.
1215 DIRECTORY can also be a list of files and directories."
1216 (magit-with-toplevel
1217 (seq-keep (##and (memq (aref % 0) '(?? ?!))
1218 (eq (aref % (1- (length %))) ?/)
1219 (substring % 3))
1220 (magit-git-items "status" "-z" "--porcelain"
1221 (and include-ignored "--ignored")
1222 "--untracked-files=normal"
1223 "--" directory))))
1224
1225 (defun magit-list-untracked-files (&optional files)
1226 "Return a list of untracked files.
1227
1228 List files if `magit-status-show-untracked-files' is non-nil, but also
1229 take the local value of Git variable `status.showUntrackedFiles' into
1230 account. The local value of the Lisp variable takes precedence over the
1231 local value of the Git variable. The global value of the Git variable
1232 is always ignored.
1233
1234 See also `magit-untracked-files'."
1235 (and-let*
1236 ((value (or (and (local-variable-p 'magit-status-show-untracked-files)
1237 magit-status-show-untracked-files)
1238 (pcase (magit-get "--local" "status.showUntrackedFiles")
1239 ((or "no" "off" "false" "0") 'no)
1240 ((or "yes" "on" "true" "1") t)
1241 ("all" 'all))
1242 magit-status-show-untracked-files))
1243 (_(not (eq value 'no))))
1244 (seq-keep (##and (eq (aref % 0) ??)
1245 (substring % 3))
1246 (apply #'magit-git-items "status" "-z" "--porcelain"
1247 (format "--untracked-files=%s"
1248 (if (eq value 'all) "all" "normal"))
1249 "--" files))))
1250
1251 (defun magit-ignored-files (&rest args)
1252 (magit-list-files "--others" "--ignored" "--exclude-standard" args))
1253
1254 (defun magit-modified-files (&optional nomodules files)
1255 (magit-git-items "diff-index" "-z" "--name-only"
1256 ;; Work around a bug in Git v2.46.0. See #5212 and #5221.
1257 (if nomodules "--ignore-submodules" "--submodule=short")
1258 (magit-headish) "--" files))
1259
1260 (defun magit-unstaged-files (&optional nomodules files)
1261 (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=u"
1262 ;; Work around a bug in Git v2.46.0. See #5212 and #5221.
1263 (if nomodules "--ignore-submodules" "--submodule=short")
1264 "--" files))
1265
1266 (defun magit-staged-files (&optional nomodules files)
1267 (magit-git-items "diff-index" "-z" "--name-only" "--cached"
1268 ;; Work around a bug in Git v2.46.0. See #5212 and #5221.
1269 (if nomodules "--ignore-submodules" "--submodule=short")
1270 (magit-headish) "--" files))
1271
1272 (defun magit-binary-files (&rest args)
1273 (seq-keep (##and (string-match "^-\t-\t\\(.+\\)" %)
1274 (match-str 1 %))
1275 (apply #'magit-git-items
1276 "diff" "-z" "--numstat" "--ignore-submodules"
1277 args)))
1278
1279 (defun magit-unmerged-files ()
1280 (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=U"))
1281
1282 (defun magit-stashed-files (stash)
1283 (magit-git-items "stash" "show" "-z" "--name-only" stash))
1284
1285 (defun magit-removed-files ()
1286 (seq-difference (delete-consecutive-dups
1287 (sort (magit-git-items "log" "-z" "--format="
1288 "--name-only" "--diff-filter=D")
1289 #'string<))
1290 (magit-list-files)))
1291
1292 (defun magit-skip-worktree-files (&rest args)
1293 (seq-keep (##and (= (aref % 0) ?S)
1294 (substring % 2))
1295 (magit-list-files "-t" args)))
1296
1297 (defun magit-assume-unchanged-files (&rest args)
1298 (seq-keep (##and (memq (aref % 0) '(?h ?s ?m ?r ?c ?k))
1299 (substring % 2))
1300 (magit-list-files "-v" args)))
1301
1302 (defun magit-revision-files (rev)
1303 (magit-git-items "ls-tree" "-z" "--full-tree" "-r" "--name-only" rev))
1304
1305 (defun magit-revision-directories (rev)
1306 "List directories that contain a tracked file in revision REV."
1307 (mapcar #'file-name-as-directory
1308 (magit-git-items "ls-tree" "-z" "--full-tree" "-r" "-d" "--name-only"
1309 rev)))
1310
1311 (defun magit-changed-files (rev-or-range &optional other-rev)
1312 "Return list of files the have changed between two revisions.
1313 If OTHER-REV is non-nil, REV-OR-RANGE should be a revision, not a
1314 range. Otherwise, it can be any revision or range accepted by
1315 \"git diff\" (i.e., <rev>, <revA>..<revB>, or <revA>...<revB>)."
1316 (magit-with-toplevel
1317 (magit-git-items "diff" "-z" "--name-only" rev-or-range other-rev)))
1318
1319 (defun magit-renamed-files (revA revB)
1320 (mapcar (pcase-lambda (`(,_status ,fileA ,fileB))
1321 (cons fileA fileB))
1322 (seq-partition (magit-git-items "diff" "-z" "--name-status"
1323 "--find-renames"
1324 "--diff-filter=R" revA revB)
1325 3)))
1326
1327 ;;;; File Names
1328
1329 (defun magit-file-relative-name (&optional file tracked)
1330 "Return the path of FILE relative to the repository root.
1331
1332 If optional FILE is nil or omitted, return the relative path of
1333 the file being visited in the current buffer, if any, else nil.
1334 If the file is not inside a Git repository, then return nil.
1335
1336 If TRACKED is non-nil, return the path only if it matches a
1337 tracked file."
1338 (with-current-buffer (or (buffer-base-buffer) (current-buffer))
1339 (and-let* ((file (or file
1340 (magit-buffer-file-name)
1341 (and (derived-mode-p 'dired-mode)
1342 default-directory)))
1343 (dir (magit-toplevel (magit--safe-default-directory
1344 (file-name-parent-directory file))))
1345 (_(or (not tracked)
1346 (magit-file-tracked-p file))))
1347 (file-relative-name file dir))))
1348
1349 (defun magit--rev-file-name (file rev other-rev)
1350 "For FILE, potentially renamed between REV and OTHER-REV, return name in REV.
1351 Return nil, if FILE appears neither in REV nor OTHER-REV,
1352 or if no rename is detected."
1353 (or (car (member file (magit-revision-files rev)))
1354 (and$ (magit-renamed-files rev other-rev)
1355 (car (rassoc file $)))))
1356
1357 (defun magit-expand-git-file-name (filename)
1358 (unless (file-name-absolute-p filename)
1359 (setq filename (expand-file-name filename)))
1360 (if-let ((cyg:win (and (not (file-remote-p default-directory)) ; see #4976
1361 (cl-assoc filename magit-cygwin-mount-points
1362 :test (##string-prefix-p %2 %1)))))
1363 (concat (cdr cyg:win)
1364 (substring filename (length (car cyg:win))))
1365 filename))
1366
1367 (defun magit-convert-filename-for-git (filename)
1368 "Convert FILENAME so that it can be passed to git.
1369 1. If it is a absolute filename, then pass it through
1370 `expand-file-name' to replace things such as \"~/\" that
1371 Git does not understand.
1372 2. If it is a remote filename, then remove the remote part.
1373 3. Deal with an `windows-nt' Emacs vs. Cygwin Git incompatibility."
1374 (cond-let
1375 ((not (file-name-absolute-p filename))
1376 filename)
1377 ([cyg:win (cl-rassoc filename magit-cygwin-mount-points
1378 :test (##string-prefix-p %2 %1))]
1379 (concat (car cyg:win)
1380 (substring filename (length (cdr cyg:win)))))
1381 ([expanded (expand-file-name filename)]
1382 (or (file-remote-p expanded 'localname)
1383 expanded))))
1384
1385 (defun magit-decode-git-path (path)
1386 (if (eq (aref path 0) ?\")
1387 (decode-coding-string (read path)
1388 (or magit-git-output-coding-system
1389 (car default-process-coding-system))
1390 t)
1391 path))
1392
1393 ;;;; File Miscellaneous
1394
1395 (defun magit-file-at-point (&optional expand assert)
1396 (cond-let
1397 ([file (magit-section-case
1398 (file (oref it value))
1399 (hunk (magit-section-parent-value it)))]
1400 (if expand
1401 (expand-file-name file (magit-toplevel))
1402 file))
1403 (assert
1404 (user-error "No file at point"))))
1405
1406 (defun magit-current-file ()
1407 (or (magit-file-relative-name)
1408 (magit-file-at-point)
1409 (and (derived-mode-p 'magit-log-mode)
1410 (car magit-buffer-log-files))))
1411
1412 (defun magit-file-status (&rest args)
1413 (magit--with-temp-process-buffer
1414 (save-excursion (magit-git-insert "status" "-z" args))
1415 (let ((pos (point)) status)
1416 (while (> (skip-chars-forward "[:print:]") 0)
1417 (let ((x (char-after pos))
1418 (y (char-after (1+ pos)))
1419 (file (buffer-substring (+ pos 3) (point))))
1420 (forward-char)
1421 (cond ((memq x '(?R ?C))
1422 (setq pos (point))
1423 (skip-chars-forward "[:print:]")
1424 (push (list file (buffer-substring pos (point)) x y) status)
1425 (forward-char))
1426 ((push (list file nil x y) status))))
1427 (setq pos (point)))
1428 status)))
1429
1430 ;;; Blobs
1431
1432 (defun magit-blob-p (obj)
1433 (equal (magit-object-type obj) "blob"))
1434
1435 (defun magit-blob-oid (rev file)
1436 (cond-let
1437 ((equal rev "{index}")
1438 (cadr (car (magit--file-index-stages file))))
1439 ;; --object-only and --format were only added in Git v2.36.0.
1440 ([out (magit-git-string "ls-tree" "--full-tree" rev "--"
1441 (magit-convert-filename-for-git file))]
1442 (nth 2 (split-string out "[\s\t]")))))
1443
1444 (defun magit--file-index-stages (file)
1445 (mapcar (##split-string % " ")
1446 (magit-git-lines "ls-files" "--stage" "--"
1447 (magit-convert-filename-for-git file))))
1448
1449 (defun magit--insert-blob-contents (obj file)
1450 (let ((coding-system-for-read (or coding-system-for-read 'undecided)))
1451 (if (magit-blob-p obj)
1452 (magit-git-insert "cat-file" "blob" obj)
1453 (magit-git-insert "cat-file" "-p"
1454 (if (equal obj "{index}")
1455 (concat ":" file)
1456 (concat obj ":" file))))
1457 (setq buffer-file-coding-system last-coding-system-used)
1458 nil))
1459
1460 ;;; Predicates
1461
1462 (defun magit-no-commit-p ()
1463 "Return t if there is no commit in the current Git repository."
1464 (not (magit-rev-verify "HEAD")))
1465
1466 (defun magit-merge-commit-p (commit)
1467 "Return t if COMMIT is a merge commit."
1468 (length> (magit-commit-parents commit) 1))
1469
1470 (defun magit-anything-staged-p (&optional ignore-submodules &rest files)
1471 "Return t if there are any staged changes.
1472 If optional FILES is non-nil, then only changes to those files
1473 are considered."
1474 ;; The "--submodule=short" is needed to work around a bug in Git v2.46.0
1475 ;; and v2.46.1. See #5212 and #5221. There are actually two related
1476 ;; bugs, both of which are fixed in v2.46.2, with the following commits,
1477 ;; but there is no workaround for the second bug.
1478 ;; 11591850dd diff: report dirty submodules as changes in builtin_diff()
1479 ;; 87cf96094a diff: report copies and renames as changes in run_diff_cmd()
1480 (magit-git-failure "diff" "--quiet" "--cached"
1481 (if ignore-submodules
1482 "--ignore-submodules"
1483 "--submodule=short")
1484 "--" files))
1485
1486 (defun magit-anything-unstaged-p (&optional ignore-submodules &rest files)
1487 "Return t if there are any unstaged changes.
1488 If optional FILES is non-nil, then only changes to those files
1489 are considered."
1490 (magit-git-failure "diff" "--quiet"
1491 (if ignore-submodules
1492 "--ignore-submodules"
1493 ;; Work around a bug in Git v2.46.0. See #5212 and #5221.
1494 "--submodule=short")
1495 "--" files))
1496
1497 (defun magit-anything-modified-p (&optional ignore-submodules &rest files)
1498 "Return t if there are any staged or unstaged changes.
1499 If optional FILES is non-nil, then only changes to those files
1500 are considered."
1501 (or (apply #'magit-anything-staged-p ignore-submodules files)
1502 (apply #'magit-anything-unstaged-p ignore-submodules files)))
1503
1504 (defun magit-anything-unmerged-p (&rest files)
1505 "Return t if there are any merge conflicts.
1506 If optional FILES is non-nil, then only conflicts in those files
1507 are considered."
1508 (and (magit-git-string "ls-files" "--unmerged" files) t))
1509
1510 (defun magit-module-worktree-p (module)
1511 (magit-with-toplevel
1512 (file-exists-p (expand-file-name ".git" module))))
1513
1514 (defun magit-module-no-worktree-p (module)
1515 (not (magit-module-worktree-p module)))
1516
1517 (defun magit-ignore-submodules-p (&optional return-argument)
1518 (or (and-let* ((arg (cl-find-if (##string-prefix-p "--ignore-submodules" %)
1519 magit-buffer-diff-args))
1520 (_(not (equal arg "--ignore-submodules=none"))))
1521 arg)
1522 (and-let* ((val (magit-get "diff.ignoreSubmodules"))
1523 (_(not (equal val "none"))))
1524 (if return-argument
1525 (concat "--ignore-submodules=" val)
1526 (concat "diff.ignoreSubmodules=" val)))))
1527
1528 ;;; Revisions and References
1529
1530 (defun magit-rev-parse (&rest args)
1531 "Execute \"git rev-parse ARGS\", returning first line of output.
1532 If there is no output, return nil."
1533 (apply #'magit-git-string "rev-parse" args))
1534
1535 (defun magit-rev-parse-safe (&rest args)
1536 "Execute \"git rev-parse ARGS\", returning first line of output.
1537 If there is no output, return nil. Like `magit-rev-parse' but
1538 ignore `magit-git-debug'."
1539 (apply #'magit-git-str "rev-parse" args))
1540
1541 (defun magit-rev-parse-true (&rest args)
1542 "Execute \"git rev-parse ARGS\", returning t if it prints \"true\".
1543 If it prints \"false\", then return nil. For any other output
1544 signal an error."
1545 (magit-git-true "rev-parse" args))
1546
1547 (defun magit-rev-parse-false (&rest args)
1548 "Execute \"git rev-parse ARGS\", returning t if it prints \"false\".
1549 If it prints \"true\", then return nil. For any other output
1550 signal an error."
1551 (magit-git-false "rev-parse" args))
1552
1553 (defun magit-rev-parse-p (&rest args)
1554 "Execute \"git rev-parse ARGS\", returning t if it prints \"true\".
1555 Return t if the first (and usually only) output line is the
1556 string \"true\", otherwise return nil."
1557 (equal (magit-git-str "rev-parse" args) "true"))
1558
1559 (defun magit-rev-verify (rev)
1560 (magit-git-string "rev-parse" "--verify" rev))
1561
1562 (defun magit-commit-p (rev)
1563 "Return non-nil if REV can be dereferences as a commit.
1564 Otherwise return nil. Use `magit-commit-oid' if you actually need
1565 the oid; eventually this function will return t instead of the oid,
1566 as it currently does for backward compatibility."
1567 ;; TODO Return t instead of the oid.
1568 (magit-rev-verify (magit--rev-dereference rev)))
1569
1570 (defun magit-commit-oid (rev &optional noerror)
1571 "Return commit oid for REV if it can be dereferences as a commit.
1572 Otherwise signal an error, or return nil, if optional NOERROR is non-nil."
1573 (cond ((magit-rev-verify (magit--rev-dereference rev)))
1574 (noerror nil)
1575 ((error "%s cannot be dereferenced as a commit" rev))))
1576
1577 (defun magit--rev-dereference (rev)
1578 "Return a rev that forces Git to interpret REV as a commit.
1579 Do so by appending \"^{commit}\"; see \"--verify\" in git-rev-parse(1).
1580 However, if REV is nil or has the form \":/TEXT\", return REV itself."
1581 (cond ((not rev) nil)
1582 ((string-prefix-p ":/" rev) rev)
1583 ((concat rev "^{commit}"))))
1584
1585 (defun magit-merge-base (a b &rest args)
1586 "Return the merge-base of commits A and B.
1587 Optional ARGS are additional argument to \"git merge-base\"."
1588 (magit-git-string "merge-base" args a b))
1589
1590 (defun magit-rev-ancestor-p (a b)
1591 "Return non-nil if commit A is an ancestor of commit B."
1592 (magit-git-success "merge-base" "--is-ancestor" a b))
1593
1594 (defun magit-rev-equal (a b)
1595 "Return t if there are no differences between the commits A and B."
1596 (magit-git-success "diff" "--quiet" a b))
1597
1598 (defun magit-rev-eq (a b)
1599 "Return t if A and B refer to the same commit."
1600 (and-let ((a (magit-commit-oid a t))
1601 (b (magit-commit-oid b t)))
1602 (equal a b)))
1603
1604 (defun magit-rev-head-p (rev)
1605 "Return t if REV can be dereferences as the `HEAD' commit."
1606 (or (equal rev "HEAD")
1607 (magit-rev-eq rev "HEAD")))
1608
1609 (defun magit-rev-author-p (rev)
1610 "Return t if the user is the author of REV.
1611 More precisely return t if `user.name' is equal to the author
1612 name of REV and/or `user.email' is equal to the author email
1613 of REV."
1614 (or (equal (magit-get "user.name") (magit-rev-format "%an" rev))
1615 (equal (magit-get "user.email") (magit-rev-format "%ae" rev))))
1616
1617 (defun magit-rev-name (rev &optional pattern not-anchored)
1618 "Return a symbolic name for REV using `git-name-rev'.
1619
1620 PATTERN can be used to limit the result to a matching ref. Unless
1621 NOT-ANCHORED is non-nil, the beginning of the ref must match PATTERN.
1622 An anchored lookup is done using the arguments \"--exclude=*/<PATTERN>\"
1623 and \"--exclude=*/HEAD\", in addition to \"--refs=<PATTERN>\"."
1624 (magit-git-string "name-rev" "--name-only" "--no-undefined"
1625 (and pattern (concat "--refs=" pattern))
1626 (and pattern
1627 (not not-anchored)
1628 (list "--exclude=*/HEAD"
1629 (concat "--exclude=*/" pattern)))
1630 rev))
1631
1632 (defun magit-rev-branch (rev)
1633 (and$ (magit-rev-name rev "refs/heads/*")
1634 (and (not (string-match-p "[~^]" $)) $)))
1635
1636 (defun magit-rev-fixup-target (rev)
1637 (let ((msg (magit-rev-format "%s" rev)))
1638 (save-match-data
1639 (and (string-match "\\`\\(squash!\\|fixup!\\|amend!\\) \\(.+\\)" msg)
1640 (magit-rev-format
1641 "%h" (format "%s^{/^%s}" rev
1642 (magit--ext-regexp-quote (match-str 2 msg))))))))
1643
1644 (defun magit-get-shortname (rev)
1645 (let* ((fn (apply-partially #'magit-rev-name rev))
1646 (name (or (funcall fn "refs/tags/*")
1647 (funcall fn "refs/heads/*")
1648 (funcall fn "refs/remotes/*"))))
1649 (cond ((not name)
1650 (magit-rev-parse "--short" rev))
1651 ((string-match "^\\(?:tags\\|remotes\\)/\\(.+\\)" name)
1652 (if (magit-ref-ambiguous-p (match-str 1 name))
1653 name
1654 (match-str 1 name)))
1655 ((magit-ref-maybe-qualify name)))))
1656
1657 (defun magit-name-branch (rev &optional lax)
1658 (or (magit-name-local-branch rev)
1659 (magit-name-remote-branch rev)
1660 (and lax (or (magit-name-local-branch rev t)
1661 (magit-name-remote-branch rev t)))))
1662
1663 (defun magit-name-local-branch (rev &optional lax)
1664 (and$ (magit-rev-name rev "refs/heads/*")
1665 (and (or lax (not (string-match-p "[~^]" $))) $)))
1666
1667 (defun magit-name-remote-branch (rev &optional lax)
1668 (and$ (magit-rev-name rev "refs/remotes/*")
1669 (and (or lax (not (string-match-p "[~^]" $)))
1670 (substring $ 8))))
1671
1672 (defun magit-name-tag (rev &optional lax)
1673 (and-let ((name (magit-rev-name rev "refs/tags/*")))
1674 (progn
1675 (when (string-suffix-p "^0" name)
1676 (setq name (substring name 0 -2)))
1677 (and (or lax (not (string-match-p "[~^]" name)))
1678 (substring name 5)))))
1679
1680 (defun magit-ref-abbrev (refname)
1681 "Return an unambiguous abbreviation of REFNAME."
1682 (magit-rev-parse "--verify" "--abbrev-ref" refname))
1683
1684 (defun magit-ref-fullname (refname)
1685 "Return fully qualified refname for REFNAME.
1686 If REFNAME is ambiguous, return nil."
1687 (magit-rev-parse "--verify" "--symbolic-full-name" refname))
1688
1689 (defun magit-ref-ambiguous-p (refname)
1690 (save-match-data
1691 (if (string-match "\\`\\([^^~]+\\)\\(.*\\)" refname)
1692 (not (magit-ref-fullname (match-str 1 refname)))
1693 (error "%S has an unrecognized format" refname))))
1694
1695 (defun magit-ref-maybe-qualify (refname &optional prefix)
1696 "If REFNAME is ambiguous, try to disambiguate it by prepend PREFIX to it.
1697 Return an unambiguous refname, either REFNAME or that prefixed
1698 with PREFIX, nil otherwise. If REFNAME has an offset suffix
1699 such as \"~1\", then that is preserved. If optional PREFIX is
1700 nil, then use \"heads/\"."
1701 (if (magit-ref-ambiguous-p refname)
1702 (let ((refname (concat (or prefix "heads/") refname)))
1703 (and (not (magit-ref-ambiguous-p refname)) refname))
1704 refname))
1705
1706 (defun magit-ref-exists-p (ref)
1707 (magit-git-success "show-ref" "--verify" ref))
1708
1709 (defun magit-ref-equal (a b)
1710 "Return t if the refnames A and B are `equal'.
1711 A symbolic-ref pointing to some ref, is `equal' to that ref,
1712 as are two symbolic-refs pointing to the same ref. Refnames
1713 may be abbreviated."
1714 (and-let ((a (magit-ref-fullname a))
1715 (b (magit-ref-fullname b)))
1716 (equal a b)))
1717
1718 (defun magit-ref-eq (a b)
1719 "Return t if the refnames A and B are `eq'.
1720 A symbolic-ref is `eq' to itself, but not to the ref it points
1721 to, or to some other symbolic-ref that points to the same ref."
1722 (let ((symbolic-a (magit-symbolic-ref-p a))
1723 (symbolic-b (magit-symbolic-ref-p b)))
1724 (or (and symbolic-a
1725 symbolic-b
1726 (equal a b))
1727 (and (not symbolic-a)
1728 (not symbolic-b)
1729 (magit-ref-equal a b)))))
1730
1731 (defun magit-headish ()
1732 "Return the `HEAD' or if that doesn't exist the hash of the empty tree."
1733 (if (magit-no-commit-p)
1734 (magit-git-string "mktree")
1735 "HEAD"))
1736
1737 (defun magit-branch-at-point ()
1738 (magit-section-case
1739 (branch (oref it value))
1740 (commit (or (magit--painted-branch-at-point)
1741 (magit-name-branch (oref it value))))
1742 (pullreq (and (fboundp 'forge--pullreq-branch-active)
1743 (forge--pullreq-branch-active (oref it value))))
1744 (related-refs (magit--painted-branch-at-point))
1745 ((unpulled unpushed)
1746 (magit-ref-abbrev
1747 (replace-regexp-in-string "\\.\\.\\.?" "" (oref it value))))))
1748
1749 (defun magit--painted-branch-at-point (&optional type)
1750 (or (and (not (eq type 'remote))
1751 (memq (get-text-property (magit-point) 'font-lock-face)
1752 (list 'magit-branch-local
1753 'magit-branch-current))
1754 (and$ (magit-thing-at-point 'git-revision t)
1755 (cdr (magit-split-branch-name $))))
1756 (and (not (eq type 'local))
1757 (memq (get-text-property (magit-point) 'font-lock-face)
1758 (list 'magit-branch-remote
1759 'magit-branch-remote-head))
1760 (thing-at-point 'git-revision t))))
1761
1762 (defun magit-local-branch-at-point ()
1763 (magit-section-case
1764 (branch (let ((branch (magit-ref-maybe-qualify (oref it value))))
1765 (when (member branch (magit-list-local-branch-names))
1766 branch)))
1767 (commit (or (magit--painted-branch-at-point 'local)
1768 (magit-name-local-branch (oref it value))))))
1769
1770 (defun magit-remote-branch-at-point ()
1771 (magit-section-case
1772 (branch (let ((branch (oref it value)))
1773 (when (member branch (magit-list-remote-branch-names))
1774 branch)))
1775 (commit (or (magit--painted-branch-at-point 'remote)
1776 (magit-name-remote-branch (oref it value))))))
1777
1778 (defun magit-commit-at-point ()
1779 (or (magit-section-value-if 'commit)
1780 (magit-thing-at-point 'git-revision t)
1781 (and-let ((chunk (and (bound-and-true-p magit-blame-mode)
1782 (fboundp 'magit-current-blame-chunk)
1783 (magit-current-blame-chunk))))
1784 (oref chunk orig-rev))
1785 (and (derived-mode-p 'magit-stash-mode
1786 'magit-merge-preview-mode
1787 'magit-revision-mode)
1788 magit-buffer-revision)))
1789
1790 (defun magit-branch-or-commit-at-point ()
1791 (or (magit-section-case
1792 (branch (magit-ref-maybe-qualify (oref it value)))
1793 (commit (or (magit--painted-branch-at-point)
1794 (let ((rev (oref it value)))
1795 (or (magit-name-branch rev) rev))))
1796 (tag (magit-ref-maybe-qualify (oref it value) "tags/"))
1797 (pullreq (or (and (fboundp 'forge--pullreq-branch-active)
1798 (forge--pullreq-branch-active (oref it value)))
1799 (and (fboundp 'forge--pullreq-ref)
1800 (forge--pullreq-ref (oref it value)))))
1801 ((unpulled unpushed)
1802 (magit-ref-abbrev
1803 (replace-regexp-in-string "\\.\\.\\.?" "" (oref it value)))))
1804 (magit-thing-at-point 'git-revision t)
1805 (and-let ((chunk (and (bound-and-true-p magit-blame-mode)
1806 (fboundp 'magit-current-blame-chunk)
1807 (magit-current-blame-chunk))))
1808 (oref chunk orig-rev))
1809 (and magit-buffer-file-name
1810 magit-buffer-revision)
1811 (and (derived-mode-p 'magit-stash-mode
1812 'magit-merge-preview-mode
1813 'magit-revision-mode)
1814 magit-buffer-revision)))
1815
1816 (defun magit-tag-at-point ()
1817 (magit-section-case
1818 (tag (oref it value))
1819 (commit (magit-name-tag (oref it value)))))
1820
1821 (defun magit-stash-at-point ()
1822 (magit-section-value-if 'stash))
1823
1824 (defun magit-remote-at-point ()
1825 (magit-section-case
1826 (remote (oref it value))
1827 ([branch remote] (magit-section-parent-value it))))
1828
1829 (defun magit-module-at-point (&optional predicate)
1830 (when (magit-section-match 'module)
1831 (let ((module (oref (magit-current-section) value)))
1832 (and (or (not predicate)
1833 (funcall predicate module))
1834 module))))
1835
1836 (defun magit-repository-at-point ()
1837 (or (magit-module-at-point)
1838 (and (derived-mode-p 'magit-repolist-mode)
1839 (tabulated-list-get-id))))
1840
1841 (defun magit-get-current-branch ()
1842 "Return the refname of the currently checked out branch.
1843 Return nil if no branch is currently checked out."
1844 (magit-git-string "symbolic-ref" "--short" "HEAD"))
1845
1846 (defvar magit-get-previous-branch-timeout 0.5
1847 "Maximum time to spend in `magit-get-previous-branch'.
1848 Given as a number of seconds.")
1849
1850 (defun magit-get-previous-branch ()
1851 "Return the refname of the previously checked out branch.
1852 Return nil if no branch can be found in the `HEAD' reflog,
1853 which is different from the current branch and still exists.
1854 The amount of time spent searching is limited by
1855 `magit-get-previous-branch-timeout'."
1856 (let ((t0 (float-time))
1857 (current (magit-get-current-branch))
1858 (i 1) prev)
1859 (while (cond ((> (- (float-time) t0) magit-get-previous-branch-timeout)
1860 (setq prev nil))
1861 ((setq prev (magit-rev-verify (format "@{-%d}" i)))
1862 (or (not (setq prev (magit-rev-branch prev)))
1863 (equal prev current))))
1864 (incf i))
1865 prev))
1866
1867 (defun magit--set-default-branch (newname oldname)
1868 (let ((remote (or (magit-primary-remote)
1869 (user-error "Cannot determine primary remote")))
1870 (branches (mapcar (##split-string % "\t")
1871 (magit-git-lines
1872 "for-each-ref" "refs/heads"
1873 "--format=%(refname:short)\t%(upstream:short)"))))
1874 (when-let ((old (assoc oldname branches))
1875 (_(not (assoc newname branches))))
1876 (magit-call-git "branch" "-m" oldname newname)
1877 (setcar old newname))
1878 (let ((new (if (magit-branch-p newname)
1879 newname
1880 (concat remote "/" newname))))
1881 (pcase-dolist (`(,branch ,upstream) branches)
1882 (cond
1883 ((equal upstream oldname)
1884 (magit-set-upstream-branch branch new))
1885 ((equal upstream (concat remote "/" oldname))
1886 (magit-set-upstream-branch branch (concat remote "/" newname))))))))
1887
1888 (defun magit--get-default-branch (&optional update)
1889 (let ((remote (magit-primary-remote)))
1890 (when update
1891 (if (not remote)
1892 (user-error "Cannot determine primary remote")
1893 (message "Determining default branch...")
1894 (magit-git "fetch" "--prune")
1895 (magit-git "remote" "set-head" "--auto" remote)
1896 (message "Determining default branch...done")))
1897 (let ((branch (magit-git-string "symbolic-ref" "--short"
1898 (format "refs/remotes/%s/HEAD" remote))))
1899 (when (and update (not branch))
1900 (error "Cannot determine new default branch"))
1901 (list remote (and branch (cdr (magit-split-branch-name branch)))))))
1902
1903 (defun magit-set-upstream-branch (branch upstream)
1904 "Set UPSTREAM as the upstream of BRANCH.
1905 If UPSTREAM is nil, then unset BRANCH's upstream.
1906 Otherwise UPSTREAM has to be an existing branch."
1907 (if upstream
1908 (magit-call-git "branch" "--set-upstream-to" upstream branch)
1909 (magit-call-git "branch" "--unset-upstream" branch)))
1910
1911 (defun magit-get-upstream-ref (&optional branch)
1912 "Return the upstream branch of BRANCH as a fully qualified ref.
1913 It BRANCH is nil, then return the upstream of the current branch,
1914 if any, nil otherwise. If the upstream is not configured, the
1915 configured remote is an url, or the named branch does not exist,
1916 then return nil. I.e., return an existing local or
1917 remote-tracking branch ref."
1918 (and$ (or branch (magit-get-current-branch))
1919 (magit-ref-fullname (concat $ "@{upstream}"))))
1920
1921 (defun magit-get-upstream-branch (&optional branch)
1922 "Return the name of the upstream branch of BRANCH.
1923 It BRANCH is nil, then return the upstream of the current branch
1924 if any, nil otherwise. If the upstream is not configured, the
1925 configured remote is an url, or the named branch does not exist,
1926 then return nil. I.e., return the name of an existing local or
1927 remote-tracking branch. The returned string is colorized
1928 according to the branch type."
1929 (magit--with-refresh-cache
1930 (list default-directory 'magit-get-upstream-branch branch)
1931 (and-let* ((branch (or branch (magit-get-current-branch)))
1932 (upstream (magit-ref-abbrev (concat branch "@{upstream}"))))
1933 (magit--propertize-face
1934 upstream (if (equal (magit-get "branch" branch "remote") ".")
1935 'magit-branch-local
1936 'magit-branch-remote)))))
1937
1938 (defun magit-get-local-upstream-branch (&optional branch)
1939 (and-let* ((upstream (magit-get-upstream-branch branch))
1940 (upstream (cdr (magit-split-branch-name upstream))))
1941 (and (magit-branch-p upstream) upstream)))
1942
1943 (defun magit-get-indirect-upstream-branch (branch &optional force)
1944 (let ((remote (magit-get "branch" branch "remote")))
1945 (and remote (not (equal remote "."))
1946 ;; The user has opted in...
1947 (or force
1948 (seq-some (##if (magit-git-success "check-ref-format" "--branch" %)
1949 (equal % branch)
1950 (string-match-p % branch))
1951 magit-branch-prefer-remote-upstream))
1952 ;; and local BRANCH tracks a remote branch...
1953 (let ((upstream (magit-get-upstream-branch branch)))
1954 ;; whose upstream...
1955 (and upstream
1956 ;; has the same name as BRANCH...
1957 (equal (substring upstream (1+ (length remote))) branch)
1958 ;; and can be fast-forwarded to BRANCH.
1959 (magit-rev-ancestor-p upstream branch)
1960 upstream)))))
1961
1962 (defun magit-get-upstream-remote (&optional branch allow-unnamed)
1963 (and-let* ((branch (or branch (magit-get-current-branch)))
1964 (remote (magit-get "branch" branch "remote")))
1965 (and (not (equal remote "."))
1966 (cond ((member remote (magit-list-remotes))
1967 (magit--propertize-face remote 'magit-branch-remote))
1968 ((and allow-unnamed
1969 (string-match-p "\\(\\`.\\{0,2\\}/\\|[:@]\\)" remote))
1970 (magit--propertize-face remote 'bold))))))
1971
1972 (defun magit-get-unnamed-upstream (&optional branch)
1973 (and-let* ((branch (or branch (magit-get-current-branch)))
1974 (remote (magit-get "branch" branch "remote"))
1975 (merge (magit-get "branch" branch "merge")))
1976 (and (magit--unnamed-upstream-p remote merge)
1977 (list (magit--propertize-face remote 'bold)
1978 (magit--propertize-face merge 'magit-branch-remote)))))
1979
1980 (defun magit--unnamed-upstream-p (remote merge)
1981 (and remote (string-match-p "\\(\\`\\.\\{0,2\\}/\\|[:@]\\)" remote)
1982 merge (string-prefix-p "refs/" merge)))
1983
1984 (defun magit--valid-upstream-p (remote merge)
1985 (and (or (equal remote ".")
1986 (member remote (magit-list-remotes)))
1987 (string-prefix-p "refs/" merge)))
1988
1989 (defun magit-get-current-remote (&optional allow-unnamed)
1990 (or (magit-get-upstream-remote nil allow-unnamed)
1991 (and-let* ((remotes (magit-list-remotes))
1992 (remote (if (length= remotes 1)
1993 (car remotes)
1994 (magit-primary-remote))))
1995 (magit--propertize-face remote 'magit-branch-remote))))
1996
1997 (defun magit-get-push-remote (&optional branch)
1998 (and-let ((remote
1999 (or (and (or branch (setq branch (magit-get-current-branch)))
2000 (magit-get "branch" branch "pushRemote"))
2001 (magit-get "remote.pushDefault"))))
2002 (magit--propertize-face remote 'magit-branch-remote)))
2003
2004 (defun magit-get-push-branch (&optional branch verify)
2005 (magit--with-refresh-cache
2006 (list default-directory 'magit-get-push-branch branch verify)
2007 (and-let*
2008 ((branch (cond ((not branch)
2009 (magit-get-current-branch))
2010 ((string-prefix-p "refs/" branch)
2011 (magit-ref-abbrev branch))
2012 (branch)))
2013 (remote (magit-get-push-remote branch))
2014 (target (concat remote "/" branch)))
2015 (and (or (not verify)
2016 (magit-rev-verify target))
2017 (magit--propertize-face target 'magit-branch-remote)))))
2018
2019 (defun magit-get-@{push}-branch (&optional branch)
2020 (and-let* ((branch (magit-ref-abbrev (or branch (magit-get-current-branch))))
2021 (target (magit-ref-fullname (concat branch "@{push}"))))
2022 (magit-ref-abbrev target)))
2023
2024 (defun magit-get-remote (&optional branch)
2025 (and (or branch (setq branch (magit-get-current-branch)))
2026 (let ((remote (magit-get "branch" branch "remote")))
2027 (and (not (equal remote "."))
2028 remote))))
2029
2030 (defun magit-get-some-remote (&optional branch)
2031 (or (magit-get-remote branch)
2032 (and$ (magit-main-branch)
2033 (magit-get-remote $))
2034 (magit-primary-remote)
2035 (car (magit-list-remotes))))
2036
2037 (defvar magit-primary-remote-names
2038 '("upstream" "origin"))
2039
2040 (defun magit-primary-remote ()
2041 "Return the primary remote.
2042
2043 The primary remote is the remote that tracks the repository that
2044 other repositories are forked from. It often is called \"origin\"
2045 but because many people name their own fork \"origin\", using that
2046 term would be ambiguous. Likewise we avoid the term \"upstream\"
2047 because a branch's @{upstream} branch may be a local branch or a
2048 branch from a remote other than the primary remote.
2049
2050 If a remote exists whose name matches `magit.primaryRemote', then
2051 that is considered the primary remote. If no remote by that name
2052 exists, then remotes in `magit-primary-remote-names' are tried in
2053 order and the first remote from that list that actually exists in
2054 the current repository is considered its primary remote."
2055 (let ((remotes (magit-list-remotes)))
2056 (seq-find (##member % remotes)
2057 (delete-dups
2058 (delq nil
2059 (cons (magit-get "magit.primaryRemote")
2060 magit-primary-remote-names))))))
2061
2062 (defun magit-branch-merged-p (branch &optional target)
2063 "Return non-nil if BRANCH is merged into its upstream and TARGET.
2064
2065 TARGET defaults to the current branch. If `HEAD' is detached and
2066 TARGET is nil, then always return nil. As a special case, if
2067 TARGET is t, then return non-nil if BRANCH is merged into any one
2068 of the other local branches.
2069
2070 If, and only if, BRANCH has an upstream, then only return non-nil
2071 if BRANCH is merged into both TARGET (as described above) as well
2072 as into its upstream."
2073 (and (if-let ((upstream (and (magit-branch-p branch)
2074 (magit-get-upstream-branch branch))))
2075 (magit-rev-ancestor-p branch upstream)
2076 t)
2077 (cond-let
2078 ((eq target t)
2079 (delete (magit-name-local-branch branch)
2080 (magit-list-containing-branches branch)))
2081 ([target (or target (magit-get-current-branch))]
2082 (magit-rev-ancestor-p branch target)))))
2083
2084 (defun magit-get-tracked (refname)
2085 "Return the remote branch tracked by the remote-tracking branch REFNAME.
2086 The returned value has the form (REMOTE . REF), where REMOTE is
2087 the name of a remote and REF is the ref local to the remote."
2088 (and-let ((ref (magit-ref-fullname refname)))
2089 (save-match-data
2090 (seq-some (lambda (line)
2091 (and (string-match "\
2092 \\`remote\\.\\([^.]+\\)\\.fetch=\\+?\\([^:]+\\):\\(.+\\)" line)
2093 (let ((rmt (match-str 1 line))
2094 (src (match-str 2 line))
2095 (dst (match-str 3 line)))
2096 (and (string-match (format "\\`%s\\'"
2097 (string-replace
2098 "*" "\\(.+\\)" dst))
2099 ref)
2100 (cons rmt (string-replace
2101 "*" (match-str 1 ref) src))))))
2102 (magit-git-lines "config" "--local" "--list")))))
2103
2104 (defun magit-split-branch-name (branch)
2105 (cond ((member branch (magit-list-local-branch-names))
2106 (cons "." branch))
2107 ((string-match "/" branch)
2108 (or (seq-some (lambda (remote)
2109 (and (string-match
2110 (format "\\`\\(%s\\)/\\(.+\\)\\'" remote)
2111 branch)
2112 (cons (match-str 1 branch)
2113 (match-str 2 branch))))
2114 (magit-list-remotes))
2115 (error "Invalid branch name %s" branch)))))
2116
2117 (defun magit-get-current-tag (&optional rev with-distance)
2118 "Return the closest tag reachable from REV.
2119
2120 If optional REV is nil, then default to `HEAD'.
2121 If optional WITH-DISTANCE is non-nil then return (TAG COMMITS),
2122 if it is `dirty' return (TAG COMMIT DIRTY). COMMITS is the number
2123 of commits in `HEAD' but not in TAG and DIRTY is t if there are
2124 uncommitted changes, nil otherwise."
2125 (and-let ((str (magit-git-str "describe" "--long" "--tags"
2126 (and (eq with-distance 'dirty) "--dirty")
2127 rev)))
2128 (save-match-data
2129 (string-match
2130 "\\(.+\\)-\\(?:0[0-9]*\\|\\([0-9]+\\)\\)-g[0-9a-z]+\\(-dirty\\)?$" str)
2131 (if with-distance
2132 `(,(match-str 1 str)
2133 ,(string-to-number (or (match-str 2 str) "0"))
2134 ,@(and (match-str 3 str) (list t)))
2135 (match-str 1 str)))))
2136
2137 (defun magit-get-next-tag (&optional rev with-distance)
2138 "Return the closest tag from which REV is reachable.
2139
2140 If optional REV is nil, then default to `HEAD'.
2141 If no such tag can be found or if the distance is 0 (in which
2142 case it is the current tag, not the next), return nil instead.
2143 If optional WITH-DISTANCE is non-nil, then return (TAG COMMITS)
2144 where COMMITS is the number of commits in TAG but not in REV."
2145 (and-let ((str (magit-git-str "describe" "--contains" (or rev "HEAD"))))
2146 (save-match-data
2147 (when (string-match "^[^^~]+" str)
2148 (setq str (match-str 0 str))
2149 (unless (equal str (magit-get-current-tag rev))
2150 (if with-distance
2151 (list str (car (magit-rev-diff-count str rev)))
2152 str))))))
2153
2154 (defun magit-list-refs (&optional namespaces format sortby)
2155 "Return list of references, excluding symbolic references.
2156
2157 When NAMESPACES is non-nil, list refs from these namespaces
2158 rather than those from `magit-list-refs-namespaces'.
2159
2160 FORMAT is passed to the \"--format\" flag of \"git for-each-ref\"
2161 and defaults to \"%(refname)\".
2162
2163 SORTBY is a key or list of keys to pass to the \"--sort\" flag
2164 of \"git for-each-ref\" to sort the refs within each namespace.
2165 When nil, use `magit-list-refs-sortby'. If both are nil, use
2166 \"version:refname\", but only for \"refs/tags\"."
2167 (let ((format (concat "--format=%(symref) " (or format "%(refname)")))
2168 (sortby (mapcar (##concat "--sort=" %)
2169 (ensure-list (or sortby magit-list-refs-sortby)))))
2170 (seq-keep (lambda (line)
2171 (pcase-let* ((`(,symrefp ,value)
2172 (split-string line " "))
2173 (symrefp (not (equal symrefp ""))))
2174 (and (not symrefp) value)))
2175 (mapcan (lambda (ns)
2176 (if (and (not sortby)
2177 (equal ns "refs/tags"))
2178 (magit-git-lines "for-each-ref" format
2179 "--sort=-version:refname" ns)
2180 (magit-git-lines "for-each-ref" format sortby ns)))
2181 (ensure-list
2182 (or namespaces magit-list-refs-namespaces))))))
2183
2184 (defun magit-list-branches ()
2185 "Return list of local and remote-tracking branches."
2186 (magit-list-refs (list "refs/heads" "refs/remotes")))
2187
2188 (defun magit-list-local-branches ()
2189 "Return list of local branches."
2190 (magit-list-refs "refs/heads"))
2191
2192 (defun magit-list-remote-branches (&optional remote)
2193 "Return list of remote-tracking branches.
2194 If optional REMOTE is non-nil, return only branches from that remote."
2195 (magit-list-refs (concat "refs/remotes/" remote)))
2196
2197 (defun magit-list-related-branches (relation &optional rev &rest args)
2198 "Return list of branches related to REV.
2199 RELATION must be one of \"--contains\", \"--no-contains\", \"--merged\",
2200 \"--no-merged\" and \"--points-at\". If optional REV is nil, default to
2201 the \"HEAD\" commit. Optional ARGS are additional arguments passed to
2202 \"git branch\"."
2203 (seq-remove (##string-match-p "\\(\\`(HEAD\\|HEAD -> \\)" %)
2204 (mapcar (##substring % 2)
2205 (magit-git-lines "branch" args relation rev))))
2206
2207 (defun magit-list-containing-branches (&optional rev &rest args)
2208 "Return list of branches containing REV.
2209 If optional REV is nil, default to the \"HEAD\" commit.
2210 Optional ARGS are additional arguments passed to \"git branch\"."
2211 (magit-list-related-branches "--contains" rev args))
2212
2213 (defun magit-list-publishing-branches (&optional rev)
2214 (seq-filter (##magit-rev-ancestor-p (or rev "HEAD") %)
2215 magit-published-branches))
2216
2217 (defun magit-list-merged-branches (&optional rev &rest args)
2218 "Return list of branches merged into REV.
2219 If optional REV is nil, default to the \"HEAD\" commit.
2220 Optional ARGS are additional arguments passed to \"git branch\"."
2221 (magit-list-related-branches "--merged" rev args))
2222
2223 (defun magit-list-unmerged-branches (&optional rev &rest args)
2224 "Return list of branches not merged into REV.
2225 If optional REV is nil, default to the \"HEAD\" commit.
2226 Optional ARGS are additional arguments passed to \"git branch\"."
2227 (magit-list-related-branches "--no-merged" rev args))
2228
2229 (defun magit-list-unmerged-to-upstream-branches ()
2230 "Return list of branches not merged into their respective upstreams."
2231 (seq-filter (##and-let ((upstream (magit-get-upstream-branch %)))
2232 (member % (magit-list-unmerged-branches upstream)))
2233 (magit-list-local-branch-names)))
2234
2235 (defun magit-list-branches-pointing-at (rev)
2236 "Return list of branches pointing at REV."
2237 (let ((re (format "\\`%s refs/\\(heads\\|remotes\\)/\\(.*\\)\\'"
2238 (magit-rev-verify rev))))
2239 (seq-keep (##and (string-match re %)
2240 (let ((name (match-str 2 %)))
2241 (and (not (string-suffix-p "HEAD" name))
2242 name)))
2243 (magit-git-lines "show-ref"))))
2244
2245 (defun magit-list-refnames (&optional namespaces include-special)
2246 (nconc (magit-list-refs namespaces "%(refname:short)")
2247 (and include-special
2248 (magit-list-special-refnames))))
2249
2250 (defvar magit-special-refnames
2251 '("HEAD" "ORIG_HEAD" "FETCH_HEAD" "MERGE_HEAD" "CHERRY_PICK_HEAD"))
2252
2253 (defun magit-list-special-refnames ()
2254 (let ((gitdir (magit-gitdir)))
2255 (cl-remove-if-not (##file-exists-p (expand-file-name % gitdir))
2256 magit-special-refnames)))
2257
2258 (defun magit-list-branch-names ()
2259 (magit-list-refnames (list "refs/heads" "refs/remotes")))
2260
2261 (defun magit-list-local-branch-names ()
2262 (magit-list-refnames "refs/heads"))
2263
2264 (defun magit-list-remote-branch-names (&optional remote relative)
2265 (if (and remote relative)
2266 (let ((regexp (format "^refs/remotes/%s/\\(.+\\)" remote)))
2267 (seq-keep (##and (string-match regexp %)
2268 (match-str 1 %))
2269 (magit-list-remote-branches remote)))
2270 (magit-list-refnames (concat "refs/remotes/" remote))))
2271
2272 (defun magit-format-refs (format &rest args)
2273 (let ((lines (magit-git-lines
2274 "for-each-ref" (concat "--format=" format)
2275 (or args (list "refs/heads" "refs/remotes" "refs/tags")))))
2276 (if (string-search "\f" format)
2277 (mapcar (##split-string % "\f") lines)
2278 lines)))
2279
2280 (defun magit-list-remotes ()
2281 (magit-git-lines "remote"))
2282
2283 (defun magit-list-tags ()
2284 (magit-git-lines "tag"))
2285
2286 (defun magit-list-stashes (&optional format)
2287 (magit-git-lines "stash" "list" (concat "--format=" (or format "%gd"))))
2288
2289 (defun magit-list-active-notes-refs ()
2290 "Return notes refs according to `core.notesRef' and `notes.displayRef'."
2291 (magit-git-lines "for-each-ref" "--format=%(refname)"
2292 (or (magit-get "core.notesRef") "refs/notes/commits")
2293 (magit-get-all "notes.displayRef")))
2294
2295 (defun magit-list-notes-refnames ()
2296 (mapcar (##substring % 6) (magit-list-refnames "refs/notes")))
2297
2298 (defun magit-remote-list-tags (remote)
2299 (seq-keep (##and (not (string-suffix-p "^{}" %))
2300 (substring % 51))
2301 (magit-git-lines "ls-remote" "--tags" remote)))
2302
2303 (defun magit-remote-list-branches (remote)
2304 (seq-keep (##and (not (string-suffix-p "^{}" %))
2305 (substring % 52))
2306 (magit-git-lines "ls-remote" "--heads" remote)))
2307
2308 (defun magit-remote-list-refs (remote)
2309 (seq-keep (##and (not (string-suffix-p "^{}" %))
2310 (substring % 41))
2311 (magit-git-lines "ls-remote" remote)))
2312
2313 (defun magit-remote-head (remote)
2314 (and$ (cl-find-if (##string-match
2315 "\\`ref: refs/heads/\\([^\s\t]+\\)[\s\t]HEAD\\'" %)
2316 (magit-git-lines "ls-remote" "--symref" remote "HEAD"))
2317 (match-str 1 $)))
2318
2319 (defun magit-list-modified-modules ()
2320 (seq-keep (##and (string-match "\\`\\+\\([^ ]+\\) \\(.+\\) (.+)\\'" %)
2321 (match-str 2 %))
2322 (magit-git-lines "submodule" "status")))
2323
2324 (defun magit-list-module-paths ()
2325 (magit-with-toplevel
2326 (seq-keep (##and (string-match "^160000 [0-9a-z]\\{40,\\} 0\t\\(.+\\)$" %)
2327 (match-str 1 %))
2328 (magit-git-items "ls-files" "-z" "--stage"))))
2329
2330 (defun magit-list-module-names ()
2331 (mapcar #'magit-get-submodule-name (magit-list-module-paths)))
2332
2333 (defun magit-get-submodule-name (path)
2334 "Return the name of the submodule at PATH.
2335 PATH has to be relative to the super-repository."
2336 (if (magit-git-version>= "2.38.0")
2337 ;; "git submodule--helper name" was removed,
2338 ;; but might still come back in another form.
2339 (substring
2340 (car (split-string
2341 (car (or (magit-git-items
2342 "config" "-z"
2343 "-f" (expand-file-name ".gitmodules" (magit-toplevel))
2344 "--get-regexp" "^submodule\\..*\\.path$"
2345 (concat "^" (regexp-quote (directory-file-name path)) "$"))
2346 (error "No such submodule `%s'" path)))
2347 "\n"))
2348 10 -5)
2349 (magit-git-string "submodule--helper" "name" path)))
2350
2351 (defun magit-list-worktrees ()
2352 "Return list of the worktrees of this repository.
2353
2354 The returned list has the form (PATH COMMIT BRANCH BARE DETACHED
2355 LOCKED PRUNABLE). The last four elements are booleans, with the
2356 exception of LOCKED and PRUNABLE, which may also be strings.
2357 See git-worktree(1) manpage for the meaning of the various parts.
2358
2359 This function corrects a situation where \"git worktree list\"
2360 would claim a worktree is bare, even though the working tree is
2361 specified using `core.worktree'."
2362 (let ((remote (file-remote-p default-directory))
2363 worktrees worktree)
2364 (dolist (line (if (magit-git-version>= "2.36")
2365 (magit-git-items "worktree" "list" "--porcelain" "-z")
2366 (magit-git-lines "worktree" "list" "--porcelain")))
2367 (cond ((string-prefix-p "worktree" line)
2368 (let ((path (substring line 9)))
2369 (when remote
2370 (setq path (concat remote path)))
2371 ;; If the git directory is separate from the main
2372 ;; worktree, then "git worktree" returns the git
2373 ;; directory instead of the worktree, which isn't
2374 ;; what it is supposed to do and not what we want.
2375 ;; However, if the worktree has been removed, then
2376 ;; we want to return it anyway; instead of nil.
2377 (setq path (or (magit-toplevel path) path))
2378 (setq worktree (list path nil nil nil nil nil nil))
2379 (push worktree worktrees)))
2380 ((string-prefix-p "HEAD" line)
2381 (setf (nth 1 worktree) (substring line 5)))
2382 ((string-prefix-p "branch" line)
2383 (setf (nth 2 worktree) (substring line 18)))
2384 ((string-equal line "bare")
2385 (let* ((default-directory (car worktree))
2386 (wt (and (not (magit-get-boolean "core.bare"))
2387 (magit-get "core.worktree"))))
2388 (cond ((and wt (file-exists-p (expand-file-name wt)))
2389 (setf (nth 0 worktree) (expand-file-name wt))
2390 (setf (nth 2 worktree) (magit-rev-parse "HEAD"))
2391 (setf (nth 3 worktree) (magit-get-current-branch)))
2392 ((setf (nth 3 worktree) t)))))
2393 ((string-equal "detached" line)
2394 (setf (nth 4 worktree) t))
2395 ((string-prefix-p "locked" line)
2396 (setf (nth 5 worktree)
2397 (if (> (length line) 6) (substring line 7) t)))
2398 ((string-prefix-p "prunable" line)
2399 (setf (nth 6 worktree)
2400 (if (> (length line) 8) (substring line 9) t)))))
2401 (nreverse worktrees)))
2402
2403 (defun magit-symbolic-ref-p (string)
2404 "Return t if STRING is a reference, nil otherwise.
2405 Signal an error if STRING is not a string."
2406 (cl-assert (stringp string))
2407 (magit-git-success "symbolic-ref" "--quiet" string))
2408
2409 (defun magit-ref-p (string)
2410 "Return t if STRING is a reference, nil otherwise.
2411 Signal an error if STRING is not a string."
2412 (cl-assert (stringp string))
2413 (and (magit-ref-fullname string)
2414 (not (magit-symbolic-ref-p string))))
2415
2416 (defun magit-branch-p (string)
2417 "Return t if STRING is a local or remote-tracking branch, nil otherwise.
2418 Signal an error if STRING is not a string."
2419 (cl-assert (stringp string))
2420 (or (magit-local-branch-p string)
2421 (magit-remote-branch-p string)))
2422
2423 (defun magit-local-branch-p (string)
2424 "Return t if STRING is a local branch.
2425 Signal an error if STRING is not a string."
2426 (cl-assert (stringp string))
2427 (magit-git-success "show-ref" "--quiet"
2428 (if (magit-git-version>= "2.46") "--branches" "--heads")
2429 string))
2430
2431 (defun magit-remote-branch-p (string)
2432 "Return t if STRING is a remote-tracking branch, nil otherwise.
2433 Signal an error if STRING is not a string."
2434 (cl-assert (stringp string))
2435 (seq-some (lambda (line)
2436 (let ((ref (cadr (split-string line " "))))
2437 (or (equal string ref)
2438 (equal string (substring ref 5))
2439 (equal string (substring ref 13)))))
2440 (magit-git-lines "show-ref" string)))
2441
2442 (defun magit-tag-p (string)
2443 "Return t if STRING is an annotated or lightweight tag, nil otherwise.
2444 Signal an error if STRING is not a string."
2445 (cl-assert (stringp string))
2446 (magit-git-success "show-ref" "--quiet" "--tags" string))
2447
2448 (defun magit-annotated-tag-p (string)
2449 "Return t if STRING is an annotated tag, nil otherwise.
2450 Signal an error if STRING is not a string."
2451 (cl-assert (stringp string))
2452 (equal (magit-object-type string) "tag"))
2453
2454 (defun magit-lightweight-tag-p (string)
2455 "Return t if STRING is a lightweight (un-annotated) tag, nil otherwise.
2456 Signal an error if STRING is not a string."
2457 (cl-assert (stringp string))
2458 (and (magit-tag-p string)
2459 (not (magit-annotated-tag-p string))))
2460
2461 (defun magit-remote-p (string)
2462 "Return t if STRING is a remote, nil otherwise.
2463 Signal an error if STRING is not a string."
2464 (cl-assert (stringp string))
2465 (and (member string (magit-list-remotes)) t))
2466
2467 (defun magit-branch-set-face (branch)
2468 (magit--propertize-face branch (if (magit-local-branch-p branch)
2469 'magit-branch-local
2470 'magit-branch-remote)))
2471
2472 (defvar magit-main-branch-names
2473 '("main" "master" "trunk" "development")
2474 "Branch names intended to be used for the primary branch.
2475 Use function `magit-main-branch' to get the name actually used in
2476 the current repository.")
2477
2478 (defvar magit-long-lived-branches
2479 (append magit-main-branch-names (list "maint" "next"))
2480 "Branch names intended to be used for long lived branches.")
2481
2482 (defun magit-main-branch (&optional remote)
2483 "Return the main branch.
2484
2485 If a branch exists whose name matches `init.defaultBranch', then
2486 that is considered the main branch. If no branch by that name
2487 exists, then the branch names in `magit-main-branch-names' are
2488 tried in order. The first branch from that list that actually
2489 exists in the current repository is considered its main branch.
2490
2491 If optional REMOTE is non-nil, return its default branch. If the
2492 symbolic ref \"refs/remotes/<REMOTE>/HEAD\" exists, return the branch
2493 it refers to, else use the same heuristic as when determining the
2494 local default."
2495 (or (and remote
2496 (magit-git-string "symbolic-ref" "--short"
2497 (format "refs/remotes/%s/HEAD" remote)))
2498 (let* ((branches (if remote
2499 (magit-list-remote-branch-names remote t)
2500 (magit-list-local-branch-names)))
2501 (branch (seq-find (##member % branches)
2502 (delete-dups
2503 (delq nil
2504 (cons (magit-get "init.defaultBranch")
2505 magit-main-branch-names))))))
2506 (if (and remote branch) (concat remote "/" branch) branch))))
2507
2508 (defun magit-rev-diff-count (a b &optional first-parent)
2509 "Return the commits in A but not B and vice versa.
2510 Return a list of two integers: (A>B B>A).
2511
2512 If `first-parent' is set, traverse only first parents."
2513 (mapcar #'string-to-number
2514 (split-string (magit-git-string "rev-list"
2515 "--count" "--left-right"
2516 (and first-parent "--first-parent")
2517 (concat a "..." b))
2518 "\t")))
2519
2520 (defun magit-abbrev-length ()
2521 (cond-let*
2522 ([abbrev (magit-get "core.abbrev")]
2523 [_(not (equal abbrev "auto"))]
2524 (string-to-number abbrev))
2525 ;; Guess the length git will be using based on an example
2526 ;; abbreviation. Actually HEAD's abbreviation might be an
2527 ;; outlier, so use the shorter of the abbreviations for two
2528 ;; commits. See #3034.
2529 ([head (magit-rev-parse "--short" "HEAD")]
2530 [head-len (length head)]
2531 (min head-len
2532 (if-let ((rev (magit-rev-parse "--short" "HEAD~")))
2533 (length rev)
2534 head-len)))
2535 ;; We're on an unborn branch, but perhaps the repository has
2536 ;; other commits. See #4123.
2537 ([commits (magit-git-lines "rev-list" "-n2" "--all" "--abbrev-commit")]
2538 (apply #'min (mapcar #'length commits)))
2539 ;; A commit does not exist. Fall back to the default of 7.
2540 (7)))
2541
2542 (defun magit-abbrev-arg (&optional arg)
2543 (format "--%s=%d" (or arg "abbrev") (magit-abbrev-length)))
2544
2545 (defun magit-rev-abbrev (rev)
2546 (magit-rev-parse (magit-abbrev-arg "short") rev))
2547
2548 (defun magit--abbrev-if-oid (obj)
2549 (cond ((member obj '("{index}" "{worktree}")) obj)
2550 ((magit-ref-p obj) obj)
2551 ((magit-rev-parse (magit-abbrev-arg "short") obj))
2552 (obj)))
2553
2554 (defun magit-commit-children (rev &optional args)
2555 (seq-keep (lambda (line)
2556 (pcase-let ((`(,child . ,parents) (split-string line " ")))
2557 (and (member rev parents) child)))
2558 (magit-git-lines "log" "--format=%H %P"
2559 (or args (list "--branches" "--tags" "--remotes"))
2560 "--not" rev)))
2561
2562 (defun magit-commit-parents (rev)
2563 (and$ (magit-git-string "rev-list" "-1" "--parents" rev)
2564 (cdr (split-string $))))
2565
2566 (defun magit-patch-id (rev)
2567 (with-connection-local-variables
2568 (magit--with-temp-process-buffer
2569 (magit-process-file
2570 shell-file-name nil '(t nil) nil shell-command-switch
2571 (let ((exec (shell-quote-argument (magit-git-executable))))
2572 (format "%s diff-tree -u %s | %s patch-id" exec rev exec)))
2573 (car (split-string (buffer-string))))))
2574
2575 (defun magit-rev-format (format &optional rev args)
2576 ;; Prefer "git log --no-walk" to "git show --no-patch" because it
2577 ;; performs better in some scenarios.
2578 (let ((str (magit-git-string "log" "--no-walk"
2579 (concat "--format=" format) args
2580 (if rev (magit--rev-dereference rev) "HEAD")
2581 "--")))
2582 (and (not (string-equal str ""))
2583 str)))
2584
2585 (defun magit-rev-insert-format (format &optional rev args)
2586 ;; Prefer "git log --no-walk" to "git show --no-patch" because it
2587 ;; performs better in some scenarios.
2588 (magit-git-insert "log" "--no-walk"
2589 (concat "--format=" format) args
2590 (if rev (magit--rev-dereference rev) "HEAD")
2591 "--"))
2592
2593 (defun magit-format-rev-summary (rev)
2594 (and-let ((str (magit-rev-format "%h %s" rev)))
2595 (progn
2596 (magit--put-face 0 (string-match " " str) 'magit-hash str)
2597 str)))
2598
2599 (defvar magit-ref-namespaces
2600 '(("\\`HEAD\\'" . magit-head)
2601 ("\\`refs/tags/\\(.+\\)" . magit-tag)
2602 ("\\`refs/heads/\\(.+\\)" . magit-branch-local)
2603 ("\\`refs/remotes/\\(.+\\)" . magit-branch-remote)
2604 ("\\`refs/bisect/\\(bad\\)" . magit-bisect-bad)
2605 ("\\`refs/bisect/\\(skip.*\\)" . magit-bisect-skip)
2606 ("\\`refs/bisect/\\(good.*\\)" . magit-bisect-good)
2607 ("\\`refs/stash$" . magit-refname-stash)
2608 ("\\`refs/wip/\\(.+\\)" . magit-refname-wip)
2609 ("\\`refs/pullreqs/\\(.+\\)" . magit-refname-pullreq)
2610 ("\\`\\(bad\\):" . magit-bisect-bad)
2611 ("\\`\\(skip\\):" . magit-bisect-skip)
2612 ("\\`\\(good\\):" . magit-bisect-good)
2613 ("\\`\\(.+\\)" . magit-refname))
2614 "How refs are formatted for display.
2615
2616 Each entry controls how a certain type of ref is displayed, and
2617 has the form (REGEXP . FACE). REGEXP is a regular expression
2618 used to match full refs. The first entry whose REGEXP matches
2619 the reference is used.
2620
2621 In log and revision buffers the first regexp submatch becomes the
2622 \"label\" that represents the ref and is propertized with FONT.
2623 In refs buffers the displayed text is controlled by other means
2624 and this option only controls what face is used.")
2625
2626 (defun magit-format-ref-labels (string)
2627 (save-match-data
2628 (let ((refs (split-string
2629 (replace-regexp-in-string "\\(tag: \\|HEAD -> \\)" "" string)
2630 ", " t))
2631 state head upstream tags branches remotes other combined)
2632 (dolist (ref refs)
2633 (let* ((face (cdr (seq-find (##string-match (car %) ref)
2634 magit-ref-namespaces)))
2635 (name (match-str 1 ref))
2636 (name (if (and name
2637 (not (string-prefix-p "refs/tags/" ref))
2638 (magit-rev-verify (concat "refs/tags/" name)))
2639 (magit-ref-abbrev ref)
2640 (or name ref)))
2641 (name (magit--propertize-face name face)))
2642 (cl-case face
2643 ((magit-bisect-bad magit-bisect-skip magit-bisect-good)
2644 (setq state name))
2645 (magit-head
2646 (setq head (magit--propertize-face "@" 'magit-head)))
2647 (magit-tag (push name tags))
2648 (magit-branch-local (push name branches))
2649 (magit-branch-remote (push name remotes))
2650 (t (push name other)))))
2651 (setq remotes
2652 (seq-keep
2653 (lambda (name)
2654 (if (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" name)
2655 (let ((r (match-str 1 name))
2656 (b (match-str 2 name)))
2657 (and (not (equal b "HEAD"))
2658 (if (equal (concat "refs/remotes/" name)
2659 (magit-git-string
2660 "symbolic-ref"
2661 (format "refs/remotes/%s/HEAD" r)))
2662 (magit--propertize-face
2663 name 'magit-branch-remote-head)
2664 name)))
2665 name))
2666 remotes))
2667 (let* ((current (magit-get-current-branch))
2668 (target (magit-get-upstream-branch current)))
2669 (dolist (name branches)
2670 (let ((push (car (member (magit-get-push-branch name) remotes))))
2671 (when push
2672 (setq remotes (delete push remotes))
2673 (string-match "^[^/]*/" push)
2674 (setq push (substring push 0 (match-end 0))))
2675 (cond
2676 ((equal name current)
2677 (setq head
2678 (concat push
2679 (magit--propertize-face
2680 name 'magit-branch-current))))
2681 ((equal name target)
2682 (setq upstream
2683 (concat push
2684 (magit--propertize-face
2685 name '(magit-branch-upstream
2686 magit-branch-local)))))
2687 ((push (concat push name) combined)))))
2688 (cond-let
2689 ((or upstream (not target)))
2690 ((member target remotes)
2691 (magit--add-face-text-property
2692 0 (length target) 'magit-branch-upstream nil target)
2693 (setq upstream target)
2694 (setq remotes (delete target remotes)))
2695 ([target (car (member target combined))]
2696 (magit--add-face-text-property
2697 0 (length target) 'magit-branch-upstream nil target)
2698 (setq upstream target)
2699 (setq combined (delete target combined)))))
2700 (string-join (flatten-tree `(,state
2701 ,head
2702 ,upstream
2703 ,@(nreverse tags)
2704 ,@(nreverse combined)
2705 ,@(nreverse remotes)
2706 ,@other))
2707 " "))))
2708
2709 (defun magit-object-type (object)
2710 (magit-git-string "cat-file" "-t" object))
2711
2712 (defmacro magit-with-blob (rev file &rest body)
2713 (declare (indent 2)
2714 (debug (form form body)))
2715 `(magit--with-temp-process-buffer
2716 (let ((buffer-file-name ,file))
2717 (save-excursion
2718 (magit-git-insert "cat-file" "-p"
2719 (concat ,rev ":" buffer-file-name)))
2720 (decode-coding-inserted-region
2721 (point-min) (point-max) buffer-file-name t nil nil t)
2722 ,@body)))
2723
2724 (defmacro magit-with-temp-index (tree arg &rest body)
2725 (declare (indent 2) (debug (form form body)))
2726 (let ((file (gensym "file")))
2727 `(let ((magit--refresh-cache nil)
2728 (,file (magit-convert-filename-for-git
2729 (make-temp-name
2730 (expand-file-name "index.magit." (magit-gitdir))))))
2731 (unwind-protect
2732 (magit-with-toplevel
2733 (when-let* ((tree ,tree)
2734 (_(not (magit-git-success
2735 "read-tree" ,arg tree
2736 (concat "--index-output=" ,file)))))
2737 (error "Cannot read tree %s" tree))
2738 (with-environment-variables (("GIT_INDEX_FILE" ,file))
2739 ,@body))
2740 (ignore-errors
2741 (delete-file (concat (file-remote-p default-directory) ,file)))))))
2742
2743 (defun magit-commit-tree (message &optional tree &rest parents)
2744 (magit-git-string "commit-tree" "--no-gpg-sign" "-m" message
2745 (mapcan (##list "-p" %) (delq nil parents))
2746 (or tree
2747 (magit-git-string "write-tree")
2748 (error "Cannot write tree"))))
2749
2750 (defun magit-commit-worktree (message &optional arg &rest other-parents)
2751 (magit-with-temp-index "HEAD" arg
2752 (and (magit-update-files (magit-unstaged-files))
2753 (apply #'magit-commit-tree message nil "HEAD" other-parents))))
2754
2755 (defun magit-update-files (files)
2756 (magit-git-success "update-index" "--add" "--remove" "--" files))
2757
2758 (defun magit-update-ref (ref message rev)
2759 (let ((magit--refresh-cache nil))
2760 (unless (zerop (magit-call-git "update-ref" "--create-reflog"
2761 "-m" message ref rev
2762 (or (magit-rev-verify ref) "")))
2763 (error "Cannot update %s with %s" ref rev))))
2764
2765 (defconst magit-range-re
2766 (concat "\\`\\([^ \t]*[^.]\\)?" ; revA
2767 "\\(\\.\\.\\.?\\)" ; range marker
2768 "\\([^.][^ \t]*\\)?\\'")) ; revB
2769
2770 (defun magit-split-range (range &optional abbrev)
2771 (pcase-let* ((`(,beg ,end ,sep) (magit--split-range-raw range))
2772 (beg (or beg "HEAD"))
2773 (end (or end "HEAD")))
2774 (when abbrev
2775 (setq beg (magit--abbrev-if-oid beg))
2776 (setq end (magit--abbrev-if-oid end)))
2777 (pcase sep
2778 (".." (cons beg end))
2779 ("..." (and$ (magit-merge-base beg end)
2780 (cons (if abbrev (magit-rev-abbrev $) $)
2781 end))))))
2782
2783 (defun magit--split-range-raw (range)
2784 (and (string-match magit-range-re range)
2785 (magit-bind-match-strings (beg sep end) range
2786 (and (or beg end)
2787 (list beg end sep)))))
2788
2789 (defun magit-hash-range (range)
2790 "Return a string with the revisions in RANGE replaced with commit oids.
2791 Either side of RANGE may be omitted, and RANGE may be just a revision.
2792 If either revision cannot be dereferenced as a commit, signal an error."
2793 (if (string-match magit-range-re range)
2794 (magit-bind-match-strings (beg sep end) range
2795 (and (or beg end)
2796 (let ((beg-oid (and beg (magit-commit-oid beg)))
2797 (end-oid (and end (magit-commit-oid end))))
2798 (and (or (not beg) beg-oid)
2799 (or (not end) end-oid)
2800 (concat beg-oid sep end-oid)))))
2801 (magit-commit-oid range)))
2802
2803 (defvar magit-revision-faces
2804 '(magit-hash
2805 magit-tag
2806 magit-branch-remote
2807 magit-branch-remote-head
2808 magit-branch-local
2809 magit-branch-current
2810 magit-branch-upstream
2811 magit-branch-warning
2812 magit-head
2813 magit-refname
2814 magit-refname-stash
2815 magit-refname-wip
2816 magit-refname-pullreq))
2817
2818 (put 'git-revision 'thing-at-point #'magit-thingatpt--git-revision)
2819 (defun magit-thingatpt--git-revision (&optional disallow)
2820 ;; Support hashes and references.
2821 (and-let* ((bounds
2822 (let ((c (concat "\s\n\t~^:?*[\\" disallow)))
2823 (cl-letf
2824 (((get 'git-revision 'beginning-op)
2825 (lambda ()
2826 (if (re-search-backward (format "[%s]" c) nil t)
2827 (forward-char)
2828 (goto-char (point-min)))))
2829 ((get 'git-revision 'end-op)
2830 (lambda ()
2831 (re-search-forward (format "\\=[^%s]*" c) nil t))))
2832 (bounds-of-thing-at-point 'git-revision))))
2833 (string (buffer-substring-no-properties (car bounds) (cdr bounds)))
2834 ;; References are allowed to contain most parentheses and
2835 ;; most punctuation, but if those characters appear at the
2836 ;; edges of a possible reference in arbitrary text, then
2837 ;; they are much more likely to be intended as just that:
2838 ;; punctuation and delimiters.
2839 (string (thread-first string
2840 (string-trim-left "[(</]")
2841 (string-trim-right "[])>/.,;!]"))))
2842 (let (disallow)
2843 (when (or (string-match-p "\\.\\." string)
2844 (string-match-p "/\\." string))
2845 (setq disallow (concat disallow ".")))
2846 (when (string-match-p "@{" string)
2847 (setq disallow (concat disallow "@{")))
2848 (if disallow
2849 ;; These additional restrictions overcompensate,
2850 ;; but that only matters in rare cases.
2851 (magit-thingatpt--git-revision disallow)
2852 (and (not (equal string "@"))
2853 (or (and (>= (length string) 7)
2854 (string-match-p "[a-z]" string)
2855 (magit-commit-oid string t))
2856 (and (magit-ref-p string)
2857 (member (get-text-property (point) 'face)
2858 magit-revision-faces)))
2859 string)))))
2860
2861 (put 'git-revision-range 'thing-at-point #'magit-thingatpt--git-revision-range)
2862 (defun magit-thingatpt--git-revision-range ()
2863 ;; Support hashes but no references.
2864 (and-let* ((bounds
2865 (cl-letf (((get 'git-revision 'beginning-op)
2866 (lambda ()
2867 (if (re-search-backward "[^a-z0-9.]" nil t)
2868 (forward-char)
2869 (goto-char (point-min)))))
2870 ((get 'git-revision 'end-op)
2871 (lambda ()
2872 (and (re-search-forward "[^a-z0-9.]" nil t)
2873 (backward-char)))))
2874 (bounds-of-thing-at-point 'git-revision)))
2875 (range (buffer-substring-no-properties (car bounds) (cdr bounds))))
2876 ;; Validate but return as-is.
2877 (and (magit-hash-range range) range)))
2878
2879 ;;; Completion
2880
2881 (defvar magit-revision-history nil)
2882
2883 (defun magit--minibuf-default-add-commit ()
2884 (let ((fn minibuffer-default-add-function))
2885 (setq-local
2886 minibuffer-default-add-function
2887 (lambda ()
2888 (let ((rest (and (functionp fn) (funcall fn))))
2889 (if-let ((commit (with-selected-window (minibuffer-selected-window)
2890 (or (magit-thing-at-point 'git-revision-range t)
2891 (magit-commit-at-point)))))
2892 (let ((rest (cons commit (delete commit rest)))
2893 (def minibuffer-default))
2894 (if (listp def)
2895 (append def rest)
2896 (cons def (delete def rest))))
2897 rest))))))
2898
2899 (defun magit-read-branch (prompt &optional secondary-default)
2900 (magit-completing-read prompt (magit-list-branch-names)
2901 nil t nil 'magit-revision-history
2902 (or (magit-branch-at-point)
2903 secondary-default
2904 (magit-get-current-branch))))
2905
2906 (defun magit-read-branch-or-commit (prompt &optional secondary-default exclude)
2907 (let* ((current (magit-get-current-branch))
2908 (branch-at-point (magit-branch-at-point))
2909 (commit-at-point (magit-commit-at-point))
2910 (exclude (ensure-list exclude))
2911 (choices (cl-set-difference (magit-list-refnames nil t)
2912 exclude :test #'equal)))
2913 (when (member current exclude)
2914 (setq current nil))
2915 (when (member branch-at-point exclude)
2916 (setq branch-at-point nil))
2917 (when (and commit-at-point (not branch-at-point))
2918 (setq choices (cons commit-at-point choices)))
2919 (minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
2920 (magit-completing-read
2921 prompt choices nil 'any nil 'magit-revision-history
2922 (or branch-at-point commit-at-point secondary-default current)))))
2923
2924 (defun magit-read-range-or-commit (prompt &optional secondary-default)
2925 (magit-read-range
2926 prompt
2927 (or (and-let ((revs (magit-region-values '(commit branch) t)))
2928 (prog1 (concat (car (last revs)) ".." (car revs))
2929 (deactivate-mark)))
2930 (magit-branch-or-commit-at-point)
2931 secondary-default
2932 (magit-get-current-branch))))
2933
2934 (defun magit-read-range (prompt &optional default)
2935 (minibuffer-with-setup-hook
2936 (lambda ()
2937 (magit--minibuf-default-add-commit)
2938 (setq-local crm-separator "\\.\\.\\.?"))
2939 (let ((crm-prompt "%p"))
2940 (magit-completing-read-multiple
2941 (concat prompt ": ")
2942 (magit-list-refnames)
2943 nil 'any nil 'magit-revision-history default nil t))))
2944
2945 (defun magit-read-remote-branch
2946 (prompt &optional remote default local-branch require-match)
2947 (let ((choice (magit-completing-read
2948 prompt
2949 (cl-union (and local-branch
2950 (if remote
2951 (list local-branch)
2952 (mapcar (##concat % "/" local-branch)
2953 (magit-list-remotes))))
2954 (magit-list-remote-branch-names remote t)
2955 :test #'equal)
2956 nil (or require-match 'any)
2957 nil 'magit-revision-history default)))
2958 (if (or remote (string-match "\\`\\([^/]+\\)/\\(.+\\)" choice))
2959 choice
2960 (user-error "`%s' doesn't have the form REMOTE/BRANCH" choice))))
2961
2962 (defun magit-read-refspec (prompt remote)
2963 (magit-completing-read prompt
2964 (prog2 (message "Determining available refs...")
2965 (magit-remote-list-refs remote)
2966 (message "Determining available refs...done"))
2967 nil 'any))
2968
2969 (defun magit-read-local-branch (prompt &optional secondary-default)
2970 (magit-completing-read prompt (magit-list-local-branch-names)
2971 nil t nil 'magit-revision-history
2972 (or (magit-local-branch-at-point)
2973 secondary-default
2974 (magit-get-current-branch))))
2975
2976 (defun magit-read-local-branch-or-commit (prompt)
2977 (let ((choices (nconc (magit-list-local-branch-names)
2978 (magit-list-special-refnames)))
2979 (commit (magit-commit-at-point)))
2980 (when commit
2981 (push commit choices))
2982 (minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
2983 (magit-completing-read prompt choices
2984 nil 'any nil 'magit-revision-history
2985 (or (magit-local-branch-at-point) commit)))))
2986
2987 (defun magit-read-local-branch-or-ref (prompt &optional secondary-default)
2988 (magit-completing-read prompt (nconc (magit-list-local-branch-names)
2989 (magit-list-refs "refs/"))
2990 nil t nil 'magit-revision-history
2991 (or (magit-local-branch-at-point)
2992 secondary-default
2993 (magit-get-current-branch))))
2994
2995 (defun magit-read-other-branch
2996 (prompt &optional exclude secondary-default)
2997 (let* ((current (magit-get-current-branch))
2998 (atpoint (magit-branch-at-point))
2999 (exclude (or exclude current))
3000 (default (or (and (not (equal atpoint exclude)) atpoint)
3001 (and (not (equal current exclude)) current)
3002 secondary-default
3003 (magit-get-previous-branch))))
3004 (magit-completing-read prompt (delete exclude (magit-list-branch-names))
3005 nil t nil 'magit-revision-history default)))
3006
3007 (defun magit-read-other-branch-or-commit
3008 (prompt &optional exclude secondary-default)
3009 (let* ((current (magit-get-current-branch))
3010 (atpoint (magit-branch-or-commit-at-point))
3011 (exclude (or exclude current))
3012 (default (or (and (not (equal atpoint exclude))
3013 (not (and (not current)
3014 (magit-rev-equal atpoint "HEAD")))
3015 atpoint)
3016 (and (not (equal current exclude)) current)
3017 secondary-default
3018 (magit-get-previous-branch))))
3019 (minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
3020 (magit-completing-read prompt (delete exclude (magit-list-refnames))
3021 nil 'any nil 'magit-revision-history default))))
3022
3023 (defun magit-read-other-branches-or-commits
3024 (prompt &optional exclude secondary-default)
3025 (let* ((current (magit-get-current-branch))
3026 (atpoint (magit-branch-or-commit-at-point))
3027 (exclude (or exclude current))
3028 (default (or (and (not (equal atpoint exclude))
3029 (not (and (not current)
3030 (magit-rev-equal atpoint "HEAD")))
3031 atpoint)
3032 (and (not (equal current exclude)) current)
3033 secondary-default
3034 (magit-get-previous-branch))))
3035 (minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
3036 (magit-completing-read-multiple
3037 prompt (delete exclude (magit-list-refnames))
3038 nil 'any nil 'magit-revision-history default))))
3039
3040 (defun magit-read-other-local-branch
3041 (prompt &optional exclude secondary-default)
3042 (let* ((current (magit-get-current-branch))
3043 (atpoint (magit-local-branch-at-point))
3044 (exclude (or exclude current))
3045 (default (or (and (not (equal atpoint exclude)) atpoint)
3046 (and (not (equal current exclude)) current)
3047 secondary-default
3048 (magit-get-previous-branch))))
3049 (magit-completing-read prompt
3050 (delete exclude (magit-list-local-branch-names))
3051 nil t nil 'magit-revision-history default)))
3052
3053 (defun magit-read-branch-prefer-other (prompt)
3054 (let* ((current (magit-get-current-branch))
3055 (commit (magit-commit-at-point))
3056 (atrev (and commit (magit-list-branches-pointing-at commit)))
3057 (atpoint (magit--painted-branch-at-point)))
3058 (magit-completing-read prompt (magit-list-branch-names)
3059 nil t nil 'magit-revision-history
3060 (or (magit-section-value-if 'branch)
3061 atpoint
3062 (and (not (cdr atrev)) (car atrev))
3063 (seq-find (##not (equal % current)) atrev)
3064 (magit-get-previous-branch)
3065 (car atrev)))))
3066
3067 (defun magit-read-upstream-branch (&optional branch prompt)
3068 "Read the upstream for BRANCH using PROMPT.
3069 If optional BRANCH is nil, then read the upstream for the
3070 current branch, or raise an error if no branch is checked
3071 out. Only existing branches can be selected."
3072 (unless branch
3073 (setq branch (or (magit-get-current-branch)
3074 (error "Need a branch to set its upstream"))))
3075 (let ((branches (delete branch (magit-list-branch-names))))
3076 (magit-completing-read
3077 (or prompt (format "Change upstream of %s to" branch))
3078 branches nil t nil 'magit-revision-history
3079 (or (let ((r (car (member (magit-remote-branch-at-point) branches)))
3080 (l (car (member (magit-local-branch-at-point) branches))))
3081 (if magit-prefer-remote-upstream (or r l) (or l r)))
3082 (and-let ((main (magit-main-branch)))
3083 (let ((r (car (member (concat "origin/" main) branches)))
3084 (l (car (member main branches))))
3085 (if magit-prefer-remote-upstream (or r l) (or l r))))
3086 (car (member (magit-get-previous-branch) branches))))))
3087
3088 (defun magit-read-starting-point (prompt &optional branch default)
3089 (or (minibuffer-with-setup-hook #'magit--minibuf-default-add-commit
3090 (magit-completing-read
3091 (concat prompt
3092 (and branch
3093 (if (bound-and-true-p ivy-mode)
3094 ;; Ivy-mode strips faces from prompt.
3095 (format " `%s'" branch)
3096 (concat " " (magit--propertize-face
3097 branch 'magit-branch-local))))
3098 " starting at")
3099 (let ((refnames (magit-list-refnames)))
3100 (when-let ((upstream (magit-get-upstream-branch)))
3101 (setq refnames (cons upstream (delete upstream refnames))))
3102 (nconc refnames
3103 (list "HEAD")
3104 (directory-files (magit-gitdir) nil "_HEAD\\'")))
3105 nil 'any nil 'magit-revision-history
3106 (or default (magit--default-starting-point))))
3107 (user-error "Nothing selected")))
3108
3109 (defun magit--default-starting-point ()
3110 (or (let ((r (magit-remote-branch-at-point))
3111 (l (magit-local-branch-at-point)))
3112 (if magit-prefer-remote-upstream (or r l) (or l r)))
3113 (magit-commit-at-point)
3114 (magit-stash-at-point)
3115 (magit-get-current-branch)))
3116
3117 (defun magit-read-tag (prompt)
3118 (magit-completing-read prompt (magit-list-tags) nil t nil
3119 'magit-revision-history
3120 (magit-tag-at-point)))
3121
3122 (defun magit-read-stash (prompt)
3123 (let* ((atpoint (magit-stash-at-point))
3124 (default (and atpoint
3125 (concat atpoint (magit-rev-format " %s" atpoint))))
3126 (choices (mapcar (lambda (c)
3127 (pcase-let ((`(,rev ,msg) (split-string c "\0")))
3128 (concat (propertize rev 'face 'magit-hash)
3129 " " msg)))
3130 (magit-list-stashes "%gd%x00%s")))
3131 (choice (magit-completing-read prompt choices
3132 nil t nil nil
3133 default
3134 (car choices))))
3135 (and choice
3136 (string-match "^\\([^ ]+\\) \\(.+\\)" choice)
3137 (substring-no-properties (match-str 1 choice)))))
3138
3139 (defun magit-read-shelved-branch (prompt)
3140 (magit-completing-read
3141 prompt
3142 (mapcar (##substring % 8)
3143 (nreverse (magit-list-refnames "refs/shelved")))
3144 nil t nil nil
3145 (and$ (magit-section-value-if 'shelved-branch)
3146 (substring $ 13))))
3147
3148 (defun magit-read-remote (prompt &optional default use-only)
3149 (let ((remotes (magit-list-remotes)))
3150 (if (and use-only (length= remotes 1))
3151 (car remotes)
3152 (magit-completing-read prompt remotes
3153 nil t nil nil
3154 (or default
3155 (magit-remote-at-point)
3156 (magit-get-remote))))))
3157
3158 (defun magit-read-remote-or-url (prompt &optional default)
3159 (magit-completing-read prompt
3160 (nconc (magit-list-remotes)
3161 (list "https://" "git://" "git@"))
3162 nil 'any nil nil
3163 (or default
3164 (magit-remote-at-point)
3165 (magit-get-remote))))
3166
3167 (defun magit-read-module-path (prompt &optional predicate)
3168 ;; Predicates are evaluate with the minibuffer as the current buffer.
3169 ;; Unlike for other completion frameworks, Helm does not ensure that
3170 ;; the value of `default-directory' in that buffer is the same as in
3171 ;; the buffer from which completion was invoked.
3172 (magit-completing-read prompt (magit-list-module-paths)
3173 (and predicate
3174 (let ((dir default-directory))
3175 (lambda (module)
3176 (let ((default-directory dir))
3177 (funcall predicate module)))))
3178 t nil nil
3179 (magit-module-at-point predicate)))
3180
3181 (defun magit-module-confirm (verb &optional predicate)
3182 ;; Some predicates use the inefficient `magit-toplevel'
3183 ;; and some repositories have thousands of submodules.
3184 (let ((magit--refresh-cache (list (cons 0 0)))
3185 (modules nil))
3186 (cond (current-prefix-arg
3187 (setq modules (magit-list-module-paths))
3188 (when predicate
3189 (setq modules (seq-filter predicate modules)))
3190 (unless modules
3191 (if predicate
3192 (user-error "No modules satisfying %s available" predicate)
3193 (user-error "No modules available"))))
3194 (t
3195 (setq modules (magit-region-values 'module))
3196 (when modules
3197 (when predicate
3198 (setq modules (seq-filter predicate modules)))
3199 (unless modules
3200 (user-error "No modules satisfying %s selected" predicate)))))
3201 (if (or (length> modules 1) current-prefix-arg)
3202 (magit-confirm t nil (format "%s %%d modules" verb) nil modules)
3203 (list (magit-read-module-path (format "%s module" verb) predicate)))))
3204
3205 ;;; Git Hooks
3206
3207 (defun magit-run-git-hook (hook &rest args)
3208 "Run the Lisp HOOK with the specified arguments ARGS.
3209
3210 ARGS are the arguments (a possibly empty list of strings), which
3211 the Git hook was called with. HOOK is a string naming a hook.
3212
3213 This function is only intended to be called via \"emacsclient\", by
3214 an executable by the same name, which in turn is only intended to
3215 be called by Git hooks."
3216 (setq hook (intern hook))
3217 (when (and (boundp hook)
3218 (symbol-value hook))
3219 (magit--client-message "Running %s..." hook)
3220 (advice-add 'message :override #'magit--client-message)
3221 (unwind-protect (apply #'run-hook-with-args hook args)
3222 (advice-remove 'message #'magit--client-message))
3223 (magit--client-message "Running %s...done" hook))
3224 '---) ; Emacsclient insists on printing the value.
3225
3226 (defun magit--client-message (format-string &rest args)
3227 ;; See `server-process-filter'.
3228 (let ((msg (format "-print %s\n"
3229 (server-quote-arg
3230 (apply #'format-message format-string args)))))
3231 (dolist (client server-clients)
3232 (server-send-string client msg))))
3233
3234 ;;; _
3235
3236 (define-obsolete-function-alias 'magit-git-string-p
3237 #'magit-git-string "Magit 4.6.0")
3238
3239 (define-obsolete-function-alias 'magit-rev-verify-commit
3240 #'magit-commit-p "Magit 4.6.0")
3241
3242 (define-obsolete-function-alias 'magit-rev-hash
3243 #'magit-commit-p "Magit 4.6.0"
3244 "Return oid for REV if it names an existing commit, nil otherwise.
3245 Instead use `magit-commit-p' or `magit-commit-oid'.")
3246
3247 (define-obsolete-function-alias 'magit--abbrev-if-hash
3248 #'magit--abbrev-if-oid "Magit 4.6.0")
3249
3250 (provide 'magit-git)
3251 ;; Local Variables:
3252 ;; read-symbol-shorthands: (
3253 ;; ("and$" . "cond-let--and$")
3254 ;; ("thread$" . "cond-let--thread$")
3255 ;; ("when$" . "cond-let--when$")
3256 ;; ("and-let*" . "cond-let--and-let*")
3257 ;; ("and-let" . "cond-let--and-let")
3258 ;; ("if-let*" . "cond-let--if-let*")
3259 ;; ("if-let" . "cond-let--if-let")
3260 ;; ("when-let*" . "cond-let--when-let*")
3261 ;; ("when-let" . "cond-let--when-let")
3262 ;; ("while-let*" . "cond-let--while-let*")
3263 ;; ("while-let" . "cond-let--while-let")
3264 ;; ("match-string" . "match-string")
3265 ;; ("match-str" . "match-string-no-properties"))
3266 ;; End:
3267 ;;; magit-git.el ends here