magit-utils.el 44.3 KB
Newer Older
1
;;; magit-utils.el --- various utilities  -*- lexical-binding: t; coding: utf-8 -*-
2

Jonas Bernoulli's avatar
Jonas Bernoulli committed
3
;; Copyright (C) 2010-2018  The Magit Project Contributors
4
;;
5 6
;; You should have received a copy of the AUTHORS.md file which
;; lists all contributors.  If not, see http://magit.vc/authors.
7 8 9 10

;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>

11 12 13
;; Contains code from GNU Emacs https://www.gnu.org/software/emacs,
;; released under the GNU General Public License version 3 or later.

14 15 16 17 18 19 20 21 22 23 24 25 26
;; Magit is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; Magit is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Magit.  If not, see http://www.gnu.org/licenses.

27 28 29 30 31 32 33 34 35 36 37 38
;;; Commentary:

;; This library defines several utility functions used by several
;; other libraries which cannot depend on one another (because
;; circular dependencies are not good).  Luckily most (all) of these
;; functions have very little (nothing) to do with Git, so we not only
;; have to do this, it even makes sense.

;; Unfortunately there are also some options which are used by several
;; libraries which cannot depend on one another, they are defined here
;; too.

39 40 41 42 43
;;; Code:

(require 'cl-lib)
(require 'dash)

44 45
(eval-when-compile
  (require 'subr-x))
46

47 48
(require 'crm)

49
(eval-when-compile (require 'ido))
50 51 52 53 54
(declare-function ido-completing-read+ "ido-completing-read+"
                  (prompt collection &optional predicate
                          require-match initial-input
                          hist def inherit-input-method))
(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 62
(require 'magit-popup)

63 64 65
;;; Options

(defcustom magit-completing-read-function 'magit-builtin-completing-read
66 67
  "Function to be called when requesting input from the user.

68 69 70 71 72 73 74 75
If you have enabled `ivy-mode' or `helm-mode', then you don't
have to customize this option; `magit-builtin-completing-read'
will work just fine.  However, if you use Ido completion, then
you do have to use `magit-ido-completion-read', because Ido is
less well behaved than the former, more modern alternatives.

If you would like to use Ivy or Helm completion with Magit but
not enable the respective modes globally, then customize this
76 77 78 79
option to use `ivy-completing-read' or
`helm--completing-read-default'.  If you choose to use
`ivy-completing-read', note that the items may always be shown in
alphabetical order, depending on your version of Ivy."
80
  :group 'magit-essentials
81 82
  :type '(radio (function-item magit-builtin-completing-read)
                (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 88 89 90 91
(defcustom magit-dwim-selection
  '((magit-stash-apply        nil t)
    (magit-stash-branch       nil t)
    (magit-stash-branch-here  nil t)
    (magit-stash-format-patch nil t)
92
    (magit-stash-drop         nil ask)
93 94 95 96 97 98
    (magit-stash-pop          nil ask)
    (forge-browse-commit      nil t)
    (forge-browse-branch      nil t)
    (forge-browse-remote      nil t)
    (forge-browse-issue       nil t)
    (forge-browse-pullreq     nil t)
99 100 101
    (forge-edit-topic-title   nil t)
    (forge-edit-topic-labels  nil t)
    (forge-edit-topic-assignees nil t)
102 103
    (forge-visit-issue        nil t)
    (forge-visit-pullreq      nil t))
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
  "When not to offer alternatives and ask for confirmation.

Many commands by default ask the user to select from a list of
possible candidates.  They do so even when there is a thing at
point that they can act on, which is then offered as the default.

This option can be used to tell certain commands to use the thing
at point instead of asking the user to select a candidate to act
on, with or without confirmation.

The value has the form ((COMMAND nil|PROMPT DEFAULT)...).

- COMMAND is the command that should not prompt for a choice.
  To have an effect, the command has to use the function
  `magit-completing-read' or a utility function which in turn uses
  that function.

- If the command uses `magit-completing-read' multiple times, then
  PROMPT can be used to only affect one of these uses.  PROMPT, if
  non-nil, is a regular expression that is used to match against
  the PROMPT argument passed to `magit-completing-read'.

- DEFAULT specifies how to use the default.  If it is t, then
  the DEFAULT argument passed to `magit-completing-read' is used
  without confirmation.  If it is `ask', then the user is given
  a chance to abort.  DEFAULT can also be nil, in which case the
  entry has no effect."
  :package-version '(magit . "2.12.0")
132
  :group 'magit-commands
133 134 135 136 137 138 139
  :type '(repeat
          (list (symbol :tag "Command") ; It might not be fboundp yet.
                (choice (const  :tag "for all prompts" nil)
                        (regexp :tag "for prompts matching regexp"))
                (choice (const  :tag "offer other choices" nil)
                        (const  :tag "require confirmation" ask)
                        (const  :tag "use default without confirmation" t)))))
140

141 142 143
(defconst magit--confirm-actions
  '((const reverse)           (const discard)
    (const rename)            (const resurrect)
144 145
    (const untrack)           (const trash)
    (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 151 152
    (const stage-all-changes) (const unstage-all-changes)
    (const safe-with-wip)))

153 154
(defcustom magit-no-confirm nil
  "A list of symbols for actions Magit should not confirm, or t.
155 156 157 158 159

Many potentially dangerous commands by default ask the user for
confirmation.  Each of the below symbols stands for an action
which, when invoked unintentionally or without being fully aware
of the consequences, could lead to tears.  In many cases there
160 161
are several commands that perform variations of a certain action,
so we don't use the command names but more generic symbols.
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192

Applying changes:

  `discard' Discarding one or more changes (i.e. hunks or the
  complete diff for a file) loses that change, obviously.

  `reverse' Reverting one or more changes can usually be undone
  by reverting the reversion.

  `stage-all-changes', `unstage-all-changes' When there are both
  staged and unstaged changes, then un-/staging everything would
  destroy that distinction.  Of course that also applies when
  un-/staging a single change, but then less is lost and one does
  that so often that having to confirm every time would be
  unacceptable.

Files:

  `delete' When a file that isn't yet tracked by Git is deleted
  then it is completely lost, not just the last changes.  Very
  dangerous.

  `trash' Instead of deleting a file it can also be move to the
  system trash.  Obviously much less dangerous than deleting it.

  Also see option `magit-delete-by-moving-to-trash'.

  `resurrect' A deleted file can easily be resurrected by
  \"deleting\" the deletion, which is done using the same command
  that was used to delete the same file in the first place.

193 194
  `untrack' Untracking a file can be undone by tracking it again.

195 196 197 198 199 200 201
  `rename' Renaming a file can easily be undone.

Sequences:

  `reset-bisect' Aborting (known to Git as \"resetting\") a
  bisect operation loses all information collected so far.

202 203 204 205
  `abort-rebase' Aborting a rebase throws away all already
  modified commits, but it's possible to restore those from the
  reflog.

206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
  `abort-merge' Aborting a merge throws away all conflict
  resolutions which has already been carried out by the user.

  `merge-dirty' Merging with a dirty worktree can make it hard to
  go back to the state before the merge was initiated.

References:

  `delete-unmerged-branch' Once a branch has been deleted it can
  only be restored using low-level recovery tools provided by
  Git.  And even then the reflog is gone.  The user always has
  to confirm the deletion of a branch by accepting the default
  choice (or selecting another branch), but when a branch has
  not been merged yet, also make sure the user is aware of that.

221 222 223 224 225 226 227
  `delete-pr-branch' When deleting a branch that was created from
  a pull request and if no other branches still exist on that
  remote, then `magit-branch-delete' offers to delete the remote
  as well.  This should be safe because it only happens if no
  other refs exist in the remotes namespace, and you can recreate
  the remote if necessary.

228
  `drop-stashes' Dropping a stash is dangerous because Git stores
229 230 231 232 233 234
  stashes in the reflog.  Once a stash is removed, there is no
  going back without using low-level recovery tools provided by
  Git.  When a single stash is dropped, then the user always has
  to confirm by accepting the default (or selecting another).
  This action only concerns the deletion of multiple stashes at
  once.
235

236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
Edit published history:

  Without adding these symbols here, you will be warned before
  editing commits that have already been pushed to one of the
  branches listed in `magit-published-branches'.

  `amend-published' Affects most commands that amend to \"HEAD\".

  `rebase-published' Affects commands that perform interactive
  rebases.  This includes commands from the commit popup that
  modify a commit other than \"HEAD\", namely the various fixup
  and squash variants.

  `edit-published' Affects the commands `magit-edit-line-commit'
  and `magit-diff-edit-hunk-commit'.  These two commands make
  it quite easy to accidentally edit a published commit, so you
  should think twice before configuring them not to ask for
  confirmation.

  To disable confirmation completely, add all three symbols here
  or set `magit-published-branches' to nil.

258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
Removing modules:

  `remove-modules' When you remove the working directory of a
  module that does not contain uncommitted changes, then that is
  safer than doing so when there are uncommitted changes and/or
  when you also remove the gitdir.  Still, you don't want to do
  that by accident.

  `remove-dirty-modules' When you remove the working directory of
  a module that contains uncommitted changes, then those changes
  are gone for good.  It is better to go to the module, inspect
  these changes and only if appropriate discard them manually.

  `trash-module-gitdirs' When you remove the gitdir of a module,
  then all unpushed changes are gone for good.  It is very easy
  to forget that you have some unfinished work on an unpublished
  feature branch or even in a stash.

  Actually there are some safety precautions in place, that might
  help you out if you make an unwise choice here, but don't count
  on it.  In case of emergency, stay calm and check the stash and
  the `trash-directory' for traces of lost work.

281 282 283 284 285 286 287 288 289 290 291 292
Various:

  `kill-process' There seldom is a reason to kill a process.

Global settings:

  Instead of adding all of the above symbols to the value of this
  option you can also set it to the atom `t', which has the same
  effect as adding all of the above symbols.  Doing that most
  certainly is a bad idea, especially because other symbols might
  be added in the future.  So even if you don't want to be asked
  for confirmation for any of these actions, you are still better
293 294
  of adding all of the respective symbols individually.

295 296 297
  When `magit-wip-before-change-mode' is enabled then these actions
  can fairly easily be undone: `discard', `reverse',
  `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 304
  :type `(choice (const :tag "Always require confirmation" nil)
                 (const :tag "Never require confirmation" t)
305
                 (set   :tag "Require confirmation except for"
306 307 308
                        ;; `remove-dirty-modules' and
                        ;; `trash-module-gitdirs' intentionally
                        ;; 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 315 316 317 318 319

When this is nil, then `y-or-n-p' is used when the user has to
confirm a potentially destructive action.  When this is t, then
`yes-or-no-p' is used instead.  If this is a list of symbols
identifying actions, then `yes-or-no-p' is used for those,
`y-or-no-p' for all others.  The list of actions is the same as
for `magit-no-confirm' (which see)."
320
  :package-version '(magit . "2.9.0")
321
  :group 'magit-miscellaneous
322 323
  :type `(choice (const :tag "Always ask \"yes or no\" questions" t)
                 (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 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
(defcustom magit-no-message nil
  "A list of messages Magit should not display.

Magit displays most echo area messages using `message', but a few
are displayed using `magit-message' instead, which takes the same
arguments as the former, FORMAT-STRING and ARGS.  `magit-message'
forgoes printing a message if any member of this list is a prefix
of the respective FORMAT-STRING.

If Magit prints a message which causes you grief, then please
first investigate whether there is another option which can be
used to suppress it.  If that is not the case, then ask the Magit
maintainers to start using `magit-message' instead of `message'
in that case.  We are not proactively replacing all uses of
`message' with `magit-message', just in case someone *might* find
some of these messages useless.

Messages which can currently be suppressed using this option are:
* \"Turning on magit-auto-revert-mode...\""
346
  :package-version '(magit . "2.8.0")
347
  :group 'magit-miscellaneous
348 349
  :type '(repeat string))

350
(defcustom magit-ellipsis ?
351 352 353 354
  "Character used to abbreviate text.

Currently this is used to abbreviate author names in the margin
and in process buffers to elide `magit-git-global-arguments'."
355
  :package-version '(magit . "2.1.0")
356
  :group 'magit-miscellaneous
357 358
  :type 'character)

359 360 361
(defcustom magit-update-other-window-delay 0.2
  "Delay before automatically updating the other window.

362 363 364 365
When moving around in certain buffers, then certain other
buffers, which are being displayed in another window, may
optionally be updated to display information about the
section at point.
366 367 368 369 370 371 372 373

When holding down a key to move by more than just one section,
then that would update that buffer for each section on the way.
To prevent that, updating the revision buffer is delayed, and
this option controls for how long.  For optimal experience you
might have to adjust this delay and/or the keyboard repeat rate
and delay of your graphical environment or operating system."
  :package-version '(magit . "2.3.0")
374
  :group 'magit-miscellaneous
375 376
  :type 'number)

377 378 379
(defcustom magit-view-git-manual-method 'info
  "How links to Git documentation are followed from Magit's Info manuals.

380
`info'  Follow the link to the node in the `gitman' Info manual
381 382 383 384 385 386 387 388
        as usual.  Unfortunately that manual is not installed by
        default on some platforms, and when it is then the nodes
        look worse than the actual manpages.

`man'   View the respective man-page using the `man' package.

`woman' View the respective man-page using the `woman' package."
  :package-version '(magit . "2.9.0")
389
  :group 'magit-miscellaneous
390
  :type '(choice (const :tag "view info manual" info)
391 392 393
                 (const :tag "view manpage using `man'" man)
                 (const :tag "view manpage using `woman'" woman)))

394 395
;;; User Input

396 397 398
(defvar helm-completion-in-region-default-sort-fn)
(defvar ivy-sort-functions-alist)

399 400
(defvar magit-completing-read--silent-default nil)

401 402 403
(defun magit-completing-read (prompt collection &optional
                                     predicate require-match initial-input
                                     hist def fallback)
404 405 406 407 408 409 410 411 412 413 414 415 416
  "Read a choice in the minibuffer, or use the default choice.

This is the function that Magit commands use when they need the
user to select a single thing to act on.  The arguments have the
same meaning as for `completing-read', except for FALLBACK, which
is unique to this function and is described below.

Instead of asking the user to choose from a list of possible
candidates, this function may instead just return the default
specified by DEF, with or without requiring user confirmation.
Whether that is the case depends on PROMPT, `this-command' and
`magit-dwim-selection'.  See the documentation of the latter for
more information.
417

418 419 420
If it does use the default without the user even having to
confirm that, then `magit-completing-read--silent-default' is set
to t, otherwise nil.
421

422 423
If it does read a value in the minibuffer, then this function
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 432 433 434 435 436
- FALLBACK specifies a secondary default that is only used if
  the primary default DEF is nil.  The secondary default is not
  subject to `magit-dwim-selection' — if DEF is nil but FALLBACK
  is not, then this function always asks the user to choose a
  candidate, just as if both defaults were nil.

437
- \": \" is appended to PROMPT.
438

439 440 441 442 443 444
- PROMPT is modified to end with \" (default DEF|FALLBACK): \"
  provided that DEF or FALLBACK is non-nil, that neither
  `ivy-mode' nor `helm-mode' is enabled, and that
  `magit-completing-read-function' is set to its default value of
  `magit-builtin-completing-read'."
  (setq magit-completing-read--silent-default nil)
445 446 447 448 449 450
  (if-let ((dwim (and def
                      (nth 2 (-first (pcase-lambda (`(,cmd ,re ,_))
                                       (and (eq this-command cmd)
                                            (or (not re)
                                                (string-match-p re prompt))))
                                     magit-dwim-selection)))))
451 452 453 454 455 456
      (if (eq dwim 'ask)
          (if (y-or-n-p (format "%s %s? " prompt def))
              def
            (user-error "Abort"))
        (setq magit-completing-read--silent-default t)
        def)
457 458
    (unless def
      (setq def fallback))
459 460
    (let ((command this-command)
          (reply (funcall magit-completing-read-function
461 462 463 464 465 466
                          (concat prompt ": ")
                          (if (and def (not (member def collection)))
                              (cons def collection)
                            collection)
                          predicate
                          require-match initial-input hist def)))
467
      (setq this-command command)
468 469 470 471 472
      (if (string= reply "")
          (if require-match
              (user-error "Nothing selected")
            nil)
        reply))))
473

474 475 476 477 478 479
(defun magit--completion-table (collection)
  (lambda (string pred action)
    (if (eq action 'metadata)
        '(metadata (display-sort-function . identity))
      (complete-with-action action collection string pred))))

480 481 482
(defun magit-builtin-completing-read
  (prompt choices &optional predicate require-match initial-input hist def)
  "Magit wrapper for standard `completing-read' function."
483 484 485 486
  (unless (or (bound-and-true-p helm-mode)
              (bound-and-true-p ivy-mode))
    (setq prompt (magit-prompt-with-default prompt def))
    (setq choices (magit--completion-table choices)))
487 488
  (cl-letf (((symbol-function 'completion-pcm--all-completions)
             #'magit-completion-pcm--all-completions))
489 490 491 492
    (let ((ivy-sort-functions-alist nil))
      (completing-read prompt choices
                       predicate require-match
                       initial-input hist def))))
493

494 495 496 497 498 499 500 501 502 503 504 505 506 507 508
(defun magit-completing-read-multiple
  (prompt choices &optional sep default hist keymap)
  "Read multiple items from CHOICES, separated by SEP.

Set up the `crm' variables needed to read multiple values with
`read-from-minibuffer'.

SEP is a regexp matching characters that can separate choices.
When SEP is nil, it defaults to `crm-default-separator'.
DEFAULT, HIST, and KEYMAP are passed to `read-from-minibuffer'.
When KEYMAP is nil, it defaults to `crm-local-completion-map'.

Unlike `completing-read-multiple', the return value is not split
into a list."
  (let* ((crm-separator (or sep crm-default-separator))
509
         (crm-completion-table (magit--completion-table choices))
510 511 512 513
         (choose-completion-string-functions
          '(crm--choose-completion-string))
         (minibuffer-completion-table #'crm--collection-fn)
         (minibuffer-completion-confirm t)
514
         (helm-completion-in-region-default-sort-fn nil)
515 516 517 518 519 520 521
         (input
          (cl-letf (((symbol-function 'completion-pcm--all-completions)
                     #'magit-completion-pcm--all-completions))
            (read-from-minibuffer
             (concat prompt (and default (format " (%s)" default)) ": ")
             nil (or keymap crm-local-completion-map)
             nil hist default))))
522 523 524 525 526
    (when (string-equal input "")
      (or (setq input default)
          (user-error "Nothing selected")))
    input))

527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
(defun magit-completing-read-multiple*
    (prompt table &optional predicate require-match initial-input
	    hist def inherit-input-method)
  "Read multiple strings in the minibuffer, with completion.
Like `completing-read-multiple' but don't mess with order of
TABLE.  Also bind `helm-completion-in-region-default-sort-fn'
to nil."
  (unwind-protect
      (cl-letf (((symbol-function 'completion-pcm--all-completions)
                 #'magit-completion-pcm--all-completions))
        (add-hook 'choose-completion-string-functions
                  'crm--choose-completion-string)
        (let* ((minibuffer-completion-table #'crm--collection-fn)
               (minibuffer-completion-predicate predicate)
               ;; see completing_read in src/minibuf.c
               (minibuffer-completion-confirm
                (unless (eq require-match t) require-match))
               (crm-completion-table (magit--completion-table table))
               (map (if require-match
                        crm-local-must-match-map
                      crm-local-completion-map))
               (helm-completion-in-region-default-sort-fn nil)
               ;; If the user enters empty input, `read-from-minibuffer'
               ;; returns the empty string, not DEF.
               (input (read-from-minibuffer
                       prompt initial-input map
                       nil hist def inherit-input-method)))
          (and def (string-equal input "") (setq input def))
          ;; Remove empty strings in the list of read strings.
          (split-string input crm-separator t)))
    (remove-hook 'choose-completion-string-functions
                 'crm--choose-completion-string)))

560 561
(defun magit-ido-completing-read
  (prompt choices &optional predicate require-match initial-input hist def)
562 563
  "Ido-based `completing-read' almost-replacement.

564 565
Unfortunately `ido-completing-read' is not suitable as a
drop-in replacement for `completing-read', instead we use
566
`ido-completing-read+' from the third-party package by the
567 568 569 570
same name."
  (if (require 'ido-completing-read+ nil t)
      (ido-completing-read+ prompt choices predicate require-match
                            initial-input hist def)
571
    (display-warning 'magit "ido-completing-read+ is not installed
572 573 574

To use Ido completion with Magit you need to install the
third-party `ido-completing-read+' packages.  Falling
575
back to built-in `completing-read' for now." :error)
576 577
    (magit-builtin-completing-read prompt choices predicate require-match
                                   initial-input hist def)))
578 579 580 581 582 583 584

(defun magit-prompt-with-default (prompt def)
  (if (and def (> (length prompt) 2)
           (string-equal ": " (substring prompt -2)))
      (format "%s (default %s): " (substring prompt 0 -2) def)
    prompt))

585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606
(defvar magit-minibuffer-local-ns-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-map)
    (define-key map "\s" 'magit-whitespace-disallowed)
    (define-key map "\t" 'magit-whitespace-disallowed)
    map))

(defun magit-whitespace-disallowed ()
  "Beep to tell the user that whitespace is not allowed."
  (interactive)
  (ding)
  (message "Whitespace isn't allowed here")
  (setq defining-kbd-macro nil)
  (force-mode-line-update))

(defun magit-read-string (prompt &optional initial-input history default-value
                                 inherit-input-method no-whitespace)
  "Read a string from the minibuffer, prompting with string PROMPT.

This is similar to `read-string', but
* empty input is only allowed if DEFAULT-VALUE is non-nil in
  which case that is returned,
607 608
* whitespace is not allowed and leading and trailing whitespace is
  removed automatically if NO-WHITESPACE is non-nil,
609 610 611 612 613 614 615 616 617 618 619
* \": \" is appended to PROMPT, and
* an invalid DEFAULT-VALUE is silently ignored."
  (when default-value
    (when (consp default-value)
      (setq default-value (car default-value)))
    (unless (stringp default-value)
      (setq default-value nil)))
  (let* ((minibuffer-completion-table nil)
         (val (read-from-minibuffer
               (magit-prompt-with-default (concat prompt ": ") default-value)
               initial-input (and no-whitespace magit-minibuffer-local-ns-map)
620 621 622 623 624 625
               nil history default-value inherit-input-method))
         (trim (lambda (regexp string)
                 (save-match-data
                   (if (string-match regexp string)
                       (replace-match "" t t string)
                     string)))))
626 627
    (when (and (string= val "") default-value)
      (setq val default-value))
628 629 630
    (when no-whitespace
      (setq val (funcall trim "\\`\\(?:[ \t\n\r]+\\)"
                         (funcall trim "\\(?:[ \t\n\r]+\\)\\'" val))))
631 632 633 634 635 636 637 638 639 640 641
    (cond ((string= val "")
           (user-error "Need non-empty input"))
          ((and no-whitespace (string-match-p "[\s\t\n]" val))
           (user-error "Input contains whitespace"))
          (t val))))

(defun magit-read-string-ns (prompt &optional initial-input history
                                    default-value inherit-input-method)
  "Call `magit-read-string' with non-nil NO-WHITESPACE."
  (magit-read-string prompt initial-input history default-value
                     inherit-input-method t))
642

643
(defmacro magit-read-char-case (prompt verbose &rest clauses)
644 645
  (declare (indent 2)
           (debug (form form &rest (characterp form body))))
646 647 648 649 650 651
  `(pcase (read-char-choice
           (concat ,prompt
                   ,(concat (mapconcat 'cadr clauses ", ")
                            (and verbose ", or [C-g] to abort") " "))
           ',(mapcar 'car clauses))
     ,@(--map `(,(car it) ,@(cddr it)) clauses)))
652

653 654 655 656 657 658
(defun magit-y-or-n-p (prompt &optional action)
  "Ask user a \"y or n\" or a \"yes or no\" question using PROMPT.
Which kind of question is used depends on whether
ACTION is a member of option `magit-slow-confirm'."
  (if (or (eq magit-slow-confirm t)
          (and action (member action magit-slow-confirm)))
659 660 661
      (yes-or-no-p prompt)
    (y-or-n-p prompt)))

662 663 664 665
(defvar magit--no-confirm-alist
  '((safe-with-wip magit-wip-before-change-mode
                   discard reverse stage-all-changes unstage-all-changes)))

666 667
(cl-defun magit-confirm (action &optional prompt prompt-n noabort
                                (items nil sitems))
668
  (declare (indent defun))
669 670
  (setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items)))
  (setq prompt   (format (concat (or prompt (magit-confirm-make-prompt action))
671 672
                                 "? ")
                         (car items)))
673 674
  (or (cond ((and (not (eq action t))
                  (or (eq magit-no-confirm t)
675
                      (memq action magit-no-confirm)
Jonas Bernoulli's avatar
Jonas Bernoulli committed
676 677 678 679 680 681
                      (cl-member-if (pcase-lambda (`(,key ,var . ,sub))
                                      (and (memq key magit-no-confirm)
                                           (memq action sub)
                                           (or (not var)
                                               (and (boundp var)
                                                    (symbol-value var)))))
682
                                    magit--no-confirm-alist)))
683 684 685 686 687 688
             (or (not sitems) items))
            ((not sitems)
             (magit-y-or-n-p prompt action))
            ((= (length items) 1)
             (and (magit-y-or-n-p prompt action) items))
            ((> (length items) 1)
689 690 691 692
             (and (magit-y-or-n-p (concat (mapconcat #'identity items "\n")
                                          "\n\n" prompt-n)
                                  action)
                  items)))
693
      (if noabort nil (user-error "Abort"))))
694 695 696 697 698 699 700 701

(defun magit-confirm-files (action files &optional prompt)
  (when files
    (unless prompt
      (setq prompt (magit-confirm-make-prompt action)))
    (magit-confirm action
      (concat prompt " %s")
      (concat prompt " %i files")
702
      nil files)))
703 704 705 706 707

(defun magit-confirm-make-prompt (action)
  (let ((prompt (symbol-name action)))
    (replace-regexp-in-string
     "-" " " (concat (upcase (substring prompt 0 1)) (substring prompt 1)))))
708

709 710 711 712 713 714 715 716
(defun magit-read-number-string (prompt &optional default)
  "Like `read-number' but return value is a string.
DEFAULT may be a number or a numeric string."
  (number-to-string
   (read-number prompt (if (stringp default)
                           (string-to-number default)
                         default))))

717 718 719 720
;;; Debug Utilities

;;;###autoload
(defun magit-emacs-Q-command ()
721 722
  "Show a shell command that runs an uncustomized Emacs with only Magit loaded.
See info node `(magit)Debugging Tools' for more information."
723 724 725 726 727 728 729 730
  (interactive)
  (let ((cmd (mapconcat
              #'shell-quote-argument
              `(,(concat invocation-directory invocation-name)
                "-Q" "--eval" "(setq debug-on-error t)"
                ,@(cl-mapcan
                   (lambda (dir) (list "-L" dir))
                   (delete-dups
731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755
                    (cl-mapcan
                     (lambda (lib)
                       (let ((path (locate-library lib)))
                         (cond
                          (path
                           (list (file-name-directory path)))
                          ((not (member lib '("lv" "transient")))
                           (error "Cannot find mandatory dependency %s" lib)))))
                     '(;; Like `LOAD_PATH' in `default.mk'.
                       "dash"
                       "ghub"
                       "graphql"
                       "lv"
                       "magit-popup"
                       "transient"
                       "treepy"
                       "with-editor"
                       ;; Obviously `magit' itself is needed too.
                       "magit"
                       ;; While this is part of the Magit repository,
                       ;; it is distributed as a separate package.
                       "git-commit"
                       ;; Even though `async' is a dependency of the
                       ;; `magit' package, it is not required here.
                       ))))
756 757
                ;; Avoid Emacs bug#16406 by using full path.
                "-l" ,(file-name-sans-extension (locate-library "magit")))
758 759 760 761 762
              " ")))
    (message "Uncustomized Magit command saved to kill-ring, %s"
             "please run it in a terminal.")
    (kill-new cmd)))

763 764 765
;;; Text Utilities

(defmacro magit-bind-match-strings (varlist string &rest body)
Lele Gaifax's avatar
Lele Gaifax committed
766
  "Bind variables to submatches according to VARLIST then evaluate BODY.
767 768
Bind the symbols in VARLIST to submatches of the current match
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 772 773 774 775 776 777 778 779 780 781 782 783 784
  (declare (indent 2) (debug (listp form body)))
  (let ((s (cl-gensym "string"))
        (i 0))
    `(let ((,s ,string))
       (let ,(save-match-data
               (--map (list it (list 'match-string (cl-incf i) s)) varlist))
         ,@body))))

(defun magit-delete-line ()
  "Delete the rest of the current line."
  (delete-region (point) (1+ (line-end-position))))

(defun magit-delete-match (&optional num)
  "Delete text matched by last search.
785
If optional NUM is specified, only delete that subexpression."
786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804
  (delete-region (match-beginning (or num 0))
                 (match-end (or num 0))))

(defun magit-file-line (file)
  "Return the first line of FILE as a string."
  (when (file-regular-p file)
    (with-temp-buffer
      (insert-file-contents file)
      (buffer-substring-no-properties (point-min)
                                      (line-end-position)))))

(defun magit-file-lines (file &optional keep-empty-lines)
  "Return a list of strings containing one element per line in FILE.
Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines."
  (when (file-regular-p file)
    (with-temp-buffer
      (insert-file-contents file)
      (split-string (buffer-string) "\n" (not keep-empty-lines)))))

805 806 807
(defun magit-set-header-line-format (string)
  "Set the header-line using STRING.
Propertize STRING with the `magit-header-line' face if no face is
808 809
present, and pad the left and right sides of STRING equally such
that it will align with the text area."
810 811 812 813 814 815 816 817 818 819 820 821 822 823
  (let* ((header-line
          (concat (propertize " "
                              'display
                              '(space :align-to 0))
                  string
                  (propertize
                   " "
                   'display
                   `(space :width (+ left-fringe
                                     left-margin
                                     ,@(and (eq (car (window-current-scroll-bars))
                                                'left)
                                            '(scroll-bar)))))))
         (len (length header-line)))
824
    (setq header-line-format
825 826 827 828 829 830 831
          (if (text-property-not-all 0 len 'face nil header-line)
              (let ((face (get-text-property 0 'face string)))
                (when (and (atom face)
                           (magit-face-property-all face string))
                  (add-face-text-property 0 1 face nil header-line)
                  (add-face-text-property (1- len) len face nil header-line))
                header-line)
832 833 834 835
            (propertize header-line
                        'face
                        'magit-header-line)))))

836 837 838 839 840 841 842 843 844 845 846
(defun magit-face-property-all (face string)
  "Return non-nil if FACE is present in all of STRING."
  (cl-loop for pos = 0 then (next-single-property-change pos 'face string)
           unless pos
             return t
           for current = (get-text-property pos 'face string)
           unless (if (consp current)
                      (memq face current)
                    (eq face current))
             return nil))

847 848 849 850 851 852 853 854 855
(defun magit--format-spec (format specification)
  "Like `format-spec' but preserve text properties in SPECIFICATION."
  (with-temp-buffer
    (insert format)
    (goto-char (point-min))
    (while (search-forward "%" nil t)
      (cond
       ;; Quoted percent sign.
       ((eq (char-after) ?%)
856
        (delete-char 1))
857 858
       ;; Valid format spec.
       ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
859 860 861 862 863 864 865 866 867
        (let* ((num (match-string 1))
               (spec (string-to-char (match-string 2)))
               (val (assq spec specification)))
          (unless val
            (error "Invalid format character: `%%%c'" spec))
          (setq val (cdr val))
          ;; Pad result to desired length.
          (let ((text (format (concat "%" num "s") val)))
            ;; Insert first, to preserve text properties.
868 869
            (if (next-property-change 0 (concat " " text))
                ;; If the inserted text has properties, then preserve those.
870
                (insert text)
871
              ;; Otherwise preserve FORMAT's properties, like `format-spec'.
872 873
              (insert-and-inherit text))
            ;; Delete the specifier body.
874 875 876 877 878 879
            (delete-region (+ (match-beginning 0) (length text))
                           (+ (match-end 0) (length text)))
            ;; Delete the percent sign.
            (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
       ;; Signal an error on bogus format strings.
       (t
880
        (error "Invalid format string"))))
881 882
    (buffer-string)))

883 884 885 886 887 888 889
;;; Missing from Emacs

(defun magit-kill-this-buffer ()
  "Kill the current buffer."
  (interactive)
  (kill-buffer (current-buffer)))

890
;;; Kludges for Emacs Bugs
891 892 893 894 895 896 897 898

(defun magit-file-accessible-directory-p (filename)
  "Like `file-accessible-directory-p' but work around an Apple bug.
See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=21573#17
and https://github.com/magit/magit/issues/2295."
  (and (file-directory-p filename)
       (file-accessible-directory-p filename)))

899 900 901 902 903
(when (version<= "25.1" emacs-version)
  (with-eval-after-load 'vc-git
    (defun vc-git-conflicted-files (directory)
      "Return the list of files with conflicts in DIRECTORY."
      (let* ((status
904 905
              (vc-git--run-command-string directory "diff-files"
                                          "--name-status"))
906 907 908
             (lines (when status (split-string status "\n" 'omit-nulls)))
             files)
        (dolist (line lines files)
909
          (when (string-match "\\([ MADRCU?!]\\)[ \t]+\\(.+\\)" line)
910 911
            (let ((state (match-string 1 line))
                  (file (match-string 2 line)))
912
              (when (equal state "U")
913 914
                (push (expand-file-name file directory) files)))))))))

915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939
(when (< emacs-major-version 27)
  (defun vc-git--call@bug21559 (fn buffer command &rest args)
    "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
    (let ((process-environment process-environment))
      (when revert-buffer-in-progress-p
        (push "GIT_OPTIONAL_LOCKS=0" process-environment))
      (apply fn buffer command args)))
  (advice-add 'vc-git--call :around 'vc-git--call@bug21559)

  (defun vc-git-command@bug21559
      (fn buffer okstatus file-or-list &rest flags)
    "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
    (let ((process-environment process-environment))
      (when revert-buffer-in-progress-p
        (push "GIT_OPTIONAL_LOCKS=0" process-environment))
      (apply fn buffer okstatus file-or-list flags)))
  (advice-add 'vc-git-command :around 'vc-git-command@bug21559)

  (defun auto-revert-handler@bug21559 (fn)
    "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559."
    (let ((revert-buffer-in-progress-p t))
      (funcall fn)))
  (advice-add 'auto-revert-handler :around 'auto-revert-handler@bug21559)
  )

940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961
;; `completion-pcm--all-completions' reverses the completion list.  To
;; preserve the order of our pre-sorted completions, we'll temporarily
;; override it with the function below.  bug#24676
(defun magit-completion-pcm--all-completions (prefix pattern table pred)
  (if (completion-pcm--pattern-trivial-p pattern)
      (all-completions (concat prefix (car pattern)) table pred)
    (let* ((regex (completion-pcm--pattern->regex pattern))
           (case-fold-search completion-ignore-case)
           (completion-regexp-list (cons regex completion-regexp-list))
           (compl (all-completions
                   (concat prefix
                           (if (stringp (car pattern)) (car pattern) ""))
                   table pred)))
      (if (not (functionp table))
          compl
        (let ((poss ()))
          (dolist (c compl)
            (when (string-match-p regex c) (push c poss)))
          ;; This `nreverse' call is the only code change made to the
          ;; `completion-pcm--all-completions' that shipped with Emacs 25.1.
          (nreverse poss))))))

962
;;; Kludges for Incompatible Modes
963

964 965
(defvar whitespace-mode)

966
(defun whitespace-dont-turn-on-in-magit-mode (fn)
967
  "Prevent `whitespace-mode' from being turned on in Magit buffers.
968 969 970 971 972 973

Because `whitespace-mode' uses font-lock and Magit does not, they
are not compatible.  Therefore you cannot turn on that minor-mode
in Magit buffers.  If you try to enable it anyway, then this
advice prevents that.

974 975 976
If the reason the attempt is made is that `global-whitespace-mode'
is enabled, then that is done silently.  However if you call the local
minor-mode interactively, then that results in an error.
977 978 979 980

See `magit-diff-paint-whitespace' for an alternative."
  (if (not (derived-mode-p 'magit-mode))
      (funcall fn)
981
    (setq whitespace-mode nil)
982 983 984
    (when (eq this-command 'whitespace-mode)
      (user-error
       "Whitespace mode NOT enabled because it is not compatible with Magit"))))
985

986
(advice-add 'whitespace-turn-on :around
987 988
            'whitespace-dont-turn-on-in-magit-mode)

989 990
;;; Kludges for Custom

991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008
(defun magit-custom-initialize-reset (symbol exp)
  "Initialize SYMBOL based on EXP.
Set the symbol, using `set-default' (unlike
`custom-initialize-reset' which uses the `:set' function if any.)
The value is either the symbol's current value
 (as obtained using the `:get' function), if any,
or the value in the symbol's `saved-value' property if any,
or (last of all) the value of EXP."
  (set-default-toplevel-value
   symbol
   (condition-case nil
       (let ((def (default-toplevel-value symbol))
             (getter (get symbol 'custom-get)))
         (if getter (funcall getter symbol) def))
     (error
      (eval (let ((sv (get symbol 'saved-value)))
              (if sv (car sv) exp)))))))

1009 1010 1011 1012 1013 1014 1015
(defun magit-hook-custom-get (symbol)
  (if (symbol-file symbol 'defvar)
      (default-toplevel-value symbol)
    ;;
    ;; Called by `custom-initialize-reset' on behalf of `symbol's
    ;; `defcustom', which is being evaluated for the first time to
    ;; set the initial value, but there's already a default value,
1016
    ;; which most likely was established by one or more `add-hook'
1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034
    ;; calls.
    ;;
    ;; We combine the `standard-value' and the current value, while
    ;; preserving the order established by `:options', and return
    ;; the result of that to be used as the "initial" default value.
    ;;
    (let ((standard (eval (car (get symbol 'standard-value))))
          (current (default-toplevel-value symbol))
          (value nil))
      (dolist (fn (get symbol 'custom-options))
        (when (or (memq fn standard)
                  (memq fn current))
          (push fn value)))
      (dolist (fn current)
        (unless (memq fn value)
          (push fn value)))
      (nreverse value))))

1035 1036
;;; Kludges for Info Manuals

1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057
;;;###autoload
(defun Info-follow-nearest-node--magit-gitman (fn &optional fork)
  (if magit-view-git-manual-method
      (let ((node (Info-get-token
                   (point) "\\*note[ \n\t]+"
                   "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")))
        (if (and node (string-match "^(gitman)\\(.+\\)" node))
            (pcase magit-view-git-manual-method
              (`man   (require 'man)
                      (man (match-string 1 node)))
              (`woman (require 'woman)
                      (woman (match-string 1 node)))
              (_
               (user-error "Invalid value for `magit-view-git-documentation'")))
          (funcall fn fork)))
    (funcall fn fork)))

;;;###autoload
(advice-add 'Info-follow-nearest-node :around
            'Info-follow-nearest-node--magit-gitman)

1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080
;;;###autoload
(defun org-man-export--magit-gitman (fn link description format)
  (if (and (eq format 'texinfo)
           (string-match-p "\\`git" link))
      (replace-regexp-in-string "%s" link "
@ifinfo
@ref{%s,,,gitman,}.
@end ifinfo
@ifhtml
@html
the <a href=\"http://git-scm.com/docs/%s\">%s(1)</a> manpage.
@end html
@end ifhtml
@iftex
the %s(1) manpage.
@end iftex
")
    (funcall fn link description format)))

;;;###autoload
(advice-add 'org-man-export :around
            'org-man-export--magit-gitman)

1081 1082 1083 1084 1085 1086 1087 1088 1089 1090
;;; Miscellaneous

(defun magit-message (format-string &rest args)
  "Display a message at the bottom of the screen, or not.
Like `message', except that if the users configured option
`magit-no-message' to prevent the message corresponding to
FORMAT-STRING to be displayed, then don't."
  (unless (--first (string-prefix-p it format-string) magit-no-message)
    (apply #'message format-string args)))

1091 1092 1093 1094 1095 1096
(defun magit-msg (format-string &rest args)
  "Display a message at the bottom of the screen, but don't log it.
Like `message', except that `message-log-max' is bound to nil."
  (let ((message-log-max nil))
    (apply #'message format-string args)))

1097
;;; _
1098 1099
(provide 'magit-utils)
;;; magit-utils.el ends here