opensourcemirror
/
git
mirror of https://github.com/git/git.git
1
0
Fork 0
Code Issues Releases Wiki Activity

Merge https://github.com/prati0100/git-gui 

* https://github.com/prati0100/git-gui:
  git-gui: allow opening currently selected file in default app
  git-gui: allow closing console window with Escape
  git gui: fix branch name encoding error
  git-gui: revert untracked files by deleting them
  git-gui: update status bar to track operations
  git-gui: consolidate naming conventions
This commit is contained in:
Junio C Hamano 2020-01-08 11:17:16 -08:00
parent 042ed3e048 0d2116c644
commit fe47c9cb5f
10 changed files with 922 additions and 234 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
git-gui/git-gui.sh
View File

@ -30,8 +30,8 @@ along with this program; if not, see <http://www.gnu.org/licenses/>.}]
##
## Tcl/Tk sanity check
if {[catch {package require Tcl 8.4} err]
|| [catch {package require Tk 8.4} err]
if {[catch {package require Tcl 8.6} err]
|| [catch {package require Tk 8.6} err]
} {
catch {wm withdraw .}
tk_messageBox \
@ -684,6 +684,7 @@ proc load_current_branch {} {
global current_branch is_detached
set fd [open [gitdir HEAD] r]
fconfigure $fd -translation binary -encoding utf-8
if {[gets $fd ref] < 1} {
set ref {}
}
@ -1797,10 +1798,10 @@ proc ui_status {msg} {
}
}
proc ui_ready {{test {}}} {
proc ui_ready {} {
global main_status
if {[info exists main_status]} {
$main_status show [mc "Ready."] $test
$main_status show [mc "Ready."]
}
}
@ -2150,8 +2151,6 @@ proc incr_font_size {font {amt 1}} {
##
## ui commands
set starting_gitk_msg [mc "Starting gitk... please wait..."]
proc do_gitk {revs {is_submodule false}} {
global current_diff_path file_states current_diff_side ui_index
global _gitdir _gitworktree
@ -2206,10 +2205,11 @@ proc do_gitk {revs {is_submodule false}} {
set env(GIT_WORK_TREE) $_gitworktree
cd $pwd
ui_status $::starting_gitk_msg
after 10000 {
ui_ready $starting_gitk_msg
}
set status_operation [$::main_status \
start \
[mc "Starting %s... please wait..." "gitk"]]
after 3500 [list $status_operation stop]
}
}
@ -2240,16 +2240,16 @@ proc do_git_gui {} {
set env(GIT_WORK_TREE) $_gitworktree
cd $pwd
ui_status $::starting_gitk_msg
after 10000 {
ui_ready $starting_gitk_msg
}
set status_operation [$::main_status \
start \
[mc "Starting %s... please wait..." "git-gui"]]
after 3500 [list $status_operation stop]
}
}
proc do_explore {} {
global _gitworktree
set explorer {}
# Get the system-specific explorer app/command.
proc get_explorer {} {
if {[is_Cygwin] || [is_Windows]} {
set explorer "explorer.exe"
} elseif {[is_MacOSX]} {
@ -2258,9 +2258,23 @@ proc do_explore {} {
# freedesktop.org-conforming system is our best shot
set explorer "xdg-open"
}
return $explorer
}
proc do_explore {} {
global _gitworktree
set explorer [get_explorer]
eval exec $explorer [list [file nativename $_gitworktree]] &
}
# Open file relative to the working tree by the default associated app.
proc do_file_open {file} {
global _gitworktree
set explorer [get_explorer]
set full_file_path [file join $_gitworktree $file]
exec $explorer [file nativename $full_file_path] &
}
set is_quitting 0
set ret_code 1
@ -3512,9 +3526,11 @@ tlabel .vpane.lower.diff.header.file \
-justify left
tlabel .vpane.lower.diff.header.path \
-background gold \
-foreground black \
-foreground blue \
-anchor w \
-justify left
-justify left \
-font [eval font create [font configure font_ui] -underline 1] \
-cursor hand2
pack .vpane.lower.diff.header.status -side left
pack .vpane.lower.diff.header.file -side left
pack .vpane.lower.diff.header.path -fill x
@ -3529,8 +3545,12 @@ $ctxm add command \
-type STRING \
-- $current_diff_path
}
$ctxm add command \
-label [mc Open] \
-command {do_file_open $current_diff_path}
lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
bind .vpane.lower.diff.header.path <Button-1> {do_file_open $current_diff_path}
# -- Diff Body
#
@ -4159,6 +4179,9 @@ if {$picked && [is_config_true gui.autoexplore]} {
do_explore
}
# Clear "Initializing..." status
after 500 {$main_status show ""}
# Local variables:
# mode: tcl
# indent-tabs-mode: t

24
git-gui/lib/blame.tcl
View File

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

2
git-gui/lib/branch.tcl
View File

@ -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

15
git-gui/lib/checkout_op.tcl
View File

@ -341,9 +341,9 @@ method _readtree {} {
global HEAD
set readtree_d {}
$::main_status start \
set status_bar_operation [$::main_status start \
[mc "Updating working directory to '%s'..." [_name $this]] \
[mc "files checked out"]
[mc "files checked out"]]
set fd [git_read --stderr read-tree \
-m \
@ -354,26 +354,27 @@ method _readtree {} {
$new_hash \
]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [cb _readtree_wait $fd]
fileevent $fd readable [cb _readtree_wait $fd $status_bar_operation]
}
method _readtree_wait {fd} {
method _readtree_wait {fd status_bar_operation} {
global current_branch
set buf [read $fd]
$::main_status update_meter $buf
$status_bar_operation update_meter $buf
append readtree_d $buf
fconfigure $fd -blocking 1
if {![eof $fd]} {
fconfigure $fd -blocking 0
$status_bar_operation stop
return
}
if {[catch {close $fd}]} {
set err $readtree_d
regsub {^fatal: } $err {} err
$::main_status stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]]
$status_bar_operation stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]]
warn_popup [strcat [mc "File level merge required."] "
$err
@ -384,7 +385,7 @@ $err
return
}
$::main_status stop
$status_bar_operation stop
_after_readtree $this
}

120
git-gui/lib/choose_repository.tcl
View File

@ -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

160
git-gui/lib/chord.tcl Normal file
View File

@ -0,0 +1,160 @@
# 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]
#
# # Pass notes as 'after' callbacks to other operations
# async_operation $args [$chord add_note]
# other_async_operation $args [$chord add_note]
#
# # 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
#
# 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".
oo::class create SimpleChord {
variable notes body is_completed
# 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 {body} {
set notes [list]
my eval [list set body $body]
set is_completed 0
}
# 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 [self] $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 [self]]
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 [self] $body
namespace delete [self]
}
}
}
# 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.
oo::class create ChordNote {
variable chord is_activated
# Constructor:
# Instances of ChordNote are created internally by calling add_note on
# SimpleChord objects.
constructor {chord} {
my eval set chord $chord
set is_activated 0
}
# Method:
# [$note is_activated]
# Returns true if this note has already been activated.
method is_activated {} {
return $is_activated
}
# Method:
# $note
# 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.
#
# NB: In TclOO, if an object is invoked like a method without supplying
# any method name, then this internal method `unknown` is what
# actually runs (with no parameters). It is used in the ChordNote
# class for the purpose of allowing the note object to be called as
# a function (see example above). (The `unknown` method can also be
# used to support dynamic dispatch, but must take parameters to
# identify the "unknown" method to be invoked. In this form, this
# proc serves only to make instances behave directly like methods.)
method unknown {} {
if {!$is_activated} {
set is_activated 1
$chord notify_note_activation
}
}
}

