mirror of https://github.com/git/git.git
* 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
commit
fe47c9cb5f
|
|
@ -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,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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -203,6 +203,8 @@ method done {ok} {
|
|||
focus $w.ok
|
||||
}
|
||||
}
|
||||
|
||||
bind $w <Key-Escape> "destroy $w;break"
|
||||
}
|
||||
|
||||
method _sb_set {sb orient first last} {
|
||||
|
|
|
|||
|
|
@ -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. Previousl | ||||