config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

magit-process.el (54879B)


      1 ;;; magit-process.el --- Process functionality  -*- lexical-binding:t -*-
      2 
      3 ;; Copyright (C) 2008-2024 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 the tools used to run Git for side-effects.
     26 
     27 ;; Note that the functions used to run Git and then consume its
     28 ;; output, are defined in `magit-git.el'.  There's a bit of overlap
     29 ;; though.
     30 
     31 ;;; Code:
     32 
     33 (require 'magit-base)
     34 (require 'magit-git)
     35 (require 'magit-mode)
     36 
     37 (require 'ansi-color)
     38 (require 'auth-source)
     39 (require 'with-editor)
     40 
     41 (defvar y-or-n-p-map)
     42 
     43 ;;; Options
     44 
     45 (defcustom magit-process-connection-type (not (eq system-type 'cygwin))
     46   "Connection type used for the Git process.
     47 
     48 If nil, use pipes: this is usually more efficient, and works on Cygwin.
     49 If t, use ptys: this enables Magit to prompt for passphrases when needed."
     50   :group 'magit-process
     51   :type '(choice (const :tag "pipe" nil)
     52                  (const :tag "pty" t)))
     53 
     54 (defcustom magit-need-cygwin-noglob
     55   (and (eq system-type 'windows-nt)
     56        (with-temp-buffer
     57          (let ((process-environment
     58                 (append magit-git-environment process-environment)))
     59            (condition-case e
     60                (process-file magit-git-executable
     61                              nil (current-buffer) nil
     62                              "-c" "alias.echo=!echo" "echo" "x{0}")
     63              (file-error
     64               (lwarn 'magit-process :warning
     65                      "Could not run Git: %S" e))))
     66          (equal "x0\n" (buffer-string))))
     67   "Whether to use a workaround for Cygwin's globbing behavior.
     68 
     69 If non-nil, add environment variables to `process-environment' to
     70 prevent the git.exe distributed by Cygwin and MSYS2 from
     71 attempting to perform glob expansion when called from a native
     72 Windows build of Emacs.  See #2246."
     73   :package-version '(magit . "2.3.0")
     74   :group 'magit-process
     75   :type '(choice (const :tag "Yes" t)
     76                  (const :tag "No" nil)))
     77 
     78 (defcustom magit-process-popup-time -1
     79   "Popup the process buffer if a command takes longer than this many seconds."
     80   :group 'magit-process
     81   :type '(choice (const :tag "Never" -1)
     82                  (const :tag "Immediately" 0)
     83                  (integer :tag "After this many seconds")))
     84 
     85 (defcustom magit-process-log-max 32
     86   "Maximum number of sections to keep in a process log buffer.
     87 When adding a new section would go beyond the limit set here,
     88 then the older half of the sections are remove.  Sections that
     89 belong to processes that are still running are never removed.
     90 When this is nil, no sections are ever removed."
     91   :package-version '(magit . "2.1.0")
     92   :group 'magit-process
     93   :type '(choice (const :tag "Never remove old sections" nil) integer))
     94 
     95 (defvar magit-process-extreme-logging nil
     96   "Whether `magit-process-file' logs to the *Messages* buffer.
     97 
     98 Only intended for temporary use when you try to figure out how
     99 Magit uses Git behind the scene.  Output that normally goes to
    100 the magit-process buffer continues to go there.  Not all output
    101 goes to either of these two buffers.
    102 
    103 Also see `magit-git-debug'.")
    104 
    105 (defcustom magit-process-error-tooltip-max-lines 20
    106   "The number of lines for `magit-process-error-lines' to return.
    107 
    108 These are displayed in a tooltip for `mode-line-process' errors.
    109 
    110 If `magit-process-error-tooltip-max-lines' is nil, the tooltip
    111 displays the text of `magit-process-error-summary' instead."
    112   :package-version '(magit . "2.12.0")
    113   :group 'magit-process
    114   :type '(choice (const :tag "Use summary line" nil)
    115                  integer))
    116 
    117 (defcustom magit-credential-cache-daemon-socket
    118   (--some (pcase-let ((`(,prog . ,args) (split-string it)))
    119             (if (and prog
    120                      (string-match-p
    121                       "\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog))
    122                 (or (cl-loop for (opt val) on args
    123                              if (string= opt "--socket")
    124                              return val)
    125                     (expand-file-name "~/.git-credential-cache/socket"))))
    126           ;; Note: `magit-process-file' is not yet defined when
    127           ;; evaluating this form, so we use `process-lines'.
    128           (ignore-errors
    129             (let ((process-environment
    130                    (append magit-git-environment process-environment)))
    131               (process-lines magit-git-executable
    132                              "config" "--get-all" "credential.helper"))))
    133   "If non-nil, start a credential cache daemon using this socket.
    134 
    135 When using Git's cache credential helper in the normal way, Emacs
    136 sends a SIGHUP to the credential daemon after the git subprocess
    137 has exited, causing the daemon to also quit.  This can be avoided
    138 by starting the `git-credential-cache--daemon' process directly
    139 from Emacs.
    140 
    141 The function `magit-maybe-start-credential-cache-daemon' takes
    142 care of starting the daemon if necessary, using the value of this
    143 option as the socket.  If this option is nil, then it does not
    144 start any daemon.  Likewise if another daemon is already running,
    145 then it starts no new daemon.  This function has to be a member
    146 of the hook variable `magit-credential-hook' for this to work.
    147 If an error occurs while starting the daemon, most likely because
    148 the necessary executable is missing, then the function removes
    149 itself from the hook, to avoid further futile attempts."
    150   :package-version '(magit . "2.3.0")
    151   :group 'magit-process
    152   :type '(choice (file  :tag "Socket")
    153                  (const :tag "Don't start a cache daemon" nil)))
    154 
    155 (defcustom magit-process-yes-or-no-prompt-regexp
    156   (concat " [([]"
    157           "\\([Yy]\\(?:es\\)?\\)"
    158           "[/|]"
    159           "\\([Nn]o?\\)"
    160           ;; OpenSSH v8 prints this.  See #3969.
    161           "\\(?:/\\[fingerprint\\]\\)?"
    162           "[])] ?[?:]? ?$")
    163   "Regexp matching Yes-or-No prompts of Git and its subprocesses."
    164   :package-version '(magit . "2.1.0")
    165   :group 'magit-process
    166   :type 'regexp)
    167 
    168 (defcustom magit-process-password-prompt-regexps
    169   '("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$"
    170     ;; Match-group 99 is used to identify the "user@host" part.
    171     "^\\(Enter \\|([^) ]+) \\)?\
    172 [Pp]assword\\( for '?\\(https?://\\)?\\(?99:[^']*\\)'?\\)?: ?$"
    173     "Please enter the passphrase for the ssh key"
    174     "Please enter the passphrase to unlock the OpenPGP secret key"
    175     "^.*'s password: ?$"
    176     "^Token: $" ; For git-credential-manager-core (#4318).
    177     "^Yubikey for .*: ?$"
    178     "^Enter PIN for .*: ?$")
    179   "List of regexps matching password prompts of Git and its subprocesses.
    180 Also see `magit-process-find-password-functions'."
    181   :package-version '(magit . "3.0.0")
    182   :group 'magit-process
    183   :type '(repeat (regexp)))
    184 
    185 (defcustom magit-process-find-password-functions nil
    186   "List of functions to try in sequence to get a password.
    187 
    188 These functions may be called when git asks for a password, which
    189 is detected using `magit-process-password-prompt-regexps'.  They
    190 are called if and only if matching the prompt resulted in the
    191 value of the 99th submatch to be non-nil.  Therefore users can
    192 control for which prompts these functions should be called by
    193 putting the host name in the 99th submatch, or not.
    194 
    195 If the functions are called, then they are called in the order
    196 given, with the host name as only argument, until one of them
    197 returns non-nil.  If they are not called or none of them returns
    198 non-nil, then the password is read from the user instead."
    199   :package-version '(magit . "2.3.0")
    200   :group 'magit-process
    201   :type 'hook
    202   :options '(magit-process-password-auth-source))
    203 
    204 (defcustom magit-process-username-prompt-regexps
    205   '("^Username for '.*': ?$")
    206   "List of regexps matching username prompts of Git and its subprocesses."
    207   :package-version '(magit . "2.1.0")
    208   :group 'magit-process
    209   :type '(repeat (regexp)))
    210 
    211 (defcustom magit-process-prompt-functions nil
    212   "List of functions used to forward arbitrary questions to the user.
    213 
    214 Magit has dedicated support for forwarding username and password
    215 prompts and Yes-or-No questions asked by Git and its subprocesses
    216 to the user.  This can be customized using other options in the
    217 `magit-process' customization group.
    218 
    219 If you encounter a new question that isn't handled by default,
    220 then those options should be used instead of this hook.
    221 
    222 However subprocesses may also ask questions that differ too much
    223 from what the code related to the above options assume, and this
    224 hook allows users to deal with such questions explicitly.
    225 
    226 Each function is called with the process and the output string
    227 as arguments until one of the functions returns non-nil.  The
    228 function is responsible for asking the user the appropriate
    229 question using, e.g., `read-char-choice' and then forwarding the
    230 answer to the process using `process-send-string'.
    231 
    232 While functions such as `magit-process-yes-or-no-prompt' may not
    233 be sufficient to handle some prompt, it may still be of benefit
    234 to look at the implementations to gain some insights on how to
    235 implement such functions."
    236   :package-version '(magit . "3.0.0")
    237   :group 'magit-process
    238   :type 'hook)
    239 
    240 (defcustom magit-process-ensure-unix-line-ending t
    241   "Whether Magit should ensure a unix coding system when talking to Git."
    242   :package-version '(magit . "2.6.0")
    243   :group 'magit-process
    244   :type 'boolean)
    245 
    246 (defcustom magit-process-display-mode-line-error t
    247   "Whether Magit should retain and highlight process errors in the mode line."
    248   :package-version '(magit . "2.12.0")
    249   :group 'magit-process
    250   :type 'boolean)
    251 
    252 (defcustom magit-process-timestamp-format nil
    253   "Format of timestamp for each process in the process buffer.
    254 If non-nil, pass this to `format-time-string' when creating a
    255 process section in the process buffer, and insert the returned
    256 string in the heading of its section."
    257   :package-version '(magit . "4.0.0")
    258   :group 'magit-process
    259   :type '(choice (const :tag "none" nil) string))
    260 
    261 (defvar tramp-pipe-stty-settings)
    262 (defvar magit-tramp-pipe-stty-settings ""
    263   "Override `tramp-pipe-stty-settings' in `magit-start-process'.
    264 
    265 The default for that Tramp variable is \"-icanon min 1 time 0\",
    266 which causes staging of individual hunks to hang.  Using \"\"
    267 prevents that, but apparently has other issues, which is why it
    268 isn't the default.
    269 
    270 This variable defaults to \"\" and is used to override the Tramp
    271 variable in `magit-start-process'.  This only has an effect when
    272 using Tramp 2.6.2 or greater.  This can also be set to `pty', in
    273 which case a pty is used instead of a pipe.  That also prevents
    274 the hanging, but doesn't work for files with DOS line endings
    275 \(see #20).
    276 
    277 For connections that have `tramp-direct-async-process' enabled,
    278 staging hunks hangs, unless this variable is set to `pty' (see
    279 #5220).
    280 
    281 To fall back to the value of `tramp-pipe-stty-settings', set this
    282 variable to nil.
    283 
    284 Also see https://github.com/magit/magit/issues/4720
    285 and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62093.")
    286 
    287 (defface magit-process-ok
    288   '((t :inherit magit-section-heading :foreground "green"))
    289   "Face for zero exit-status."
    290   :group 'magit-faces)
    291 
    292 (defface magit-process-ng
    293   '((t :inherit magit-section-heading :foreground "red"))
    294   "Face for non-zero exit-status."
    295   :group 'magit-faces)
    296 
    297 (defface magit-mode-line-process
    298   '((t :inherit mode-line-emphasis))
    299   "Face for `mode-line-process' status when Git is running for side-effects."
    300   :group 'magit-faces)
    301 
    302 (defface magit-mode-line-process-error
    303   '((t :inherit error))
    304   "Face for `mode-line-process' error status.
    305 
    306 Used when `magit-process-display-mode-line-error' is non-nil."
    307   :group 'magit-faces)
    308 
    309 ;;; Process Mode
    310 
    311 (defvar-keymap magit-process-mode-map
    312   :doc "Keymap for `magit-process-mode'."
    313   :parent magit-mode-map
    314   "<remap> <magit-refresh>"      #'undefined
    315   "<remap> <magit-delete-thing>" #'magit-process-kill)
    316 
    317 (define-derived-mode magit-process-mode magit-mode "Magit Process"
    318   "Mode for looking at Git process output."
    319   :interactive nil
    320   :group 'magit-process
    321   (magit-hack-dir-local-variables)
    322   (setq magit--imenu-item-types 'process))
    323 
    324 (defun magit-process-buffer (&optional nodisplay)
    325   "Display the current repository's process buffer.
    326 
    327 If that buffer doesn't exist yet, then create it.
    328 Non-interactively return the buffer and unless
    329 optional NODISPLAY is non-nil also display it."
    330   (interactive)
    331   (let ((topdir (magit-toplevel)))
    332     (unless topdir
    333       (magit--with-safe-default-directory nil
    334         (setq topdir default-directory)
    335         (let (prev)
    336           (while (not (equal topdir prev))
    337             (setq prev topdir)
    338             (setq topdir (file-name-directory (directory-file-name topdir)))))))
    339     (let ((buffer (or (--first (with-current-buffer it
    340                                  (and (eq major-mode 'magit-process-mode)
    341                                       (equal default-directory topdir)))
    342                                (buffer-list))
    343                       (magit-generate-new-buffer 'magit-process-mode
    344                                                  nil topdir))))
    345       (with-current-buffer buffer
    346         (if magit-root-section
    347             (when magit-process-log-max
    348               (magit-process-truncate-log))
    349           (magit-process-mode)
    350           (let ((inhibit-read-only t)
    351                 (magit-insert-section--parent  nil)
    352                 (magit-insert-section--oldroot nil))
    353             (make-local-variable 'text-property-default-nonsticky)
    354             (magit-insert-section (processbuf)
    355               (insert "\n")))))
    356       (unless nodisplay
    357         (magit-display-buffer buffer))
    358       buffer)))
    359 
    360 (defun magit-process-kill ()
    361   "Kill the process at point."
    362   (interactive)
    363   (when-let ((process (magit-section-value-if 'process)))
    364     (unless (eq (process-status process) 'run)
    365       (user-error "Process isn't running"))
    366     (magit-confirm 'kill-process)
    367     (kill-process process)))
    368 
    369 ;;; Synchronous Processes
    370 
    371 (defvar magit-process-raise-error nil)
    372 
    373 (defun magit-git (&rest args)
    374   "Call Git synchronously in a separate process, for side-effects.
    375 
    376 Option `magit-git-executable' specifies the Git executable.
    377 The arguments ARGS specify arguments to Git, they are flattened
    378 before use.
    379 
    380 Process output goes into a new section in the buffer returned by
    381 `magit-process-buffer'.  If Git exits with a non-zero status,
    382 then raise an error."
    383   (let ((magit-process-raise-error t))
    384     (magit-call-git args)))
    385 
    386 (defun magit-run-git (&rest args)
    387   "Call Git synchronously in a separate process, and refresh.
    388 
    389 Function `magit-git-executable' specifies the Git executable and
    390 option `magit-git-global-arguments' specifies constant arguments.
    391 The arguments ARGS specify arguments to Git, they are flattened
    392 before use.
    393 
    394 After Git returns, the current buffer (if it is a Magit buffer)
    395 as well as the current repository's status buffer are refreshed.
    396 
    397 Process output goes into a new section in the buffer returned by
    398 `magit-process-buffer'."
    399   (let ((magit--refresh-cache (list (cons 0 0))))
    400     (prog1 (magit-call-git args)
    401       (when (member (car args) '("init" "clone"))
    402         ;; Creating a new repository invalidates the cache.
    403         (setq magit--refresh-cache nil))
    404       (magit-refresh))))
    405 
    406 (defvar magit-pre-call-git-hook nil)
    407 
    408 (defun magit-call-git (&rest args)
    409   "Call Git synchronously in a separate process.
    410 
    411 Function `magit-git-executable' specifies the Git executable and
    412 option `magit-git-global-arguments' specifies constant arguments.
    413 The arguments ARGS specify arguments to Git, they are flattened
    414 before use.
    415 
    416 Process output goes into a new section in the buffer returned by
    417 `magit-process-buffer'."
    418   (run-hooks 'magit-pre-call-git-hook)
    419   (let ((default-process-coding-system (magit--process-coding-system)))
    420     (apply #'magit-call-process
    421            (magit-git-executable)
    422            (magit-process-git-arguments args))))
    423 
    424 (defun magit-call-process (program &rest args)
    425   "Call PROGRAM synchronously in a separate process.
    426 Process output goes into a new section in the buffer returned by
    427 `magit-process-buffer'."
    428   (pcase-let ((`(,process-buf . ,section)
    429                (magit-process-setup program args)))
    430     (magit-process-finish
    431      (let ((inhibit-read-only t))
    432        (apply #'magit-process-file program nil process-buf nil args))
    433      process-buf (current-buffer) default-directory section)))
    434 
    435 (defun magit-process-git (destination &rest args)
    436   "Call Git synchronously in a separate process, returning its exit code.
    437 DESTINATION specifies how to handle the output, like for
    438 `call-process', except that file handlers are supported.
    439 Enable Cygwin's \"noglob\" option during the call and
    440 ensure unix eol conversion."
    441   (apply #'magit-process-file
    442          (magit-git-executable)
    443          nil destination nil
    444          (magit-process-git-arguments args)))
    445 
    446 (defun magit-process-file (process &optional infile buffer display &rest args)
    447   "Process files synchronously in a separate process.
    448 Identical to `process-file' but temporarily enable Cygwin's
    449 \"noglob\" option during the call and ensure unix eol
    450 conversion."
    451   (when magit-process-extreme-logging
    452     (let ((inhibit-message t))
    453       (message "$ %s" (magit-process--format-arguments process args))))
    454   (let ((process-environment (magit-process-environment))
    455         (default-process-coding-system (magit--process-coding-system)))
    456     (apply #'process-file process infile buffer display args)))
    457 
    458 (defun magit-process-environment ()
    459   ;; The various w32 hacks are only applicable when running on the local
    460   ;; machine.  A local binding of process-environment different from the
    461   ;; top-level value affects the environment used by Tramp.
    462   (let ((local (not (file-remote-p default-directory))))
    463     (append magit-git-environment
    464             (and local
    465                  (cdr (assoc magit-git-executable magit-git-w32-path-hack)))
    466             (and local magit-need-cygwin-noglob
    467                  (mapcar (lambda (var)
    468                            (concat var "=" (if-let ((val (getenv var)))
    469                                                (concat val " noglob")
    470                                              "noglob")))
    471                          '("CYGWIN" "MSYS")))
    472             process-environment)))
    473 
    474 (defvar magit-this-process nil)
    475 
    476 (defun magit-run-git-with-input (&rest args)
    477   "Call Git in a separate process.
    478 ARGS is flattened and then used as arguments to Git.
    479 
    480 The current buffer's content is used as the process's standard
    481 input.  The buffer is assumed to be temporary and thus OK to
    482 modify.
    483 
    484 Function `magit-git-executable' specifies the Git executable and
    485 option `magit-git-global-arguments' specifies constant arguments.
    486 The remaining arguments ARGS specify arguments to Git, they are
    487 flattened before use."
    488   (when (eq system-type 'windows-nt)
    489     ;; On w32, git expects UTF-8 encoded input, ignore any user
    490     ;; configuration telling us otherwise (see #3250).
    491     (encode-coding-region (point-min) (point-max) 'utf-8-unix))
    492   (if (file-remote-p default-directory)
    493       ;; We lack `process-file-region', so fall back to asynch +
    494       ;; waiting in remote case.
    495       (progn
    496         (magit-start-git (current-buffer) args)
    497         (while (and magit-this-process
    498                     (eq (process-status magit-this-process) 'run))
    499           (sleep-for 0.005)))
    500     (run-hooks 'magit-pre-call-git-hook)
    501     (pcase-let* ((process-environment (magit-process-environment))
    502                  (default-process-coding-system (magit--process-coding-system))
    503                  (flat-args (magit-process-git-arguments args))
    504                  (`(,process-buf . ,section)
    505                   (magit-process-setup (magit-git-executable) flat-args))
    506                  (inhibit-read-only t))
    507       (magit-process-finish
    508        (apply #'call-process-region (point-min) (point-max)
    509               (magit-git-executable) nil process-buf nil flat-args)
    510        process-buf nil default-directory section))))
    511 
    512 ;;; Asynchronous Processes
    513 
    514 (defun magit-run-git-async (&rest args)
    515   "Start Git, prepare for refresh, and return the process object.
    516 ARGS is flattened and then used as arguments to Git.
    517 
    518 Display the command line arguments in the echo area.
    519 
    520 After Git returns some buffers are refreshed: the buffer that was
    521 current when this function was called (if it is a Magit buffer
    522 and still alive), as well as the respective Magit status buffer.
    523 
    524 See `magit-start-process' for more information."
    525   (let ((message-log-max nil))
    526     (message "Running %s %s" (magit-git-executable)
    527              (let ((m (string-join (flatten-tree args) " ")))
    528                (remove-list-of-text-properties 0 (length m) '(face) m)
    529                m)))
    530   (magit-start-git nil args))
    531 
    532 (defun magit-run-git-with-editor (&rest args)
    533   "Export GIT_EDITOR and start Git.
    534 Also prepare for refresh and return the process object.
    535 ARGS is flattened and then used as arguments to Git.
    536 
    537 Display the command line arguments in the echo area.
    538 
    539 After Git returns some buffers are refreshed: the buffer that was
    540 current when this function was called (if it is a Magit buffer
    541 and still alive), as well as the respective Magit status buffer.
    542 
    543 See `magit-start-process' and `with-editor' for more information."
    544   (magit--record-separated-gitdir)
    545   (magit-with-editor (magit-run-git-async args)))
    546 
    547 (defun magit-run-git-sequencer (&rest args)
    548   "Export GIT_EDITOR and start Git.
    549 Also prepare for refresh and return the process object.
    550 ARGS is flattened and then used as arguments to Git.
    551 
    552 Display the command line arguments in the echo area.
    553 
    554 After Git returns some buffers are refreshed: the buffer that was
    555 current when this function was called (if it is a Magit buffer
    556 and still alive), as well as the respective Magit status buffer.
    557 If the sequence stops at a commit, make the section representing
    558 that commit the current section by moving `point' there.
    559 
    560 See `magit-start-process' and `with-editor' for more information."
    561   (apply #'magit-run-git-with-editor args)
    562   (set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel)
    563   magit-this-process)
    564 
    565 (defvar magit-pre-start-git-hook nil)
    566 
    567 (defun magit-start-git (input &rest args)
    568   "Start Git, prepare for refresh, and return the process object.
    569 
    570 If INPUT is non-nil, it has to be a buffer or the name of an
    571 existing buffer.  The buffer content becomes the processes
    572 standard input.
    573 
    574 Function `magit-git-executable' specifies the Git executable and
    575 option `magit-git-global-arguments' specifies constant arguments.
    576 The remaining arguments ARGS specify arguments to Git, they are
    577 flattened before use.
    578 
    579 After Git returns some buffers are refreshed: the buffer that was
    580 current when this function was called (if it is a Magit buffer
    581 and still alive), as well as the respective Magit status buffer.
    582 
    583 See `magit-start-process' for more information."
    584   (run-hooks 'magit-pre-start-git-hook)
    585   (let ((default-process-coding-system (magit--process-coding-system)))
    586     (apply #'magit-start-process (magit-git-executable) input
    587            (magit-process-git-arguments args))))
    588 
    589 (defun magit-start-process (program &optional input &rest args)
    590   "Start PROGRAM, prepare for refresh, and return the process object.
    591 
    592 If optional argument INPUT is non-nil, it has to be a buffer or
    593 the name of an existing buffer.  The buffer content becomes the
    594 processes standard input.
    595 
    596 The process is started using `start-file-process' and then setup
    597 to use the sentinel `magit-process-sentinel' and the filter
    598 `magit-process-filter'.  Information required by these functions
    599 is stored in the process object.  When this function returns the
    600 process has not started to run yet so it is possible to override
    601 the sentinel and filter.
    602 
    603 After the process returns, `magit-process-sentinel' refreshes the
    604 buffer that was current when `magit-start-process' was called (if
    605 it is a Magit buffer and still alive), as well as the respective
    606 Magit status buffer."
    607   (pcase-let*
    608       ((`(,process-buf . ,section)
    609         (magit-process-setup program args))
    610        (process
    611         (let ((process-connection-type ;t=pty nil=pipe
    612                (or
    613                 ;; With Tramp, maybe force use a pty.  #4720
    614                 (and (file-remote-p default-directory)
    615                      (eq magit-tramp-pipe-stty-settings 'pty))
    616                 ;; Without input, don't use a pty, because it would
    617                 ;; set icrnl, which would modify the input.  #20
    618                 (and (not input) magit-process-connection-type)))
    619               (tramp-pipe-stty-settings
    620                (or (and (not (eq magit-tramp-pipe-stty-settings 'pty))
    621                         ;; Defaults to "", to allow staging hunks over
    622                         ;; Tramp again.  #4720
    623                         magit-tramp-pipe-stty-settings)
    624                    (bound-and-true-p tramp-pipe-stty-settings)))
    625               (process-environment (magit-process-environment))
    626               (default-process-coding-system (magit--process-coding-system)))
    627           (apply #'start-file-process
    628                  (file-name-nondirectory program)
    629                  process-buf program args))))
    630     (with-editor-set-process-filter process #'magit-process-filter)
    631     (set-process-sentinel process #'magit-process-sentinel)
    632     (set-process-buffer   process process-buf)
    633     (when (eq system-type 'windows-nt)
    634       ;; On w32, git expects UTF-8 encoded input, ignore any user
    635       ;; configuration telling us otherwise.
    636       (set-process-coding-system process nil 'utf-8-unix))
    637     (process-put process 'section section)
    638     (process-put process 'command-buf (current-buffer))
    639     (process-put process 'default-dir default-directory)
    640     (when magit-inhibit-refresh
    641       (process-put process 'inhibit-refresh t))
    642     (oset section process process)
    643     (with-current-buffer process-buf
    644       (set-marker (process-mark process) (point)))
    645     (when input
    646       (with-current-buffer input
    647         (process-send-region process (point-min) (point-max))
    648         ;; `process-send-eof' appears to be broken over
    649         ;;  Tramp from Windows. See #3624 and bug#43226.
    650         (if (and (eq system-type 'windows-nt)
    651                  (file-remote-p (process-get process 'default-dir) nil t))
    652             (process-send-string process "")
    653           (process-send-eof process))))
    654     (setq magit-this-process process)
    655     (oset section value process)
    656     (magit-process-display-buffer process)
    657     process))
    658 
    659 (defun magit-parse-git-async (&rest args)
    660   (setq args (magit-process-git-arguments args))
    661   (let ((command-buf (current-buffer))
    662         (stdout-buf (generate-new-buffer " *git-stdout*"))
    663         (stderr-buf (generate-new-buffer " *git-stderr*"))
    664         (toplevel (magit-toplevel)))
    665     (with-current-buffer stdout-buf
    666       (setq default-directory toplevel)
    667       (let ((process
    668              (let ((process-environment (magit-process-environment)))
    669                (make-process :name "git"
    670                              :buffer stdout-buf
    671                              :stderr stderr-buf
    672                              :command (cons (magit-git-executable) args)
    673                              :coding (magit--process-coding-system)
    674                              :file-handler t))))
    675         (process-put process 'command-buf command-buf)
    676         (process-put process 'stderr-buf stderr-buf)
    677         (process-put process 'parsed (point))
    678         (setq magit-this-process process)
    679         process))))
    680 
    681 ;;; Process Internals
    682 
    683 (defclass magit-process-section (magit-section)
    684   ((process :initform nil)))
    685 
    686 (setf (alist-get 'process magit--section-type-alist) 'magit-process-section)
    687 
    688 (defun magit-process-setup (program args)
    689   (magit-process-set-mode-line program args)
    690   (let ((pwd default-directory)
    691         (buf (magit-process-buffer t)))
    692     (cons buf (with-current-buffer buf
    693                 (prog1 (magit-process-insert-section pwd program args nil nil)
    694                   (backward-char 1))))))
    695 
    696 (defun magit-process-insert-section
    697     (pwd program args &optional errcode errlog face)
    698   (let ((inhibit-read-only t)
    699         (magit-insert-section--current nil)
    700         (magit-insert-section--parent magit-root-section)
    701         (magit-insert-section--oldroot nil))
    702     (goto-char (1- (point-max)))
    703     (magit-insert-section (process)
    704       (insert (if errcode
    705                   (format "%3s " (propertize (number-to-string errcode)
    706                                              'font-lock-face 'magit-process-ng))
    707                 "run "))
    708       (when magit-process-timestamp-format
    709         (insert (format-time-string magit-process-timestamp-format) " "))
    710       (let ((cmd (concat
    711                   (and (not (equal
    712                              (file-name-as-directory (expand-file-name pwd))
    713                              (file-name-as-directory (expand-file-name
    714                                                       default-directory))))
    715                        (concat (file-relative-name pwd default-directory) " "))
    716                   (magit-process--format-arguments program args))))
    717         (magit-insert-heading (if face (propertize cmd 'face face) cmd)))
    718       (when errlog
    719         (if (bufferp errlog)
    720             (insert (with-current-buffer errlog
    721                       (buffer-substring-no-properties (point-min) (point-max))))
    722           (insert-file-contents errlog)
    723           (goto-char (1- (point-max)))))
    724       (insert "\n"))))
    725 
    726 (defun magit-process--format-arguments (program args)
    727   (cond
    728    ((and args (equal program (magit-git-executable)))
    729     (let ((global (length magit-git-global-arguments)))
    730       (concat
    731        (propertize (file-name-nondirectory program)
    732                    'font-lock-face 'magit-section-heading)
    733        " "
    734        (propertize (magit--ellipsis)
    735                    'font-lock-face 'magit-section-heading
    736                    'help-echo (string-join (seq-take args global) " "))
    737        " "
    738        (propertize (mapconcat #'shell-quote-argument (seq-drop args global) " ")
    739                    'font-lock-face 'magit-section-heading))))
    740    ((and args (equal program shell-file-name))
    741     (propertize (cadr args)
    742                 'font-lock-face 'magit-section-heading))
    743    (t
    744     (concat (propertize (file-name-nondirectory program)
    745                         'font-lock-face 'magit-section-heading)
    746             " "
    747             (propertize (mapconcat #'shell-quote-argument args " ")
    748                         'font-lock-face 'magit-section-heading)))))
    749 
    750 (defun magit-process-truncate-log ()
    751   (let* ((head nil)
    752          (tail (oref magit-root-section children))
    753          (count (length tail)))
    754     (when (> (1+ count) magit-process-log-max)
    755       (while (and (cdr tail)
    756                   (> count (/ magit-process-log-max 2)))
    757         (let* ((inhibit-read-only t)
    758                (section (car tail))
    759                (process (oref section process)))
    760           (cond ((not process))
    761                 ((memq (process-status process) '(exit signal))
    762                  (delete-region (oref section start)
    763                                 (1+ (oref section end)))
    764                  (cl-decf count))
    765                 (t
    766                  (push section head))))
    767         (pop tail))
    768       (oset magit-root-section children
    769             (nconc (reverse head) tail)))))
    770 
    771 (defun magit-process-sentinel (process event)
    772   "Default sentinel used by `magit-start-process'."
    773   (when (memq (process-status process) '(exit signal))
    774     (setq event (substring event 0 -1))
    775     (when (string-match "^finished" event)
    776       (message (concat (capitalize (process-name process)) " finished")))
    777     (magit-process-finish process)
    778     (when (eq process magit-this-process)
    779       (setq magit-this-process nil))
    780     (unless (process-get process 'inhibit-refresh)
    781       (let ((command-buf (process-get process 'command-buf)))
    782         (if (buffer-live-p command-buf)
    783             (with-current-buffer command-buf
    784               (magit-refresh))
    785           (with-temp-buffer
    786             (setq default-directory (process-get process 'default-dir))
    787             (magit-refresh)))))))
    788 
    789 (defun magit-sequencer-process-sentinel (process event)
    790   "Special sentinel used by `magit-run-git-sequencer'."
    791   (when (memq (process-status process) '(exit signal))
    792     (magit-process-sentinel process event)
    793     (when-let* ((process-buf (process-buffer process))
    794                 ((buffer-live-p process-buf))
    795                 (status-buf (with-current-buffer process-buf
    796                               (magit-get-mode-buffer 'magit-status-mode))))
    797       (with-current-buffer status-buf
    798         (when-let ((section
    799                     (magit-get-section
    800                      `((commit . ,(magit-rev-parse "HEAD"))
    801                        (,(pcase (car (seq-drop
    802                                       (process-command process)
    803                                       (1+ (length magit-git-global-arguments))))
    804                            ((or "rebase" "am") 'rebase-sequence)
    805                            ((or "cherry-pick" "revert") 'sequence)))
    806                        (status)))))
    807           (goto-char (oref section start))
    808           (magit-section-update-highlight))))))
    809 
    810 (defun magit-process-filter (proc string)
    811   "Default filter used by `magit-start-process'."
    812   (with-current-buffer (process-buffer proc)
    813     (let ((inhibit-read-only t))
    814       (goto-char (process-mark proc))
    815       ;; Find last ^M in string.  If one was found, ignore
    816       ;; everything before it and delete the current line.
    817       (when-let ((ret-pos (cl-position ?\r string :from-end t)))
    818         (setq string (substring string (1+ ret-pos)))
    819         (delete-region (line-beginning-position) (point)))
    820       (setq string (magit-process-remove-bogus-errors string))
    821       (insert (propertize string 'magit-section
    822                           (process-get proc 'section)))
    823       (set-marker (process-mark proc) (point))
    824       ;; Make sure prompts are matched after removing ^M.
    825       (magit-process-yes-or-no-prompt proc string)
    826       (magit-process-username-prompt  proc string)
    827       (magit-process-password-prompt  proc string)
    828       (run-hook-with-args-until-success 'magit-process-prompt-functions
    829                                         proc string))))
    830 
    831 (defun magit-process-make-keymap (process parent)
    832   "Remap `abort-minibuffers' to a command that also kills PROCESS.
    833 PARENT is used as the parent of the returned keymap."
    834   (let ((cmd (lambda ()
    835                (interactive)
    836                (ignore-errors (kill-process process))
    837                (if (fboundp 'abort-minibuffers)
    838                    (abort-minibuffers)
    839                  (abort-recursive-edit)))))
    840     (define-keymap :parent parent
    841       "C-g" cmd
    842       "<remap> <abort-minibuffers>" cmd
    843       "<remap> <abort-recursive-edit>" cmd)))
    844 
    845 (defmacro magit-process-kill-on-abort (process &rest body)
    846   (declare (indent 1)
    847            (debug (form body))
    848            (obsolete magit-process-make-keymap "Magit 4.0.0"))
    849   `(let ((minibuffer-local-map
    850           (magit-process-make-keymap ,process minibuffer-local-map)))
    851      ,@body))
    852 
    853 (defun magit-process-remove-bogus-errors (str)
    854   (save-match-data
    855     (when (string-match "^\\(\\*ERROR\\*: \\)Canceled by user" str)
    856       (setq str (replace-match "" nil nil str 1)))
    857     (when (string-match "^error: There was a problem with the editor.*\n" str)
    858       (setq str (replace-match "" nil nil str)))
    859     (when (string-match
    860            "^Please supply the message using either -m or -F option\\.\n" str)
    861       (setq str (replace-match "" nil nil str))))
    862   str)
    863 
    864 (defun magit-process-yes-or-no-prompt (process string)
    865   "Forward Yes-or-No prompts to the user."
    866   (when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string)))
    867     (process-send-string
    868      process
    869      (if (save-match-data
    870            (let ((max-mini-window-height 30)
    871                  (minibuffer-local-map
    872                   (magit-process-make-keymap process minibuffer-local-map))
    873                  ;; In case yes-or-no-p is fset to that, but does
    874                  ;; not cover use-dialog-box-p and y-or-n-p-read-key.
    875                  (y-or-n-p-map
    876                   (magit-process-make-keymap process y-or-n-p-map)))
    877              (yes-or-no-p (substring string 0 beg))))
    878          (concat (downcase (match-string 1 string)) "\n")
    879        (concat (downcase (match-string 2 string)) "\n")))))
    880 
    881 (defun magit-process-password-auth-source (key)
    882   "Use `auth-source-search' to get a password.
    883 If found, return the password.  Otherwise, return nil.
    884 
    885 To use this function add it to the appropriate hook
    886   (add-hook \\='magit-process-find-password-functions
    887             \\='magit-process-password-auth-source)
    888 
    889 KEY typically derives from a prompt such as:
    890   Password for \\='https://yourname@github.com\\='
    891 in which case it would be the string
    892   yourname@github.com
    893 which matches the ~/.authinfo.gpg entry
    894   machine github.com login yourname password 12345
    895 or iff that is undefined, for backward compatibility
    896   machine yourname@github.com password 12345
    897 
    898 On github.com you should not use your password but a
    899 personal access token, see [1].  For information about
    900 the peculiarities of other forges, please consult the
    901 respective documentation.
    902 
    903 After manually editing ~/.authinfo.gpg you must reset
    904 the cache using
    905   M-x auth-source-forget-all-cached RET
    906 
    907 The above will save you from having to repeatedly type
    908 your token or password, but you might still repeatedly
    909 be asked for your username.  To prevent that, change an
    910 URL like
    911   https://github.com/foo/bar.git
    912 to
    913   https://yourname@github.com/foo/bar.git
    914 
    915 Instead of changing all such URLs manually, they can
    916 be translated on the fly by doing this once
    917   git config --global \
    918     url.https://yourname@github.com.insteadOf \
    919     https://github.com
    920 
    921 [1]: https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token."
    922   (require 'auth-source)
    923   (and (fboundp 'auth-source-search)
    924        (string-match "\\`\\(.+\\)@\\([^@]+\\)\\'" key)
    925        (let* ((user (match-string 1 key))
    926               (host (match-string 2 key))
    927               (secret
    928                (plist-get
    929                 (car (or (auth-source-search :max 1 :host host :user user)
    930                          (auth-source-search :max 1 :host key)))
    931                 :secret)))
    932          (if (functionp secret)
    933              (funcall secret)
    934            secret))))
    935 
    936 (defun magit-process-git-credential-manager-core (process string)
    937   "Authenticate using `git-credential-manager-core'.
    938 
    939 To use this function add it to the appropriate hook
    940   (add-hook \\='magit-process-prompt-functions
    941             \\='magit-process-git-credential-manager-core)"
    942   (and (string-match "^option (enter for default): $" string)
    943        (progn
    944          (magit-process-buffer)
    945          (let ((option (format "%c\n"
    946                                (read-char-choice "Option: " '(?\r ?\j ?1 ?2)))))
    947            (insert-before-markers-and-inherit option)
    948            (process-send-string process option)))))
    949 
    950 (defun magit-process-password-prompt (process string)
    951   "Find a password based on prompt STRING and send it to git.
    952 Use `magit-process-password-prompt-regexps' to find a known
    953 prompt.  If and only if one is found, then call functions in
    954 `magit-process-find-password-functions' until one of them returns
    955 the password.  If all functions return nil, then read the password
    956 from the user."
    957   (when-let ((prompt (magit-process-match-prompt
    958                       magit-process-password-prompt-regexps string)))
    959     (process-send-string
    960      process
    961      (concat (or (and-let* ((key (match-string 99 string)))
    962                    (run-hook-with-args-until-success
    963                     'magit-process-find-password-functions key))
    964                  (let ((read-passwd-map
    965                         (magit-process-make-keymap process read-passwd-map)))
    966                    (read-passwd prompt)))
    967              "\n"))))
    968 
    969 (defun magit-process-username-prompt (process string)
    970   "Forward username prompts to the user."
    971   (when-let ((prompt (magit-process-match-prompt
    972                       magit-process-username-prompt-regexps string)))
    973     (process-send-string
    974      process
    975      (let ((minibuffer-local-map
    976             (magit-process-make-keymap process minibuffer-local-map)))
    977        (concat (read-string prompt nil nil (user-login-name)) "\n")))))
    978 
    979 (defun magit-process-match-prompt (prompts string)
    980   "Match STRING against PROMPTS and set match data.
    981 Return the matched string suffixed with \": \", if needed."
    982   (when (--any-p (string-match it string) prompts)
    983     (let ((prompt (match-string 0 string)))
    984       (cond ((string-suffix-p ": " prompt) prompt)
    985             ((string-suffix-p ":"  prompt) (concat prompt " "))
    986             (t                             (concat prompt ": "))))))
    987 
    988 (defun magit--process-coding-system ()
    989   (let ((fro (or magit-git-output-coding-system
    990                  (car default-process-coding-system)))
    991         (to (cdr default-process-coding-system)))
    992     (if magit-process-ensure-unix-line-ending
    993         (cons (coding-system-change-eol-conversion fro 'unix)
    994               (coding-system-change-eol-conversion to 'unix))
    995       (cons fro to))))
    996 
    997 (defvar magit-credential-hook nil
    998   "Hook run before Git needs credentials.")
    999 
   1000 (defvar magit-credential-cache-daemon-process nil)
   1001 
   1002 (defun magit-maybe-start-credential-cache-daemon ()
   1003   "Maybe start a `git-credential-cache--daemon' process.
   1004 
   1005 If such a process is already running or if the value of option
   1006 `magit-credential-cache-daemon-socket' is nil, then do nothing.
   1007 Otherwise start the process passing the value of that options
   1008 as argument."
   1009   (unless (or (not magit-credential-cache-daemon-socket)
   1010               (process-live-p magit-credential-cache-daemon-process)
   1011               (memq magit-credential-cache-daemon-process
   1012                     (list-system-processes)))
   1013     (setq magit-credential-cache-daemon-process
   1014           (or (--first (let* ((attr (process-attributes it))
   1015                               (comm (cdr (assq 'comm attr)))
   1016                               (user (cdr (assq 'user attr))))
   1017                          (and (string= comm "git-credential-cache--daemon")
   1018                               (string= user user-login-name)))
   1019                        (list-system-processes))
   1020               (condition-case nil
   1021                   (start-process "git-credential-cache--daemon"
   1022                                  " *git-credential-cache--daemon*"
   1023                                  (magit-git-executable)
   1024                                  "credential-cache--daemon"
   1025                                  magit-credential-cache-daemon-socket)
   1026                 ;; Some Git implementations (e.g., Windows) won't have
   1027                 ;; this program; if we fail the first time, stop trying.
   1028                 ((debug error)
   1029                  (remove-hook 'magit-credential-hook
   1030                               #'magit-maybe-start-credential-cache-daemon)))))))
   1031 
   1032 (add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon)
   1033 
   1034 (defvar-keymap magit-mode-line-process-map
   1035   :doc "Keymap for `mode-line-process'."
   1036   "<mode-line> <mouse-1>" 'magit-process-buffer)
   1037 
   1038 (defun magit-process-set-mode-line (program args)
   1039   "Display the git command (sans arguments) in the mode line."
   1040   (when (equal program (magit-git-executable))
   1041     (setq args (nthcdr (length magit-git-global-arguments) args)))
   1042   (let ((str (concat " " (propertize
   1043                           (concat (file-name-nondirectory program)
   1044                                   (and args (concat " " (car args))))
   1045                           'mouse-face 'highlight
   1046                           'keymap magit-mode-line-process-map
   1047                           'help-echo "mouse-1: Show process buffer"
   1048                           'font-lock-face 'magit-mode-line-process))))
   1049     (magit-repository-local-set 'mode-line-process str)
   1050     (dolist (buf (magit-mode-get-buffers))
   1051       (with-current-buffer buf
   1052         (setq mode-line-process str)))
   1053     (force-mode-line-update t)))
   1054 
   1055 (defun magit-process-set-mode-line-error-status (&optional error str)
   1056   "Apply an error face to the string set by `magit-process-set-mode-line'.
   1057 
   1058 If ERROR is supplied, include it in the `mode-line-process' tooltip.
   1059 
   1060 If STR is supplied, it replaces the `mode-line-process' text."
   1061   (setq str (or str (magit-repository-local-get 'mode-line-process)))
   1062   (when str
   1063     (setq error (format "%smouse-1: Show process buffer"
   1064                         (if (stringp error)
   1065                             (concat error "\n\n")
   1066                           "")))
   1067     (setq str (concat " " (propertize
   1068                            (substring-no-properties str 1)
   1069                            'mouse-face 'highlight
   1070                            'keymap magit-mode-line-process-map
   1071                            'help-echo error
   1072                            'font-lock-face 'magit-mode-line-process-error)))
   1073     (magit-repository-local-set 'mode-line-process str)
   1074     (dolist (buf (magit-mode-get-buffers))
   1075       (with-current-buffer buf
   1076         (setq mode-line-process str)))
   1077     (force-mode-line-update t)
   1078     ;; We remove any error status from the mode line when a magit
   1079     ;; buffer is refreshed (see `magit-refresh-buffer'), but we must
   1080     ;; ensure that we ignore any refreshes during the remainder of the
   1081     ;; current command -- otherwise a newly-set error status would be
   1082     ;; removed before it was seen.  We set a flag which prevents the
   1083     ;; status from being removed prior to the next command, so that
   1084     ;; the error status is guaranteed to remain visible until then.
   1085     (let ((repokey (magit-repository-local-repository)))
   1086       ;; The following closure captures the repokey value, and is
   1087       ;; added to `pre-command-hook'.
   1088       (cl-labels ((enable-magit-process-unset-mode-line ()
   1089                     ;; Remove ourself from the hook variable, so
   1090                     ;; that we only run once.
   1091                     (remove-hook 'pre-command-hook
   1092                                  #'enable-magit-process-unset-mode-line)
   1093                     ;; Clear the inhibit flag for the repository in
   1094                     ;; which we set it.
   1095                     (magit-repository-local-set
   1096                      'inhibit-magit-process-unset-mode-line nil repokey)))
   1097         ;; Set the inhibit flag until the next command is invoked.
   1098         (magit-repository-local-set
   1099          'inhibit-magit-process-unset-mode-line t repokey)
   1100         (add-hook 'pre-command-hook
   1101                   #'enable-magit-process-unset-mode-line)))))
   1102 
   1103 (defun magit-process-unset-mode-line-error-status ()
   1104   "Remove any current error status from the mode line."
   1105   (let ((status (or mode-line-process
   1106                     (magit-repository-local-get 'mode-line-process))))
   1107     (when (and status
   1108                (eq (get-text-property 1 'font-lock-face status)
   1109                    'magit-mode-line-process-error))
   1110       (magit-process-unset-mode-line))))
   1111 
   1112 (add-hook 'magit-refresh-buffer-hook
   1113           #'magit-process-unset-mode-line-error-status)
   1114 
   1115 (defun magit-process-unset-mode-line (&optional directory)
   1116   "Remove the git command from the mode line."
   1117   (let ((default-directory (or directory default-directory)))
   1118     (unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line)
   1119       (magit-repository-local-set 'mode-line-process nil)
   1120       (dolist (buf (magit-mode-get-buffers))
   1121         (with-current-buffer buf (setq mode-line-process nil)))
   1122       (force-mode-line-update t))))
   1123 
   1124 (defvar magit-process-error-message-regexps
   1125   (list "^\\*ERROR\\*: Canceled by user$"
   1126         "^\\(?:error\\|fatal\\|git\\): \\(.*\\)$"
   1127         "^\\(Cannot rebase:.*\\)$"))
   1128 
   1129 (define-error 'magit-git-error "Git error")
   1130 
   1131 (defun magit-process-error-summary (process-buf section)
   1132   "A one-line error summary from the given SECTION."
   1133   (or (and (buffer-live-p process-buf)
   1134            (with-current-buffer process-buf
   1135              (and (oref section content)
   1136                   (save-excursion
   1137                     (goto-char (oref section end))
   1138                     (run-hook-wrapped
   1139                      'magit-process-error-message-regexps
   1140                      (lambda (re)
   1141                        (save-excursion
   1142                          (and (re-search-backward
   1143                                re (oref section start) t)
   1144                               (or (match-string-no-properties 1)
   1145                                   (and (not magit-process-raise-error)
   1146                                        'suppressed))))))))))
   1147       "Git failed"))
   1148 
   1149 (defun magit-process-error-tooltip (process-buf section)
   1150   "Returns the text from SECTION of the PROCESS-BUF buffer.
   1151 
   1152 Limited by `magit-process-error-tooltip-max-lines'."
   1153   (and (integerp magit-process-error-tooltip-max-lines)
   1154        (> magit-process-error-tooltip-max-lines 0)
   1155        (buffer-live-p process-buf)
   1156        (with-current-buffer process-buf
   1157          (save-excursion
   1158            (goto-char (or (oref section content)
   1159                           (oref section start)))
   1160            (buffer-substring-no-properties
   1161             (point)
   1162             (save-excursion
   1163               (forward-line magit-process-error-tooltip-max-lines)
   1164               (goto-char
   1165                (if (> (point) (oref section end))
   1166                    (oref section end)
   1167                  (point)))
   1168               ;; Remove any trailing whitespace.
   1169               (when (re-search-backward "[^[:space:]\n]"
   1170                                         (oref section start) t)
   1171                 (forward-char 1))
   1172               (point)))))))
   1173 
   1174 (defvar-local magit-this-error nil)
   1175 
   1176 (defvar magit-process-finish-apply-ansi-colors nil)
   1177 
   1178 (defun magit-process-finish (arg &optional process-buf command-buf
   1179                                  default-dir section)
   1180   (unless (integerp arg)
   1181     (setq process-buf (process-buffer arg))
   1182     (setq command-buf (process-get arg 'command-buf))
   1183     (setq default-dir (process-get arg 'default-dir))
   1184     (setq section     (process-get arg 'section))
   1185     (setq arg         (process-exit-status arg)))
   1186   (when (fboundp 'dired-uncache)
   1187     (dired-uncache default-dir))
   1188   (when (buffer-live-p process-buf)
   1189     (with-current-buffer process-buf
   1190       (magit-process-finish-section section arg)))
   1191   (if (= arg 0)
   1192       ;; Unset the `mode-line-process' value upon success.
   1193       (magit-process-unset-mode-line default-dir)
   1194     ;; Otherwise process the error.
   1195     (let ((msg (magit-process-error-summary process-buf section)))
   1196       ;; Change `mode-line-process' to an error face upon failure.
   1197       (if magit-process-display-mode-line-error
   1198           (magit-process-set-mode-line-error-status
   1199            (or (magit-process-error-tooltip process-buf section)
   1200                msg))
   1201         (magit-process-unset-mode-line default-dir))
   1202       ;; Either signal the error, or else display the error summary in
   1203       ;; the status buffer and with a message in the echo area.
   1204       (cond
   1205        (magit-process-raise-error
   1206         (signal 'magit-git-error (list (format "%s (in %s)" msg default-dir))))
   1207        ((not (eq msg 'suppressed))
   1208         (when (buffer-live-p process-buf)
   1209           (with-current-buffer process-buf
   1210             (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode)))
   1211               (with-current-buffer status-buf
   1212                 (setq magit-this-error msg)))))
   1213         (message "%s ... [%s buffer %s for details]" msg
   1214                  (if-let ((key (and (buffer-live-p command-buf)
   1215                                     (with-current-buffer command-buf
   1216                                       (car (where-is-internal
   1217                                             'magit-process-buffer))))))
   1218                      (format "Hit %s to see" (key-description key))
   1219                    "See")
   1220                  (buffer-name process-buf))))))
   1221   arg)
   1222 
   1223 (defun magit-process-finish-section (section exit-code)
   1224   (let ((inhibit-read-only t)
   1225         (buffer (current-buffer))
   1226         (marker (oref section start)))
   1227     (goto-char marker)
   1228     (save-excursion
   1229       (delete-char 3)
   1230       (set-marker-insertion-type marker nil)
   1231       (insert (propertize (format "%3s" exit-code)
   1232                           'magit-section section
   1233                           'font-lock-face (if (= exit-code 0)
   1234                                               'magit-process-ok
   1235                                             'magit-process-ng)))
   1236       (set-marker-insertion-type marker t))
   1237     (when magit-process-finish-apply-ansi-colors
   1238       (ansi-color-apply-on-region (oref section content)
   1239                                   (oref section end)))
   1240     (if (= (oref section end)
   1241            (+ (line-end-position) 2))
   1242         (save-excursion
   1243           (goto-char (1+ (line-end-position)))
   1244           (delete-char -1)
   1245           (oset section content nil))
   1246       (when (and (= exit-code 0)
   1247                  (not (--any-p (eq (window-buffer it) buffer)
   1248                                (window-list))))
   1249         (magit-section-hide section)))))
   1250 
   1251 (defun magit-process-display-buffer (process)
   1252   (when (process-live-p process)
   1253     (let ((buf (process-buffer process)))
   1254       (cond ((not (buffer-live-p buf)))
   1255             ((= magit-process-popup-time 0)
   1256              (if (minibufferp)
   1257                  (switch-to-buffer-other-window buf)
   1258                (pop-to-buffer buf)))
   1259             ((> magit-process-popup-time 0)
   1260              (run-with-timer magit-process-popup-time nil
   1261                              (lambda (p)
   1262                                (when (eq (process-status p) 'run)
   1263                                  (let ((buf (process-buffer p)))
   1264                                    (when (buffer-live-p buf)
   1265                                      (if (minibufferp)
   1266                                          (switch-to-buffer-other-window buf)
   1267                                        (pop-to-buffer buf))))))
   1268                              process))))))
   1269 
   1270 (defun magit--log-action (summary line list)
   1271   (let (heading lines)
   1272     (if (cdr list)
   1273         (progn (setq heading (funcall summary list))
   1274                (setq lines (mapcar line list)))
   1275       (setq heading (funcall line (car list))))
   1276     (with-current-buffer (magit-process-buffer t)
   1277       (goto-char (1- (point-max)))
   1278       (let ((inhibit-read-only t))
   1279         (magit-insert-section (message)
   1280           (magit-insert-heading (concat "  * " heading))
   1281           (when lines
   1282             (dolist (line lines)
   1283               (insert line "\n"))
   1284             (insert "\n"))))
   1285       (let ((inhibit-message t))
   1286         (when heading
   1287           (setq lines (cons heading lines)))
   1288         (message (string-join lines "\n"))))))
   1289 
   1290 ;;; _
   1291 (provide 'magit-process)
   1292 ;;; magit-process.el ends here