diff options
Diffstat (limited to 'elpa/magit-20200728.45/magit-process.el')
| -rw-r--r-- | elpa/magit-20200728.45/magit-process.el | 1156 |
1 files changed, 0 insertions, 1156 deletions
diff --git a/elpa/magit-20200728.45/magit-process.el b/elpa/magit-20200728.45/magit-process.el deleted file mode 100644 index 12eedf8..0000000 --- a/elpa/magit-20200728.45/magit-process.el +++ /dev/null @@ -1,1156 +0,0 @@ -;;; magit-process.el --- process functionality -*- lexical-binding: t -*- - -;; Copyright (C) 2010-2020 The Magit Project Contributors -;; -;; You should have received a copy of the AUTHORS.md file which -;; lists all contributors. If not, see http://magit.vc/authors. - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> - -;; Magit is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; Magit is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -;; License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with Magit. If not, see http://www.gnu.org/licenses. - -;;; Commentary: - -;; This library implements the tools used to run Git for side-effects. - -;; Note that the functions used to run Git and then consume its -;; output, are defined in `magit-git.el'. There's a bit of overlap -;; though. - -;;; Code: - -(require 'ansi-color) -(require 'cl-lib) -(require 'dash) - -(eval-when-compile - (require 'subr-x)) - -(require 'with-editor) -(require 'magit-utils) -(require 'magit-section) -(require 'magit-git) -(require 'magit-mode) - -(declare-function auth-source-search "auth-source" - (&rest spec &key max require create delete &allow-other-keys)) - -;;; Options - -(defcustom magit-process-connection-type (not (eq system-type 'cygwin)) - "Connection type used for the Git process. - -If nil, use pipes: this is usually more efficient, and works on Cygwin. -If t, use ptys: this enables Magit to prompt for passphrases when needed." - :group 'magit-process - :type '(choice (const :tag "pipe" nil) - (const :tag "pty" t))) - -(defcustom magit-need-cygwin-noglob - (and (eq system-type 'windows-nt) - (with-temp-buffer - (let ((process-environment - (append magit-git-environment process-environment))) - (condition-case e - (process-file magit-git-executable - nil (current-buffer) nil - "-c" "alias.echo=!echo" "echo" "x{0}") - (file-error - (lwarn 'magit-process :warning - "Could not run Git: %S" e)))) - (equal "x0\n" (buffer-string)))) - "Whether to use a workaround for Cygwin's globbing behavior. - -If non-nil, add environment variables to `process-environment' to -prevent the git.exe distributed by Cygwin and MSYS2 from -attempting to perform glob expansion when called from a native -Windows build of Emacs. See #2246." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type '(choice (const :tag "Yes" t) - (const :tag "No" nil))) - -(defcustom magit-process-popup-time -1 - "Popup the process buffer if a command takes longer than this many seconds." - :group 'magit-process - :type '(choice (const :tag "Never" -1) - (const :tag "Immediately" 0) - (integer :tag "After this many seconds"))) - -(defcustom magit-process-log-max 32 - "Maximum number of sections to keep in a process log buffer. -When adding a new section would go beyond the limit set here, -then the older half of the sections are remove. Sections that -belong to processes that are still running are never removed. -When this is nil, no sections are ever removed." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type '(choice (const :tag "Never remove old sections" nil) integer)) - -(defcustom magit-process-error-tooltip-max-lines 20 - "The number of lines for `magit-process-error-lines' to return. - -These are displayed in a tooltip for `mode-line-process' errors. - -If `magit-process-error-tooltip-max-lines' is nil, the tooltip -displays the text of `magit-process-error-summary' instead." - :package-version '(magit . "2.12.0") - :group 'magit-process - :type '(choice (const :tag "Use summary line" nil) - integer)) - -(defcustom magit-credential-cache-daemon-socket - (--some (pcase-let ((`(,prog . ,args) (split-string it))) - (if (and prog - (string-match-p - "\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)) - (or (cl-loop for (opt val) on args - if (string= opt "--socket") - return val) - (expand-file-name "~/.git-credential-cache/socket")))) - ;; Note: `magit-process-file' is not yet defined when - ;; evaluating this form, so we use `process-lines'. - (ignore-errors - (let ((process-environment - (append magit-git-environment process-environment))) - (process-lines magit-git-executable - "config" "--get-all" "credential.helper")))) - "If non-nil, start a credential cache daemon using this socket. - -When using Git's cache credential helper in the normal way, Emacs -sends a SIGHUP to the credential daemon after the git subprocess -has exited, causing the daemon to also quit. This can be avoided -by starting the `git-credential-cache--daemon' process directly -from Emacs. - -The function `magit-maybe-start-credential-cache-daemon' takes -care of starting the daemon if necessary, using the value of this -option as the socket. If this option is nil, then it does not -start any daemon. Likewise if another daemon is already running, -then it starts no new daemon. This function has to be a member -of the hook variable `magit-credential-hook' for this to work. -If an error occurs while starting the daemon, most likely because -the necessary executable is missing, then the function removes -itself from the hook, to avoid further futile attempts." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type '(choice (file :tag "Socket") - (const :tag "Don't start a cache daemon" nil))) - -(defcustom magit-process-yes-or-no-prompt-regexp - (concat " [\[(]" - "\\([Yy]\\(?:es\\)?\\)" - "[/|]" - "\\([Nn]o?\\)" - ;; OpenSSH v8 prints this. See #3969. - "\\(?:/\\[fingerprint\\]\\)?" - "[\])] ?[?:] ?$") - "Regexp matching Yes-or-No prompts of Git and its subprocesses." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type 'regexp) - -(defcustom magit-process-password-prompt-regexps - '("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$" - ;; Match-group 99 is used to identify the "user@host" part. - "^\\(Enter \\)?[Pp]assword\\( for '?\\(https?://\\)?\\(?99:[^']*\\)'?\\)?: ?$" - "Please enter the passphrase for the ssh key" - "Please enter the passphrase to unlock the OpenPGP secret key" - "^.*'s password: ?$" - "^Yubikey for .*: ?$" - "^Enter PIN for .*: ?$") - "List of regexps matching password prompts of Git and its subprocesses. -Also see `magit-process-find-password-functions'." - :package-version '(magit . "2.8.0") - :group 'magit-process - :type '(repeat (regexp))) - -(defcustom magit-process-find-password-functions nil - "List of functions to try in sequence to get a password. - -These functions may be called when git asks for a password, which -is detected using `magit-process-password-prompt-regexps'. They -are called if and only if matching the prompt resulted in the -value of the 99th submatch to be non-nil. Therefore users can -control for which prompts these functions should be called by -putting the host name in the 99th submatch, or not. - -If the functions are called, then they are called in the order -given, with the host name as only argument, until one of them -returns non-nil. If they are not called or none of them returns -non-nil, then the password is read from the user instead." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type 'hook - :options '(magit-process-password-auth-source)) - -(defcustom magit-process-username-prompt-regexps - '("^Username for '.*': ?$") - "List of regexps matching username prompts of Git and its subprocesses." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type '(repeat (regexp))) - -(defcustom magit-process-prompt-functions nil - "List of functions used to forward arbitrary questions to the user. - -Magit has dedicated support for forwarding username and password -prompts and Yes-or-No questions asked by Git and its subprocesses -to the user. This can be customized using other options in the -`magit-process' customization group. - -If you encounter a new question that isn't handled by default, -then those options should be used instead of this hook. - -However subprocesses may also ask questions that differ too much -from what the code related to the above options assume, and this -hook allows users to deal with such questions explicitly. - -Each function is called with the process and the output string -as arguments until one of the functions returns non-nil. The -function is responsible for asking the user the appropriate -question using e.g. `read-char-choice' and then forwarding the -answer to the process using `process-send-string'. - -While functions such as `magit-process-yes-or-no-prompt' may not -be sufficient to handle some prompt, it may still be of benefit -to look at the implementations to gain some insights on how to -implement such functions." - :package-version '(magit . "3.0.0") - :group 'magit-process - :type 'hook) - -(defcustom magit-process-ensure-unix-line-ending t - "Whether Magit should ensure a unix coding system when talking to Git." - :package-version '(magit . "2.6.0") - :group 'magit-process - :type 'boolean) - -(defcustom magit-process-display-mode-line-error t - "Whether Magit should retain and highlight process errors in the mode line." - :package-version '(magit . "2.12.0") - :group 'magit-process - :type 'boolean) - -(defface magit-process-ok - '((t :inherit magit-section-heading :foreground "green")) - "Face for zero exit-status." - :group 'magit-faces) - -(defface magit-process-ng - '((t :inherit magit-section-heading :foreground "red")) - "Face for non-zero exit-status." - :group 'magit-faces) - -(defface magit-mode-line-process - '((t :inherit mode-line-emphasis)) - "Face for `mode-line-process' status when Git is running for side-effects." - :group 'magit-faces) - -(defface magit-mode-line-process-error - '((t :inherit error)) - "Face for `mode-line-process' error status. - -Used when `magit-process-display-mode-line-error' is non-nil." - :group 'magit-faces) - -;;; Process Mode - -(defvar magit-process-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map magit-mode-map) - map) - "Keymap for `magit-process-mode'.") - -(define-derived-mode magit-process-mode magit-mode "Magit Process" - "Mode for looking at Git process output." - :group 'magit-process - (hack-dir-local-variables-non-file-buffer) - (setq imenu-prev-index-position-function - 'magit-imenu--process-prev-index-position-function) - (setq imenu-extract-index-name-function - 'magit-imenu--process-extract-index-name-function)) - -(defun magit-process-buffer (&optional nodisplay) - "Display the current repository's process buffer. - -If that buffer doesn't exist yet, then create it. -Non-interactively return the buffer and unless -optional NODISPLAY is non-nil also display it." - (interactive) - (let ((topdir (magit-toplevel))) - (unless topdir - (magit--with-safe-default-directory nil - (setq topdir default-directory) - (let (prev) - (while (not (equal topdir prev)) - (setq prev topdir) - (setq topdir (file-name-directory (directory-file-name topdir))))))) - (let ((buffer (or (--first (with-current-buffer it - (and (eq major-mode 'magit-process-mode) - (equal default-directory topdir))) - (buffer-list)) - (let ((default-directory topdir)) - (magit-generate-new-buffer 'magit-process-mode))))) - (with-current-buffer buffer - (if magit-root-section - (when magit-process-log-max - (magit-process-truncate-log)) - (magit-process-mode) - (let ((inhibit-read-only t) - (magit-insert-section--parent nil) - (magit-insert-section--oldroot nil)) - (make-local-variable 'text-property-default-nonsticky) - (magit-insert-section (processbuf) - (insert "\n"))))) - (unless nodisplay - (magit-display-buffer buffer)) - buffer))) - -(defun magit-process-kill () - "Kill the process at point." - (interactive) - (when-let ((process (magit-section-value-if 'process))) - (unless (eq (process-status process) 'run) - (user-error "Process isn't running")) - (magit-confirm 'kill-process) - (kill-process process))) - -;;; Synchronous Processes - -(defvar magit-process-raise-error nil) - -(defun magit-git (&rest args) - "Call Git synchronously in a separate process, for side-effects. - -Option `magit-git-executable' specifies the Git executable. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'. If Git exits with a non-zero status, -then raise an error." - (let ((magit-process-raise-error t)) - (magit-call-git args))) - -(defun magit-run-git (&rest args) - "Call Git synchronously in a separate process, and refresh. - -Option `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -After Git returns, the current buffer (if it is a Magit buffer) -as well as the current repository's status buffer are refreshed. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (let ((magit--refresh-cache (list (cons 0 0)))) - (magit-call-git args) - (when (member (car args) '("init" "clone")) - ;; Creating a new repository invalidates the cache. - (setq magit--refresh-cache nil)) - (magit-refresh))) - -(defvar magit-pre-call-git-hook nil) - -(defun magit-call-git (&rest args) - "Call Git synchronously in a separate process. - -Option `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (run-hooks 'magit-pre-call-git-hook) - (let ((default-process-coding-system (magit--process-coding-system))) - (apply #'magit-call-process magit-git-executable - (magit-process-git-arguments args)))) - -(defun magit-call-process (program &rest args) - "Call PROGRAM synchronously in a separate process. -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (pcase-let ((`(,process-buf . ,section) - (magit-process-setup program args))) - (magit-process-finish - (let ((inhibit-read-only t)) - (apply #'magit-process-file program nil process-buf nil args)) - process-buf (current-buffer) default-directory section))) - -(defun magit-process-file (process &optional infile buffer display &rest args) - "Process files synchronously in a separate process. -Identical to `process-file' but temporarily enable Cygwin's -\"noglob\" option during the call and ensure unix eol -conversion." - (let ((process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system))) - (apply #'process-file process infile buffer display args))) - -(defun magit-process-environment () - ;; The various w32 hacks are only applicable when running on the - ;; local machine. As of Emacs 25.1, a local binding of - ;; process-environment different from the top-level value affects - ;; the environment used in - ;; tramp-sh-handle-{start-file-process,process-file}. - (let ((local (not (file-remote-p default-directory)))) - (append magit-git-environment - (and local - (cdr (assoc magit-git-executable magit-git-w32-path-hack))) - (and local magit-need-cygwin-noglob - (mapcar (lambda (var) - (concat var "=" (--if-let (getenv var) - (concat it " noglob") - "noglob"))) - '("CYGWIN" "MSYS"))) - process-environment))) - -(defvar magit-this-process nil) - -(defun magit-run-git-with-input (&rest args) - "Call Git in a separate process. -ARGS is flattened and then used as arguments to Git. - -The current buffer's content is used as the process's standard -input. - -Option `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The remaining arguments ARGS specify arguments to Git, they are -flattened before use." - (when (eq system-type 'windows-nt) - ;; On w32, git expects UTF-8 encoded input, ignore any user - ;; configuration telling us otherwise (see #3250). - (encode-coding-region (point-min) (point-max) 'utf-8-unix)) - (if (file-remote-p default-directory) - ;; We lack `process-file-region', so fall back to asynch + - ;; waiting in remote case. - (progn - (magit-start-git (current-buffer) args) - (while (and magit-this-process - (eq (process-status magit-this-process) 'run)) - (sleep-for 0.005))) - (run-hooks 'magit-pre-call-git-hook) - (pcase-let* ((process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system)) - (flat-args (magit-process-git-arguments args)) - (`(,process-buf . ,section) - (magit-process-setup magit-git-executable flat-args)) - (inhibit-read-only t)) - (magit-process-finish - (apply #'call-process-region (point-min) (point-max) - magit-git-executable nil process-buf nil flat-args) - process-buf nil default-directory section)))) - -;;; Asynchronous Processes - -(defun magit-run-git-async (&rest args) - "Start Git, prepare for refresh, and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' for more information." - (message "Running %s %s" magit-git-executable - (let ((m (mapconcat #'identity (-flatten args) " "))) - (remove-list-of-text-properties 0 (length m) '(face) m) - m)) - (magit-start-git nil args)) - -(defun magit-run-git-with-editor (&rest args) - "Export GIT_EDITOR and start Git. -Also prepare for refresh and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' and `with-editor' for more information." - (magit--record-separated-gitdir) - (magit-with-editor (magit-run-git-async args))) - -(defun magit-run-git-sequencer (&rest args) - "Export GIT_EDITOR and start Git. -Also prepare for refresh and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. -If the sequence stops at a commit, make the section representing -that commit the current section by moving `point' there. - -See `magit-start-process' and `with-editor' for more information." - (apply #'magit-run-git-with-editor args) - (set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel) - magit-this-process) - -(defvar magit-pre-start-git-hook nil) - -(defun magit-start-git (input &rest args) - "Start Git, prepare for refresh, and return the process object. - -If INPUT is non-nil, it has to be a buffer or the name of an -existing buffer. The buffer content becomes the processes -standard input. - -Option `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The remaining arguments ARGS specify arguments to Git, they are -flattened before use. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' for more information." - (run-hooks 'magit-pre-start-git-hook) - (let ((default-process-coding-system (magit--process-coding-system))) - (apply #'magit-start-process magit-git-executable input - (magit-process-git-arguments args)))) - -(defun magit-start-process (program &optional input &rest args) - "Start PROGRAM, prepare for refresh, and return the process object. - -If optional argument INPUT is non-nil, it has to be a buffer or -the name of an existing buffer. The buffer content becomes the -processes standard input. - -The process is started using `start-file-process' and then setup -to use the sentinel `magit-process-sentinel' and the filter -`magit-process-filter'. Information required by these functions -is stored in the process object. When this function returns the -process has not started to run yet so it is possible to override -the sentinel and filter. - -After the process returns, `magit-process-sentinel' refreshes the -buffer that was current when `magit-start-process' was called (if -it is a Magit buffer and still alive), as well as the respective -Magit status buffer." - (pcase-let* - ((`(,process-buf . ,section) - (magit-process-setup program args)) - (process - (let ((process-connection-type - ;; Don't use a pty, because it would set icrnl - ;; which would modify the input (issue #20). - (and (not input) magit-process-connection-type)) - (process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system))) - (apply #'start-file-process - (file-name-nondirectory program) - process-buf program args)))) - (with-editor-set-process-filter process #'magit-process-filter) - (set-process-sentinel process #'magit-process-sentinel) - (set-process-buffer process process-buf) - (when (eq system-type 'windows-nt) - ;; On w32, git expects UTF-8 encoded input, ignore any user - ;; configuration telling us otherwise. - (set-process-coding-system process 'utf-8-unix)) - (process-put process 'section section) - (process-put process 'command-buf (current-buffer)) - (process-put process 'default-dir default-directory) - (when inhibit-magit-refresh - (process-put process 'inhibit-refresh t)) - (oset section process process) - (with-current-buffer process-buf - (set-marker (process-mark process) (point))) - (when input - (with-current-buffer input - (process-send-region process (point-min) (point-max)) - (process-send-eof process))) - (setq magit-this-process process) - (oset section value process) - (magit-process-display-buffer process) - process)) - -(defun magit-parse-git-async (&rest args) - (setq args (magit-process-git-arguments args)) - (let ((command-buf (current-buffer)) - (process-buf (generate-new-buffer " *temp*")) - (toplevel (magit-toplevel))) - (with-current-buffer process-buf - (setq default-directory toplevel) - (let ((process - (let ((process-connection-type nil) - (process-environment (magit-process-environment)) - (default-process-coding-system - (magit--process-coding-system))) - (apply #'start-file-process "git" process-buf - magit-git-executable args)))) - (process-put process 'command-buf command-buf) - (process-put process 'parsed (point)) - (setq magit-this-process process) - process)))) - -;;; Process Internals - -(defun magit-process-setup (program args) - (magit-process-set-mode-line program args) - (let ((pwd default-directory) - (buf (magit-process-buffer t))) - (cons buf (with-current-buffer buf - (prog1 (magit-process-insert-section pwd program args nil nil) - (backward-char 1)))))) - -(defun magit-process-insert-section (pwd program args &optional errcode errlog) - (let ((inhibit-read-only t) - (magit-insert-section--parent magit-root-section) - (magit-insert-section--oldroot nil)) - (goto-char (1- (point-max))) - (magit-insert-section (process) - (insert (if errcode - (format "%3s " (propertize (number-to-string errcode) - 'font-lock-face 'magit-process-ng)) - "run ")) - (unless (equal (expand-file-name pwd) - (expand-file-name default-directory)) - (insert (file-relative-name pwd default-directory) ?\s)) - (cond - ((and args (equal program magit-git-executable)) - (setq args (-split-at (length magit-git-global-arguments) args)) - (insert (propertize (file-name-nondirectory program) - 'font-lock-face 'magit-section-heading) " ") - (insert (propertize (char-to-string magit-ellipsis) - 'font-lock-face 'magit-section-heading - 'help-echo (mapconcat #'identity (car args) " "))) - (insert " ") - (insert (propertize (mapconcat #'shell-quote-argument (cadr args) " ") - 'font-lock-face 'magit-section-heading))) - ((and args (equal program shell-file-name)) - (insert (propertize (cadr args) - 'font-lock-face 'magit-section-heading))) - (t - (insert (propertize (file-name-nondirectory program) - 'font-lock-face 'magit-section-heading) " ") - (insert (propertize (mapconcat #'shell-quote-argument args " ") - 'font-lock-face 'magit-section-heading)))) - (magit-insert-heading) - (when errlog - (if (bufferp errlog) - (insert (with-current-buffer errlog - (buffer-substring-no-properties (point-min) (point-max)))) - (insert-file-contents errlog) - (goto-char (1- (point-max))))) - (insert "\n")))) - -(defun magit-process-truncate-log () - (let* ((head nil) - (tail (oref magit-root-section children)) - (count (length tail))) - (when (> (1+ count) magit-process-log-max) - (while (and (cdr tail) - (> count (/ magit-process-log-max 2))) - (let* ((inhibit-read-only t) - (section (car tail)) - (process (oref section process))) - (cond ((not process)) - ((memq (process-status process) '(exit signal)) - (delete-region (oref section start) - (1+ (oref section end))) - (cl-decf count)) - (t - (push section head)))) - (pop tail)) - (oset magit-root-section children - (nconc (reverse head) tail))))) - -(defun magit-process-sentinel (process event) - "Default sentinel used by `magit-start-process'." - (when (memq (process-status process) '(exit signal)) - (setq event (substring event 0 -1)) - (when (string-match "^finished" event) - (message (concat (capitalize (process-name process)) " finished"))) - (magit-process-finish process) - (when (eq process magit-this-process) - (setq magit-this-process nil)) - (unless (process-get process 'inhibit-refresh) - (let ((command-buf (process-get process 'command-buf))) - (if (buffer-live-p command-buf) - (with-current-buffer command-buf - (magit-refresh)) - (with-temp-buffer - (setq default-directory (process-get process 'default-dir)) - (magit-refresh))))))) - -(defun magit-sequencer-process-sentinel (process event) - "Special sentinel used by `magit-run-git-sequencer'." - (when (memq (process-status process) '(exit signal)) - (magit-process-sentinel process event) - (when-let ((process-buf (process-buffer process))) - (when (buffer-live-p process-buf) - (when-let ((status-buf (with-current-buffer process-buf - (magit-get-mode-buffer 'magit-status-mode)))) - (with-current-buffer status-buf - (--when-let - (magit-get-section - `((commit . ,(magit-rev-parse "HEAD")) - (,(pcase (car (cadr (-split-at - (1+ (length magit-git-global-arguments)) - (process-command process)))) - ((or "rebase" "am") 'rebase-sequence) - ((or "cherry-pick" "revert") 'sequence))) - (status))) - (goto-char (oref it start)) - (magit-section-update-highlight)))))))) - -(defun magit-process-filter (proc string) - "Default filter used by `magit-start-process'." - (with-current-buffer (process-buffer proc) - (let ((inhibit-read-only t)) - (goto-char (process-mark proc)) - ;; Find last ^M in string. If one was found, ignore - ;; everything before it and delete the current line. - (when-let ((ret-pos (cl-position ?\r string :from-end t))) - (cl-callf substring string (1+ ret-pos)) - (delete-region (line-beginning-position) (point))) - (insert (propertize string 'magit-section - (process-get proc 'section))) - (set-marker (process-mark proc) (point)) - ;; Make sure prompts are matched after removing ^M. - (magit-process-yes-or-no-prompt proc string) - (magit-process-username-prompt proc string) - (magit-process-password-prompt proc string) - (run-hook-with-args-until-success 'magit-process-prompt-functions - proc string)))) - -(defmacro magit-process-kill-on-abort (proc &rest body) - (declare (indent 1) (debug (form body))) - (let ((map (cl-gensym))) - `(let ((,map (make-sparse-keymap))) - (set-keymap-parent ,map minibuffer-local-map) - (define-key ,map "\C-g" - (lambda () - (interactive) - (ignore-errors (kill-process ,proc)) - (abort-recursive-edit))) - (let ((minibuffer-local-map ,map)) - ,@body)))) - -(defun magit-process-yes-or-no-prompt (process string) - "Forward Yes-or-No prompts to the user." - (when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string))) - (let ((max-mini-window-height 30)) - (process-send-string - process - (downcase - (concat - (match-string - (if (save-match-data - (magit-process-kill-on-abort process - (yes-or-no-p (substring string 0 beg)))) 1 2) - string) - "\n")))))) - -(defun magit-process-password-auth-source (key) - "Use `auth-source-search' to get a password. -If found, return the password. Otherwise, return nil. - -To use this function add it to the appropriate hook - (add-hook 'magit-process-find-password-functions - 'magit-process-password-auth-source) - -KEY typically derives from a prompt such as: - Password for 'https://tarsius@bitbucket.org' -in which case it would be the string - tarsius@bitbucket.org -which matches the ~/.authinfo.gpg entry - machine bitbucket.org login tarsius password 12345 -or iff that is undefined, for backward compatibility - machine tarsius@bitbucket.org password 12345" - (require 'auth-source) - (and (string-match "\\`\\(.+\\)@\\([^@]+\\)\\'" key) - (let* ((user (match-string 1 key)) - (host (match-string 2 key)) - (secret - (plist-get - (car (or (auth-source-search :max 1 :host host :user user) - (auth-source-search :max 1 :host key))) - :secret))) - (if (functionp secret) - (funcall secret) - secret)))) - -(defun magit-process-password-prompt (process string) - "Find a password based on prompt STRING and send it to git. -Use `magit-process-password-prompt-regexps' to find a known -prompt. If and only if one is found, then call functions in -`magit-process-find-password-functions' until one of them returns -the password. If all function return nil, then read the password -from the user." - (when-let ((prompt (magit-process-match-prompt - magit-process-password-prompt-regexps string))) - (process-send-string - process (magit-process-kill-on-abort process - (concat (or (when-let ((key (match-string 99 string))) - (run-hook-with-args-until-success - 'magit-process-find-password-functions key)) - (read-passwd prompt)) - "\n"))))) - -(defun magit-process-username-prompt (process string) - "Forward username prompts to the user." - (--when-let (magit-process-match-prompt - magit-process-username-prompt-regexps string) - (process-send-string - process (magit-process-kill-on-abort process - (concat (read-string it nil nil (user-login-name)) "\n"))))) - -(defun magit-process-match-prompt (prompts string) - "Match STRING against PROMPTS and set match data. -Return the matched string suffixed with \": \", if needed." - (when (--any-p (string-match it string) prompts) - (let ((prompt (match-string 0 string))) - (cond ((string-suffix-p ": " prompt) prompt) - ((string-suffix-p ":" prompt) (concat prompt " ")) - (t (concat prompt ": ")))))) - -(defun magit--process-coding-system () - (let ((fro (or magit-git-output-coding-system - (car default-process-coding-system))) - (to (cdr default-process-coding-system))) - (if magit-process-ensure-unix-line-ending - (cons (coding-system-change-eol-conversion fro 'unix) - (coding-system-change-eol-conversion to 'unix)) - (cons fro to)))) - -(defvar magit-credential-hook nil - "Hook run before Git needs credentials.") - -(defvar magit-credential-cache-daemon-process nil) - -(defun magit-maybe-start-credential-cache-daemon () - "Maybe start a `git-credential-cache--daemon' process. - -If such a process is already running or if the value of option -`magit-credential-cache-daemon-socket' is nil, then do nothing. -Otherwise start the process passing the value of that options -as argument." - (unless (or (not magit-credential-cache-daemon-socket) - (process-live-p magit-credential-cache-daemon-process) - (memq magit-credential-cache-daemon-process - (list-system-processes))) - (setq magit-credential-cache-daemon-process - (or (--first (let* ((attr (process-attributes it)) - (comm (cdr (assq 'comm attr))) - (user (cdr (assq 'user attr)))) - (and (string= comm "git-credential-cache--daemon") - (string= user user-login-name))) - (list-system-processes)) - (condition-case nil - (start-process "git-credential-cache--daemon" - " *git-credential-cache--daemon*" - magit-git-executable - "credential-cache--daemon" - magit-credential-cache-daemon-socket) - ;; Some Git implementations (e.g. Windows) won't have - ;; this program; if we fail the first time, stop trying. - ((debug error) - (remove-hook 'magit-credential-hook - #'magit-maybe-start-credential-cache-daemon))))))) - -(add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon) - -(defun tramp-sh-handle-start-file-process--magit-tramp-process-environment - (fn name buffer program &rest args) - (if magit-tramp-process-environment - (apply fn name buffer - (car magit-tramp-process-environment) - (append (cdr magit-tramp-process-environment) - (cons program args))) - (apply fn name buffer program args))) - -(advice-add 'tramp-sh-handle-start-file-process :around - 'tramp-sh-handle-start-file-process--magit-tramp-process-environment) - -(defun tramp-sh-handle-process-file--magit-tramp-process-environment - (fn program &optional infile destination display &rest args) - (if magit-tramp-process-environment - (apply fn "env" infile destination display - (append magit-tramp-process-environment - (cons program args))) - (apply fn program infile destination display args))) - -(advice-add 'tramp-sh-handle-process-file :around - 'tramp-sh-handle-process-file--magit-tramp-process-environment) - -(defvar magit-mode-line-process-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "<mode-line> <mouse-1>") - 'magit-process-buffer) - map) - "Keymap for `mode-line-process'.") - -(defun magit-process-set-mode-line (program args) - "Display the git command (sans arguments) in the mode line." - (when (equal program magit-git-executable) - (setq args (nthcdr (length magit-git-global-arguments) args))) - (let ((str (concat " " (propertize - (concat (file-name-nondirectory program) - (and args (concat " " (car args)))) - 'mouse-face 'highlight - 'keymap magit-mode-line-process-map - 'help-echo "mouse-1: Show process buffer" - 'font-lock-face 'magit-mode-line-process)))) - (magit-repository-local-set 'mode-line-process str) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf - (setq mode-line-process str))) - (force-mode-line-update t))) - -(defun magit-process-set-mode-line-error-status (&optional error str) - "Apply an error face to the string set by `magit-process-set-mode-line'. - -If ERROR is supplied, include it in the `mode-line-process' tooltip. - -If STR is supplied, it replaces the `mode-line-process' text." - (setq str (or str (magit-repository-local-get 'mode-line-process))) - (when str - (setq error (format "%smouse-1: Show process buffer" - (if (stringp error) - (concat error "\n\n") - ""))) - (setq str (concat " " (propertize - (substring-no-properties str 1) - 'mouse-face 'highlight - 'keymap magit-mode-line-process-map - 'help-echo error - 'font-lock-face 'magit-mode-line-process-error))) - (magit-repository-local-set 'mode-line-process str) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf - (setq mode-line-process str))) - (force-mode-line-update t) - ;; We remove any error status from the mode line when a magit - ;; buffer is refreshed (see `magit-refresh-buffer'), but we must - ;; ensure that we ignore any refreshes during the remainder of the - ;; current command -- otherwise a newly-set error status would be - ;; removed before it was seen. We set a flag which prevents the - ;; status from being removed prior to the next command, so that - ;; the error status is guaranteed to remain visible until then. - (let ((repokey (magit-repository-local-repository))) - ;; The following closure captures the repokey value, and is - ;; added to `pre-command-hook'. - (cl-labels ((enable-magit-process-unset-mode-line - () ;; Remove ourself from the hook variable, so - ;; that we only run once. - (remove-hook 'pre-command-hook - #'enable-magit-process-unset-mode-line) - ;; Clear the inhibit flag for the repository in - ;; which we set it. - (magit-repository-local-set - 'inhibit-magit-process-unset-mode-line nil repokey))) - ;; Set the inhibit flag until the next command is invoked. - (magit-repository-local-set - 'inhibit-magit-process-unset-mode-line t repokey) - (add-hook 'pre-command-hook - #'enable-magit-process-unset-mode-line))))) - -(defun magit-process-unset-mode-line-error-status () - "Remove any current error status from the mode line." - (let ((status (or mode-line-process - (magit-repository-local-get 'mode-line-process)))) - (when (and status - (eq (get-text-property 1 'font-lock-face status) - 'magit-mode-line-process-error)) - (magit-process-unset-mode-line)))) - -(defun magit-process-unset-mode-line (&optional directory) - "Remove the git command from the mode line." - (let ((default-directory (or directory default-directory))) - (unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line) - (magit-repository-local-set 'mode-line-process nil) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf (setq mode-line-process nil))) - (force-mode-line-update t)))) - -(defvar magit-process-error-message-regexps - (list "^\\*ERROR\\*: Canceled by user$" - "^\\(?:error\\|fatal\\|git\\): \\(.*\\)$" - "^\\(Cannot rebase:.*\\)$")) - -(define-error 'magit-git-error "Git error") - -(defun magit-process-error-summary (process-buf section) - "A one-line error summary from the given SECTION." - (or (and (buffer-live-p process-buf) - (with-current-buffer process-buf - (and (oref section content) - (save-excursion - (goto-char (oref section end)) - (run-hook-wrapped - 'magit-process-error-message-regexps - (lambda (re) - (save-excursion - (and (re-search-backward - re (oref section start) t) - (or (match-string-no-properties 1) - (and (not magit-process-raise-error) - 'suppressed)))))))))) - "Git failed")) - -(defun magit-process-error-tooltip (process-buf section) - "Returns the text from SECTION of the PROCESS-BUF buffer. - -Limited by `magit-process-error-tooltip-max-lines'." - (and (integerp magit-process-error-tooltip-max-lines) - (> magit-process-error-tooltip-max-lines 0) - (buffer-live-p process-buf) - (with-current-buffer process-buf - (save-excursion - (goto-char (or (oref section content) - (oref section start))) - (buffer-substring-no-properties - (point) - (save-excursion - (forward-line magit-process-error-tooltip-max-lines) - (goto-char - (if (> (point) (oref section end)) - (oref section end) - (point))) - ;; Remove any trailing whitespace. - (when (re-search-backward "[^[:space:]\n]" - (oref section start) t) - (forward-char 1)) - (point))))))) - -(defvar-local magit-this-error nil) - -(defvar magit-process-finish-apply-ansi-colors nil) - -(defun magit-process-finish (arg &optional process-buf command-buf - default-dir section) - (unless (integerp arg) - (setq process-buf (process-buffer arg)) - (setq command-buf (process-get arg 'command-buf)) - (setq default-dir (process-get arg 'default-dir)) - (setq section (process-get arg 'section)) - (setq arg (process-exit-status arg))) - (when (fboundp 'dired-uncache) - (dired-uncache default-dir)) - (when (buffer-live-p process-buf) - (with-current-buffer process-buf - (let ((inhibit-read-only t) - (marker (oref section start))) - (goto-char marker) - (save-excursion - (delete-char 3) - (set-marker-insertion-type marker nil) - (insert (propertize (format "%3s" arg) - 'magit-section section - 'font-lock-face (if (= arg 0) - 'magit-process-ok - 'magit-process-ng))) - (set-marker-insertion-type marker t)) - (when magit-process-finish-apply-ansi-colors - (ansi-color-apply-on-region (oref section content) - (oref section end))) - (if (= (oref section end) - (+ (line-end-position) 2)) - (save-excursion - (goto-char (1+ (line-end-position))) - (delete-char -1) - (oset section content nil)) - (let ((buf (magit-process-buffer t))) - (when (and (= arg 0) - (not (--any-p (eq (window-buffer it) buf) - (window-list)))) - (magit-section-hide section))))))) - (if (= arg 0) - ;; Unset the `mode-line-process' value upon success. - (magit-process-unset-mode-line default-dir) - ;; Otherwise process the error. - (let ((msg (magit-process-error-summary process-buf section))) - ;; Change `mode-line-process' to an error face upon failure. - (if magit-process-display-mode-line-error - (magit-process-set-mode-line-error-status - (or (magit-process-error-tooltip process-buf section) - msg)) - (magit-process-unset-mode-line default-dir)) - ;; Either signal the error, or else display the error summary in - ;; the status buffer and with a message in the echo area. - (cond - (magit-process-raise-error - (signal 'magit-git-error (list (format "%s (in %s)" msg default-dir)))) - ((not (eq msg 'suppressed)) - (when (buffer-live-p process-buf) - (with-current-buffer process-buf - (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) - (with-current-buffer status-buf - (setq magit-this-error msg))))) - (message "%s ... [%s buffer %s for details]" msg - (if-let ((key (and (buffer-live-p command-buf) - (with-current-buffer command-buf - (car (where-is-internal - 'magit-process-buffer)))))) - (format "Hit %s to see" (key-description key)) - "See") - (buffer-name process-buf)))))) - arg) - -(defun magit-process-display-buffer (process) - (when (process-live-p process) - (let ((buf (process-buffer process))) - (cond ((not (buffer-live-p buf))) - ((= magit-process-popup-time 0) - (if (minibufferp) - (switch-to-buffer-other-window buf) - (pop-to-buffer buf))) - ((> magit-process-popup-time 0) - (run-with-timer magit-process-popup-time nil - (lambda (p) - (when (eq (process-status p) 'run) - (let ((buf (process-buffer p))) - (when (buffer-live-p buf) - (if (minibufferp) - (switch-to-buffer-other-window buf) - (pop-to-buffer buf)))))) - process)))))) - -(defun magit--log-action (summary line list) - (let (heading lines) - (if (cdr list) - (progn (setq heading (funcall summary list)) - (setq lines (mapcar line list))) - (setq heading (funcall line (car list)))) - (with-current-buffer (magit-process-buffer t) - (goto-char (1- (point-max))) - (let ((inhibit-read-only t)) - (magit-insert-section (message) - (magit-insert-heading (concat " * " heading)) - (when lines - (dolist (line lines) - (insert line "\n")) - (insert "\n")))) - (let ((inhibit-message t)) - (when heading - (setq lines (cons heading lines))) - (message (mapconcat #'identity lines "\n")))))) - -;;; _ -(provide 'magit-process) -;;; magit-process.el ends here |