Merge branch 'es/submodule-fetch-message-fix'
[git] / git-gui / lib / index.tcl
1 # git-gui index (add/remove) support
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 proc _delete_indexlock {} {
5         if {[catch {file delete -- [gitdir index.lock]} err]} {
6                 error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"]
7         }
8 }
9
10 proc close_and_unlock_index {fd after} {
11         if {![catch {_close_updateindex $fd} err]} {
12                 unlock_index
13                 uplevel #0 $after
14         } else {
15                 rescan_on_error $err $after
16         }
17 }
18
19 proc _close_updateindex {fd} {
20         fconfigure $fd -blocking 1
21         close $fd
22 }
23
24 proc rescan_on_error {err {after {}}} {
25         global use_ttk NS
26
27         set w .indexfried
28         Dialog $w
29         wm withdraw $w
30         wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
31         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
32         set s [mc "Updating the Git index failed.  A rescan will be automatically started to resynchronize git-gui."]
33         text $w.msg -yscrollcommand [list $w.vs set] \
34                 -width [string length $s] -relief flat \
35                 -borderwidth 0 -highlightthickness 0 \
36                 -background [get_bg_color $w]
37         $w.msg tag configure bold -font font_uibold -justify center
38         ${NS}::scrollbar $w.vs -command [list $w.msg yview]
39         $w.msg insert end $s bold \n\n$err {}
40         $w.msg configure -state disabled
41
42         ${NS}::button $w.continue \
43                 -text [mc "Continue"] \
44                 -command [list destroy $w]
45         ${NS}::button $w.unlock \
46                 -text [mc "Unlock Index"] \
47                 -command "destroy $w; _delete_indexlock"
48         grid $w.msg - $w.vs -sticky news
49         grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2
50         grid columnconfigure $w 0 -weight 1
51         grid rowconfigure $w 0 -weight 1
52
53         wm protocol $w WM_DELETE_WINDOW update
54         bind $w.continue <Visibility> "
55                 grab $w
56                 focus %W
57         "
58         wm deiconify $w
59         tkwait window $w
60
61         $::main_status stop_all
62         unlock_index
63         rescan [concat $after [list ui_ready]] 0
64 }
65
66 proc update_indexinfo {msg path_list after} {
67         global update_index_cp
68
69         if {![lock_index update]} return
70
71         set update_index_cp 0
72         set path_list [lsort $path_list]
73         set total_cnt [llength $path_list]
74         set batch [expr {int($total_cnt * .01) + 1}]
75         if {$batch > 25} {set batch 25}
76
77         set status_bar_operation [$::main_status start $msg [mc "files"]]
78         set fd [git_write update-index -z --index-info]
79         fconfigure $fd \
80                 -blocking 0 \
81                 -buffering full \
82                 -buffersize 512 \
83                 -encoding binary \
84                 -translation binary
85         fileevent $fd writable [list \
86                 write_update_indexinfo \
87                 $fd \
88                 $path_list \
89                 $total_cnt \
90                 $batch \
91                 $status_bar_operation \
92                 $after \
93                 ]
94 }
95
96 proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \
97         after} {
98         global update_index_cp
99         global file_states current_diff_path
100
101         if {$update_index_cp >= $total_cnt} {
102                 $status_bar_operation stop
103                 close_and_unlock_index $fd $after
104                 return
105         }
106
107         for {set i $batch} \
108                 {$update_index_cp < $total_cnt && $i > 0} \
109                 {incr i -1} {
110                 set path [lindex $path_list $update_index_cp]
111                 incr update_index_cp
112
113                 set s $file_states($path)
114                 switch -glob -- [lindex $s 0] {
115                 A? {set new _O}
116                 MT -
117                 TM -
118                 T_ {set new _T}
119                 M? {set new _M}
120                 TD -
121                 D_ {set new _D}
122                 D? {set new _?}
123                 ?? {continue}
124                 }
125                 set info [lindex $s 2]
126                 if {$info eq {}} continue
127
128                 puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0"
129                 display_file $path $new
130         }
131
132         $status_bar_operation update $update_index_cp $total_cnt
133 }
134
135 proc update_index {msg path_list after} {
136         global update_index_cp
137
138         if {![lock_index update]} return
139
140         set update_index_cp 0
141         set path_list [lsort $path_list]
142         set total_cnt [llength $path_list]
143         set batch [expr {int($total_cnt * .01) + 1}]
144         if {$batch > 25} {set batch 25}
145
146         set status_bar_operation [$::main_status start $msg [mc "files"]]
147         set fd [git_write update-index --add --remove -z --stdin]
148         fconfigure $fd \
149                 -blocking 0 \
150                 -buffering full \
151                 -buffersize 512 \
152                 -encoding binary \
153                 -translation binary
154         fileevent $fd writable [list \
155                 write_update_index \
156                 $fd \
157                 $path_list \
158                 $total_cnt \
159                 $batch \
160                 $status_bar_operation \
161                 $after \
162                 ]
163 }
164
165 proc write_update_index {fd path_list total_cnt batch status_bar_operation \
166         after} {
167         global update_index_cp
168         global file_states current_diff_path
169
170         if {$update_index_cp >= $total_cnt} {
171                 $status_bar_operation stop
172                 close_and_unlock_index $fd $after
173                 return
174         }
175
176         for {set i $batch} \
177                 {$update_index_cp < $total_cnt && $i > 0} \
178                 {incr i -1} {
179                 set path [lindex $path_list $update_index_cp]
180                 incr update_index_cp
181
182                 switch -glob -- [lindex $file_states($path) 0] {
183                 AD {set new __}
184                 ?D {set new D_}
185                 _O -
186                 AT -
187                 AM {set new A_}
188                 TM -
189                 MT -
190                 _T {set new T_}
191                 _U -
192                 U? {
193                         if {[file exists $path]} {
194                                 set new M_
195                         } else {
196                                 set new D_
197                         }
198                 }
199                 ?M {set new M_}
200                 ?? {continue}
201                 }
202                 puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
203                 display_file $path $new
204         }
205
206         $status_bar_operation update $update_index_cp $total_cnt
207 }
208
209 proc checkout_index {msg path_list after capture_error} {
210         global update_index_cp
211
212         if {![lock_index update]} return
213
214         set update_index_cp 0
215         set path_list [lsort $path_list]
216         set total_cnt [llength $path_list]
217         set batch [expr {int($total_cnt * .01) + 1}]
218         if {$batch > 25} {set batch 25}
219
220         set status_bar_operation [$::main_status start $msg [mc "files"]]
221         set fd [git_write checkout-index \
222                 --index \
223                 --quiet \
224                 --force \
225                 -z \
226                 --stdin \
227                 ]
228         fconfigure $fd \
229                 -blocking 0 \
230                 -buffering full \
231                 -buffersize 512 \
232                 -encoding binary \
233                 -translation binary
234         fileevent $fd writable [list \
235                 write_checkout_index \
236                 $fd \
237                 $path_list \
238                 $total_cnt \
239                 $batch \
240                 $status_bar_operation \
241                 $after \
242                 $capture_error \
243                 ]
244 }
245
246 proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \
247         after capture_error} {
248         global update_index_cp
249         global file_states current_diff_path
250
251         if {$update_index_cp >= $total_cnt} {
252                 $status_bar_operation stop
253
254                 # We do not unlock the index directly here because this
255                 # operation expects to potentially run in parallel with file
256                 # deletions scheduled by revert_helper. We're done with the
257                 # update index, so we close it, but actually unlocking the index
258                 # and dealing with potential errors is deferred to the chord
259                 # body that runs when all async operations are completed.
260                 #
261                 # (See after_chord in revert_helper.)
262
263                 if {[catch {_close_updateindex $fd} err]} {
264                         uplevel #0 $capture_error [list $err]
265                 }
266
267                 uplevel #0 $after
268
269                 return
270         }
271
272         for {set i $batch} \
273                 {$update_index_cp < $total_cnt && $i > 0} \
274                 {incr i -1} {
275                 set path [lindex $path_list $update_index_cp]
276                 incr update_index_cp
277                 switch -glob -- [lindex $file_states($path) 0] {
278                 U? {continue}
279                 ?M -
280                 ?T -
281                 ?D {
282                         puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
283                         display_file $path ?_
284                 }
285                 }
286         }
287
288         $status_bar_operation update $update_index_cp $total_cnt
289 }
290
291 proc unstage_helper {txt paths} {
292         global file_states current_diff_path
293
294         if {![lock_index begin-update]} return
295
296         set path_list [list]
297         set after {}
298         foreach path $paths {
299                 switch -glob -- [lindex $file_states($path) 0] {
300                 A? -
301                 M? -
302                 T? -
303                 D? {
304                         lappend path_list $path
305                         if {$path eq $current_diff_path} {
306                                 set after {reshow_diff;}
307                         }
308                 }
309                 }
310         }
311         if {$path_list eq {}} {
312                 unlock_index
313         } else {
314                 update_indexinfo \
315                         $txt \
316                         $path_list \
317                         [concat $after [list ui_ready]]
318         }
319 }
320
321 proc do_unstage_selection {} {
322         global current_diff_path selected_paths
323
324         if {[array size selected_paths] > 0} {
325                 unstage_helper \
326                         [mc "Unstaging selected files from commit"] \
327                         [array names selected_paths]
328         } elseif {$current_diff_path ne {}} {
329                 unstage_helper \
330                         [mc "Unstaging %s from commit" [short_path $current_diff_path]] \
331                         [list $current_diff_path]
332         }
333 }
334
335 proc add_helper {txt paths} {
336         global file_states current_diff_path
337
338         if {![lock_index begin-update]} return
339
340         set path_list [list]
341         set after {}
342         foreach path $paths {
343                 switch -glob -- [lindex $file_states($path) 0] {
344                 _U -
345                 U? {
346                         if {$path eq $current_diff_path} {
347                                 unlock_index
348                                 merge_stage_workdir $path
349                                 return
350                         }
351                 }
352                 _O -
353                 ?M -
354                 ?D -
355                 ?T {
356                         lappend path_list $path
357                         if {$path eq $current_diff_path} {
358                                 set after {reshow_diff;}
359                         }
360                 }
361                 }
362         }
363         if {$path_list eq {}} {
364                 unlock_index
365         } else {
366                 update_index \
367                         $txt \
368                         $path_list \
369                         [concat $after {ui_status [mc "Ready to commit."]}]
370         }
371 }
372
373 proc do_add_selection {} {
374         global current_diff_path selected_paths
375
376         if {[array size selected_paths] > 0} {
377                 add_helper \
378                         [mc "Adding selected files"] \
379                         [array names selected_paths]
380         } elseif {$current_diff_path ne {}} {
381                 add_helper \
382                         [mc "Adding %s" [short_path $current_diff_path]] \
383                         [list $current_diff_path]
384         }
385 }
386
387 proc do_add_all {} {
388         global file_states
389
390         set paths [list]
391         set untracked_paths [list]
392         foreach path [array names file_states] {
393                 switch -glob -- [lindex $file_states($path) 0] {
394                 U? {continue}
395                 ?M -
396                 ?T -
397                 ?D {lappend paths $path}
398                 ?O {lappend untracked_paths $path}
399                 }
400         }
401         if {[llength $untracked_paths]} {
402                 set reply 0
403                 switch -- [get_config gui.stageuntracked] {
404                 no {
405                         set reply 0
406                 }
407                 yes {
408                         set reply 1
409                 }
410                 ask -
411                 default {
412                         set reply [ask_popup [mc "Stage %d untracked files?" \
413                                                                           [llength $untracked_paths]]]
414                 }
415                 }
416                 if {$reply} {
417                         set paths [concat $paths $untracked_paths]
418                 }
419         }
420         add_helper [mc "Adding all changed files"] $paths
421 }
422
423 # Copied from TclLib package "lambda".
424 proc lambda {arguments body args} {
425         return [list ::apply [list $arguments $body] {*}$args]
426 }
427
428 proc revert_helper {txt paths} {
429         global file_states current_diff_path
430
431         if {![lock_index begin-update]} return
432
433         # Common "after" functionality that waits until multiple asynchronous
434         # operations are complete (by waiting for them to activate their notes
435         # on the chord).
436         #
437         # The asynchronous operations are each indicated below by a comment
438         # before the code block that starts the async operation.
439         set after_chord [SimpleChord new {
440                 if {[string trim $err] != ""} {
441                         rescan_on_error $err
442                 } else {
443                         unlock_index
444                         if {$should_reshow_diff} { reshow_diff }
445                         ui_ready
446                 }
447         }]
448
449         $after_chord eval { set should_reshow_diff 0 }
450
451         # This function captures an error for processing when after_chord is
452         # completed. (The chord is curried into the lambda function.)
453         set capture_error [lambda \
454                 {chord error} \
455                 { $chord eval [list set err $error] } \
456                 $after_chord]
457
458         # We don't know how many notes we're going to create (it's dynamic based
459         # on conditional paths below), so create a common note that will delay
460         # the chord's completion until we activate it, and then activate it
461         # after all the other notes have been created.
462         set after_common_note [$after_chord add_note]
463
464         set path_list [list]
465         set untracked_list [list]
466
467         foreach path $paths {
468                 switch -glob -- [lindex $file_states($path) 0] {
469                 U? {continue}
470                 ?O {
471                         lappend untracked_list $path
472                 }
473                 ?M -
474                 ?T -
475                 ?D {
476                         lappend path_list $path
477                         if {$path eq $current_diff_path} {
478                                 $after_chord eval { set should_reshow_diff 1 }
479                         }
480                 }
481                 }
482         }
483
484         set path_cnt [llength $path_list]
485         set untracked_cnt [llength $untracked_list]
486
487         # Asynchronous operation: revert changes by checking them out afresh
488         # from the index.
489         if {$path_cnt > 0} {
490                 # Split question between singular and plural cases, because
491                 # such distinction is needed in some languages. Previously, the
492                 # code used "Revert changes in" for both, but that can't work
493                 # in languages where 'in' must be combined with word from
494                 # rest of string (in different way for both cases of course).
495                 #
496                 # FIXME: Unfortunately, even that isn't enough in some languages
497                 # as they have quite complex plural-form rules. Unfortunately,
498                 # msgcat doesn't seem to support that kind of string
499                 # translation.
500                 #
501                 if {$path_cnt == 1} {
502                         set query [mc \
503                                 "Revert changes in file %s?" \
504                                 [short_path [lindex $path_list]] \
505                                 ]
506                 } else {
507                         set query [mc \
508                                 "Revert changes in these %i files?" \
509                                 $path_cnt]
510                 }
511
512                 set reply [tk_dialog \
513                         .confirm_revert \
514                         "[appname] ([reponame])" \
515                         "$query
516
517 [mc "Any unstaged changes will be permanently lost by the revert."]" \
518                         question \
519                         1 \
520                         [mc "Do Nothing"] \
521                         [mc "Revert Changes"] \
522                         ]
523
524                 if {$reply == 1} {
525                         checkout_index \
526                                 $txt \
527                                 $path_list \
528                                 [$after_chord add_note] \
529                                 $capture_error
530                 }
531         }
532
533         # Asynchronous operation: Deletion of untracked files.
534         if {$untracked_cnt > 0} {
535                 # Split question between singular and plural cases, because
536                 # such distinction is needed in some languages.
537                 #
538                 # FIXME: Unfortunately, even that isn't enough in some languages
539                 # as they have quite complex plural-form rules. Unfortunately,
540                 # msgcat doesn't seem to support that kind of string
541                 # translation.
542                 #
543                 if {$untracked_cnt == 1} {
544                         set query [mc \
545                                 "Delete untracked file %s?" \
546                                 [short_path [lindex $untracked_list]] \
547                                 ]
548                 } else {
549                         set query [mc \
550                                 "Delete these %i untracked files?" \
551                                 $untracked_cnt \
552                                 ]
553                 }
554
555                 set reply [tk_dialog \
556                         .confirm_revert \
557                         "[appname] ([reponame])" \
558                         "$query
559
560 [mc "Files will be permanently deleted."]" \
561                         question \
562                         1 \
563                         [mc "Do Nothing"] \
564                         [mc "Delete Files"] \
565                         ]
566
567                 if {$reply == 1} {
568                         $after_chord eval { set should_reshow_diff 1 }
569
570                         delete_files $untracked_list [$after_chord add_note]
571                 }
572         }
573
574         # Activate the common note. If no other notes were created, this
575         # completes the chord. If other notes were created, then this common
576         # note prevents a race condition where the chord might complete early.
577         $after_common_note
578 }
579
580 # Delete all of the specified files, performing deletion in batches to allow the
581 # UI to remain responsive and updated.
582 proc delete_files {path_list after} {
583         # Enable progress bar status updates
584         set status_bar_operation [$::main_status \
585                 start \
586                 [mc "Deleting"] \
587                 [mc "files"]]
588
589         set path_index 0
590         set deletion_errors [list]
591         set batch_size 50
592
593         delete_helper \
594                 $path_list \
595                 $path_index \
596                 $deletion_errors \
597                 $batch_size \
598                 $status_bar_operation \
599                 $after
600 }
601
602 # Helper function to delete a list of files in batches. Each call deletes one
603 # batch of files, and then schedules a call for the next batch after any UI
604 # messages have been processed.
605 proc delete_helper {path_list path_index deletion_errors batch_size \
606         status_bar_operation after} {
607         global file_states
608
609         set path_cnt [llength $path_list]
610
611         set batch_remaining $batch_size
612
613         while {$batch_remaining > 0} {
614                 if {$path_index >= $path_cnt} { break }
615
616                 set path [lindex $path_list $path_index]
617
618                 set deletion_failed [catch {file delete -- $path} deletion_error]
619
620                 if {$deletion_failed} {
621                         lappend deletion_errors [list "$deletion_error"]
622                 } else {
623                         remove_empty_directories [file dirname $path]
624
625                         # Don't assume the deletion worked. Remove the file from
626                         # the UI, but only if it no longer exists.
627                         if {![path_exists $path]} {
628                                 unset file_states($path)
629                                 display_file $path __
630                         }
631                 }
632
633                 incr path_index 1
634                 incr batch_remaining -1
635         }
636
637         # Update the progress bar to indicate that this batch has been
638         # completed. The update will be visible when this procedure returns
639         # and allows the UI thread to process messages.
640         $status_bar_operation update $path_index $path_cnt
641
642         if {$path_index < $path_cnt} {
643                 # The Tcler's Wiki lists this as the best practice for keeping
644                 # a UI active and processing messages during a long-running
645                 # operation.
646
647                 after idle [list after 0 [list \
648                         delete_helper \
649                         $path_list \
650                         $path_index \
651                         $deletion_errors \
652                         $batch_size \
653                         $status_bar_operation \
654                         $after
655                         ]]
656         } else {
657                 # Finish the status bar operation.
658                 $status_bar_operation stop
659
660                 # Report error, if any, based on how many deletions failed.
661                 set deletion_error_cnt [llength $deletion_errors]
662
663                 if {($deletion_error_cnt > 0)
664                  && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} {
665                         set error_text [mc "Encountered errors deleting files:\n"]
666
667                         foreach deletion_error $deletion_errors {
668                                 append error_text "* [lindex $deletion_error 0]\n"
669                         }
670
671                         error_popup $error_text
672                 } elseif {$deletion_error_cnt == $path_cnt} {
673                         error_popup [mc \
674                                 "None of the %d selected files could be deleted." \
675                                 $path_cnt \
676                                 ]
677                 } elseif {$deletion_error_cnt > 1} {
678                         error_popup [mc \
679                                 "%d of the %d selected files could not be deleted." \
680                                 $deletion_error_cnt \
681                                 $path_cnt \
682                                 ]
683                 }
684
685                 uplevel #0 $after
686         }
687 }
688
689 proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; }
690
691 # This function is from the TCL documentation:
692 #
693 #   https://wiki.tcl-lang.org/page/file+exists
694 #
695 # [file exists] returns false if the path does exist but is a symlink to a path
696 # that doesn't exist. This proc returns true if the path exists, regardless of
697 # whether it is a symlink and whether it is broken.
698 proc path_exists {name} {
699         expr {![catch {file lstat $name finfo}]}
700 }
701
702 # Remove as many empty directories as we can starting at the specified path,
703 # walking up the directory tree. If we encounter a directory that is not
704 # empty, or if a directory deletion fails, then we stop the operation and
705 # return to the caller. Even if this procedure fails to delete any
706 # directories at all, it does not report failure.
707 proc remove_empty_directories {directory_path} {
708         set parent_path [file dirname $directory_path]
709
710         while {$parent_path != $directory_path} {
711                 set contents [glob -nocomplain -dir $directory_path *]
712
713                 if {[llength $contents] > 0} { break }
714                 if {[catch {file delete -- $directory_path}]} { break }
715
716                 set directory_path $parent_path
717                 set parent_path [file dirname $directory_path]
718         }
719 }
720
721 proc do_revert_selection {} {
722         global current_diff_path selected_paths
723
724         if {[array size selected_paths] > 0} {
725                 revert_helper \
726                         [mc "Reverting selected files"] \
727                         [array names selected_paths]
728         } elseif {$current_diff_path ne {}} {
729                 revert_helper \
730                         [mc "Reverting %s" [short_path $current_diff_path]] \
731                         [list $current_diff_path]
732         }
733 }
734
735 proc do_select_commit_type {} {
736         global commit_type commit_type_is_amend
737
738         if {$commit_type_is_amend == 0
739                 && [string match amend* $commit_type]} {
740                 create_new_commit
741         } elseif {$commit_type_is_amend == 1
742                 && ![string match amend* $commit_type]} {
743                 load_last_commit
744
745                 # The amend request was rejected...
746                 #
747                 if {![string match amend* $commit_type]} {
748                         set commit_type_is_amend 0
749                 }
750         }
751 }