Re: [PATCH v4 2/2] git-gui: revert untracked files by deleting them

> From: Jonathan Gilbert <JonathanG@iQmetrix.com>
> 
> Update the revert_helper proc to check for untracked files as well as
> changes, and then handle changes to be reverted and untracked files with
> independent blocks of code. Prompt the user independently for untracked
> files, since the underlying action is fundamentally different (rm -f).
> If after deleting untracked files, the directory containing them becomes
> empty, then remove the directory as well. Migrate unlocking of the index
> out of _close_updateindex to a responsibility of the caller, to permit
> paths that don't directly unlock the index, and refactor the error
> handling added in d4e890e5 so that callers can make flow control
> decisions in the event of errors. Rework status_bar to explicitly handle
> multiple overlapping operations, and update all call sites.
> 
> A new proc delete_files takes care of actually deleting the files in
> batches, using the Tcler's Wiki recommended approach for keeping the UI
> responsive.
> 
> Since the checkout_index and delete_files calls are both asynchronous
> and could potentially complete in any order, a "chord" is used to
> coordinate unlocking the index and returning the UI to a usable state
> only after both operations are complete. The `SimpleChord` class,
> based on TclOO (Tcl/Tk 8.6), is added in this commit.
> 
> Since the checkout_index and delete_files calls are both asynchronous
> and overlap, they clash in wanting to update the status bar. This commit
> reworks the status bar so that when an operation wants to display
> ongoing updates/progress, it explicitly starts an "operation", which is
> tracked by its own object, and the status bar handles multiple
> concurrent operations by merging their progress and concatenating their
> text.

