diff options
Diffstat (limited to 'third_party/git/git-gui/lib/index.tcl')
| -rw-r--r-- | third_party/git/git-gui/lib/index.tcl | 753 |
1 files changed, 753 insertions, 0 deletions
diff --git a/third_party/git/git-gui/lib/index.tcl b/third_party/git/git-gui/lib/index.tcl new file mode 100644 index 0000000000..1fc5b42300 --- /dev/null +++ b/third_party/git/git-gui/lib/index.tcl @@ -0,0 +1,753 @@ +# git-gui index (add/remove) support +# Copyright (C) 2006, 2007 Shawn Pearce + +proc _delete_indexlock {} { + if {[catch {file delete -- [gitdir index.lock]} err]} { + error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"] + } +} + +proc close_and_unlock_index {fd after} { + if {![catch {_close_updateindex $fd} err]} { + unlock_index + uplevel #0 $after + } else { + rescan_on_error $err $after + } +} + +proc _close_updateindex {fd} { + fconfigure $fd -blocking 1 + close $fd +} + +proc rescan_on_error {err {after {}}} { + global use_ttk NS + + set w .indexfried + Dialog $w + wm withdraw $w + wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]] + wm geometry $w "+[winfo rootx .]+[winfo rooty .]" + set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."] + text $w.msg -yscrollcommand [list $w.vs set] \ + -width [string length $s] -relief flat \ + -borderwidth 0 -highlightthickness 0 \ + -background [get_bg_color $w] + $w.msg tag configure bold -font font_uibold -justify center + ${NS}::scrollbar $w.vs -command [list $w.msg yview] + $w.msg insert end $s bold \n\n$err {} + $w.msg configure -state disabled + + ${NS}::button $w.continue \ + -text [mc "Continue"] \ + -command [list destroy $w] + ${NS}::button $w.unlock \ + -text [mc "Unlock Index"] \ + -command "destroy $w; _delete_indexlock" + grid $w.msg - $w.vs -sticky news + grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2 + grid columnconfigure $w 0 -weight 1 + grid rowconfigure $w 0 -weight 1 + + wm protocol $w WM_DELETE_WINDOW update + bind $w.continue <Visibility> " + grab $w + focus %W + " + wm deiconify $w + tkwait window $w + + $::main_status stop_all + unlock_index + rescan [concat $after [list ui_ready]] 0 +} + +proc update_indexinfo {msg path_list after} { + global update_index_cp + + if {![lock_index update]} return + + set update_index_cp 0 + set path_list [lsort $path_list] + set total_cnt [llength $path_list] + set batch [expr {int($total_cnt * .01) + 1}] + if {$batch > 25} {set batch 25} + + set status_bar_operation [$::main_status start $msg [mc "files"]] + set fd [git_write update-index -z --index-info] + fconfigure $fd \ + -blocking 0 \ + -buffering full \ + -buffersize 512 \ + -encoding binary \ + -translation binary + fileevent $fd writable [list \ + write_update_indexinfo \ + $fd \ + $path_list \ + $total_cnt \ + $batch \ + $status_bar_operation \ + $after \ + ] +} + +proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \ + after} { + global update_index_cp + global file_states current_diff_path + + if {$update_index_cp >= $total_cnt} { + $status_bar_operation stop + close_and_unlock_index $fd $after + return + } + + for {set i $batch} \ + {$update_index_cp < $total_cnt && $i > 0} \ + {incr i -1} { + set path [lindex $path_list $update_index_cp] + incr update_index_cp + + set s $file_states($path) + switch -glob -- [lindex $s 0] { + A? {set new _O} + MT - + TM - + T_ {set new _T} + M? {set new _M} + TD - + D_ {set new _D} + D? {set new _?} + ?? {continue} + } + set info [lindex $s 2] + if {$info eq {}} continue + + puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0" + display_file $path $new + } + + $status_bar_operation update $update_index_cp $total_cnt +} + +proc update_index {msg path_list after} { + global update_index_cp + + if {![lock_index update]} return + + set update_index_cp 0 + set path_list [lsort $path_list] + set total_cnt [llength $path_list] + set batch [expr {int($total_cnt * .01) + 1}] + if {$batch > 25} {set batch 25} + + set status_bar_operation [$::main_status start $msg [mc "files"]] + set fd [git_write update-index --add --remove -z --stdin] + fconfigure $fd \ + -blocking 0 \ + -buffering full \ + -buffersize 512 \ + -encoding binary \ + -translation binary + fileevent $fd writable [list \ + write_update_index \ + $fd \ + $path_list \ + $total_cnt \ + $batch \ + $status_bar_operation \ + $after \ + ] +} + +proc write_update_index {fd path_list total_cnt batch status_bar_operation \ + after} { + global update_index_cp + global file_states current_diff_path + + if {$update_index_cp >= $total_cnt} { + $status_bar_operation stop + close_and_unlock_index $fd $after + return + } + + for {set i $batch} \ + {$update_index_cp < $total_cnt && $i > 0} \ + {incr i -1} { + set path [lindex $path_list $update_index_cp] + incr update_index_cp + + switch -glob -- [lindex $file_states($path) 0] { + AD {set new __} + ?D {set new D_} + _O - + AT - + AM {set new A_} + TM - + MT - + _T {set new T_} + _U - + U? { + if {[file exists $path]} { + set new M_ + } else { + set new D_ + } + } + ?M {set new M_} + ?? {continue} + } + puts -nonewline $fd "[encoding convertto utf-8 $path]\0" + display_file $path $new + } + + $status_bar_operation update $update_index_cp $total_cnt +} + +proc checkout_index {msg path_list after capture_error} { + global update_index_cp + + if {![lock_index update]} return + + set update_index_cp 0 + set path_list [lsort $path_list] + set total_cnt [llength $path_list] + set batch [expr {int($total_cnt * .01) + 1}] + if {$batch > 25} {set batch 25} + + set status_bar_operation [$::main_status start $msg [mc "files"]] + set fd [git_write checkout-index \ + --index \ + --quiet \ + --force \ + -z \ + --stdin \ + ] + fconfigure $fd \ + -blocking 0 \ + -buffering full \ + -buffersize 512 \ + -encoding binary \ + -translation binary + fileevent $fd writable [list \ + write_checkout_index \ + $fd \ + $path_list \ + $total_cnt \ + $batch \ + $status_bar_operation \ + $after \ + $capture_error \ + ] +} + +proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \ + after capture_error} { + global update_index_cp + global file_states current_diff_path + + if {$update_index_cp >= $total_cnt} { + $status_bar_operation stop + + # We do not unlock the index directly here because this + # operation expects to potentially run in parallel with file + # deletions scheduled by revert_helper. We're done with the + # update index, so we close it, but actually unlocking the index + # and dealing with potential errors is deferred to the chord + # body that runs when all async operations are completed. + # + # (See after_chord in revert_helper.) + + if {[catch {_close_updateindex $fd} err]} { + uplevel #0 $capture_error [list $err] + } + + uplevel #0 $after + + return + } + + for {set i $batch} \ + {$update_index_cp < $total_cnt && $i > 0} \ + {incr i -1} { + set path [lindex $path_list $update_index_cp] + incr update_index_cp + switch -glob -- [lindex $file_states($path) 0] { + U? {continue} + ?M - + ?T - + ?D { + puts -nonewline $fd "[encoding convertto utf-8 $path]\0" + display_file $path ?_ + } + } + } + + $status_bar_operation update $update_index_cp $total_cnt +} + +proc unstage_helper {txt paths} { + global file_states current_diff_path + + if {![lock_index begin-update]} return + + set path_list [list] + set after {} + foreach path $paths { + switch -glob -- [lindex $file_states($path) 0] { + A? - + M? - + T? - + D? { + lappend path_list $path + if {$path eq $current_diff_path} { + set after {reshow_diff;} + } + } + } + } + if {$path_list eq {}} { + unlock_index + } else { + update_indexinfo \ + $txt \ + $path_list \ + [concat $after [list ui_ready]] + } +} + +proc do_unstage_selection {} { + global current_diff_path selected_paths + + if {[array size selected_paths] > 0} { + unstage_helper \ + [mc "Unstaging selected files from commit"] \ + [array names selected_paths] + } elseif {$current_diff_path ne {}} { + unstage_helper \ + [mc "Unstaging %s from commit" [short_path $current_diff_path]] \ + [list $current_diff_path] + } +} + +proc add_helper {txt paths} { + global file_states current_diff_path + + if {![lock_index begin-update]} return + + set path_list [list] + set after {} + foreach path $paths { + switch -glob -- [lindex $file_states($path) 0] { + _U - + U? { + if {$path eq $current_diff_path} { + unlock_index + merge_stage_workdir $path + return + } + } + _O - + ?M - + ?D - + ?T { + lappend path_list $path + if {$path eq $current_diff_path} { + set after {reshow_diff;} + } + } + } + } + if {$path_list eq {}} { + unlock_index + } else { + update_index \ + $txt \ + $path_list \ + [concat $after {ui_status [mc "Ready to commit."]}] + } +} + +proc do_add_selection {} { + global current_diff_path selected_paths + + if {[array size selected_paths] > 0} { + add_helper \ + [mc "Adding selected files"] \ + [array names selected_paths] + } elseif {$current_diff_path ne {}} { + add_helper \ + [mc "Adding %s" [short_path $current_diff_path]] \ + [list $current_diff_path] + } +} + +proc do_add_all {} { + global file_states + + set paths [list] + set untracked_paths [list] + foreach path [array names file_states] { + switch -glob -- [lindex $file_states($path) 0] { + U? {continue} + ?M - + ?T - + ?D {lappend paths $path} + ?O {lappend untracked_paths $path} + } + } + if {[llength $untracked_paths]} { + set reply 0 + switch -- [get_config gui.stageuntracked] { + no { + set reply 0 + } + yes { + set reply 1 + } + ask - + default { + set reply [ask_popup [mc "Stage %d untracked files?" \ + [llength $untracked_paths]]] + } + } + if {$reply} { + set paths [concat $paths $untracked_paths] + } + } + add_helper [mc "Adding all changed files"] $paths +} + +# Copied from TclLib package "lambda". +proc lambda {arguments body args} { + return [list ::apply [list $arguments $body] {*}$args] +} + +proc revert_helper {txt paths} { + global file_states current_diff_path + + if {![lock_index begin-update]} return + + # Common "after" functionality that waits until multiple asynchronous + # operations are complete (by waiting for them to activate their notes + # on the chord). + # + # The asynchronous operations are each indicated below by a comment + # before the code block that starts the async operation. + set after_chord [SimpleChord::new { + if {[string trim $err] != ""} { + rescan_on_error $err + } else { + unlock_index + if {$should_reshow_diff} { reshow_diff } + ui_ready + } + }] + + $after_chord eval { set should_reshow_diff 0 } + + # This function captures an error for processing when after_chord is + # completed. (The chord is curried into the lambda function.) + set capture_error [lambda \ + {chord error} \ + { $chord eval [list set err $error] } \ + $after_chord] + + # We don't know how many notes we're going to create (it's dynamic based + # on conditional paths below), so create a common note that will delay + # the chord's completion until we activate it, and then activate it + # after all the other notes have been created. + set after_common_note [$after_chord add_note] + + set path_list [list] + set untracked_list [list] + + foreach path $paths { + switch -glob -- [lindex $file_states($path) 0] { + U? {continue} + ?O { + lappend untracked_list $path + } + ?M - + ?T - + ?D { + lappend path_list $path + if {$path eq $current_diff_path} { + $after_chord eval { set should_reshow_diff 1 } + } + } + } + } + + set path_cnt [llength $path_list] + set untracked_cnt [llength $untracked_list] + + # Asynchronous operation: revert changes by checking them out afresh + # from the index. + if {$path_cnt > 0} { + # Split question between singular and plural cases, because + # such distinction is needed in some languages. Previously, the + # code used "Revert changes in" for both, but that can't work + # in languages where 'in' must be combined with word from + # rest of string (in different way for both cases of course). + # + # FIXME: Unfortunately, even that isn't enough in some languages + # as they have quite complex plural-form rules. Unfortunately, + # msgcat doesn't seem to support that kind of string + # translation. + # + if {$path_cnt == 1} { + set query [mc \ + "Revert changes in file %s?" \ + [short_path [lindex $path_list]] \ + ] + } else { + set query [mc \ + "Revert changes in these %i files?" \ + $path_cnt] + } + + set reply [tk_dialog \ + .confirm_revert \ + "[appname] ([reponame])" \ + "$query + +[mc "Any unstaged changes will be permanently lost by the revert."]" \ + question \ + 1 \ + [mc "Do Nothing"] \ + [mc "Revert Changes"] \ + ] + + if {$reply == 1} { + set note [$after_chord add_note] + checkout_index \ + $txt \ + $path_list \ + [list $note activate] \ + $capture_error + } + } + + # Asynchronous operation: Deletion of untracked files. + if {$untracked_cnt > 0} { + # Split question between singular and plural cases, because + # such distinction is needed in some languages. + # + # FIXME: Unfortunately, even that isn't enough in some languages + # as they have quite complex plural-form rules. Unfortunately, + # msgcat doesn't seem to support that kind of string + # translation. + # + if {$untracked_cnt == 1} { + set query [mc \ + "Delete untracked file %s?" \ + [short_path [lindex $untracked_list]] \ + ] + } else { + set query [mc \ + "Delete these %i untracked files?" \ + $untracked_cnt \ + ] + } + + set reply [tk_dialog \ + .confirm_revert \ + "[appname] ([reponame])" \ + "$query + +[mc "Files will be permanently deleted."]" \ + question \ + 1 \ + [mc "Do Nothing"] \ + [mc "Delete Files"] \ + ] + + if {$reply == 1} { + $after_chord eval { set should_reshow_diff 1 } + + set note [$after_chord add_note] + delete_files $untracked_list [list $note activate] + } + } + + # Activate the common note. If no other notes were created, this + # completes the chord. If other notes were created, then this common + # note prevents a race condition where the chord might complete early. + $after_common_note activate +} + +# Delete all of the specified files, performing deletion in batches to allow the +# UI to remain responsive and updated. +proc delete_files {path_list after} { + # Enable progress bar status updates + set status_bar_operation [$::main_status \ + start \ + [mc "Deleting"] \ + [mc "files"]] + + set path_index 0 + set deletion_errors [list] + set batch_size 50 + + delete_helper \ + $path_list \ + $path_index \ + $deletion_errors \ + $batch_size \ + $status_bar_operation \ + $after +} + +# Helper function to delete a list of files in batches. Each call deletes one +# batch of files, and then schedules a call for the next batch after any UI +# messages have been processed. +proc delete_helper {path_list path_index deletion_errors batch_size \ + status_bar_operation after} { + global file_states + + set path_cnt [llength $path_list] + + set batch_remaining $batch_size + + while {$batch_remaining > 0} { + if {$path_index >= $path_cnt} { break } + + set path [lindex $path_list $path_index] + + set deletion_failed [catch {file delete -- $path} deletion_error] + + if {$deletion_failed} { + lappend deletion_errors [list "$deletion_error"] + } else { + remove_empty_directories [file dirname $path] + + # Don't assume the deletion worked. Remove the file from + # the UI, but only if it no longer exists. + if {![path_exists $path]} { + unset file_states($path) + display_file $path __ + } + } + + incr path_index 1 + incr batch_remaining -1 + } + + # Update the progress bar to indicate that this batch has been + # completed. The update will be visible when this procedure returns + # and allows the UI thread to process messages. + $status_bar_operation update $path_index $path_cnt + + if {$path_index < $path_cnt} { + # The Tcler's Wiki lists this as the best practice for keeping + # a UI active and processing messages during a long-running + # operation. + + after idle [list after 0 [list \ + delete_helper \ + $path_list \ + $path_index \ + $deletion_errors \ + $batch_size \ + $status_bar_operation \ + $after + ]] + } else { + # Finish the status bar operation. + $status_bar_operation stop + + # Report error, if any, based on how many deletions failed. + set deletion_error_cnt [llength $deletion_errors] + + if {($deletion_error_cnt > 0) + && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} { + set error_text [mc "Encountered errors deleting files:\n"] + + foreach deletion_error $deletion_errors { + append error_text "* [lindex $deletion_error 0]\n" + } + + error_popup $error_text + } elseif {$deletion_error_cnt == $path_cnt} { + error_popup [mc \ + "None of the %d selected files could be deleted." \ + $path_cnt \ + ] + } elseif {$deletion_error_cnt > 1} { + error_popup [mc \ + "%d of the %d selected files could not be deleted." \ + $deletion_error_cnt \ + $path_cnt \ + ] + } + + uplevel #0 $after + } +} + +proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; } + +# This function is from the TCL documentation: +# +# https://wiki.tcl-lang.org/page/file+exists +# +# [file exists] returns false if the path does exist but is a symlink to a path +# that doesn't exist. This proc returns true if the path exists, regardless of +# whether it is a symlink and whether it is broken. +proc path_exists {name} { + expr {![catch {file lstat $name finfo}]} +} + +# Remove as many empty directories as we can starting at the specified path, +# walking up the directory tree. If we encounter a directory that is not +# empty, or if a directory deletion fails, then we stop the operation and +# return to the caller. Even if this procedure fails to delete any +# directories at all, it does not report failure. +proc remove_empty_directories {directory_path} { + set parent_path [file dirname $directory_path] + + while {$parent_path != $directory_path} { + set contents [glob -nocomplain -dir $directory_path *] + + if {[llength $contents] > 0} { break } + if {[catch {file delete -- $directory_path}]} { break } + + set directory_path $parent_path + set parent_path [file dirname $directory_path] + } +} + +proc do_revert_selection {} { + global current_diff_path selected_paths + + if {[array size selected_paths] > 0} { + revert_helper \ + [mc "Reverting selected files"] \ + [array names selected_paths] + } elseif {$current_diff_path ne {}} { + revert_helper \ + [mc "Reverting %s" [short_path $current_diff_path]] \ + [list $current_diff_path] + } +} + +proc do_select_commit_type {} { + global commit_type commit_type_is_amend + + if {$commit_type_is_amend == 0 + && [string match amend* $commit_type]} { + create_new_commit + } elseif {$commit_type_is_amend == 1 + && ![string match amend* $commit_type]} { + load_last_commit + + # The amend request was rejected... + # + if {![string match amend* $commit_type]} { + set commit_type_is_amend 0 + } + } +} |