proc savestuff {w} {
global canv canv2 canv3 ctext cflist mainfont textfont
- global stuffsaved findmergefiles gaudydiff
+ global stuffsaved findmergefiles gaudydiff maxgraphpct
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set textfont $textfont]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set gaudydiff $gaudydiff]
+ puts $f [list set maxgraphpct $maxgraphpct]
puts $f "set geometry(width) [winfo width .ctop]"
puts $f "set geometry(height) [winfo height .ctop]"
puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
proc drawcommitline {level} {
global parents children nparents nchildren todo
- global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
+ global canv canv2 canv3 mainfont namefont canvy linespc
global lineid linehtag linentag linedtag commitinfo
global colormap numcommits currentparents dupparents
global oldlevel oldnlines oldtodo
}
}
}
- set x [expr $canvx0 + $level * $linespc]
+ set x [xcoord $level $level $lineno]
set y1 $canvy
set canvy [expr $canvy + $linespc]
allcanvs conf -scrollregion \
-fill $ofill -outline black -width 1]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
- set xt [expr $canvx0 + [llength $todo] * $linespc]
+ set xt [xcoord [llength $todo] $level $lineno]
if {[llength $currentparents] > 2} {
set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
}
proc updatetodo {level noshortcut} {
global currentparents ncleft todo
global mainline oldlevel oldtodo oldnlines
- global canvx0 canvy linespc mainline
- global commitinfo
+ global canvy linespc mainline
+ global commitinfo lineno xspc1
set oldlevel $level
set oldtodo $todo
set p [lindex $currentparents 0]
if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
set ncleft($p) 0
- set x [expr $canvx0 + $level * $linespc]
+ set x [xcoord $level $level $lineno]
set y [expr $canvy - $linespc]
set mainline($p) [list $x $y]
set todo [lreplace $todo $level $level $p]
+ set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
return 0
}
}
}
}
-proc drawslants {} {
- global canv mainline sidelines canvx0 canvy linespc
- global oldlevel oldtodo todo currentparents dupparents
- global lthickness linespc canvy colormap
+proc xcoord {i level ln} {
+ global canvx0 xspc1 xspc2
+
+ set x [expr {$canvx0 + $i * $xspc1($ln)}]
+ if {$i > 0 && $i == $level} {
+ set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
+ } elseif {$i > $level} {
+ set x [expr {$x + $xspc2 - $xspc1($ln)}]
+ }
+ return $x
+}
+proc drawslants {level} {
+ global canv mainline sidelines canvx0 canvy xspc1 xspc2 lthickness
+ global oldlevel oldtodo todo currentparents dupparents
+ global lthickness linespc canvy colormap lineno geometry
+ global maxgraphpct
+
+ # decide on the line spacing for the next line
+ set lj [expr {$lineno + 1}]
+ set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
+ set n [llength $todo]
+ if {$n <= 1 || $canvx0 + $n * $xspc2 <= $maxw} {
+ set xspc1($lj) $xspc2
+ } else {
+ set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($n - 1)}]
+ if {$xspc1($lj) < $lthickness} {
+ set xspc1($lj) $lthickness
+ }
+ }
+
set y1 [expr $canvy - $linespc]
set y2 $canvy
set i -1
foreach id $oldtodo {
incr i
if {$id == {}} continue
- set xi [expr {$canvx0 + $i * $linespc}]
+ set xi [xcoord $i $oldlevel $lineno]
if {$i == $oldlevel} {
foreach p $currentparents {
set j [lsearch -exact $todo $p]
set coords [list $xi $y1]
- set xj [expr {$canvx0 + $j * $linespc}]
- if {$j < $i - 1} {
- lappend coords [expr $xj + $linespc] $y1
+ set xj [xcoord $j $level $lj]
+ if {$xj < $xi - $linespc} {
+ lappend coords [expr {$xj + $linespc}] $y1
notecrossings $p $j $i [expr {$j + 1}]
- } elseif {$j > $i + 1} {
- lappend coords [expr $xj - $linespc] $y1
+ } elseif {$xj > $xi + $linespc} {
+ lappend coords [expr {$xj - $linespc}] $y1
notecrossings $p $i $j [expr {$j - 1}]
}
if {[lsearch -exact $dupparents $p] >= 0} {
}
} else {
# normal case, no parent duplicated
+ set yb $y2
+ set dx [expr {abs($xi - $xj)}]
+ if {0 && $dx < $linespc} {
+ set yb [expr {$y1 + $dx}]
+ }
if {![info exists mainline($p)]} {
- if {$i != $j} {
- lappend coords $xj $y2
+ if {$xi != $xj} {
+ lappend coords $xj $yb
}
set mainline($p) $coords
} else {
- lappend coords $xj $y2
+ lappend coords $xj $yb
+ if {$yb < $y2} {
+ lappend coords $xj $y2
+ }
lappend sidelines($p) [list $coords 1]
}
}
}
- } elseif {[lindex $todo $i] != $id} {
- set j [lsearch -exact $todo $id]
- set xj [expr {$canvx0 + $j * $linespc}]
- lappend mainline($id) $xi $y1 $xj $y2
+ } else {
+ set j $i
+ if {[lindex $todo $i] != $id} {
+ set j [lsearch -exact $todo $id]
+ }
+ if {$j != $i || $xspc1($lineno) != $xspc1($lj)
+ || ($oldlevel <= $i && $i <= $level)
+ || ($level <= $i && $i <= $oldlevel)} {
+ set xj [xcoord $j $level $lj]
+ set dx [expr {abs($xi - $xj)}]
+ set yb $y2
+ if {0 && $dx < $linespc} {
+ set yb [expr {$y1 + $dx}]
+ }
+ lappend mainline($id) $xi $y1 $xj $yb
+ }
}
}
}
proc decidenext {{noread 0}} {
global parents children nchildren ncleft todo
- global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
+ global canv canv2 canv3 mainfont namefont canvy linespc
global datemode cdate
global commitinfo
global currentparents oldlevel oldnlines oldtodo
return
}
while 1 {
- drawslants
+ drawslants $level
drawcommitline $level
if {[updatetodo $level $datemode]} {
set level [decidenext 1]
-font $mainfont -tags textitems
set phase {}
} else {
- drawslants
set level [decidenext]
+ drawslants $level
drawrest $level [llength $startcommits]
}
. config -cursor $maincursor
if {$hard} {
set level [decidenext]
if {$level < 0} break
- drawslants
+ drawslants $level
}
if {[clock clicks -milliseconds] >= $nextupdate} {
update
set diffpindex -1
set diffmergegca [findgca $parents($id)]
if {[info exists mergefilelist($id)]} {
- showmergediff
+ if {$mergefilelist($id) ne {}} {
+ showmergediff
+ }
} else {
contmergediff {}
}
proc contmergediff {ids} {
global diffmergeid diffpindex parents nparents diffmergegca
- global treediffs mergefilelist diffids
+ global treediffs mergefilelist diffids treepending
# diff the child against each of the parents, and diff
# each of the parents against the GCA.
proc showmergediff {} {
global cflist diffmergeid mergefilelist parents
- global diffopts diffinhunk currentfile diffblocked
- global groupfilelast mergefds
+ global diffopts diffinhunk currentfile currenthunk filelines
+ global diffblocked groupfilelast mergefds groupfilenum grouphunks
set files $mergefilelist($diffmergeid)
foreach f $files {
catch {unset currentfile}
catch {unset currenthunk}
catch {unset filelines}
+ catch {unset groupfilenum}
+ catch {unset grouphunks}
set groupfilelast -1
foreach p $parents($diffmergeid) {
set cmd [list | git-diff-tree -p $p $diffmergeid]
set pnum 0
foreach p $parents($id) {
set startline [expr {$grouplinestart + $diffoffset($p)}]
- set offset($p) $diffoffset($p)
set ol $startline
set nl $grouplinestart
if {[info exists grouphunks($p)]} {
set events [lsort -integer -index 0 $events]
set nevents [llength $events]
set nmerge $nparents($diffmergeid)
- set i 0
set l $grouplinestart
- while {$i < $nevents} {
+ for {set i 0} {$i < $nevents} {set i $j} {
set nl [lindex $events $i 0]
while {$l < $nl} {
$ctext insert end " $filelines($id,$f,$l)\n"
}
set nlc [expr {$enl - $l}]
set ncol mresult
+ set bestpn -1
if {[llength $active] == $nmerge - 1} {
+ # no diff for one of the parents, i.e. it's identical
for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
if {![info exists delta($pnum)]} {
if {$pnum < $mergemax} {
break
}
}
+ } elseif {[llength $active] == $nmerge} {
+ # all parents are different, see if one is very similar
+ set bestsim 30
+ for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
+ set sim [similarity $pnum $l $nlc $f \
+ [lrange $events $i [expr {$j-1}]]]
+ if {$sim > $bestsim} {
+ set bestsim $sim
+ set bestpn $pnum
+ }
+ }
+ if {$bestpn >= 0} {
+ lappend ncol m$bestpn
+ }
}
set pnum -1
foreach p $parents($id) {
incr pnum
- if {![info exists delta($pnum)]} continue
+ if {![info exists delta($pnum)] || $pnum == $bestpn} continue
set olc [expr {$nlc + $delta($pnum)}]
set ol [expr {$l + $diffoffset($p)}]
incr diffoffset($p) $delta($pnum)
incr ol
}
}
- for {} {$nlc > 0} {incr nlc -1} {
+ set endl [expr {$l + $nlc}]
+ if {$bestpn >= 0} {
+ # show this pretty much as a normal diff
+ set p [lindex $parents($id) $bestpn]
+ set ol [expr {$l + $diffoffset($p)}]
+ incr diffoffset($p) $delta($bestpn)
+ unset delta($bestpn)
+ for {set k $i} {$k < $j} {incr k} {
+ set e [lindex $events $k]
+ if {[lindex $e 2] != $bestpn} continue
+ set nl [lindex $e 0]
+ set ol [expr {$ol + $nl - $l}]
+ for {} {$l < $nl} {incr l} {
+ $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
+ }
+ set c [lindex $e 3]
+ for {} {$c > 0} {incr c -1} {
+ $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
+ incr ol
+ }
+ set nl [lindex $e 1]
+ for {} {$l < $nl} {incr l} {
+ $ctext insert end "+$filelines($id,$f,$l)\n" mresult
+ }
+ }
+ }
+ for {} {$l < $endl} {incr l} {
$ctext insert end "+$filelines($id,$f,$l)\n" $ncol
- incr l
}
- set i $j
}
while {$l < $grouplineend} {
$ctext insert end " $filelines($id,$f,$l)\n"
$ctext conf -state disabled
}
+proc similarity {pnum l nlc f events} {
+ global diffmergeid parents diffoffset filelines
+
+ set id $diffmergeid
+ set p [lindex $parents($id) $pnum]
+ set ol [expr {$l + $diffoffset($p)}]
+ set endl [expr {$l + $nlc}]
+ set same 0
+ set diff 0
+ foreach e $events {
+ if {[lindex $e 2] != $pnum} continue
+ set nl [lindex $e 0]
+ set ol [expr {$ol + $nl - $l}]
+ for {} {$l < $nl} {incr l} {
+ incr same [string length $filelines($id,$f,$l)]
+ incr same
+ }
+ set oc [lindex $e 3]
+ for {} {$oc > 0} {incr oc -1} {
+ incr diff [string length $filelines($p,$f,$ol)]
+ incr diff
+ incr ol
+ }
+ set nl [lindex $e 1]
+ for {} {$l < $nl} {incr l} {
+ incr diff [string length $filelines($id,$f,$l)]
+ incr diff
+ }
+ }
+ for {} {$l < $endl} {incr l} {
+ incr same [string length $filelines($id,$f,$l)]
+ incr same
+ }
+ if {$same == 0} {
+ return 0
+ }
+ return [expr {200 * $same / (2 * $same + $diff)}]
+}
+
proc startdiff {ids} {
global treediffs diffids treepending diffmergeid
proc setcoords {} {
global linespc charspc canvx0 canvy0 mainfont
+ global xspc1 xspc2
+
set linespc [font metrics $mainfont -linespace]
set charspc [font measure $mainfont "m"]
set canvy0 [expr 3 + 0.5 * $linespc]
set canvx0 [expr 3 + 0.5 * $linespc]
+ set xspc1(0) $linespc
+ set xspc2 $linespc
}
proc redisplay {} {
$ctext conf -state disabled
$ctext tag delete Comments
$ctext tag remove found 1.0 end
- startdiff $newid [list $oldid]
+ startdiff [list $newid $oldid]
}
proc mkpatch {} {
set textfont {Courier 9}
set findmergefiles 0
set gaudydiff 0
+set maxgraphpct 50
set colors {green red blue magenta darkgrey brown orange}
projects / git.git / blobdiff