> Signed-off-by: Jonathan Gilbert <JonathanG@iQmetrix.com>
> ---
>  git-gui.sh          |   7 +-
>  lib/checkout_op.tcl |  15 +-
>  lib/chord.tcl       | 160 ++++++++++++++++
>  lib/index.tcl       | 443 +++++++++++++++++++++++++++++++++++---------
>  lib/merge.tcl       |  14 +-
>  lib/status_bar.tcl  | 221 +++++++++++++++++++---
>  6 files changed, 734 insertions(+), 126 deletions(-)
>  create mode 100644 lib/chord.tcl
> 
> diff --git a/git-gui.sh b/git-gui.sh
> index 0d21f5688b..dc4ac577ac 100755
> --- a/git-gui.sh
> +++ b/git-gui.sh
> @@ -30,8 +30,8 @@ along with this program; if not, see <http://www.gnu.org/licenses/>.}]
>  ##
>  ## Tcl/Tk sanity check
>  
> -if {[catch {package require Tcl 8.4} err]
> - || [catch {package require Tk  8.4} err]
> +if {[catch {package require Tcl 8.6} err]
> + || [catch {package require Tk  8.6} err]
>  } {
>  	catch {wm withdraw .}
>  	tk_messageBox \
> @@ -4159,6 +4159,9 @@ if {$picked && [is_config_true gui.autoexplore]} {
>  	do_explore
>  }
>  
> +# Clear "Initializing..." status
> +after idle {after 500 {$main_status show ""}}

> +
>  # Local variables:
>  # mode: tcl
>  # indent-tabs-mode: t
> diff --git a/lib/checkout_op.tcl b/lib/checkout_op.tcl
> index a5228297db..21ea768d80 100644
> --- a/lib/checkout_op.tcl
> +++ b/lib/checkout_op.tcl
> @@ -341,9 +341,9 @@ method _readtree {} {
>  	global HEAD
>  
>  	set readtree_d {}
> -	$::main_status start \
> +	set status_bar_operation [$::main_status start \
>  		[mc "Updating working directory to '%s'..." [_name $this]] \
> -		[mc "files checked out"]
> +		[mc "files checked out"]]
>  
>  	set fd [git_read --stderr read-tree \
>  		-m \
> @@ -354,26 +354,27 @@ method _readtree {} {
>  		$new_hash \
>  		]
>  	fconfigure $fd -blocking 0 -translation binary
> -	fileevent $fd readable [cb _readtree_wait $fd]
> +	fileevent $fd readable [cb _readtree_wait $fd $status_bar_operation]
>  }
>  
> -method _readtree_wait {fd} {
> +method _readtree_wait {fd status_bar_operation} {
>  	global current_branch
>  
>  	set buf [read $fd]
> -	$::main_status update_meter $buf
> +	$status_bar_operation update_meter $buf
>  	append readtree_d $buf
>  
>  	fconfigure $fd -blocking 1
>  	if {![eof $fd]} {
>  		fconfigure $fd -blocking 0
> +		$status_bar_operation stop
>  		return
>  	}
>  
>  	if {[catch {close $fd}]} {
>  		set err $readtree_d
>  		regsub {^fatal: } $err {} err
> -		$::main_status stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]]
> +		$status_bar_operation stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]]
>  		warn_popup [strcat [mc "File level merge required."] "
>  
>  $err
> @@ -384,7 +385,7 @@ $err
>  		return
>  	}
>  
> -	$::main_status stop
> +	$status_bar_operation stop
>  	_after_readtree $this
>  }
>  
> diff --git a/lib/index.tcl b/lib/index.tcl
> index 28d4d2a54e..8d7590241e 100644
> --- a/lib/index.tcl
> +++ b/lib/index.tcl
> @@ -7,53 +7,63 @@ proc _delete_indexlock {} {
>  	}
>  }
>  
> -proc _close_updateindex {fd after} {
> -	global use_ttk NS
> -	fconfigure $fd -blocking 1
> -	if {[catch {close $fd} err]} {
> -		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
> +# Returns true if the operation succeeded, false if a rescan has been initiated.
> +proc close_and_unlock_updateindex_rescan_on_error {fd after} {

> +	if {![catch {_close_updateindex $fd} err]} {
>  		unlock_index
> -		rescan $after 0
> -		return
> +		uplevel #0 $after
> +		return 1
> +	} else {
> +		rescan_on_error $err $after
> +		return 0

>  	}
> +}
>  
> -	$::main_status stop
> +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
> -	uplevel #0 $after
> +	rescan [concat $after [list ui_ready]] 0
>  }
>  
>  proc update_indexinfo {msg path_list after} {
> @@ -67,7 +77,7 @@ proc update_indexinfo {msg path_list after} {
>  	set batch [expr {int($total_cnt * .01) + 1}]
>  	if {$batch > 25} {set batch 25}
>  
> -	$::main_status start $msg [mc "files"]
> +	set status_bar_operation [$::main_status start $msg [mc "files"]]
>  	set fd [git_write update-index -z --index-info]
>  	fconfigure $fd \
>  		-blocking 0 \
> @@ -81,16 +91,19 @@ proc update_indexinfo {msg path_list after} {
>  		$path_list \
>  		$total_cnt \
>  		$batch \
> +		$status_bar_operation \
>  		$after \
>  		]
>  }
>  
> -proc write_update_indexinfo {fd path_list total_cnt batch 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} {
> -		_close_updateindex $fd $after
> +		$status_bar_operation stop
> +		close_and_unlock_updateindex_rescan_on_error $fd $after
>  		return
>  	}
>  
> @@ -119,7 +132,7 @@ proc write_update_indexinfo {fd path_list total_cnt batch after} {
>  		display_file $path $new
>  	}
>  
> -	$::main_status update $update_index_cp $total_cnt
> +	$status_bar_operation update $update_index_cp $total_cnt
>  }
>  
>  proc update_index {msg path_list after} {
> @@ -133,7 +146,7 @@ proc update_index {msg path_list after} {
>  	set batch [expr {int($total_cnt * .01) + 1}]
>  	if {$batch > 25} {set batch 25}
>  
> -	$::main_status start $msg [mc "files"]
> +	set status_bar_operation [$::main_status start $msg [mc "files"]]
>  	set fd [git_write update-index --add --remove -z --stdin]
>  	fconfigure $fd \
>  		-blocking 0 \
> @@ -147,16 +160,19 @@ proc update_index {msg path_list after} {
>  		$path_list \
>  		$total_cnt \
>  		$batch \
> +		$status_bar_operation \
>  		$after \
>  		]
>  }
>  
> -proc write_update_index {fd path_list total_cnt batch 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} {
> -		_close_updateindex $fd $after
> +		$status_bar_operation stop
> +		close_and_unlock_updateindex_rescan_on_error $fd $after
>  		return
>  	}
>  
> @@ -190,10 +206,10 @@ proc write_update_index {fd path_list total_cnt batch after} {
>  		display_file $path $new
>  	}
>  
> -	$::main_status update $update_index_cp $total_cnt
> +	$status_bar_operation update $update_index_cp $total_cnt
>  }
>  
> -proc checkout_index {msg path_list after} {
> +proc checkout_index {msg path_list after capture_error} {
>  	global update_index_cp
>  
>  	if {![lock_index update]} return
> @@ -204,7 +220,7 @@ proc checkout_index {msg path_list after} {
>  	set batch [expr {int($total_cnt * .01) + 1}]
>  	if {$batch > 25} {set batch 25}
>  
> -	$::main_status start $msg [mc "files"]
> +	set status_bar_operation [$::main_status start $msg [mc "files"]]
>  	set fd [git_write checkout-index \
>  		--index \
>  		--quiet \
> @@ -224,16 +240,26 @@ proc checkout_index {msg path_list after} {
>  		$path_list \
>  		$total_cnt \
>  		$batch \
> +		$status_bar_operation \
>  		$after \
> +		$capture_error \
>  		]
>  }
>  
> -proc write_checkout_index {fd path_list total_cnt batch after} {
> +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} {
> -		_close_updateindex $fd $after
> +		$status_bar_operation stop
> +
> +		if {[catch {_close_updateindex $fd} err]} {

> +			uplevel #0 $capture_error [list $err]
> +		}
> +
> +		uplevel #0 $after
> +
>  		return
>  	}
>  
> diff --git a/lib/status_bar.tcl b/lib/status_bar.tcl
> index 02111a1742..6a73988b23 100644
> --- a/lib/status_bar.tcl
> +++ b/lib/status_bar.tcl
> @@ -1,16 +1,42 @@
>  # git-gui status bar mega-widget
>  # Copyright (C) 2007 Shawn Pearce
>  
> +# The status_bar class manages the entire status bar. It is possible for
> +# multiple overlapping asynchronous operations to want to display status
> +# simultaneously. Each one receives a status_bar_operation when it calls the
> +# start method, and the status bar combines all active operations into the
> +# line of text it displays. Most of the time, there will be at most one
> +# ongoing operation.
> +#
> +# Note that the entire status bar can be either in single-line or two-line
> +# mode, depending on the constructor. Multiple active operations are only
> +# supported for single-line status bars.
> +
>  class status_bar {
>  
> +field allow_multiple ; # configured at construction
> +
>  field w         ; # our own window path
>  field w_l       ; # text widget we draw messages into
>  field w_c       ; # canvas we draw a progress bar into
>  field c_pack    ; # script to pack the canvas with
> -field status  {}; # single line of text we show

> -field prefix  {}; # text we format into status
> -field units   {}; # unit of progress
> -field meter   {}; # current core git progress meter (if active)
> +
> +field baseline_text   ; # text to show if there are no operations
> +field status_bar_text ; # combined text for all operations
> +
> +field operations ; # list of current ongoing operations
> +
> +# The status bar can display a progress bar, updated when consumers call the
> +# update method on their status_bar_operation. When there are multiple
> +# operations, the status bar shows the combined status of all operations.
> +#
> +# When an overlapping operation completes, the progress bar is going to
> +# abruptly have one fewer operation in the calculation, causing a discontinuity.
> +# Therefore, whenever an operation completes, if it is not the last operation,
> +# this counter is increased, and the progress bar is calculated as though there
> +# were still another operation at 100%. When the last operation completes, this
> +# is reset to 0.
> +field completed_operation_count
>  
>  constructor new {path} {
>  	global use_ttk NS
> @@ -18,12 +44,19 @@ constructor new {path} {
>  	set w_l $w.l
>  	set w_c $w.c
>  
> +	# Standard single-line status bar: Permit overlapping operations
> +	set allow_multiple 1
> +
> +	set baseline_text ""
> +	set operations [list]
> +	set completed_operation_count 0
> +
>  	${NS}::frame $w
>  	if {!$use_ttk} {
>  		$w configure -borderwidth 1 -relief sunken
>  	}
>  	${NS}::label $w_l \
> -		-textvariable @status \
> +		-textvariable @status_bar_text \
>  		-anchor w \
>  		-justify left
>  	pack $w_l -side left
> @@ -44,9 +77,15 @@ constructor two_line {path} {
>  	set w_l $w.l
>  	set w_c $w.c
>  
> +	# Two-line status bar: Only one ongoing operation permitted.
> +	set allow_multiple 0
> +
> +	set baseline_text ""
> +	set operations [list]
> +
>  	${NS}::frame $w
>  	${NS}::label $w_l \
> -		-textvariable @status \
> +		-textvariable @status_bar_text \
>  		-anchor w \
>  		-justify left
>  	pack $w_l -anchor w -fill x
> @@ -56,7 +95,7 @@ constructor two_line {path} {
>  	return $this
>  }
>  
> -method start {msg uds} {
> +method ensure_canvas {} {
>  	if {[winfo exists $w_c]} {
>  		$w_c coords bar 0 0 0 20
>  	} else {
> @@ -68,31 +107,169 @@ method start {msg uds} {
>  		$w_c create rectangle 0 0 0 20 -tags bar -fill navy
>  		eval $c_pack
>  	}
> +}
> +
> +method show {msg {test {}}} {
> +	if {$test eq {} || $status eq $test} {
> +		$this ensure_canvas
> +		set baseline_text $msg
> +		$this refresh
> +	}
> +}
> +
> +method start {msg uds} {
> +	set baseline_text ""
> +
> +	if {!$allow_multiple && [llength $operations]} {

> +		return [lindex $operations 0]
> +	}
> +
> +	$this ensure_canvas
> +
> +	set operation [status_bar_operation::new $this $msg $uds]
> +
> +	lappend operations $operation
> +
> +	$this refresh
> +
> +	return $operation
> +}
> +
> +method refresh {} {
> +	set new_text ""
> +
> +	set total [expr $completed_operation_count * 100]
> +	set have $total
> +
> +	foreach operation $operations {
> +		if {$new_text != ""} {
> +			append new_text " / "
> +		}
> +
> +		append new_text [$operation get_status]
> +
> +		set total [expr $total + 100]
> +		set have [expr $have + [$operation get_progress]]
> +	}
> +
> +	if {$new_text == ""} {
> +		set new_text $baseline_text
> +	}
> +
> +	set status_bar_text $new_text
> +
> +	set pixel_width 0
> +	if {$have > 0} {
> +		set pixel_width [expr {[winfo width $w_c] * $have / $total}]
> +	}
> +
> +	$w_c coords bar 0 0 $pixel_width 20
> +}
> +
> +method stop {operation stop_msg} {
> +	set idx [lsearch $operations $operation]
> +
> +	if {$idx >= 0} {
> +		set operations [lreplace $operations $idx $idx]
> +		set completed_operation_count [expr \
> +			$completed_operation_count + 1]
> +
> +		if {[llength operations] == 0} {
> +			set completed_operation_count 0
> +
> +			destroy $w_c
> +			if {$stop_msg ne {}} {
> +				set baseline_text $stop_msg
> +			}
> +		}
> +
> +		$this refresh
> +	}
> +}
> +
> +method stop_all {{stop_msg {}}} {
> +	set operations_copy $operations
> +	set operations [list] # This makes the operation's call to stop a no-op.
> +
> +	foreach $operation operations_copy {
> +		$operation stop
> +	}
> +
> +	if {$stop_msg ne {}} {
> +		set baseline_text $stop_msg
> +	}
> +
> +	$this refresh
> +}
> +
> +method _delete {current} {
> +	if {$current eq $w} {
> +		delete_this
> +	}
> +}
> +
> +}
> +
> +# The status_bar_operation class tracks a single consumer's ongoing status bar
> +# activity, with the context that there are a few situations where multiple
> +# overlapping asynchronous operations might want to display status information
> +# simultaneously. Instances of status_bar_operation are created by calling
> +# start on the status_bar, and when the caller is done with its stauts bar
> +# operation, it calls stop on the operation.
> +
> +class status_bar_operation {
> +
> +field status_bar; # reference back to the status_bar that owns this object
> +
> +field is_active;
> +
> +field status   {}; # single line of text we show
> +field progress {}; # current progress (0 to 100)
> +field prefix   {}; # text we format into status
> +field units    {}; # unit of progress
> +field meter    {}; # current core git progress meter (if active)
> +
> +constructor new {owner msg uds} {
> +	set status_bar $owner
>  
>  	set status $msg
> +	set progress 0
>  	set prefix $msg
>  	set units  $uds
>  	set meter  {}
> +
> +	set is_active 1
> +
> +	return $this
>  }
>  
> +method get_is_active {} { return $is_active }
> +method get_status {} { return $status }
> +method get_progress {} { return $progress }
> +
>  method update {have total} {
> -	set pdone 0
> -	set cdone 0
> +	if {!$is_active} { return }
> +
> +	set progress 0
> +
>  	if {$total > 0} {
> -		set pdone [expr {100 * $have / $total}]
> -		set cdone [expr {[winfo width $w_c] * $have / $total}]
> +		set progress [expr {100 * $have / $total}]
>  	}
>  
>  	set prec [string length [format %i $total]]
> +
>  	set status [mc "%s ... %*i of %*i %s (%3i%%)" \
>  		$prefix \
>  		$prec $have \
>  		$prec $total \
> -		$units $pdone]
> -	$w_c coords bar 0 0 $cdone 20
> +		$units $progress]
> +
> +	$status_bar refresh
>  }
>  
>  method update_meter {buf} {
> +	if {!$is_active} { return }
> +
>  	append meter $buf
>  	set r [string last "\r" $meter]
>  	if {$r == -1} {
> @@ -109,23 +286,25 @@ method update_meter {buf} {
>  	}
>  }
>  
> -method stop {{msg {}}} {
> -	destroy $w_c
> -	if {$msg ne {}} {
> -		set status $msg
> +method stop {{stop_msg {}}} {
> +	if {$is_active} {
> +		set is_active 0
> +		$status_bar stop $this $stop_msg
>  	}
>  }
>  
>  method show {msg {test {}}} {
> +	if {!$is_active} { return }
> +
>  	if {$test eq {} || $status eq $test} {
>  		set status $msg
> +		$status_bar refresh
>  	}
>  }
>  
> -method _delete {current} {
> -	if {$current eq $w} {
> -		delete_this
> -	}
> +method _delete {} {
> +	stop
> +	delete_this
>  }
>  
>  }