X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=6dc4b24f060e790d46b19f3510fee1e507057960;hb=b664550c066810b770ad3e19cafe2fbdd42c6793;hp=112c9c0b60f9157a4556959396be4541a3e14963;hpb=7eab29339bb856e314e799bbb57d945299c8cc51;p=git.git diff --git a/gitk b/gitk index 112c9c0b..6dc4b24f 100755 --- a/gitk +++ b/gitk @@ -7,17 +7,22 @@ exec wish "$0" -- "${1+$@}" # 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 @@ -26,6 +31,7 @@ proc getcommits {rargs} { set phase getcommits set startmsecs [clock clicks -milliseconds] set nextupdate [expr $startmsecs + 100] + set ncmupdate 1 if [catch { set parse_args [concat --default HEAD $rargs] set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] @@ -37,19 +43,19 @@ proc getcommits {rargs} { 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} { @@ -104,7 +110,7 @@ to allow selection of commits to be displayed.)} parsecommit $id $cmit 1 drawcommit $id if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate + doupdate 1 } while {$redisplaying} { set redisplaying 0 @@ -115,7 +121,7 @@ to allow selection of commits to be displayed.)} drawcommit $id if {$stopped} break if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate + doupdate 1 } } } @@ -123,13 +129,24 @@ to allow selection of commits to be displayed.)} } } -proc doupdate {} { - global commfd nextupdate +proc doupdate {reading} { + global commfd nextupdate numcommits ncmupdate - incr nextupdate 100 - fileevent $commfd readable {} + if {$reading} { + fileevent $commfd readable {} + } update - fileevent $commfd readable "getcommitlines $commfd" + set nextupdate [expr {[clock clicks -milliseconds] + 100}] + if {$numcommits < 100} { + set ncmupdate [expr {$numcommits + 1}] + } elseif {$numcommits < 10000} { + set ncmupdate [expr {$numcommits + 10}] + } else { + set ncmupdate [expr {$numcommits + 100}] + } + if {$reading} { + fileevent $commfd readable [list getcommitlines $commfd] + } } proc readcommit {id} { @@ -212,7 +229,7 @@ proc parsecommit {id contents listed} { 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] @@ -241,7 +258,7 @@ proc readrefs {} { 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] @@ -272,8 +289,8 @@ proc makewindow {} { 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 gaudydiff + global maincursor textcursor curtextcursor + global rowctxmenu gaudydiff mergemax menu .bar .bar add cascade -label "File" -menu .bar.file @@ -334,6 +351,30 @@ proc makewindow {} { 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 {} @@ -358,7 +399,7 @@ proc makewindow {} { 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 @@ -373,6 +414,15 @@ proc makewindow {} { $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 } @@ -427,6 +477,7 @@ proc makewindow {} { set maincursor [. cget -cursor] set textcursor [$ctext cget -cursor] + set curtextcursor $textcursor set rowctxmenu .rowctxmenu menu $rowctxmenu -tearoff 0 @@ -466,7 +517,8 @@ proc click {w} { 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 { @@ -475,6 +527,7 @@ proc savestuff {w} { 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]" @@ -674,12 +727,12 @@ proc bindline {t id} { $canv bind $t "lineenter %x %y $id" $canv bind $t "linemotion %x %y $id" $canv bind $t "lineleave $id" - $canv bind $t "lineclick %x %y $id" + $canv bind $t "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 @@ -713,7 +766,7 @@ proc drawcommitline {level} { } } } - set x [expr $canvx0 + $level * $linespc] + set x [xcoord $level $level $lineno] set y1 $canvy set canvy [expr $canvy + $linespc] allcanvs conf -scrollregion \ @@ -741,7 +794,7 @@ proc drawcommitline {level} { -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}] } @@ -817,8 +870,8 @@ proc drawtags {id x xt y1} { 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 @@ -827,10 +880,11 @@ proc updatetodo {level noshortcut} { 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 } } @@ -876,28 +930,54 @@ proc notecrossings {id lo hi corner} { } } -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} { @@ -909,28 +989,48 @@ proc drawslants {} { } } 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 @@ -1002,7 +1102,7 @@ proc decidenext {{noread 0}} { proc drawcommit {id} { global phase todo nchildren datemode nextupdate - global startcommits + global startcommits numcommits ncmupdate if {$phase != "incrdraw"} { set phase incrdraw @@ -1021,7 +1121,7 @@ proc drawcommit {id} { return } while 1 { - drawslants + drawslants $level drawcommitline $level if {[updatetodo $level $datemode]} { set level [decidenext 1] @@ -1031,8 +1131,9 @@ proc drawcommit {id} { if {![info exists commitlisted($id)]} { break } - if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate + if {[clock clicks -milliseconds] >= $nextupdate + && $numcommits >= $ncmupdate} { + doupdate 1 if {$stopped} break } } @@ -1050,20 +1151,32 @@ proc finishcommits {} { -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 1 initgraph set todo [lindex $startcommits 0] drawrest 0 1 @@ -1072,7 +1185,7 @@ proc drawgraph {} { 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} { @@ -1099,11 +1212,11 @@ proc drawrest {level startix} { if {$hard} { set level [decidenext] if {$level < 0} break - drawslants + drawslants $level } - if {[clock clicks -milliseconds] >= $nextupdate} { - update - incr nextupdate 100 + if {[clock clicks -milliseconds] >= $nextupdate + && $numcommits >= $ncmupdate} { + doupdate 0 } } } @@ -1112,7 +1225,7 @@ proc drawrest {level startix} { #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 @@ -1211,7 +1324,7 @@ proc dofind {} { 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] @@ -1290,7 +1403,7 @@ proc stopfindproc {{done 0}} { unset findinprogress if {$phase != "incrdraw"} { . config -cursor $maincursor - $ctext config -cursor $textcursor + settextcursor $textcursor } } } @@ -1333,7 +1446,7 @@ proc findpatches {} { fileevent $f readable readfindproc set finddidsel 0 . config -cursor watch - $ctext config -cursor watch + settextcursor watch set findinprogress 1 } @@ -1438,7 +1551,7 @@ proc findfiles {} { 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 @@ -1588,7 +1701,7 @@ proc unmarkmatches {} { } 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 @@ -1602,15 +1715,25 @@ proc selcanvline {w x y} { if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return } unmarkmatches - selectline $l + selectline $l 1 } -proc selectline {l} { +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 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 @@ -1659,6 +1782,11 @@ proc selectline {l} { } allcanvs yview moveto [expr $newtop * 1.0 / $ymax] } + + if {$isnew} { + addtohistory [list selectline $l 0] + } + set selectedline $l set id $lineid($l) @@ -1682,9 +1810,42 @@ proc selectline {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 { %W configure -cursor hand2 } + $ctext tag bind link { %W configure -cursor $curtextcursor } + $ctext tag delete Comments $ctext tag remove found 1.0 end $ctext conf -state disabled @@ -1704,7 +1865,64 @@ proc selnextline {dir} { 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} { @@ -1714,7 +1932,9 @@ proc mergediff {id} { set diffpindex -1 set diffmergegca [findgca $parents($id)] if {[info exists mergefilelist($id)]} { - showmergediff + if {$mergefilelist($id) ne {}} { + showmergediff + } } else { contmergediff {} } @@ -1738,7 +1958,7 @@ proc findgca {ids} { 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. @@ -1752,7 +1972,9 @@ proc contmergediff {ids} { } if {![info exists treediffs($ids)]} { set diffids $ids - gettreediffs $ids + if {![info exists treepending]} { + gettreediffs $ids + } return } } @@ -1790,16 +2012,443 @@ proc contmergediff {ids} { } set mergefilelist($diffmergeid) $files - showmergediff + if {$files ne {}} { + showmergediff + } } proc showmergediff {} { - global cflist diffmergeid mergefilelist + 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] + } +} + +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} { @@ -2005,14 +2654,18 @@ proc listboxsel {} { 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 @@ -2024,7 +2677,7 @@ proc redisplay {} { } 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}]] @@ -2092,7 +2745,7 @@ proc gotocommit {} { } } if {[info exists idline($id)]} { - selectline $idline($id) + selectline $idline($id) 1 return } if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { @@ -2166,34 +2819,40 @@ proc linehover {} { $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 { %W configure -cursor hand2 } + $ctext tag bind link { %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 @@ -2204,7 +2863,7 @@ proc lineclick {x y id} { proc selbyid {id} { global idline if {[info exists idline($id)]} { - selectline $idline($id) + selectline $idline($id) 1 } } @@ -2233,8 +2892,6 @@ proc rowmenu {x y id} { proc diffvssel {dirn} { global rowmenuid selectedline lineid - global ctext cflist - global commitinfo if {![info exists selectedline]} return if {$dirn} { @@ -2244,21 +2901,38 @@ proc diffvssel {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 { %W configure -cursor hand2 } + $ctext tag bind link { %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 {} { @@ -2392,10 +3066,7 @@ proc domktag {} { 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 @@ -2411,7 +3082,7 @@ proc domktag {} { 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 } } @@ -2498,6 +3169,7 @@ 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} @@ -2520,6 +3192,9 @@ foreach arg $argv { } } +set history {} +set historyindex 0 + set stopped 0 set redisplaying 0 set stuffsaved 0