diff options
Diffstat (limited to 'elpa/magit-20200728.45/magit-utils.el')
| -rw-r--r-- | elpa/magit-20200728.45/magit-utils.el | 1214 |
1 files changed, 0 insertions, 1214 deletions
diff --git a/elpa/magit-20200728.45/magit-utils.el b/elpa/magit-20200728.45/magit-utils.el deleted file mode 100644 index d221b57..0000000 --- a/elpa/magit-20200728.45/magit-utils.el +++ /dev/null @@ -1,1214 +0,0 @@ -;;; magit-utils.el --- various utilities -*- lexical-binding: t; coding: utf-8 -*- - -;; Copyright (C) 2010-2020 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 <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> - -;; Contains code from GNU Emacs https://www.gnu.org/software/emacs, -;; released under the GNU General Public License version 3 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) - -(eval-when-compile - (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)) - "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 reverse) (const discard) - (const rename) (const resurrect) - (const untrack) (const trash) - (const delete) (const abort-rebase) - (const abort-merge) (const merge-dirty) - (const drop-stashes) (const reset-bisect) - (const kill-process) (const delete-unmerged-branch) - (const delete-pr-branch) (const remove-modules) - (const stage-all-changes) (const unstage-all-changes) - (const safe-with-wip))) - -(defcustom magit-no-confirm nil - "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-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. - -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 ?… - "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'." - :package-version '(magit . "2.1.0") - :group 'magit-miscellaneous - :type 'character) - -(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 ivy-sort-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) - (if (string= 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)) - (setq prompt (magit-prompt-with-default prompt def)) - (setq choices (magit--completion-table choices))) - (cl-letf (((symbol-function '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." - (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) - (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)))) - (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) - "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))) - -(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 - ,(concat (mapconcat 'cadr clauses ", ") - (and 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 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. - )))) - ;; 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 - (--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. -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 and right sides of STRING so that -it aligns with the text area." - (setq header-line-format - (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))))))) - (magit--add-face-text-property 0 (1- (length header-line-format)) - 'magit-header-line t header-line-format)) - -(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 'font-lock-face string) - unless pos - return t - for current = (get-text-property pos 'font-lock-face string) - unless (if (consp current) - (memq face current) - (eq face current)) - return nil)) - -(defun magit--add-face-text-property (beg end face &optional append object) - "Like `add-face-text-property' but for `font-lock-face'." - (cl-loop for pos = (next-single-property-change - beg 'font-lock-face object end) - for current = (get-text-property beg 'font-lock-face object) - for newface = (if (listp current) - (if append - (append current (list face)) - (cons face current)) - (if append - (list current face) - (list face current))) - do (progn (put-text-property beg pos 'font-lock-face newface object) - (setq beg pos)) - while (< beg end))) - -(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) - ) - -;; `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)))))) - -(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 <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) - -;;; 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 <https://github.com/raxod502/straight.el/issues/520>." - (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)) - -;;; Bitmaps - -(when (fboundp 'define-fringe-bitmap) - (define-fringe-bitmap 'magit-fringe-bitmap+ - [#b00000000 - #b00011000 - #b00011000 - #b01111110 - #b01111110 - #b00011000 - #b00011000 - #b00000000]) - (define-fringe-bitmap 'magit-fringe-bitmap- - [#b00000000 - #b00000000 - #b00000000 - #b01111110 - #b01111110 - #b00000000 - #b00000000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmap> - [#b01100000 - #b00110000 - #b00011000 - #b00001100 - #b00011000 - #b00110000 - #b01100000 - #b00000000]) - (define-fringe-bitmap 'magit-fringe-bitmapv - [#b00000000 - #b10000010 - #b11000110 - #b01101100 - #b00111000 - #b00010000 - #b00000000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmap-bold> - [#b11100000 - #b01110000 - #b00111000 - #b00011100 - #b00011100 - #b00111000 - #b01110000 - #b11100000]) - (define-fringe-bitmap 'magit-fringe-bitmap-boldv - [#b10000001 - #b11000011 - #b11100111 - #b01111110 - #b00111100 - #b00011000 - #b00000000 - #b00000000]) - ) - -;;; 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 |