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, 0 insertions, 753 deletions
diff --git a/third_party/git/git-gui/lib/index.tcl b/third_party/git/git-gui/lib/index.tcl deleted file mode 100644 index d2ec24bd80e1..000000000000 --- a/third_party/git/git-gui/lib/index.tcl +++ /dev/null @@ -1,753 +0,0 @@ -# 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 {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 {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 - } - } -} |