2
git-gui/lib/console.tcl
View File

@ -203,6 +203,8 @@ method done {ok} {
focus $w.ok
}
}
bind $w <Key-Escape> "destroy $w;break"
}
method _sb_set {sb orient first last} {

527
git-gui/lib/index.tcl
View File

@ -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
unlock_index
uplevel #0 $after
}
proc update_indexinfo {msg pathList after} {
proc _close_updateindex {fd} {
fconfigure $fd -blocking 1
close $fd
}
proc rescan_on_error {err {after {}}} {
global use_ttk NS
set w .indexfried
Dialog $w
wm withdraw $w
wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."]
text $w.msg -yscrollcommand [list $w.vs set] \
-width [string length $s] -relief flat \
-borderwidth 0 -highlightthickness 0 \
-background [get_bg_color $w]
$w.msg tag configure bold -font font_uibold -justify center
${NS}::scrollbar $w.vs -command [list $w.msg yview]
$w.msg insert end $s bold \n\n$err {}
$w.msg configure -state disabled
${NS}::button $w.continue \
-text [mc "Continue"] \
-command [list destroy $w]
${NS}::button $w.unlock \
-text [mc "Unlock Index"] \
-command "destroy $w; _delete_indexlock"
grid $w.msg - $w.vs -sticky news
grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2
grid columnconfigure $w 0 -weight 1
grid rowconfigure $w 0 -weight 1
wm protocol $w WM_DELETE_WINDOW update
bind $w.continue <Visibility> "
grab $w
focus %W
"
wm deiconify $w
tkwait window $w
$::main_status stop_all
unlock_index
rescan [concat $after [list ui_ready]] 0
}
proc update_indexinfo {msg path_list after} {
global update_index_cp
if {![lock_index update]} return
set update_index_cp 0
set 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,301 @@ 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]
# 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]
}
# 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
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} {
checkout_index \
$txt \
$pathList \
[concat $after [list ui_ready]]
question \
1 \
[mc "Do Nothing"] \
[mc "Revert Changes"] \
]
if {$reply == 1} {
checkout_index \
$txt \
$path_list \
[$after_chord add_note] \
$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 }
delete_files $untracked_list [$after_chord add_note]
}
}
# 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
}
# 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]
}
}

14
git-gui/lib/merge.tcl
View File

@ -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

231
git-gui/lib/status_bar.tcl
View File

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