proc parse_args {rargs} {
global parsed_args
- if [catch {
+ if {[catch {
set parse_args [concat --default HEAD $rargs]
set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
- }] {
+ }]} {
# if git-rev-parse failed for some reason...
if {$rargs == {}} {
set rargs HEAD
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr {$startmsecs + 100}]
set ncmupdate 1
- if [catch {
+ if {[catch {
set commfd [open [concat | git-rev-list --header --topo-order \
--parents $rlargs] r]
- } err] {
+ } err]} {
puts stderr "Error executing git-rev-list: $err"
exit 1
}
}
proc readcommit {id} {
- if [catch {set contents [exec git-cat-file commit $id]}] return
+ if {[catch {set contents [exec git-cat-file commit $id]}]} return
parsecommit $id $contents 0 {}
}
$ctext tag conf m2 -fore green
$ctext tag conf m3 -fore purple
$ctext tag conf m4 -fore brown
+ $ctext tag conf m5 -fore "#009090"
+ $ctext tag conf m6 -fore magenta
+ $ctext tag conf m7 -fore "#808000"
+ $ctext tag conf m8 -fore "#009000"
+ $ctext tag conf m9 -fore "#ff0080"
+ $ctext tag conf m10 -fore cyan
+ $ctext tag conf m11 -fore "#b07070"
+ $ctext tag conf m12 -fore "#70b0f0"
+ $ctext tag conf m13 -fore "#70f0b0"
+ $ctext tag conf m14 -fore "#f0b070"
+ $ctext tag conf m15 -fore "#ff70b0"
$ctext tag conf mmax -fore darkgrey
- set mergemax 5
+ set mergemax 16
$ctext tag conf mresult -font [concat $textfont bold]
$ctext tag conf msep -font [concat $textfont bold]
$ctext tag conf found -back yellow
proc resizeclistpanes {win w} {
global oldwidth
- if [info exists oldwidth($win)] {
+ if {[info exists oldwidth($win)]} {
set s0 [$win sash coord 0]
set s1 [$win sash coord 1]
if {$w < 60} {
proc resizecdetpanes {win w} {
global oldwidth
- if [info exists oldwidth($win)] {
+ if {[info exists oldwidth($win)]} {
set s0 [$win sash coord 0]
if {$w < 60} {
set sash0 [expr {int($w*3/4 - 2)}]
global parents nparents children nchildren
global cornercrossings crossings
- if [info exists colormap($id)] return
+ if {[info exists colormap($id)]} return
set ncolors [llength $colors]
if {$nparents($id) <= 1 && $nchildren($id) == 1} {
set child [lindex $children($id) 0]
global canvy0 linespc parents nparents children
global cflist currentid sha1entry
global commentend idtags idline linknum
+ global mergemax
$canv delete hover
normalline
}
set comment {}
- if {[info exists parents($id)]} {
+ if {$nparents($id) > 1} {
+ set np 0
foreach p $parents($id) {
- append comment "Parent: [commit_descriptor $p]\n"
+ if {$np >= $mergemax} {
+ set tag mmax
+ } else {
+ set tag m$np
+ }
+ $ctext insert end "Parent: " $tag
+ appendwithlinks [commit_descriptor $p]
+ incr np
+ }
+ } else {
+ if {[info exists parents($id)]} {
+ foreach p $parents($id) {
+ append comment "Parent: [commit_descriptor $p]\n"
+ }
}
}
+
if {[info exists children($id)]} {
foreach c $children($id) {
append comment "Child: [commit_descriptor $c]\n"
}
proc mergediff {id} {
- global parents diffmergeid diffmergegca mergefilelist diffpindex
+ global parents diffmergeid diffopts mdifffd
+ global difffilestart
set diffmergeid $id
- set diffpindex -1
- set diffmergegca [findgca $parents($id)]
- if {[info exists mergefilelist($id)]} {
- if {$mergefilelist($id) ne {}} {
- showmergediff
- }
- } else {
- contmergediff {}
- }
-}
-
-proc findgca {ids} {
- set gca {}
- foreach id $ids {
- if {$gca eq {}} {
- set gca $id
- } else {
- if {[catch {
- set gca [exec git-merge-base $gca $id]
- } err]} {
- return {}
- }
- }
- }
- return $gca
-}
-
-proc contmergediff {ids} {
- global diffmergeid diffpindex parents nparents diffmergegca
- global treediffs mergefilelist diffids treepending
-
- # diff the child against each of the parents, and diff
- # each of the parents against the GCA.
- while 1 {
- if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} {
- set ids [list $diffmergegca [lindex $ids 0]]
- } else {
- if {[incr diffpindex] >= $nparents($diffmergeid)} break
- set p [lindex $parents($diffmergeid) $diffpindex]
- set ids [list $p $diffmergeid]
- }
- if {![info exists treediffs($ids)]} {
- set diffids $ids
- if {![info exists treepending]} {
- gettreediffs $ids
- }
- return
- }
- }
-
- # If a file in some parent is different from the child and also
- # different from the GCA, then it's interesting.
- # If we don't have a GCA, then a file is interesting if it is
- # different from the child in all the parents.
- if {$diffmergegca ne {}} {
- set files {}
- foreach p $parents($diffmergeid) {
- set gcadiffs $treediffs([list $diffmergegca $p])
- foreach f $treediffs([list $p $diffmergeid]) {
- if {[lsearch -exact $files $f] < 0
- && [lsearch -exact $gcadiffs $f] >= 0} {
- lappend files $f
- }
- }
- }
- set files [lsort $files]
- } else {
- set p [lindex $parents($diffmergeid) 0]
- set files $treediffs([list $diffmergeid $p])
- for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
- set p [lindex $parents($diffmergeid) $i]
- set df $treediffs([list $p $diffmergeid])
- set nf {}
- foreach f $files {
- if {[lsearch -exact $df $f] >= 0} {
- lappend nf $f
- }
- }
- set files $nf
- }
- }
-
- set mergefilelist($diffmergeid) $files
- if {$files ne {}} {
- showmergediff
- }
-}
-
-proc showmergediff {} {
- global cflist diffmergeid mergefilelist parents
- global diffopts diffinhunk currentfile currenthunk filelines
- global diffblocked groupfilelast mergefds groupfilenum grouphunks
-
- set files $mergefilelist($diffmergeid)
- foreach f $files {
- $cflist insert end $f
- }
+ catch {unset difffilestart}
+ # this doesn't seem to actually affect anything...
set env(GIT_DIFF_OPTS) $diffopts
- set flist {}
- 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 cmd [concat $cmd $mergefilelist($diffmergeid)]
- if {[catch {set f [open $cmd r]} err]} {
- error_popup "Error getting diffs: $err"
- foreach f $flist {
- catch {close $f}
- }
- return
- }
- lappend flist $f
- set ids [list $diffmergeid $p]
- set mergefds($ids) $f
- set diffinhunk($ids) 0
- set diffblocked($ids) 0
- fconfigure $f -blocking 0
- fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
+ set cmd [concat | git-diff-tree --no-commit-id --cc $id]
+ if {[catch {set mdf [open $cmd r]} err]} {
+ error_popup "Error getting merge diffs: $err"
+ return
}
+ fconfigure $mdf -blocking 0
+ set mdifffd($id) $mdf
+ fileevent $mdf readable [list getmergediffline $mdf $id]
+ set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
-proc getmergediffline {f ids id} {
- global diffmergeid diffinhunk diffoldlines diffnewlines
- global currentfile currenthunk
- global diffoldstart diffnewstart diffoldlno diffnewlno
- global diffblocked mergefilelist
- global noldlines nnewlines difflcounts filelines
+proc getmergediffline {mdf id} {
+ global diffmergeid ctext cflist nextupdate nparents mergemax
+ global difffilestart
- set n [gets $f line]
+ set n [gets $mdf line]
if {$n < 0} {
- if {![eof $f]} return
- }
-
- if {!([info exists diffmergeid] && $diffmergeid == $id)} {
- if {$n < 0} {
- close $f
+ if {[eof $mdf]} {
+ close $mdf
}
return
}
-
- if {$diffinhunk($ids) != 0} {
- set fi $currentfile($ids)
- if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
- # continuing an existing hunk
- set line [string range $line 1 end]
- set p [lindex $ids 1]
- if {$match eq "-" || $match eq " "} {
- set filelines($p,$fi,$diffoldlno($ids)) $line
- incr diffoldlno($ids)
- }
- if {$match eq "+" || $match eq " "} {
- set filelines($id,$fi,$diffnewlno($ids)) $line
- incr diffnewlno($ids)
- }
- if {$match eq " "} {
- if {$diffinhunk($ids) == 2} {
- lappend difflcounts($ids) \
- [list $noldlines($ids) $nnewlines($ids)]
- set noldlines($ids) 0
- set diffinhunk($ids) 1
- }
- incr noldlines($ids)
- } elseif {$match eq "-" || $match eq "+"} {
- if {$diffinhunk($ids) == 1} {
- lappend difflcounts($ids) [list $noldlines($ids)]
- set noldlines($ids) 0
- set nnewlines($ids) 0
- set diffinhunk($ids) 2
- }
- if {$match eq "-"} {
- incr noldlines($ids)
- } else {
- incr nnewlines($ids)
- }
- }
- # and if it's \ No newline at end of line, then what?
- return
- }
- # end of a hunk
- if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
- lappend difflcounts($ids) [list $noldlines($ids)]
- } elseif {$diffinhunk($ids) == 2
- && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
- lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
- }
- set currenthunk($ids) [list $currentfile($ids) \
- $diffoldstart($ids) $diffnewstart($ids) \
- $diffoldlno($ids) $diffnewlno($ids) \
- $difflcounts($ids)]
- set diffinhunk($ids) 0
- # -1 = need to block, 0 = unblocked, 1 = is blocked
- set diffblocked($ids) -1
- processhunks
- if {$diffblocked($ids) == -1} {
- fileevent $f readable {}
- set diffblocked($ids) 1
- }
- }
-
- if {$n < 0} {
- # eof
- if {!$diffblocked($ids)} {
- close $f
- set currentfile($ids) [llength $mergefilelist($diffmergeid)]
- set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
- processhunks
- }
- } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
- # start of a new file
- set currentfile($ids) \
- [lsearch -exact $mergefilelist($diffmergeid) $fname]
- } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
- $line match f1l f1c f2l f2c rest]} {
- if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
- # start of a new hunk
- if {$f1l == 0 && $f1c == 0} {
- set f1l 1
- }
- if {$f2l == 0 && $f2c == 0} {
- set f2l 1
- }
- set diffinhunk($ids) 1
- set diffoldstart($ids) $f1l
- set diffnewstart($ids) $f2l
- set diffoldlno($ids) $f1l
- set diffnewlno($ids) $f2l
- set difflcounts($ids) {}
- set noldlines($ids) 0
- set nnewlines($ids) 0
- }
- }
-}
-
-proc processhunks {} {
- global diffmergeid parents nparents currenthunk
- global mergefilelist diffblocked mergefds
- global grouphunks grouplinestart grouplineend groupfilenum
-
- set nfiles [llength $mergefilelist($diffmergeid)]
- while 1 {
- set fi $nfiles
- set lno 0
- # look for the earliest hunk
- foreach p $parents($diffmergeid) {
- set ids [list $diffmergeid $p]
- if {![info exists currenthunk($ids)]} return
- set i [lindex $currenthunk($ids) 0]
- set l [lindex $currenthunk($ids) 2]
- if {$i < $fi || ($i == $fi && $l < $lno)} {
- set fi $i
- set lno $l
- set pi $p
- }
- }
-
- if {$fi < $nfiles} {
- set ids [list $diffmergeid $pi]
- set hunk $currenthunk($ids)
- unset currenthunk($ids)
- if {$diffblocked($ids) > 0} {
- fileevent $mergefds($ids) readable \
- [list getmergediffline $mergefds($ids) $ids $diffmergeid]
- }
- set diffblocked($ids) 0
-
- if {[info exists groupfilenum] && $groupfilenum == $fi
- && $lno <= $grouplineend} {
- # add this hunk to the pending group
- lappend grouphunks($pi) $hunk
- set endln [lindex $hunk 4]
- if {$endln > $grouplineend} {
- set grouplineend $endln
- }
- continue
- }
- }
-
- # succeeding stuff doesn't belong in this group, so
- # process the group now
- if {[info exists groupfilenum]} {
- processgroup
- unset groupfilenum
- unset grouphunks
- }
-
- if {$fi >= $nfiles} break
-
- # start a new group
- set groupfilenum $fi
- set grouphunks($pi) [list $hunk]
- set grouplinestart $lno
- set grouplineend [lindex $hunk 4]
+ if {![info exists diffmergeid] || $id != $diffmergeid} {
+ return
}
-}
-
-proc processgroup {} {
- global groupfilelast groupfilenum difffilestart
- global mergefilelist diffmergeid ctext filelines
- global parents diffmergeid diffoffset
- global grouphunks grouplinestart grouplineend nparents
- global mergemax
-
$ctext conf -state normal
- set id $diffmergeid
- set f $groupfilenum
- if {$groupfilelast != $f} {
+ if {[regexp {^diff --cc (.*)} $line match fname]} {
+ # start of a new file
$ctext insert end "\n"
set here [$ctext index "end - 1c"]
- set difffilestart($f) $here
- set mark fmark.[expr {$f + 1}]
- $ctext mark set $mark $here
- $ctext mark gravity $mark left
- set header [lindex $mergefilelist($id) $f]
- set l [expr {(78 - [string length $header]) / 2}]
+ set i [$cflist index end]
+ $ctext mark set fmark.$i $here
+ $ctext mark gravity fmark.$i left
+ set difffilestart([expr {$i-1}]) $here
+ $cflist insert end $fname
+ set l [expr {(78 - [string length $fname]) / 2}]
set pad [string range "----------------------------------------" 1 $l]
- $ctext insert end "$pad $header $pad\n" filesep
- set groupfilelast $f
- foreach p $parents($id) {
- set diffoffset($p) 0
- }
- }
-
- $ctext insert end "@@" msep
- set nlines [expr {$grouplineend - $grouplinestart}]
- set events {}
- set pnum 0
- foreach p $parents($id) {
- set startline [expr {$grouplinestart + $diffoffset($p)}]
- set ol $startline
- set nl $grouplinestart
- if {[info exists grouphunks($p)]} {
- foreach h $grouphunks($p) {
- set l [lindex $h 2]
- if {$nl < $l} {
- for {} {$nl < $l} {incr nl} {
- set filelines($p,$f,$ol) $filelines($id,$f,$nl)
- incr ol
- }
- }
- foreach chunk [lindex $h 5] {
- if {[llength $chunk] == 2} {
- set olc [lindex $chunk 0]
- set nlc [lindex $chunk 1]
- set nnl [expr {$nl + $nlc}]
- lappend events [list $nl $nnl $pnum $olc $nlc]
- incr ol $olc
- set nl $nnl
- } else {
- incr ol [lindex $chunk 0]
- incr nl [lindex $chunk 0]
- }
- }
- }
- }
- if {$nl < $grouplineend} {
- for {} {$nl < $grouplineend} {incr nl} {
- set filelines($p,$f,$ol) $filelines($id,$f,$nl)
- incr ol
- }
- }
- set nlines [expr {$ol - $startline}]
- $ctext insert end " -$startline,$nlines" msep
- incr pnum
- }
-
- set nlines [expr {$grouplineend - $grouplinestart}]
- $ctext insert end " +$grouplinestart,$nlines @@\n" msep
-
- set events [lsort -integer -index 0 $events]
- set nevents [llength $events]
- set nmerge $nparents($diffmergeid)
- set l $grouplinestart
- 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"
- incr l
- }
- set e [lindex $events $i]
- set enl [lindex $e 1]
- set j $i
- set active {}
- while 1 {
- set pnum [lindex $e 2]
- set olc [lindex $e 3]
- set nlc [lindex $e 4]
- if {![info exists delta($pnum)]} {
- set delta($pnum) [expr {$olc - $nlc}]
- lappend active $pnum
+ $ctext insert end "$pad $fname $pad\n" filesep
+ } elseif {[regexp {^@@} $line]} {
+ $ctext insert end "$line\n" hunksep
+ } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
+ # do nothing
+ } else {
+ # parse the prefix - one ' ', '-' or '+' for each parent
+ set np $nparents($id)
+ set spaces {}
+ set minuses {}
+ set pluses {}
+ set isbad 0
+ for {set j 0} {$j < $np} {incr j} {
+ set c [string range $line $j $j]
+ if {$c == " "} {
+ lappend spaces $j
+ } elseif {$c == "-"} {
+ lappend minuses $j
+ } elseif {$c == "+"} {
+ lappend pluses $j
} else {
- incr delta($pnum) [expr {$olc - $nlc}]
- }
- if {[incr j] >= $nevents} break
- set e [lindex $events $j]
- if {[lindex $e 0] >= $enl} break
- if {[lindex $e 1] > $enl} {
- set enl [lindex $e 1]
- }
- }
- 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} {
- lappend ncol m$pnum
- } else {
- lappend ncol mmax
- }
- 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 isbad 1
+ break
}
}
- set pnum -1
- foreach p $parents($id) {
- incr pnum
- 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)
- unset delta($pnum)
- for {} {$olc > 0} {incr olc -1} {
- $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
- incr ol
- }
+ set tags {}
+ set num {}
+ if {!$isbad && $minuses ne {} && $pluses eq {}} {
+ # line doesn't appear in result, parents in $minuses have the line
+ set num [lindex $minuses 0]
+ } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
+ # line appears in result, parents in $pluses don't have the line
+ lappend tags mresult
+ set num [lindex $spaces 0]
}
- 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
- }
+ if {$num ne {}} {
+ if {$num >= $mergemax} {
+ set num "max"
}
+ lappend tags m$num
}
- for {} {$l < $endl} {incr l} {
- $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
- }
- }
- while {$l < $grouplineend} {
- $ctext insert end " $filelines($id,$f,$l)\n"
- incr l
+ $ctext insert end "$line\n" $tags
}
$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
+ if {[clock clicks -milliseconds] >= $nextupdate} {
+ incr nextupdate 100
+ fileevent $mdf readable {}
+ update
+ fileevent $mdf readable [list getmergediffline $mdf $id]
}
- return [expr {200 * $same / (2 * $same + $diff)}]
}
proc startdiff {ids} {
global treediff parents treepending
set treepending $ids
set treediff {}
- if [catch {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return
+ if {[catch \
+ {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]
}