# 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 } } }