mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be
commit | author | age
5cb5f7 1 ;;; magit-utils.el --- various utilities  -*- lexical-binding: t; coding: utf-8 -*-
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 ;; Contains code from GNU Emacs https://www.gnu.org/software/emacs,
12 ;; released under the GNU General Public License version 3 or later.
13
14 ;; Magit is free software; you can redistribute it and/or modify it
15 ;; under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; any later version.
18 ;;
19 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
21 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
22 ;; License for more details.
23 ;;
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with Magit.  If not, see http://www.gnu.org/licenses.
26
27 ;;; Commentary:
28
29 ;; This library defines several utility functions used by several
30 ;; other libraries which cannot depend on one another (because
31 ;; circular dependencies are not good).  Luckily most (all) of these
32 ;; functions have very little (nothing) to do with Git, so we not only
33 ;; have to do this, it even makes sense.
34
35 ;; Unfortunately there are also some options which are used by several
36 ;; libraries which cannot depend on one another, they are defined here
37 ;; too.
38
39 ;;; Code:
40
41 (require 'cl-lib)
42 (require 'dash)
43
44 (eval-when-compile
45   (require 'subr-x))
46
47 (require 'crm)
48
49 (eval-when-compile (require 'ido))
50 (declare-function ido-completing-read+ "ido-completing-read+"
51                   (prompt collection &optional predicate
52                           require-match initial-input
53                           hist def inherit-input-method))
54 (declare-function Info-get-token "info" (pos start all &optional errorstring))
55
56 (eval-when-compile (require 'vc-git))
57 (declare-function vc-git--run-command-string "vc-git" (file &rest args))
58
59 (defvar magit-wip-before-change-mode)
60
61 (require 'magit-popup)
62
63 ;;; Options
64
65 (defcustom magit-completing-read-function 'magit-builtin-completing-read
66   "Function to be called when requesting input from the user.
67
68 If you have enabled `ivy-mode' or `helm-mode', then you don't
69 have to customize this option; `magit-builtin-completing-read'
70 will work just fine.  However, if you use Ido completion, then
71 you do have to use `magit-ido-completion-read', because Ido is
72 less well behaved than the former, more modern alternatives.
73
74 If you would like to use Ivy or Helm completion with Magit but
75 not enable the respective modes globally, then customize this
76 option to use `ivy-completing-read' or
77 `helm--completing-read-default'.  If you choose to use
78 `ivy-completing-read', note that the items may always be shown in
79 alphabetical order, depending on your version of Ivy."
80   :group 'magit-essentials
81   :type '(radio (function-item magit-builtin-completing-read)
82                 (function-item magit-ido-completing-read)
83                 (function-item ivy-completing-read)
84                 (function-item helm--completing-read-default)
85                 (function :tag "Other function")))
86
87 (defcustom magit-dwim-selection
88   '((magit-stash-apply        nil t)
89     (magit-stash-branch       nil t)
90     (magit-stash-branch-here  nil t)
91     (magit-stash-format-patch nil t)
92     (magit-stash-drop         nil ask)
93     (magit-stash-pop          nil ask)
94     (forge-browse-commit      nil t)
95     (forge-browse-branch      nil t)
96     (forge-browse-remote      nil t)
97     (forge-browse-issue       nil t)
98     (forge-browse-pullreq     nil t)
99     (forge-edit-topic-title   nil t)
100     (forge-edit-topic-labels  nil t)
101     (forge-edit-topic-assignees nil t)
102     (forge-visit-issue        nil t)
103     (forge-visit-pullreq      nil t))
104   "When not to offer alternatives and ask for confirmation.
105
106 Many commands by default ask the user to select from a list of
107 possible candidates.  They do so even when there is a thing at
108 point that they can act on, which is then offered as the default.
109
110 This option can be used to tell certain commands to use the thing
111 at point instead of asking the user to select a candidate to act
112 on, with or without confirmation.
113
114 The value has the form ((COMMAND nil|PROMPT DEFAULT)...).
115
116 - COMMAND is the command that should not prompt for a choice.
117   To have an effect, the command has to use the function
118   `magit-completing-read' or a utility function which in turn uses
119   that function.
120
121 - If the command uses `magit-completing-read' multiple times, then
122   PROMPT can be used to only affect one of these uses.  PROMPT, if
123   non-nil, is a regular expression that is used to match against
124   the PROMPT argument passed to `magit-completing-read'.
125
126 - DEFAULT specifies how to use the default.  If it is t, then
127   the DEFAULT argument passed to `magit-completing-read' is used
128   without confirmation.  If it is `ask', then the user is given
129   a chance to abort.  DEFAULT can also be nil, in which case the
130   entry has no effect."
131   :package-version '(magit . "2.12.0")
132   :group 'magit-commands
133   :type '(repeat
134           (list (symbol :tag "Command") ; It might not be fboundp yet.
135                 (choice (const  :tag "for all prompts" nil)
136                         (regexp :tag "for prompts matching regexp"))
137                 (choice (const  :tag "offer other choices" nil)
138                         (const  :tag "require confirmation" ask)
139                         (const  :tag "use default without confirmation" t)))))
140
141 (defconst magit--confirm-actions
142   '((const reverse)           (const discard)
143     (const rename)            (const resurrect)
144     (const untrack)           (const trash)
145     (const delete)            (const abort-rebase)
146     (const abort-merge)       (const merge-dirty)
147     (const drop-stashes)      (const reset-bisect)
148     (const kill-process)      (const delete-unmerged-branch)
149     (const delete-pr-branch)  (const remove-modules)
150     (const stage-all-changes) (const unstage-all-changes)
151     (const safe-with-wip)))
152
153 (defcustom magit-no-confirm nil
154   "A list of symbols for actions Magit should not confirm, or t.
155
156 Many potentially dangerous commands by default ask the user for
157 confirmation.  Each of the below symbols stands for an action
158 which, when invoked unintentionally or without being fully aware
159 of the consequences, could lead to tears.  In many cases there
160 are several commands that perform variations of a certain action,
161 so we don't use the command names but more generic symbols.
162
163 Applying changes:
164
165   `discard' Discarding one or more changes (i.e. hunks or the
166   complete diff for a file) loses that change, obviously.
167
168   `reverse' Reverting one or more changes can usually be undone
169   by reverting the reversion.
170
171   `stage-all-changes', `unstage-all-changes' When there are both
172   staged and unstaged changes, then un-/staging everything would
173   destroy that distinction.  Of course that also applies when
174   un-/staging a single change, but then less is lost and one does
175   that so often that having to confirm every time would be
176   unacceptable.
177
178 Files:
179
180   `delete' When a file that isn't yet tracked by Git is deleted
181   then it is completely lost, not just the last changes.  Very
182   dangerous.
183
184   `trash' Instead of deleting a file it can also be move to the
185   system trash.  Obviously much less dangerous than deleting it.
186
187   Also see option `magit-delete-by-moving-to-trash'.
188
189   `resurrect' A deleted file can easily be resurrected by
190   \"deleting\" the deletion, which is done using the same command
191   that was used to delete the same file in the first place.
192
193   `untrack' Untracking a file can be undone by tracking it again.
194
195   `rename' Renaming a file can easily be undone.
196
197 Sequences:
198
199   `reset-bisect' Aborting (known to Git as \"resetting\") a
200   bisect operation loses all information collected so far.
201
202   `abort-rebase' Aborting a rebase throws away all already
203   modified commits, but it's possible to restore those from the
204   reflog.
205
206   `abort-merge' Aborting a merge throws away all conflict
207   resolutions which has already been carried out by the user.
208
209   `merge-dirty' Merging with a dirty worktree can make it hard to
210   go back to the state before the merge was initiated.
211
212 References:
213
214   `delete-unmerged-branch' Once a branch has been deleted it can
215   only be restored using low-level recovery tools provided by
216   Git.  And even then the reflog is gone.  The user always has
217   to confirm the deletion of a branch by accepting the default
218   choice (or selecting another branch), but when a branch has
219   not been merged yet, also make sure the user is aware of that.
220
221   `delete-pr-branch' When deleting a branch that was created from
222   a pull request and if no other branches still exist on that
223   remote, then `magit-branch-delete' offers to delete the remote
224   as well.  This should be safe because it only happens if no
225   other refs exist in the remotes namespace, and you can recreate
226   the remote if necessary.
227
228   `drop-stashes' Dropping a stash is dangerous because Git stores
229   stashes in the reflog.  Once a stash is removed, there is no
230   going back without using low-level recovery tools provided by
231   Git.  When a single stash is dropped, then the user always has
232   to confirm by accepting the default (or selecting another).
233   This action only concerns the deletion of multiple stashes at
234   once.
235
236 Edit published history:
237
238   Without adding these symbols here, you will be warned before
239   editing commits that have already been pushed to one of the
240   branches listed in `magit-published-branches'.
241
242   `amend-published' Affects most commands that amend to \"HEAD\".
243
244   `rebase-published' Affects commands that perform interactive
245   rebases.  This includes commands from the commit popup that
246   modify a commit other than \"HEAD\", namely the various fixup
247   and squash variants.
248
249   `edit-published' Affects the commands `magit-edit-line-commit'
250   and `magit-diff-edit-hunk-commit'.  These two commands make
251   it quite easy to accidentally edit a published commit, so you
252   should think twice before configuring them not to ask for
253   confirmation.
254
255   To disable confirmation completely, add all three symbols here
256   or set `magit-published-branches' to nil.
257
258 Removing modules:
259
260   `remove-modules' When you remove the working directory of a
261   module that does not contain uncommitted changes, then that is
262   safer than doing so when there are uncommitted changes and/or
263   when you also remove the gitdir.  Still, you don't want to do
264   that by accident.
265
266   `remove-dirty-modules' When you remove the working directory of
267   a module that contains uncommitted changes, then those changes
268   are gone for good.  It is better to go to the module, inspect
269   these changes and only if appropriate discard them manually.
270
271   `trash-module-gitdirs' When you remove the gitdir of a module,
272   then all unpushed changes are gone for good.  It is very easy
273   to forget that you have some unfinished work on an unpublished
274   feature branch or even in a stash.
275
276   Actually there are some safety precautions in place, that might
277   help you out if you make an unwise choice here, but don't count
278   on it.  In case of emergency, stay calm and check the stash and
279   the `trash-directory' for traces of lost work.
280
281 Various:
282
283   `kill-process' There seldom is a reason to kill a process.
284
285 Global settings:
286
287   Instead of adding all of the above symbols to the value of this
288   option you can also set it to the atom `t', which has the same
289   effect as adding all of the above symbols.  Doing that most
290   certainly is a bad idea, especially because other symbols might
291   be added in the future.  So even if you don't want to be asked
292   for confirmation for any of these actions, you are still better
293   of adding all of the respective symbols individually.
294
295   When `magit-wip-before-change-mode' is enabled then these actions
296   can fairly easily be undone: `discard', `reverse',
297   `stage-all-changes', and `unstage-all-changes'.  If and only if
298   this mode is enabled, then `safe-with-wip' has the same effect
299   as adding all of these symbols individually."
300   :package-version '(magit . "2.1.0")
301   :group 'magit-essentials
302   :group 'magit-commands
303   :type `(choice (const :tag "Always require confirmation" nil)
304                  (const :tag "Never require confirmation" t)
305                  (set   :tag "Require confirmation except for"
306                         ;; `remove-dirty-modules' and
307                         ;; `trash-module-gitdirs' intentionally
308                         ;; omitted.
309                         ,@magit--confirm-actions)))
310
311 (defcustom magit-slow-confirm '(drop-stashes)
312   "Whether to ask user \"y or n\" or \"yes or no\" questions.
313
314 When this is nil, then `y-or-n-p' is used when the user has to
315 confirm a potentially destructive action.  When this is t, then
316 `yes-or-no-p' is used instead.  If this is a list of symbols
317 identifying actions, then `yes-or-no-p' is used for those,
318 `y-or-no-p' for all others.  The list of actions is the same as
319 for `magit-no-confirm' (which see)."
320   :package-version '(magit . "2.9.0")
321   :group 'magit-miscellaneous
322   :type `(choice (const :tag "Always ask \"yes or no\" questions" t)
323                  (const :tag "Always ask \"y or n\" questions" nil)
324                  (set   :tag "Ask \"yes or no\" questions only for"
325                         ,@magit--confirm-actions)))
326
327 (defcustom magit-no-message nil
328   "A list of messages Magit should not display.
329
330 Magit displays most echo area messages using `message', but a few
331 are displayed using `magit-message' instead, which takes the same
332 arguments as the former, FORMAT-STRING and ARGS.  `magit-message'
333 forgoes printing a message if any member of this list is a prefix
334 of the respective FORMAT-STRING.
335
336 If Magit prints a message which causes you grief, then please
337 first investigate whether there is another option which can be
338 used to suppress it.  If that is not the case, then ask the Magit
339 maintainers to start using `magit-message' instead of `message'
340 in that case.  We are not proactively replacing all uses of
341 `message' with `magit-message', just in case someone *might* find
342 some of these messages useless.
343
344 Messages which can currently be suppressed using this option are:
345 * \"Turning on magit-auto-revert-mode...\""
346   :package-version '(magit . "2.8.0")
347   :group 'magit-miscellaneous
348   :type '(repeat string))
349
350 (defcustom magit-ellipsis ?…
351   "Character used to abbreviate text.
352
353 Currently this is used to abbreviate author names in the margin
354 and in process buffers to elide `magit-git-global-arguments'."
355   :package-version '(magit . "2.1.0")
356   :group 'magit-miscellaneous
357   :type 'character)
358
359 (defcustom magit-update-other-window-delay 0.2
360   "Delay before automatically updating the other window.
361
362 When moving around in certain buffers, then certain other
363 buffers, which are being displayed in another window, may
364 optionally be updated to display information about the
365 section at point.
366
367 When holding down a key to move by more than just one section,
368 then that would update that buffer for each section on the way.
369 To prevent that, updating the revision buffer is delayed, and
370 this option controls for how long.  For optimal experience you
371 might have to adjust this delay and/or the keyboard repeat rate
372 and delay of your graphical environment or operating system."
373   :package-version '(magit . "2.3.0")
374   :group 'magit-miscellaneous
375   :type 'number)
376
377 (defcustom magit-view-git-manual-method 'info
378   "How links to Git documentation are followed from Magit's Info manuals.
379
380 `info'  Follow the link to the node in the `gitman' Info manual
381         as usual.  Unfortunately that manual is not installed by
382         default on some platforms, and when it is then the nodes
383         look worse than the actual manpages.
384
385 `man'   View the respective man-page using the `man' package.
386
387 `woman' View the respective man-page using the `woman' package."
388   :package-version '(magit . "2.9.0")
389   :group 'magit-miscellaneous
390   :type '(choice (const :tag "view info manual" info)
391                  (const :tag "view manpage using `man'" man)
392                  (const :tag "view manpage using `woman'" woman)))
393
394 ;;; User Input
395
396 (defvar helm-completion-in-region-default-sort-fn)
397 (defvar ivy-sort-functions-alist)
398
399 (defvar magit-completing-read--silent-default nil)
400
401 (defun magit-completing-read (prompt collection &optional
402                                      predicate require-match initial-input
403                                      hist def fallback)
404   "Read a choice in the minibuffer, or use the default choice.
405
406 This is the function that Magit commands use when they need the
407 user to select a single thing to act on.  The arguments have the
408 same meaning as for `completing-read', except for FALLBACK, which
409 is unique to this function and is described below.
410
411 Instead of asking the user to choose from a list of possible
412 candidates, this function may instead just return the default
413 specified by DEF, with or without requiring user confirmation.
414 Whether that is the case depends on PROMPT, `this-command' and
415 `magit-dwim-selection'.  See the documentation of the latter for
416 more information.
417
418 If it does use the default without the user even having to
419 confirm that, then `magit-completing-read--silent-default' is set
420 to t, otherwise nil.
421
422 If it does read a value in the minibuffer, then this function
423 acts similarly to `completing-read', except for the following:
424
425 - If REQUIRE-MATCH is nil and the user exits without a choice,
426   then nil is returned instead of an empty string.
427
428 - If REQUIRE-MATCH is non-nil and the users exits without a
429   choice, an user-error is raised.
430
431 - FALLBACK specifies a secondary default that is only used if
432   the primary default DEF is nil.  The secondary default is not
433   subject to `magit-dwim-selection' â€” if DEF is nil but FALLBACK
434   is not, then this function always asks the user to choose a
435   candidate, just as if both defaults were nil.
436
437 - \": \" is appended to PROMPT.
438
439 - PROMPT is modified to end with \" (default DEF|FALLBACK): \"
440   provided that DEF or FALLBACK is non-nil, that neither
441   `ivy-mode' nor `helm-mode' is enabled, and that
442   `magit-completing-read-function' is set to its default value of
443   `magit-builtin-completing-read'."
444   (setq magit-completing-read--silent-default nil)
445   (if-let ((dwim (and def
446                       (nth 2 (-first (pcase-lambda (`(,cmd ,re ,_))
447                                        (and (eq this-command cmd)
448                                             (or (not re)
449                                                 (string-match-p re prompt))))
450                                      magit-dwim-selection)))))
451       (if (eq dwim 'ask)
452           (if (y-or-n-p (format "%s %s? " prompt def))
453               def
454             (user-error "Abort"))
455         (setq magit-completing-read--silent-default t)
456         def)
457     (unless def
458       (setq def fallback))
459     (let ((command this-command)
460           (reply (funcall magit-completing-read-function
461                           (concat prompt ": ")
462                           (if (and def (not (member def collection)))
463                               (cons def collection)
464                             collection)
465                           predicate
466                           require-match initial-input hist def)))
467       (setq this-command command)
468       (if (string= reply "")
469           (if require-match
470               (user-error "Nothing selected")
471             nil)
472         reply))))
473
474 (defun magit--completion-table (collection)
475   (lambda (string pred action)
476     (if (eq action 'metadata)
477         '(metadata (display-sort-function . identity))
478       (complete-with-action action collection string pred))))
479
480 (defun magit-builtin-completing-read
481   (prompt choices &optional predicate require-match initial-input hist def)
482   "Magit wrapper for standard `completing-read' function."
483   (unless (or (bound-and-true-p helm-mode)
484               (bound-and-true-p ivy-mode))
485     (setq prompt (magit-prompt-with-default prompt def))
486     (setq choices (magit--completion-table choices)))
487   (cl-letf (((symbol-function 'completion-pcm--all-completions)
488              #'magit-completion-pcm--all-completions))
489     (let ((ivy-sort-functions-alist nil))
490       (completing-read prompt choices
491                        predicate require-match
492                        initial-input hist def))))
493
494 (defun magit-completing-read-multiple
495   (prompt choices &optional sep default hist keymap)
496   "Read multiple items from CHOICES, separated by SEP.
497
498 Set up the `crm' variables needed to read multiple values with
499 `read-from-minibuffer'.
500
501 SEP is a regexp matching characters that can separate choices.
502 When SEP is nil, it defaults to `crm-default-separator'.
503 DEFAULT, HIST, and KEYMAP are passed to `read-from-minibuffer'.
504 When KEYMAP is nil, it defaults to `crm-local-completion-map'.
505
506 Unlike `completing-read-multiple', the return value is not split
507 into a list."
508   (let* ((crm-separator (or sep crm-default-separator))
509          (crm-completion-table (magit--completion-table choices))
510          (choose-completion-string-functions
511           '(crm--choose-completion-string))
512          (minibuffer-completion-table #'crm--collection-fn)
513          (minibuffer-completion-confirm t)
514          (helm-completion-in-region-default-sort-fn nil)
515          (input
516           (cl-letf (((symbol-function 'completion-pcm--all-completions)
517                      #'magit-completion-pcm--all-completions))
518             (read-from-minibuffer
519              (concat prompt (and default (format " (%s)" default)) ": ")
520              nil (or keymap crm-local-completion-map)
521              nil hist default))))
522     (when (string-equal input "")
523       (or (setq input default)
524           (user-error "Nothing selected")))
525     input))
526
527 (defun magit-completing-read-multiple*
528     (prompt table &optional predicate require-match initial-input
529         hist def inherit-input-method)
530   "Read multiple strings in the minibuffer, with completion.
531 Like `completing-read-multiple' but don't mess with order of
532 TABLE.  Also bind `helm-completion-in-region-default-sort-fn'
533 to nil."
534   (unwind-protect
535       (cl-letf (((symbol-function 'completion-pcm--all-completions)
536                  #'magit-completion-pcm--all-completions))
537         (add-hook 'choose-completion-string-functions
538                   'crm--choose-completion-string)
539         (let* ((minibuffer-completion-table #'crm--collection-fn)
540                (minibuffer-completion-predicate predicate)
541                ;; see completing_read in src/minibuf.c
542                (minibuffer-completion-confirm
543                 (unless (eq require-match t) require-match))
544                (crm-completion-table (magit--completion-table table))
545                (map (if require-match
546                         crm-local-must-match-map
547                       crm-local-completion-map))
548                (helm-completion-in-region-default-sort-fn nil)
549                ;; If the user enters empty input, `read-from-minibuffer'
550                ;; returns the empty string, not DEF.
551                (input (read-from-minibuffer
552                        prompt initial-input map
553                        nil hist def inherit-input-method)))
554           (and def (string-equal input "") (setq input def))
555           ;; Remove empty strings in the list of read strings.
556           (split-string input crm-separator t)))
557     (remove-hook 'choose-completion-string-functions
558                  'crm--choose-completion-string)))
559
560 (defun magit-ido-completing-read
561   (prompt choices &optional predicate require-match initial-input hist def)
562   "Ido-based `completing-read' almost-replacement.
563
564 Unfortunately `ido-completing-read' is not suitable as a
565 drop-in replacement for `completing-read', instead we use
566 `ido-completing-read+' from the third-party package by the
567 same name."
568   (if (require 'ido-completing-read+ nil t)
569       (ido-completing-read+ prompt choices predicate require-match
570                             initial-input hist def)
571     (display-warning 'magit "ido-completing-read+ is not installed
572
573 To use Ido completion with Magit you need to install the
574 third-party `ido-completing-read+' packages.  Falling
575 back to built-in `completing-read' for now." :error)
576     (magit-builtin-completing-read prompt choices predicate require-match
577                                    initial-input hist def)))
578
579 (defun magit-prompt-with-default (prompt def)
580   (if (and def (> (length prompt) 2)
581            (string-equal ": " (substring prompt -2)))
582       (format "%s (default %s): " (substring prompt 0 -2) def)
583     prompt))
584
585 (defvar magit-minibuffer-local-ns-map
586   (let ((map (make-sparse-keymap)))
587     (set-keymap-parent map minibuffer-local-map)
588     (define-key map "\s" 'magit-whitespace-disallowed)
589     (define-key map "\t" 'magit-whitespace-disallowed)
590     map))
591
592 (defun magit-whitespace-disallowed ()
593   "Beep to tell the user that whitespace is not allowed."
594   (interactive)
595   (ding)
596   (message "Whitespace isn't allowed here")
597   (setq defining-kbd-macro nil)
598   (force-mode-line-update))
599
600 (defun magit-read-string (prompt &optional initial-input history default-value
601                                  inherit-input-method no-whitespace)
602   "Read a string from the minibuffer, prompting with string PROMPT.
603
604 This is similar to `read-string', but
605 * empty input is only allowed if DEFAULT-VALUE is non-nil in
606   which case that is returned,
607 * whitespace is not allowed and leading and trailing whitespace is
608   removed automatically if NO-WHITESPACE is non-nil,
609 * \": \" is appended to PROMPT, and
610 * an invalid DEFAULT-VALUE is silently ignored."
611   (when default-value
612     (when (consp default-value)
613       (setq default-value (car default-value)))
614     (unless (stringp default-value)
615       (setq default-value nil)))
616   (let* ((minibuffer-completion-table nil)
617          (val (read-from-minibuffer
618                (magit-prompt-with-default (concat prompt ": ") default-value)
619                initial-input (and no-whitespace magit-minibuffer-local-ns-map)
620                nil history default-value inherit-input-method))
621          (trim (lambda (regexp string)
622                  (save-match-data
623                    (if (string-match regexp string)
624                        (replace-match "" t t string)
625                      string)))))
626     (when (and (string= val "") default-value)
627       (setq val default-value))
628     (when no-whitespace
629       (setq val (funcall trim "\\`\\(?:[ \t\n\r]+\\)"
630                          (funcall trim "\\(?:[ \t\n\r]+\\)\\'" val))))
631     (cond ((string= val "")
632            (user-error "Need non-empty input"))
633           ((and no-whitespace (string-match-p "[\s\t\n]" val))
634            (user-error "Input contains whitespace"))
635           (t val))))
636
637 (defun magit-read-string-ns (prompt &optional initial-input history
638                                     default-value inherit-input-method)
639   "Call `magit-read-string' with non-nil NO-WHITESPACE."
640   (magit-read-string prompt initial-input history default-value
641                      inherit-input-method t))
642
643 (defmacro magit-read-char-case (prompt verbose &rest clauses)
644   (declare (indent 2)
645            (debug (form form &rest (characterp form body))))
646   `(pcase (read-char-choice
647            (concat ,prompt
648                    ,(concat (mapconcat 'cadr clauses ", ")
649                             (and verbose ", or [C-g] to abort") " "))
650            ',(mapcar 'car clauses))
651      ,@(--map `(,(car it) ,@(cddr it)) clauses)))
652
653 (defun magit-y-or-n-p (prompt &optional action)
654   "Ask user a \"y or n\" or a \"yes or no\" question using PROMPT.
655 Which kind of question is used depends on whether
656 ACTION is a member of option `magit-slow-confirm'."
657   (if (or (eq magit-slow-confirm t)
658           (and action (member action magit-slow-confirm)))
659       (yes-or-no-p prompt)
660     (y-or-n-p prompt)))
661
662 (defvar magit--no-confirm-alist
663   '((safe-with-wip magit-wip-before-change-mode
664                    discard reverse stage-all-changes unstage-all-changes)))
665
666 (cl-defun magit-confirm (action &optional prompt prompt-n noabort
667                                 (items nil sitems))
668   (declare (indent defun))
669   (setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items)))
670   (setq prompt   (format (concat (or prompt (magit-confirm-make-prompt action))
671                                  "? ")
672                          (car items)))
673   (or (cond ((and (not (eq action t))
674                   (or (eq magit-no-confirm t)
675                       (memq action magit-no-confirm)
676                       (cl-member-if (pcase-lambda (`(,key ,var . ,sub))
677                                       (and (memq key magit-no-confirm)
678                                            (memq action sub)
679                                            (or (not var)
680                                                (and (boundp var)
681                                                     (symbol-value var)))))
682                                     magit--no-confirm-alist)))
683              (or (not sitems) items))
684             ((not sitems)
685              (magit-y-or-n-p prompt action))
686             ((= (length items) 1)
687              (and (magit-y-or-n-p prompt action) items))
688             ((> (length items) 1)
689              (and (magit-y-or-n-p (concat (mapconcat #'identity items "\n")
690                                           "\n\n" prompt-n)
691                                   action)
692                   items)))
693       (if noabort nil (user-error "Abort"))))
694
695 (defun magit-confirm-files (action files &optional prompt)
696   (when files
697     (unless prompt
698       (setq prompt (magit-confirm-make-prompt action)))
699     (magit-confirm action
700       (concat prompt " %s")
701       (concat prompt " %i files")
702       nil files)))
703
704 (defun magit-confirm-make-prompt (action)
705   (let ((prompt (symbol-name action)))
706     (replace-regexp-in-string
707      "-" " " (concat (upcase (substring prompt 0 1)) (substring prompt 1)))))
708
709 (defun magit-read-number-string (prompt &optional default)
710   "Like `read-number' but return value is a string.
711 DEFAULT may be a number or a numeric string."
712   (number-to-string
713    (read-number prompt (if (stringp default)
714                            (string-to-number default)
715                          default))))
716
717 ;;; Debug Utilities
718
719 ;;;###autoload
720 (defun magit-emacs-Q-command ()
721   "Show a shell command that runs an uncustomized Emacs with only Magit loaded.
722 See info node `(magit)Debugging Tools' for more information."
723   (interactive)
724   (let ((cmd (mapconcat
725               #'shell-quote-argument
726               `(,(concat invocation-directory invocation-name)
727                 "-Q" "--eval" "(setq debug-on-error t)"
728                 ,@(cl-mapcan
729                    (lambda (dir) (list "-L" dir))
730                    (delete-dups
731                     (cl-mapcan
732                      (lambda (lib)
733                        (let ((path (locate-library lib)))
734                          (cond
735                           (path
736                            (list (file-name-directory path)))
737                           ((not (member lib '("lv" "transient")))
738                            (error "Cannot find mandatory dependency %s" lib)))))
739                      '(;; Like `LOAD_PATH' in `default.mk'.
740                        "dash"
741                        "ghub"
742                        "graphql"
743                        "lv"
744                        "magit-popup"
745                        "transient"
746                        "treepy"
747                        "with-editor"
748                        ;; Obviously `magit' itself is needed too.
749                        "magit"
750                        ;; While this is part of the Magit repository,
751                        ;; it is distributed as a separate package.
752                        "git-commit"
753                        ;; Even though `async' is a dependency of the
754                        ;; `magit' package, it is not required here.
755                        ))))
756                 ;; Avoid Emacs bug#16406 by using full path.
757                 "-l" ,(file-name-sans-extension (locate-library "magit")))
758               " ")))
759     (message "Uncustomized Magit command saved to kill-ring, %s"
760              "please run it in a terminal.")
761     (kill-new cmd)))
762
763 ;;; Text Utilities
764
765 (defmacro magit-bind-match-strings (varlist string &rest body)
766   "Bind variables to submatches according to VARLIST then evaluate BODY.
767 Bind the symbols in VARLIST to submatches of the current match
768 data, starting with 1 and incrementing by 1 for each symbol.  If
769 the last match was against a string, then that has to be provided
770 as STRING."
771   (declare (indent 2) (debug (listp form body)))
772   (let ((s (cl-gensym "string"))
773         (i 0))
774     `(let ((,s ,string))
775        (let ,(save-match-data
776                (--map (list it (list 'match-string (cl-incf i) s)) varlist))
777          ,@body))))
778
779 (defun magit-delete-line ()
780   "Delete the rest of the current line."
781   (delete-region (point) (1+ (line-end-position))))
782
783 (defun magit-delete-match (&optional num)
784   "Delete text matched by last search.
785 If optional NUM is specified, only delete that subexpression."
786   (delete-region (match-beginning (or num 0))
787                  (match-end (or num 0))))
788
789 (defun magit-file-line (file)
790   "Return the first line of FILE as a string."
791   (when (file-regular-p file)
792     (with-temp-buffer
793       (insert-file-contents file)
794       (buffer-substring-no-properties (point-min)
795                                       (line-end-position)))))
796
797 (defun magit-file-lines (file &optional keep-empty-lines)
798   "Return a list of strings containing one element per line in FILE.
799 Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines."
800   (when (file-regular-p file)
801     (with-temp-buffer
802       (insert-file-contents file)
803       (split-string (buffer-string) "\n" (not keep-empty-lines)))))
804
805 (defun magit-set-header-line-format (string)
806   "Set the header-line using STRING.
807 Propertize STRING with the `magit-header-line' face if no face is
808 present, and pad the left and right sides of STRING equally such
809 that it will align with the text area."
810   (let* ((header-line
811           (concat (propertize " "
812                               'display
813                               '(space :align-to 0))
814                   string
815                   (propertize
816                    " "
817                    'display
818                    `(space :width (+ left-fringe
819                                      left-margin
820                                      ,@(and (eq (car (window-current-scroll-bars))
821                                                 'left)
822                                             '(scroll-bar)))))))
823          (len (length header-line)))
824     (setq header-line-format
825           (if (text-property-not-all 0 len 'face nil header-line)
826               (let ((face (get-text-property 0 'face string)))
827                 (when (and (atom face)
828                            (magit-face-property-all face string))
829                   (add-face-text-property 0 1 face nil header-line)
830                   (add-face-text-property (1- len) len face nil header-line))
831                 header-line)
832             (propertize header-line
833                         'face
834                         'magit-header-line)))))
835
836 (defun magit-face-property-all (face string)
837   "Return non-nil if FACE is present in all of STRING."
838   (cl-loop for pos = 0 then (next-single-property-change pos 'face string)
839            unless pos
840              return t
841            for current = (get-text-property pos 'face string)
842            unless (if (consp current)
843                       (memq face current)
844                     (eq face current))
845              return nil))
846
847 (defun magit--format-spec (format specification)
848   "Like `format-spec' but preserve text properties in SPECIFICATION."
849   (with-temp-buffer
850     (insert format)
851     (goto-char (point-min))
852     (while (search-forward "%" nil t)
853       (cond
854        ;; Quoted percent sign.
855        ((eq (char-after) ?%)
856         (delete-char 1))
857        ;; Valid format spec.
858        ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
859         (let* ((num (match-string 1))
860                (spec (string-to-char (match-string 2)))
861                (val (assq spec specification)))
862           (unless val
863             (error "Invalid format character: `%%%c'" spec))
864           (setq val (cdr val))
865           ;; Pad result to desired length.
866           (let ((text (format (concat "%" num "s") val)))
867             ;; Insert first, to preserve text properties.
868             (if (next-property-change 0 (concat " " text))
869                 ;; If the inserted text has properties, then preserve those.
870                 (insert text)
871               ;; Otherwise preserve FORMAT's properties, like `format-spec'.
872               (insert-and-inherit text))
873             ;; Delete the specifier body.
874             (delete-region (+ (match-beginning 0) (length text))
875                            (+ (match-end 0) (length text)))
876             ;; Delete the percent sign.
877             (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
878        ;; Signal an error on bogus format strings.
879        (t
880         (error "Invalid format string"))))
881     (buffer-string)))
882
883 ;;; Missing from Emacs
884
885 (defun magit-kill-this-buffer ()
886   "Kill the current buffer."
887   (interactive)
888   (kill-buffer (current-buffer)))
889
890 ;;; Kludges for Emacs Bugs
891
892 (defun magit-file-accessible-directory-p (filename)
893   "Like `file-accessible-directory-p' but work around an Apple bug.
894 See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=21573#17
895 and https://github.com/magit/magit/issues/2295."
896   (and (file-directory-p filename)
897        (file-accessible-directory-p filename)))
898
899 (when (version<= "25.1" emacs-version)
900   (with-eval-after-load 'vc-git
901     (defun vc-git-conflicted-files (directory)
902       "Return the list of files with conflicts in DIRECTORY."
903       (let* ((status
904               (vc-git--run-command-string directory "diff-files"
905                                           "--name-status"))
906              (lines (when status (split-string status "\n" 'omit-nulls)))
907              files)
908         (dolist (line lines files)
909           (when (string-match "\\([ MADRCU?!]\\)[ \t]+\\(.+\\)" line)
910             (let ((state (match-string 1 line))
911                   (file (match-string 2 line)))
912               (when (equal state "U")
913                 (push (expand-file-name file directory) files)))))))))
914
915 (when (< emacs-major-version 27)
916   (defun vc-git--call@bug21559 (fn buffer command &rest args)
917     "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
918     (let ((process-environment process-environment))
919       (when revert-buffer-in-progress-p
920         (push "GIT_OPTIONAL_LOCKS=0" process-environment))
921       (apply fn buffer command args)))
922   (advice-add 'vc-git--call :around 'vc-git--call@bug21559)
923
924   (defun vc-git-command@bug21559
925       (fn buffer okstatus file-or-list &rest flags)
926     "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
927     (let ((process-environment process-environment))
928       (when revert-buffer-in-progress-p
929         (push "GIT_OPTIONAL_LOCKS=0" process-environment))
930       (apply fn buffer okstatus file-or-list flags)))
931   (advice-add 'vc-git-command :around 'vc-git-command@bug21559)
932
933   (defun auto-revert-handler@bug21559 (fn)
934     "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
935     (let ((revert-buffer-in-progress-p t))
936       (funcall fn)))
937   (advice-add 'auto-revert-handler :around 'auto-revert-handler@bug21559)
938   )
939
940 ;; `completion-pcm--all-completions' reverses the completion list.  To
941 ;; preserve the order of our pre-sorted completions, we'll temporarily
942 ;; override it with the function below.  bug#24676
943 (defun magit-completion-pcm--all-completions (prefix pattern table pred)
944   (if (completion-pcm--pattern-trivial-p pattern)
945       (all-completions (concat prefix (car pattern)) table pred)
946     (let* ((regex (completion-pcm--pattern->regex pattern))
947            (case-fold-search completion-ignore-case)
948            (completion-regexp-list (cons regex completion-regexp-list))
949            (compl (all-completions
950                    (concat prefix
951                            (if (stringp (car pattern)) (car pattern) ""))
952                    table pred)))
953       (if (not (functionp table))
954           compl
955         (let ((poss ()))
956           (dolist (c compl)
957             (when (string-match-p regex c) (push c poss)))
958           ;; This `nreverse' call is the only code change made to the
959           ;; `completion-pcm--all-completions' that shipped with Emacs 25.1.
960           (nreverse poss))))))
961
962 ;;; Kludges for Incompatible Modes
963
964 (defvar whitespace-mode)
965
966 (defun whitespace-dont-turn-on-in-magit-mode (fn)
967   "Prevent `whitespace-mode' from being turned on in Magit buffers.
968
969 Because `whitespace-mode' uses font-lock and Magit does not, they
970 are not compatible.  Therefore you cannot turn on that minor-mode
971 in Magit buffers.  If you try to enable it anyway, then this
972 advice prevents that.
973
974 If the reason the attempt is made is that `global-whitespace-mode'
975 is enabled, then that is done silently.  However if you call the local
976 minor-mode interactively, then that results in an error.
977
978 See `magit-diff-paint-whitespace' for an alternative."
979   (if (not (derived-mode-p 'magit-mode))
980       (funcall fn)
981     (setq whitespace-mode nil)
982     (when (eq this-command 'whitespace-mode)
983       (user-error
984        "Whitespace mode NOT enabled because it is not compatible with Magit"))))
985
986 (advice-add 'whitespace-turn-on :around
987             'whitespace-dont-turn-on-in-magit-mode)
988
989 ;;; Kludges for Custom
990
991 (defun magit-custom-initialize-reset (symbol exp)
992   "Initialize SYMBOL based on EXP.
993 Set the symbol, using `set-default' (unlike
994 `custom-initialize-reset' which uses the `:set' function if any.)
995 The value is either the symbol's current value
996  (as obtained using the `:get' function), if any,
997 or the value in the symbol's `saved-value' property if any,
998 or (last of all) the value of EXP."
999   (set-default-toplevel-value
1000    symbol
1001    (condition-case nil
1002        (let ((def (default-toplevel-value symbol))
1003              (getter (get symbol 'custom-get)))
1004          (if getter (funcall getter symbol) def))
1005      (error
1006       (eval (let ((sv (get symbol 'saved-value)))
1007               (if sv (car sv) exp)))))))
1008
1009 (defun magit-hook-custom-get (symbol)
1010   (if (symbol-file symbol 'defvar)
1011       (default-toplevel-value symbol)
1012     ;;
1013     ;; Called by `custom-initialize-reset' on behalf of `symbol's
1014     ;; `defcustom', which is being evaluated for the first time to
1015     ;; set the initial value, but there's already a default value,
1016     ;; which most likely was established by one or more `add-hook'
1017     ;; calls.
1018     ;;
1019     ;; We combine the `standard-value' and the current value, while
1020     ;; preserving the order established by `:options', and return
1021     ;; the result of that to be used as the "initial" default value.
1022     ;;
1023     (let ((standard (eval (car (get symbol 'standard-value))))
1024           (current (default-toplevel-value symbol))
1025           (value nil))
1026       (dolist (fn (get symbol 'custom-options))
1027         (when (or (memq fn standard)
1028                   (memq fn current))
1029           (push fn value)))
1030       (dolist (fn current)
1031         (unless (memq fn value)
1032           (push fn value)))
1033       (nreverse value))))
1034
1035 ;;; Kludges for Info Manuals
1036
1037 ;;;###autoload
1038 (defun Info-follow-nearest-node--magit-gitman (fn &optional fork)
1039   (if magit-view-git-manual-method
1040       (let ((node (Info-get-token
1041                    (point) "\\*note[ \n\t]+"
1042                    "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")))
1043         (if (and node (string-match "^(gitman)\\(.+\\)" node))
1044             (pcase magit-view-git-manual-method
1045               (`man   (require 'man)
1046                       (man (match-string 1 node)))
1047               (`woman (require 'woman)
1048                       (woman (match-string 1 node)))
1049               (_
1050                (user-error "Invalid value for `magit-view-git-documentation'")))
1051           (funcall fn fork)))
1052     (funcall fn fork)))
1053
1054 ;;;###autoload
1055 (advice-add 'Info-follow-nearest-node :around
1056             'Info-follow-nearest-node--magit-gitman)
1057
1058 ;;;###autoload
1059 (defun org-man-export--magit-gitman (fn link description format)
1060   (if (and (eq format 'texinfo)
1061            (string-match-p "\\`git" link))
1062       (replace-regexp-in-string "%s" link "
1063 @ifinfo
1064 @ref{%s,,,gitman,}.
1065 @end ifinfo
1066 @ifhtml
1067 @html
1068 the <a href=\"http://git-scm.com/docs/%s\">%s(1)</a> manpage.
1069 @end html
1070 @end ifhtml
1071 @iftex
1072 the %s(1) manpage.
1073 @end iftex
1074 ")
1075     (funcall fn link description format)))
1076
1077 ;;;###autoload
1078 (advice-add 'org-man-export :around
1079             'org-man-export--magit-gitman)
1080
1081 ;;; Miscellaneous
1082
1083 (defun magit-message (format-string &rest args)
1084   "Display a message at the bottom of the screen, or not.
1085 Like `message', except that if the users configured option
1086 `magit-no-message' to prevent the message corresponding to
1087 FORMAT-STRING to be displayed, then don't."
1088   (unless (--first (string-prefix-p it format-string) magit-no-message)
1089     (apply #'message format-string args)))
1090
1091 (defun magit-msg (format-string &rest args)
1092   "Display a message at the bottom of the screen, but don't log it.
1093 Like `message', except that `message-log-max' is bound to nil."
1094   (let ((message-log-max nil))
1095     (apply #'message format-string args)))
1096
1097 ;;; _
1098 (provide 'magit-utils)
1099 ;;; magit-utils.el ends here