Klimi's new dotfiles with stow.
Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.

1189 рядки
46 KiB

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