X-Git-Url: https://git.octo.it/?p=git.git;a=blobdiff_plain;f=gitk;h=ba4644f450215682d7465ada26878d626f72fa00;hp=317d90d954010102ea0b4eee45da2cca8e3832cd;hb=HEAD;hpb=5864c08f897425ff186fcab00ecc81166e783bd5 diff --git a/gitk b/gitk index 317d90d9..ba4644f4 100755 --- a/gitk +++ b/gitk @@ -34,10 +34,10 @@ proc start_rev_list {view} { set order "--date-order" } if {[catch { - set fd [open [concat | git-rev-list --header $order \ + set fd [open [concat | git rev-list --header $order \ --parents --boundary --default HEAD $args] r] } err]} { - puts stderr "Error executing git-rev-list: $err" + puts stderr "Error executing git rev-list: $err" exit 1 } set commfd($view) $fd @@ -94,10 +94,10 @@ proc getcommitlines {fd view} { } if {[string range $err 0 4] == "usage"} { set err "Gitk: error reading commits$fv:\ - bad arguments to git-rev-list." + bad arguments to git rev-list." if {$viewname($view) eq "Command line"} { append err \ - " (Note: arguments to gitk are passed to git-rev-list\ + " (Note: arguments to gitk are passed to git rev-list\ to allow selection of commits to be displayed.)" } } else { @@ -148,7 +148,7 @@ proc getcommitlines {fd view} { if {[string length $shortcmit] > 80} { set shortcmit "[string range $shortcmit 0 80]..." } - error_popup "Can't parse git-rev-list output: {$shortcmit}" + error_popup "Can't parse git rev-list output: {$shortcmit}" exit 1 } set id [lindex $ids 0] @@ -217,7 +217,7 @@ proc doupdate {} { } proc readcommit {id} { - if {[catch {set contents [exec git-cat-file commit $id]}]} return + if {[catch {set contents [exec git cat-file commit $id]}]} return parsecommit $id $contents 0 } @@ -238,6 +238,7 @@ proc updatecommits {} { catch {unset selectedline} catch {unset thickerline} catch {unset viewdata($n)} + discardallcommits readrefs showview $n } @@ -278,8 +279,8 @@ proc parsecommit {id contents listed} { 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 + # 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 " " @@ -339,14 +340,14 @@ proc readrefs {} { set type {} set tag {} catch { - set commit [exec git-rev-parse "$id^0"] + 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"] + set tagcontents($name) [exec git cat-file tag "$id"] } } elseif { $type == "heads" } { set headids($name) $id @@ -359,21 +360,21 @@ proc readrefs {} { close $refd } -proc show_error {w msg} { +proc show_error {w top msg} { message $w.m -text $msg -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 - button $w.ok -text OK -command "destroy $w" + button $w.ok -text OK -command "destroy $top" pack $w.ok -side bottom -fill x - bind $w "grab $w; focus $w" - bind $w "destroy $w" - tkwait window $w + bind $top "grab $top; focus $top" + bind $top "destroy $top" + tkwait window $top } proc error_popup msg { set w .error toplevel $w wm transient $w . - show_error $w $msg + show_error $w $w $msg } proc makewindow {} { @@ -382,7 +383,7 @@ proc makewindow {} { global findtype findtypemenu findloc findstring fstring geometry global entries sha1entry sha1string sha1but global maincursor textcursor curtextcursor - global rowctxmenu mergemax + global rowctxmenu mergemax wrapcomment global highlight_files gdttype global searchstring sstring @@ -538,6 +539,15 @@ proc makewindow {} { $viewhlmenu conf -font $uifont .ctop.top.lbar.vhl conf -font $uifont pack .ctop.top.lbar.vhl -side left -fill y + label .ctop.top.lbar.rlabel -text " OR " -font $uifont + pack .ctop.top.lbar.rlabel -side left -fill y + global highlight_related + set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \ + "Descendent" "Not descendent" "Ancestor" "Not ancestor"] + $m conf -font $uifont + .ctop.top.lbar.relm conf -font $uifont + trace add variable highlight_related write vrel_change + pack .ctop.top.lbar.relm -side left -fill y panedwindow .ctop.cdet -orient horizontal .ctop add .ctop.cdet @@ -561,6 +571,7 @@ proc makewindow {} { pack $ctext -side left -fill both -expand 1 .ctop.cdet add .ctop.cdet.left + $ctext tag conf comment -wrap $wrapcomment $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" $ctext tag conf hunksep -fore blue $ctext tag conf d0 -fore red @@ -623,6 +634,8 @@ proc makewindow {} { bindkey sellastline bind . "selnextline -1" bind . "selnextline 1" + bind . "next_highlight -1" + bind . "next_highlight 1" bindkey "goforw" bindkey "goback" bind . "selnextpage -1" @@ -731,9 +744,9 @@ proc click {w} { proc savestuff {w} { global canv canv2 canv3 ctext cflist mainfont textfont uifont global stuffsaved findmergefiles maxgraphpct - global maxwidth + global maxwidth showneartags global viewname viewfiles viewargs viewperm nextviewnum - global cmitmode + global cmitmode wrapcomment if {$stuffsaved} return if {![winfo viewable .]} return @@ -746,6 +759,8 @@ proc savestuff {w} { puts $f [list set maxgraphpct $maxgraphpct] puts $f [list set maxwidth $maxwidth] puts $f [list set cmitmode $cmitmode] + puts $f [list set wrapcomment $wrapcomment] + puts $f [list set showneartags $showneartags] 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}]" @@ -883,6 +898,8 @@ Gitk key bindings: Scroll commit list down one line Scroll commit list up one page Scroll commit list down one page + Move to previous highlighted line + Move to next highlighted line , b Scroll diff view up one page Scroll diff view up one page Scroll diff view down one page @@ -890,11 +907,12 @@ u Scroll diff view up 18 lines d Scroll diff view down 18 lines Find Move to next find hit - Move to previous find hit Move to next find hit / Move to next find hit, or redo find ? Move to previous find hit f Scroll diff view to next file + Search for next hit in diff view + Search for previous hit in diff view Increase font size Increase font size Decrease font size @@ -1374,7 +1392,7 @@ proc vieweditor {top n title} { checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) grid $top.perm - -pady 5 -sticky w message $top.al -aspect 1000 -font $uifont \ - -text "Commits to include (arguments to git-rev-list):" + -text "Commits to include (arguments to git rev-list):" grid $top.al - -sticky w -pady 5 entry $top.args -width 50 -textvariable newviewargs($n) \ -background white @@ -1642,7 +1660,7 @@ proc showview {n} { # Stuff relating to the highlighting facility proc ishighlighted {row} { - global vhighlights fhighlights nhighlights + global vhighlights fhighlights nhighlights rhighlights if {[info exists nhighlights($row)] && $nhighlights($row) > 0} { return $nhighlights($row) @@ -1653,12 +1671,16 @@ proc ishighlighted {row} { if {[info exists fhighlights($row)] && $fhighlights($row) > 0} { return $fhighlights($row) } + if {[info exists rhighlights($row)] && $rhighlights($row) > 0} { + return $rhighlights($row) + } return 0 } proc bolden {row font} { - global canv linehtag selectedline + global canv linehtag selectedline boldrows + lappend boldrows $row $canv itemconf $linehtag($row) -font $font if {[info exists selectedline] && $row == $selectedline} { $canv delete secsel @@ -1670,8 +1692,9 @@ proc bolden {row font} { } proc bolden_name {row font} { - global canv2 linentag selectedline + global canv2 linentag selectedline boldnamerows + lappend boldnamerows $row $canv2 itemconf $linentag($row) -font $font if {[info exists selectedline] && $row == $selectedline} { $canv2 delete secsel @@ -1682,14 +1705,18 @@ proc bolden_name {row font} { } } -proc unbolden {rows} { - global mainfont +proc unbolden {} { + global mainfont boldrows - foreach row $rows { + set stillbold {} + foreach row $boldrows { if {![ishighlighted $row]} { bolden $row $mainfont + } else { + lappend stillbold $row } } + set boldrows $stillbold } proc addvhighlight {n} { @@ -1718,11 +1745,8 @@ proc delvhighlight {} { if {![info exists hlview]} return unset hlview - set rows [array names vhighlights] - if {$rows ne {}} { - unset vhighlights - unbolden $rows - } + catch {unset vhighlights} + unbolden } proc vhighlightmore {} { @@ -1775,11 +1799,8 @@ proc hfiles_change {name ix op} { # delete previous highlights catch {close $filehighlight} unset filehighlight - set rows [array names fhighlights] - if {$rows ne {}} { - unset fhighlights - unbolden $rows - } + catch {unset fhighlights} + unbolden unhighlight_filelist } set highlight_paths {} @@ -1805,7 +1826,7 @@ proc makepatterns {l} { } proc do_file_hl {serial} { - global highlight_files filehighlight highlight_paths gdttype + global highlight_files filehighlight highlight_paths gdttype fhl_list if {$gdttype eq "touching paths:"} { if {[catch {set paths [shellsplit $highlight_files]}]} return @@ -1819,64 +1840,72 @@ proc do_file_hl {serial} { set filehighlight [open $cmd r+] fconfigure $filehighlight -blocking 0 fileevent $filehighlight readable readfhighlight + set fhl_list {} drawvisible flushhighlights } proc flushhighlights {} { - global filehighlight + global filehighlight fhl_list if {[info exists filehighlight]} { + lappend fhl_list {} puts $filehighlight "" flush $filehighlight } } proc askfilehighlight {row id} { - global filehighlight fhighlights + global filehighlight fhighlights fhl_list - set fhighlights($row) 0 + lappend fhl_list $id + set fhighlights($row) -1 puts $filehighlight $id } proc readfhighlight {} { global filehighlight fhighlights commitrow curview mainfont iddrawn - - set n [gets $filehighlight line] - if {$n < 0} { - if {[eof $filehighlight]} { - # strange... - puts "oops, git-diff-tree died" - catch {close $filehighlight} - unset filehighlight + global fhl_list + + while {[gets $filehighlight line] >= 0} { + set line [string trim $line] + set i [lsearch -exact $fhl_list $line] + if {$i < 0} continue + for {set j 0} {$j < $i} {incr j} { + set id [lindex $fhl_list $j] + if {[info exists commitrow($curview,$id)]} { + set fhighlights($commitrow($curview,$id)) 0 + } } - return + set fhl_list [lrange $fhl_list [expr {$i+1}] end] + if {$line eq {}} continue + if {![info exists commitrow($curview,$line)]} continue + set row $commitrow($curview,$line) + if {[info exists iddrawn($line)] && ![ishighlighted $row]} { + bolden $row [concat $mainfont bold] + } + set fhighlights($row) 1 } - set line [string trim $line] - if {$line eq {}} return - if {![info exists commitrow($curview,$line)]} return - set row $commitrow($curview,$line) - if {[info exists iddrawn($line)] && ![ishighlighted $row]} { - bolden $row [concat $mainfont bold] + if {[eof $filehighlight]} { + # strange... + puts "oops, git-diff-tree died" + catch {close $filehighlight} + unset filehighlight } - set fhighlights($row) 1 + next_hlcont } proc find_change {name ix op} { - global nhighlights mainfont + global nhighlights mainfont boldnamerows global findstring findpattern findtype # delete previous highlights, if any - set rows [array names nhighlights] - if {$rows ne {}} { - foreach row $rows { - if {$nhighlights($row) >= 2} { - bolden_name $row $mainfont - } - } - unset nhighlights - unbolden $rows + foreach row $boldnamerows { + bolden_name $row $mainfont } + set boldnamerows {} + catch {unset nhighlights} + unbolden if {$findtype ne "Regexp"} { set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ $findstring] @@ -1925,6 +1954,207 @@ proc askfindhighlight {row id} { set nhighlights($row) $isbold } +proc vrel_change {name ix op} { + global highlight_related + + rhighlight_none + if {$highlight_related ne "None"} { + after idle drawvisible + } +} + +# prepare for testing whether commits are descendents or ancestors of a +proc rhighlight_sel {a} { + global descendent desc_todo ancestor anc_todo + global highlight_related rhighlights + + catch {unset descendent} + set desc_todo [list $a] + catch {unset ancestor} + set anc_todo [list $a] + if {$highlight_related ne "None"} { + rhighlight_none + after idle drawvisible + } +} + +proc rhighlight_none {} { + global rhighlights + + catch {unset rhighlights} + unbolden +} + +proc is_descendent {a} { + global curview children commitrow descendent desc_todo + + set v $curview + set la $commitrow($v,$a) + set todo $desc_todo + set leftover {} + set done 0 + for {set i 0} {$i < [llength $todo]} {incr i} { + set do [lindex $todo $i] + if {$commitrow($v,$do) < $la} { + lappend leftover $do + continue + } + foreach nk $children($v,$do) { + if {![info exists descendent($nk)]} { + set descendent($nk) 1 + lappend todo $nk + if {$nk eq $a} { + set done 1 + } + } + } + if {$done} { + set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]] + return + } + } + set descendent($a) 0 + set desc_todo $leftover +} + +proc is_ancestor {a} { + global curview parentlist commitrow ancestor anc_todo + + set v $curview + set la $commitrow($v,$a) + set todo $anc_todo + set leftover {} + set done 0 + for {set i 0} {$i < [llength $todo]} {incr i} { + set do [lindex $todo $i] + if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} { + lappend leftover $do + continue + } + foreach np [lindex $parentlist $commitrow($v,$do)] { + if {![info exists ancestor($np)]} { + set ancestor($np) 1 + lappend todo $np + if {$np eq $a} { + set done 1 + } + } + } + if {$done} { + set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]] + return + } + } + set ancestor($a) 0 + set anc_todo $leftover +} + +proc askrelhighlight {row id} { + global descendent highlight_related iddrawn mainfont rhighlights + global selectedline ancestor + + if {![info exists selectedline]} return + set isbold 0 + if {$highlight_related eq "Descendent" || + $highlight_related eq "Not descendent"} { + if {![info exists descendent($id)]} { + is_descendent $id + } + if {$descendent($id) == ($highlight_related eq "Descendent")} { + set isbold 1 + } + } elseif {$highlight_related eq "Ancestor" || + $highlight_related eq "Not ancestor"} { + if {![info exists ancestor($id)]} { + is_ancestor $id + } + if {$ancestor($id) == ($highlight_related eq "Ancestor")} { + set isbold 1 + } + } + if {[info exists iddrawn($id)]} { + if {$isbold && ![ishighlighted $row]} { + bolden $row [concat $mainfont bold] + } + } + set rhighlights($row) $isbold +} + +proc next_hlcont {} { + global fhl_row fhl_dirn displayorder numcommits + global vhighlights fhighlights nhighlights rhighlights + global hlview filehighlight findstring highlight_related + + if {![info exists fhl_dirn] || $fhl_dirn == 0} return + set row $fhl_row + while {1} { + if {$row < 0 || $row >= $numcommits} { + bell + set fhl_dirn 0 + return + } + set id [lindex $displayorder $row] + if {[info exists hlview]} { + if {![info exists vhighlights($row)]} { + askvhighlight $row $id + } + if {$vhighlights($row) > 0} break + } + if {$findstring ne {}} { + if {![info exists nhighlights($row)]} { + askfindhighlight $row $id + } + if {$nhighlights($row) > 0} break + } + if {$highlight_related ne "None"} { + if {![info exists rhighlights($row)]} { + askrelhighlight $row $id + } + if {$rhighlights($row) > 0} break + } + if {[info exists filehighlight]} { + if {![info exists fhighlights($row)]} { + # ask for a few more while we're at it... + set r $row + for {set n 0} {$n < 100} {incr n} { + if {![info exists fhighlights($r)]} { + askfilehighlight $r [lindex $displayorder $r] + } + incr r $fhl_dirn + if {$r < 0 || $r >= $numcommits} break + } + flushhighlights + } + if {$fhighlights($row) < 0} { + set fhl_row $row + return + } + if {$fhighlights($row) > 0} break + } + incr row $fhl_dirn + } + set fhl_dirn 0 + selectline $row 1 +} + +proc next_highlight {dirn} { + global selectedline fhl_row fhl_dirn + global hlview filehighlight findstring highlight_related + + if {![info exists selectedline]} return + if {!([info exists hlview] || $findstring ne {} || + $highlight_related ne "None" || [info exists filehighlight])} return + set fhl_row [expr {$selectedline + $dirn}] + set fhl_dirn $dirn + next_hlcont +} + +proc cancel_next_highlight {} { + global fhl_dirn + + set fhl_dirn 0 +} + # Graph layout functions proc shortids {ids} { @@ -2644,7 +2874,7 @@ proc drawcmittext {id row col rmx} { global commitlisted commitinfo rowidlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag - global mainfont canvxmax + global mainfont canvxmax boldrows boldnamerows set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] set x [xc $row $col] @@ -2673,8 +2903,10 @@ proc drawcmittext {id row col rmx} { set nfont $mainfont set isbold [ishighlighted $row] if {$isbold > 0} { + lappend boldrows $row lappend font bold if {$isbold > 1} { + lappend boldnamerows $row lappend nfont bold } } @@ -2698,6 +2930,7 @@ proc drawcmitrow {row} { global commitinfo parentlist numcommits global filehighlight fhighlights findstring nhighlights global hlview vhighlights + global highlight_related rhighlights if {$row >= $numcommits} return foreach id [lindex $rowidlist $row] { @@ -2727,6 +2960,9 @@ proc drawcmitrow {row} { if {$findstring ne {} && ![info exists nhighlights($row)]} { askfindhighlight $row $id } + if {$highlight_related ne "None" && ![info exists rhighlights($row)]} { + askrelhighlight $row $id + } if {[info exists iddrawn($id)]} return set col [lsearch -exact [lindex $rowidlist $row] $id] if {$col < 0} { @@ -2775,7 +3011,7 @@ proc drawvisible {} { proc clear_display {} { global iddrawn idrangedrawn - global vhighlights fhighlights nhighlights + global vhighlights fhighlights nhighlights rhighlights allcanvs delete all catch {unset iddrawn} @@ -2783,6 +3019,7 @@ proc clear_display {} { catch {unset vhighlights} catch {unset fhighlights} catch {unset nhighlights} + catch {unset rhighlights} } proc findcrossings {id} { @@ -3086,6 +3323,7 @@ proc dofind {} { stopfindproc unmarkmatches + cancel_next_highlight focus . set matchinglines {} if {$findtype == "IgnCase"} { @@ -3287,17 +3525,16 @@ proc commit_descriptor {p} { if {[llength $commitinfo($p)] > 1} { set l [lindex $commitinfo($p) 0] } - return "$p ($l)" + return "$p ($l)\n" } # append some text to the ctext widget, and make any SHA1 ID # that we know about be a clickable link. -proc appendwithlinks {text} { +proc appendwithlinks {text tags} { global ctext commitrow linknum curview set start [$ctext index "end - 1c"] - $ctext insert end $text - $ctext insert end "\n" + $ctext insert end $text $tags set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] foreach l $links { set s [lindex $l 0] @@ -3332,6 +3569,64 @@ proc viewnextline {dir} { allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}] } +# add a list of tag or branch names at position pos +# returns the number of names inserted +proc appendrefs {pos l var} { + global ctext commitrow linknum curview idtags $var + + if {[catch {$ctext index $pos}]} { + return 0 + } + set tags {} + foreach id $l { + foreach tag [set $var\($id\)] { + lappend tags [concat $tag $id] + } + } + set tags [lsort -index 1 $tags] + set sep {} + foreach tag $tags { + set name [lindex $tag 0] + set id [lindex $tag 1] + set lk link$linknum + incr linknum + $ctext insert $pos $sep + $ctext insert $pos $name $lk + $ctext tag conf $lk -foreground blue + if {[info exists commitrow($curview,$id)]} { + $ctext tag bind $lk <1> \ + [list selectline $commitrow($curview,$id) 1] + $ctext tag conf $lk -underline 1 + $ctext tag bind $lk { %W configure -cursor hand2 } + $ctext tag bind $lk { %W configure -cursor $curtextcursor } + } + set sep ", " + } + return [llength $tags] +} + +# called when we have finished computing the nearby tags +proc dispneartags {} { + global selectedline currentid ctext anc_tags desc_tags showneartags + global desc_heads + + if {![info exists selectedline] || !$showneartags} return + set id $currentid + $ctext conf -state normal + if {[info exists desc_heads($id)]} { + if {[appendrefs branch $desc_heads($id) idheads] > 1} { + $ctext insert "branch -2c" "es" + } + } + if {[info exists anc_tags($id)]} { + appendrefs follows $anc_tags($id) idtags + } + if {[info exists desc_tags($id)]} { + appendrefs precedes $desc_tags($id) idtags + } + $ctext conf -state disabled +} + proc selectline {l isnew} { global canv canv2 canv3 ctext commitinfo selectedline global displayorder linehtag linentag linedtag @@ -3339,11 +3634,12 @@ proc selectline {l isnew} { global currentid sha1entry global commentend idtags linknum global mergemax numcommits pending_select - global cmitmode + global cmitmode desc_tags anc_tags showneartags allcommits desc_heads catch {unset pending_select} $canv delete hover normalline + cancel_next_highlight if {$l < 0 || $l >= $numcommits} return set y [expr {$canvy0 + $l * $linespc}] set ymax [lindex [$canv cget -scrollregion] 3] @@ -3407,6 +3703,7 @@ proc selectline {l isnew} { $sha1entry insert 0 $id $sha1entry selection from 0 $sha1entry selection to end + rhighlight_sel $id $ctext conf -state normal clear_ctext @@ -3424,7 +3721,7 @@ proc selectline {l isnew} { $ctext insert end "\n" } - set comment {} + set headers {} set olds [lindex $parentlist $l] if {[llength $olds] > 1} { set np 0 @@ -3435,23 +3732,50 @@ proc selectline {l isnew} { set tag m$np } $ctext insert end "Parent: " $tag - appendwithlinks [commit_descriptor $p] + appendwithlinks [commit_descriptor $p] {} incr np } } else { foreach p $olds { - append comment "Parent: [commit_descriptor $p]\n" + append headers "Parent: [commit_descriptor $p]" } } foreach c [lindex $childlist $l] { - append comment "Child: [commit_descriptor $c]\n" + append headers "Child: [commit_descriptor $c]" } - append comment "\n" - append comment [lindex $info 5] # make anything that looks like a SHA1 ID be a clickable link - appendwithlinks $comment + appendwithlinks $headers {} + if {$showneartags} { + if {![info exists allcommits]} { + getallcommits + } + $ctext insert end "Branch: " + $ctext mark set branch "end -1c" + $ctext mark gravity branch left + if {[info exists desc_heads($id)]} { + if {[appendrefs branch $desc_heads($id) idheads] > 1} { + # turn "Branch" into "Branches" + $ctext insert "branch -2c" "es" + } + } + $ctext insert end "\nFollows: " + $ctext mark set follows "end -1c" + $ctext mark gravity follows left + if {[info exists anc_tags($id)]} { + appendrefs follows $anc_tags($id) idtags + } + $ctext insert end "\nPrecedes: " + $ctext mark set precedes "end -1c" + $ctext mark gravity precedes left + if {[info exists desc_tags($id)]} { + appendrefs precedes $desc_tags($id) idtags + } + $ctext insert end "\n" + } + $ctext insert end "\n" + appendwithlinks [lindex $info 5] {comment} $ctext tag delete Comments $ctext tag remove found 1.0 end @@ -3514,6 +3838,8 @@ proc unselectline {} { catch {unset selectedline} catch {unset currentid} allcanvs delete secsel + rhighlight_none + cancel_next_highlight } proc reselectline {} { @@ -3592,7 +3918,7 @@ proc gettree {id} { catch {unset diffmergeid} if {![info exists treefilelist($id)]} { if {![info exists treepending]} { - if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} { + if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} { return } set treepending $id @@ -3640,7 +3966,7 @@ proc showfile {f} { return } set blob [lindex $treeidlist($diffids) $i] - if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} { + if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { puts "oops, error reading blob $blob: $err" return } @@ -3682,7 +4008,7 @@ proc mergediff {id l} { set diffids $id # 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] + 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 @@ -3794,7 +4120,7 @@ proc gettreediffs {ids} { set treepending $ids set treediff {} if {[catch \ - {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \ + {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \ ]} return fconfigure $gdtf -blocking 0 fileevent $gdtf readable [list gettreediffline $gdtf $ids] @@ -3830,7 +4156,7 @@ proc getblobdiffs {ids} { global nextupdate diffinhdr treediffs set env(GIT_DIFF_OPTS) $diffopts - set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids] + 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 @@ -4499,7 +4825,7 @@ proc mkpatchgo {} { 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]} { + if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} { error_popup "Error creating patch: $err" } catch {destroy $patchtop} @@ -4575,12 +4901,19 @@ proc domktag {} { proc redrawtags {id} { global canv linehtag commitrow idpos selectedline curview + global mainfont if {![info exists commitrow($curview,$id)]} return drawcmitrow $commitrow($curview,$id) $canv delete tag.$id set xt [eval drawtags $id $idpos($id)] $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2] + set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text] + set xr [expr {$xt + [font measure $mainfont $text]}] + if {$xr > $canvxmax} { + set canvxmax $xr + setcanvscroll + } if {[info exists selectedline] && $selectedline == $commitrow($curview,$id)} { selectline $selectedline 0 @@ -4654,22 +4987,192 @@ proc wrcomcan {} { unset wrcomtop } -proc listrefs {id} { - global idtags idheads idotherrefs +# Stuff for finding nearby tags +proc getallcommits {} { + global allcstart allcommits allcfd - set x {} - if {[info exists idtags($id)]} { - set x $idtags($id) + set fd [open [concat | git rev-list --all --topo-order --parents] r] + set allcfd $fd + fconfigure $fd -blocking 0 + set allcommits "reading" + nowbusy allcommits + restartgetall $fd +} + +proc discardallcommits {} { + global allparents allchildren allcommits allcfd + global desc_tags anc_tags alldtags tagisdesc allids desc_heads + + if {![info exists allcommits]} return + if {$allcommits eq "reading"} { + catch {close $allcfd} } - set y {} - if {[info exists idheads($id)]} { - set y $idheads($id) + foreach v {allcommits allchildren allparents allids desc_tags anc_tags + alldtags tagisdesc desc_heads} { + catch {unset $v} } - set z {} - if {[info exists idotherrefs($id)]} { - set z $idotherrefs($id) +} + +proc restartgetall {fd} { + global allcstart + + fileevent $fd readable [list getallclines $fd] + set allcstart [clock clicks -milliseconds] +} + +proc combine_dtags {l1 l2} { + global tagisdesc notfirstd + + set res [lsort -unique [concat $l1 $l2]] + for {set i 0} {$i < [llength $res]} {incr i} { + set x [lindex $res $i] + for {set j [expr {$i+1}]} {$j < [llength $res]} {} { + set y [lindex $res $j] + if {[info exists tagisdesc($x,$y)]} { + if {$tagisdesc($x,$y) > 0} { + # x is a descendent of y, exclude x + set res [lreplace $res $i $i] + incr i -1 + break + } else { + # y is a descendent of x, exclude y + set res [lreplace $res $j $j] + } + } else { + # no relation, keep going + incr j + } + } } - return [list $x $y $z] + return $res +} + +proc combine_atags {l1 l2} { + global tagisdesc + + set res [lsort -unique [concat $l1 $l2]] + for {set i 0} {$i < [llength $res]} {incr i} { + set x [lindex $res $i] + for {set j [expr {$i+1}]} {$j < [llength $res]} {} { + set y [lindex $res $j] + if {[info exists tagisdesc($x,$y)]} { + if {$tagisdesc($x,$y) < 0} { + # x is an ancestor of y, exclude x + set res [lreplace $res $i $i] + incr i -1 + break + } else { + # y is an ancestor of x, exclude y + set res [lreplace $res $j $j] + } + } else { + # no relation, keep going + incr j + } + } + } + return $res +} + +proc getallclines {fd} { + global allparents allchildren allcommits allcstart + global desc_tags anc_tags idtags alldtags tagisdesc allids + global desc_heads idheads + + while {[gets $fd line] >= 0} { + set id [lindex $line 0] + lappend allids $id + set olds [lrange $line 1 end] + set allparents($id) $olds + if {![info exists allchildren($id)]} { + set allchildren($id) {} + } + foreach p $olds { + lappend allchildren($p) $id + } + # compute nearest tagged descendents as we go + # also compute descendent heads + set dtags {} + set dheads {} + foreach child $allchildren($id) { + if {[info exists idtags($child)]} { + set ctags [list $child] + } else { + set ctags $desc_tags($child) + } + if {$dtags eq {}} { + set dtags $ctags + } elseif {$ctags ne $dtags} { + set dtags [combine_dtags $dtags $ctags] + } + set cheads $desc_heads($child) + if {$dheads eq {}} { + set dheads $cheads + } elseif {$cheads ne $dheads} { + set dheads [lsort -unique [concat $dheads $cheads]] + } + } + set desc_tags($id) $dtags + if {[info exists idtags($id)]} { + set adt $dtags + foreach tag $dtags { + set adt [concat $adt $alldtags($tag)] + } + set adt [lsort -unique $adt] + set alldtags($id) $adt + foreach tag $adt { + set tagisdesc($id,$tag) -1 + set tagisdesc($tag,$id) 1 + } + } + if {[info exists idheads($id)]} { + lappend dheads $id + } + set desc_heads($id) $dheads + if {[clock clicks -milliseconds] - $allcstart >= 50} { + fileevent $fd readable {} + after idle restartgetall $fd + return + } + } + if {[eof $fd]} { + after idle restartatags [llength $allids] + if {[catch {close $fd} err]} { + error_popup "Error reading full commit graph: $err.\n\ + Results may be incomplete." + } + } +} + +# walk backward through the tree and compute nearest tagged ancestors +proc restartatags {i} { + global allids allparents idtags anc_tags t0 + + set t0 [clock clicks -milliseconds] + while {[incr i -1] >= 0} { + set id [lindex $allids $i] + set atags {} + foreach p $allparents($id) { + if {[info exists idtags($p)]} { + set ptags [list $p] + } else { + set ptags $anc_tags($p) + } + if {$atags eq {}} { + set atags $ptags + } elseif {$ptags ne $atags} { + set atags [combine_atags $atags $ptags] + } + } + set anc_tags($id) $atags + if {[clock clicks -milliseconds] - $t0 >= 50} { + after idle restartatags $i + return + } + } + set allcommits "done" + notbusy allcommits + dispneartags } proc rereadrefs {} { @@ -4693,6 +5196,24 @@ proc rereadrefs {} { } } +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 showtag {tag isnew} { global ctext tagcontents tagids linknum @@ -4707,7 +5228,7 @@ proc showtag {tag isnew} { } else { set text "Tag: $tag\nId: $tagids($tag)" } - appendwithlinks $text + appendwithlinks $text {} $ctext conf -state disabled init_flist {} } @@ -4720,7 +5241,7 @@ proc doquit {} { proc doprefs {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop + global oldprefs prefstop showneartags set top .gitkprefs set prefstop $top @@ -4728,7 +5249,7 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set oldprefs($v) [set $v] } toplevel $top @@ -4750,6 +5271,11 @@ proc doprefs {} { -font optionfont entry $top.diffopt -width 20 -textvariable diffopts grid x $top.diffoptl $top.diffopt -sticky w + frame $top.ntag + label $top.ntag.l -text "Display nearby tags" -font optionfont + checkbutton $top.ntag.b -variable showneartags + pack $top.ntag.b $top.ntag.l -side left + grid x $top.ntag -sticky w frame $top.buts button $top.buts.ok -text "OK" -command prefsok button $top.buts.can -text "Cancel" -command prefscan @@ -4761,9 +5287,9 @@ proc doprefs {} { proc prefscan {} { global maxwidth maxgraphpct diffopts - global oldprefs prefstop + global oldprefs prefstop showneartags - foreach v {maxwidth maxgraphpct diffopts} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -4772,13 +5298,15 @@ proc prefscan {} { proc prefsok {} { global maxwidth maxgraphpct - global oldprefs prefstop + global oldprefs prefstop showneartags catch {destroy $prefstop} unset prefstop if {$maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { redisplay + } elseif {$showneartags != $oldprefs(showneartags)} { + reselectline } } @@ -5062,11 +5590,11 @@ proc tcl_encoding {enc} { # defaults... set datemode 0 set diffopts "-U 5 -p" -set wrcomcmd "git-diff-tree --stdin -p --pretty" +set wrcomcmd "git diff-tree --stdin -p --pretty" set gitencoding {} catch { - set gitencoding [exec git-repo-config --get i18n.commitencoding] + set gitencoding [exec git repo-config --get i18n.commitencoding] } if {$gitencoding == ""} { set gitencoding "utf-8" @@ -5088,6 +5616,8 @@ set uparrowlen 7 set downarrowlen 7 set mingaplen 30 set cmitmode "patch" +set wrapcomment "none" +set showneartags 1 set colors {green red blue magenta darkgrey brown orange} @@ -5109,7 +5639,7 @@ foreach arg $argv { # check that we can find a .git directory somewhere... set gitdir [gitdir] if {![file isdirectory $gitdir]} { - show_error . "Cannot find the git directory \"$gitdir\"." + show_error {} . "Cannot find the git directory \"$gitdir\"." exit 1 } @@ -5120,7 +5650,7 @@ if {$i >= 0} { set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]] } elseif {$revtreeargs ne {}} { if {[catch { - set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs] + set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs] set cmdline_files [split $f "\n"] set n [llength $cmdline_files] set revtreeargs [lrange $revtreeargs 0 end-$n] @@ -5129,9 +5659,9 @@ if {$i >= 0} { # so look for "fatal:". set i [string first "fatal:" $err] if {$i > 0} { - set err [string range [expr {$i + 6}] end] + set err [string range $err [expr {$i + 6}] end] } - show_error . "Bad arguments to gitk:\n$err" + show_error {} . "Bad arguments to gitk:\n$err" exit 1 } } @@ -5142,6 +5672,8 @@ set fh_serial 0 set nhl_names {} set highlight_paths {} set searchdirn -forwards +set boldrows {} +set boldnamerows {} set optim_delay 16