# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
+proc gitdir {} {
+ global env
+ if {[info exists env(GIT_DIR)]} {
+ return $env(GIT_DIR)
+ } else {
+ return ".git"
+ }
+}
+
proc getcommits {rargs} {
global commits commfd phase canv mainfont env
- global startmsecs nextupdate
+ global startmsecs nextupdate ncmupdate
global ctext maincursor textcursor leftover
# check that we can find a .git directory somewhere...
- if {[info exists env(GIT_DIR)]} {
- set gitdir $env(GIT_DIR)
- } else {
- set gitdir ".git"
- }
+ set gitdir [gitdir]
if {![file isdirectory $gitdir]} {
error_popup "Cannot find the git directory \"$gitdir\"."
exit 1
set phase getcommits
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr $startmsecs + 100]
+ set ncmupdate 0
if [catch {
set parse_args [concat --default HEAD $rargs]
set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
set parsed_args $rargs
}
if [catch {
- set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
+ set commfd [open "|git-rev-list --header --topo-order $parsed_args" r]
} err] {
puts stderr "Error executing git-rev-list: $err"
exit 1
}
set leftover {}
- fconfigure $commfd -blocking 0 -translation binary
- fileevent $commfd readable "getcommitlines $commfd"
+ fconfigure $commfd -blocking 0 -translation lf
+ fileevent $commfd readable [list getcommitlines $commfd]
$canv delete all
$canv create text 3 3 -anchor nw -text "Reading commits..." \
-font $mainfont -tags textitems
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
}
proc getcommitlines {commfd} {
global commits parents cdate children nchildren
global commitlisted phase commitinfo nextupdate
global stopped redisplaying leftover
+ global numcommits ncmupdate
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
set commitlisted($id) 1
parsecommit $id $cmit 1
drawcommit $id
- if {[clock clicks -milliseconds] >= $nextupdate} {
+ if {[clock clicks -milliseconds] >= $nextupdate
+ && $numcommits >= $ncmupdate + 100} {
doupdate
+ set ncmupdate $numcommits
}
while {$redisplaying} {
set redisplaying 0
foreach id $commits {
drawcommit $id
if {$stopped} break
- if {[clock clicks -milliseconds] >= $nextupdate} {
+ if {[clock clicks -milliseconds] >= $nextupdate
+ && $numcommits >= $ncmupdate + 100} {
doupdate
+ set ncmupdate $numcommits
}
}
}
incr nextupdate 100
fileevent $commfd readable {}
update
- fileevent $commfd readable "getcommitlines $commfd"
+ fileevent $commfd readable [list getcommitlines $commfd]
}
proc readcommit {id} {
proc readrefs {} {
global tagids idtags headids idheads
- set tags [glob -nocomplain -types f .git/refs/tags/*]
+ set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
foreach f $tags {
catch {
set fd [open $f r]
close $fd
}
}
- set heads [glob -nocomplain -types f .git/refs/heads/*]
+ set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
foreach f $heads {
catch {
set fd [open $f r]
global canv canv2 canv3 linespc charspc ctext cflist textfont
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
- global maincursor textcursor
- global rowctxmenu
+ global maincursor textcursor curtextcursor
+ global rowctxmenu gaudydiff mergemax
menu .bar
.bar add cascade -label "File" -menu .bar.file
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
+
+ image create bitmap bm-left -data {
+ #define left_width 16
+ #define left_height 16
+ static unsigned char left_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
+ 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
+ 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
+ }
+ image create bitmap bm-right -data {
+ #define right_width 16
+ #define right_height 16
+ static unsigned char right_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
+ 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
+ 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
+ }
+ button .ctop.top.bar.leftbut -image bm-left -command goback \
+ -state disabled -width 26
+ pack .ctop.top.bar.leftbut -side left -fill y
+ button .ctop.top.bar.rightbut -image bm-right -command goforw \
+ -state disabled -width 26
+ pack .ctop.top.bar.rightbut -side left -fill y
+
button .ctop.top.bar.findbut -text "Find" -command dofind
pack .ctop.top.bar.findbut -side left
set findstring {}
set ctext .ctop.cdet.left.ctext
text $ctext -bg white -state disabled -font $textfont \
-width $geometry(ctextw) -height $geometry(ctexth) \
- -yscrollcommand ".ctop.cdet.left.sb set"
+ -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
scrollbar .ctop.cdet.left.sb -command "$ctext yview"
pack .ctop.cdet.left.sb -side right -fill y
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 m0 -fore red
+ $ctext tag conf m1 -fore blue
+ $ctext tag conf m2 -fore green
+ $ctext tag conf m3 -fore purple
+ $ctext tag conf m4 -fore brown
+ $ctext tag conf mmax -fore darkgrey
+ set mergemax 5
+ $ctext tag conf mresult -font [concat $textfont bold]
+ $ctext tag conf msep -font [concat $textfont bold]
+ $ctext tag conf found -back yellow
+ }
frame .ctop.cdet.right
set cflist .ctop.cdet.right.cfiles
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
+ set curtextcursor $textcursor
set rowctxmenu .rowctxmenu
menu $rowctxmenu -tearoff 0
proc savestuff {w} {
global canv canv2 canv3 ctext cflist mainfont textfont
- global stuffsaved
+ global stuffsaved findmergefiles gaudydiff maxgraphpct
+
if {$stuffsaved} return
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 [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]"
$canv bind $t <Enter> "lineenter %x %y $id"
$canv bind $t <Motion> "linemotion %x %y $id"
$canv bind $t <Leave> "lineleave $id"
- $canv bind $t <Button-1> "lineclick %x %y $id"
+ $canv bind $t <Button-1> "lineclick %x %y $id 1"
}
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
proc drawcommit {id} {
global phase todo nchildren datemode nextupdate
- global startcommits
+ global startcommits numcommits ncmupdate
if {$phase != "incrdraw"} {
set phase incrdraw
return
}
while 1 {
- drawslants
+ drawslants $level
drawcommitline $level
if {[updatetodo $level $datemode]} {
set level [decidenext 1]
if {![info exists commitlisted($id)]} {
break
}
- if {[clock clicks -milliseconds] >= $nextupdate} {
+ if {[clock clicks -milliseconds] >= $nextupdate
+ && $numcommits >= $ncmupdate} {
doupdate
+ set ncmupdate $numcommits
if {$stopped} break
}
}
-font $mainfont -tags textitems
set phase {}
} else {
- drawslants
set level [decidenext]
+ drawslants $level
drawrest $level [llength $startcommits]
}
. config -cursor $maincursor
- $ctext config -cursor $textcursor
+ settextcursor $textcursor
+}
+
+# Don't change the text pane cursor if it is currently the hand cursor,
+# showing that we are over a sha1 ID link.
+proc settextcursor {c} {
+ global ctext curtextcursor
+
+ if {[$ctext cget -cursor] == $curtextcursor} {
+ $ctext config -cursor $c
+ }
+ set curtextcursor $c
}
proc drawgraph {} {
- global nextupdate startmsecs startcommits todo
+ global nextupdate startmsecs startcommits todo ncmupdate
if {$startcommits == {}} return
set startmsecs [clock clicks -milliseconds]
set nextupdate [expr $startmsecs + 100]
+ set ncmupdate 0
initgraph
set todo [lindex $startcommits 0]
drawrest 0 1
proc drawrest {level startix} {
global phase stopped redisplaying selectedline
global datemode currentparents todo
- global numcommits
+ global numcommits ncmupdate
global nextupdate startmsecs startcommits idline
if {$level >= 0} {
if {$hard} {
set level [decidenext]
if {$level < 0} break
- drawslants
+ drawslants $level
}
- if {[clock clicks -milliseconds] >= $nextupdate} {
+ if {[clock clicks -milliseconds] >= $nextupdate
+ && $numcommits >= $ncmupdate + 100} {
update
incr nextupdate 100
+ set ncmupdate $numcommits
}
}
}
#puts "overall $drawmsecs ms for $numcommits commits"
if {$redisplaying} {
if {$stopped == 0 && [info exists selectedline]} {
- selectline $selectedline
+ selectline $selectedline 0
}
if {$stopped == 1} {
set stopped 0
proc findselectline {l} {
global findloc commentend ctext
- selectline $l
+ selectline $l 1
if {$findloc == "All fields" || $findloc == "Comments"} {
# highlight the matches in the comments
set f [$ctext get 1.0 $commentend]
unset findinprogress
if {$phase != "incrdraw"} {
. config -cursor $maincursor
- $ctext config -cursor $textcursor
+ settextcursor $textcursor
}
}
}
fileevent $f readable readfindproc
set finddidsel 0
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
set findinprogress 1
}
set id $lineid($l)
set p [lindex $parents($id) 0]
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
set findinprogress 1
findcont [list $id $p]
update
}
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
}
proc selcanvline {w x y} {
- global canv canvy0 ctext linespc selectedline
+ global canv canvy0 ctext linespc
global lineid linehtag linentag linedtag rowtextx
set ymax [lindex [$canv cget -scrollregion] 3]
if {$ymax == {}} return
if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
}
unmarkmatches
- selectline $l
+ selectline $l 1
+}
+
+proc commit_descriptor {p} {
+ global commitinfo
+ set l "..."
+ if {[info exists commitinfo($p)]} {
+ set l [lindex $commitinfo($p) 0]
+ }
+ return "$p ($l)"
}
-proc selectline {l} {
+proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
global lineid linehtag linentag linedtag
- global canvy0 linespc parents nparents
+ global canvy0 linespc parents nparents children nchildren
global cflist currentid sha1entry
- global commentend seenfile idtags
+ global commentend idtags idline
+
$canv delete hover
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
$canv delete secsel
}
allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
}
+
+ if {$isnew} {
+ addtohistory [list selectline $l 0]
+ }
+
set selectedline $l
set id $lineid($l)
}
$ctext insert end "\n"
}
+
+ set commentstart [$ctext index "end - 1c"]
+ set comment {}
+ 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"
+ }
+ }
+ append comment "\n"
+ append comment [lindex $info 5]
+ $ctext insert end $comment
$ctext insert end "\n"
- $ctext insert end [lindex $info 5]
- $ctext insert end "\n"
+
+ # make anything that looks like a SHA1 ID be a clickable link
+ set links [regexp -indices -all -inline {[0-9a-f]{40}} $comment]
+ set i 0
+ foreach l $links {
+ set s [lindex $l 0]
+ set e [lindex $l 1]
+ set linkid [string range $comment $s $e]
+ if {![info exists idline($linkid)]} continue
+ incr e
+ $ctext tag add link "$commentstart + $s c" "$commentstart + $e c"
+ $ctext tag add link$i "$commentstart + $s c" "$commentstart + $e c"
+ $ctext tag bind link$i <1> [list selectline $idline($linkid) 1]
+ incr i
+ }
+ $ctext tag conf link -foreground blue -underline 1
+ $ctext tag bind link <Enter> { %W configure -cursor hand2 }
+ $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+
$ctext tag delete Comments
$ctext tag remove found 1.0 end
$ctext conf -state disabled
$cflist insert end "Comments"
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 1
+}
+
+proc unselectline {} {
+ global selectedline
+
+ catch {unset selectedline}
+ allcanvs delete secsel
+}
+
+proc addtohistory {cmd} {
+ global history historyindex
+
+ if {$historyindex > 0
+ && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
+ return
+ }
+
+ if {$historyindex < [llength $history]} {
+ set history [lreplace $history $historyindex end $cmd]
+ } else {
+ lappend history $cmd
+ }
+ incr historyindex
+ if {$historyindex > 1} {
+ .ctop.top.bar.leftbut conf -state normal
+ } else {
+ .ctop.top.bar.leftbut conf -state disabled
+ }
+ .ctop.top.bar.rightbut conf -state disabled
+}
+
+proc goback {} {
+ global history historyindex
+
+ if {$historyindex > 1} {
+ incr historyindex -1
+ set cmd [lindex $history [expr {$historyindex - 1}]]
+ eval $cmd
+ .ctop.top.bar.rightbut conf -state normal
+ }
+ if {$historyindex <= 1} {
+ .ctop.top.bar.leftbut conf -state disabled
+ }
+}
+
+proc goforw {} {
+ global history historyindex
+
+ if {$historyindex < [llength $history]} {
+ set cmd [lindex $history $historyindex]
+ incr historyindex
+ eval $cmd
+ .ctop.top.bar.leftbut conf -state normal
+ }
+ if {$historyindex >= [llength $history]} {
+ .ctop.top.bar.rightbut conf -state disabled
+ }
+}
+
+proc mergediff {id} {
+ global parents diffmergeid diffmergegca mergefilelist diffpindex
+
+ 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 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
+ 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 $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
+ 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
+ }
+ 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]
+ }
+}
+
+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
+
+ set n [gets $f line]
+ if {$n < 0} {
+ if {![eof $f]} return
+ }
+
+ if {!([info exists diffmergeid] && $diffmergeid == $id)} {
+ if {$n < 0} {
+ close $f
+ }
+ 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]
}
- catch {unset seenfile}
+}
+
+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} {
+ $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 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
+ } 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 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 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
+ }
+ }
+ while {$l < $grouplineend} {
+ $ctext insert end " $filelines($id,$f,$l)\n"
+ incr l
+ }
+ $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
+ global treediffs diffids treepending diffmergeid
+ set diffids $ids
+ catch {unset diffmergeid}
if {![info exists treediffs($ids)]} {
- set diffids $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
foreach f $treediffs($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 {
- unset diffids
addtocflist $ids
}
}
return
}
set file [lindex $line 5]
- lappend treediffs($ids) $file
+ lappend treediff $file
}
proc getblobdiffs {ids} {
- global diffopts blobdifffd blobdiffids env curdifftag curtagstart
- global diffindex difffilestart nextupdate
+ 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 blobdiffids $ids
set blobdifffd($ids) $bdf
set curdifftag Comments
set curtagstart 0.0
- set diffindex 0
catch {unset difffilestart}
- fileevent $bdf readable "getblobdiffline $bdf {$ids}"
+ fileevent $bdf readable [list getblobdiffline $bdf $diffids]
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
}
proc getblobdiffline {bdf ids} {
- global blobdiffids blobdifffd ctext curdifftag curtagstart seenfile
- global diffnexthead diffnextnote diffindex difffilestart
- global nextupdate
+ global diffids blobdifffd ctext curdifftag curtagstart
+ global diffnexthead diffnextnote difffilestart
+ global nextupdate diffinhdr treediffs
+ global gaudydiff
set n [gets $bdf line]
if {$n < 0} {
if {[eof $bdf]} {
close $bdf
- if {$ids == $blobdiffids && $bdf == $blobdifffd($ids)} {
+ if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
$ctext tag add $curdifftag $curtagstart end
- set seenfile($curdifftag) 1
}
}
return
}
- if {$ids != $blobdiffids || $bdf != $blobdifffd($ids)} {
+ if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
return
}
$ctext conf -state normal
- if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 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 seenfile($curdifftag) 1
set curtagstart [$ctext index "end - 1c"]
- set header $fname
- if {[info exists diffnexthead]} {
- set fname $diffnexthead
- set header "$diffnexthead ($diffnextnote)"
- unset diffnexthead
- }
+ 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 pad [string range "----------------------------------------" 1 $l]
$ctext insert end "$pad $header $pad\n" filesep
- } elseif {[string range $line 0 2] == "+++"} {
- # no need to do anything with this
- } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
- set diffnexthead $fn
- set diffnextnote "created, mode $m"
- } elseif {[string range $line 0 8] == "Deleted: "} {
- set diffnexthead [string range $line 9 end]
- set diffnextnote "deleted"
- } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
- # save the filename in case the next thing is "new file mode ..."
- set diffnexthead $fn
- set diffnextnote "modified"
- } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
- set diffnextnote "new file, mode $m"
- } elseif {[string range $line 0 11] == "deleted file"} {
- set diffnextnote "deleted"
+ set diffinhdr 1
+ } elseif {[regexp {^(---|\+\+\+)} $line]} {
+ 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 {$x == "\\"} {
+ } elseif {$diffinhdr || $x == "\\"} {
# e.g. "\ No newline at end of file"
$ctext insert end "$line\n" filesep
} else {
if {$curdifftag != "Comments"} {
$ctext insert end "\n"
$ctext tag add $curdifftag $curtagstart end
- set seenfile($curdifftag) 1
set curtagstart [$ctext index "end - 1c"]
set curdifftag Comments
}
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 seenfile
+ global ctext cflist currentid
if {![info exists currentid]} return
set sel [lsort [$cflist curselection]]
if {$sel eq {}} return
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 {} {
- global selectedline stopped redisplaying phase
+ global stopped redisplaying phase
if {$stopped > 1} return
if {$phase == "getcommits"} return
set redisplaying 1
}
proc incrfont {inc} {
- global mainfont namefont textfont selectedline ctext canv phase
+ global mainfont namefont textfont ctext canv phase
global stopped entries
unmarkmatches
set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
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)
+ selectline $idline($id) 1
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"
$canv raise $t
}
-proc lineclick {x y id} {
+proc lineclick {x y id isnew} {
global ctext commitinfo children cflist canv
unmarkmatches
+ unselectline
+ if {$isnew} {
+ addtohistory [list lineclick $x $x $id 0]
+ }
$canv delete hover
# fill the details pane with info about this line
$ctext conf -state normal
$ctext delete 0.0 end
- $ctext insert end "Parent:\n "
- catch {destroy $ctext.$id}
- button $ctext.$id -text "Go:" -command "selbyid $id" \
- -padx 4 -pady 0
- $ctext window create end -window $ctext.$id -align center
+ $ctext tag conf link -foreground blue -underline 1
+ $ctext tag bind link <Enter> { %W configure -cursor hand2 }
+ $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+ $ctext insert end "Parent:\t"
+ $ctext insert end $id [list link link0]
+ $ctext tag bind link0 <1> [list selbyid $id]
set info $commitinfo($id)
- $ctext insert end "\t[lindex $info 0]\n"
+ $ctext insert end "\n\t[lindex $info 0]\n"
$ctext insert end "\tAuthor:\t[lindex $info 1]\n"
$ctext insert end "\tDate:\t[lindex $info 2]\n"
- $ctext insert end "\tID:\t$id\n"
if {[info exists children($id)]} {
$ctext insert end "\nChildren:"
+ set i 0
foreach child $children($id) {
- $ctext insert end "\n "
- catch {destroy $ctext.$child}
- button $ctext.$child -text "Go:" -command "selbyid $child" \
- -padx 4 -pady 0
- $ctext window create end -window $ctext.$child -align center
+ incr i
set info $commitinfo($child)
- $ctext insert end "\t[lindex $info 0]"
+ $ctext insert end "\n\t"
+ $ctext insert end $child [list link link$i]
+ $ctext tag bind link$i <1> [list selbyid $child]
+ $ctext insert end "\n\t[lindex $info 0]"
+ $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
+ $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
}
}
$ctext conf -state disabled
proc selbyid {id} {
global idline
if {[info exists idline($id)]} {
- selectline $idline($id)
+ selectline $idline($id) 1
}
}
proc diffvssel {dirn} {
global rowmenuid selectedline lineid
- global ctext cflist
- global commitinfo
if {![info exists selectedline]} return
if {$dirn} {
set oldid $rowmenuid
set newid $lineid($selectedline)
}
+ addtohistory [list doseldiff $oldid $newid]
+ doseldiff $oldid $newid
+}
+
+proc doseldiff {oldid newid} {
+ global ctext cflist
+ global commitinfo
+
$ctext conf -state normal
$ctext delete 0.0 end
$ctext mark set fmark.0 0.0
$ctext mark gravity fmark.0 left
$cflist delete 0 end
$cflist insert end "Top"
- $ctext insert end "From $oldid\n "
+ $ctext insert end "From "
+ $ctext tag conf link -foreground blue -underline 1
+ $ctext tag bind link <Enter> { %W configure -cursor hand2 }
+ $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+ $ctext tag bind link0 <1> [list selbyid $oldid]
+ $ctext insert end $oldid [list link link0]
+ $ctext insert end "\n "
$ctext insert end [lindex $commitinfo($oldid) 0]
- $ctext insert end "\n\nTo $newid\n "
+ $ctext insert end "\n\nTo "
+ $ctext tag bind link1 <1> [list selbyid $newid]
+ $ctext insert end $newid [list link link1]
+ $ctext insert end "\n "
$ctext insert end [lindex $commitinfo($newid) 0]
$ctext insert end "\n"
$ctext conf -state disabled
return
}
if {[catch {
- set dir ".git"
- if {[info exists env(GIT_DIR)]} {
- set dir $env(GIT_DIR)
- }
+ set dir [gitdir]
set fname [file join $dir "refs/tags" $tag]
set f [open $fname w]
puts $f $id
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
if {[info exists selectedline] && $selectedline == $idline($id)} {
- selectline $selectedline
+ selectline $selectedline 0
}
}
set mainfont {Helvetica 9}
set textfont {Courier 9}
set findmergefiles 0
+set gaudydiff 0
+set maxgraphpct 50
set colors {green red blue magenta darkgrey brown orange}
}
}
+set history {}
+set historyindex 0
+
set stopped 0
set redisplaying 0
set stuffsaved 0
projects / git.git / blobdiff