commit | author | age
|
5cb5f7
|
1 |
;;; magit-process.el --- process functionality -*- lexical-binding: t -*- |
C |
2 |
|
|
3 |
;; Copyright (C) 2010-2018 The Magit Project Contributors |
|
4 |
;; |
|
5 |
;; You should have received a copy of the AUTHORS.md file which |
|
6 |
;; lists all contributors. If not, see http://magit.vc/authors. |
|
7 |
|
|
8 |
;; Author: Jonas Bernoulli <jonas@bernoul.li> |
|
9 |
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> |
|
10 |
|
|
11 |
;; Magit is free software; you can redistribute it and/or modify it |
|
12 |
;; under the terms of the GNU General Public License as published by |
|
13 |
;; the Free Software Foundation; either version 3, or (at your option) |
|
14 |
;; any later version. |
|
15 |
;; |
|
16 |
;; Magit is distributed in the hope that it will be useful, but WITHOUT |
|
17 |
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
|
18 |
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
|
19 |
;; License for more details. |
|
20 |
;; |
|
21 |
;; You should have received a copy of the GNU General Public License |
|
22 |
;; along with Magit. If not, see http://www.gnu.org/licenses. |
|
23 |
|
|
24 |
;;; Commentary: |
|
25 |
|
|
26 |
;; This library implements the tools used to run Git for side-effects. |
|
27 |
|
|
28 |
;; Note that the functions used to run Git and then consume its |
|
29 |
;; output, are defined in `magit-git.el'. There's a bit of overlap |
|
30 |
;; though. |
|
31 |
|
|
32 |
;;; Code: |
|
33 |
|
|
34 |
(require 'ansi-color) |
|
35 |
(require 'cl-lib) |
|
36 |
(require 'dash) |
|
37 |
|
|
38 |
(eval-when-compile |
|
39 |
(require 'subr-x)) |
|
40 |
|
|
41 |
(require 'with-editor) |
|
42 |
(require 'magit-utils) |
|
43 |
(require 'magit-section) |
|
44 |
(require 'magit-git) |
|
45 |
(require 'magit-mode) |
|
46 |
|
|
47 |
(declare-function auth-source-search "auth-source" |
|
48 |
(&rest spec &key max require create delete &allow-other-keys)) |
|
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 |
(let ((process-environment |
|
65 |
(append magit-git-environment process-environment))) |
|
66 |
(condition-case e |
|
67 |
(process-file magit-git-executable |
|
68 |
nil (current-buffer) nil |
|
69 |
"-c" "alias.echo=!echo" "echo" "x{0}") |
|
70 |
(file-error |
|
71 |
(lwarn 'magit-process :warning |
|
72 |
"Could not run Git: %S" e)))) |
|
73 |
(equal "x0\n" (buffer-string)))) |
|
74 |
"Whether to use a workaround for Cygwin's globbing behavior. |
|
75 |
|
|
76 |
If non-nil, add environment variables to `process-environment' to |
|
77 |
prevent the git.exe distributed by Cygwin and MSYS2 from |
|
78 |
attempting to perform glob expansion when called from a native |
|
79 |
Windows build of Emacs. See #2246." |
|
80 |
:package-version '(magit . "2.3.0") |
|
81 |
:group 'magit-process |
|
82 |
:type '(choice (const :tag "Yes" t) |
|
83 |
(const :tag "No" nil))) |
|
84 |
|
|
85 |
(defcustom magit-process-popup-time -1 |
|
86 |
"Popup the process buffer if a command takes longer than this many seconds." |
|
87 |
:group 'magit-process |
|
88 |
:type '(choice (const :tag "Never" -1) |
|
89 |
(const :tag "Immediately" 0) |
|
90 |
(integer :tag "After this many seconds"))) |
|
91 |
|
|
92 |
(defcustom magit-process-log-max 32 |
|
93 |
"Maximum number of sections to keep in a process log buffer. |
|
94 |
When adding a new section would go beyond the limit set here, |
|
95 |
then the older half of the sections are remove. Sections that |
|
96 |
belong to processes that are still running are never removed. |
|
97 |
When this is nil, no sections are ever removed." |
|
98 |
:package-version '(magit . "2.1.0") |
|
99 |
:group 'magit-process |
|
100 |
:type '(choice (const :tag "Never remove old sections" nil) integer)) |
|
101 |
|
|
102 |
(defcustom magit-process-error-tooltip-max-lines 20 |
|
103 |
"The number of lines for `magit-process-error-lines' to return. |
|
104 |
|
|
105 |
These are displayed in a tooltip for `mode-line-process' errors. |
|
106 |
|
|
107 |
If `magit-process-error-tooltip-max-lines' is nil, the tooltip |
|
108 |
displays the text of `magit-process-error-summary' instead." |
|
109 |
:package-version '(magit . "2.12.0") |
|
110 |
:group 'magit-process |
|
111 |
:type '(choice (const :tag "Use summary line" nil) |
|
112 |
integer)) |
|
113 |
|
|
114 |
(defcustom magit-credential-cache-daemon-socket |
|
115 |
(--some (pcase-let ((`(,prog . ,args) (split-string it))) |
|
116 |
(if (and prog |
|
117 |
(string-match-p |
|
118 |
"\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)) |
|
119 |
(or (cl-loop for (opt val) on args |
|
120 |
if (string= opt "--socket") |
|
121 |
return val) |
|
122 |
(expand-file-name "~/.git-credential-cache/socket")))) |
|
123 |
;; Note: `magit-process-file' is not yet defined when |
|
124 |
;; evaluating this form, so we use `process-lines'. |
|
125 |
(ignore-errors |
|
126 |
(let ((process-environment |
|
127 |
(append magit-git-environment process-environment))) |
|
128 |
(process-lines magit-git-executable |
|
129 |
"config" "--get-all" "credential.helper")))) |
|
130 |
"If non-nil, start a credential cache daemon using this socket. |
|
131 |
|
|
132 |
When using Git's cache credential helper in the normal way, Emacs |
|
133 |
sends a SIGHUP to the credential daemon after the git subprocess |
|
134 |
has exited, causing the daemon to also quit. This can be avoided |
|
135 |
by starting the `git-credential-cache--daemon' process directly |
|
136 |
from Emacs. |
|
137 |
|
|
138 |
The function `magit-maybe-start-credential-cache-daemon' takes |
|
139 |
care of starting the daemon if necessary, using the value of this |
|
140 |
option as the socket. If this option is nil, then it does not |
|
141 |
start any daemon. Likewise if another daemon is already running, |
|
142 |
then it starts no new daemon. This function has to be a member |
|
143 |
of the hook variable `magit-credential-hook' for this to work. |
|
144 |
If an error occurs while starting the daemon, most likely because |
|
145 |
the necessary executable is missing, then the function removes |
|
146 |
itself from the hook, to avoid further futile attempts." |
|
147 |
:package-version '(magit . "2.3.0") |
|
148 |
:group 'magit-process |
|
149 |
:type '(choice (file :tag "Socket") |
|
150 |
(const :tag "Don't start a cache daemon" nil))) |
|
151 |
|
|
152 |
(defcustom magit-process-yes-or-no-prompt-regexp |
|
153 |
" [\[(]\\([Yy]\\(?:es\\)?\\)[/|]\\([Nn]o?\\)[\])] ?[?:] ?$" |
|
154 |
"Regexp matching Yes-or-No prompts of Git and its subprocesses." |
|
155 |
:package-version '(magit . "2.1.0") |
|
156 |
:group 'magit-process |
|
157 |
:type 'regexp) |
|
158 |
|
|
159 |
(defcustom magit-process-password-prompt-regexps |
|
160 |
'("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$" |
|
161 |
;; Match-group 99 is used to identify the "user@host" part. |
|
162 |
"^\\(Enter \\)?[Pp]assword\\( for '\\(https?://\\)?\\(?99:.*\\)'\\)?: ?$" |
|
163 |
"^.*'s password: ?$" |
|
164 |
"^Yubikey for .*: ?$" |
|
165 |
"^Enter PIN for .*: ?$") |
|
166 |
"List of regexps matching password prompts of Git and its subprocesses. |
|
167 |
Also see `magit-process-find-password-functions'." |
|
168 |
:package-version '(magit . "2.8.0") |
|
169 |
:group 'magit-process |
|
170 |
:type '(repeat (regexp))) |
|
171 |
|
|
172 |
(defcustom magit-process-find-password-functions nil |
|
173 |
"List of functions to try in sequence to get a password. |
|
174 |
|
|
175 |
These functions may be called when git asks for a password, which |
|
176 |
is detected using `magit-process-password-prompt-regexps'. They |
|
177 |
are called if and only if matching the prompt resulted in the |
|
178 |
value of the 99th submatch to be non-nil. Therefore users can |
|
179 |
control for which prompts these functions should be called by |
|
180 |
putting the host name in the 99th submatch, or not. |
|
181 |
|
|
182 |
If the functions are called, then they are called in the order |
|
183 |
given, with the host name as only argument, until one of them |
|
184 |
returns non-nil. If they are not called or none of them returns |
|
185 |
non-nil, then the password is read from the user instead." |
|
186 |
:package-version '(magit . "2.3.0") |
|
187 |
:group 'magit-process |
|
188 |
:type 'hook |
|
189 |
:options '(magit-process-password-auth-source)) |
|
190 |
|
|
191 |
(defcustom magit-process-username-prompt-regexps |
|
192 |
'("^Username for '.*': ?$") |
|
193 |
"List of regexps matching username prompts of Git and its subprocesses." |
|
194 |
:package-version '(magit . "2.1.0") |
|
195 |
:group 'magit-process |
|
196 |
:type '(repeat (regexp))) |
|
197 |
|
|
198 |
(defcustom magit-process-ensure-unix-line-ending t |
|
199 |
"Whether Magit should ensure a unix coding system when talking to Git." |
|
200 |
:package-version '(magit . "2.6.0") |
|
201 |
:group 'magit-process |
|
202 |
:type 'boolean) |
|
203 |
|
|
204 |
(defcustom magit-process-display-mode-line-error t |
|
205 |
"Whether Magit should retain and highlight process errors in the mode line." |
|
206 |
:package-version '(magit . "2.12.0") |
|
207 |
:group 'magit-process |
|
208 |
:type 'boolean) |
|
209 |
|
|
210 |
(defface magit-process-ok |
|
211 |
'((t :inherit magit-section-heading :foreground "green")) |
|
212 |
"Face for zero exit-status." |
|
213 |
:group 'magit-faces) |
|
214 |
|
|
215 |
(defface magit-process-ng |
|
216 |
'((t :inherit magit-section-heading :foreground "red")) |
|
217 |
"Face for non-zero exit-status." |
|
218 |
:group 'magit-faces) |
|
219 |
|
|
220 |
(defface magit-mode-line-process |
|
221 |
'((t :inherit mode-line-emphasis)) |
|
222 |
"Face for `mode-line-process' status when Git is running for side-effects." |
|
223 |
:group 'magit-faces) |
|
224 |
|
|
225 |
(defface magit-mode-line-process-error |
|
226 |
'((t :inherit error)) |
|
227 |
"Face for `mode-line-process' error status. |
|
228 |
|
|
229 |
Used when `magit-process-display-mode-line-error' is non-nil." |
|
230 |
:group 'magit-faces) |
|
231 |
|
|
232 |
;;; Process Mode |
|
233 |
|
|
234 |
(defvar magit-process-mode-map |
|
235 |
(let ((map (make-sparse-keymap))) |
|
236 |
(set-keymap-parent map magit-mode-map) |
|
237 |
map) |
|
238 |
"Keymap for `magit-process-mode'.") |
|
239 |
|
|
240 |
(define-derived-mode magit-process-mode magit-mode "Magit Process" |
|
241 |
"Mode for looking at Git process output." |
|
242 |
:group 'magit-process |
|
243 |
(hack-dir-local-variables-non-file-buffer) |
|
244 |
(setq imenu-prev-index-position-function |
|
245 |
'magit-imenu--process-prev-index-position-function) |
|
246 |
(setq imenu-extract-index-name-function |
|
247 |
'magit-imenu--process-extract-index-name-function)) |
|
248 |
|
|
249 |
(defun magit-process-buffer (&optional nodisplay) |
|
250 |
"Display the current repository's process buffer. |
|
251 |
|
|
252 |
If that buffer doesn't exist yet, then create it. |
|
253 |
Non-interactively return the buffer and unless |
|
254 |
optional NODISPLAY is non-nil also display it." |
|
255 |
(interactive) |
|
256 |
(let ((topdir (magit-toplevel))) |
|
257 |
(unless topdir |
|
258 |
(magit--with-safe-default-directory nil |
|
259 |
(setq topdir default-directory) |
|
260 |
(let (prev) |
|
261 |
(while (not (equal topdir prev)) |
|
262 |
(setq prev topdir) |
|
263 |
(setq topdir (file-name-directory (directory-file-name topdir))))))) |
|
264 |
(let ((buffer (or (--first (with-current-buffer it |
|
265 |
(and (eq major-mode 'magit-process-mode) |
|
266 |
(equal default-directory topdir))) |
|
267 |
(buffer-list)) |
|
268 |
(let ((default-directory topdir)) |
|
269 |
(magit-generate-new-buffer 'magit-process-mode))))) |
|
270 |
(with-current-buffer buffer |
|
271 |
(if magit-root-section |
|
272 |
(when magit-process-log-max |
|
273 |
(magit-process-truncate-log)) |
|
274 |
(magit-process-mode) |
|
275 |
(let ((inhibit-read-only t) |
|
276 |
(magit-insert-section--parent nil) |
|
277 |
(magit-insert-section--oldroot nil)) |
|
278 |
(make-local-variable 'text-property-default-nonsticky) |
|
279 |
(magit-insert-section (processbuf) |
|
280 |
(insert "\n"))))) |
|
281 |
(unless nodisplay |
|
282 |
(magit-display-buffer buffer)) |
|
283 |
buffer))) |
|
284 |
|
|
285 |
(defun magit-process-kill () |
|
286 |
"Kill the process at point." |
|
287 |
(interactive) |
|
288 |
(when-let ((process (magit-section-value-if 'process))) |
|
289 |
(unless (eq (process-status process) 'run) |
|
290 |
(user-error "Process isn't running")) |
|
291 |
(magit-confirm 'kill-process) |
|
292 |
(kill-process process))) |
|
293 |
|
|
294 |
;;; Synchronous Processes |
|
295 |
|
|
296 |
(defvar magit-process-raise-error nil) |
|
297 |
|
|
298 |
(defun magit-git (&rest args) |
|
299 |
"Call Git synchronously in a separate process, for side-effects. |
|
300 |
|
|
301 |
Option `magit-git-executable' specifies the Git executable. |
|
302 |
The arguments ARGS specify arguments to Git, they are flattened |
|
303 |
before use. |
|
304 |
|
|
305 |
Process output goes into a new section in the buffer returned by |
|
306 |
`magit-process-buffer'. If Git exits with a non-zero status, |
|
307 |
then raise an error." |
|
308 |
(let ((magit-process-raise-error t)) |
|
309 |
(magit-call-git args))) |
|
310 |
|
|
311 |
(defun magit-run-git (&rest args) |
|
312 |
"Call Git synchronously in a separate process, and refresh. |
|
313 |
|
|
314 |
Option `magit-git-executable' specifies the Git executable and |
|
315 |
option `magit-git-global-arguments' specifies constant arguments. |
|
316 |
The arguments ARGS specify arguments to Git, they are flattened |
|
317 |
before use. |
|
318 |
|
|
319 |
After Git returns, the current buffer (if it is a Magit buffer) |
|
320 |
as well as the current repository's status buffer are refreshed. |
|
321 |
|
|
322 |
Process output goes into a new section in the buffer returned by |
|
323 |
`magit-process-buffer'." |
|
324 |
(let ((magit--refresh-cache (list (cons 0 0)))) |
|
325 |
(magit-call-git args) |
|
326 |
(when (member (car args) '("init" "clone")) |
|
327 |
;; Creating a new repository invalidates the cache. |
|
328 |
(setq magit--refresh-cache nil)) |
|
329 |
(magit-refresh))) |
|
330 |
|
|
331 |
(defvar magit-pre-call-git-hook nil) |
|
332 |
|
|
333 |
(defun magit-call-git (&rest args) |
|
334 |
"Call Git synchronously in a separate process. |
|
335 |
|
|
336 |
Option `magit-git-executable' specifies the Git executable and |
|
337 |
option `magit-git-global-arguments' specifies constant arguments. |
|
338 |
The arguments ARGS specify arguments to Git, they are flattened |
|
339 |
before use. |
|
340 |
|
|
341 |
Process output goes into a new section in the buffer returned by |
|
342 |
`magit-process-buffer'." |
|
343 |
(run-hooks 'magit-pre-call-git-hook) |
|
344 |
(let ((default-process-coding-system (magit--process-coding-system))) |
|
345 |
(apply #'magit-call-process magit-git-executable |
|
346 |
(magit-process-git-arguments args)))) |
|
347 |
|
|
348 |
(defun magit-call-process (program &rest args) |
|
349 |
"Call PROGRAM synchronously in a separate process. |
|
350 |
Process output goes into a new section in the buffer returned by |
|
351 |
`magit-process-buffer'." |
|
352 |
(pcase-let ((`(,process-buf . ,section) |
|
353 |
(magit-process-setup program args))) |
|
354 |
(magit-process-finish |
|
355 |
(let ((inhibit-read-only t)) |
|
356 |
(apply #'magit-process-file program nil process-buf nil args)) |
|
357 |
process-buf (current-buffer) default-directory section))) |
|
358 |
|
|
359 |
(defun magit-process-file (process &optional infile buffer display &rest args) |
|
360 |
"Process files synchronously in a separate process. |
|
361 |
Identical to `process-file' but temporarily enable Cygwin's |
|
362 |
\"noglob\" option during the call and ensure unix eol |
|
363 |
conversion." |
|
364 |
(let ((process-environment (magit-process-environment)) |
|
365 |
(default-process-coding-system (magit--process-coding-system))) |
|
366 |
(apply #'process-file process infile buffer display args))) |
|
367 |
|
|
368 |
(defun magit-process-environment () |
|
369 |
;; The various w32 hacks are only applicable when running on the |
|
370 |
;; local machine. As of Emacs 25.1, a local binding of |
|
371 |
;; process-environment different from the top-level value affects |
|
372 |
;; the environment used in |
|
373 |
;; tramp-sh-handle-{start-file-process,process-file}. |
|
374 |
(let ((local (not (file-remote-p default-directory)))) |
|
375 |
(append magit-git-environment |
|
376 |
(and local |
|
377 |
(cdr (assoc magit-git-executable magit-git-w32-path-hack))) |
|
378 |
(and local magit-need-cygwin-noglob |
|
379 |
(mapcar (lambda (var) |
|
380 |
(concat var "=" (--if-let (getenv var) |
|
381 |
(concat it " noglob") |
|
382 |
"noglob"))) |
|
383 |
'("CYGWIN" "MSYS"))) |
|
384 |
process-environment))) |
|
385 |
|
|
386 |
(defvar magit-this-process nil) |
|
387 |
|
|
388 |
(defun magit-run-git-with-input (&rest args) |
|
389 |
"Call Git in a separate process. |
|
390 |
ARGS is flattened and then used as arguments to Git. |
|
391 |
|
|
392 |
The current buffer's content is used as the process' standard |
|
393 |
input. |
|
394 |
|
|
395 |
Option `magit-git-executable' specifies the Git executable and |
|
396 |
option `magit-git-global-arguments' specifies constant arguments. |
|
397 |
The remaining arguments ARGS specify arguments to Git, they are |
|
398 |
flattened before use." |
|
399 |
(when (eq system-type 'windows-nt) |
|
400 |
;; On w32, git expects UTF-8 encoded input, ignore any user |
|
401 |
;; configuration telling us otherwise (see #3250). |
|
402 |
(encode-coding-region (point-min) (point-max) 'utf-8-unix)) |
|
403 |
(if (file-remote-p default-directory) |
|
404 |
;; We lack `process-file-region', so fall back to asynch + |
|
405 |
;; waiting in remote case. |
|
406 |
(progn |
|
407 |
(magit-start-git (current-buffer) args) |
|
408 |
(while (and magit-this-process |
|
409 |
(eq (process-status magit-this-process) 'run)) |
|
410 |
(sleep-for 0.005))) |
|
411 |
(run-hooks 'magit-pre-call-git-hook) |
|
412 |
(pcase-let* ((process-environment (magit-process-environment)) |
|
413 |
(default-process-coding-system (magit--process-coding-system)) |
|
414 |
(flat-args (magit-process-git-arguments args)) |
|
415 |
(`(,process-buf . ,section) |
|
416 |
(magit-process-setup magit-git-executable flat-args)) |
|
417 |
(inhibit-read-only t)) |
|
418 |
(magit-process-finish |
|
419 |
(apply #'call-process-region (point-min) (point-max) |
|
420 |
magit-git-executable nil process-buf nil flat-args) |
|
421 |
process-buf nil default-directory section)))) |
|
422 |
|
|
423 |
(defun magit-run-git-with-logfile (file &rest args) |
|
424 |
"Call Git in a separate process and log its output to FILE. |
|
425 |
This function might have a short halflive." |
|
426 |
(apply #'magit-process-file magit-git-executable nil `(:file ,file) nil |
|
427 |
(magit-process-git-arguments args)) |
|
428 |
(magit-refresh)) |
|
429 |
|
|
430 |
;;; Asynchronous Processes |
|
431 |
|
|
432 |
(defun magit-run-git-async (&rest args) |
|
433 |
"Start Git, prepare for refresh, and return the process object. |
|
434 |
ARGS is flattened and then used as arguments to Git. |
|
435 |
|
|
436 |
Display the command line arguments in the echo area. |
|
437 |
|
|
438 |
After Git returns some buffers are refreshed: the buffer that was |
|
439 |
current when this function was called (if it is a Magit buffer |
|
440 |
and still alive), as well as the respective Magit status buffer. |
|
441 |
|
|
442 |
See `magit-start-process' for more information." |
|
443 |
(message "Running %s %s" magit-git-executable |
|
444 |
(let ((m (mapconcat #'identity (-flatten args) " "))) |
|
445 |
(remove-list-of-text-properties 0 (length m) '(face) m) |
|
446 |
m)) |
|
447 |
(magit-start-git nil args)) |
|
448 |
|
|
449 |
(defun magit-run-git-with-editor (&rest args) |
|
450 |
"Export GIT_EDITOR and start Git. |
|
451 |
Also prepare for refresh and return the process object. |
|
452 |
ARGS is flattened and then used as arguments to Git. |
|
453 |
|
|
454 |
Display the command line arguments in the echo area. |
|
455 |
|
|
456 |
After Git returns some buffers are refreshed: the buffer that was |
|
457 |
current when this function was called (if it is a Magit buffer |
|
458 |
and still alive), as well as the respective Magit status buffer. |
|
459 |
|
|
460 |
See `magit-start-process' and `with-editor' for more information." |
|
461 |
(magit--record-separated-gitdir) |
|
462 |
(magit-with-editor (magit-run-git-async args))) |
|
463 |
|
|
464 |
(defun magit-run-git-sequencer (&rest args) |
|
465 |
"Export GIT_EDITOR and start Git. |
|
466 |
Also prepare for refresh and return the process object. |
|
467 |
ARGS is flattened and then used as arguments to Git. |
|
468 |
|
|
469 |
Display the command line arguments in the echo area. |
|
470 |
|
|
471 |
After Git returns some buffers are refreshed: the buffer that was |
|
472 |
current when this function was called (if it is a Magit buffer |
|
473 |
and still alive), as well as the respective Magit status buffer. |
|
474 |
If the sequence stops at a commit, make the section representing |
|
475 |
that commit the current section by moving `point' there. |
|
476 |
|
|
477 |
See `magit-start-process' and `with-editor' for more information." |
|
478 |
(apply #'magit-run-git-with-editor args) |
|
479 |
(set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel) |
|
480 |
magit-this-process) |
|
481 |
|
|
482 |
(defvar magit-pre-start-git-hook nil) |
|
483 |
|
|
484 |
(defun magit-start-git (input &rest args) |
|
485 |
"Start Git, prepare for refresh, and return the process object. |
|
486 |
|
|
487 |
If INPUT is non-nil, it has to be a buffer or the name of an |
|
488 |
existing buffer. The buffer content becomes the processes |
|
489 |
standard input. |
|
490 |
|
|
491 |
Option `magit-git-executable' specifies the Git executable and |
|
492 |
option `magit-git-global-arguments' specifies constant arguments. |
|
493 |
The remaining arguments ARGS specify arguments to Git, they are |
|
494 |
flattened before use. |
|
495 |
|
|
496 |
After Git returns some buffers are refreshed: the buffer that was |
|
497 |
current when this function was called (if it is a Magit buffer |
|
498 |
and still alive), as well as the respective Magit status buffer. |
|
499 |
|
|
500 |
See `magit-start-process' for more information." |
|
501 |
(run-hooks 'magit-pre-start-git-hook) |
|
502 |
(let ((default-process-coding-system (magit--process-coding-system))) |
|
503 |
(apply #'magit-start-process magit-git-executable input |
|
504 |
(magit-process-git-arguments args)))) |
|
505 |
|
|
506 |
(defun magit-start-process (program &optional input &rest args) |
|
507 |
"Start PROGRAM, prepare for refresh, and return the process object. |
|
508 |
|
|
509 |
If optional argument INPUT is non-nil, it has to be a buffer or |
|
510 |
the name of an existing buffer. The buffer content becomes the |
|
511 |
processes standard input. |
|
512 |
|
|
513 |
The process is started using `start-file-process' and then setup |
|
514 |
to use the sentinel `magit-process-sentinel' and the filter |
|
515 |
`magit-process-filter'. Information required by these functions |
|
516 |
is stored in the process object. When this function returns the |
|
517 |
process has not started to run yet so it is possible to override |
|
518 |
the sentinel and filter. |
|
519 |
|
|
520 |
After the process returns, `magit-process-sentinel' refreshes the |
|
521 |
buffer that was current when `magit-start-process' was called (if |
|
522 |
it is a Magit buffer and still alive), as well as the respective |
|
523 |
Magit status buffer." |
|
524 |
(pcase-let* |
|
525 |
((`(,process-buf . ,section) |
|
526 |
(magit-process-setup program args)) |
|
527 |
(process |
|
528 |
(let ((process-connection-type |
|
529 |
;; Don't use a pty, because it would set icrnl |
|
530 |
;; which would modify the input (issue #20). |
|
531 |
(and (not input) magit-process-connection-type)) |
|
532 |
(process-environment (magit-process-environment)) |
|
533 |
(default-process-coding-system (magit--process-coding-system))) |
|
534 |
(apply #'start-file-process |
|
535 |
(file-name-nondirectory program) |
|
536 |
process-buf program args)))) |
|
537 |
(with-editor-set-process-filter process #'magit-process-filter) |
|
538 |
(set-process-sentinel process #'magit-process-sentinel) |
|
539 |
(set-process-buffer process process-buf) |
|
540 |
(when (eq system-type 'windows-nt) |
|
541 |
;; On w32, git expects UTF-8 encoded input, ignore any user |
|
542 |
;; configuration telling us otherwise. |
|
543 |
(set-process-coding-system process 'utf-8-unix)) |
|
544 |
(process-put process 'section section) |
|
545 |
(process-put process 'command-buf (current-buffer)) |
|
546 |
(process-put process 'default-dir default-directory) |
|
547 |
(when inhibit-magit-refresh |
|
548 |
(process-put process 'inhibit-refresh t)) |
|
549 |
(oset section process process) |
|
550 |
(with-current-buffer process-buf |
|
551 |
(set-marker (process-mark process) (point))) |
|
552 |
(when input |
|
553 |
(with-current-buffer input |
|
554 |
(process-send-region process (point-min) (point-max)) |
|
555 |
(process-send-eof process))) |
|
556 |
(setq magit-this-process process) |
|
557 |
(oset section value process) |
|
558 |
(magit-process-display-buffer process) |
|
559 |
process)) |
|
560 |
|
|
561 |
(defun magit-parse-git-async (&rest args) |
|
562 |
(setq args (magit-process-git-arguments args)) |
|
563 |
(let ((command-buf (current-buffer)) |
|
564 |
(process-buf (generate-new-buffer " *temp*")) |
|
565 |
(toplevel (magit-toplevel))) |
|
566 |
(with-current-buffer process-buf |
|
567 |
(setq default-directory toplevel) |
|
568 |
(let ((process |
|
569 |
(let ((process-connection-type nil) |
|
570 |
(process-environment (magit-process-environment)) |
|
571 |
(default-process-coding-system |
|
572 |
(magit--process-coding-system))) |
|
573 |
(apply #'start-file-process "git" process-buf |
|
574 |
magit-git-executable args)))) |
|
575 |
(process-put process 'command-buf command-buf) |
|
576 |
(process-put process 'parsed (point)) |
|
577 |
(setq magit-this-process process) |
|
578 |
process)))) |
|
579 |
|
|
580 |
;;; Process Internals |
|
581 |
|
|
582 |
(defun magit-process-setup (program args) |
|
583 |
(magit-process-set-mode-line program args) |
|
584 |
(let ((pwd default-directory) |
|
585 |
(buf (magit-process-buffer t))) |
|
586 |
(cons buf (with-current-buffer buf |
|
587 |
(prog1 (magit-process-insert-section pwd program args nil nil) |
|
588 |
(backward-char 1)))))) |
|
589 |
|
|
590 |
(defun magit-process-insert-section (pwd program args &optional errcode errlog) |
|
591 |
(let ((inhibit-read-only t) |
|
592 |
(magit-insert-section--parent magit-root-section) |
|
593 |
(magit-insert-section--oldroot nil)) |
|
594 |
(goto-char (1- (point-max))) |
|
595 |
(magit-insert-section (process) |
|
596 |
(insert (if errcode |
|
597 |
(format "%3s " (propertize (number-to-string errcode) |
|
598 |
'face 'magit-process-ng)) |
|
599 |
"run ")) |
|
600 |
(unless (equal (expand-file-name pwd) |
|
601 |
(expand-file-name default-directory)) |
|
602 |
(insert (file-relative-name pwd default-directory) ?\s)) |
|
603 |
(cond |
|
604 |
((and args (equal program magit-git-executable)) |
|
605 |
(setq args (-split-at (length magit-git-global-arguments) args)) |
|
606 |
(insert (propertize (file-name-nondirectory program) |
|
607 |
'face 'magit-section-heading) " ") |
|
608 |
(insert (propertize (char-to-string magit-ellipsis) |
|
609 |
'face 'magit-section-heading |
|
610 |
'help-echo (mapconcat #'identity (car args) " "))) |
|
611 |
(insert " ") |
|
612 |
(insert (propertize (mapconcat #'shell-quote-argument (cadr args) " ") |
|
613 |
'face 'magit-section-heading))) |
|
614 |
((and args (equal program shell-file-name)) |
|
615 |
(insert (propertize (cadr args) 'face 'magit-section-heading))) |
|
616 |
(t |
|
617 |
(insert (propertize (file-name-nondirectory program) |
|
618 |
'face 'magit-section-heading) " ") |
|
619 |
(insert (propertize (mapconcat #'shell-quote-argument args " ") |
|
620 |
'face 'magit-section-heading)))) |
|
621 |
(magit-insert-heading) |
|
622 |
(when errlog |
|
623 |
(insert-file-contents errlog) |
|
624 |
(goto-char (1- (point-max)))) |
|
625 |
(insert "\n")))) |
|
626 |
|
|
627 |
(defun magit-process-truncate-log () |
|
628 |
(let* ((head nil) |
|
629 |
(tail (oref magit-root-section children)) |
|
630 |
(count (length tail))) |
|
631 |
(when (> (1+ count) magit-process-log-max) |
|
632 |
(while (and (cdr tail) |
|
633 |
(> count (/ magit-process-log-max 2))) |
|
634 |
(let* ((inhibit-read-only t) |
|
635 |
(section (car tail)) |
|
636 |
(process (oref section process))) |
|
637 |
(cond ((not process)) |
|
638 |
((memq (process-status process) '(exit signal)) |
|
639 |
(delete-region (oref section start) |
|
640 |
(1+ (oref section end))) |
|
641 |
(cl-decf count)) |
|
642 |
(t |
|
643 |
(push section head)))) |
|
644 |
(pop tail)) |
|
645 |
(oset magit-root-section children |
|
646 |
(nconc (reverse head) tail))))) |
|
647 |
|
|
648 |
(defun magit-process-sentinel (process event) |
|
649 |
"Default sentinel used by `magit-start-process'." |
|
650 |
(when (memq (process-status process) '(exit signal)) |
|
651 |
(setq event (substring event 0 -1)) |
|
652 |
(when (string-match "^finished" event) |
|
653 |
(message (concat (capitalize (process-name process)) " finished"))) |
|
654 |
(magit-process-finish process) |
|
655 |
(when (eq process magit-this-process) |
|
656 |
(setq magit-this-process nil)) |
|
657 |
(unless (process-get process 'inhibit-refresh) |
|
658 |
(let ((command-buf (process-get process 'command-buf))) |
|
659 |
(if (buffer-live-p command-buf) |
|
660 |
(with-current-buffer command-buf |
|
661 |
(magit-refresh)) |
|
662 |
(with-temp-buffer |
|
663 |
(setq default-directory (process-get process 'default-dir)) |
|
664 |
(magit-refresh))))))) |
|
665 |
|
|
666 |
(defun magit-sequencer-process-sentinel (process event) |
|
667 |
"Special sentinel used by `magit-run-git-sequencer'." |
|
668 |
(when (memq (process-status process) '(exit signal)) |
|
669 |
(magit-process-sentinel process event) |
|
670 |
(when-let ((process-buf (process-buffer process))) |
|
671 |
(when (buffer-live-p process-buf) |
|
672 |
(when-let ((status-buf (with-current-buffer process-buf |
|
673 |
(magit-mode-get-buffer 'magit-status-mode)))) |
|
674 |
(with-current-buffer status-buf |
|
675 |
(--when-let |
|
676 |
(magit-get-section |
|
677 |
`((commit . ,(magit-rev-parse "HEAD")) |
|
678 |
(,(pcase (car (cadr (-split-at |
|
679 |
(1+ (length magit-git-global-arguments)) |
|
680 |
(process-command process)))) |
|
681 |
((or "rebase" "am") 'rebase-sequence) |
|
682 |
((or "cherry-pick" "revert") 'sequence))) |
|
683 |
(status))) |
|
684 |
(goto-char (oref it start)) |
|
685 |
(magit-section-update-highlight)))))))) |
|
686 |
|
|
687 |
(defun magit-process-filter (proc string) |
|
688 |
"Default filter used by `magit-start-process'." |
|
689 |
(with-current-buffer (process-buffer proc) |
|
690 |
(let ((inhibit-read-only t)) |
|
691 |
(magit-process-yes-or-no-prompt proc string) |
|
692 |
(magit-process-username-prompt proc string) |
|
693 |
(magit-process-password-prompt proc string) |
|
694 |
(goto-char (process-mark proc)) |
|
695 |
(setq string (propertize string 'magit-section |
|
696 |
(process-get proc 'section))) |
|
697 |
;; Find last ^M in string. If one was found, ignore |
|
698 |
;; everything before it and delete the current line. |
|
699 |
(let ((ret-pos (length string))) |
|
700 |
(while (and (>= (cl-decf ret-pos) 0) |
|
701 |
(/= ?\r (aref string ret-pos)))) |
|
702 |
(if (< ret-pos 0) |
|
703 |
(insert string) |
|
704 |
(delete-region (line-beginning-position) (point)) |
|
705 |
(insert (substring string (1+ ret-pos))))) |
|
706 |
(set-marker (process-mark proc) (point))))) |
|
707 |
|
|
708 |
(defmacro magit-process-kill-on-abort (proc &rest body) |
|
709 |
(declare (indent 1) (debug (form body))) |
|
710 |
(let ((map (cl-gensym))) |
|
711 |
`(let ((,map (make-sparse-keymap))) |
|
712 |
(set-keymap-parent ,map minibuffer-local-map) |
|
713 |
(define-key ,map "\C-g" |
|
714 |
(lambda () |
|
715 |
(interactive) |
|
716 |
(ignore-errors (kill-process ,proc)) |
|
717 |
(abort-recursive-edit))) |
|
718 |
(let ((minibuffer-local-map ,map)) |
|
719 |
,@body)))) |
|
720 |
|
|
721 |
(defun magit-process-yes-or-no-prompt (process string) |
|
722 |
"Forward Yes-or-No prompts to the user." |
|
723 |
(when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string))) |
|
724 |
(let ((max-mini-window-height 30)) |
|
725 |
(process-send-string |
|
726 |
process |
|
727 |
(downcase |
|
728 |
(concat |
|
729 |
(match-string |
|
730 |
(if (save-match-data |
|
731 |
(magit-process-kill-on-abort process |
|
732 |
(yes-or-no-p (substring string 0 beg)))) 1 2) |
|
733 |
string) |
|
734 |
"\n")))))) |
|
735 |
|
|
736 |
(defun magit-process-password-auth-source (key) |
|
737 |
"Use `auth-source-search' to get a password. |
|
738 |
If found, return the password. Otherwise, return nil. |
|
739 |
|
|
740 |
To use this function add it to the appropriate hook |
|
741 |
(add-hook 'magit-process-find-password-functions |
|
742 |
'magit-process-password-auth-source) |
|
743 |
|
|
744 |
KEY typically derives from a prompt such as: |
|
745 |
Password for 'https://tarsius@bitbucket.org' |
|
746 |
in which case it would be the string |
|
747 |
tarsius@bitbucket.org |
|
748 |
which matches the ~/.authinfo.gpg entry |
|
749 |
machine bitbucket.org login tarsius password 12345 |
|
750 |
or iff that is undefined, for backward compatibility |
|
751 |
machine tarsius@bitbucket.org password 12345" |
|
752 |
(require 'auth-source) |
|
753 |
(and (string-match "\\`\\([^@]+\\)@\\([^@]+\\)\\'" key) |
|
754 |
(let* ((user (match-string 1 key)) |
|
755 |
(host (match-string 2 key)) |
|
756 |
(secret |
|
757 |
(plist-get |
|
758 |
(car (or (auth-source-search :max 1 :host host :user user) |
|
759 |
(auth-source-search :max 1 :host key))) |
|
760 |
:secret))) |
|
761 |
(if (functionp secret) |
|
762 |
(funcall secret) |
|
763 |
secret)))) |
|
764 |
|
|
765 |
(defun magit-process-password-prompt (process string) |
|
766 |
"Find a password based on prompt STRING and send it to git. |
|
767 |
Use `magit-process-password-prompt-regexps' to find a known |
|
768 |
prompt. If and only if one is found, then call functions in |
|
769 |
`magit-process-find-password-functions' until one of them returns |
|
770 |
the password. If all function return nil, then read the password |
|
771 |
from the user." |
|
772 |
(when-let ((prompt (magit-process-match-prompt |
|
773 |
magit-process-password-prompt-regexps string))) |
|
774 |
(process-send-string |
|
775 |
process (magit-process-kill-on-abort process |
|
776 |
(concat (or (when-let ((key (match-string 99 string))) |
|
777 |
(run-hook-with-args-until-success |
|
778 |
'magit-process-find-password-functions key)) |
|
779 |
(read-passwd prompt)) |
|
780 |
"\n"))))) |
|
781 |
|
|
782 |
(defun magit-process-username-prompt (process string) |
|
783 |
"Forward username prompts to the user." |
|
784 |
(--when-let (magit-process-match-prompt |
|
785 |
magit-process-username-prompt-regexps string) |
|
786 |
(process-send-string |
|
787 |
process (magit-process-kill-on-abort process |
|
788 |
(concat (read-string it nil nil (user-login-name)) "\n"))))) |
|
789 |
|
|
790 |
(defun magit-process-match-prompt (prompts string) |
|
791 |
"Match STRING against PROMPTS and set match data. |
|
792 |
Return the matched string suffixed with \": \", if needed." |
|
793 |
(when (--any-p (string-match it string) prompts) |
|
794 |
(let ((prompt (match-string 0 string))) |
|
795 |
(cond ((string-suffix-p ": " prompt) prompt) |
|
796 |
((string-suffix-p ":" prompt) (concat prompt " ")) |
|
797 |
(t (concat prompt ": ")))))) |
|
798 |
|
|
799 |
(defun magit--process-coding-system () |
|
800 |
(let ((fro (or magit-git-output-coding-system |
|
801 |
(car default-process-coding-system))) |
|
802 |
(to (cdr default-process-coding-system))) |
|
803 |
(if magit-process-ensure-unix-line-ending |
|
804 |
(cons (coding-system-change-eol-conversion fro 'unix) |
|
805 |
(coding-system-change-eol-conversion to 'unix)) |
|
806 |
(cons fro to)))) |
|
807 |
|
|
808 |
(defvar magit-credential-hook nil |
|
809 |
"Hook run before Git needs credentials.") |
|
810 |
|
|
811 |
(defvar magit-credential-cache-daemon-process nil) |
|
812 |
|
|
813 |
(defun magit-maybe-start-credential-cache-daemon () |
|
814 |
"Maybe start a `git-credential-cache--daemon' process. |
|
815 |
|
|
816 |
If such a process is already running or if the value of option |
|
817 |
`magit-credential-cache-daemon-socket' is nil, then do nothing. |
|
818 |
Otherwise start the process passing the value of that options |
|
819 |
as argument." |
|
820 |
(unless (or (not magit-credential-cache-daemon-socket) |
|
821 |
(process-live-p magit-credential-cache-daemon-process) |
|
822 |
(memq magit-credential-cache-daemon-process |
|
823 |
(list-system-processes))) |
|
824 |
(setq magit-credential-cache-daemon-process |
|
825 |
(or (--first (let* ((attr (process-attributes it)) |
|
826 |
(comm (cdr (assq 'comm attr))) |
|
827 |
(user (cdr (assq 'user attr)))) |
|
828 |
(and (string= comm "git-credential-cache--daemon") |
|
829 |
(string= user user-login-name))) |
|
830 |
(list-system-processes)) |
|
831 |
(condition-case nil |
|
832 |
(start-process "git-credential-cache--daemon" |
|
833 |
" *git-credential-cache--daemon*" |
|
834 |
magit-git-executable |
|
835 |
"credential-cache--daemon" |
|
836 |
magit-credential-cache-daemon-socket) |
|
837 |
;; Some Git implementations (e.g. Windows) won't have |
|
838 |
;; this program; if we fail the first time, stop trying. |
|
839 |
((debug error) |
|
840 |
(remove-hook 'magit-credential-hook |
|
841 |
#'magit-maybe-start-credential-cache-daemon))))))) |
|
842 |
|
|
843 |
(add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon) |
|
844 |
|
|
845 |
(defun tramp-sh-handle-start-file-process--magit-tramp-process-environment |
|
846 |
(fn name buffer program &rest args) |
|
847 |
(if magit-tramp-process-environment |
|
848 |
(apply fn name buffer |
|
849 |
(car magit-tramp-process-environment) |
|
850 |
(append (cdr magit-tramp-process-environment) |
|
851 |
(cons program args))) |
|
852 |
(apply fn name buffer program args))) |
|
853 |
|
|
854 |
(advice-add 'tramp-sh-handle-start-file-process :around |
|
855 |
'tramp-sh-handle-start-file-process--magit-tramp-process-environment) |
|
856 |
|
|
857 |
(defun tramp-sh-handle-process-file--magit-tramp-process-environment |
|
858 |
(fn program &optional infile destination display &rest args) |
|
859 |
(if magit-tramp-process-environment |
|
860 |
(apply fn "env" infile destination display |
|
861 |
(append magit-tramp-process-environment |
|
862 |
(cons program args))) |
|
863 |
(apply fn program infile destination display args))) |
|
864 |
|
|
865 |
(advice-add 'tramp-sh-handle-process-file :around |
|
866 |
'tramp-sh-handle-process-file--magit-tramp-process-environment) |
|
867 |
|
|
868 |
(defvar magit-mode-line-process-map |
|
869 |
(let ((map (make-sparse-keymap))) |
|
870 |
(define-key map (kbd "<mode-line> <mouse-1>") |
|
871 |
'magit-process-buffer) |
|
872 |
map) |
|
873 |
"Keymap for `mode-line-process'.") |
|
874 |
|
|
875 |
(defun magit-process-set-mode-line (program args) |
|
876 |
"Display the git command (sans arguments) in the mode line." |
|
877 |
(when (equal program magit-git-executable) |
|
878 |
(setq args (nthcdr (length magit-git-global-arguments) args))) |
|
879 |
(let ((str (concat " " (propertize |
|
880 |
(concat (file-name-nondirectory program) |
|
881 |
(and args (concat " " (car args)))) |
|
882 |
'mouse-face 'highlight |
|
883 |
'keymap magit-mode-line-process-map |
|
884 |
'help-echo "mouse-1: Show process buffer" |
|
885 |
'face 'magit-mode-line-process)))) |
|
886 |
(magit-repository-local-set 'mode-line-process str) |
|
887 |
(dolist (buf (magit-mode-get-buffers)) |
|
888 |
(with-current-buffer buf |
|
889 |
(setq mode-line-process str))) |
|
890 |
(force-mode-line-update t))) |
|
891 |
|
|
892 |
(defun magit-process-set-mode-line-error-status (&optional error str) |
|
893 |
"Apply an error face to the string set by `magit-process-set-mode-line'. |
|
894 |
|
|
895 |
If ERROR is supplied, include it in the `mode-line-process' tooltip. |
|
896 |
|
|
897 |
If STR is supplied, it replaces the `mode-line-process' text." |
|
898 |
(setq str (or str (magit-repository-local-get 'mode-line-process))) |
|
899 |
(when str |
|
900 |
(setq error (format "%smouse-1: Show process buffer" |
|
901 |
(if (stringp error) |
|
902 |
(concat error "\n\n") |
|
903 |
""))) |
|
904 |
(setq str (concat " " (propertize |
|
905 |
(substring-no-properties str 1) |
|
906 |
'mouse-face 'highlight |
|
907 |
'keymap magit-mode-line-process-map |
|
908 |
'help-echo error |
|
909 |
'face 'magit-mode-line-process-error))) |
|
910 |
(magit-repository-local-set 'mode-line-process str) |
|
911 |
(dolist (buf (magit-mode-get-buffers)) |
|
912 |
(with-current-buffer buf |
|
913 |
(setq mode-line-process str))) |
|
914 |
(force-mode-line-update t) |
|
915 |
;; We remove any error status from the mode line when a magit |
|
916 |
;; buffer is refreshed (see `magit-refresh-buffer'), but we must |
|
917 |
;; ensure that we ignore any refreshes during the remainder of the |
|
918 |
;; current command -- otherwise a newly-set error status would be |
|
919 |
;; removed before it was seen. We set a flag which prevents the |
|
920 |
;; status from being removed prior to the next command, so that |
|
921 |
;; the error status is guaranteed to remain visible until then. |
|
922 |
(let ((repokey (magit-repository-local-repository))) |
|
923 |
;; The following closure captures the repokey value, and is |
|
924 |
;; added to `pre-command-hook'. |
|
925 |
(cl-labels ((enable-magit-process-unset-mode-line |
|
926 |
() ;; Remove ourself from the hook variable, so |
|
927 |
;; that we only run once. |
|
928 |
(remove-hook 'pre-command-hook |
|
929 |
#'enable-magit-process-unset-mode-line) |
|
930 |
;; Clear the inhibit flag for the repository in |
|
931 |
;; which we set it. |
|
932 |
(magit-repository-local-set |
|
933 |
'inhibit-magit-process-unset-mode-line nil repokey))) |
|
934 |
;; Set the inhibit flag until the next command is invoked. |
|
935 |
(magit-repository-local-set |
|
936 |
'inhibit-magit-process-unset-mode-line t repokey) |
|
937 |
(add-hook 'pre-command-hook |
|
938 |
#'enable-magit-process-unset-mode-line))))) |
|
939 |
|
|
940 |
(defun magit-process-unset-mode-line-error-status () |
|
941 |
"Remove any current error status from the mode line." |
|
942 |
(let ((status (or mode-line-process |
|
943 |
(magit-repository-local-get 'mode-line-process)))) |
|
944 |
(when (and status |
|
945 |
(eq (get-text-property 1 'face status) |
|
946 |
'magit-mode-line-process-error)) |
|
947 |
(magit-process-unset-mode-line)))) |
|
948 |
|
|
949 |
(defun magit-process-unset-mode-line () |
|
950 |
"Remove the git command from the mode line." |
|
951 |
(unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line) |
|
952 |
(magit-repository-local-set 'mode-line-process nil) |
|
953 |
(dolist (buf (magit-mode-get-buffers)) |
|
954 |
(with-current-buffer buf (setq mode-line-process nil))) |
|
955 |
(force-mode-line-update t))) |
|
956 |
|
|
957 |
(defvar magit-process-error-message-regexps |
|
958 |
(list "^\\*ERROR\\*: Canceled by user$" |
|
959 |
"^\\(?:error\\|fatal\\|git\\): \\(.*\\)$" |
|
960 |
"^\\(Cannot rebase:.*\\)$")) |
|
961 |
|
|
962 |
(define-error 'magit-git-error "Git error") |
|
963 |
|
|
964 |
(defun magit-process-error-summary (process-buf section) |
|
965 |
"A one-line error summary from the given SECTION." |
|
966 |
(or (and (buffer-live-p process-buf) |
|
967 |
(with-current-buffer process-buf |
|
968 |
(and (oref section content) |
|
969 |
(save-excursion |
|
970 |
(goto-char (oref section end)) |
|
971 |
(run-hook-wrapped |
|
972 |
'magit-process-error-message-regexps |
|
973 |
(lambda (re) |
|
974 |
(save-excursion |
|
975 |
(and (re-search-backward |
|
976 |
re (oref section start) t) |
|
977 |
(or (match-string-no-properties 1) |
|
978 |
(and (not magit-process-raise-error) |
|
979 |
'suppressed)))))))))) |
|
980 |
"Git failed")) |
|
981 |
|
|
982 |
(defun magit-process-error-tooltip (process-buf section) |
|
983 |
"Returns the text from SECTION of the PROCESS-BUF buffer. |
|
984 |
|
|
985 |
Limited by `magit-process-error-tooltip-max-lines'." |
|
986 |
(and (integerp magit-process-error-tooltip-max-lines) |
|
987 |
(> magit-process-error-tooltip-max-lines 0) |
|
988 |
(buffer-live-p process-buf) |
|
989 |
(with-current-buffer process-buf |
|
990 |
(save-excursion |
|
991 |
(goto-char (or (oref section content) |
|
992 |
(oref section start))) |
|
993 |
(buffer-substring-no-properties |
|
994 |
(point) |
|
995 |
(save-excursion |
|
996 |
(forward-line magit-process-error-tooltip-max-lines) |
|
997 |
(goto-char |
|
998 |
(if (> (point) (oref section end)) |
|
999 |
(oref section end) |
|
1000 |
(point))) |
|
1001 |
;; Remove any trailing whitespace. |
|
1002 |
(when (re-search-backward "[^[:space:]\n]" |
|
1003 |
(oref section start) t) |
|
1004 |
(forward-char 1)) |
|
1005 |
(point))))))) |
|
1006 |
|
|
1007 |
(defvar-local magit-this-error nil) |
|
1008 |
|
|
1009 |
(defvar magit-process-finish-apply-ansi-colors nil) |
|
1010 |
|
|
1011 |
(defun magit-process-finish (arg &optional process-buf command-buf |
|
1012 |
default-dir section) |
|
1013 |
(unless (integerp arg) |
|
1014 |
(setq process-buf (process-buffer arg)) |
|
1015 |
(setq command-buf (process-get arg 'command-buf)) |
|
1016 |
(setq default-dir (process-get arg 'default-dir)) |
|
1017 |
(setq section (process-get arg 'section)) |
|
1018 |
(setq arg (process-exit-status arg))) |
|
1019 |
(when (fboundp 'dired-uncache) |
|
1020 |
(dired-uncache default-dir)) |
|
1021 |
(when (buffer-live-p process-buf) |
|
1022 |
(with-current-buffer process-buf |
|
1023 |
(let ((inhibit-read-only t) |
|
1024 |
(marker (oref section start))) |
|
1025 |
(goto-char marker) |
|
1026 |
(save-excursion |
|
1027 |
(delete-char 3) |
|
1028 |
(set-marker-insertion-type marker nil) |
|
1029 |
(insert (propertize (format "%3s" arg) |
|
1030 |
'magit-section section |
|
1031 |
'face (if (= arg 0) |
|
1032 |
'magit-process-ok |
|
1033 |
'magit-process-ng))) |
|
1034 |
(set-marker-insertion-type marker t)) |
|
1035 |
(when magit-process-finish-apply-ansi-colors |
|
1036 |
(ansi-color-apply-on-region (oref section content) |
|
1037 |
(oref section end))) |
|
1038 |
(if (= (oref section end) |
|
1039 |
(+ (line-end-position) 2)) |
|
1040 |
(save-excursion |
|
1041 |
(goto-char (1+ (line-end-position))) |
|
1042 |
(delete-char -1) |
|
1043 |
(oset section content nil)) |
|
1044 |
(let ((buf (magit-process-buffer t))) |
|
1045 |
(when (and (= arg 0) |
|
1046 |
(not (--any-p (eq (window-buffer it) buf) |
|
1047 |
(window-list)))) |
|
1048 |
(magit-section-hide section))))))) |
|
1049 |
(if (= arg 0) |
|
1050 |
;; Unset the `mode-line-process' value upon success. |
|
1051 |
(magit-process-unset-mode-line) |
|
1052 |
;; Otherwise process the error. |
|
1053 |
(let ((msg (magit-process-error-summary process-buf section))) |
|
1054 |
;; Change `mode-line-process' to an error face upon failure. |
|
1055 |
(if magit-process-display-mode-line-error |
|
1056 |
(magit-process-set-mode-line-error-status |
|
1057 |
(or (magit-process-error-tooltip process-buf section) |
|
1058 |
msg)) |
|
1059 |
(magit-process-unset-mode-line)) |
|
1060 |
;; Either signal the error, or else display the error summary in |
|
1061 |
;; the status buffer and with a message in the echo area. |
|
1062 |
(cond |
|
1063 |
(magit-process-raise-error |
|
1064 |
(signal 'magit-git-error (list (format "%s (in %s)" msg default-dir)))) |
|
1065 |
((not (eq msg 'suppressed)) |
|
1066 |
(when (buffer-live-p process-buf) |
|
1067 |
(with-current-buffer process-buf |
|
1068 |
(when-let ((status-buf (magit-mode-get-buffer 'magit-status-mode))) |
|
1069 |
(with-current-buffer status-buf |
|
1070 |
(setq magit-this-error msg))))) |
|
1071 |
(message "%s ... [%s buffer %s for details]" msg |
|
1072 |
(if-let ((key (and (buffer-live-p command-buf) |
|
1073 |
(with-current-buffer command-buf |
|
1074 |
(car (where-is-internal |
|
1075 |
'magit-process-buffer)))))) |
|
1076 |
(format "Hit %s to see" (key-description key)) |
|
1077 |
"See") |
|
1078 |
(buffer-name process-buf)))))) |
|
1079 |
arg) |
|
1080 |
|
|
1081 |
(defun magit-process-display-buffer (process) |
|
1082 |
(when (process-live-p process) |
|
1083 |
(let ((buf (process-buffer process))) |
|
1084 |
(cond ((not (buffer-live-p buf))) |
|
1085 |
((= magit-process-popup-time 0) |
|
1086 |
(if (minibufferp) |
|
1087 |
(switch-to-buffer-other-window buf) |
|
1088 |
(pop-to-buffer buf))) |
|
1089 |
((> magit-process-popup-time 0) |
|
1090 |
(run-with-timer magit-process-popup-time nil |
|
1091 |
(lambda (p) |
|
1092 |
(when (eq (process-status p) 'run) |
|
1093 |
(let ((buf (process-buffer p))) |
|
1094 |
(when (buffer-live-p buf) |
|
1095 |
(if (minibufferp) |
|
1096 |
(switch-to-buffer-other-window buf) |
|
1097 |
(pop-to-buffer buf)))))) |
|
1098 |
process)))))) |
|
1099 |
|
|
1100 |
(defun magit--log-action (summary line list) |
|
1101 |
(let (heading lines) |
|
1102 |
(if (cdr list) |
|
1103 |
(progn (setq heading (funcall summary list)) |
|
1104 |
(setq lines (mapcar line list))) |
|
1105 |
(setq heading (funcall line (car list)))) |
|
1106 |
(with-current-buffer (magit-process-buffer t) |
|
1107 |
(goto-char (1- (point-max))) |
|
1108 |
(let ((inhibit-read-only t)) |
|
1109 |
(magit-insert-section (message) |
|
1110 |
(magit-insert-heading (concat " * " heading)) |
|
1111 |
(when lines |
|
1112 |
(dolist (line lines) |
|
1113 |
(insert line "\n")) |
|
1114 |
(insert "\n")))) |
|
1115 |
(let ((inhibit-message t)) |
|
1116 |
(when heading |
|
1117 |
(setq lines (cons heading lines))) |
|
1118 |
(message (mapconcat #'identity lines "\n")))))) |
|
1119 |
|
|
1120 |
;;; _ |
|
1121 |
(provide 'magit-process) |
|
1122 |
;;; magit-process.el ends here |