diff options
Diffstat (limited to 'third_party/git/git-gui/lib')
| -rw-r--r-- | third_party/git/git-gui/lib/blame.tcl | 24 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/branch.tcl | 2 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/checkout_op.tcl | 21 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/choose_repository.tcl | 120 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/chord.tcl | 158 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/commit.tcl | 4 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/console.tcl | 2 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/diff.tcl | 129 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/index.tcl | 533 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/merge.tcl | 14 | ||||
| -rw-r--r-- | third_party/git/git-gui/lib/status_bar.tcl | 231 |
11 files changed, 252 insertions, 986 deletions
diff --git a/third_party/git/git-gui/lib/blame.tcl b/third_party/git/git-gui/lib/blame.tcl index 62ec083667..a1aeb8b96e 100644 --- a/third_party/git/git-gui/lib/blame.tcl +++ b/third_party/git/git-gui/lib/blame.tcl @@ -24,7 +24,6 @@ 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 @@ -275,7 +274,6 @@ 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 \ @@ -604,23 +602,16 @@ 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} { @@ -815,11 +806,10 @@ method _read_blame {fd cur_w cur_d} { [mc "Loading original location annotations..."] } else { set current_fd {} - $status_operation stop [mc "Annotation complete."] - set status_operation {} + $status stop [mc "Annotation complete."] } } else { - $status_operation update $blame_lines $total_lines + $status update $blame_lines $total_lines } } ifdeleted { catch {close $fd} } @@ -1134,7 +1124,7 @@ method _blameparent {} { set diffcmd [list diff-tree --unified=0 $cparent $cmit -- $new_path] } if {[catch {set fd [eval git_read $diffcmd]} err]} { - $status_operation stop [mc "Unable to display parent"] + $status stop [mc "Unable to display parent"] error_popup [strcat [mc "Error loading diff:"] "\n\n$err"] return } diff --git a/third_party/git/git-gui/lib/branch.tcl b/third_party/git/git-gui/lib/branch.tcl index 8b0c485889..777eeb79c1 100644 --- a/third_party/git/git-gui/lib/branch.tcl +++ b/third_party/git/git-gui/lib/branch.tcl @@ -8,7 +8,6 @@ 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] @@ -25,7 +24,6 @@ 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/third_party/git/git-gui/lib/checkout_op.tcl b/third_party/git/git-gui/lib/checkout_op.tcl index 21ea768d80..9e7412c446 100644 --- a/third_party/git/git-gui/lib/checkout_op.tcl +++ b/third_party/git/git-gui/lib/checkout_op.tcl @@ -341,9 +341,9 @@ method _readtree {} { global HEAD set readtree_d {} - set status_bar_operation [$::main_status start \ + $::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,27 +354,26 @@ method _readtree {} { $new_hash \ ] fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _readtree_wait $fd $status_bar_operation] + fileevent $fd readable [cb _readtree_wait $fd] } -method _readtree_wait {fd status_bar_operation} { +method _readtree_wait {fd} { global current_branch set buf [read $fd] - $status_bar_operation update_meter $buf + $::main_status 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 - $status_bar_operation stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]] + $::main_status stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]] warn_popup [strcat [mc "File level merge required."] " $err @@ -385,12 +384,12 @@ $err return } - $status_bar_operation stop + $::main_status stop _after_readtree $this } method _after_readtree {} { - global commit_type HEAD MERGE_HEAD PARENT + global selected_commit_type commit_type HEAD MERGE_HEAD PARENT global current_branch is_detached global ui_comm @@ -491,12 +490,12 @@ method _update_repo_state {} { # amend mode our file lists are accurate and we can avoid # the rescan. # - global commit_type_is_amend commit_type HEAD MERGE_HEAD PARENT + global selected_commit_type commit_type HEAD MERGE_HEAD PARENT global ui_comm unlock_index set name [_name $this] - set commit_type_is_amend 0 + set selected_commit_type new if {[string match amend* $commit_type]} { $ui_comm delete 0.0 end $ui_comm edit reset diff --git a/third_party/git/git-gui/lib/choose_repository.tcl b/third_party/git/git-gui/lib/choose_repository.tcl index e54f3e66d8..80f5a59bbb 100644 --- a/third_party/git/git-gui/lib/choose_repository.tcl +++ b/third_party/git/git-gui/lib/choose_repository.tcl @@ -9,18 +9,6 @@ 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 @@ -671,12 +659,12 @@ method _do_clone2 {} { switch -exact -- $clone_type { hardlink { - set o_status [status_bar::two_line $w_body] + set o_cons [status_bar::two_line $w_body] pack $w_body -fill x -padx 10 -pady 10 - set status_op [$o_status start \ + $o_cons start \ [mc "Counting objects"] \ - [mc "buckets"]] + [mc "buckets"] update if {[file exists [file join $objdir info alternates]]} { @@ -701,7 +689,6 @@ method _do_clone2 {} { } err]} { catch {cd $pwd} _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] - $status_op stop return } } @@ -713,7 +700,7 @@ method _do_clone2 {} { -directory [file join $objdir] ??] set bcnt [expr {[llength $buckets] + 2}] set bcur 1 - $status_op update $bcur $bcnt + $o_cons update $bcur $bcnt update file mkdir [file join .git objects pack] @@ -721,7 +708,7 @@ method _do_clone2 {} { -directory [file join $objdir pack] *] { lappend tolink [file join pack $i] } - $status_op update [incr bcur] $bcnt + $o_cons update [incr bcur] $bcnt update foreach i $buckets { @@ -730,10 +717,10 @@ method _do_clone2 {} { -directory [file join $objdir $i] *] { lappend tolink [file join $i $j] } - $status_op update [incr bcur] $bcnt + $o_cons update [incr bcur] $bcnt update } - $status_op stop + $o_cons stop if {$tolink eq {}} { info_popup [strcat \ @@ -760,8 +747,6 @@ method _do_clone2 {} { if {!$i} return destroy $w_body - - set o_status {} } full { set o_cons [console::embed \ @@ -796,9 +781,9 @@ method _do_clone2 {} { } method _copy_files {objdir tocopy} { - set status_op [$o_status start \ + $o_cons start \ [mc "Copying objects"] \ - [mc "KiB"]] + [mc "KiB"] set tot 0 set cmp 0 foreach p $tocopy { @@ -813,7 +798,7 @@ method _copy_files {objdir tocopy} { while {![eof $f_in]} { incr cmp [fcopy $f_in $f_cp -size 16384] - $status_op update \ + $o_cons update \ [expr {$cmp / 1024}] \ [expr {$tot / 1024}] update @@ -823,19 +808,17 @@ 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] - set status_op [$o_status start \ + $o_cons start \ [mc "Linking objects"] \ - [mc "objects"]] + [mc "objects"] for {set i 0} {$i < $total} {} { set p [lindex $tolink $i] if {[catch { @@ -844,17 +827,15 @@ 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} { - $status_op update $i $total + $o_cons update $i $total update } } - $status_op stop return 1 } @@ -977,26 +958,11 @@ method _do_clone_checkout {HEAD} { return } - set status [status_bar::two_line $w_body] + set o_cons [status_bar::two_line $w_body] pack $w_body -fill x -padx 10 -pady 10 - - # 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 \ + $o_cons start \ [mc "Creating working directory"] \ - [mc "files"]] + [mc "files"] set readtree_err {} set fd [git_read --stderr read-tree \ @@ -1010,9 +976,33 @@ 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_status_op update_meter $buf + $o_cons update_meter $buf append readtree_err $buf fconfigure $fd -blocking 1 @@ -1060,34 +1050,6 @@ 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/third_party/git/git-gui/lib/chord.tcl b/third_party/git/git-gui/lib/chord.tcl deleted file mode 100644 index e21e7d3d0b..0000000000 --- a/third_party/git/git-gui/lib/chord.tcl +++ /dev/null @@ -1,158 +0,0 @@ -# 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/third_party/git/git-gui/lib/commit.tcl b/third_party/git/git-gui/lib/commit.tcl index b516aa2990..75ea965dac 100644 --- a/third_party/git/git-gui/lib/commit.tcl +++ b/third_party/git/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 commit_type_is_amend + global ui_comm selected_commit_type 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/third_party/git/git-gui/lib/console.tcl b/third_party/git/git-gui/lib/console.tcl index bb6b9c889e..1f3248ffd1 100644 --- a/third_party/git/git-gui/lib/console.tcl +++ b/third_party/git/git-gui/lib/console.tcl @@ -203,8 +203,6 @@ method done {ok} { focus $w.ok } } - - bind $w <Key-Escape> "destroy $w;break" } method _sb_set {sb orient first last} { diff --git a/third_party/git/git-gui/lib/diff.tcl b/third_party/git/git-gui/lib/diff.tcl index 871ad488c2..68c4a6c736 100644 --- a/third_party/git/git-gui/lib/diff.tcl +++ b/third_party/git/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,6 +270,19 @@ 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 @@ -285,7 +298,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 [gitattr $path conflict-marker-size 7] + set conflict_size [get_conflict_marker_size $path] set cmd [list] if {$w eq $ui_index} { @@ -347,10 +360,6 @@ 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] \ @@ -453,23 +462,11 @@ 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_++ } @@ -570,31 +567,24 @@ proc read_diff {fd conflict_size cont_info} { } } -proc apply_or_revert_hunk {x y revert} { +proc apply_hunk {x y} { global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states last_revert last_revert_enc + global ui_diff ui_index file_states if {$current_diff_path eq {} || $current_diff_header eq {}} return if {![lock_index apply_hunk]} return - set apply_cmd {apply --whitespace=nowarn} + set apply_cmd {apply --cached --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 --cached + lappend apply_cmd --reverse if {[string index $mi 0] ne {M}} { unlock_index return } } else { - 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 - } - + set failed_msg [mc "Failed to stage selected hunk."] if {[string index $mi 1] ne {M}} { unlock_index return @@ -613,40 +603,29 @@ proc apply_or_revert_hunk {x y revert} { 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 $wholepatch + puts -nonewline $p $current_diff_header + puts -nonewline $p [$ui_diff get $s_lno $e_lno] 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 ? } - # Update the status flags. - if {$revert} { - set mi [string index $mi 0]$o - } elseif {$current_diff_side eq $ui_index} { + if {$current_diff_side eq $ui_index} { set mi ${o}M } elseif {[string index $mi 0] eq {_}} { set mi M$o @@ -661,9 +640,9 @@ proc apply_or_revert_hunk {x y revert} { } } -proc apply_or_revert_range_or_line {x y revert} { +proc apply_range_or_line {x y} { global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states last_revert + global ui_diff ui_index file_states set selected [$ui_diff tag nextrange sel 0.0] @@ -681,27 +660,19 @@ proc apply_or_revert_range_or_line {x y revert} { if {$current_diff_path eq {} || $current_diff_header eq {}} return if {![lock_index apply_hunk]} return - set apply_cmd {apply --whitespace=nowarn} + set apply_cmd {apply --cached --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 --cached + lappend apply_cmd --reverse if {[string index $mi 0] ne {M}} { unlock_index return } } else { - 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 - } - + set failed_msg [mc "Failed to stage selected line."] + set to_context {-} if {[string index $mi 1] ne {M}} { unlock_index return @@ -859,47 +830,7 @@ proc apply_or_revert_range_or_line {x y revert} { 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/third_party/git/git-gui/lib/index.tcl b/third_party/git/git-gui/lib/index.tcl index 1fc5b42300..b588db11d9 100644 --- a/third_party/git/git-gui/lib/index.tcl +++ b/third_party/git/git-gui/lib/index.tcl @@ -7,74 +7,67 @@ proc _delete_indexlock {} { } } -proc close_and_unlock_index {fd after} { - if {![catch {_close_updateindex $fd} err]} { +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 unlock_index - uplevel #0 $after - } else { - rescan_on_error $err $after + rescan $after 0 + return } -} -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 + $::main_status stop unlock_index - rescan [concat $after [list ui_ready]] 0 + uplevel #0 $after } -proc update_indexinfo {msg path_list after} { +proc update_indexinfo {msg pathList 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}] + set pathList [lsort $pathList] + set totalCnt [llength $pathList] + set batch [expr {int($totalCnt * .01) + 1}] if {$batch > 25} {set batch 25} - set status_bar_operation [$::main_status start $msg [mc "files"]] + $::main_status start $msg [mc "files"] set fd [git_write update-index -z --index-info] fconfigure $fd \ -blocking 0 \ @@ -85,29 +78,26 @@ proc update_indexinfo {msg path_list after} { fileevent $fd writable [list \ write_update_indexinfo \ $fd \ - $path_list \ - $total_cnt \ + $pathList \ + $totalCnt \ $batch \ - $status_bar_operation \ $after \ ] } -proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \ - after} { +proc write_update_indexinfo {fd pathList totalCnt batch 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 + if {$update_index_cp >= $totalCnt} { + _close_updateindex $fd $after return } for {set i $batch} \ - {$update_index_cp < $total_cnt && $i > 0} \ + {$update_index_cp < $totalCnt && $i > 0} \ {incr i -1} { - set path [lindex $path_list $update_index_cp] + set path [lindex $pathList $update_index_cp] incr update_index_cp set s $file_states($path) @@ -129,21 +119,21 @@ proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \ display_file $path $new } - $status_bar_operation update $update_index_cp $total_cnt + $::main_status update $update_index_cp $totalCnt } -proc update_index {msg path_list after} { +proc update_index {msg pathList 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}] + set pathList [lsort $pathList] + set totalCnt [llength $pathList] + set batch [expr {int($totalCnt * .01) + 1}] if {$batch > 25} {set batch 25} - set status_bar_operation [$::main_status start $msg [mc "files"]] + $::main_status start $msg [mc "files"] set fd [git_write update-index --add --remove -z --stdin] fconfigure $fd \ -blocking 0 \ @@ -154,29 +144,26 @@ proc update_index {msg path_list after} { fileevent $fd writable [list \ write_update_index \ $fd \ - $path_list \ - $total_cnt \ + $pathList \ + $totalCnt \ $batch \ - $status_bar_operation \ $after \ ] } -proc write_update_index {fd path_list total_cnt batch status_bar_operation \ - after} { +proc write_update_index {fd pathList totalCnt batch 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 + if {$update_index_cp >= $totalCnt} { + _close_updateindex $fd $after return } for {set i $batch} \ - {$update_index_cp < $total_cnt && $i > 0} \ + {$update_index_cp < $totalCnt && $i > 0} \ {incr i -1} { - set path [lindex $path_list $update_index_cp] + set path [lindex $pathList $update_index_cp] incr update_index_cp switch -glob -- [lindex $file_states($path) 0] { @@ -203,21 +190,21 @@ proc write_update_index {fd path_list total_cnt batch status_bar_operation \ display_file $path $new } - $status_bar_operation update $update_index_cp $total_cnt + $::main_status update $update_index_cp $totalCnt } -proc checkout_index {msg path_list after capture_error} { +proc checkout_index {msg pathList 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}] + set pathList [lsort $pathList] + set totalCnt [llength $pathList] + set batch [expr {int($totalCnt * .01) + 1}] if {$batch > 25} {set batch 25} - set status_bar_operation [$::main_status start $msg [mc "files"]] + $::main_status start $msg [mc "files"] set fd [git_write checkout-index \ --index \ --quiet \ @@ -234,45 +221,26 @@ proc checkout_index {msg path_list after capture_error} { fileevent $fd writable [list \ write_checkout_index \ $fd \ - $path_list \ - $total_cnt \ + $pathList \ + $totalCnt \ $batch \ - $status_bar_operation \ $after \ - $capture_error \ ] } -proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \ - after capture_error} { +proc write_checkout_index {fd pathList totalCnt batch after} { 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 - + if {$update_index_cp >= $totalCnt} { + _close_updateindex $fd $after return } for {set i $batch} \ - {$update_index_cp < $total_cnt && $i > 0} \ + {$update_index_cp < $totalCnt && $i > 0} \ {incr i -1} { - set path [lindex $path_list $update_index_cp] + set path [lindex $pathList $update_index_cp] incr update_index_cp switch -glob -- [lindex $file_states($path) 0] { U? {continue} @@ -285,7 +253,7 @@ proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \ } } - $status_bar_operation update $update_index_cp $total_cnt + $::main_status update $update_index_cp $totalCnt } proc unstage_helper {txt paths} { @@ -293,7 +261,7 @@ proc unstage_helper {txt paths} { if {![lock_index begin-update]} return - set path_list [list] + set pathList [list] set after {} foreach path $paths { switch -glob -- [lindex $file_states($path) 0] { @@ -301,19 +269,19 @@ proc unstage_helper {txt paths} { M? - T? - D? { - lappend path_list $path + lappend pathList $path if {$path eq $current_diff_path} { set after {reshow_diff;} } } } } - if {$path_list eq {}} { + if {$pathList eq {}} { unlock_index } else { update_indexinfo \ $txt \ - $path_list \ + $pathList \ [concat $after [list ui_ready]] } } @@ -337,7 +305,7 @@ proc add_helper {txt paths} { if {![lock_index begin-update]} return - set path_list [list] + set pathList [list] set after {} foreach path $paths { switch -glob -- [lindex $file_states($path) 0] { @@ -353,19 +321,19 @@ proc add_helper {txt paths} { ?M - ?D - ?T { - lappend path_list $path + lappend pathList $path if {$path eq $current_diff_path} { set after {reshow_diff;} } } } } - if {$path_list eq {}} { + if {$pathList eq {}} { unlock_index } else { update_index \ $txt \ - $path_list \ + $pathList \ [concat $after {ui_status [mc "Ready to commit."]}] } } @@ -420,303 +388,66 @@ 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 - # 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] - + set pathList [list] + set after {} foreach path $paths { switch -glob -- [lindex $file_states($path) 0] { U? {continue} - ?O { - lappend untracked_list $path - } ?M - ?T - ?D { - lappend path_list $path + lappend pathList $path if {$path eq $current_diff_path} { - $after_chord eval { set should_reshow_diff 1 } + set after {reshow_diff;} } } } } - 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 - ]] + # 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 { - # 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 + set query [mc "Revert changes in these %i files?" $n] } -} -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 *] + set reply [tk_dialog \ + .confirm_revert \ + "[appname] ([reponame])" \ + "$query - if {[llength $contents] > 0} { break } - if {[catch {file delete -- $directory_path}]} { break } - - set directory_path $parent_path - set parent_path [file dirname $directory_path] +[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]] + } else { + unlock_index } } @@ -735,19 +466,19 @@ proc do_revert_selection {} { } proc do_select_commit_type {} { - global commit_type commit_type_is_amend + global commit_type selected_commit_type - if {$commit_type_is_amend == 0 + if {$selected_commit_type eq {new} && [string match amend* $commit_type]} { create_new_commit - } elseif {$commit_type_is_amend == 1 + } elseif {$selected_commit_type eq {amend} && ![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 + set selected_commit_type new } } } diff --git a/third_party/git/git-gui/lib/merge.tcl b/third_party/git/git-gui/lib/merge.tcl index 664803cf3f..9f253db5b3 100644 --- a/third_party/git/git-gui/lib/merge.tcl +++ b/third_party/git/git-gui/lib/merge.tcl @@ -241,27 +241,23 @@ 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 - set status_bar_operation [$::main_status \ - start \ - [mc "Aborting"] \ - [mc "files reset"]] - fileevent $fd readable [namespace code [list \ - _reset_wait $fd $status_bar_operation]] + fileevent $fd readable [namespace code [list _reset_wait $fd]] + $::main_status start [mc "Aborting"] [mc "files reset"] } else { unlock_index } } -proc _reset_wait {fd status_bar_operation} { +proc _reset_wait {fd} { global ui_comm - $status_bar_operation update_meter [read $fd] + $::main_status 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/third_party/git/git-gui/lib/status_bar.tcl b/third_party/git/git-gui/lib/status_bar.tcl index d32b14142f..02111a1742 100644 --- a/third_party/git/git-gui/lib/status_bar.tcl +++ b/third_party/git/git-gui/lib/status_bar.tcl @@ -1,42 +1,16 @@ # 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 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 +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) constructor new {path} { global use_ttk NS @@ -44,19 +18,12 @@ 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_bar_text \ + -textvariable @status \ -anchor w \ -justify left pack $w_l -side left @@ -77,16 +44,9 @@ 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_bar_text \ + -textvariable @status \ -anchor w \ -justify left pack $w_l -anchor w -fill x @@ -96,7 +56,7 @@ constructor two_line {path} { return $this } -method ensure_canvas {} { +method start {msg uds} { if {[winfo exists $w_c]} { $w_c coords bar 0 0 0 20 } else { @@ -108,170 +68,31 @@ method ensure_canvas {} { $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} { - if {!$is_active} { return } - - set progress 0 - + set pdone 0 + set cdone 0 if {$total > 0} { - set progress [expr {100 * $have / $total}] + set pdone [expr {100 * $have / $total}] + set cdone [expr {[winfo width $w_c] * $have / $total}] } set prec [string length [format %i $total]] - set status [mc "%s ... %*i of %*i %s (%3i%%)" \ $prefix \ $prec $have \ $prec $total \ - $units $progress] - - $status_bar refresh + $units $pdone] + $w_c coords bar 0 0 $cdone 20 } method update_meter {buf} { - if {!$is_active} { return } - append meter $buf set r [string last "\r" $meter] if {$r == -1} { @@ -288,25 +109,23 @@ method update_meter {buf} { } } -method stop {{stop_msg {}}} { - if {$is_active} { - set is_active 0 - $status_bar stop $this $stop_msg +method stop {{msg {}}} { + destroy $w_c + if {$msg ne {}} { + set status $msg } } -method restart {msg} { - if {!$is_active} { return } - - set status $msg - set prefix $msg - set meter {} - $status_bar refresh +method show {msg {test {}}} { + if {$test eq {} || $status eq $test} { + set status $msg + } } -method _delete {} { - stop - delete_this +method _delete {current} { + if {$current eq $w} { + delete_this + } } } |