gitk: Implement a simple scheduler for the compute-intensive stuff

This allows us to do compute-intensive processing, such as laying out
the graph, relatively efficiently while also having the GUI be
reasonably responsive.  The problem previously was that file events
were serviced before X events, so reading from another process which
supplies data quickly (hi git rev-list :) could mean that X events
didn't get processed for a long time.

With this, gitk finishes laying out the graph slightly sooner and
still responds to the GUI while doing so.

Signed-off-by: Paul Mackerras <paulus@samba.org>

gitk

@@ -16,13 +16,75 @@ proc gitdir {} {
     }
 }
 
+# A simple scheduler for compute-intensive stuff.
+# The aim is to make sure that event handlers for GUI actions can
+# run at least every 50-100 ms.  Unfortunately fileevent handlers are
+# run before X event handlers, so reading from a fast source can
+# make the GUI completely unresponsive.
+proc run args {
+    global isonrunq runq
+
+    set script $args
+    if {[info exists isonrunq($script)]} return
+    if {$runq eq {}} {
+	after idle dorunq
+    }
+    lappend runq [list {} $script]
+    set isonrunq($script) 1
+}
+
+proc filerun {fd script} {
+    fileevent $fd readable [list filereadable $fd $script]
+}
+
+proc filereadable {fd script} {
+    global runq
+
+    fileevent $fd readable {}
+    if {$runq eq {}} {
+	after idle dorunq
+    }
+    lappend runq [list $fd $script]
+}
+
+proc dorunq {} {
+    global isonrunq runq
+
+    set tstart [clock clicks -milliseconds]
+    set t0 $tstart
+    while {$runq ne {}} {
+	set fd [lindex $runq 0 0]
+	set script [lindex $runq 0 1]
+	set repeat [eval $script]
+	set t1 [clock clicks -milliseconds]
+	set t [expr {$t1 - $t0}]
+	set runq [lrange $runq 1 end]
+	if {$repeat ne {} && $repeat} {
+	    if {$fd eq {} || $repeat == 2} {
+		# script returns 1 if it wants to be readded
+		# file readers return 2 if they could do more straight away
+		lappend runq [list $fd $script]
+	    } else {
+		fileevent $fd readable [list filereadable $fd $script]
+	    }
+	} elseif {$fd eq {}} {
+	    unset isonrunq($script)
+	}
+	set t0 $t1
+	if {$t1 - $tstart >= 80} break
+    }
+    if {$runq ne {}} {
+	after idle dorunq
+    }
+}
+
+# Start off a git rev-list process and arrange to read its output
 proc start_rev_list {view} {
-    global startmsecs nextupdate
+    global startmsecs
     global commfd leftover tclencoding datemode
     global viewargs viewfiles commitidx
 
     set startmsecs [clock clicks -milliseconds]
-    set nextupdate [expr {$startmsecs + 100}]
     set commitidx($view) 0
     set args $viewargs($view)
     if {$viewfiles($view) ne {}} {
@@ -45,7 +107,7 @@ proc start_rev_list {view} {
     if {$tclencoding != {}} {
 	fconfigure $fd -encoding $tclencoding
     }
-    fileevent $fd readable [list getcommitlines $fd $view]
+    filerun $fd [list getcommitlines $fd $view]
     nowbusy $view
 }
 
@@ -72,7 +134,7 @@ proc getcommits {} {
 }
 
 proc getcommitlines {fd view}  {
-    global commitlisted nextupdate
+    global commitlisted
     global leftover commfd
     global displayorder commitidx commitrow commitdata
     global parentlist childlist children curview hlview
@@ -80,7 +142,9 @@ proc getcommitlines {fd view}  {
 
     set stuff [read $fd 500000]
     if {$stuff == {}} {
-	if {![eof $fd]} return
+	if {![eof $fd]} {
+	    return 1
+	}
 	global viewname
 	unset commfd($view)
 	notbusy $view
@@ -105,9 +169,9 @@ proc getcommitlines {fd view}  {
 	    error_popup $err
 	}
 	if {$view == $curview} {
-	    after idle finishcommits
+	    run chewcommits $view
 	}
-	return
+	return 0
     }
     set start 0
     set gotsome 0
@@ -183,29 +247,42 @@ proc getcommitlines {fd view}  {
 	set gotsome 1
     }
     if {$gotsome} {
-	if {$view == $curview} {
+	run chewcommits $view
-	    while {[layoutmore $nextupdate]} doupdate
-	} elseif {[info exists hlview] && $view == $hlview} {
-	    vhighlightmore
-	}
-    }
-    if {[clock clicks -milliseconds] >= $nextupdate} {
-	doupdate
     }
+    return 2
 }
 
-proc doupdate {} {
+proc chewcommits {view} {
-    global commfd nextupdate numcommits
+    global curview hlview commfd
+    global selectedline pending_select
 
-    foreach v [array names commfd] {
+    set more 0
-	fileevent $commfd($v) readable {}
+    if {$view == $curview} {
+	set allread [expr {![info exists commfd($view)]}]
+	set tlimit [expr {[clock clicks -milliseconds] + 50}]
+	set more [layoutmore $tlimit $allread]
+	if {$allread && !$more} {
+	    global displayorder commitidx phase
+	    global numcommits startmsecs
+
+	    if {[info exists pending_select]} {
+		set row [expr {[lindex $displayorder 0] eq $nullid}]
+		selectline $row 1
 	    }
-    update
+	    if {$commitidx($curview) > 0} {
-    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
+		#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
-    foreach v [array names commfd] {
+		#puts "overall $ms ms for $numcommits commits"
-	set fd $commfd($v)
+	    } else {
-	fileevent $fd readable [list getcommitlines $fd $v]
+		show_status "No commits selected"
 	    }
+	    notbusy layout
+	    set phase {}
+	}
+    }
+    if {[info exists hlview] && $view == $hlview} {
+	vhighlightmore
+    }
+    return $more
 }
 
 proc readcommit {id} {
@@ -1594,9 +1671,9 @@ proc newviewok {top n} {
 	set viewargs($n) $newargs
 	addviewmenu $n
 	if {!$newishighlight} {
-	    after idle showview $n
+	    run showview $n
 	} else {
-	    after idle addvhighlight $n
+	    run addvhighlight $n
 	}
     } else {
 	# editing an existing view
@@ -1612,7 +1689,7 @@ proc newviewok {top n} {
 	    set viewfiles($n) $files
 	    set viewargs($n) $newargs
 	    if {$curview == $n} {
-		after idle updatecommits
+		run updatecommits
 	    }
 	}
     }
@@ -1670,7 +1747,7 @@ proc showview {n} {
     global matchinglines treediffs
     global pending_select phase
     global commitidx rowlaidout rowoptim linesegends
-    global commfd nextupdate
+    global commfd
     global selectedview selectfirst
     global vparentlist vchildlist vdisporder vcmitlisted
     global hlview selectedhlview
@@ -1791,11 +1868,7 @@ proc showview {n} {
 	if {$phase eq "getcommits"} {
 	    show_status "Reading commits..."
 	}
-	if {[info exists commfd($n)]} {
+	run chewcommits $n
-	    layoutmore {}
-	} else {
-	    finishcommits
-	}
     } elseif {$numcommits == 0} {
 	show_status "No commits selected"
     }
@@ -1983,7 +2056,7 @@ proc do_file_hl {serial} {
     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
     set filehighlight [open $cmd r+]
     fconfigure $filehighlight -blocking 0
-    fileevent $filehighlight readable readfhighlight
+    filerun $filehighlight readfhighlight
     set fhl_list {}
     drawvisible
     flushhighlights
@@ -2011,7 +2084,11 @@ proc readfhighlight {} {
     global filehighlight fhighlights commitrow curview mainfont iddrawn
     global fhl_list
 
-    while {[gets $filehighlight line] >= 0} {
+    if {![info exists filehighlight]} {
+	return 0
+    }
+    set nr 0
+    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
 	set line [string trim $line]
 	set i [lsearch -exact $fhl_list $line]
 	if {$i < 0} continue
@@ -2035,8 +2112,10 @@ proc readfhighlight {} {
 	puts "oops, git diff-tree died"
 	catch {close $filehighlight}
 	unset filehighlight
+	return 0
     }
     next_hlcont
+    return 1
 }
 
 proc find_change {name ix op} {
@@ -2103,7 +2182,7 @@ proc vrel_change {name ix op} {
 
     rhighlight_none
     if {$highlight_related ne "None"} {
-	after idle drawvisible
+	run drawvisible
     }
 }
 
@@ -2118,7 +2197,7 @@ proc rhighlight_sel {a} {
     set anc_todo [list $a]
     if {$highlight_related ne "None"} {
 	rhighlight_none
-	after idle drawvisible
+	run drawvisible
     }
 }
 
@@ -2474,15 +2553,17 @@ proc visiblerows {} {
     return [list $r0 $r1]
 }
 
-proc layoutmore {tmax} {
+proc layoutmore {tmax allread} {
     global rowlaidout rowoptim commitidx numcommits optim_delay
-    global uparrowlen curview
+    global uparrowlen curview rowidlist idinlist
 
+    set showdelay $optim_delay
+    set optdelay [expr {$uparrowlen + 1}]
     while {1} {
-	if {$rowoptim - $optim_delay > $numcommits} {
+	if {$rowoptim - $showdelay > $numcommits} {
-	    showstuff [expr {$rowoptim - $optim_delay}]
+	    showstuff [expr {$rowoptim - $showdelay}]
-	} elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
+	} elseif {$rowlaidout - $optdelay > $rowoptim} {
-	    set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
+	    set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
 	    if {$nr > 100} {
 		set nr 100
 	    }
@@ -2496,10 +2577,23 @@ proc layoutmore {tmax} {
 		set nr 150
 	    }
 	    set row $rowlaidout
-	    set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
+	    set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
 	    if {$rowlaidout == $row} {
 		return 0
 	    }
+	} elseif {$allread} {
+	    set optdelay 0
+	    set nrows $commitidx($curview)
+	    if {[lindex $rowidlist $nrows] ne {} ||
+		[array names idinlist] ne {}} {
+		layouttail
+		set rowlaidout $commitidx($curview)
+	    } elseif {$rowoptim == $nrows} {
+		set showdelay 0
+		if {$numcommits == $nrows} {
+		    return 0
+		}
+	    }
 	} else {
 	    return 0
 	}
@@ -2715,6 +2809,7 @@ proc layouttail {} {
     }
 
     foreach id [array names idinlist] {
+	unset idinlist($id)
 	addextraid $id $row
 	lset rowidlist $row [list $id]
 	lset rowoffsets $row 0
@@ -3423,19 +3518,6 @@ proc show_status {msg} {
 	-tags text -fill $fgcolor
 }
 
-proc finishcommits {} {
-    global commitidx phase curview
-    global pending_select
-
-    if {$commitidx($curview) > 0} {
-	drawrest
-    } else {
-	show_status "No commits selected"
-    }
-    set phase {}
-    catch {unset pending_select}
-}
-
 # Insert a new commit as the child of the commit on row $row.
 # The new commit will be displayed on row $row and the commits
 # on that row and below will move down one row.
@@ -3569,24 +3651,6 @@ proc notbusy {what} {
     }
 }
 
-proc drawrest {} {
-    global startmsecs
-    global rowlaidout commitidx curview
-    global pending_select
-
-    layoutrows $rowlaidout $commitidx($curview) 1
-    layouttail
-    optimize_rows $row 0 $commitidx($curview)
-    showstuff $commitidx($curview)
-    if {[info exists pending_select]} {
-	selectline 0 1
-    }
-
-    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
-    #global numcommits
-    #puts "overall $drawmsecs ms for $numcommits commits"
-}
-
 proc findmatches {f} {
     global findtype foundstring foundstrlen
     if {$findtype == "Regexp"} {
@@ -4243,7 +4307,7 @@ proc gettree {id} {
 	    set treefilelist($id) {}
 	    set treeidlist($id) {}
 	    fconfigure $gtf -blocking 0
-	    fileevent $gtf readable [list gettreeline $gtf $id]
+	    filerun $gtf [list gettreeline $gtf $id]
 	}
     } else {
 	setfilelist $id
@@ -4253,14 +4317,21 @@ proc gettree {id} {
 proc gettreeline {gtf id} {
     global treefilelist treeidlist treepending cmitmode diffids
 
-    while {[gets $gtf line] >= 0} {
+    set nl 0
-	if {[lindex $line 1] ne "blob"} continue
+    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
-	set sha1 [lindex $line 2]
+	set tl [split $line "\t"]
-	set fname [lindex $line 3]
+	if {[lindex $tl 0 1] ne "blob"} continue
-	lappend treefilelist($id) $fname
+	set sha1 [lindex $tl 0 2]
-	lappend treeidlist($id) $sha1
+	set fname [lindex $tl 1]
+	if {[string index $fname 0] eq "\""} {
+	    set fname [lindex $fname 0]
+	}
+	lappend treeidlist($id) $sha1
+	lappend treefilelist($id) $fname
+    }
+    if {![eof $gtf]} {
+	return [expr {$nl >= 1000? 2: 1}]
     }
-    if {![eof $gtf]} return
     close $gtf
     unset treepending
     if {$cmitmode ne "tree"} {
@@ -4272,6 +4343,7 @@ proc gettreeline {gtf id} {
     } else {
 	setfilelist $id
     }
+    return 0
 }
 
 proc showfile {f} {
@@ -4289,7 +4361,7 @@ proc showfile {f} {
 	return
     }
     fconfigure $bf -blocking 0
-    fileevent $bf readable [list getblobline $bf $diffids]
+    filerun $bf [list getblobline $bf $diffids]
     $ctext config -state normal
     clear_ctext $commentend
     $ctext insert end "\n"
@@ -4303,18 +4375,21 @@ proc getblobline {bf id} {
 
     if {$id ne $diffids || $cmitmode ne "tree"} {
 	catch {close $bf}
-	return
+	return 0
     }
     $ctext config -state normal
-    while {[gets $bf line] >= 0} {
+    set nl 0
+    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
 	$ctext insert end "$line\n"
     }
     if {[eof $bf]} {
 	# delete last newline
 	$ctext delete "end - 2c" "end - 1c"
 	close $bf
+	return 0
     }
     $ctext config -state disabled
+    return [expr {$nl >= 1000? 2: 1}]
 }
 
 proc mergediff {id l} {
@@ -4334,26 +4409,21 @@ proc mergediff {id l} {
     fconfigure $mdf -blocking 0
     set mdifffd($id) $mdf
     set np [llength [lindex $parentlist $l]]
-    fileevent $mdf readable [list getmergediffline $mdf $id $np]
+    filerun $mdf [list getmergediffline $mdf $id $np]
-    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 }
 
 proc getmergediffline {mdf id np} {
-    global diffmergeid ctext cflist nextupdate mergemax
+    global diffmergeid ctext cflist mergemax
     global difffilestart mdifffd
 
-    set n [gets $mdf line]
+    $ctext conf -state normal
-    if {$n < 0} {
+    set nr 0
-	if {[eof $mdf]} {
+    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
-	    close $mdf
-	}
-	return
-    }
 	if {![info exists diffmergeid] || $id != $diffmergeid
 	    || $mdf != $mdifffd($id)} {
-	return
+	    close $mdf
+	    return 0
 	}
-    $ctext conf -state normal
 	if {[regexp {^diff --cc (.*)} $line match fname]} {
 	    # start of a new file
 	    $ctext insert end "\n"
@@ -4404,13 +4474,13 @@ proc getmergediffline {mdf id np} {
 	    }
 	    $ctext insert end "$line\n" $tags
 	}
-    $ctext conf -state disabled
-    if {[clock clicks -milliseconds] >= $nextupdate} {
-	incr nextupdate 100
-	fileevent $mdf readable {}
-	update
-	fileevent $mdf readable [list getmergediffline $mdf $id $np]
     }
+    $ctext conf -state disabled
+    if {[eof $mdf]} {
+	close $mdf
+	return 0
+    }
+    return [expr {$nr >= 1000? 2: 1}]
 }
 
 proc startdiff {ids} {
@@ -4441,16 +4511,21 @@ proc gettreediffs {ids} {
 	 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
 	]} return
     fconfigure $gdtf -blocking 0
-    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
+    filerun $gdtf [list gettreediffline $gdtf $ids]
 }
 
 proc gettreediffline {gdtf ids} {
     global treediff treediffs treepending diffids diffmergeid
     global cmitmode
 
-    set n [gets $gdtf line]
+    set nr 0
-    if {$n < 0} {
+    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
-	if {![eof $gdtf]} return
+	set file [lindex $line 5]
+	lappend treediff $file
+    }
+    if {![eof $gdtf]} {
+	return [expr {$nr >= 1000? 2: 1}]
+    }
     close $gdtf
     set treediffs($ids) $treediff
     unset treepending
@@ -4463,15 +4538,12 @@ proc gettreediffline {gdtf ids} {
     } else {
 	addtocflist $ids
     }
-	return
+    return 0
-    }
-    set file [lindex $line 5]
-    lappend treediff $file
 }
 
 proc getblobdiffs {ids} {
     global diffopts blobdifffd diffids env curdifftag curtagstart
-    global nextupdate diffinhdr treediffs
+    global diffinhdr treediffs
 
     set env(GIT_DIFF_OPTS) $diffopts
     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
@@ -4484,8 +4556,7 @@ proc getblobdiffs {ids} {
     set blobdifffd($ids) $bdf
     set curdifftag Comments
     set curtagstart 0.0
-    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
+    filerun $bdf [list getblobdiffline $bdf $diffids]
-    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 }
 
 proc setinlist {var i val} {
@@ -4504,22 +4575,15 @@ proc setinlist {var i val} {
 proc getblobdiffline {bdf ids} {
     global diffids blobdifffd ctext curdifftag curtagstart
     global diffnexthead diffnextnote difffilestart
-    global nextupdate diffinhdr treediffs
+    global diffinhdr treediffs
 
-    set n [gets $bdf line]
+    set nr 0
-    if {$n < 0} {
-	if {[eof $bdf]} {
-	    close $bdf
-	    if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
-		$ctext tag add $curdifftag $curtagstart end
-	    }
-	}
-	return
-    }
-    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
-	return
-    }
     $ctext conf -state normal
+    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
+	if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
+	    close $bdf
+	    return 0
+	}
 	if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
 	    # start of a new file
 	    $ctext insert end "\n"
@@ -4540,7 +4604,8 @@ proc getblobdiffline {bdf ids} {
 	    set curdifftag "f:$fname"
 	    $ctext tag delete $curdifftag
 	    set l [expr {(78 - [string length $header]) / 2}]
-	set pad [string range "----------------------------------------" 1 $l]
+	    set pad [string range "----------------------------------------" \
+			 1 $l]
 	    $ctext insert end "$pad $header $pad\n" filesep
 	    set diffinhdr 1
 	} elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
@@ -4572,13 +4637,16 @@ proc getblobdiffline {bdf ids} {
 		$ctext insert end "$line\n" filesep
 	    }
 	}
-    $ctext conf -state disabled
-    if {[clock clicks -milliseconds] >= $nextupdate} {
-	incr nextupdate 100
-	fileevent $bdf readable {}
-	update
-	fileevent $bdf readable "getblobdiffline $bdf {$ids}"
     }
+    $ctext conf -state disabled
+    if {[eof $bdf]} {
+	close $bdf
+	if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
+	    $ctext tag add $curdifftag $curtagstart end
+	}
+	return 0
+    }
+    return [expr {$nr >= 1000? 2: 1}]
 }
 
 proc changediffdisp {} {
@@ -5509,11 +5577,7 @@ proc regetallcommits {} {
     fconfigure $fd -blocking 0
     incr allcommits
     nowbusy allcommits
-    restartgetall $fd
+    filerun $fd [list getallclines $fd]
-}
-
-proc restartgetall {fd} {
-    fileevent $fd readable [list getallclines $fd]
 }
 
 # Since most commits have 1 parent and 1 child, we group strings of
@@ -5534,13 +5598,10 @@ proc restartgetall {fd} {
 proc getallclines {fd} {
     global allids allparents allchildren idtags nextarc nbmp
     global arcnos arcids arctags arcout arcend arcstart archeads growing
-    global seeds allcommits allcstart
+    global seeds allcommits
 
-    if {![info exists allcstart]} {
-	set allcstart [clock clicks -milliseconds]
-    }
     set nid 0
-    while {[gets $fd line] >= 0} {
+    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
 	set id [lindex $line 0]
 	if {[info exists allparents($id)]} {
 	    # seen it already
@@ -5607,22 +5668,16 @@ proc getallclines {fd} {
 	    lappend arcnos($p) $a
 	}
 	set arcout($id) $ao
-	if {[incr nid] >= 50} {
-	    set nid 0
-	    if {[clock clicks -milliseconds] - $allcstart >= 50} {
-		fileevent $fd readable {}
-		after idle restartgetall $fd
-		unset allcstart
-		return
     }
+    if {![eof $fd]} {
+	return [expr {$nid >= 1000? 2: 1}]
     }
-    }
-    if {![eof $fd]} return
     close $fd
     if {[incr allcommits -1] == 0} {
 	notbusy allcommits
     }
     dispneartags 0
+    return 0
 }
 
 proc recalcarc {a} {
@@ -5919,6 +5974,7 @@ proc is_certain {desc anc} {
 	if {$dl($x)} {
 	    return 0
 	}
+	return 0
     }
     return 1
 }
@@ -6948,6 +7004,7 @@ if {$i >= 0} {
     }
 }
 
+set runq {}
 set history {}
 set historyindex 0
 set fh_serial 0