diff options
Diffstat (limited to 'git-gui/lib')
| -rw-r--r-- | git-gui/lib/blame.tcl | 24 | ||||
| -rw-r--r-- | git-gui/lib/branch.tcl | 2 | ||||
| -rw-r--r-- | git-gui/lib/checkout_op.tcl | 21 | ||||
| -rw-r--r-- | git-gui/lib/choose_repository.tcl | 120 | ||||
| -rw-r--r-- | git-gui/lib/chord.tcl | 158 | ||||
| -rw-r--r-- | git-gui/lib/commit.tcl | 4 | ||||
| -rw-r--r-- | git-gui/lib/console.tcl | 2 | ||||
| -rw-r--r-- | git-gui/lib/diff.tcl | 129 | ||||
| -rw-r--r-- | git-gui/lib/index.tcl | 533 | ||||
| -rw-r--r-- | git-gui/lib/merge.tcl | 14 | ||||
| -rw-r--r-- | git-gui/lib/status_bar.tcl | 231 |
11 files changed, 986 insertions, 252 deletions
diff --git a/git-gui/lib/blame.tcl b/git-gui/lib/blame.tcl index a1aeb8b96e2d..62ec08366768 100644 --- a/git-gui/lib/blame.tcl +++ b/git-gui/lib/blame.tcl @@ -24,6 +24,7 @@ field w_cviewer ; # pane showing commit message field finder ; # find mini-dialog frame field gotoline ; # line goto mini-dialog frame field status ; # status mega-widget instance +field status_operation ; # operation displayed by status mega-widget field old_height ; # last known height of $w.file_pane @@ -274,6 +275,7 @@ constructor new {i_commit i_path i_jump} { pack $w_cviewer -expand 1 -fill both set status [::status_bar::new $w.status] + set status_operation {} menu $w.ctxm -tearoff 0 $w.ctxm add command \ @@ -602,16 +604,23 @@ method _exec_blame {cur_w cur_d options cur_s} { } else { lappend options $commit } + + # We may recurse in from another call to _exec_blame and already have + # a status operation. + if {$status_operation == {}} { + set status_operation [$status start \ + $cur_s \ + [mc "lines annotated"]] + } else { + $status_operation restart $cur_s + } + lappend options -- $path set fd [eval git_read --nice blame $options] fconfigure $fd -blocking 0 -translation lf -encoding utf-8 fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d] set current_fd $fd set blame_lines 0 - - $status start \ - $cur_s \ - [mc "lines annotated"] } method _read_blame {fd cur_w cur_d} { @@ -806,10 +815,11 @@ method _read_blame {fd cur_w cur_d} { [mc "Loading original location annotations..."] } else { set current_fd {} - $status stop [mc "Annotation complete."] + $status_operation stop [mc "Annotation complete."] + set status_operation {} } } else { - $status update $blame_lines $total_lines + $status_operation update $blame_lines $total_lines } } ifdeleted { catch {close $fd} } @@ -1124,7 +1134,7 @@ method _blameparent {} { set diffcmd [list diff-tree --unified=0 $cparent $cmit -- $new_path] } if {[catch {set fd [eval git_read $diffcmd]} err]} { - $status stop [mc "Unable to display parent"] + $status_operation stop [mc "Unable to display parent"] error_popup [strcat [mc "Error loading diff:"] "\n\n$err"] return } diff --git a/git-gui/lib/branch.tcl b/git-gui/lib/branch.tcl index 777eeb79c135..8b0c4858890f 100644 --- a/git-gui/lib/branch.tcl +++ b/git-gui/lib/branch.tcl @@ -8,6 +8,7 @@ proc load_all_heads {} { set rh_len [expr {[string length $rh] + 1}] set all_heads [list] set fd [git_read for-each-ref --format=%(refname) $rh] + fconfigure $fd -translation binary -encoding utf-8 while {[gets $fd line] > 0} { if {!$some_heads_tracking || ![is_tracking_branch $line]} { lappend all_heads [string range $line $rh_len end] @@ -24,6 +25,7 @@ proc load_all_tags {} { --sort=-taggerdate \ --format=%(refname) \ refs/tags] + fconfigure $fd -translation binary -encoding utf-8 while {[gets $fd line] > 0} { if {![regsub ^refs/tags/ $line {} name]} continue lappend all_tags $name diff --git a/git-gui/lib/checkout_op.tcl b/git-gui/lib/checkout_op.tcl index 9e7412c446f7..21ea768d8036 100644 --- a/git-gui/lib/checkout_op.tcl +++ b/git-gui/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,12 +385,12 @@ $err return } - $::main_status stop + $status_bar_operation stop _after_readtree $this } method _after_readtree {} { - global selected_commit_type commit_type HEAD MERGE_HEAD PARENT + global commit_type HEAD MERGE_HEAD PARENT global current_branch is_detached global ui_comm @@ -490,12 +491,12 @@ method _update_repo_state {} { # amend mode our file lists are accurate and we can avoid # the rescan. # - global selected_commit_type commit_type HEAD MERGE_HEAD PARENT + global commit_type_is_amend commit_type HEAD MERGE_HEAD PARENT global ui_comm unlock_index set name [_name $this] - set selected_commit_type new + set commit_type_is_amend 0 if {[string match amend* $commit_type]} { $ui_comm delete 0.0 end $ui_comm edit reset diff --git a/git-gui/lib/choose_repository.tcl b/git-gui/lib/choose_repository.tcl index 80f5a59bbbfc..e54f3e66d8f0 100644 --- a/git-gui/lib/choose_repository.tcl +++ b/git-gui/lib/choose_repository.tcl @@ -9,6 +9,18 @@ field w_body ; # Widget holding the center content field w_next ; # Next button field w_quit ; # Quit button field o_cons ; # Console object (if active) + +# Status mega-widget instance during _do_clone2 (used by _copy_files and +# _link_files). Widget is destroyed before _do_clone2 calls +# _do_clone_checkout +field o_status + +# Operation displayed by status mega-widget during _do_clone_checkout => +# _readtree_wait => _postcheckout_wait => _do_clone_submodules => +# _do_validate_submodule_cloning. The status mega-widget is a different +# instance than that stored in $o_status in earlier operations. +field o_status_op + field w_types ; # List of type buttons in clone field w_recentlist ; # Listbox containing recent repositories field w_localpath ; # Entry widget bound to local_path @@ -659,12 +671,12 @@ method _do_clone2 {} { switch -exact -- $clone_type { hardlink { - set o_cons [status_bar::two_line $w_body] + set o_status [status_bar::two_line $w_body] pack $w_body -fill x -padx 10 -pady 10 - $o_cons start \ + set status_op [$o_status start \ [mc "Counting objects"] \ - [mc "buckets"] + [mc "buckets"]] update if {[file exists [file join $objdir info alternates]]} { @@ -689,6 +701,7 @@ method _do_clone2 {} { } err]} { catch {cd $pwd} _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] + $status_op stop return } } @@ -700,7 +713,7 @@ method _do_clone2 {} { -directory [file join $objdir] ??] set bcnt [expr {[llength $buckets] + 2}] set bcur 1 - $o_cons update $bcur $bcnt + $status_op update $bcur $bcnt update file mkdir [file join .git objects pack] @@ -708,7 +721,7 @@ method _do_clone2 {} { -directory [file join $objdir pack] *] { lappend tolink [file join pack $i] } - $o_cons update [incr bcur] $bcnt + $status_op update [incr bcur] $bcnt update foreach i $buckets { @@ -717,10 +730,10 @@ method _do_clone2 {} { -directory [file join $objdir $i] *] { lappend tolink [file join $i $j] } - $o_cons update [incr bcur] $bcnt + $status_op update [incr bcur] $bcnt update } - $o_cons stop + $status_op stop if {$tolink eq {}} { info_popup [strcat \ @@ -747,6 +760,8 @@ method _do_clone2 {} { if {!$i} return destroy $w_body + + set o_status {} } full { set o_cons [console::embed \ @@ -781,9 +796,9 @@ method _do_clone2 {} { } method _copy_files {objdir tocopy} { - $o_cons start \ + set status_op [$o_status start \ [mc "Copying objects"] \ - [mc "KiB"] + [mc "KiB"]] set tot 0 set cmp 0 foreach p $tocopy { @@ -798,7 +813,7 @@ method _copy_files {objdir tocopy} { while {![eof $f_in]} { incr cmp [fcopy $f_in $f_cp -size 16384] - $o_cons update \ + $status_op update \ [expr {$cmp / 1024}] \ [expr {$tot / 1024}] update @@ -808,17 +823,19 @@ method _copy_files {objdir tocopy} { close $f_cp } err]} { _clone_failed $this [mc "Unable to copy object: %s" $err] + $status_op stop return 0 } } + $status_op stop return 1 } method _link_files {objdir tolink} { set total [llength $tolink] - $o_cons start \ + set status_op [$o_status start \ [mc "Linking objects"] \ - [mc "objects"] + [mc "objects"]] for {set i 0} {$i < $total} {} { set p [lindex $tolink $i] if {[catch { @@ -827,15 +844,17 @@ method _link_files {objdir tolink} { [file join $objdir $p] } err]} { _clone_failed $this [mc "Unable to hardlink object: %s" $err] + $status_op stop return 0 } incr i if {$i % 5 == 0} { - $o_cons update $i $total + $status_op update $i $total update } } + $status_op stop return 1 } @@ -958,11 +977,26 @@ method _do_clone_checkout {HEAD} { return } - set o_cons [status_bar::two_line $w_body] + set status [status_bar::two_line $w_body] pack $w_body -fill x -padx 10 -pady 10 - $o_cons start \ + + # We start the status operation here. + # + # This function calls _readtree_wait as a callback. + # + # _readtree_wait in turn either calls _do_clone_submodules directly, + # or calls _postcheckout_wait as a callback which then calls + # _do_clone_submodules. + # + # _do_clone_submodules calls _do_validate_submodule_cloning. + # + # _do_validate_submodule_cloning stops the status operation. + # + # There are no other calls into this chain from other code. + + set o_status_op [$status start \ [mc "Creating working directory"] \ - [mc "files"] + [mc "files"]] set readtree_err {} set fd [git_read --stderr read-tree \ @@ -976,33 +1010,9 @@ method _do_clone_checkout {HEAD} { fileevent $fd readable [cb _readtree_wait $fd] } -method _do_validate_submodule_cloning {ok} { - if {$ok} { - $o_cons done $ok - set done 1 - } else { - _clone_failed $this [mc "Cannot clone submodules."] - } -} - -method _do_clone_submodules {} { - if {$recursive eq {true}} { - destroy $w_body - set o_cons [console::embed \ - $w_body \ - [mc "Cloning submodules"]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git submodule update --init --recursive] \ - [cb _do_validate_submodule_cloning] - } else { - set done 1 - } -} - method _readtree_wait {fd} { set buf [read $fd] - $o_cons update_meter $buf + $o_status_op update_meter $buf append readtree_err $buf fconfigure $fd -blocking 1 @@ -1050,6 +1060,34 @@ method _postcheckout_wait {fd_ph} { fconfigure $fd_ph -blocking 0 } +method _do_clone_submodules {} { + if {$recursive eq {true}} { + $o_status_op stop + set o_status_op {} + + destroy $w_body + + set o_cons [console::embed \ + $w_body \ + [mc "Cloning submodules"]] + pack $w_body -fill both -expand 1 -padx 10 + $o_cons exec \ + [list git submodule update --init --recursive] \ + [cb _do_validate_submodule_cloning] + } else { + set done 1 + } +} + +method _do_validate_submodule_cloning {ok} { + if {$ok} { + $o_cons done $ok + set done 1 + } else { + _clone_failed $this [mc "Cannot clone submodules."] + } +} + ###################################################################### ## ## Open Existing Repository diff --git a/git-gui/lib/chord.tcl b/git-gui/lib/chord.tcl new file mode 100644 index 000000000000..e21e7d3d0b79 --- /dev/null +++ b/git-gui/lib/chord.tcl @@ -0,0 +1,158 @@ +# Simple Chord for Tcl +# +# A "chord" is a method with more than one entrypoint and only one body, such +# that the body runs only once all the entrypoints have been called by +# different asynchronous tasks. In this implementation, the chord is defined +# dynamically for each invocation. A SimpleChord object is created, supplying +# body script to be run when the chord is completed, and then one or more notes +# are added to the chord. Each note can be called like a proc, and returns +# immediately if the chord isn't yet complete. When the last remaining note is +# called, the body runs before the note returns. +# +# The SimpleChord class has a constructor that takes the body script, and a +# method add_note that returns a note object. Since the body script does not +# run in the context of the procedure that defined it, a mechanism is provided +# for injecting variables into the chord for use by the body script. The +# activation of a note is idempotent; multiple calls have the same effect as +# a simple call. +# +# If you are invoking asynchronous operations with chord notes as completion +# callbacks, and there is a possibility that earlier operations could complete +# before later ones are started, it is a good practice to create a "common" +# note on the chord that prevents it from being complete until you're certain +# you've added all the notes you need. +# +# Example: +# +# # Turn off the UI while running a couple of async operations. +# lock_ui +# +# set chord [SimpleChord::new { +# unlock_ui +# # Note: $notice here is not referenced in the calling scope +# if {$notice} { info_popup $notice } +# } +# +# # Configure a note to keep the chord from completing until +# # all operations have been initiated. +# set common_note [$chord add_note] +# +# # Activate notes in 'after' callbacks to other operations +# set newnote [$chord add_note] +# async_operation $args [list $newnote activate] +# +# # Communicate with the chord body +# if {$condition} { +# # This sets $notice in the same context that the chord body runs in. +# $chord eval { set notice "Something interesting" } +# } +# +# # Activate the common note, making the chord eligible to complete +# $common_note activate +# +# At this point, the chord will complete at some unknown point in the future. +# The common note might have been the first note activated, or the async +# operations might have completed synchronously and the common note is the +# last one, completing the chord before this code finishes, or anything in +# between. The purpose of the chord is to not have to worry about the order. + +# SimpleChord class: +# Represents a procedure that conceptually has multiple entrypoints that must +# all be called before the procedure executes. Each entrypoint is called a +# "note". The chord is only "completed" when all the notes are "activated". +class SimpleChord { + field notes + field body + field is_completed + field eval_ns + + # Constructor: + # set chord [SimpleChord::new {body}] + # Creates a new chord object with the specified body script. The + # body script is evaluated at most once, when a note is activated + # and the chord has no other non-activated notes. + constructor new {i_body} { + set notes [list] + set body $i_body + set is_completed 0 + set eval_ns "[namespace qualifiers $this]::eval" + return $this + } + + # Method: + # $chord eval {script} + # Runs the specified script in the same context (namespace) in which + # the chord body will be evaluated. This can be used to set variable + # values for the chord body to use. + method eval {script} { + namespace eval $eval_ns $script + } + + # Method: + # set note [$chord add_note] + # Adds a new note to the chord, an instance of ChordNote. Raises an + # error if the chord is already completed, otherwise the chord is + # updated so that the new note must also be activated before the + # body is evaluated. + method add_note {} { + if {$is_completed} { error "Cannot add a note to a completed chord" } + + set note [ChordNote::new $this] + + lappend notes $note + + return $note + } + + # This method is for internal use only and is intentionally undocumented. + method notify_note_activation {} { + if {!$is_completed} { + foreach note $notes { + if {![$note is_activated]} { return } + } + + set is_completed 1 + + namespace eval $eval_ns $body + delete_this + } + } +} + +# ChordNote class: +# Represents a note within a chord, providing a way to activate it. When the +# final note of the chord is activated (this can be any note in the chord, +# with all other notes already previously activated in any order), the chord's +# body is evaluated. +class ChordNote { + field chord + field is_activated + + # Constructor: + # Instances of ChordNote are created internally by calling add_note on + # SimpleChord objects. + constructor new {c} { + set chord $c + set is_activated 0 + return $this + } + + # Method: + # [$note is_activated] + # Returns true if this note has already been activated. + method is_activated {} { + return $is_activated + } + + # Method: + # $note activate + # Activates the note, if it has not already been activated, and + # completes the chord if there are no other notes awaiting + # activation. Subsequent calls will have no further effect. + method activate {} { + if {!$is_activated} { + set is_activated 1 + $chord notify_note_activation + } + } +} diff --git a/git-gui/lib/commit.tcl b/git-gui/lib/commit.tcl index 75ea965dacd7..b516aa299069 100644 --- a/git-gui/lib/commit.tcl +++ b/git-gui/lib/commit.tcl @@ -333,7 +333,7 @@ proc commit_writetree {curHEAD msg_p} { proc commit_committree {fd_wt curHEAD msg_p} { global HEAD PARENT MERGE_HEAD commit_type commit_author global current_branch - global ui_comm selected_commit_type + global ui_comm commit_type_is_amend global file_states selected_paths rescan_active global repo_config global env @@ -467,8 +467,8 @@ A rescan will be automatically started now. # -- Update in memory status # - set selected_commit_type new set commit_type normal + set commit_type_is_amend 0 set HEAD $cmt_id set PARENT $cmt_id set MERGE_HEAD [list] diff --git a/git-gui/lib/console.tcl b/git-gui/lib/console.tcl index 1f3248ffd113..bb6b9c889e20 100644 --- a/git-gui/lib/console.tcl +++ b/git-gui/lib/console.tcl @@ -203,6 +203,8 @@ method done {ok} { focus $w.ok } } + + bind $w <Key-Escape> "destroy $w;break" } method _sb_set {sb orient first last} { diff --git a/git-gui/lib/diff.tcl b/git-gui/lib/diff.tcl index 68c4a6c7366f..871ad488c2a1 100644 --- a/git-gui/lib/diff.tcl +++ b/git-gui/lib/diff.tcl @@ -55,7 +55,7 @@ proc reshow_diff {{after {}}} { proc force_diff_encoding {enc} { global current_diff_path - + if {$current_diff_path ne {}} { force_path_encoding $current_diff_path $enc reshow_diff @@ -270,19 +270,6 @@ proc show_other_diff {path w m cont_info} { } } -proc get_conflict_marker_size {path} { - set size 7 - catch { - set fd_rc [eval [list git_read check-attr "conflict-marker-size" -- $path]] - set ret [gets $fd_rc line] - close $fd_rc - if {$ret > 0} { - regexp {.*: conflict-marker-size: (\d+)$} $line line size - } - } - return $size -} - proc start_show_diff {cont_info {add_opts {}}} { global file_states file_lists global is_3way_diff is_submodule_diff diff_active repo_config @@ -298,7 +285,7 @@ proc start_show_diff {cont_info {add_opts {}}} { set is_submodule_diff 0 set diff_active 1 set current_diff_header {} - set conflict_size [get_conflict_marker_size $path] + set conflict_size [gitattr $path conflict-marker-size 7] set cmd [list] if {$w eq $ui_index} { @@ -360,6 +347,10 @@ proc start_show_diff {cont_info {add_opts {}}} { } set ::current_diff_inheader 1 + # Detect pre-image lines of the diff3 conflict-style. They are just + # '++' lines which is not bijective. Thus, we need to maintain a state + # across lines. + set ::conflict_in_pre_image 0 fconfigure $fd \ -blocking 0 \ -encoding [get_path_encoding $path] \ @@ -462,11 +453,23 @@ proc read_diff {fd conflict_size cont_info} { {--} {set tags d_--} {++} { set regexp [string map [list %conflict_size $conflict_size]\ - {^\+\+([<>=]){%conflict_size}(?: |$)}] + {^\+\+([<>=|]){%conflict_size}(?: |$)}] if {[regexp $regexp $line _g op]} { set is_conflict_diff 1 set line [string replace $line 0 1 { }] set tags d$op + + # The ||| conflict-marker marks the start of the pre-image. + # All those lines are also prefixed with '++'. Thus we need + # to maintain this state. + set ::conflict_in_pre_image [expr {$op eq {|}}] + } elseif {$::conflict_in_pre_image} { + # This is a pre-image line. It is the one which both sides + # are based on. As it has also the '++' line start, it is + # normally shown as 'added'. Invert this to '--' to make + # it a 'removed' line. + set line [string replace $line 0 1 {--}] + set tags d_-- } else { set tags d_++ } @@ -567,24 +570,31 @@ proc read_diff {fd conflict_size cont_info} { } } -proc apply_hunk {x y} { +proc apply_or_revert_hunk {x y revert} { global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states + global ui_diff ui_index file_states last_revert last_revert_enc if {$current_diff_path eq {} || $current_diff_header eq {}} return if {![lock_index apply_hunk]} return - set apply_cmd {apply --cached --whitespace=nowarn} + set apply_cmd {apply --whitespace=nowarn} set mi [lindex $file_states($current_diff_path) 0] if {$current_diff_side eq $ui_index} { set failed_msg [mc "Failed to unstage selected hunk."] - lappend apply_cmd --reverse + lappend apply_cmd --reverse --cached if {[string index $mi 0] ne {M}} { unlock_index return } } else { - set failed_msg [mc "Failed to stage selected hunk."] + if {$revert} { + set failed_msg [mc "Failed to revert selected hunk."] + lappend apply_cmd --reverse + } else { + set failed_msg [mc "Failed to stage selected hunk."] + lappend apply_cmd --cached + } + if {[string index $mi 1] ne {M}} { unlock_index return @@ -603,29 +613,40 @@ proc apply_hunk {x y} { set e_lno end } + set wholepatch "$current_diff_header[$ui_diff get $s_lno $e_lno]" + if {[catch { set enc [get_path_encoding $current_diff_path] set p [eval git_write $apply_cmd] fconfigure $p -translation binary -encoding $enc - puts -nonewline $p $current_diff_header - puts -nonewline $p [$ui_diff get $s_lno $e_lno] + puts -nonewline $p $wholepatch close $p} err]} { error_popup "$failed_msg\n\n$err" unlock_index return } + if {$revert} { + # Save a copy of this patch for undoing reverts. + set last_revert $wholepatch + set last_revert_enc $enc + } + $ui_diff conf -state normal $ui_diff delete $s_lno $e_lno $ui_diff conf -state disabled + # Check if the hunk was the last one in the file. if {[$ui_diff get 1.0 end] eq "\n"} { set o _ } else { set o ? } - if {$current_diff_side eq $ui_index} { + # Update the status flags. + if {$revert} { + set mi [string index $mi 0]$o + } elseif {$current_diff_side eq $ui_index} { set mi ${o}M } elseif {[string index $mi 0] eq {_}} { set mi M$o @@ -640,9 +661,9 @@ proc apply_hunk {x y} { } } -proc apply_range_or_line {x y} { +proc apply_or_revert_range_or_line {x y revert} { global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states + global ui_diff ui_index file_states last_revert set selected [$ui_diff tag nextrange sel 0.0] @@ -660,19 +681,27 @@ proc apply_range_or_line {x y} { if {$current_diff_path eq {} || $current_diff_header eq {}} return if {![lock_index apply_hunk]} return - set apply_cmd {apply --cached --whitespace=nowarn} + set apply_cmd {apply --whitespace=nowarn} set mi [lindex $file_states($current_diff_path) 0] if {$current_diff_side eq $ui_index} { set failed_msg [mc "Failed to unstage selected line."] set to_context {+} - lappend apply_cmd --reverse + lappend apply_cmd --reverse --cached if {[string index $mi 0] ne {M}} { unlock_index return } } else { - set failed_msg [mc "Failed to stage selected line."] - set to_context {-} + if {$revert} { + set failed_msg [mc "Failed to revert selected line."] + set to_context {+} + lappend apply_cmd --reverse + } else { + set failed_msg [mc "Failed to stage selected line."] + set to_context {-} + lappend apply_cmd --cached + } + if {[string index $mi 1] ne {M}} { unlock_index return @@ -830,7 +859,47 @@ proc apply_range_or_line {x y} { puts -nonewline $p $wholepatch close $p} err]} { error_popup "$failed_msg\n\n$err" + unlock_index + return + } + + if {$revert} { + # Save a copy of this patch for undoing reverts. + set last_revert $current_diff_header$wholepatch + set last_revert_enc $enc + } + + unlock_index +} + +# Undo the last line/hunk reverted. When hunks and lines are reverted, a copy +# of the diff applied is saved. Re-apply that diff to undo the revert. +# +# Right now, we only use a single variable to hold the copy, and not a +# stack/deque for simplicity, so multiple undos are not possible. Maybe this +# can be added if the need for something like this is felt in the future. +proc undo_last_revert {} { + global last_revert current_diff_path current_diff_header + global last_revert_enc + + if {$last_revert eq {}} return + if {![lock_index apply_hunk]} return + + set apply_cmd {apply --whitespace=nowarn} + set failed_msg [mc "Failed to undo last revert."] + + if {[catch { + set enc $last_revert_enc + set p [eval git_write $apply_cmd] + fconfigure $p -translation binary -encoding $enc + puts -nonewline $p $last_revert + close $p} err]} { + error_popup "$failed_msg\n\n$err" + unlock_index + return } + set last_revert {} + unlock_index } diff --git a/git-gui/lib/index.tcl b/git-gui/lib/index.tcl index b588db11d9fc..1fc5b42300d6 100644 --- a/git-gui/lib/index.tcl +++ b/git-gui/lib/index.tcl @@ -7,67 +7,74 @@ 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 +proc close_and_unlock_index {fd after} { + if {![catch {_close_updateindex $fd} err]} { unlock_index - rescan $after 0 - return + uplevel #0 $after + } else { + rescan_on_error $err $after } +} - $::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 pathList after} { +proc update_indexinfo {msg path_list after} { global update_index_cp if {![lock_index update]} return set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] + 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} - $::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 \ @@ -78,26 +85,29 @@ proc update_indexinfo {msg pathList after} { fileevent $fd writable [list \ write_update_indexinfo \ $fd \ - $pathList \ - $totalCnt \ + $path_list \ + $total_cnt \ $batch \ + $status_bar_operation \ $after \ ] } -proc write_update_indexinfo {fd pathList totalCnt 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 >= $totalCnt} { - _close_updateindex $fd $after + if {$update_index_cp >= $total_cnt} { + $status_bar_operation stop + close_and_unlock_index $fd $after return } for {set i $batch} \ - {$update_index_cp < $totalCnt && $i > 0} \ + {$update_index_cp < $total_cnt && $i > 0} \ {incr i -1} { - set path [lindex $pathList $update_index_cp] + set path [lindex $path_list $update_index_cp] incr update_index_cp set s $file_states($path) @@ -119,21 +129,21 @@ proc write_update_indexinfo {fd pathList totalCnt batch after} { display_file $path $new } - $::main_status update $update_index_cp $totalCnt + $status_bar_operation update $update_index_cp $total_cnt } -proc update_index {msg pathList after} { +proc update_index {msg path_list after} { global update_index_cp if {![lock_index update]} return set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] + 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} - $::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 \ @@ -144,26 +154,29 @@ proc update_index {msg pathList after} { fileevent $fd writable [list \ write_update_index \ $fd \ - $pathList \ - $totalCnt \ + $path_list \ + $total_cnt \ $batch \ + $status_bar_operation \ $after \ ] } -proc write_update_index {fd pathList totalCnt 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 >= $totalCnt} { - _close_updateindex $fd $after + if {$update_index_cp >= $total_cnt} { + $status_bar_operation stop + close_and_unlock_index $fd $after return } for {set i $batch} \ - {$update_index_cp < $totalCnt && $i > 0} \ + {$update_index_cp < $total_cnt && $i > 0} \ {incr i -1} { - set path [lindex $pathList $update_index_cp] + set path [lindex $path_list $update_index_cp] incr update_index_cp switch -glob -- [lindex $file_states($path) 0] { @@ -190,21 +203,21 @@ proc write_update_index {fd pathList totalCnt batch after} { display_file $path $new } - $::main_status update $update_index_cp $totalCnt + $status_bar_operation update $update_index_cp $total_cnt } -proc checkout_index {msg pathList after} { +proc checkout_index {msg path_list after capture_error} { global update_index_cp if {![lock_index update]} return set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] + 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} - $::main_status start $msg [mc "files"] + set status_bar_operation [$::main_status start $msg [mc "files"]] set fd [git_write checkout-index \ --index \ --quiet \ @@ -221,26 +234,45 @@ proc checkout_index {msg pathList after} { fileevent $fd writable [list \ write_checkout_index \ $fd \ - $pathList \ - $totalCnt \ + $path_list \ + $total_cnt \ $batch \ + $status_bar_operation \ $after \ + $capture_error \ ] } -proc write_checkout_index {fd pathList totalCnt 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 >= $totalCnt} { - _close_updateindex $fd $after + 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 < $totalCnt && $i > 0} \ + {$update_index_cp < $total_cnt && $i > 0} \ {incr i -1} { - set path [lindex $pathList $update_index_cp] + set path [lindex $path_list $update_index_cp] incr update_index_cp switch -glob -- [lindex $file_states($path) 0] { U? {continue} @@ -253,7 +285,7 @@ proc write_checkout_index {fd pathList totalCnt batch after} { } } - $::main_status update $update_index_cp $totalCnt + $status_bar_operation update $update_index_cp $total_cnt } proc unstage_helper {txt paths} { @@ -261,7 +293,7 @@ proc unstage_helper {txt paths} { if {![lock_index begin-update]} return - set pathList [list] + set path_list [list] set after {} foreach path $paths { switch -glob -- [lindex $file_states($path) 0] { @@ -269,19 +301,19 @@ proc unstage_helper {txt paths} { M? - T? - D? { - lappend pathList $path + lappend path_list $path if {$path eq $current_diff_path} { set after {reshow_diff;} } } } } - if {$pathList eq {}} { + if {$path_list eq {}} { unlock_index } else { update_indexinfo \ $txt \ - $pathList \ + $path_list \ [concat $after [list ui_ready]] } } @@ -305,7 +337,7 @@ proc add_helper {txt paths} { if {![lock_index begin-update]} return - set pathList [list] + set path_list [list] set after {} foreach path $paths { switch -glob -- [lindex $file_states($path) 0] { @@ -321,19 +353,19 @@ proc add_helper {txt paths} { ?M - ?D - ?T { - lappend pathList $path + lappend path_list $path if {$path eq $current_diff_path} { set after {reshow_diff;} } } } } - if {$pathList eq {}} { + if {$path_list eq {}} { unlock_index } else { update_index \ $txt \ - $pathList \ + $path_list \ [concat $after {ui_status [mc "Ready to commit."]}] } } @@ -388,66 +420,303 @@ proc do_add_all {} { 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 - set pathList [list] - set after {} + # 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 pathList $path + lappend path_list $path if {$path eq $current_diff_path} { - set after {reshow_diff;} + $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] + } - # 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. - # - set n [llength $pathList] - if {$n == 0} { - unlock_index - return - } elseif {$n == 1} { - set query [mc "Revert changes in file %s?" [short_path [lindex $pathList]]] - } else { - set query [mc "Revert changes in these %i files?" $n] + 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 + } } - set reply [tk_dialog \ - .confirm_revert \ - "[appname] ([reponame])" \ - "$query + # 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 \ + ] + } -[mc "Any unstaged changes will be permanently lost by the revert."]" \ - question \ - 1 \ - [mc "Do Nothing"] \ - [mc "Revert Changes"] \ - ] - if {$reply == 1} { - checkout_index \ - $txt \ - $pathList \ - [concat $after [list ui_ready]] + 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 { - unlock_index + # 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] } } @@ -466,19 +735,19 @@ proc do_revert_selection {} { } proc do_select_commit_type {} { - global commit_type selected_commit_type + global commit_type commit_type_is_amend - if {$selected_commit_type eq {new} + if {$commit_type_is_amend == 0 && [string match amend* $commit_type]} { create_new_commit - } elseif {$selected_commit_type eq {amend} + } 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 selected_commit_type new + set commit_type_is_amend 0 } } } diff --git a/git-gui/lib/merge.tcl b/git-gui/lib/merge.tcl index 9f253db5b37e..664803cf3fd1 100644 --- a/git-gui/lib/merge.tcl +++ b/git-gui/lib/merge.tcl @@ -241,23 +241,27 @@ Continue with resetting the current changes?"] if {[ask_popup $op_question] eq {yes}} { set fd [git_read --stderr read-tree --reset -u -v HEAD] fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [namespace code [list _reset_wait $fd]] - $::main_status start [mc "Aborting"] [mc "files reset"] + set status_bar_operation [$::main_status \ + start \ + [mc "Aborting"] \ + [mc "files reset"]] + fileevent $fd readable [namespace code [list \ + _reset_wait $fd $status_bar_operation]] } else { unlock_index } } -proc _reset_wait {fd} { +proc _reset_wait {fd status_bar_operation} { global ui_comm - $::main_status update_meter [read $fd] + $status_bar_operation update_meter [read $fd] fconfigure $fd -blocking 1 if {[eof $fd]} { set fail [catch {close $fd} err] - $::main_status stop unlock_index + $status_bar_operation stop $ui_comm delete 0.0 end $ui_comm edit modified false diff --git a/git-gui/lib/status_bar.tcl b/git-gui/lib/status_bar.tcl index 02111a1742f9..d32b14142ff8 100644 --- a/git-gui/lib/status_bar.tcl +++ b/git-gui/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,16 @@ 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] + set completed_operation_count 0 + ${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 +96,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 +108,170 @@ method start {msg uds} { $w_c create rectangle 0 0 0 20 -tags bar -fill navy eval $c_pack } +} + +method show {msg} { + $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 + + if {[winfo exists $w_c]} { + 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 {}}} { + # This makes the operation's call to stop a no-op. + set operations_copy $operations + set operations [list] + + 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 +288,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 {$test eq {} || $status eq $test} { - set status $msg - } +method restart {msg} { + if {!$is_active} { return } + + set status $msg + set prefix $msg + set meter {} + $status_bar refresh } -method _delete {current} { - if {$current eq $w} { - delete_this - } +method _delete {} { + stop + delete_this } } |