1 # git-gui index (add/remove) support
2 # Copyright (C) 2006, 2007 Shawn Pearce
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"]
10 proc close_and_unlock_index
{fd
after} {
11 if {![catch {_close_updateindex
$fd} err
]} {
15 rescan_on_error
$err $after
19 proc _close_updateindex
{fd
} {
20 fconfigure $fd -blocking 1
24 proc rescan_on_error
{err
{after {}}} {
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
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
53 wm protocol
$w WM_DELETE_WINDOW
update
54 bind $w.
continue <Visibility
> "
61 $::main_status stop_all
63 rescan
[concat $after [list ui_ready
]] 0
66 proc update_indexinfo
{msg path_list
after} {
67 global update_index_cp
69 if {![lock_index
update]} return
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}
77 set status_bar_operation
[$::main_status start
$msg [mc
"files"]]
78 set fd
[git_write update-index
-z --index-info
]
85 fileevent $fd writable
[list \
86 write_update_indexinfo
\
91 $status_bar_operation \
96 proc write_update_indexinfo
{fd path_list total_cnt batch status_bar_operation
\
98 global update_index_cp
99 global file_states current_diff_path
101 if {$update_index_cp >= $total_cnt} {
102 $status_bar_operation stop
103 close_and_unlock_index
$fd $after
108 {$update_index_cp < $total_cnt && $i > 0} \
110 set path
[lindex $path_list $update_index_cp]
113 set s
$file_states($path)
114 switch -glob -- [lindex $s 0] {
125 set info [lindex $s 2]
126 if {$info eq
{}} continue
128 puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0"
129 display_file
$path $new
132 $status_bar_operation update $update_index_cp $total_cnt
135 proc update_index
{msg path_list
after} {
136 global update_index_cp
138 if {![lock_index
update]} return
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}
146 set status_bar_operation
[$::main_status start
$msg [mc
"files"]]
147 set fd
[git_write update-index
--add --remove -z --stdin]
154 fileevent $fd writable
[list \
160 $status_bar_operation \
165 proc write_update_index
{fd path_list total_cnt batch status_bar_operation
\
167 global update_index_cp
168 global file_states current_diff_path
170 if {$update_index_cp >= $total_cnt} {
171 $status_bar_operation stop
172 close_and_unlock_index
$fd $after
177 {$update_index_cp < $total_cnt && $i > 0} \
179 set path
[lindex $path_list $update_index_cp]
182 switch -glob -- [lindex $file_states($path) 0] {
193 if {[file exists
$path]} {
202 puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
203 display_file
$path $new
206 $status_bar_operation update $update_index_cp $total_cnt
209 proc checkout_index
{msg path_list
after capture_error
} {
210 global update_index_cp
212 if {![lock_index
update]} return
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}
220 set status_bar_operation
[$::main_status start
$msg [mc
"files"]]
221 set fd
[git_write checkout-index
\
234 fileevent $fd writable
[list \
235 write_checkout_index
\
240 $status_bar_operation \
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
251 if {$update_index_cp >= $total_cnt} {
252 $status_bar_operation stop
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.
261 # (See after_chord in revert_helper.)
263 if {[catch {_close_updateindex
$fd} err
]} {
264 uplevel #0 $capture_error [list $err]
273 {$update_index_cp < $total_cnt && $i > 0} \
275 set path
[lindex $path_list $update_index_cp]
277 switch -glob -- [lindex $file_states($path) 0] {
282 puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
283 display_file
$path ?_
288 $status_bar_operation update $update_index_cp $total_cnt
291 proc unstage_helper
{txt paths
} {
292 global file_states current_diff_path
294 if {![lock_index begin-update
]} return
298 foreach path
$paths {
299 switch -glob -- [lindex $file_states($path) 0] {
304 lappend path_list
$path
305 if {$path eq
$current_diff_path} {
306 set after {reshow_diff
;}
311 if {$path_list eq
{}} {
317 [concat $after [list ui_ready
]]
321 proc do_unstage_selection
{} {
322 global current_diff_path selected_paths
324 if {[array size selected_paths
] > 0} {
326 [mc
"Unstaging selected files from commit"] \
327 [array names selected_paths
]
328 } elseif
{$current_diff_path ne
{}} {
330 [mc
"Unstaging %s from commit" [short_path
$current_diff_path]] \
331 [list $current_diff_path]
335 proc add_helper
{txt paths
} {
336 global file_states current_diff_path
338 if {![lock_index begin-update
]} return
342 foreach path
$paths {
343 switch -glob -- [lindex $file_states($path) 0] {
346 if {$path eq
$current_diff_path} {
348 merge_stage_workdir
$path
356 lappend path_list
$path
357 if {$path eq
$current_diff_path} {
358 set after {reshow_diff
;}
363 if {$path_list eq
{}} {
369 [concat $after {ui_status
[mc
"Ready to commit."]}]
373 proc do_add_selection
{} {
374 global current_diff_path selected_paths
376 if {[array size selected_paths
] > 0} {
378 [mc
"Adding selected files"] \
379 [array names selected_paths
]
380 } elseif
{$current_diff_path ne
{}} {
382 [mc
"Adding %s" [short_path
$current_diff_path]] \
383 [list $current_diff_path]
391 set untracked_paths
[list]
392 foreach path
[array names file_states
] {
393 switch -glob -- [lindex $file_states($path) 0] {
397 ?D
{lappend paths
$path}
398 ?O
{lappend untracked_paths
$path}
401 if {[llength $untracked_paths]} {
403 switch -- [get_config gui.stageuntracked
] {
412 set reply
[ask_popup
[mc
"Stage %d untracked files?" \
413 [llength $untracked_paths]]]
417 set paths
[concat $paths $untracked_paths]
420 add_helper
[mc
"Adding all changed files"] $paths
423 # Copied from TclLib package "lambda".
424 proc lambda
{arguments body args
} {
425 return [list ::apply [list $arguments $body] {*}$args]
428 proc revert_helper
{txt paths
} {
429 global file_states current_diff_path
431 if {![lock_index begin-update
]} return
433 # Common "after" functionality that waits until multiple asynchronous
434 # operations are complete (by waiting for them to activate their notes
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] != ""} {
444 if {$should_reshow_diff} { reshow_diff
}
449 $after_chord eval { set should_reshow_diff
0 }
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
\
455 { $chord eval [list set err
$error] } \
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
]
465 set untracked_list
[list]
467 foreach path
$paths {
468 switch -glob -- [lindex $file_states($path) 0] {
471 lappend untracked_list
$path
476 lappend path_list
$path
477 if {$path eq
$current_diff_path} {
478 $after_chord eval { set should_reshow_diff
1 }
484 set path_cnt
[llength $path_list]
485 set untracked_cnt
[llength $untracked_list]
487 # Asynchronous operation: revert changes by checking them out afresh
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).
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
501 if {$path_cnt == 1} {
503 "Revert changes in file %s?" \
504 [short_path
[lindex $path_list]] \
508 "Revert changes in these %i files?" \
512 set reply
[tk_dialog \
514 "[appname] ([reponame])" \
517 [mc "Any unstaged changes will be permanently lost by the revert.
"]" \
521 [mc
"Revert Changes"] \
528 [$after_chord add_note
] \
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.
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
543 if {$untracked_cnt == 1} {
545 "Delete untracked file %s?" \
546 [short_path
[lindex $untracked_list]] \
550 "Delete these %i untracked files?" \
555 set reply
[tk_dialog \
557 "[appname] ([reponame])" \
560 [mc "Files will be permanently deleted.
"]" \
564 [mc
"Delete Files"] \
568 $after_chord eval { set should_reshow_diff
1 }
570 delete_files
$untracked_list [$after_chord add_note
]
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.
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 \
590 set deletion_errors
[list]
598 $status_bar_operation \
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} {
609 set path_cnt
[llength $path_list]
611 set batch_remaining
$batch_size
613 while {$batch_remaining > 0} {
614 if {$path_index >= $path_cnt} { break }
616 set path
[lindex $path_list $path_index]
618 set deletion_failed
[catch {file delete
-- $path} deletion_error
]
620 if {$deletion_failed} {
621 lappend deletion_errors
[list "$deletion_error"]
623 remove_empty_directories
[file dirname
$path]
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 __
634 incr batch_remaining
-1
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
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
647 after idle
[list after 0 [list \
653 $status_bar_operation \
657 # Finish the status bar operation.
658 $status_bar_operation stop
660 # Report error, if any, based on how many deletions failed.
661 set deletion_error_cnt
[llength $deletion_errors]
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"]
667 foreach deletion_error
$deletion_errors {
668 append error_text
"* [lindex $deletion_error 0]\n"
671 error_popup
$error_text
672 } elseif
{$deletion_error_cnt == $path_cnt} {
674 "None of the %d selected files could be deleted." \
677 } elseif
{$deletion_error_cnt > 1} {
679 "%d of the %d selected files could not be deleted." \
680 $deletion_error_cnt \
689 proc MAX_VERBOSE_FILES_IN_DELETION_ERROR
{} { return 10; }
691 # This function is from the TCL documentation:
693 # https://wiki.tcl-lang.org/page/file+exists
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
}]}
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]
710 while {$parent_path != $directory_path} {
711 set contents
[glob -nocomplain -dir $directory_path *]
713 if {[llength $contents] > 0} { break }
714 if {[catch {file delete
-- $directory_path}]} { break }
716 set directory_path
$parent_path
717 set parent_path
[file dirname
$directory_path]
721 proc do_revert_selection
{} {
722 global current_diff_path selected_paths
724 if {[array size selected_paths
] > 0} {
726 [mc
"Reverting selected files"] \
727 [array names selected_paths
]
728 } elseif
{$current_diff_path ne
{}} {
730 [mc
"Reverting %s" [short_path
$current_diff_path]] \
731 [list $current_diff_path]
735 proc do_select_commit_type
{} {
736 global commit_type commit_type_is_amend
738 if {$commit_type_is_amend == 0
739 && [string match amend
* $commit_type]} {
741 } elseif
{$commit_type_is_amend == 1
742 && ![string match amend
* $commit_type]} {
745 # The amend request was rejected...
747 if {![string match amend
* $commit_type]} {
748 set commit_type_is_amend
0