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