Merge branch 'jt/avoid-prefetch-when-able-in-diff'
[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 {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 {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                         set note [$after_chord add_note]
526                         checkout_index \
527                                 $txt \
528                                 $path_list \
529                                 [list $note activate] \
530                                 $capture_error
531                 }
532         }
533
534         # Asynchronous operation: Deletion of untracked files.
535         if {$untracked_cnt > 0} {
536                 # Split question between singular and plural cases, because
537                 # such distinction is needed in some languages.
538                 #
539                 # FIXME: Unfortunately, even that isn't enough in some languages
540                 # as they have quite complex plural-form rules. Unfortunately,
541                 # msgcat doesn't seem to support that kind of string
542                 # translation.
543                 #
544                 if {$untracked_cnt == 1} {
545                         set query [mc \
546                                 "Delete untracked file %s?" \
547                                 [short_path [lindex $untracked_list]] \
548                                 ]
549                 } else {
550                         set query [mc \
551                                 "Delete these %i untracked files?" \
552                                 $untracked_cnt \
553                                 ]
554                 }
555
556                 set reply [tk_dialog \
557                         .confirm_revert \
558                         "[appname] ([reponame])" \
559                         "$query
560
561 [mc "Files will be permanently deleted."]" \
562                         question \
563                         1 \
564                         [mc "Do Nothing"] \
565                         [mc "Delete Files"] \
566                         ]
567
568                 if {$reply == 1} {
569                         $after_chord eval { set should_reshow_diff 1 }
570
571                         set note [$after_chord add_note]
572                         delete_files $untracked_list [list $note activate]
573                 }
574         }
575
576         # Activate the common note. If no other notes were created, this
577         # completes the chord. If other notes were created, then this common
578         # note prevents a race condition where the chord might complete early.
579         $after_common_note activate
580 }
581
582 # Delete all of the specified files, performing deletion in batches to allow the
583 # UI to remain responsive and updated.
584 proc delete_files {path_list after} {
585         # Enable progress bar status updates
586         set status_bar_operation [$::main_status \
587                 start \
588                 [mc "Deleting"] \
589                 [mc "files"]]
590
591         set path_index 0
592         set deletion_errors [list]
593         set batch_size 50
594
595         delete_helper \
596                 $path_list \
597                 $path_index \
598                 $deletion_errors \
599                 $batch_size \
600                 $status_bar_operation \
601                 $after
602 }
603
604 # Helper function to delete a list of files in batches. Each call deletes one
605 # batch of files, and then schedules a call for the next batch after any UI
606 # messages have been processed.
607 proc delete_helper {path_list path_index deletion_errors batch_size \
608         status_bar_operation after} {
609         global file_states
610
611         set path_cnt [llength $path_list]
612
613         set batch_remaining $batch_size
614
615         while {$batch_remaining > 0} {
616                 if {$path_index >= $path_cnt} { break }
617
618                 set path [lindex $path_list $path_index]
619
620                 set deletion_failed [catch {file delete -- $path} deletion_error]
621
622                 if {$deletion_failed} {
623                         lappend deletion_errors [list "$deletion_error"]
624                 } else {
625                         remove_empty_directories [file dirname $path]
626
627                         # Don't assume the deletion worked. Remove the file from
628                         # the UI, but only if it no longer exists.
629                         if {![path_exists $path]} {
630                                 unset file_states($path)
631                                 display_file $path __
632                         }
633                 }
634
635                 incr path_index 1
636                 incr batch_remaining -1
637         }
638
639         # Update the progress bar to indicate that this batch has been
640         # completed. The update will be visible when this procedure returns
641         # and allows the UI thread to process messages.
642         $status_bar_operation update $path_index $path_cnt
643
644         if {$path_index < $path_cnt} {
645                 # The Tcler's Wiki lists this as the best practice for keeping
646                 # a UI active and processing messages during a long-running
647                 # operation.
648
649                 after idle [list after 0 [list \
650                         delete_helper \
651                         $path_list \
652                         $path_index \
653                         $deletion_errors \
654                         $batch_size \
655                         $status_bar_operation \
656                         $after
657                         ]]
658         } else {
659                 # Finish the status bar operation.
660                 $status_bar_operation stop
661
662                 # Report error, if any, based on how many deletions failed.
663                 set deletion_error_cnt [llength $deletion_errors]
664
665                 if {($deletion_error_cnt > 0)
666                  && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} {
667                         set error_text [mc "Encountered errors deleting files:\n"]
668
669                         foreach deletion_error $deletion_errors {
670                                 append error_text "* [lindex $deletion_error 0]\n"
671                         }
672
673                         error_popup $error_text
674                 } elseif {$deletion_error_cnt == $path_cnt} {
675                         error_popup [mc \
676                                 "None of the %d selected files could be deleted." \
677                                 $path_cnt \
678                                 ]
679                 } elseif {$deletion_error_cnt > 1} {
680                         error_popup [mc \
681                                 "%d of the %d selected files could not be deleted." \
682                                 $deletion_error_cnt \
683                                 $path_cnt \
684                                 ]
685                 }
686
687                 uplevel #0 $after
688         }
689 }
690
691 proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; }
692
693 # This function is from the TCL documentation:
694 #
695 #   https://wiki.tcl-lang.org/page/file+exists
696 #
697 # [file exists] returns false if the path does exist but is a symlink to a path
698 # that doesn't exist. This proc returns true if the path exists, regardless of
699 # whether it is a symlink and whether it is broken.
700 proc path_exists {name} {
701         expr {![catch {file lstat $name finfo}]}
702 }
703
704 # Remove as many empty directories as we can starting at the specified path,
705 # walking up the directory tree. If we encounter a directory that is not
706 # empty, or if a directory deletion fails, then we stop the operation and
707 # return to the caller. Even if this procedure fails to delete any
708 # directories at all, it does not report failure.
709 proc remove_empty_directories {directory_path} {
710         set parent_path [file dirname $directory_path]
711
712         while {$parent_path != $directory_path} {
713                 set contents [glob -nocomplain -dir $directory_path *]
714
715                 if {[llength $contents] > 0} { break }
716                 if {[catch {file delete -- $directory_path}]} { break }
717
718                 set directory_path $parent_path
719                 set parent_path [file dirname $directory_path]
720         }
721 }
722
723 proc do_revert_selection {} {
724         global current_diff_path selected_paths
725
726         if {[array size selected_paths] > 0} {
727                 revert_helper \
728                         [mc "Reverting selected files"] \
729                         [array names selected_paths]
730         } elseif {$current_diff_path ne {}} {
731                 revert_helper \
732                         [mc "Reverting %s" [short_path $current_diff_path]] \
733                         [list $current_diff_path]
734         }
735 }
736
737 proc do_select_commit_type {} {
738         global commit_type commit_type_is_amend
739
740         if {$commit_type_is_amend == 0
741                 && [string match amend* $commit_type]} {
742                 create_new_commit
743         } elseif {$commit_type_is_amend == 1
744                 && ![string match amend* $commit_type]} {
745                 load_last_commit
746
747                 # The amend request was rejected...
748                 #
749                 if {![string match amend* $commit_type]} {
750                         set commit_type_is_amend 0
751                 }
752         }
753 }