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