;;; magit-utils.el --- various utilities -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 2010-2021 The Magit Project Contributors ;; ;; You should have received a copy of the AUTHORS.md file which ;; lists all contributors. If not, see http://magit.vc/authors. ;; Author: Jonas Bernoulli ;; Maintainer: Jonas Bernoulli ;; Contains code from GNU Emacs https://www.gnu.org/software/emacs, ;; released under the GNU General Public License version 3 or later. ;; SPDX-License-Identifier: GPL-3.0-or-later ;; Magit is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; ;; Magit is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public ;; License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Magit. If not, see http://www.gnu.org/licenses. ;;; Commentary: ;; This library 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. ;;; Code: (require 'cl-lib) (require 'dash) (require 'eieio) (require 'seq) (require 'subr-x) (require 'crm) (eval-when-compile (require 'ido)) (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)) (eval-when-compile (require 'vc-git)) (declare-function vc-git--run-command-string "vc-git" (file &rest args)) (eval-when-compile (require 'which-func)) (declare-function which-function "which-func" ()) (defvar magit-wip-before-change-mode) ;;; Options (defcustom magit-completing-read-function 'magit-builtin-completing-read "Function to be called when requesting input from the user. 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-completing-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 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." :group 'magit-essentials :type '(radio (function-item magit-builtin-completing-read) (function-item magit-ido-completing-read) (function-item ivy-completing-read) (function-item helm--completing-read-default) (function :tag "Other function"))) (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) (magit-stash-drop nil ask) (magit-stash-pop nil ask) (forge-browse-dwim nil t) (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) (forge-edit-topic-title nil t) (forge-edit-topic-state nil t) (forge-edit-topic-milestone nil t) (forge-edit-topic-labels nil t) (forge-edit-topic-marks nil t) (forge-edit-topic-assignees nil t) (forge-edit-topic-review-requests nil t) (forge-edit-topic-note nil t) (forge-pull-pullreq nil t) (forge-visit-issue nil t) (forge-visit-pullreq nil t) (forge-visit-topic nil t)) "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") :group 'magit-commands :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))))) (defconst magit--confirm-actions '((const discard) (const reverse) (const stage-all-changes) (const unstage-all-changes) (const delete) (const trash) (const resurrect) (const untrack) (const rename) (const reset-bisect) (const abort-rebase) (const abort-merge) (const merge-dirty) (const delete-unmerged-branch) (const delete-branch-on-remote) (const delete-pr-remote) (const drop-stashes) (const set-and-push) (const amend-published) (const rebase-published) (const edit-published) (const remove-modules) (const remove-dirty-modules) (const trash-module-gitdirs) (const kill-process) (const safe-with-wip))) (defcustom magit-no-confirm '(set-and-push) "A list of symbols for actions Magit should not confirm, or t. 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 are several commands that perform variations of a certain action, so we don't use the command names but more generic symbols. 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. `untrack' Untracking a file can be undone by tracking it again. `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. `abort-rebase' Aborting a rebase throws away all already modified commits, but it's possible to restore those from the reflog. `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. `delete-branch-on-remote' Deleting a \"remote branch\" may mean deleting the (local) \"remote-tracking\" branch only, or also removing it from the remote itself. The latter often makes more sense because otherwise simply fetching from the remote would restore the remote-tracking branch, but doing that can be surprising and hard to recover from, so we ask. `delete-pr-remote' 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. `drop-stashes' Dropping a stash is dangerous because Git stores 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. Publishing: `set-and-push' When pushing to the upstream or the push-remote and that isn't actually configured yet, then the user can first set the target. If s/he confirms the default too quickly, then s/he might end up pushing to the wrong branch and if the remote repository is configured to disallow fixing such mistakes, then that can be quite embarrassing and annoying. 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. 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. 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 of adding all of the respective symbols individually. 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 this mode is enabled, then `safe-with-wip' has the same effect as adding all of these symbols individually." :package-version '(magit . "2.1.0") :group 'magit-essentials :group 'magit-commands :type `(choice (const :tag "Always require confirmation" nil) (const :tag "Never require confirmation" t) (set :tag "Require confirmation except for" ;; `remove-dirty-modules' and ;; `trash-module-gitdirs' intentionally ;; omitted. ,@magit--confirm-actions))) (defcustom magit-slow-confirm '(drop-stashes) "Whether to ask user \"y or n\" or \"yes or no\" questions. 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)." :package-version '(magit . "2.9.0") :group 'magit-miscellaneous :type `(choice (const :tag "Always ask \"yes or no\" questions" t) (const :tag "Always ask \"y or n\" questions" nil) (set :tag "Ask \"yes or no\" questions only for" ,@magit--confirm-actions))) (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...\"" :package-version '(magit . "2.8.0") :group 'magit-miscellaneous :type '(repeat string)) (defcustom magit-ellipsis (if (char-displayable-p ?…) "…" "...") "String used to abbreviate text in process buffers. Currently this is only used to elide `magit-git-global-arguments' in process buffers. In the future it may be used in other places as well, but not the following: - Author names in the log margin are always abbreviated using \"…\" or if that is not displayable, then \">\". - Whether collapsed sections are indicated using ellipsis is controlled by `magit-section-visibility-indicator'." :package-version '(magit . "3.0.0") :group 'magit-miscellaneous :type 'string) (defcustom magit-update-other-window-delay 0.2 "Delay before automatically updating the other window. 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. 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") :group 'magit-miscellaneous :type 'number) (defcustom magit-view-git-manual-method 'info "How links to Git documentation are followed from Magit's Info manuals. `info' Follow the link to the node in the `gitman' Info manual 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") :group 'magit-miscellaneous :type '(choice (const :tag "view info manual" info) (const :tag "view manpage using `man'" man) (const :tag "view manpage using `woman'" woman))) ;;; User Input (defvar helm-completion-in-region-default-sort-fn) (defvar helm-crm-default-separator) (defvar ivy-sort-functions-alist) (defvar ivy-sort-matches-functions-alist) (defvar magit-completing-read--silent-default nil) (defun magit-completing-read (prompt collection &optional predicate require-match initial-input hist def fallback) "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. 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. If it does read a value in the minibuffer, then this function acts similarly to `completing-read', except for the following: - COLLECTION must be a list of choices. A function is not supported. - If REQUIRE-MATCH is nil and the user exits without a choice, then nil is returned instead of an empty string. - If REQUIRE-MATCH is non-nil and the user exits without a choice, `user-error' is raised. - 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. - \": \" is appended to PROMPT. - 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) (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))))) (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) (unless def (setq def fallback)) (let ((command this-command) (reply (funcall magit-completing-read-function (concat prompt ": ") (if (and def (not (member def collection))) (cons def collection) collection) predicate require-match initial-input hist def))) (setq this-command command) ;; Note: Avoid `string=' to support `helm-comp-read-use-marked'. (if (equal reply "") (if require-match (user-error "Nothing selected") nil) reply)))) (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)))) (defun magit-builtin-completing-read (prompt choices &optional predicate require-match initial-input hist def) "Magit wrapper for standard `completing-read' function." (unless (or (bound-and-true-p helm-mode) (bound-and-true-p ivy-mode) (bound-and-true-p vertico-mode) (bound-and-true-p selectrum-mode)) (setq prompt (magit-prompt-with-default prompt def))) (unless (or (bound-and-true-p helm-mode) (bound-and-true-p ivy-mode)) (setq choices (magit--completion-table choices))) (cl-letf (((symbol-function 'completion-pcm--all-completions))) (when (< emacs-major-version 26) (fset 'completion-pcm--all-completions 'magit-completion-pcm--all-completions)) (let ((ivy-sort-functions-alist nil)) (completing-read prompt choices predicate require-match initial-input hist def)))) (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." (declare (obsolete magit-completing-read-multiple* "Magit 3.1.0")) (let* ((crm-separator (or sep crm-default-separator)) (crm-completion-table (magit--completion-table choices)) (choose-completion-string-functions '(crm--choose-completion-string)) (minibuffer-completion-table #'crm--collection-fn) (minibuffer-completion-confirm t) (helm-completion-in-region-default-sort-fn nil) (helm-crm-default-separator nil) (ivy-sort-matches-functions-alist nil) (input (cl-letf (((symbol-function 'completion-pcm--all-completions))) (when (< emacs-major-version 26) (fset '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)))) (when (string-equal input "") (or (setq input default) (user-error "Nothing selected"))) input)) (defun magit-completing-read-multiple* (prompt table &optional predicate require-match initial-input hist def inherit-input-method no-split) "Read multiple strings in the minibuffer, with completion. Like `completing-read-multiple' but don't mess with order of TABLE and take an additional argument NO-SPLIT, which causes the user input to be returned as a single unmodified string. Also work around various misfeatures of various third-party completion frameworks." (cl-letf* (;; To implement NO-SPLIT we have to manipulate the respective ;; `split-string' invocation. We cannot simply advice it to ;; return the input string because `SELECTRUM' would choke on ;; it that string. Use a variable to pass along the raw user ;; input string. aa5f098ab (input nil) (split-string (symbol-function 'split-string)) ((symbol-function 'split-string) (lambda (string &optional separators omit-nulls trim) (when (and no-split (equal separators crm-separator) (equal omit-nulls t)) (setq input string)) (funcall split-string string separators omit-nulls trim))) ;; In Emacs 25 this function has a bug, so we use a copy of the ;; version from Emacs 26. bef9c7aa3 ((symbol-function 'completion-pcm--all-completions) (if (< emacs-major-version 26) 'magit-completion-pcm--all-completions (symbol-function 'completion-pcm--all-completions))) ;; Prevent `BUILT-IN' completion from messing up our existing ;; order of the completion candidates. aa5f098ab (table (magit--completion-table table)) ;; Prevent `IVY' from messing up our existing order. c7af78726 (ivy-sort-matches-functions-alist nil) ;; Prevent `HELM' from messing up our existing order. 6fcf994bd (helm-completion-in-region-default-sort-fn nil) ;; Prevent `HELM' from automatically appending the separator, ;; which is counterproductive when NO-SPLIT is non-nil and/or ;; when reading commit ranges. 798aff564 (helm-crm-default-separator (if no-split nil (bound-and-true-p helm-crm-default-separator))) ;; And now, the moment we have all been waiting for... (values (completing-read-multiple prompt table predicate require-match initial-input hist def inherit-input-method))) (if no-split input values))) (defun magit-ido-completing-read (prompt choices &optional predicate require-match initial-input hist def) "Ido-based `completing-read' almost-replacement. Unfortunately `ido-completing-read' is not suitable as a drop-in replacement for `completing-read', instead we use `ido-completing-read+' from the third-party package by the same name." (if (require 'ido-completing-read+ nil t) (ido-completing-read+ prompt choices predicate require-match initial-input hist (or def (and require-match (car choices)))) (display-warning 'magit "ido-completing-read+ is not installed To use Ido completion with Magit you need to install the third-party `ido-completing-read+' packages. Falling back to built-in `completing-read' for now." :error) (magit-builtin-completing-read prompt choices predicate require-match initial-input hist def))) (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)) (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, * whitespace is not allowed and leading and trailing whitespace is removed automatically if NO-WHITESPACE is non-nil, * \": \" 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) 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))))) (when (and (string= val "") default-value) (setq val default-value)) (when no-whitespace (setq val (funcall trim "\\`\\(?:[ \t\n\r]+\\)" (funcall trim "\\(?:[ \t\n\r]+\\)\\'" val)))) (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)) (defmacro magit-read-char-case (prompt verbose &rest clauses) (declare (indent 2) (debug (form form &rest (characterp form body)))) `(prog1 (pcase (read-char-choice (concat ,prompt (mapconcat #'identity (list ,@(mapcar #'cadr clauses)) ", ") ,(if verbose ", or [C-g] to abort " " ")) ',(mapcar #'car clauses)) ,@(--map `(,(car it) ,@(cddr it)) clauses)) (message ""))) (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))) (yes-or-no-p prompt) (y-or-n-p prompt))) (defvar magit--no-confirm-alist '((safe-with-wip magit-wip-before-change-mode discard reverse stage-all-changes unstage-all-changes))) (cl-defun magit-confirm (action &optional prompt prompt-n noabort (items nil sitems)) (declare (indent defun)) (setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items))) (setq prompt (format (concat (or prompt (magit-confirm-make-prompt action)) "? ") (car items))) (or (cond ((and (not (eq action t)) (or (eq magit-no-confirm t) (memq action magit-no-confirm) (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))))) magit--no-confirm-alist))) (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) (and (magit-y-or-n-p (concat (mapconcat #'identity items "\n") "\n\n" prompt-n) action) items))) (if noabort nil (user-error "Abort")))) (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") nil files))) (defun magit-confirm-make-prompt (action) (let ((prompt (symbol-name action))) (replace-regexp-in-string "-" " " (concat (upcase (substring prompt 0 1)) (substring prompt 1))))) (defun magit-read-number-string (prompt &optional default _history) "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)))) ;;; Debug Utilities ;;;###autoload (defun magit-emacs-Q-command () "Show a shell command that runs an uncustomized Emacs with only Magit loaded. See info node `(magit)Debugging Tools' for more information." (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 (cl-mapcan (lambda (lib) (let ((path (locate-library lib))) (cond (path (list (file-name-directory path))) ((not (equal lib "libgit")) (error "Cannot find mandatory dependency %s" lib))))) '(;; Like `LOAD_PATH' in `default.mk'. "dash" "libgit" "transient" "with-editor" ;; Obviously `magit' itself is needed too. "magit" ;; While these are part of the Magit repository, ;; they are distributed as separate packages. "magit-section" "git-commit" )))) ;; Avoid Emacs bug#16406 by using full path. "-l" ,(file-name-sans-extension (locate-library "magit"))) " "))) (message "Uncustomized Magit command saved to kill-ring, %s" "please run it in a terminal.") (kill-new cmd))) ;;; Text Utilities (defmacro magit-bind-match-strings (varlist string &rest body) "Bind variables to submatches according to VARLIST then evaluate BODY. Bind the symbols in VARLIST to submatches of the current match data, starting with 1 and incrementing by 1 for each symbol. If the last match was against a string, then that has to be provided as STRING." (declare (indent 2) (debug (listp form body))) (let ((s (cl-gensym "string")) (i 0)) `(let ((,s ,string)) (let ,(save-match-data (cl-mapcan (lambda (sym) (cl-incf i) (and (not (eq (aref (symbol-name sym) 0) ?_)) (list (list sym (list 'match-string 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. If optional NUM is specified, only delete that subexpression." (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))))) (defun magit-set-header-line-format (string) "Set the header-line using STRING. Propertize STRING with the `magit-header-line'. If the `face' property of any part of STRING is already set, then that takes precedence. Also pad the left side of STRING so that it aligns with the text area." (setq header-line-format (concat (propertize " " 'display '(space :align-to 0)) string))) (defun magit-face-property-all (face string) "Return non-nil if FACE is present in all of STRING." (catch 'missing (let ((pos 0)) (while (setq pos (next-single-property-change pos 'font-lock-face string)) (let ((val (get-text-property pos 'font-lock-face string))) (unless (if (consp val) (memq face val) (eq face val)) (throw 'missing nil)))) (not pos)))) (defun magit--add-face-text-property (beg end face &optional append object) "Like `add-face-text-property' but for `font-lock-face'." (while (< beg end) (let* ((pos (next-single-property-change beg 'font-lock-face object end)) (val (get-text-property beg 'font-lock-face object)) (val (if (listp val) val (list val)))) (put-text-property beg pos 'font-lock-face (if append (append val (list face)) (cons face val)) object) (setq beg pos)))) (defun magit--propertize-face (string face) (propertize string 'face face 'font-lock-face face)) (defun magit--put-face (beg end face string) (put-text-property beg end 'face face string) (put-text-property beg end 'font-lock-face face string)) (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) ?%) (delete-char 1)) ;; Valid format spec. ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") (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. (if (next-property-change 0 (concat " " text)) ;; If the inserted text has properties, then preserve those. (insert text) ;; Otherwise preserve FORMAT's properties, like `format-spec'. (insert-and-inherit text)) ;; Delete the specifier body. (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 (error "Invalid format string")))) (buffer-string))) ;;; Missing from Emacs (defun magit-kill-this-buffer () "Kill the current buffer." (interactive) (kill-buffer (current-buffer))) (defun magit--buffer-string (&optional min max trim) "Like `buffer-substring-no-properties' but the arguments are optional. This combines the benefits of `buffer-string', `buffer-substring' and `buffer-substring-no-properties' into one function that is not as painful to use as the latter. I.e. you can write (magit--buffer-string) instead of (buffer-substring-no-properties (point-min) (point-max)) Optional MIN defaults to the value of `point-min'. Optional MAX defaults to the value of `point-max'. If optional TRIM is non-nil, then all leading and trailing whitespace is remove. If it is the newline character, then one trailing newline is added." ;; Lets write that one last time and be done with it: (let ((str (buffer-substring-no-properties (or min (point-min)) (or max (point-max))))) (if trim (concat (string-trim str) (and (eq trim ?\n) "\n")) str))) ;;; Kludges for Emacs Bugs (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))) (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 (vc-git--run-command-string directory "diff-files" "--name-status")) (lines (when status (split-string status "\n" 'omit-nulls))) files) (dolist (line lines files) (when (string-match "\\([ MADRCU?!]\\)[ \t]+\\(.+\\)" line) (let ((state (match-string 1 line)) (file (match-string 2 line))) (when (equal state "U") (push (expand-file-name file directory) files))))))))) (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) ) (when (< emacs-major-version 26) ;; In Emacs 25 `completion-pcm--all-completions' reverses the ;; completion list. This is the version from Emacs 26, which ;; fixes that issue. 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))) (nreverse poss))))))) (defun magit-which-function () "Return current function name based on point. This is a simple wrapper around `which-function', that resets Imenu's potentially outdated and therefore unreliable cache by setting `imenu--index-alist' to nil before calling that function." (setq imenu--index-alist nil) (which-function)) ;;; Kludges for Custom (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))))))) (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, ;; which most likely was established by one or more `add-hook' ;; 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)))) ;;; Kludges for Info Manuals ;;;###autoload (defun Info-follow-nearest-node--magit-gitman (fn &optional fork) (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 (`info (funcall fn fork)) (`man (require 'man) (man (match-string 1 node))) (`woman (require 'woman) (woman (match-string 1 node))) (_ (user-error "Invalid value for `magit-view-git-manual-method'"))) (funcall fn fork)))) ;;;###autoload (advice-add 'Info-follow-nearest-node :around 'Info-follow-nearest-node--magit-gitman) ;;;###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 %s(1) 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) ;;; Kludges for Package Managers (defun magit--straight-chase-links (filename) "Chase links in FILENAME until a name that is not a link. This is the same as `file-chase-links', except that it also handles fake symlinks that are created by the package manager straight.el on Windows. See ." (when (and (bound-and-true-p straight-symlink-emulation-mode) (fboundp 'straight-chase-emulated-symlink)) (when-let ((target (straight-chase-emulated-symlink filename))) (unless (eq target 'broken) (setq filename target)))) (file-chase-links filename)) ;;; 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))) (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))) (defmacro magit--with-temp-position (buf pos &rest body) (declare (indent 2)) `(with-current-buffer ,buf (save-excursion (save-restriction (widen) (goto-char (or ,pos 1)) ,@body)))) ;;; _ (provide 'magit-utils) ;;; magit-utils.el ends here