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