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