X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=gitk;h=fa1e83c494ea6da8ba397d7c0314abd250ef3487;hb=879e8b1aad021cade0a254db0a5b67f56d99902a;hp=35ae1018b6b77646ee87e2bc9ed955ad6baea65c;hpb=df3d83b143d0e149767acfebc91b2041f44507ef;p=git.git diff --git a/gitk b/gitk index 35ae1018..fa1e83c4 100755 --- a/gitk +++ b/gitk @@ -1,85 +1,228 @@ #!/bin/sh # Tcl ignores the next line -*- tcl -*- \ -exec wish "$0" -- "${1+$@}" +exec wish "$0" -- "$@" # Copyright (C) 2005 Paul Mackerras. All rights reserved. # This program is free software; it may be used, copied, modified # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. -# CVS $Revision: 1.14 $ +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 - if {$rargs == {}} { - set rargs HEAD +proc parse_args {rargs} { + global parsed_args + + if {[catch { + set parse_args [concat --default HEAD $rargs] + set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] + }]} { + # if git-rev-parse failed for some reason... + if {$rargs == {}} { + set rargs HEAD + } + set parsed_args $rargs } - set commits {} - set phase getcommits - if [catch {set commfd [open "|git-rev-tree $rargs" r]} err] { - puts stderr "Error executing git-rev-tree: $err" + return $parsed_args +} + +proc start_rev_list {rlargs} { + global startmsecs nextupdate ncmupdate + global commfd leftover tclencoding datemode + + set startmsecs [clock clicks -milliseconds] + set nextupdate [expr {$startmsecs + 100}] + set ncmupdate 1 + initlayout + set order "--topo-order" + if {$datemode} { + set order "--date-order" + } + if {[catch { + set commfd [open [concat | git-rev-list --header $order \ + --parents --boundary $rlargs] r] + } err]} { + puts stderr "Error executing git-rev-list: $err" exit 1 } - fconfigure $commfd -blocking 0 - fileevent $commfd readable "getcommitline $commfd" + set leftover {} + fconfigure $commfd -blocking 0 -translation lf + if {$tclencoding != {}} { + fconfigure $commfd -encoding $tclencoding + } + fileevent $commfd readable [list getcommitlines $commfd] + . config -cursor watch + settextcursor watch +} + +proc getcommits {rargs} { + global phase canv mainfont + + set phase getcommits + start_rev_list [parse_args $rargs] $canv delete all $canv create text 3 3 -anchor nw -text "Reading commits..." \ -font $mainfont -tags textitems } -proc getcommitline {commfd} { - global commits parents cdate nparents children nchildren - set n [gets $commfd line] - if {$n < 0} { +proc getcommitlines {commfd} { + global commitlisted nextupdate + global leftover + global displayorder commitidx commitrow commitdata + + 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 drawgraph + after idle finishcommits return } if {[string range $err 0 4] == "usage"} { - set err "\ -Gitk: error reading commits: bad arguments to git-rev-tree.\n\ -(Note: arguments to gitk are passed to git-rev-tree\ -to allow selection of commits to be displayed.)" + set err \ + "Gitk: error reading commits: bad arguments to git-rev-list.\ + (Note: arguments to gitk are passed to git-rev-list\ + to allow selection of commits to be displayed.)" } else { set err "Error reading commits: $err" } error_popup $err exit 1 } - - set i 0 - set cid {} - foreach f $line { - if {$i == 0} { - set d $f + set start 0 + set gotsome 0 + while 1 { + set i [string first "\0" $stuff $start] + if {$i < 0} { + append leftover [string range $stuff $start end] + break + } + if {$start == 0} { + set cmit $leftover + append cmit [string range $stuff 0 [expr {$i - 1}]] + set leftover {} } else { - set id [lindex [split $f :] 0] - if {![info exists nchildren($id)]} { - set children($id) {} - set nchildren($id) 0 - } - if {$i == 1} { - set cid $id - lappend commits $id - set parents($id) {} - set cdate($id) $d - set nparents($id) 0 - } else { - lappend parents($cid) $id - incr nparents($cid) - incr nchildren($id) - lappend children($id) $cid + set cmit [string range $stuff $start [expr {$i - 1}]] + } + set start [expr {$i + 1}] + set j [string first "\n" $cmit] + set ok 0 + set listed 1 + if {$j >= 0} { + set ids [string range $cmit 0 [expr {$j - 1}]] + if {[string range $ids 0 0] == "-"} { + set listed 0 + set ids [string range $ids 1 end] } + set ok 1 + foreach id $ids { + if {[string length $id] != 40} { + set ok 0 + break + } + } + } + if {!$ok} { + set shortcmit $cmit + if {[string length $shortcmit] > 80} { + set shortcmit "[string range $shortcmit 0 80]..." + } + error_popup "Can't parse git-rev-list output: {$shortcmit}" + exit 1 + } + set id [lindex $ids 0] + if {$listed} { + set olds [lrange $ids 1 end] + set commitlisted($id) 1 + } else { + set olds {} } - incr i + updatechildren $id $olds + set commitdata($id) [string range $cmit [expr {$j + 1}] end] + set commitrow($id) $commitidx + incr commitidx + lappend displayorder $id + set gotsome 1 + } + if {$gotsome} { + layoutmore + } + if {[clock clicks -milliseconds] >= $nextupdate} { + doupdate 1 + } +} + +proc doupdate {reading} { + global commfd nextupdate numcommits ncmupdate + + if {$reading} { + fileevent $commfd readable {} + } + update + 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} { - global commitinfo + if {[catch {set contents [exec git-cat-file commit $id]}]} return + updatechildren $id {} + parsecommit $id $contents 0 +} + +proc updatecommits {rargs} { + stopfindproc + foreach v {children nchildren parents nparents commitlisted + colormap selectedline matchinglines treediffs + mergefilelist currentid rowtextx commitrow + rowidlist rowoffsets idrowranges idrangedrawn iddrawn + linesegends crossings cornercrossings} { + global $v + catch {unset $v} + } + allcanvs delete all + readrefs + getcommits $rargs +} + +proc updatechildren {id olds} { + global children nchildren parents nparents + + if {![info exists nchildren($id)]} { + set children($id) {} + set nchildren($id) 0 + } + set parents($id) $olds + set nparents($id) [llength $olds] + foreach p $olds { + if {![info exists nchildren($p)]} { + set children($p) [list $id] + set nchildren($p) 1 + } elseif {[lsearch -exact $children($p) $id] < 0} { + lappend children($p) $id + incr nchildren($p) + } + } +} + +proc parsecommit {id contents listed} { + global commitinfo cdate + set inhdr 1 set comment {} set headline {} @@ -87,42 +230,108 @@ proc readcommit {id} { set audate {} set comname {} set comdate {} - if [catch {set contents [exec git-cat-file commit $id]}] return - foreach line [split $contents "\n"] { - if {$inhdr} { - if {$line == {}} { - set inhdr 0 - } else { - set tag [lindex $line 0] - if {$tag == "author"} { - set x [expr {[llength $line] - 2}] - set audate [lindex $line $x] - set auname [lrange $line 1 [expr {$x - 1}]] - } elseif {$tag == "committer"} { - set x [expr {[llength $line] - 2}] - set comdate [lindex $line $x] - set comname [lrange $line 1 [expr {$x - 1}]] - } - } - } else { - if {$comment == {}} { - set headline $line - } else { - append comment "\n" - } - append comment $line + set hdrend [string first "\n\n" $contents] + if {$hdrend < 0} { + # should never happen... + set hdrend [string length $contents] + } + set header [string range $contents 0 [expr {$hdrend - 1}]] + set comment [string range $contents [expr {$hdrend + 2}] end] + foreach line [split $header "\n"] { + set tag [lindex $line 0] + if {$tag == "author"} { + set audate [lindex $line end-1] + set auname [lrange $line 1 end-2] + } elseif {$tag == "committer"} { + set comdate [lindex $line end-1] + set comname [lrange $line 1 end-2] } } - if {$audate != {}} { - set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] + set headline {} + # take the first line of the comment as the headline + set i [string first "\n" $comment] + if {$i >= 0} { + set headline [string trim [string range $comment 0 $i]] + } else { + set headline $comment + } + if {!$listed} { + # git-rev-list indents the comment by 4 spaces; + # if we got this via git-cat-file, add the indentation + set newcomment {} + foreach line [split $comment "\n"] { + append newcomment " " + append newcomment $line + append newcomment "\n" + } + set comment $newcomment } if {$comdate != {}} { - set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] + set cdate($id) $comdate } set commitinfo($id) [list $headline $auname $audate \ $comname $comdate $comment] } +proc getcommit {id} { + global commitdata commitinfo nparents + + if {[info exists commitdata($id)]} { + parsecommit $id $commitdata($id) 1 + } else { + readcommit $id + if {![info exists commitinfo($id)]} { + set commitinfo($id) {"No commit information available"} + set nparents($id) 0 + } + } + return 1 +} + +proc readrefs {} { + global tagids idtags headids idheads tagcontents + global otherrefids idotherrefs + + foreach v {tagids idtags headids idheads otherrefids idotherrefs} { + catch {unset $v} + } + set refd [open [list | git-ls-remote [gitdir]] r] + while {0 <= [set n [gets $refd line]]} { + if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \ + match id path]} { + continue + } + if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { + set type others + set name $path + } + if {$type == "tags"} { + set tagids($name) $id + lappend idtags($id) $name + set obj {} + set type {} + set tag {} + catch { + set commit [exec git-rev-parse "$id^0"] + if {"$commit" != "$id"} { + set tagids($name) $commit + lappend idtags($commit) $name + } + } + catch { + set tagcontents($name) [exec git-cat-file tag "$id"] + } + } elseif { $type == "heads" } { + set headids($name) $id + lappend idheads($id) $name + } else { + set otherrefids($name) $id + lappend idotherrefs($id) $name + } + } + close $refd +} + proc error_popup msg { set w .error toplevel $w @@ -132,27 +341,36 @@ proc error_popup msg { button $w.ok -text OK -command "destroy $w" pack $w.ok -side bottom -fill x bind $w "grab $w; focus $w" + bind $w "destroy $w" tkwait window $w } -proc makewindow {} { +proc makewindow {rargs} { global canv canv2 canv3 linespc charspc ctext cflist textfont - global sha1entry findtype findloc findstring fstring geometry + global findtype findtypemenu findloc findstring fstring geometry + global entries sha1entry sha1string sha1but + global maincursor textcursor curtextcursor + global rowctxmenu mergemax menu .bar .bar add cascade -label "File" -menu .bar.file menu .bar.file + .bar.file add command -label "Update" -command [list updatecommits $rargs] + .bar.file add command -label "Reread references" -command rereadrefs .bar.file add command -label "Quit" -command doquit + menu .bar.edit + .bar add cascade -label "Edit" -menu .bar.edit + .bar.edit add command -label "Preferences" -command doprefs menu .bar.help .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about . configure -menu .bar if {![info exists geometry(canv1)]} { - set geometry(canv1) [expr 45 * $charspc] - set geometry(canv2) [expr 30 * $charspc] - set geometry(canv3) [expr 15 * $charspc] - set geometry(canvh) [expr 25 * $linespc + 4] + set geometry(canv1) [expr {45 * $charspc}] + set geometry(canv2) [expr {30 * $charspc}] + set geometry(canv3) [expr {15 * $charspc}] + set geometry(canvh) [expr {25 * $linespc + 4}] set geometry(ctextw) 80 set geometry(ctexth) 30 set geometry(cflistw) 30 @@ -160,6 +378,9 @@ proc makewindow {} { panedwindow .ctop -orient vertical if {[info exists geometry(width)]} { .ctop conf -width $geometry(width) -height $geometry(height) + set texth [expr {$geometry(height) - $geometry(canvh) - 56}] + set geometry(ctexth) [expr {($texth - 8) / + [font metrics $textfont -linespace]}] } frame .ctop.top frame .ctop.top.bar @@ -173,7 +394,7 @@ proc makewindow {} { set canv .ctop.top.clist.canv canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ -bg white -bd 0 \ - -yscrollincr $linespc -yscrollcommand "$cscroll set" + -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" .ctop.top.clist add $canv set canv2 .ctop.top.clist.canv2 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ @@ -186,25 +407,56 @@ proc makewindow {} { bind .ctop.top.clist {resizeclistpanes %W %w} set sha1entry .ctop.top.bar.sha1 - label .ctop.top.bar.sha1label -text "SHA1 ID: " + set entries $sha1entry + set sha1but .ctop.top.bar.sha1label + button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ + -command gotocommit -width 8 + $sha1but conf -disabledforeground [$sha1but cget -foreground] pack .ctop.top.bar.sha1label -side left - entry $sha1entry -width 40 -font $textfont -state readonly + 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 fstring .ctop.top.bar.findstring + lappend entries $fstring entry $fstring -width 30 -font $textfont -textvariable findstring - # stop the toplevel events from firing on key presses - bind $fstring "[bind Entry ]; break" pack $fstring -side left -expand 1 -fill x set findtype Exact - tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp + set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ + findtype Exact IgnCase Regexp] set findloc "All fields" tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ - Comments Author Committer + Comments Author Committer Files Pickaxe pack .ctop.top.bar.findloc -side right pack .ctop.top.bar.findtype -side right + # for making sure type==Exact whenever loc==Pickaxe + trace add variable findloc write findlocchange panedwindow .ctop.cdet -orient horizontal .ctop add .ctop.cdet @@ -212,21 +464,41 @@ 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 .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 filesep -font [concat $textfont bold] -back "#aaaaaa" + $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 m5 -fore "#009090" + $ctext tag conf m6 -fore magenta + $ctext tag conf m7 -fore "#808000" + $ctext tag conf m8 -fore "#009000" + $ctext tag conf m9 -fore "#ff0080" + $ctext tag conf m10 -fore cyan + $ctext tag conf m11 -fore "#b07070" + $ctext tag conf m12 -fore "#70b0f0" + $ctext tag conf m13 -fore "#70f0b0" + $ctext tag conf m14 -fore "#f0b070" + $ctext tag conf m15 -fore "#ff70b0" + $ctext tag conf mmax -fore darkgrey + set mergemax 16 + $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 - listbox $cflist -width $geometry(cflistw) -bg white -selectmode extended \ + listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ -yscrollcommand ".ctop.cdet.right.sb set" scrollbar .ctop.cdet.right.sb -command "$cflist yview" pack .ctop.cdet.right.sb -side right -fill y @@ -236,29 +508,39 @@ proc makewindow {} { pack .ctop -side top -fill both -expand 1 - bindall <1> {selcanvline %x %y} - bindall {selcanvline %x %y} - bindall "allcanvs yview scroll -5 u" - bindall "allcanvs yview scroll 5 u" - bindall <2> "allcanvs scan mark 0 %y" - bindall "allcanvs scan dragto 0 %y" - bindall "selnextline -1" - bindall "selnextline 1" - bindall "allcanvs yview scroll -1 p" - bindall "allcanvs yview scroll 1 p" - bindkey "$ctext yview scroll -1 p" - bindkey "$ctext yview scroll -1 p" - bindkey "$ctext yview scroll 1 p" + bindall <1> {selcanvline %W %x %y} + #bindall {selcanvline %W %x %y} + bindall "allcanvs yview scroll -5 units" + bindall "allcanvs yview scroll 5 units" + bindall <2> "canvscan mark %W %x %y" + bindall "canvscan dragto %W %x %y" + bind . "selnextline -1" + bind . "selnextline 1" + bind . "goforw" + bind . "goback" + bind . "allcanvs yview scroll -1 pages" + bind . "allcanvs yview scroll 1 pages" + bindkey "$ctext yview scroll -1 pages" + bindkey "$ctext yview scroll -1 pages" + bindkey "$ctext yview scroll 1 pages" bindkey p "selnextline -1" bindkey n "selnextline 1" - bindkey b "$ctext yview scroll -1 p" - bindkey d "$ctext yview scroll 18 u" - bindkey u "$ctext yview scroll -18 u" - bindkey / findnext + bindkey z "goback" + bindkey x "goforw" + bindkey i "selnextline -1" + bindkey k "selnextline 1" + bindkey j "goback" + bindkey l "goforw" + bindkey b "$ctext yview scroll -1 pages" + bindkey d "$ctext yview scroll 18 units" + bindkey u "$ctext yview scroll -18 units" + bindkey / {findnext 1} + bindkey {findnext 0} bindkey ? findprev + bindkey f nextfile bind . doquit bind . dofind - bind . findnext + bind . {findnext 0} bind . findprev bind . {incrfont 1} bind . {incrfont 1} @@ -267,52 +549,91 @@ proc makewindow {} { bind $cflist <> listboxsel bind . {savestuff %W} bind . "click %W" + bind $fstring dofind + bind $sha1entry gotocommit + bind $sha1entry <> clearsha1 + + set maincursor [. cget -cursor] + set textcursor [$ctext cget -cursor] + set curtextcursor $textcursor + + set rowctxmenu .rowctxmenu + menu $rowctxmenu -tearoff 0 + $rowctxmenu add command -label "Diff this -> selected" \ + -command {diffvssel 0} + $rowctxmenu add command -label "Diff selected -> this" \ + -command {diffvssel 1} + $rowctxmenu add command -label "Make patch" -command mkpatch + $rowctxmenu add command -label "Create tag" -command mktag + $rowctxmenu add command -label "Write commit to file" -command writecommit +} + +# mouse-2 makes all windows scan vertically, but only the one +# the cursor is in scans horizontally +proc canvscan {op w x y} { + global canv canv2 canv3 + foreach c [list $canv $canv2 $canv3] { + if {$c == $w} { + $c scan $op $x $y + } else { + $c scan $op 0 $y + } + } +} + +proc scrollcanv {cscroll f0 f1} { + $cscroll set $f0 $f1 + drawfrac $f0 $f1 } # when we make a key binding for the toplevel, make sure # it doesn't get triggered when that key is pressed in the # find string entry widget. proc bindkey {ev script} { - global fstring + global entries bind . $ev $script set escript [bind Entry $ev] if {$escript == {}} { set escript [bind Entry ] } - bind $fstring $ev "$escript; break" + foreach e $entries { + bind $e $ev "$escript; break" + } } # set the focus back to the toplevel for any click outside -# the find string entry widget +# the entry widgets proc click {w} { - global fstring - if {$w != $fstring} { - focus . + global entries + foreach e $entries { + if {$w == $e} return } + focus . } proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont - global stuffsaved + global stuffsaved findmergefiles maxgraphpct + global maxwidth + 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 maxgraphpct $maxgraphpct] + puts $f [list set maxwidth $maxwidth] 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]" - puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" - puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" - puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" - puts $f "set geometry(csash) {[.ctop sash coord 0]}" + puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]" + puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]" + puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]" + puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]" set wid [expr {([winfo width $ctext] - 8) \ / [font measure $textfont "0"]}] - set ht [expr {([winfo height $ctext] - 8) \ - / [font metrics $textfont -linespace]}] puts $f "set geometry(ctextw) $wid" - puts $f "set geometry(ctexth) $ht" set wid [expr {([winfo width $cflist] - 11) \ / [font measure [$cflist cget -font] "0"]}] puts $f "set geometry(cflistw) $wid" @@ -324,7 +645,7 @@ proc savestuff {w} { proc resizeclistpanes {win w} { global oldwidth - if [info exists oldwidth($win)] { + if {[info exists oldwidth($win)]} { set s0 [$win sash coord 0] set s1 [$win sash coord 1] if {$w < 60} { @@ -338,12 +659,12 @@ proc resizeclistpanes {win w} { set sash0 30 } if {$sash1 < $sash0 + 20} { - set sash1 [expr $sash0 + 20] + set sash1 [expr {$sash0 + 20}] } if {$sash1 > $w - 10} { - set sash1 [expr $w - 10] + set sash1 [expr {$w - 10}] if {$sash0 > $sash1 - 20} { - set sash0 [expr $sash1 - 20] + set sash0 [expr {$sash1 - 20}] } } } @@ -355,7 +676,7 @@ proc resizeclistpanes {win w} { proc resizecdetpanes {win w} { global oldwidth - if [info exists oldwidth($win)] { + if {[info exists oldwidth($win)]} { set s0 [$win sash coord 0] if {$w < 60} { set sash0 [expr {int($w*3/4 - 2)}] @@ -366,7 +687,7 @@ proc resizecdetpanes {win w} { set sash0 45 } if {$sash0 > $w - 15} { - set sash0 [expr $w - 15] + set sash0 [expr {$w - 15}] } } $win sash place 0 $sash0 [lindex $s0 1] @@ -397,353 +718,1086 @@ proc about {} { toplevel $w wm title $w "About gitk" message $w.m -text { -Gitk version 0.95 - -Copyright © 2005 Paul Mackerras +Gitk - a commit viewer for git -Use and redistribute under the terms of the GNU General Public License +Copyright © 2005-2006 Paul Mackerras -(CVS $Revision: 1.14 $)} \ +Use and redistribute under the terms of the GNU General Public License} \ -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 button $w.ok -text Close -command "destroy $w" pack $w.ok -side bottom } -proc truncatetofit {str width font} { - if {[font measure $font $str] <= $width} { - return $str - } - set best 0 - set bad [string length $str] - set tmp $str - while {$best < $bad - 1} { - set try [expr {int(($best + $bad) / 2)}] - set tmp "[string range $str 0 [expr $try-1]]..." - if {[font measure $font $tmp] <= $width} { - set best $try +proc shortids {ids} { + set res {} + foreach id $ids { + if {[llength $id] > 1} { + lappend res [shortids $id] + } elseif {[regexp {^[0-9a-f]{40}$} $id]} { + lappend res [string range $id 0 7] } else { - set bad $try + lappend res $id } } - return $tmp + return $res } -proc assigncolor {id} { - global commitinfo colormap commcolors colors nextcolor - global colorbycommitter - global parents nparents children nchildren - if [info exists colormap($id)] return - set ncolors [llength $colors] - if {$colorbycommitter} { - if {![info exists commitinfo($id)]} { - readcommit $id +proc incrange {l x o} { + set n [llength $l] + while {$x < $n} { + set e [lindex $l $x] + if {$e ne {}} { + lset l $x [expr {$e + $o}] } - set comm [lindex $commitinfo($id) 3] - if {![info exists commcolors($comm)]} { - set commcolors($comm) [lindex $colors $nextcolor] - if {[incr nextcolor] >= $ncolors} { - set nextcolor 0 - } + incr x + } + return $l +} + +proc ntimes {n o} { + set ret {} + for {} {$n > 0} {incr n -1} { + lappend ret $o + } + return $ret +} + +proc usedinrange {id l1 l2} { + global children commitrow + + if {[info exists commitrow($id)]} { + set r $commitrow($id) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] } - set colormap($id) $commcolors($comm) - } else { - if {$nparents($id) == 1 && $nchildren($id) == 1} { - set child [lindex $children($id) 0] - if {[info exists colormap($child)] - && $nparents($child) == 1} { - set colormap($id) $colormap($child) - return + } + foreach c $children($id) { + if {[info exists commitrow($c)]} { + set r $commitrow($c) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] } } - set badcolors {} - foreach child $children($id) { - if {[info exists colormap($child)] - && [lsearch -exact $badcolors $colormap($child)] < 0} { - lappend badcolors $colormap($child) - } - if {[info exists parents($child)]} { - foreach p $parents($child) { - if {[info exists colormap($p)] - && [lsearch -exact $badcolors $colormap($p)] < 0} { - lappend badcolors $colormap($p) - } + } + return 0 +} + +proc sanity {row {full 0}} { + global rowidlist rowoffsets + + set col -1 + set ids [lindex $rowidlist $row] + foreach id $ids { + incr col + if {$id eq {}} continue + if {$col < [llength $ids] - 1 && + [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} { + puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}" + } + set o [lindex $rowoffsets $row $col] + set y $row + set x $col + while {$o ne {}} { + incr y -1 + incr x $o + if {[lindex $rowidlist $y $x] != $id} { + puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]" + puts " id=[shortids $id] check started at row $row" + for {set i $row} {$i >= $y} {incr i -1} { + puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}" } + break } + if {!$full} break + set o [lindex $rowoffsets $y $x] } - if {[llength $badcolors] >= $ncolors} { - set badcolors {} - } - for {set i 0} {$i <= $ncolors} {incr i} { - set c [lindex $colors $nextcolor] - if {[incr nextcolor] >= $ncolors} { - set nextcolor 0 + } +} + +proc makeuparrow {oid x y z} { + global rowidlist rowoffsets uparrowlen idrowranges + + for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} { + incr y -1 + incr x $z + set off0 [lindex $rowoffsets $y] + for {set x0 $x} {1} {incr x0} { + if {$x0 >= [llength $off0]} { + set x0 [llength [lindex $rowoffsets [expr {$y-1}]]] + break + } + set z [lindex $off0 $x0] + if {$z ne {}} { + incr x0 $z + break } - if {[lsearch -exact $badcolors $c]} break } - set colormap($id) $c + set z [expr {$x0 - $x}] + lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid] + lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z] } + set tmp [lreplace [lindex $rowoffsets $y] $x $x {}] + lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1] + lappend idrowranges($oid) $y } -proc drawgraph {} { - global parents children nparents nchildren commits - global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc - global datemode cdate - global lineid linehtag linentag linedtag commitinfo - global nextcolor colormap numcommits - global stopped phase redisplaying selectedline +proc initlayout {} { + global rowidlist rowoffsets displayorder + global rowlaidout rowoptim + global idinlist rowchk + global commitidx numcommits canvxmax canv + global nextcolor - allcanvs delete all - set start {} - foreach id [array names nchildren] { - if {$nchildren($id) == 0} { - lappend start $id - } - set ncleft($id) $nchildren($id) - if {![info exists nparents($id)]} { - set nparents($id) 0 - } + set commitidx 0 + set numcommits 0 + set displayorder {} + set nextcolor 0 + set rowidlist {{}} + set rowoffsets {{}} + catch {unset idinlist} + catch {unset rowchk} + set rowlaidout 0 + set rowoptim 0 + set canvxmax [$canv cget -width] +} + +proc setcanvscroll {} { + global canv canv2 canv3 numcommits linespc canvxmax canvy0 + + set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}] + $canv conf -scrollregion [list 0 0 $canvxmax $ymax] + $canv2 conf -scrollregion [list 0 0 0 $ymax] + $canv3 conf -scrollregion [list 0 0 0 $ymax] +} + +proc visiblerows {} { + global canv numcommits linespc + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set f [$canv yview] + set y0 [expr {int([lindex $f 0] * $ymax)}] + set r0 [expr {int(($y0 - 3) / $linespc) - 1}] + if {$r0 < 0} { + set r0 0 } - if {$start == {}} { - error_popup "Gitk: ERROR: No starting commits found" - exit 1 + set y1 [expr {int([lindex $f 1] * $ymax)}] + set r1 [expr {int(($y1 - 3) / $linespc) + 1}] + if {$r1 >= $numcommits} { + set r1 [expr {$numcommits - 1}] } + return [list $r0 $r1] +} - set nextcolor 0 - foreach id $start { - assigncolor $id - } - set todo $start - set level [expr [llength $todo] - 1] - set y2 $canvy0 - set nullentry -1 - set lineno -1 - set numcommits 0 - set phase drawgraph - while 1 { - set canvy $y2 - allcanvs conf -scrollregion [list 0 0 0 $canvy] - update - if {$stopped} break - incr numcommits - incr lineno - set nlines [llength $todo] - set id [lindex $todo $level] - set lineid($lineno) $id - set actualparents {} - if {[info exists parents($id)]} { - foreach p $parents($id) { - incr ncleft($p) -1 - if {![info exists commitinfo($p)]} { - readcommit $p - if {![info exists commitinfo($p)]} continue +proc layoutmore {} { + global rowlaidout rowoptim commitidx numcommits optim_delay + global uparrowlen + + set row $rowlaidout + set rowlaidout [layoutrows $row $commitidx 0] + set orow [expr {$rowlaidout - $uparrowlen - 1}] + if {$orow > $rowoptim} { + checkcrossings $rowoptim $orow + optimize_rows $rowoptim 0 $orow + set rowoptim $orow + } + set canshow [expr {$rowoptim - $optim_delay}] + if {$canshow > $numcommits} { + showstuff $canshow + } +} + +proc showstuff {canshow} { + global numcommits + global linesegends idrowranges idrangedrawn + + if {$numcommits == 0} { + global phase + set phase "incrdraw" + allcanvs delete all + } + set row $numcommits + set numcommits $canshow + setcanvscroll + set rows [visiblerows] + set r0 [lindex $rows 0] + set r1 [lindex $rows 1] + for {set r $row} {$r < $canshow} {incr r} { + if {[info exists linesegends($r)]} { + foreach id $linesegends($r) { + set i -1 + foreach {s e} $idrowranges($id) { + incr i + if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0 + && ![info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + set idrangedrawn($id,$i) 1 + } } - lappend actualparents $p } } - if {![info exists commitinfo($id)]} { - readcommit $id - if {![info exists commitinfo($id)]} { - set commitinfo($id) {"No commit information available"} - } - } - set x [expr $canvx0 + $level * $linespc] - set y2 [expr $canvy + $linespc] - if {[info exists linestarty($level)] && $linestarty($level) < $canvy} { - set t [$canv create line $x $linestarty($level) $x $canvy \ - -width 2 -fill $colormap($id)] - $canv lower $t - } - set linestarty($level) $canvy - set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \ - [expr $x + 3] [expr $canvy + 3] \ - -fill blue -outline black -width 1] - $canv raise $t - set xt [expr $canvx0 + $nlines * $linespc] - set headline [lindex $commitinfo($id) 0] - set name [lindex $commitinfo($id) 1] - set date [lindex $commitinfo($id) 2] - set linehtag($lineno) [$canv create text $xt $canvy -anchor w \ - -text $headline -font $mainfont ] - set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \ - -text $name -font $namefont] - set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \ - -text $date -font $mainfont] - if {!$datemode && [llength $actualparents] == 1} { - set p [lindex $actualparents 0] - if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { - assigncolor $p - set todo [lreplace $todo $level $level $p] - continue + } + if {$canshow > $r1} { + set canshow $r1 + } + while {$row < $canshow} { + drawcmitrow $row + incr row + } +} + +proc layoutrows {row endrow last} { + global rowidlist rowoffsets displayorder + global uparrowlen downarrowlen maxwidth mingaplen + global nchildren parents nparents + global idrowranges linesegends + global commitidx + global idinlist rowchk + + set idlist [lindex $rowidlist $row] + set offs [lindex $rowoffsets $row] + while {$row < $endrow} { + set id [lindex $displayorder $row] + set oldolds {} + set newolds {} + foreach p $parents($id) { + if {![info exists idinlist($p)]} { + lappend newolds $p + } elseif {!$idinlist($p)} { + lappend oldolds $p } } - - set oldtodo $todo - set oldlevel $level - set lines {} - for {set i 0} {$i < $nlines} {incr i} { - if {[lindex $todo $i] == {}} continue - if {[info exists linestarty($i)]} { - set oldstarty($i) $linestarty($i) - unset linestarty($i) + set nev [expr {[llength $idlist] + [llength $newolds] + + [llength $oldolds] - $maxwidth + 1}] + if {$nev > 0} { + if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break + for {set x [llength $idlist]} {[incr x -1] >= 0} {} { + set i [lindex $idlist $x] + if {![info exists rowchk($i)] || $row >= $rowchk($i)} { + set r [usedinrange $i [expr {$row - $downarrowlen}] \ + [expr {$row + $uparrowlen + $mingaplen}]] + if {$r == 0} { + set idlist [lreplace $idlist $x $x] + set offs [lreplace $offs $x $x] + set offs [incrange $offs $x 1] + set idinlist($i) 0 + set rm1 [expr {$row - 1}] + lappend linesegends($rm1) $i + lappend idrowranges($i) $rm1 + if {[incr nev -1] <= 0} break + continue + } + set rowchk($id) [expr {$row + $r}] + } } - if {$i != $level} { - lappend lines [list $i [lindex $todo $i]] + lset rowidlist $row $idlist + lset rowoffsets $row $offs + } + set col [lsearch -exact $idlist $id] + if {$col < 0} { + set col [llength $idlist] + lappend idlist $id + lset rowidlist $row $idlist + set z {} + if {$nchildren($id) > 0} { + set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}] + unset idinlist($id) + } + lappend offs $z + lset rowoffsets $row $offs + if {$z ne {}} { + makeuparrow $id $col $row $z } + } else { + unset idinlist($id) + } + if {[info exists idrowranges($id)]} { + lappend idrowranges($id) $row } - if {$nullentry >= 0} { - set todo [lreplace $todo $nullentry $nullentry] - if {$nullentry < $level} { - incr level -1 + incr row + set offs [ntimes [llength $idlist] 0] + set l [llength $newolds] + set idlist [eval lreplace \$idlist $col $col $newolds] + set o 0 + if {$l != 1} { + set offs [lrange $offs 0 [expr {$col - 1}]] + foreach x $newolds { + lappend offs {} + incr o -1 } + incr o + set tmp [expr {[llength $idlist] - [llength $offs]}] + if {$tmp > 0} { + set offs [concat $offs [ntimes $tmp $o]] + } + } else { + lset offs $col {} } - - set todo [lreplace $todo $level $level] - if {$nullentry > $level} { - incr nullentry -1 + foreach i $newolds { + set idinlist($i) 1 + set idrowranges($i) $row + } + incr col $l + foreach oid $oldolds { + set idinlist($oid) 1 + set idlist [linsert $idlist $col $oid] + set offs [linsert $offs $col $o] + makeuparrow $oid $col $row $o + incr col } - set i $level - foreach p $actualparents { - set k [lsearch -exact $todo $p] - if {$k < 0} { - assigncolor $p - set todo [linsert $todo $i $p] - if {$nullentry >= $i} { - incr nullentry + lappend rowidlist $idlist + lappend rowoffsets $offs + } + return $row +} + +proc addextraid {id row} { + global displayorder commitrow commitinfo nparents + global commitidx + + incr commitidx + lappend displayorder $id + set commitrow($id) $row + readcommit $id + if {![info exists commitinfo($id)]} { + set commitinfo($id) {"No commit information available"} + set nparents($id) 0 + } +} + +proc layouttail {} { + global rowidlist rowoffsets idinlist commitidx + global idrowranges + + set row $commitidx + set idlist [lindex $rowidlist $row] + while {$idlist ne {}} { + set col [expr {[llength $idlist] - 1}] + set id [lindex $idlist $col] + addextraid $id $row + unset idinlist($id) + lappend idrowranges($id) $row + incr row + set offs [ntimes $col 0] + set idlist [lreplace $idlist $col $col] + lappend rowidlist $idlist + lappend rowoffsets $offs + } + + foreach id [array names idinlist] { + addextraid $id $row + lset rowidlist $row [list $id] + lset rowoffsets $row 0 + makeuparrow $id 0 $row 0 + lappend idrowranges($id) $row + incr row + lappend rowidlist {} + lappend rowoffsets {} + } +} + +proc insert_pad {row col npad} { + global rowidlist rowoffsets + + set pad [ntimes $npad {}] + lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad] + set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad] + lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]] +} + +proc optimize_rows {row col endrow} { + global rowidlist rowoffsets idrowranges linesegends displayorder + + for {} {$row < $endrow} {incr row} { + set idlist [lindex $rowidlist $row] + set offs [lindex $rowoffsets $row] + set haspad 0 + for {} {$col < [llength $offs]} {incr col} { + if {[lindex $idlist $col] eq {}} { + set haspad 1 + continue + } + set z [lindex $offs $col] + if {$z eq {}} continue + set isarrow 0 + set x0 [expr {$col + $z}] + set y0 [expr {$row - 1}] + set z0 [lindex $rowoffsets $y0 $x0] + if {$z0 eq {}} { + set id [lindex $idlist $col] + if {[info exists idrowranges($id)] && + $y0 > [lindex $idrowranges($id) 0]} { + set isarrow 1 } } - lappend lines [list $oldlevel $p] - } - - # choose which one to do next time around - set todol [llength $todo] - set level -1 - set latest {} - for {set k $todol} {[incr k -1] >= 0} {} { - set p [lindex $todo $k] - if {$p == {}} continue - if {$ncleft($p) == 0} { - if {$datemode} { - if {$latest == {} || $cdate($p) > $latest} { - set level $k - set latest $cdate($p) + if {$z < -1 || ($z < 0 && $isarrow)} { + set npad [expr {-1 - $z + $isarrow}] + set offs [incrange $offs $col $npad] + insert_pad $y0 $x0 $npad + if {$y0 > 0} { + optimize_rows $y0 $x0 $row + } + set z [lindex $offs $col] + set x0 [expr {$col + $z}] + set z0 [lindex $rowoffsets $y0 $x0] + } elseif {$z > 1 || ($z > 0 && $isarrow)} { + set npad [expr {$z - 1 + $isarrow}] + set y1 [expr {$row + 1}] + set offs2 [lindex $rowoffsets $y1] + set x1 -1 + foreach z $offs2 { + incr x1 + if {$z eq {} || $x1 + $z < $col} continue + if {$x1 + $z > $col} { + incr npad } - } else { - set level $k + lset rowoffsets $y1 [incrange $offs2 $x1 $npad] break } + set pad [ntimes $npad {}] + set idlist [eval linsert \$idlist $col $pad] + set tmp [eval linsert \$offs $col $pad] + incr col $npad + set offs [incrange $tmp $col [expr {-$npad}]] + set z [lindex $offs $col] + set haspad 1 } - } - if {$level < 0} { - if {$todo != {}} { - puts "ERROR: none of the pending commits can be done yet:" - foreach p $todo { - puts " $p" + if {$z0 eq {} && !$isarrow} { + # this line links to its first child on row $row-2 + set rm2 [expr {$row - 2}] + set id [lindex $displayorder $rm2] + set xc [lsearch -exact [lindex $rowidlist $rm2] $id] + if {$xc >= 0} { + set z0 [expr {$xc - $x0}] } } - break + if {$z0 ne {} && $z < 0 && $z0 > 0} { + insert_pad $y0 $x0 1 + set offs [incrange $offs $col 1] + optimize_rows $y0 [expr {$x0 + 1}] $row + } } - - # If we are reducing, put in a null entry - if {$todol < $nlines} { - if {$nullentry >= 0} { - set i $nullentry - while {$i < $todol - && [lindex $oldtodo $i] == [lindex $todo $i]} { - incr i - } - } else { - set i $oldlevel - if {$level >= $i} { - incr i + if {!$haspad} { + set o {} + for {set col [llength $idlist]} {[incr col -1] >= 0} {} { + set o [lindex $offs $col] + if {$o eq {}} { + # check if this is the link to the first child + set id [lindex $idlist $col] + if {[info exists idrowranges($id)] && + $row == [lindex $idrowranges($id) 0]} { + # it is, work out offset to child + set y0 [expr {$row - 1}] + set id [lindex $displayorder $y0] + set x0 [lsearch -exact [lindex $rowidlist $y0] $id] + if {$x0 >= 0} { + set o [expr {$x0 - $col}] + } + } } + if {$o eq {} || $o <= 0} break } - if {$i >= $todol} { - set nullentry -1 - } else { - set nullentry $i - set todo [linsert $todo $nullentry {}] - if {$level >= $i} { - incr level + if {$o ne {} && [incr col] < [llength $idlist]} { + set y1 [expr {$row + 1}] + set offs2 [lindex $rowoffsets $y1] + set x1 -1 + foreach z $offs2 { + incr x1 + if {$z eq {} || $x1 + $z < $col} continue + lset rowoffsets $y1 [incrange $offs2 $x1 1] + break } + set idlist [linsert $idlist $col {}] + set tmp [linsert $offs $col {}] + incr col + set offs [incrange $tmp $col -1] } - } else { - set nullentry -1 } + lset rowidlist $row $idlist + lset rowoffsets $row $offs + set col 0 + } +} - foreach l $lines { - set i [lindex $l 0] - set dst [lindex $l 1] - set j [lsearch -exact $todo $dst] - if {$i == $j} { - if {[info exists oldstarty($i)]} { - set linestarty($i) $oldstarty($i) - } - continue - } - set xi [expr {$canvx0 + $i * $linespc}] - set xj [expr {$canvx0 + $j * $linespc}] - set coords {} - if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} { - lappend coords $xi $oldstarty($i) - } - lappend coords $xi $canvy - if {$j < $i - 1} { - lappend coords [expr $xj + $linespc] $canvy - } elseif {$j > $i + 1} { - lappend coords [expr $xj - $linespc] $canvy - } - lappend coords $xj $y2 - set t [$canv create line $coords -width 2 -fill $colormap($dst)] - $canv lower $t - if {![info exists linestarty($j)]} { - set linestarty($j) $y2 - } +proc xc {row col} { + global canvx0 linespc + return [expr {$canvx0 + $col * $linespc}] +} + +proc yc {row} { + global canvy0 linespc + return [expr {$canvy0 + $row * $linespc}] +} + +proc linewidth {id} { + global thickerline lthickness + + set wid $lthickness + if {[info exists thickerline] && $id eq $thickerline} { + set wid [expr {2 * $lthickness}] + } + return $wid +} + +proc drawlineseg {id i} { + global rowoffsets rowidlist idrowranges + global displayorder + global canv colormap linespc + + set startrow [lindex $idrowranges($id) [expr {2 * $i}]] + set row [lindex $idrowranges($id) [expr {2 * $i + 1}]] + if {$startrow == $row} return + assigncolor $id + set coords {} + set col [lsearch -exact [lindex $rowidlist $row] $id] + if {$col < 0} { + puts "oops: drawline: id $id not on row $row" + return + } + set lasto {} + set ns 0 + while {1} { + set o [lindex $rowoffsets $row $col] + if {$o eq {}} break + if {$o ne $lasto} { + # changing direction + set x [xc $row $col] + set y [yc $row] + lappend coords $x $y + set lasto $o } + incr col $o + incr row -1 } - set phase {} - if {$redisplaying} { - if {$stopped == 0 && [info exists selectedline]} { - selectline $selectedline + set x [xc $row $col] + set y [yc $row] + lappend coords $x $y + if {$i == 0} { + # draw the link to the first child as part of this line + incr row -1 + set child [lindex $displayorder $row] + set ccol [lsearch -exact [lindex $rowidlist $row] $child] + if {$ccol >= 0} { + set x [xc $row $ccol] + set y [yc $row] + if {$ccol < $col - 1} { + lappend coords [xc $row [expr {$col - 1}]] [yc $row] + } elseif {$ccol > $col + 1} { + lappend coords [xc $row [expr {$col + 1}]] [yc $row] + } + lappend coords $x $y } - if {$stopped == 1} { - set stopped 0 - after idle drawgraph - } else { - set redisplaying 0 + } + if {[llength $coords] < 4} return + set last [expr {[llength $idrowranges($id)] / 2 - 1}] + if {$i < $last} { + # This line has an arrow at the lower end: check if the arrow is + # on a diagonal segment, and if so, work around the Tk 8.4 + # refusal to draw arrows on diagonal lines. + set x0 [lindex $coords 0] + set x1 [lindex $coords 2] + if {$x0 != $x1} { + set y0 [lindex $coords 1] + set y1 [lindex $coords 3] + if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} { + # we have a nearby vertical segment, just trim off the diag bit + set coords [lrange $coords 2 end] + } else { + set slope [expr {($x0 - $x1) / ($y0 - $y1)}] + set xi [expr {$x0 - $slope * $linespc / 2}] + set yi [expr {$y0 - $linespc / 2}] + set coords [lreplace $coords 0 1 $xi $y0 $xi $yi] + } } } + set arrow [expr {2 * ($i > 0) + ($i < $last)}] + set arrow [lindex {none first last both} $arrow] + set t [$canv create line $coords -width [linewidth $id] \ + -fill $colormap($id) -tags lines.$id -arrow $arrow] + $canv lower $t + bindline $t $id } -proc findmatches {f} { - global findtype foundstring foundstrlen - if {$findtype == "Regexp"} { - set matches [regexp -indices -all -inline $foundstring $f] - } else { - if {$findtype == "IgnCase"} { - set str [string tolower $f] - } else { - set str $f +proc drawparentlinks {id row col olds} { + global rowidlist canv colormap idrowranges + + set row2 [expr {$row + 1}] + set x [xc $row $col] + set y [yc $row] + set y2 [yc $row2] + set ids [lindex $rowidlist $row2] + # rmx = right-most X coord used + set rmx 0 + foreach p $olds { + set i [lsearch -exact $ids $p] + if {$i < 0} { + puts "oops, parent $p of $id not in list" + continue } - set matches {} - set i 0 - while {[set j [string first $foundstring $str $i]] >= 0} { - lappend matches [list $j [expr $j+$foundstrlen-1]] - set i [expr $j + $foundstrlen] + set x2 [xc $row2 $i] + if {$x2 > $rmx} { + set rmx $x2 } - } + if {[info exists idrowranges($p)] && + $row2 == [lindex $idrowranges($p) 0] && + $row2 < [lindex $idrowranges($p) 1]} { + # drawlineseg will do this one for us + continue + } + assigncolor $p + # should handle duplicated parents here... + set coords [list $x $y] + if {$i < $col - 1} { + lappend coords [xc $row [expr {$i + 1}]] $y + } elseif {$i > $col + 1} { + lappend coords [xc $row [expr {$i - 1}]] $y + } + lappend coords $x2 $y2 + set t [$canv create line $coords -width [linewidth $p] \ + -fill $colormap($p) -tags lines.$p] + $canv lower $t + bindline $t $p + } + return $rmx +} + +proc drawlines {id} { + global colormap canv + global idrowranges idrangedrawn + global children iddrawn commitrow rowidlist + + $canv delete lines.$id + set nr [expr {[llength $idrowranges($id)] / 2}] + for {set i 0} {$i < $nr} {incr i} { + if {[info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + } + } + if {[info exists children($id)]} { + foreach child $children($id) { + if {[info exists iddrawn($child)]} { + set row $commitrow($child) + set col [lsearch -exact [lindex $rowidlist $row] $child] + if {$col >= 0} { + drawparentlinks $child $row $col [list $id] + } + } + } + } +} + +proc drawcmittext {id row col rmx} { + global linespc canv canv2 canv3 canvy0 + global commitlisted commitinfo rowidlist + global rowtextx idpos idtags idheads idotherrefs + global linehtag linentag linedtag + global mainfont namefont canvxmax + + set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] + set x [xc $row $col] + set y [yc $row] + set orad [expr {$linespc / 3}] + set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \ + [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \ + -fill $ofill -outline black -width 1] + $canv raise $t + $canv bind $t <1> {selcanvline {} %x %y} + set xt [xc $row [llength [lindex $rowidlist $row]]] + if {$xt < $rmx} { + set xt $rmx + } + set rowtextx($row) $xt + set idpos($id) [list $x $xt $y] + if {[info exists idtags($id)] || [info exists idheads($id)] + || [info exists idotherrefs($id)]} { + set xt [drawtags $id $x $xt $y] + } + set headline [lindex $commitinfo($id) 0] + set name [lindex $commitinfo($id) 1] + set date [lindex $commitinfo($id) 2] + set date [formatdate $date] + set linehtag($row) [$canv create text $xt $y -anchor w \ + -text $headline -font $mainfont ] + $canv bind $linehtag($row) "rowmenu %X %Y $id" + set linentag($row) [$canv2 create text 3 $y -anchor w \ + -text $name -font $namefont] + set linedtag($row) [$canv3 create text 3 $y -anchor w \ + -text $date -font $mainfont] + set xr [expr {$xt + [font measure $mainfont $headline]}] + if {$xr > $canvxmax} { + set canvxmax $xr + setcanvscroll + } +} + +proc drawcmitrow {row} { + global displayorder rowidlist + global idrowranges idrangedrawn iddrawn + global commitinfo commitlisted parents numcommits + + if {$row >= $numcommits} return + foreach id [lindex $rowidlist $row] { + if {![info exists idrowranges($id)]} continue + set i -1 + foreach {s e} $idrowranges($id) { + incr i + if {$row < $s} continue + if {$e eq {}} break + if {$row <= $e} { + if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} { + drawlineseg $id $i + set idrangedrawn($id,$i) 1 + } + break + } + } + } + + set id [lindex $displayorder $row] + if {[info exists iddrawn($id)]} return + set col [lsearch -exact [lindex $rowidlist $row] $id] + if {$col < 0} { + puts "oops, row $row id $id not in list" + return + } + if {![info exists commitinfo($id)]} { + getcommit $id + } + assigncolor $id + if {[info exists commitlisted($id)] && [info exists parents($id)] + && $parents($id) ne {}} { + set rmx [drawparentlinks $id $row $col $parents($id)] + } else { + set rmx 0 + } + drawcmittext $id $row $col $rmx + set iddrawn($id) 1 +} + +proc drawfrac {f0 f1} { + global numcommits canv + global linespc + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set y0 [expr {int($f0 * $ymax)}] + set row [expr {int(($y0 - 3) / $linespc) - 1}] + if {$row < 0} { + set row 0 + } + set y1 [expr {int($f1 * $ymax)}] + set endrow [expr {int(($y1 - 3) / $linespc) + 1}] + if {$endrow >= $numcommits} { + set endrow [expr {$numcommits - 1}] + } + for {} {$row <= $endrow} {incr row} { + drawcmitrow $row + } +} + +proc drawvisible {} { + global canv + eval drawfrac [$canv yview] +} + +proc clear_display {} { + global iddrawn idrangedrawn + + allcanvs delete all + catch {unset iddrawn} + catch {unset idrangedrawn} +} + +proc assigncolor {id} { + global colormap colors nextcolor + global parents nparents children nchildren + global cornercrossings crossings + + if {[info exists colormap($id)]} return + set ncolors [llength $colors] + if {$nchildren($id) == 1} { + set child [lindex $children($id) 0] + if {[info exists colormap($child)] + && $nparents($child) == 1} { + set colormap($id) $colormap($child) + return + } + } + set badcolors {} + if {[info exists cornercrossings($id)]} { + foreach x $cornercrossings($id) { + if {[info exists colormap($x)] + && [lsearch -exact $badcolors $colormap($x)] < 0} { + lappend badcolors $colormap($x) + } + } + if {[llength $badcolors] >= $ncolors} { + set badcolors {} + } + } + set origbad $badcolors + if {[llength $badcolors] < $ncolors - 1} { + if {[info exists crossings($id)]} { + foreach x $crossings($id) { + if {[info exists colormap($x)] + && [lsearch -exact $badcolors $colormap($x)] < 0} { + lappend badcolors $colormap($x) + } + } + if {[llength $badcolors] >= $ncolors} { + set badcolors $origbad + } + } + set origbad $badcolors + } + if {[llength $badcolors] < $ncolors - 1} { + foreach child $children($id) { + if {[info exists colormap($child)] + && [lsearch -exact $badcolors $colormap($child)] < 0} { + lappend badcolors $colormap($child) + } + if {[info exists parents($child)]} { + foreach p $parents($child) { + if {[info exists colormap($p)] + && [lsearch -exact $badcolors $colormap($p)] < 0} { + lappend badcolors $colormap($p) + } + } + } + } + if {[llength $badcolors] >= $ncolors} { + set badcolors $origbad + } + } + for {set i 0} {$i <= $ncolors} {incr i} { + set c [lindex $colors $nextcolor] + if {[incr nextcolor] >= $ncolors} { + set nextcolor 0 + } + if {[lsearch -exact $badcolors $c]} break + } + set colormap($id) $c +} + +proc bindline {t id} { + global canv + + $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 1" +} + +proc drawtags {id x xt y1} { + global idtags idheads idotherrefs + global linespc lthickness + global canv mainfont commitrow rowtextx + + set marks {} + set ntags 0 + set nheads 0 + if {[info exists idtags($id)]} { + set marks $idtags($id) + set ntags [llength $marks] + } + if {[info exists idheads($id)]} { + set marks [concat $marks $idheads($id)] + set nheads [llength $idheads($id)] + } + if {[info exists idotherrefs($id)]} { + set marks [concat $marks $idotherrefs($id)] + } + if {$marks eq {}} { + return $xt + } + + set delta [expr {int(0.5 * ($linespc - $lthickness))}] + set yt [expr {$y1 - 0.5 * $linespc}] + set yb [expr {$yt + $linespc - 1}] + set xvals {} + set wvals {} + foreach tag $marks { + set wid [font measure $mainfont $tag] + lappend xvals $xt + lappend wvals $wid + set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] + } + set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ + -width $lthickness -fill black -tags tag.$id] + $canv lower $t + foreach tag $marks x $xvals wid $wvals { + set xl [expr {$x + $delta}] + set xr [expr {$x + $delta + $wid + $lthickness}] + if {[incr ntags -1] >= 0} { + # draw a tag + set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \ + $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \ + -width 1 -outline black -fill yellow -tags tag.$id] + $canv bind $t <1> [list showtag $tag 1] + set rowtextx($commitrow($id)) [expr {$xr + $linespc}] + } else { + # draw a head or other ref + if {[incr nheads -1] >= 0} { + set col green + } else { + set col "#ddddff" + } + set xl [expr {$xl - $delta/2}] + $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ + -width 1 -outline black -fill $col -tags tag.$id + } + set t [$canv create text $xl $y1 -anchor w -text $tag \ + -font $mainfont -tags tag.$id] + if {$ntags >= 0} { + $canv bind $t <1> [list showtag $tag 1] + } + } + return $xt +} + +proc checkcrossings {row endrow} { + global displayorder parents rowidlist + + for {} {$row < $endrow} {incr row} { + set id [lindex $displayorder $row] + set i [lsearch -exact [lindex $rowidlist $row] $id] + if {$i < 0} continue + set idlist [lindex $rowidlist [expr {$row+1}]] + foreach p $parents($id) { + set j [lsearch -exact $idlist $p] + if {$j > 0} { + if {$j < $i - 1} { + notecrossings $row $p $j $i [expr {$j+1}] + } elseif {$j > $i + 1} { + notecrossings $row $p $i $j [expr {$j-1}] + } + } + } + } +} + +proc notecrossings {row id lo hi corner} { + global rowidlist crossings cornercrossings + + for {set i $lo} {[incr i] < $hi} {} { + set p [lindex [lindex $rowidlist $row] $i] + if {$p == {}} continue + if {$i == $corner} { + if {![info exists cornercrossings($id)] + || [lsearch -exact $cornercrossings($id) $p] < 0} { + lappend cornercrossings($id) $p + } + if {![info exists cornercrossings($p)] + || [lsearch -exact $cornercrossings($p) $id] < 0} { + lappend cornercrossings($p) $id + } + } else { + if {![info exists crossings($id)] + || [lsearch -exact $crossings($id) $p] < 0} { + lappend crossings($id) $p + } + if {![info exists crossings($p)] + || [lsearch -exact $crossings($p) $id] < 0} { + lappend crossings($p) $id + } + } + } +} + +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 finishcommits {} { + global commitidx phase + global canv mainfont ctext maincursor textcursor + global findinprogress + + if {$commitidx > 0} { + drawrest + } else { + $canv delete all + $canv create text 3 3 -anchor nw -text "No commits selected" \ + -font $mainfont -tags textitems + } + if {![info exists findinprogress]} { + . config -cursor $maincursor + settextcursor $textcursor + } + set phase {} +} + +# 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 drawrest {} { + global numcommits + global startmsecs + global canvy0 numcommits linespc + global rowlaidout commitidx + + set row $rowlaidout + layoutrows $rowlaidout $commitidx 1 + layouttail + optimize_rows $row 0 $commitidx + showstuff $commitidx + + set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] + #puts "overall $drawmsecs ms for $numcommits commits" +} + +proc findmatches {f} { + global findtype foundstring foundstrlen + if {$findtype == "Regexp"} { + set matches [regexp -indices -all -inline $foundstring $f] + } else { + if {$findtype == "IgnCase"} { + set str [string tolower $f] + } else { + set str $f + } + set matches {} + set i 0 + while {[set j [string first $foundstring $str $i]] >= 0} { + lappend matches [list $j [expr {$j+$foundstrlen-1}]] + set i [expr {$j + $foundstrlen}] + } + } return $matches } proc dofind {} { global findtype findloc findstring markedmatches commitinfo - global numcommits lineid linehtag linentag linedtag + global numcommits displayorder linehtag linentag linedtag global mainfont namefont canv canv2 canv3 selectedline - global matchinglines foundstring foundstrlen + global matchinglines foundstring foundstrlen matchstring + global commitdata + + stopfindproc unmarkmatches focus . set matchinglines {} - set fldtypes {Headline Author Date Committer CDate Comment} + if {$findloc == "Pickaxe"} { + findpatches + return + } if {$findtype == "IgnCase"} { set foundstring [string tolower $findstring] } else { @@ -751,14 +1805,34 @@ proc dofind {} { } set foundstrlen [string length $findstring] if {$foundstrlen == 0} return + regsub -all {[*?\[\\]} $foundstring {\\&} matchstring + set matchstring "*$matchstring*" + if {$findloc == "Files"} { + findfiles + return + } if {![info exists selectedline]} { set oldsel -1 } else { set oldsel $selectedline } set didsel 0 - for {set l 0} {$l < $numcommits} {incr l} { - set id $lineid($l) + set fldtypes {Headline Author Date Committer CDate Comment} + set l -1 + foreach id $displayorder { + set d $commitdata($id) + incr l + if {$findtype == "Regexp"} { + set doesmatch [regexp $foundstring $d] + } elseif {$findtype == "IgnCase"} { + set doesmatch [string match -nocase $matchstring $d] + } else { + set doesmatch [string match $matchstring $d] + } + if {!$doesmatch} continue + if {![info exists commitinfo($id)]} { + getcommit $id + } set info $commitinfo($id) set doesmatch 0 foreach f $info ty $fldtypes { @@ -769,10 +1843,13 @@ proc dofind {} { if {$matches == {}} continue set doesmatch 1 if {$ty == "Headline"} { + drawcmitrow $l markmatches $canv $l $f $linehtag($l) $matches $mainfont } elseif {$ty == "Author"} { + drawcmitrow $l markmatches $canv2 $l $f $linentag($l) $matches $namefont } elseif {$ty == "Date"} { + drawcmitrow $l markmatches $canv3 $l $f $linedtag($l) $matches $mainfont } } @@ -793,23 +1870,25 @@ 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] set matches [findmatches $f] foreach match $matches { set start [lindex $match 0] - set end [expr [lindex $match 1] + 1] + set end [expr {[lindex $match 1] + 1}] $ctext tag add found "1.0 + $start c" "1.0 + $end c" } } } -proc findnext {} { +proc findnext {restart} { global matchinglines selectedline if {![info exists matchinglines]} { - dofind + if {$restart} { + dofind + } return } if {![info exists selectedline]} return @@ -841,6 +1920,295 @@ proc findprev {} { } } +proc findlocchange {name ix op} { + global findloc findtype findtypemenu + if {$findloc == "Pickaxe"} { + set findtype Exact + set state disabled + } else { + set state normal + } + $findtypemenu entryconf 1 -state $state + $findtypemenu entryconf 2 -state $state +} + +proc stopfindproc {{done 0}} { + global findprocpid findprocfile findids + global ctext findoldcursor phase maincursor textcursor + global findinprogress + + catch {unset findids} + if {[info exists findprocpid]} { + if {!$done} { + catch {exec kill $findprocpid} + } + catch {close $findprocfile} + unset findprocpid + } + if {[info exists findinprogress]} { + unset findinprogress + if {$phase != "incrdraw"} { + . config -cursor $maincursor + settextcursor $textcursor + } + } +} + +proc findpatches {} { + global findstring selectedline numcommits + global findprocpid findprocfile + global finddidsel ctext displayorder findinprogress + global findinsertpos + + if {$numcommits == 0} return + + # make a list of all the ids to search, starting at the one + # after the selected line (if any) + if {[info exists selectedline]} { + set l $selectedline + } else { + set l -1 + } + set inputids {} + for {set i 0} {$i < $numcommits} {incr i} { + if {[incr l] >= $numcommits} { + set l 0 + } + append inputids [lindex $displayorder $l] "\n" + } + + if {[catch { + set f [open [list | git-diff-tree --stdin -s -r -S$findstring \ + << $inputids] r] + } err]} { + error_popup "Error starting search process: $err" + return + } + + set findinsertpos end + set findprocfile $f + set findprocpid [pid $f] + fconfigure $f -blocking 0 + fileevent $f readable readfindproc + set finddidsel 0 + . config -cursor watch + settextcursor watch + set findinprogress 1 +} + +proc readfindproc {} { + global findprocfile finddidsel + global commitrow matchinglines findinsertpos + + set n [gets $findprocfile line] + if {$n < 0} { + if {[eof $findprocfile]} { + stopfindproc 1 + if {!$finddidsel} { + bell + } + } + return + } + if {![regexp {^[0-9a-f]{40}} $line id]} { + error_popup "Can't parse git-diff-tree output: $line" + stopfindproc + return + } + if {![info exists commitrow($id)]} { + puts stderr "spurious id: $id" + return + } + set l $commitrow($id) + insertmatch $l $id +} + +proc insertmatch {l id} { + global matchinglines findinsertpos finddidsel + + if {$findinsertpos == "end"} { + if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { + set matchinglines [linsert $matchinglines 0 $l] + set findinsertpos 1 + } else { + lappend matchinglines $l + } + } else { + set matchinglines [linsert $matchinglines $findinsertpos $l] + incr findinsertpos + } + markheadline $l $id + if {!$finddidsel} { + findselectline $l + set finddidsel 1 + } +} + +proc findfiles {} { + global selectedline numcommits displayorder ctext + global ffileline finddidsel parents nparents + global findinprogress findstartline findinsertpos + global treediffs fdiffid fdiffsneeded fdiffpos + global findmergefiles + + if {$numcommits == 0} return + + if {[info exists selectedline]} { + set l [expr {$selectedline + 1}] + } else { + set l 0 + } + set ffileline $l + set findstartline $l + set diffsneeded {} + set fdiffsneeded {} + while 1 { + set id [lindex $displayorder $l] + if {$findmergefiles || $nparents($id) == 1} { + if {![info exists treediffs($id)]} { + append diffsneeded "$id\n" + lappend fdiffsneeded $id + } + } + if {[incr l] >= $numcommits} { + set l 0 + } + if {$l == $findstartline} break + } + + # start off a git-diff-tree process if needed + if {$diffsneeded ne {}} { + if {[catch { + set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r] + } err ]} { + error_popup "Error starting search process: $err" + return + } + catch {unset fdiffid} + set fdiffpos 0 + fconfigure $df -blocking 0 + fileevent $df readable [list readfilediffs $df] + } + + set finddidsel 0 + set findinsertpos end + set id [lindex $displayorder $l] + . config -cursor watch + settextcursor watch + set findinprogress 1 + findcont $id + update +} + +proc readfilediffs {df} { + global findid fdiffid fdiffs + + set n [gets $df line] + if {$n < 0} { + if {[eof $df]} { + donefilediff + if {[catch {close $df} err]} { + stopfindproc + bell + error_popup "Error in git-diff-tree: $err" + } elseif {[info exists findid]} { + set id $findid + stopfindproc + bell + error_popup "Couldn't find diffs for $id" + } + } + return + } + if {[regexp {^([0-9a-f]{40})$} $line match id]} { + # start of a new string of diffs + donefilediff + set fdiffid $id + set fdiffs {} + } elseif {[string match ":*" $line]} { + lappend fdiffs [lindex $line 5] + } +} + +proc donefilediff {} { + global fdiffid fdiffs treediffs findid + global fdiffsneeded fdiffpos + + if {[info exists fdiffid]} { + while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid + && $fdiffpos < [llength $fdiffsneeded]} { + # git-diff-tree doesn't output anything for a commit + # which doesn't change anything + set nullid [lindex $fdiffsneeded $fdiffpos] + set treediffs($nullid) {} + if {[info exists findid] && $nullid eq $findid} { + unset findid + findcont $nullid + } + incr fdiffpos + } + incr fdiffpos + + if {![info exists treediffs($fdiffid)]} { + set treediffs($fdiffid) $fdiffs + } + if {[info exists findid] && $fdiffid eq $findid} { + unset findid + findcont $fdiffid + } + } +} + +proc findcont {id} { + global findid treediffs parents nparents + global ffileline findstartline finddidsel + global displayorder numcommits matchinglines findinprogress + global findmergefiles + + set l $ffileline + while 1 { + if {$findmergefiles || $nparents($id) == 1} { + if {![info exists treediffs($id)]} { + set findid $id + set ffileline $l + return + } + set doesmatch 0 + foreach f $treediffs($id) { + set x [findmatches $f] + if {$x != {}} { + set doesmatch 1 + break + } + } + if {$doesmatch} { + insertmatch $l $id + } + } + if {[incr l] >= $numcommits} { + set l 0 + } + if {$l == $findstartline} break + set id [lindex $displayorder $l] + } + stopfindproc + if {!$finddidsel} { + bell + } +} + +# mark a commit as matching by putting a yellow background +# behind the headline +proc markheadline {l id} { + global canv mainfont linehtag + + drawcmitrow $l + set bbox [$canv bbox $linehtag($l)] + set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] + $canv lower $t +} + +# mark the bits of a headline, author or date that match a find string proc markmatches {canv l str tag matches font} { set bbox [$canv bbox $tag] set x0 [lindex $bbox 0] @@ -850,42 +2218,122 @@ proc markmatches {canv l str tag matches font} { set start [lindex $match 0] set end [lindex $match 1] if {$start > $end} continue - set xoff [font measure $font [string range $str 0 [expr $start-1]]] - set xlen [font measure $font [string range $str 0 [expr $end]]] - set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ + set xoff [font measure $font [string range $str 0 [expr {$start-1}]]] + set xlen [font measure $font [string range $str 0 [expr {$end}]]] + set t [$canv create rect [expr {$x0+$xoff}] $y0 \ + [expr {$x0+$xlen+2}] $y1 \ -outline {} -tags matches -fill yellow] $canv lower $t } } proc unmarkmatches {} { - global matchinglines + global matchinglines findids allcanvs delete matches catch {unset matchinglines} + catch {unset findids} } -proc selcanvline {x y} { - global canv canvy0 ctext linespc selectedline - global lineid linehtag linentag linedtag +proc selcanvline {w x y} { + global canv canvy0 ctext linespc + global rowtextx set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax == {}} return set yfrac [lindex [$canv yview] 0] set y [expr {$y + $yfrac * $ymax}] set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] if {$l < 0} { set l 0 } - if {[info exists selectedline] && $selectedline == $l} return + if {$w eq $canv} { + 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)" +} + +# append some text to the ctext widget, and make any SHA1 ID +# that we know about be a clickable link. +proc appendwithlinks {text} { + global ctext commitrow linknum + + set start [$ctext index "end - 1c"] + $ctext insert end $text + $ctext insert end "\n" + set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] + foreach l $links { + set s [lindex $l 0] + set e [lindex $l 1] + set linkid [string range $text $s $e] + if {![info exists commitrow($linkid)]} continue + incr e + $ctext tag add link "$start + $s c" "$start + $e c" + $ctext tag add link$linknum "$start + $s c" "$start + $e c" + $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1] + incr linknum + } + $ctext tag conf link -foreground blue -underline 1 + $ctext tag bind link { %W configure -cursor hand2 } + $ctext tag bind link { %W configure -cursor $curtextcursor } +} + +proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline - global lineid linehtag linentag linedtag - global canvy canvy0 linespc nparents treepending - global cflist treediffs currentid sha1entry - global commentend - if {![info exists lineid($l)] || ![info exists linehtag($l)]} return + global displayorder linehtag linentag linedtag + global canvy0 linespc parents nparents children + global cflist currentid sha1entry + global commentend idtags linknum + global mergemax numcommits + + $canv delete hover + normalline + if {$l < 0 || $l >= $numcommits} return + set y [expr {$canvy0 + $l * $linespc}] + set ymax [lindex [$canv cget -scrollregion] 3] + set ytop [expr {$y - $linespc - 1}] + set ybot [expr {$y + $linespc + 1}] + set wnow [$canv yview] + set wtop [expr {[lindex $wnow 0] * $ymax}] + set wbot [expr {[lindex $wnow 1] * $ymax}] + set wh [expr {$wbot - $wtop}] + set newtop $wtop + if {$ytop < $wtop} { + if {$ybot < $wtop} { + set newtop [expr {$y - $wh / 2.0}] + } else { + set newtop $ytop + if {$newtop > $wtop - $linespc} { + set newtop [expr {$wtop - $linespc}] + } + } + } elseif {$ybot > $wbot} { + if {$ytop > $wbot} { + set newtop [expr {$y - $wh / 2.0}] + } else { + set newtop [expr {$ybot - $wh}] + if {$newtop < $wtop + $linespc} { + set newtop [expr {$wtop + $linespc}] + } + } + } + if {$newtop != $wtop} { + if {$newtop < 0} { + set newtop 0 + } + allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] + drawvisible + } + + if {![info exists linehtag($l)]} return $canv delete secsel set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ -tags secsel -fill [$canv cget -selectbackground]] @@ -898,157 +2346,389 @@ proc selectline {l} { set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ -tags secsel -fill [$canv3 cget -selectbackground]] $canv3 lower $t - set y [expr {$canvy0 + $l * $linespc}] - set ytop [expr {($y - $linespc / 2.0) / $canvy}] - set ybot [expr {($y + $linespc / 2.0) / $canvy}] - set wnow [$canv yview] - if {$ytop < [lindex $wnow 0]} { - allcanvs yview moveto $ytop - } elseif {$ybot > [lindex $wnow 1]} { - set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}] - allcanvs yview moveto [expr {$ybot - $wh}] + + if {$isnew} { + addtohistory [list selectline $l 0] } + set selectedline $l - set id $lineid($l) - $sha1entry conf -state normal + set id [lindex $displayorder $l] + set currentid $id $sha1entry delete 0 end $sha1entry insert 0 $id $sha1entry selection from 0 $sha1entry selection to end - $sha1entry conf -state readonly $ctext conf -state normal $ctext delete 0.0 end + set linknum 0 + $ctext mark set fmark.0 0.0 + $ctext mark gravity fmark.0 left set info $commitinfo($id) - $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" - $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" - $ctext insert end "\n" - $ctext insert end [lindex $info 5] - $ctext insert end "\n" + set date [formatdate [lindex $info 2]] + $ctext insert end "Author: [lindex $info 1] $date\n" + set date [formatdate [lindex $info 4]] + $ctext insert end "Committer: [lindex $info 3] $date\n" + if {[info exists idtags($id)]} { + $ctext insert end "Tags:" + foreach tag $idtags($id) { + $ctext insert end " $tag" + } + $ctext insert end "\n" + } + + set comment {} + if {$nparents($id) > 1} { + set np 0 + foreach p $parents($id) { + if {$np >= $mergemax} { + set tag mmax + } else { + set tag m$np + } + $ctext insert end "Parent: " $tag + appendwithlinks [commit_descriptor $p] + incr np + } + } else { + if {[info exists parents($id)]} { + foreach p $parents($id) { + append comment "Parent: [commit_descriptor $p]\n" + } + } + } + + if {[info exists children($id)]} { + foreach c $children($id) { + append comment "Child: [commit_descriptor $c]\n" + } + } + append comment "\n" + append comment [lindex $info 5] + + # make anything that looks like a SHA1 ID be a clickable link + appendwithlinks $comment + $ctext tag delete Comments $ctext tag remove found 1.0 end $ctext conf -state disabled set commentend [$ctext index "end - 1c"] $cflist delete 0 end - set currentid $id - if {$nparents($id) == 1} { - if {![info exists treediffs($id)]} { - if {![info exists treepending]} { - gettreediffs $id - } - } else { - addtocflist $id - } + $cflist insert end "Comments" + if {$nparents($id) <= 1} { + startdiff $id + } else { + mergediff $id } } proc selnextline {dir} { global selectedline if {![info exists selectedline]} return - set l [expr $selectedline + $dir] + 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} { + global parents diffmergeid diffopts mdifffd + global difffilestart diffids + + set diffmergeid $id + set diffids $id + catch {unset difffilestart} + # this doesn't seem to actually affect anything... + set env(GIT_DIFF_OPTS) $diffopts + set cmd [concat | git-diff-tree --no-commit-id --cc $id] + if {[catch {set mdf [open $cmd r]} err]} { + error_popup "Error getting merge diffs: $err" + return + } + fconfigure $mdf -blocking 0 + set mdifffd($id) $mdf + fileevent $mdf readable [list getmergediffline $mdf $id] + set nextupdate [expr {[clock clicks -milliseconds] + 100}] +} + +proc getmergediffline {mdf id} { + global diffmergeid ctext cflist nextupdate nparents mergemax + global difffilestart mdifffd + + set n [gets $mdf line] + if {$n < 0} { + if {[eof $mdf]} { + close $mdf + } + return + } + if {![info exists diffmergeid] || $id != $diffmergeid + || $mdf != $mdifffd($id)} { + return + } + $ctext conf -state normal + if {[regexp {^diff --cc (.*)} $line match fname]} { + # start of a new file + $ctext insert end "\n" + set here [$ctext index "end - 1c"] + set i [$cflist index end] + $ctext mark set fmark.$i $here + $ctext mark gravity fmark.$i left + set difffilestart([expr {$i-1}]) $here + $cflist insert end $fname + set l [expr {(78 - [string length $fname]) / 2}] + set pad [string range "----------------------------------------" 1 $l] + $ctext insert end "$pad $fname $pad\n" filesep + } elseif {[regexp {^@@} $line]} { + $ctext insert end "$line\n" hunksep + } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { + # do nothing + } else { + # parse the prefix - one ' ', '-' or '+' for each parent + set np $nparents($id) + set spaces {} + set minuses {} + set pluses {} + set isbad 0 + for {set j 0} {$j < $np} {incr j} { + set c [string range $line $j $j] + if {$c == " "} { + lappend spaces $j + } elseif {$c == "-"} { + lappend minuses $j + } elseif {$c == "+"} { + lappend pluses $j + } else { + set isbad 1 + break + } + } + set tags {} + set num {} + if {!$isbad && $minuses ne {} && $pluses eq {}} { + # line doesn't appear in result, parents in $minuses have the line + set num [lindex $minuses 0] + } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { + # line appears in result, parents in $pluses don't have the line + lappend tags mresult + set num [lindex $spaces 0] + } + if {$num ne {}} { + if {$num >= $mergemax} { + set num "max" + } + lappend tags m$num + } + $ctext insert end "$line\n" $tags + } + $ctext conf -state disabled + if {[clock clicks -milliseconds] >= $nextupdate} { + incr nextupdate 100 + fileevent $mdf readable {} + update + fileevent $mdf readable [list getmergediffline $mdf $id] + } } -proc addtocflist {id} { - global currentid treediffs cflist treepending - if {$id != $currentid} { - gettreediffs $currentid - return +proc startdiff {ids} { + global treediffs diffids treepending diffmergeid + + set diffids $ids + catch {unset diffmergeid} + if {![info exists treediffs($ids)]} { + if {![info exists treepending]} { + gettreediffs $ids + } + } else { + addtocflist $ids } - $cflist insert end "All files" - foreach f $treediffs($currentid) { +} + +proc addtocflist {ids} { + global treediffs cflist + foreach f $treediffs($ids) { $cflist insert end $f } - getblobdiffs $id + getblobdiffs $ids } -proc gettreediffs {id} { - global treediffs parents treepending - set treepending $id - set treediffs($id) {} - set p [lindex $parents($id) 0] - if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return +proc gettreediffs {ids} { + global treediff parents treepending + set treepending $ids + set treediff {} + if {[catch \ + {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \ + ]} return fconfigure $gdtf -blocking 0 - fileevent $gdtf readable "gettreediffline $gdtf $id" + fileevent $gdtf readable [list gettreediffline $gdtf $ids] } -proc gettreediffline {gdtf id} { - global treediffs treepending +proc gettreediffline {gdtf ids} { + 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 - addtocflist $id + if {$ids != $diffids} { + if {![info exists diffmergeid]} { + gettreediffs $diffids + } + } else { + addtocflist $ids + } return } - set type [lindex $line 1] - set file [lindex $line 3] - if {$type == "blob"} { - lappend treediffs($id) $file - } + set file [lindex $line 5] + lappend treediff $file } -proc getblobdiffs {id} { - global parents diffopts blobdifffd env curdifftag curtagstart - set p [lindex $parents($id) 0] +proc getblobdiffs {ids} { + global diffopts blobdifffd diffids env curdifftag curtagstart + global difffilestart nextupdate diffinhdr treediffs + set env(GIT_DIFF_OPTS) $diffopts - if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] { + set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids] + if {[catch {set bdf [open $cmd r]} err]} { puts "error getting diffs: $err" return } + set diffinhdr 0 fconfigure $bdf -blocking 0 - set blobdifffd($id) $bdf + set blobdifffd($ids) $bdf set curdifftag Comments set curtagstart 0.0 - fileevent $bdf readable "getblobdiffline $bdf $id" + catch {unset difffilestart} + fileevent $bdf readable [list getblobdiffline $bdf $diffids] + set nextupdate [expr {[clock clicks -milliseconds] + 100}] } -proc getblobdiffline {bdf id} { - global currentid blobdifffd ctext curdifftag curtagstart +proc getblobdiffline {bdf ids} { + global diffids blobdifffd ctext curdifftag curtagstart + global diffnexthead diffnextnote difffilestart + global nextupdate diffinhdr treediffs + set n [gets $bdf line] if {$n < 0} { if {[eof $bdf]} { close $bdf - if {$id == $currentid && $bdf == $blobdifffd($id)} { + if {$ids == $diffids && $bdf == $blobdifffd($ids)} { $ctext tag add $curdifftag $curtagstart end } } return } - if {$id != $currentid || $bdf != $blobdifffd($id)} { + 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 curtagstart [$ctext index "end - 1c"] + set header $newname + set here [$ctext index "end - 1c"] + 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 $fname]) / 2}] + set l [expr {(78 - [string length $header]) / 2}] set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $fname $pad\n" filesep - } elseif {[string range $line 0 2] == "+++"} { - # no need to do anything with this + $ctext insert end "$pad $header $pad\n" filesep + set diffinhdr 1 + } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} { + # do nothing + } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} { + 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 + $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] $ctext insert end "$line\n" d$tag } elseif {$x == " "} { - set line [string range $line 1 end] $ctext insert end "$line\n" + } elseif {$diffinhdr || $x == "\\"} { + # e.g. "\ No newline at end of file" + $ctext insert end "$line\n" filesep } else { # Something else we don't recognize if {$curdifftag != "Comments"} { @@ -1061,53 +2741,71 @@ proc getblobdiffline {bdf id} { } } $ctext conf -state disabled + if {[clock clicks -milliseconds] >= $nextupdate} { + incr nextupdate 100 + fileevent $bdf readable {} + update + fileevent $bdf readable "getblobdiffline $bdf {$ids}" + } } -proc listboxsel {} { - global ctext cflist currentid treediffs - if {![info exists currentid]} return - set sel [$cflist curselection] - if {$sel == {} || [lsearch -exact $sel 0] >= 0} { - # show everything - $ctext tag conf Comments -elide 0 - foreach f $treediffs($currentid) { - $ctext tag conf "f:$f" -elide 0 - } - } else { - # just show selected files - $ctext tag conf Comments -elide 1 - set i 1 - foreach f $treediffs($currentid) { - set elide [expr {[lsearch -exact $sel $i] < 0}] - $ctext tag conf "f:$f" -elide $elide - incr i +proc nextfile {} { + global difffilestart ctext + set here [$ctext index @0,0] + for {set i 0} {[info exists difffilestart($i)]} {incr i} { + if {[$ctext compare $difffilestart($i) > $here]} { + 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 + if {![info exists currentid]} return + set sel [lsort [$cflist curselection]] + if {$sel eq {}} return + set first [lindex $sel 0] + catch {$ctext yview fmark.$first} } proc setcoords {} { global linespc charspc canvx0 canvy0 mainfont + global xspc1 xspc2 lthickness + 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 canvy0 [expr {int(3 + 0.5 * $linespc)}] + set canvx0 [expr {int(3 + 0.5 * $linespc)}] + set lthickness [expr {int($linespc / 9) + 1}] + set xspc1(0) $linespc + set xspc2 $linespc } proc redisplay {} { - global selectedline stopped redisplaying phase - if {$stopped > 1} return - if {$phase == "getcommits"} return - set redisplaying 1 - if {$phase == "drawgraph"} { - set stopped 1 - } else { - drawgraph + global canv + global selectedline + + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax == 0} return + set span [$canv yview] + clear_display + setcanvscroll + allcanvs yview moveto [lindex $span 0] + drawvisible + if {[info exists selectedline]} { + selectline $selectedline 0 } } proc incrfont {inc} { - global mainfont namefont textfont selectedline ctext canv phase - global stopped + global mainfont namefont textfont ctext canv phase + global stopped entries unmarkmatches set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] @@ -1115,55 +2813,1014 @@ proc incrfont {inc} { setcoords $ctext conf -font $textfont $ctext tag conf filesep -font [concat $textfont bold] + foreach e $entries { + $e conf -font $mainfont + } if {$phase == "getcommits"} { $canv itemconf textitems -font $mainfont } redisplay } +proc clearsha1 {} { + global sha1entry sha1string + if {[string length $sha1string] == 40} { + $sha1entry delete 0 end + } +} + +proc sha1change {n1 n2 op} { + global sha1string currentid sha1but + if {$sha1string == {} + || ([info exists currentid] && $sha1string == $currentid)} { + set state disabled + } else { + set state normal + } + if {[$sha1but cget -state] == $state} return + if {$state == "normal"} { + $sha1but conf -state normal -relief raised -text "Goto: " + } else { + $sha1but conf -state disabled -relief flat -text "SHA1 ID: " + } +} + +proc gotocommit {} { + global sha1string currentid commitrow tagids + global displayorder 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 {} + foreach i $displayorder { + if {[string match $id* $i]} { + lappend matches $i + } + } + if {$matches ne {}} { + if {[llength $matches] > 1} { + error_popup "Short SHA1 id $id is ambiguous" + return + } + set id [lindex $matches 0] + } + } + } + if {[info exists commitrow($id)]} { + selectline $commitrow($id) 1 + return + } + if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { + set type "SHA1 id" + } else { + set type "Tag" + } + error_popup "$type $sha1string is not known" +} + +proc lineenter {x y id} { + global hoverx hovery hoverid hovertimer + global commitinfo canv + + if {![info exists commitinfo($id)] && ![getcommit $id]} return + set hoverx $x + set hovery $y + set hoverid $id + if {[info exists hovertimer]} { + after cancel $hovertimer + } + set hovertimer [after 500 linehover] + $canv delete hover +} + +proc linemotion {x y id} { + global hoverx hovery hoverid hovertimer + + if {[info exists hoverid] && $id == $hoverid} { + set hoverx $x + set hovery $y + if {[info exists hovertimer]} { + after cancel $hovertimer + } + set hovertimer [after 500 linehover] + } +} + +proc lineleave {id} { + global hoverid hovertimer canv + + if {[info exists hoverid] && $id == $hoverid} { + $canv delete hover + if {[info exists hovertimer]} { + after cancel $hovertimer + unset hovertimer + } + unset hoverid + } +} + +proc linehover {} { + global hoverx hovery hoverid hovertimer + global canv linespc lthickness + global commitinfo mainfont + + set text [lindex $commitinfo($hoverid) 0] + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax == {}} return + set yfrac [lindex [$canv yview] 0] + set x [expr {$hoverx + 2 * $linespc}] + set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] + set x0 [expr {$x - 2 * $lthickness}] + set y0 [expr {$y - 2 * $lthickness}] + set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] + set y1 [expr {$y + $linespc + 2 * $lthickness}] + set t [$canv create rectangle $x0 $y0 $x1 $y1 \ + -fill \#ffff80 -outline black -width 1 -tags hover] + $canv raise $t + set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont] + $canv raise $t +} + +proc clickisonarrow {id y} { + global lthickness idrowranges + + set thresh [expr {2 * $lthickness + 6}] + set n [expr {[llength $idrowranges($id)] - 1}] + for {set i 1} {$i < $n} {incr i} { + set row [lindex $idrowranges($id) $i] + if {abs([yc $row] - $y) < $thresh} { + return $i + } + } + return {} +} + +proc arrowjump {id n y} { + global idrowranges canv + + # 1 <-> 2, 3 <-> 4, etc... + set n [expr {(($n - 1) ^ 1) + 1}] + set row [lindex $idrowranges($id) $n] + set yt [yc $row] + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {} || $ymax <= 0} return + set view [$canv yview] + set yspan [expr {[lindex $view 1] - [lindex $view 0]}] + set yfrac [expr {$yt / $ymax - $yspan / 2}] + if {$yfrac < 0} { + set yfrac 0 + } + allcanvs yview moveto $yfrac +} + +proc lineclick {x y id isnew} { + global ctext commitinfo children cflist canv thickerline + + if {![info exists commitinfo($id)] && ![getcommit $id]} return + unmarkmatches + unselectline + normalline + $canv delete hover + # draw this line thicker than normal + set thickerline $id + drawlines $id + if {$isnew} { + set ymax [lindex [$canv cget -scrollregion] 3] + if {$ymax eq {}} return + set yfrac [lindex [$canv yview] 0] + set y [expr {$y + $yfrac * $ymax}] + } + set dirn [clickisonarrow $id $y] + if {$dirn ne {}} { + arrowjump $id $dirn $y + return + } + + if {$isnew} { + addtohistory [list lineclick $x $y $id 0] + } + # fill the details pane with info about this line + $ctext conf -state normal + $ctext delete 0.0 end + $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 "\n\t[lindex $info 0]\n" + $ctext insert end "\tAuthor:\t[lindex $info 1]\n" + set date [formatdate [lindex $info 2]] + $ctext insert end "\tDate:\t$date\n" + if {[info exists children($id)]} { + $ctext insert end "\nChildren:" + set i 0 + foreach child $children($id) { + incr i + if {![info exists commitinfo($child)] && ![getcommit $child]} continue + set info $commitinfo($child) + $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]" + set date [formatdate [lindex $info 2]] + $ctext insert end "\n\tDate:\t$date\n" + } + } + $ctext conf -state disabled + + $cflist delete 0 end +} + +proc normalline {} { + global thickerline + if {[info exists thickerline]} { + set id $thickerline + unset thickerline + drawlines $id + } +} + +proc selbyid {id} { + global commitrow + if {[info exists commitrow($id)]} { + selectline $commitrow($id) 1 + } +} + +proc mstime {} { + global startmstime + if {![info exists startmstime]} { + set startmstime [clock clicks -milliseconds] + } + return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] +} + +proc rowmenu {x y id} { + global rowctxmenu commitrow selectedline rowmenuid + + if {![info exists selectedline] || $commitrow($id) eq $selectedline} { + set state disabled + } else { + set state normal + } + $rowctxmenu entryconfigure 0 -state $state + $rowctxmenu entryconfigure 1 -state $state + $rowctxmenu entryconfigure 2 -state $state + set rowmenuid $id + tk_popup $rowctxmenu $x $y +} + +proc diffvssel {dirn} { + global rowmenuid selectedline displayorder + + if {![info exists selectedline]} return + if {$dirn} { + set oldid [lindex $displayorder $selectedline] + set newid $rowmenuid + } else { + set oldid $rowmenuid + set newid [lindex $displayorder $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 " + $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 " + $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 [list $oldid $newid] +} + +proc mkpatch {} { + global rowmenuid currentid commitinfo patchtop patchnum + + if {![info exists currentid]} return + set oldid $currentid + set oldhead [lindex $commitinfo($oldid) 0] + set newid $rowmenuid + set newhead [lindex $commitinfo($newid) 0] + set top .patch + set patchtop $top + catch {destroy $top} + toplevel $top + label $top.title -text "Generate patch" + grid $top.title - -pady 10 + label $top.from -text "From:" + entry $top.fromsha1 -width 40 -relief flat + $top.fromsha1 insert 0 $oldid + $top.fromsha1 conf -state readonly + grid $top.from $top.fromsha1 -sticky w + entry $top.fromhead -width 60 -relief flat + $top.fromhead insert 0 $oldhead + $top.fromhead conf -state readonly + grid x $top.fromhead -sticky w + label $top.to -text "To:" + entry $top.tosha1 -width 40 -relief flat + $top.tosha1 insert 0 $newid + $top.tosha1 conf -state readonly + grid $top.to $top.tosha1 -sticky w + entry $top.tohead -width 60 -relief flat + $top.tohead insert 0 $newhead + $top.tohead conf -state readonly + grid x $top.tohead -sticky w + button $top.rev -text "Reverse" -command mkpatchrev -padx 5 + grid $top.rev x -pady 10 + label $top.flab -text "Output file:" + entry $top.fname -width 60 + $top.fname insert 0 [file normalize "patch$patchnum.patch"] + incr patchnum + grid $top.flab $top.fname -sticky w + frame $top.buts + button $top.buts.gen -text "Generate" -command mkpatchgo + button $top.buts.can -text "Cancel" -command mkpatchcan + grid $top.buts.gen $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - -pady 10 -sticky ew + focus $top.fname +} + +proc mkpatchrev {} { + global patchtop + + set oldid [$patchtop.fromsha1 get] + set oldhead [$patchtop.fromhead get] + set newid [$patchtop.tosha1 get] + set newhead [$patchtop.tohead get] + foreach e [list fromsha1 fromhead tosha1 tohead] \ + v [list $newid $newhead $oldid $oldhead] { + $patchtop.$e conf -state normal + $patchtop.$e delete 0 end + $patchtop.$e insert 0 $v + $patchtop.$e conf -state readonly + } +} + +proc mkpatchgo {} { + global patchtop + + set oldid [$patchtop.fromsha1 get] + set newid [$patchtop.tosha1 get] + set fname [$patchtop.fname get] + if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} { + error_popup "Error creating patch: $err" + } + catch {destroy $patchtop} + unset patchtop +} + +proc mkpatchcan {} { + global patchtop + + catch {destroy $patchtop} + unset patchtop +} + +proc mktag {} { + global rowmenuid mktagtop commitinfo + + set top .maketag + set mktagtop $top + catch {destroy $top} + toplevel $top + label $top.title -text "Create tag" + grid $top.title - -pady 10 + label $top.id -text "ID:" + entry $top.sha1 -width 40 -relief flat + $top.sha1 insert 0 $rowmenuid + $top.sha1 conf -state readonly + grid $top.id $top.sha1 -sticky w + entry $top.head -width 60 -relief flat + $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] + $top.head conf -state readonly + grid x $top.head -sticky w + label $top.tlab -text "Tag name:" + entry $top.tag -width 60 + grid $top.tlab $top.tag -sticky w + frame $top.buts + button $top.buts.gen -text "Create" -command mktaggo + button $top.buts.can -text "Cancel" -command mktagcan + grid $top.buts.gen $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - -pady 10 -sticky ew + focus $top.tag +} + +proc domktag {} { + global mktagtop env tagids idtags + + set id [$mktagtop.sha1 get] + set tag [$mktagtop.tag get] + if {$tag == {}} { + error_popup "No tag name specified" + return + } + if {[info exists tagids($tag)]} { + error_popup "Tag \"$tag\" already exists" + return + } + if {[catch { + set dir [gitdir] + set fname [file join $dir "refs/tags" $tag] + set f [open $fname w] + puts $f $id + close $f + } err]} { + error_popup "Error creating tag: $err" + return + } + + set tagids($tag) $id + lappend idtags($id) $tag + redrawtags $id +} + +proc redrawtags {id} { + global canv linehtag commitrow idpos selectedline + + if {![info exists commitrow($id)]} return + drawcmitrow $commitrow($id) + $canv delete tag.$id + set xt [eval drawtags $id $idpos($id)] + $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2] + if {[info exists selectedline] && $selectedline == $commitrow($id)} { + selectline $selectedline 0 + } +} + +proc mktagcan {} { + global mktagtop + + catch {destroy $mktagtop} + unset mktagtop +} + +proc mktaggo {} { + domktag + mktagcan +} + +proc writecommit {} { + global rowmenuid wrcomtop commitinfo wrcomcmd + + set top .writecommit + set wrcomtop $top + catch {destroy $top} + toplevel $top + label $top.title -text "Write commit to file" + grid $top.title - -pady 10 + label $top.id -text "ID:" + entry $top.sha1 -width 40 -relief flat + $top.sha1 insert 0 $rowmenuid + $top.sha1 conf -state readonly + grid $top.id $top.sha1 -sticky w + entry $top.head -width 60 -relief flat + $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] + $top.head conf -state readonly + grid x $top.head -sticky w + label $top.clab -text "Command:" + entry $top.cmd -width 60 -textvariable wrcomcmd + grid $top.clab $top.cmd -sticky w -pady 10 + label $top.flab -text "Output file:" + entry $top.fname -width 60 + $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] + grid $top.flab $top.fname -sticky w + frame $top.buts + button $top.buts.gen -text "Write" -command wrcomgo + button $top.buts.can -text "Cancel" -command wrcomcan + grid $top.buts.gen $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - -pady 10 -sticky ew + focus $top.fname +} + +proc wrcomgo {} { + global wrcomtop + + set id [$wrcomtop.sha1 get] + set cmd "echo $id | [$wrcomtop.cmd get]" + set fname [$wrcomtop.fname get] + if {[catch {exec sh -c $cmd >$fname &} err]} { + error_popup "Error writing commit: $err" + } + catch {destroy $wrcomtop} + unset wrcomtop +} + +proc wrcomcan {} { + global wrcomtop + + catch {destroy $wrcomtop} + unset wrcomtop +} + +proc listrefs {id} { + global idtags idheads idotherrefs + + set x {} + if {[info exists idtags($id)]} { + set x $idtags($id) + } + set y {} + if {[info exists idheads($id)]} { + set y $idheads($id) + } + set z {} + if {[info exists idotherrefs($id)]} { + set z $idotherrefs($id) + } + return [list $x $y $z] +} + +proc rereadrefs {} { + global idtags idheads idotherrefs + global tagids headids otherrefids + + set refids [concat [array names idtags] \ + [array names idheads] [array names idotherrefs]] + foreach id $refids { + if {![info exists ref($id)]} { + set ref($id) [listrefs $id] + } + } + readrefs + set refids [lsort -unique [concat $refids [array names idtags] \ + [array names idheads] [array names idotherrefs]]] + foreach id $refids { + set v [listrefs $id] + if {![info exists ref($id)] || $ref($id) != $v} { + redrawtags $id + } + } +} + +proc showtag {tag isnew} { + global ctext cflist tagcontents tagids linknum + + if {$isnew} { + addtohistory [list showtag $tag 0] + } + $ctext conf -state normal + $ctext delete 0.0 end + set linknum 0 + if {[info exists tagcontents($tag)]} { + set text $tagcontents($tag) + } else { + set text "Tag: $tag\nId: $tagids($tag)" + } + appendwithlinks $text + $ctext conf -state disabled + $cflist delete 0 end +} + proc doquit {} { global stopped set stopped 100 destroy . } +proc doprefs {} { + global maxwidth maxgraphpct diffopts findmergefiles + global oldprefs prefstop + + set top .gitkprefs + set prefstop $top + if {[winfo exists $top]} { + raise $top + return + } + foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + set oldprefs($v) [set $v] + } + toplevel $top + wm title $top "Gitk preferences" + label $top.ldisp -text "Commit list display options" + grid $top.ldisp - -sticky w -pady 10 + label $top.spacer -text " " + label $top.maxwidthl -text "Maximum graph width (lines)" \ + -font optionfont + spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth + grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w + label $top.maxpctl -text "Maximum graph width (% of pane)" \ + -font optionfont + spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct + grid x $top.maxpctl $top.maxpct -sticky w + checkbutton $top.findm -variable findmergefiles + label $top.findml -text "Include merges for \"Find\" in \"Files\"" \ + -font optionfont + grid $top.findm $top.findml - -sticky w + label $top.ddisp -text "Diff display options" + grid $top.ddisp - -sticky w -pady 10 + label $top.diffoptl -text "Options for diff program" \ + -font optionfont + entry $top.diffopt -width 20 -textvariable diffopts + grid x $top.diffoptl $top.diffopt -sticky w + frame $top.buts + button $top.buts.ok -text "OK" -command prefsok + button $top.buts.can -text "Cancel" -command prefscan + grid $top.buts.ok $top.buts.can + grid columnconfigure $top.buts 0 -weight 1 -uniform a + grid columnconfigure $top.buts 1 -weight 1 -uniform a + grid $top.buts - - -pady 10 -sticky ew +} + +proc prefscan {} { + global maxwidth maxgraphpct diffopts findmergefiles + global oldprefs prefstop + + foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + set $v $oldprefs($v) + } + catch {destroy $prefstop} + unset prefstop +} + +proc prefsok {} { + global maxwidth maxgraphpct + global oldprefs prefstop + + catch {destroy $prefstop} + unset prefstop + if {$maxwidth != $oldprefs(maxwidth) + || $maxgraphpct != $oldprefs(maxgraphpct)} { + redisplay + } +} + +proc formatdate {d} { + return [clock format $d -format "%Y-%m-%d %H:%M:%S"] +} + +# This list of encoding names and aliases is distilled from +# http://www.iana.org/assignments/character-sets. +# Not all of them are supported by Tcl. +set encoding_aliases { + { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII + ISO646-US US-ASCII us IBM367 cp367 csASCII } + { ISO-10646-UTF-1 csISO10646UTF1 } + { ISO_646.basic:1983 ref csISO646basic1983 } + { INVARIANT csINVARIANT } + { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion } + { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom } + { NATS-SEFI iso-ir-8-1 csNATSSEFI } + { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD } + { NATS-DANO iso-ir-9-1 csNATSDANO } + { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD } + { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish } + { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames } + { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 } + { ISO-2022-KR csISO2022KR } + { EUC-KR csEUCKR } + { ISO-2022-JP csISO2022JP } + { ISO-2022-JP-2 csISO2022JP2 } + { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7 + csISO13JISC6220jp } + { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro } + { IT iso-ir-15 ISO646-IT csISO15Italian } + { PT iso-ir-16 ISO646-PT csISO16Portuguese } + { ES iso-ir-17 ISO646-ES csISO17Spanish } + { greek7-old iso-ir-18 csISO18Greek7Old } + { latin-greek iso-ir-19 csISO19LatinGreek } + { DIN_66003 iso-ir-21 de ISO646-DE csISO21German } + { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French } + { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 } + { ISO_5427 iso-ir-37 csISO5427Cyrillic } + { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 } + { BS_viewdata iso-ir-47 csISO47BSViewdata } + { INIS iso-ir-49 csISO49INIS } + { INIS-8 iso-ir-50 csISO50INIS8 } + { INIS-cyrillic iso-ir-51 csISO51INISCyrillic } + { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 } + { ISO_5428:1980 iso-ir-55 csISO5428Greek } + { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 } + { GB_2312-80 iso-ir-58 chinese csISO58GB231280 } + { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian + csISO60Norwegian1 } + { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 } + { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French } + { videotex-suppl iso-ir-70 csISO70VideotexSupp1 } + { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 } + { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 } + { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian } + { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 } + { greek7 iso-ir-88 csISO88Greek7 } + { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 } + { iso-ir-90 csISO90 } + { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a } + { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b + csISO92JISC62991984b } + { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd } + { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand } + { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add + csISO95JIS62291984handadd } + { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana } + { ISO_2033-1983 iso-ir-98 e13b csISO2033 } + { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS } + { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819 + CP819 csISOLatin1 } + { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 } + { T.61-7bit iso-ir-102 csISO102T617bit } + { T.61-8bit T.61 iso-ir-103 csISO103T618bit } + { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 } + { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 } + { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic } + { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 } + { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 } + { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr } + { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708 + arabic csISOLatinArabic } + { ISO_8859-6-E csISO88596E ISO-8859-6-E } + { ISO_8859-6-I csISO88596I ISO-8859-6-I } + { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118 + greek greek8 csISOLatinGreek } + { T.101-G2 iso-ir-128 csISO128T101G2 } + { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew + csISOLatinHebrew } + { ISO_8859-8-E csISO88598E ISO-8859-8-E } + { ISO_8859-8-I csISO88598I ISO-8859-8-I } + { CSN_369103 iso-ir-139 csISO139CSN369103 } + { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 } + { ISO_6937-2-add iso-ir-142 csISOTextComm } + { IEC_P27-1 iso-ir-143 csISO143IECP271 } + { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic + csISOLatinCyrillic } + { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian } + { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian } + { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 } + { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT } + { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba } + { ISO_6937-2-25 iso-ir-152 csISO6937Add } + { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 } + { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp } + { ISO_10367-box iso-ir-155 csISO10367Box } + { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 } + { latin-lap lap iso-ir-158 csISO158Lap } + { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 } + { DS_2089 DS2089 ISO646-DK dk csISO646Danish } + { us-dk csUSDK } + { dk-us csDKUS } + { JIS_X0201 X0201 csHalfWidthKatakana } + { KSC5636 ISO646-KR csKSC5636 } + { ISO-10646-UCS-2 csUnicode } + { ISO-10646-UCS-4 csUCS4 } + { DEC-MCS dec csDECMCS } + { hp-roman8 roman8 r8 csHPRoman8 } + { macintosh mac csMacintosh } + { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl + csIBM037 } + { IBM038 EBCDIC-INT cp038 csIBM038 } + { IBM273 CP273 csIBM273 } + { IBM274 EBCDIC-BE CP274 csIBM274 } + { IBM275 EBCDIC-BR cp275 csIBM275 } + { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 } + { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 } + { IBM280 CP280 ebcdic-cp-it csIBM280 } + { IBM281 EBCDIC-JP-E cp281 csIBM281 } + { IBM284 CP284 ebcdic-cp-es csIBM284 } + { IBM285 CP285 ebcdic-cp-gb csIBM285 } + { IBM290 cp290 EBCDIC-JP-kana csIBM290 } + { IBM297 cp297 ebcdic-cp-fr csIBM297 } + { IBM420 cp420 ebcdic-cp-ar1 csIBM420 } + { IBM423 cp423 ebcdic-cp-gr csIBM423 } + { IBM424 cp424 ebcdic-cp-he csIBM424 } + { IBM437 cp437 437 csPC8CodePage437 } + { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 } + { IBM775 cp775 csPC775Baltic } + { IBM850 cp850 850 csPC850Multilingual } + { IBM851 cp851 851 csIBM851 } + { IBM852 cp852 852 csPCp852 } + { IBM855 cp855 855 csIBM855 } + { IBM857 cp857 857 csIBM857 } + { IBM860 cp860 860 csIBM860 } + { IBM861 cp861 861 cp-is csIBM861 } + { IBM862 cp862 862 csPC862LatinHebrew } + { IBM863 cp863 863 csIBM863 } + { IBM864 cp864 csIBM864 } + { IBM865 cp865 865 csIBM865 } + { IBM866 cp866 866 csIBM866 } + { IBM868 CP868 cp-ar csIBM868 } + { IBM869 cp869 869 cp-gr csIBM869 } + { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 } + { IBM871 CP871 ebcdic-cp-is csIBM871 } + { IBM880 cp880 EBCDIC-Cyrillic csIBM880 } + { IBM891 cp891 csIBM891 } + { IBM903 cp903 csIBM903 } + { IBM904 cp904 904 csIBBM904 } + { IBM905 CP905 ebcdic-cp-tr csIBM905 } + { IBM918 CP918 ebcdic-cp-ar2 csIBM918 } + { IBM1026 CP1026 csIBM1026 } + { EBCDIC-AT-DE csIBMEBCDICATDE } + { EBCDIC-AT-DE-A csEBCDICATDEA } + { EBCDIC-CA-FR csEBCDICCAFR } + { EBCDIC-DK-NO csEBCDICDKNO } + { EBCDIC-DK-NO-A csEBCDICDKNOA } + { EBCDIC-FI-SE csEBCDICFISE } + { EBCDIC-FI-SE-A csEBCDICFISEA } + { EBCDIC-FR csEBCDICFR } + { EBCDIC-IT csEBCDICIT } + { EBCDIC-PT csEBCDICPT } + { EBCDIC-ES csEBCDICES } + { EBCDIC-ES-A csEBCDICESA } + { EBCDIC-ES-S csEBCDICESS } + { EBCDIC-UK csEBCDICUK } + { EBCDIC-US csEBCDICUS } + { UNKNOWN-8BIT csUnknown8BiT } + { MNEMONIC csMnemonic } + { MNEM csMnem } + { VISCII csVISCII } + { VIQR csVIQR } + { KOI8-R csKOI8R } + { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro } + { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro } + { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro } + { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro } + { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro } + { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro } + { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro } + { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro } + { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro } + { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro } + { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro } + { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro } + { IBM1047 IBM-1047 } + { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian } + { Amiga-1251 Ami1251 Amiga1251 Ami-1251 } + { UNICODE-1-1 csUnicode11 } + { CESU-8 csCESU-8 } + { BOCU-1 csBOCU-1 } + { UNICODE-1-1-UTF-7 csUnicode11UTF7 } + { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic + l8 } + { ISO-8859-15 ISO_8859-15 Latin-9 } + { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 } + { GBK CP936 MS936 windows-936 } + { JIS_Encoding csJISEncoding } + { Shift_JIS MS_Kanji csShiftJIS } + { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese + EUC-JP } + { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese } + { ISO-10646-UCS-Basic csUnicodeASCII } + { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 } + { ISO-Unicode-IBM-1261 csUnicodeIBM1261 } + { ISO-Unicode-IBM-1268 csUnicodeIBM1268 } + { ISO-Unicode-IBM-1276 csUnicodeIBM1276 } + { ISO-Unicode-IBM-1264 csUnicodeIBM1264 } + { ISO-Unicode-IBM-1265 csUnicodeIBM1265 } + { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 } + { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 } + { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 } + { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 } + { Adobe-Standard-Encoding csAdobeStandardEncoding } + { Ventura-US csVenturaUS } + { Ventura-International csVenturaInternational } + { PC8-Danish-Norwegian csPC8DanishNorwegian } + { PC8-Turkish csPC8Turkish } + { IBM-Symbols csIBMSymbols } + { IBM-Thai csIBMThai } + { HP-Legal csHPLegal } + { HP-Pi-font csHPPiFont } + { HP-Math8 csHPMath8 } + { Adobe-Symbol-Encoding csHPPSMath } + { HP-DeskTop csHPDesktop } + { Ventura-Math csVenturaMath } + { Microsoft-Publishing csMicrosoftPublishing } + { Windows-31J csWindows31J } + { GB2312 csGB2312 } + { Big5 csBig5 } +} + +proc tcl_encoding {enc} { + global encoding_aliases + set names [encoding names] + set lcnames [string tolower $names] + set enc [string tolower $enc] + set i [lsearch -exact $lcnames $enc] + if {$i < 0} { + # look for "isonnn" instead of "iso-nnn" or "iso_nnn" + if {[regsub {^iso[-_]} $enc iso encx]} { + set i [lsearch -exact $lcnames $encx] + } + } + if {$i < 0} { + foreach l $encoding_aliases { + set ll [string tolower $l] + if {[lsearch -exact $ll $enc] < 0} continue + # look through the aliases for one that tcl knows about + foreach e $ll { + set i [lsearch -exact $lcnames $e] + if {$i < 0} { + if {[regsub {^iso[-_]} $e iso ex]} { + set i [lsearch -exact $lcnames $ex] + } + } + if {$i >= 0} break + } + break + } + } + if {$i >= 0} { + return [lindex $names $i] + } + return {} +} + # defaults... set datemode 0 -set boldnames 0 set diffopts "-U 5 -p" +set wrcomcmd "git-diff-tree --stdin -p --pretty" + +set gitencoding {} +catch { + set gitencoding [exec git-repo-config --get i18n.commitencoding] +} +if {$gitencoding == ""} { + set gitencoding "utf-8" +} +set tclencoding [tcl_encoding $gitencoding] +if {$tclencoding == {}} { + puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk" +} set mainfont {Helvetica 9} -set namefont $mainfont set textfont {Courier 9} -if {$boldnames} { - lappend namefont bold -} +set findmergefiles 0 +set maxgraphpct 50 +set maxwidth 16 +set revlistorder 0 +set fastdate 0 +set uparrowlen 7 +set downarrowlen 7 +set mingaplen 30 set colors {green red blue magenta darkgrey brown orange} -set colorbycommitter false catch {source ~/.gitk} +set namefont $mainfont + +font create optionfont -family sans-serif -size -12 + set revtreeargs {} foreach arg $argv { switch -regexp -- $arg { "^$" { } - "^-b" { set boldnames 1 } - "^-c" { set colorbycommitter 1 } "^-d" { set datemode 1 } - "^-.*" { - puts stderr "unrecognized option $arg" - exit 1 - } default { lappend revtreeargs $arg } } } +# check that we can find a .git directory somewhere... +set gitdir [gitdir] +if {![file isdirectory $gitdir]} { + error_popup "Cannot find the git directory \"$gitdir\"." + exit 1 +} + +set history {} +set historyindex 0 + +set optim_delay 16 + set stopped 0 -set redisplaying 0 set stuffsaved 0 +set patchnum 0 setcoords -makewindow +makewindow $revtreeargs +readrefs getcommits $revtreeargs