set stuff [read $commfd]
if {$stuff == {}} {
if {![eof $commfd]} return
- # this works around what is apparently a bug in Tcl...
+ # set it blocking so we wait for the process to terminate
fconfigure $commfd -blocking 1
if {![catch {close $commfd} err]} {
after idle finishcommits
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
global maincursor textcursor
- global rowctxmenu
+ global rowctxmenu gaudydiff
menu .bar
.bar add cascade -label "File" -menu .bar.file
pack $ctext -side left -fill both -expand 1
.ctop.cdet add .ctop.cdet.left
- $ctext tag conf filesep -font [concat $textfont bold]
- $ctext tag conf hunksep -back blue -fore white
- $ctext tag conf d0 -back "#ff8080"
- $ctext tag conf d1 -back green
- $ctext tag conf found -back yellow
+ $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
+ if {$gaudydiff} {
+ $ctext tag conf hunksep -back blue -fore white
+ $ctext tag conf d0 -back "#ff8080"
+ $ctext tag conf d1 -back green
+ } else {
+ $ctext tag conf hunksep -fore blue
+ $ctext tag conf d0 -fore red
+ $ctext tag conf d1 -fore "#00a000"
+ $ctext tag conf found -back yellow
+ }
frame .ctop.cdet.right
set cflist .ctop.cdet.right.cfiles
if {![winfo viewable .]} return
catch {
set f [open "~/.gitk-new" w]
- puts $f "set mainfont {$mainfont}"
- puts $f "set textfont {$textfont}"
+ puts $f [list set mainfont $mainfont]
+ puts $f [list set textfont $textfont]
+ puts $f [list set findmergefiles $findmergefiles]
+ puts $f [list set gaudydiff $gaudydiff]
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 findcont {ids} {
- global findids treediffs parents nparents treepending
+ global findids treediffs parents nparents
global ffileline findstartline finddidsel
global lineid numcommits matchinglines findinprogress
global findmergefiles
$cflist delete 0 end
$cflist insert end "Comments"
- startdiff $id $parents($id)
+ if {$nparents($id) == 1} {
+ startdiff [concat $id $parents($id)]
+ } elseif {$nparents($id) > 1} {
+ mergediff $id
+ }
+}
+
+proc selnextline {dir} {
+ global selectedline
+ if {![info exists selectedline]} return
+ set l [expr $selectedline + $dir]
+ unmarkmatches
+ selectline $l
}
-proc startdiff {id vs} {
- global diffpending diffpindex
- global diffindex difffilestart
- global curdifftag curtagstart
+proc mergediff {id} {
+ global parents diffmergeid diffmergegca mergefilelist diffpindex
- set diffpending $vs
- set diffpindex 0
- set diffindex 0
- catch {unset difffilestart}
- set curdifftag Comments
- set curtagstart 0.0
- contdiff [list $id [lindex $vs 0]]
+ set diffmergeid $id
+ set diffpindex -1
+ set diffmergegca [findgca $parents($id)]
+ if {[info exists mergefilelist($id)]} {
+ 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
+
+ # diff the child against each of the parents, and diff
+ # each of the parents against the GCA.
+ while 1 {
+ if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
+ set ids [list [lindex $ids 1] $diffmergegca]
+ } else {
+ if {[incr diffpindex] >= $nparents($diffmergeid)} break
+ set p [lindex $parents($diffmergeid) $diffpindex]
+ set ids [list $diffmergeid $p]
+ }
+ if {![info exists treediffs($ids)]} {
+ set diffids $ids
+ 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 $p $diffmergegca])
+ foreach f $treediffs([list $diffmergeid $p]) {
+ 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 $diffmergeid $p])
+ set nf {}
+ foreach f $files {
+ if {[lsearch -exact $df $f] >= 0} {
+ lappend nf $f
+ }
+ }
+ set files $nf
+ }
+ }
+
+ set mergefilelist($diffmergeid) $files
+ showmergediff
+}
+
+proc showmergediff {} {
+ global cflist diffmergeid mergefilelist
+
+ set files $mergefilelist($diffmergeid)
+ foreach f $files {
+ $cflist insert end $f
+ }
}
-proc contdiff {ids} {
- global treediffs diffids treepending
+proc startdiff {ids} {
+ global treediffs diffids treepending diffmergeid
set diffids $ids
+ catch {unset diffmergeid}
if {![info exists treediffs($ids)]} {
if {![info exists treepending]} {
gettreediffs $ids
}
}
-proc selnextline {dir} {
- global selectedline
- if {![info exists selectedline]} return
- set l [expr $selectedline + $dir]
- unmarkmatches
- selectline $l
-}
-
proc addtocflist {ids} {
- global treediffs cflist diffpindex
-
- set colors {black blue green red cyan magenta}
- set color [lindex $colors [expr {$diffpindex % [llength $colors]}]]
+ global treediffs cflist
foreach f $treediffs($ids) {
$cflist insert end $f
- $cflist itemconf end -foreground $color
}
getblobdiffs $ids
}
proc gettreediffs {ids} {
- global treediffs parents treepending
+ global treediff parents treepending
set treepending $ids
- set treediffs($ids) {}
+ set treediff {}
set id [lindex $ids 0]
set p [lindex $ids 1]
if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
fconfigure $gdtf -blocking 0
- fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
+ fileevent $gdtf readable [list gettreediffline $gdtf $ids]
}
proc gettreediffline {gdtf ids} {
- global treediffs treepending diffids
+ global treediff treediffs treepending diffids diffmergeid
+
set n [gets $gdtf line]
if {$n < 0} {
if {![eof $gdtf]} return
close $gdtf
+ set treediffs($ids) $treediff
unset treepending
- if {[info exists diffids]} {
- if {$ids != $diffids} {
- gettreediffs $diffids
+ if {$ids != $diffids} {
+ gettreediffs $diffids
+ } else {
+ if {[info exists diffmergeid]} {
+ contmergediff $ids
} else {
addtocflist $ids
}
return
}
set file [lindex $line 5]
- lappend treediffs($ids) $file
+ lappend treediff $file
}
proc getblobdiffs {ids} {
- global diffopts blobdifffd diffids env
- global nextupdate diffinhdr
+ global diffopts blobdifffd diffids env curdifftag curtagstart
+ global difffilestart nextupdate diffinhdr treediffs
set id [lindex $ids 0]
set p [lindex $ids 1]
set env(GIT_DIFF_OPTS) $diffopts
- if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
+ set cmd [list | git-diff-tree -r -p -C $p $id]
+ if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
}
set diffinhdr 0
fconfigure $bdf -blocking 0
set blobdifffd($ids) $bdf
- fileevent $bdf readable [list getblobdiffline $bdf $ids]
+ set curdifftag Comments
+ set curtagstart 0.0
+ catch {unset difffilestart}
+ fileevent $bdf readable [list getblobdiffline $bdf $diffids]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
proc getblobdiffline {bdf ids} {
global diffids blobdifffd ctext curdifftag curtagstart
- global diffnexthead diffnextnote diffindex difffilestart
- global nextupdate diffpending diffpindex diffinhdr
+ global diffnexthead diffnextnote difffilestart
+ global nextupdate diffinhdr treediffs
+ global gaudydiff
set n [gets $bdf line]
if {$n < 0} {
close $bdf
if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
$ctext tag add $curdifftag $curtagstart end
- if {[incr diffpindex] < [llength $diffpending]} {
- set id [lindex $ids 0]
- set p [lindex $diffpending $diffpindex]
- contdiff [list $id $p]
- }
}
}
return
return
}
$ctext conf -state normal
- if {[regexp {^diff --git a/(.*) b/} $line match fname]} {
+ if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
# start of a new file
$ctext insert end "\n"
$ctext tag add $curdifftag $curtagstart end
set curtagstart [$ctext index "end - 1c"]
- set header $fname
+ set header $newname
set here [$ctext index "end - 1c"]
- set difffilestart($diffindex) $here
- incr diffindex
- # start mark names at fmark.1 for first file
- $ctext mark set fmark.$diffindex $here
- $ctext mark gravity fmark.$diffindex left
+ set i [lsearch -exact $treediffs($diffids) $fname]
+ if {$i >= 0} {
+ set difffilestart($i) $here
+ incr i
+ $ctext mark set fmark.$i $here
+ $ctext mark gravity fmark.$i left
+ }
+ if {$newname != $fname} {
+ set i [lsearch -exact $treediffs($diffids) $newname]
+ if {$i >= 0} {
+ set difffilestart($i) $here
+ incr i
+ $ctext mark set fmark.$i $here
+ $ctext mark gravity fmark.$i left
+ }
+ }
set curdifftag "f:$fname"
$ctext tag delete $curdifftag
set l [expr {(78 - [string length $header]) / 2}]
set diffinhdr 0
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
$line match f1l f1c f2l f2c rest]} {
- $ctext insert end "\t" hunksep
- $ctext insert end " $f1l " d0 " $f2l " d1
- $ctext insert end " $rest \n" hunksep
+ if {$gaudydiff} {
+ $ctext insert end "\t" hunksep
+ $ctext insert end " $f1l " d0 " $f2l " d1
+ $ctext insert end " $rest \n" hunksep
+ } else {
+ $ctext insert end "$line\n" hunksep
+ }
set diffinhdr 0
} else {
set x [string range $line 0 0]
if {$x == "-" || $x == "+"} {
set tag [expr {$x == "+"}]
- set line [string range $line 1 end]
+ if {$gaudydiff} {
+ set line [string range $line 1 end]
+ }
$ctext insert end "$line\n" d$tag
} elseif {$x == " "} {
- set line [string range $line 1 end]
+ if {$gaudydiff} {
+ set line [string range $line 1 end]
+ }
$ctext insert end "$line\n"
} elseif {$diffinhdr || $x == "\\"} {
# e.g. "\ No newline at end of file"
set here [$ctext index @0,0]
for {set i 0} {[info exists difffilestart($i)]} {incr i} {
if {[$ctext compare $difffilestart($i) > $here]} {
- $ctext yview $difffilestart($i)
- break
+ if {![info exists pos]
+ || [$ctext compare $difffilestart($i) < $pos]} {
+ set pos $difffilestart($i)
+ }
}
}
+ if {[info exists pos]} {
+ $ctext yview $pos
+ }
}
proc listboxsel {} {
- global ctext cflist currentid treediffs
+ global ctext cflist currentid
if {![info exists currentid]} return
set sel [lsort [$cflist curselection]]
if {$sel eq {}} return
proc gotocommit {} {
global sha1string currentid idline tagids
+ global lineid numcommits
+
if {$sha1string == {}
|| ([info exists currentid] && $sha1string == $currentid)} return
if {[info exists tagids($sha1string)]} {
set id $tagids($sha1string)
} else {
set id [string tolower $sha1string]
+ if {[regexp {^[0-9a-f]{4,39}$} $id]} {
+ set matches {}
+ for {set l 0} {$l < $numcommits} {incr l} {
+ if {[string match $id* $lineid($l)]} {
+ lappend matches $lineid($l)
+ }
+ }
+ if {$matches ne {}} {
+ if {[llength $matches] > 1} {
+ error_popup "Short SHA1 id $id is ambiguous"
+ return
+ }
+ set id [lindex $matches 0]
+ }
+ }
}
if {[info exists idline($id)]} {
selectline $idline($id)
return
}
- if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
+ if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set type "SHA1 id"
} else {
set type "Tag"
$ctext conf -state disabled
$ctext tag delete Comments
$ctext tag remove found 1.0 end
- startdiff [list $newid $oldid]
+ startdiff $newid [list $oldid]
}
proc mkpatch {} {
set mainfont {Helvetica 9}
set textfont {Courier 9}
set findmergefiles 0
+set gaudydiff 0
set colors {green red blue magenta darkgrey brown orange}
projects / git.git / blobdiff