git-gui: Keep the UI responsive while counting objects in clone

If we are doing a "standard" clone by way of hardlinking the
objects (or copying them if hardlinks are not available) the
UI can freeze up for a good few seconds while Tcl scans all
of the object directories.  This is espeically noticed on a
Windows system when you are working off network shares and
need to wait for both the NT overheads and the network.

We now show a progress bar as we count the objects and build
our list of things to copy.  This keeps the user amused and
also makes sure we run the Tk event loop often enough that
the window can still be dragged around the desktop.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>

diff --git a/lib/choose_repository.tcl b/lib/choose_repository.tcl
index 9074c1ba5ca1ede9321226caf37dbc57413fcf55..4ad1f781f77357d3da8566cc261a0cc3b2cced72 100644 (file)
--- a/lib/choose_repository.tcl
+++ b/lib/choose_repository.tcl
@@ -462,20 +462,42 @@ method _do_clone2 {} {
 
        switch -exact -- $clone_type {
        hardlink {
+               set o_cons [status_bar::new $w_body]
+               pack $w_body -fill x -padx 10
+
+               $o_cons start \
+                       [mc "Counting objects"] \
+                       [mc "buckets"]
+               update
+
                set tolink  [list]
+               set buckets [glob \
+                       -tails \
+                       -nocomplain \
+                       -directory [file join $objdir] ??]
+               set bcnt [expr {[llength $buckets] + 2}]
+               set bcur 1
+               $o_cons update $bcur $bcnt
+               update
+
                file mkdir [file join .git objects pack]
                foreach i [glob -tails -nocomplain \
                        -directory [file join $objdir pack] *] {
                        lappend tolink [file join pack $i]
                }
-               foreach i [glob -tails -nocomplain \
-                       -directory [file join $objdir] ??] {
+               $o_cons update [incr bcur] $bcnt
+               update
+
+               foreach i $buckets {
                        file mkdir [file join .git objects $i]
                        foreach j [glob -tails -nocomplain \
                                -directory [file join $objdir $i] *] {
                                lappend tolink [file join $i $j]
                        }
+                       $o_cons update [incr bcur] $bcnt
+                       update
                }
+               $o_cons stop
 
                if {$tolink eq {}} {
                        info_popup [strcat \
@@ -483,13 +505,11 @@ method _do_clone2 {} {
                                "\n" \
                                [mc "The 'master' branch has not been initialized."] \
                                ]
+                       destroy $w_body
                        set done 1
                        return
                }
 
-               set o_cons [status_bar::new $w_body]
-               pack $w_body -fill x -padx 10
-
                set i [lindex $tolink 0]
                if {[catch {
                                file link -hard \