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...
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"]
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 == {}} {
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} {
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 maincursor textcursor curtextcursor
global rowctxmenu gaudydiff mergemax
menu .bar
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
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 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]"
$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 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 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
if {![info exists selectedline]} return
set l [expr $selectedline + $dir]
unmarkmatches
- selectline $l
+ 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} {
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 {} {
- 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}]]
}
}
if {[info exists idline($id)]} {
- selectline $idline($id)
+ selectline $idline($id) 1
return
}
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
$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
$ctext tag delete Comments
$ctext tag remove found 1.0 end
- startdiff $newid [list $oldid]
+ startdiff [list $newid $oldid]
}
proc mkpatch {} {
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 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