diff options
Diffstat (limited to 'gitk')
| -rwxr-xr-x | gitk | 3143 |
1 files changed, 2467 insertions, 676 deletions
@@ -16,83 +16,112 @@ proc gitdir {} { } } -proc start_rev_list {rlargs} { +proc start_rev_list {view} { global startmsecs nextupdate ncmupdate global commfd leftover tclencoding datemode + global viewargs viewfiles commitidx set startmsecs [clock clicks -milliseconds] set nextupdate [expr {$startmsecs + 100}] set ncmupdate 1 - initlayout + set commitidx($view) 0 + set args $viewargs($view) + if {$viewfiles($view) ne {}} { + set args [concat $args "--" $viewfiles($view)] + } set order "--topo-order" if {$datemode} { set order "--date-order" } if {[catch { - set commfd [open [concat | git-rev-list --header $order \ - --parents --boundary --default HEAD $rlargs] r] + 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 leftover {} - fconfigure $commfd -blocking 0 -translation lf + set commfd($view) $fd + set leftover($view) {} + fconfigure $fd -blocking 0 -translation lf if {$tclencoding != {}} { - fconfigure $commfd -encoding $tclencoding + fconfigure $fd -encoding $tclencoding + } + fileevent $fd readable [list getcommitlines $fd $view] + nowbusy $view +} + +proc stop_rev_list {} { + global commfd curview + + if {![info exists commfd($curview)]} return + set fd $commfd($curview) + catch { + set pid [pid $fd] + exec kill $pid } - fileevent $commfd readable [list getcommitlines $commfd] - . config -cursor watch - settextcursor watch + catch {close $fd} + unset commfd($curview) } -proc getcommits {rargs} { - global phase canv mainfont +proc getcommits {} { + global phase canv mainfont curview set phase getcommits - start_rev_list $rargs - $canv delete all - $canv create text 3 3 -anchor nw -text "Reading commits..." \ - -font $mainfont -tags textitems + initlayout + start_rev_list $curview + show_status "Reading commits..." } -proc getcommitlines {commfd} { +proc getcommitlines {fd view} { global commitlisted nextupdate - global leftover + global leftover commfd global displayorder commitidx commitrow commitdata - global parentlist childlist children + global parentlist childlist children curview hlview + global vparentlist vchildlist vdisporder vcmitlisted - set stuff [read $commfd] + set stuff [read $fd] if {$stuff == {}} { - if {![eof $commfd]} return + if {![eof $fd]} return + global viewname + unset commfd($view) + notbusy $view # set it blocking so we wait for the process to terminate - fconfigure $commfd -blocking 1 - if {![catch {close $commfd} err]} { - after idle finishcommits - return + fconfigure $fd -blocking 1 + if {[catch {close $fd} err]} { + set fv {} + if {$view != $curview} { + set fv " for the \"$viewname($view)\" view" + } + if {[string range $err 0 4] == "usage"} { + set err "Gitk: error reading commits$fv:\ + bad arguments to git rev-list." + if {$viewname($view) eq "Command line"} { + append err \ + " (Note: arguments to gitk are passed to git rev-list\ + to allow selection of commits to be displayed.)" + } + } else { + set err "Error reading commits$fv: $err" + } + error_popup $err } - if {[string range $err 0 4] == "usage"} { - 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" + if {$view == $curview} { + after idle finishcommits } - error_popup $err - exit 1 + return } 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] + append leftover($view) [string range $stuff $start end] break } if {$start == 0} { - set cmit $leftover + set cmit $leftover($view) append cmit [string range $stuff 0 [expr {$i - 1}]] - set leftover {} + set leftover($view) {} } else { set cmit [string range $stuff $start [expr {$i - 1}]] } @@ -119,47 +148,58 @@ proc getcommitlines {commfd} { 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] if {$listed} { set olds [lrange $ids 1 end] - if {[llength $olds] > 1} { - set olds [lsort -unique $olds] - } + set i 0 foreach p $olds { - lappend children($p) $id + if {$i == 0 || [lsearch -exact $olds $p] >= $i} { + lappend children($view,$p) $id + } + incr i } } else { set olds {} } - lappend parentlist $olds - if {[info exists children($id)]} { - lappend childlist $children($id) - } else { - lappend childlist {} + if {![info exists children($view,$id)]} { + set children($view,$id) {} } set commitdata($id) [string range $cmit [expr {$j + 1}] end] - set commitrow($id) $commitidx - incr commitidx - lappend displayorder $id - lappend commitlisted $listed + set commitrow($view,$id) $commitidx($view) + incr commitidx($view) + if {$view == $curview} { + lappend parentlist $olds + lappend childlist $children($view,$id) + lappend displayorder $id + lappend commitlisted $listed + } else { + lappend vparentlist($view) $olds + lappend vchildlist($view) $children($view,$id) + lappend vdisporder($view) $id + lappend vcmitlisted($view) $listed + } set gotsome 1 } if {$gotsome} { - layoutmore + if {$view == $curview} { + layoutmore + } elseif {[info exists hlview] && $view == $hlview} { + vhighlightmore + } } if {[clock clicks -milliseconds] >= $nextupdate} { - doupdate 1 + doupdate } } -proc doupdate {reading} { +proc doupdate {} { global commfd nextupdate numcommits ncmupdate - if {$reading} { - fileevent $commfd readable {} + foreach v [array names commfd] { + fileevent $commfd($v) readable {} } update set nextupdate [expr {[clock clicks -milliseconds] + 100}] @@ -170,28 +210,37 @@ proc doupdate {reading} { } else { set ncmupdate [expr {$numcommits + 100}] } - if {$reading} { - fileevent $commfd readable [list getcommitlines $commfd] + foreach v [array names commfd] { + set fd $commfd($v) + fileevent $fd readable [list getcommitlines $fd $v] } } 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 } -proc updatecommits {rargs} { - stopfindproc - foreach v {colormap selectedline matchinglines treediffs - mergefilelist currentid rowtextx commitrow - rowidlist rowoffsets idrowranges idrangedrawn iddrawn - linesegends crossings cornercrossings} { - global $v - catch {unset $v} +proc updatecommits {} { + global viewdata curview phase displayorder + global children commitrow selectedline thickerline + + if {$phase ne {}} { + stop_rev_list + set phase {} } - allcanvs delete all + set n $curview + foreach id $displayorder { + catch {unset children($n,$id)} + catch {unset commitrow($n,$id)} + } + set curview -1 + catch {unset selectedline} + catch {unset thickerline} + catch {unset viewdata($n)} + discardallcommits readrefs - getcommits $rargs + showview $n } proc parsecommit {id contents listed} { @@ -230,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 " " @@ -274,10 +323,16 @@ proc readrefs {} { match id path]} { continue } + if {[regexp {^remotes/.*/HEAD$} $path match]} { + continue + } if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { set type others set name $path } + if {[regexp {^remotes/} $path match]} { + set type heads + } if {$type == "tags"} { set tagids($name) $id lappend idtags($id) $name @@ -285,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 @@ -305,31 +360,38 @@ proc readrefs {} { close $refd } +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 $top" + pack $w.ok -side bottom -fill x + bind $top <Visibility> "grab $top; focus $top" + bind $top <Key-Return> "destroy $top" + tkwait window $top +} + proc error_popup msg { set w .error toplevel $w wm transient $w . - 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" - pack $w.ok -side bottom -fill x - bind $w <Visibility> "grab $w; focus $w" - bind $w <Key-Return> "destroy $w" - tkwait window $w + show_error $w $w $msg } -proc makewindow {rargs} { - global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont +proc makewindow {} { + global canv canv2 canv3 linespc charspc ctext cflist + global textfont mainfont uifont 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 menu .bar .bar add cascade -label "File" -menu .bar.file .bar configure -font $uifont menu .bar.file - .bar.file add command -label "Update" -command [list updatecommits $rargs] + .bar.file add command -label "Update" -command updatecommits .bar.file add command -label "Reread references" -command rereadrefs .bar.file add command -label "Quit" -command doquit .bar.file configure -font $uifont @@ -337,6 +399,17 @@ proc makewindow {rargs} { .bar add cascade -label "Edit" -menu .bar.edit .bar.edit add command -label "Preferences" -command doprefs .bar.edit configure -font $uifont + + menu .bar.view -font $uifont + .bar add cascade -label "View" -menu .bar.view + .bar.view add command -label "New view..." -command {newview 0} + .bar.view add command -label "Edit view..." -command editview \ + -state disabled + .bar.view add command -label "Delete view" -command delview -state disabled + .bar.view add separator + .bar.view add radiobutton -label "All files" -command {showview 0} \ + -variable selectedview -value 0 + menu .bar.help .bar add cascade -label "Help" -menu .bar.help .bar.help add command -label "About gitk" -command about @@ -362,6 +435,8 @@ proc makewindow {rargs} { } frame .ctop.top frame .ctop.top.bar + frame .ctop.top.lbar + pack .ctop.top.lbar -side bottom -fill x pack .ctop.top.bar -side bottom -fill x set cscroll .ctop.top.csb scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 @@ -423,36 +498,80 @@ proc makewindow {rargs} { set findstring {} set fstring .ctop.top.bar.findstring lappend entries $fstring - entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont + entry $fstring -width 30 -font $textfont -textvariable findstring + trace add variable findstring write find_change pack $fstring -side left -expand 1 -fill x set findtype Exact set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ findtype Exact IgnCase Regexp] + trace add variable findtype write find_change .ctop.top.bar.findtype configure -font $uifont .ctop.top.bar.findtype.menu configure -font $uifont set findloc "All fields" tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ - Comments Author Committer Files Pickaxe + Comments Author Committer + trace add variable findloc write find_change .ctop.top.bar.findloc configure -font $uifont .ctop.top.bar.findloc.menu configure -font $uifont - 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 + + label .ctop.top.lbar.flabel -text "Highlight: Commits " \ + -font $uifont + pack .ctop.top.lbar.flabel -side left -fill y + set gdttype "touching paths:" + set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \ + "adding/removing string:"] + trace add variable gdttype write hfiles_change + $gm conf -font $uifont + .ctop.top.lbar.gdttype conf -font $uifont + pack .ctop.top.lbar.gdttype -side left -fill y + entry .ctop.top.lbar.fent -width 25 -font $textfont \ + -textvariable highlight_files + trace add variable highlight_files write hfiles_change + lappend entries .ctop.top.lbar.fent + pack .ctop.top.lbar.fent -side left -fill x -expand 1 + label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont + pack .ctop.top.lbar.vlabel -side left -fill y + global viewhlmenu selectedhlview + set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None] + $viewhlmenu entryconf 0 -command delvhighlight + $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 frame .ctop.cdet.left + frame .ctop.cdet.left.bot + pack .ctop.cdet.left.bot -side bottom -fill x + button .ctop.cdet.left.bot.search -text "Search" -command dosearch \ + -font $uifont + pack .ctop.cdet.left.bot.search -side left -padx 5 + set sstring .ctop.cdet.left.bot.sstring + entry $sstring -width 20 -font $textfont -textvariable searchstring + lappend entries $sstring + trace add variable searchstring write incrsearch + pack $sstring -side left -expand 1 -fill x 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" -wrap none + -yscrollcommand scrolltext -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 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 @@ -480,12 +599,26 @@ proc makewindow {rargs} { $ctext tag conf found -back yellow frame .ctop.cdet.right + frame .ctop.cdet.right.mode + radiobutton .ctop.cdet.right.mode.patch -text "Patch" \ + -command reselectline -variable cmitmode -value "patch" + radiobutton .ctop.cdet.right.mode.tree -text "Tree" \ + -command reselectline -variable cmitmode -value "tree" + grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew + pack .ctop.cdet.right.mode -side top -fill x set cflist .ctop.cdet.right.cfiles - listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ - -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont + set indent [font measure $mainfont "nn"] + text $cflist -width $geometry(cflistw) -background white -font $mainfont \ + -tabs [list $indent [expr {2 * $indent}]] \ + -yscrollcommand ".ctop.cdet.right.sb set" \ + -cursor [. cget -cursor] \ + -spacing1 1 -spacing3 1 scrollbar .ctop.cdet.right.sb -command "$cflist yview" pack .ctop.cdet.right.sb -side right -fill y pack $cflist -side left -fill both -expand 1 + $cflist tag configure highlight \ + -background [$cflist cget -selectbackground] + $cflist tag configure bold -font [concat $mainfont bold] .ctop.cdet add .ctop.cdet.right bind .ctop.cdet <Configure> {resizecdetpanes %W %w} @@ -501,6 +634,8 @@ proc makewindow {rargs} { bindkey <End> sellastline bind . <Key-Up> "selnextline -1" bind . <Key-Down> "selnextline 1" + bind . <Shift-Key-Up> "next_highlight -1" + bind . <Shift-Key-Down> "next_highlight 1" bindkey <Key-Right> "goforw" bindkey <Key-Left> "goback" bind . <Key-Prior> "selnextpage -1" @@ -532,17 +667,20 @@ proc makewindow {rargs} { bind . <Control-q> doquit bind . <Control-f> dofind bind . <Control-g> {findnext 0} - bind . <Control-r> findprev + bind . <Control-r> dosearchback + bind . <Control-s> dosearch bind . <Control-equal> {incrfont 1} bind . <Control-KP_Add> {incrfont 1} bind . <Control-minus> {incrfont -1} bind . <Control-KP_Subtract> {incrfont -1} - bind $cflist <<ListboxSelect>> listboxsel bind . <Destroy> {savestuff %W} bind . <Button-1> "click %W" bind $fstring <Key-Return> dofind bind $sha1entry <Key-Return> gotocommit bind $sha1entry <<PasteSelection>> clearsha1 + bind $cflist <1> {sel_flist %W %x %y; break} + bind $cflist <B1-Motion> {sel_flist %W %x %y; break} + bind $cflist <ButtonRelease-1> {treeclick %W %x %y} set maincursor [. cget -cursor] set textcursor [$ctext cget -cursor] @@ -575,6 +713,7 @@ proc canvscan {op w x y} { proc scrollcanv {cscroll f0 f1} { $cscroll set $f0 $f1 drawfrac $f0 $f1 + flushhighlights } # when we make a key binding for the toplevel, make sure @@ -605,7 +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 wrapcomment if {$stuffsaved} return if {![winfo viewable .]} return @@ -617,6 +758,9 @@ proc savestuff {w} { puts $f [list set findmergefiles $findmergefiles] 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}]" @@ -629,6 +773,13 @@ proc savestuff {w} { set wid [expr {([winfo width $cflist] - 11) \ / [font measure [$cflist cget -font] "0"]}] puts $f "set geometry(cflistw) $wid" + puts -nonewline $f "set permviews {" + for {set v 0} {$v < $nextviewnum} {incr v} { + if {$viewperm($v)} { + puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}" + } + } + puts $f "}" close $f file rename -force "~/.gitk-new" "~/.gitk" } @@ -747,6 +898,8 @@ Gitk key bindings: <Ctrl-Down> Scroll commit list down one line <Ctrl-PageUp> Scroll commit list up one page <Ctrl-PageDown> Scroll commit list down one page +<Shift-Up> Move to previous highlighted line +<Shift-Down> Move to next highlighted line <Delete>, b Scroll diff view up one page <Backspace> Scroll diff view up one page <Space> Scroll diff view down one page @@ -754,11 +907,12 @@ u Scroll diff view up 18 lines d Scroll diff view down 18 lines <Ctrl-F> Find <Ctrl-G> Move to next find hit -<Ctrl-R> Move to previous find hit <Return> 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 +<Ctrl-S> Search for next hit in diff view +<Ctrl-R> Search for previous hit in diff view <Ctrl-KP+> Increase font size <Ctrl-plus> Increase font size <Ctrl-KP-> Decrease font size @@ -770,6 +924,1239 @@ f Scroll diff view to next file pack $w.ok -side bottom } +# Procedures for manipulating the file list window at the +# bottom right of the overall window. + +proc treeview {w l openlevs} { + global treecontents treediropen treeheight treeparent treeindex + + set ix 0 + set treeindex() 0 + set lev 0 + set prefix {} + set prefixend -1 + set prefendstack {} + set htstack {} + set ht 0 + set treecontents() {} + $w conf -state normal + foreach f $l { + while {[string range $f 0 $prefixend] ne $prefix} { + if {$lev <= $openlevs} { + $w mark set e:$treeindex($prefix) "end -1c" + $w mark gravity e:$treeindex($prefix) left + } + set treeheight($prefix) $ht + incr ht [lindex $htstack end] + set htstack [lreplace $htstack end end] + set prefixend [lindex $prefendstack end] + set prefendstack [lreplace $prefendstack end end] + set prefix [string range $prefix 0 $prefixend] + incr lev -1 + } + set tail [string range $f [expr {$prefixend+1}] end] + while {[set slash [string first "/" $tail]] >= 0} { + lappend htstack $ht + set ht 0 + lappend prefendstack $prefixend + incr prefixend [expr {$slash + 1}] + set d [string range $tail 0 $slash] + lappend treecontents($prefix) $d + set oldprefix $prefix + append prefix $d + set treecontents($prefix) {} + set treeindex($prefix) [incr ix] + set treeparent($prefix) $oldprefix + set tail [string range $tail [expr {$slash+1}] end] + if {$lev <= $openlevs} { + set ht 1 + set treediropen($prefix) [expr {$lev < $openlevs}] + set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}] + $w mark set d:$ix "end -1c" + $w mark gravity d:$ix left + set str "\n" + for {set i 0} {$i < $lev} {incr i} {append str "\t"} + $w insert end $str + $w image create end -align center -image $bm -padx 1 \ + -name a:$ix + $w insert end $d [highlight_tag $prefix] + $w mark set s:$ix "end -1c" + $w mark gravity s:$ix left + } + incr lev + } + if {$tail ne {}} { + if {$lev <= $openlevs} { + incr ht + set str "\n" + for {set i 0} {$i < $lev} {incr i} {append str "\t"} + $w insert end $str + $w insert end $tail [highlight_tag $f] + } + lappend treecontents($prefix) $tail + } + } + while {$htstack ne {}} { + set treeheight($prefix) $ht + incr ht [lindex $htstack end] + set htstack [lreplace $htstack end end] + } + $w conf -state disabled +} + +proc linetoelt {l} { + global treeheight treecontents + + set y 2 + set prefix {} + while {1} { + foreach e $treecontents($prefix) { + if {$y == $l} { + return "$prefix$e" + } + set n 1 + if {[string index $e end] eq "/"} { + set n $treeheight($prefix$e) + if {$y + $n > $l} { + append prefix $e + incr y + break + } + } + incr y $n + } + } +} + +proc highlight_tree {y prefix} { + global treeheight treecontents cflist + + foreach e $treecontents($prefix) { + set path $prefix$e + if {[highlight_tag $path] ne {}} { + $cflist tag add bold $y.0 "$y.0 lineend" + } + incr y + if {[string index $e end] eq "/" && $treeheight($path) > 1} { + set y [highlight_tree $y $path] + } + } + return $y +} + +proc treeclosedir {w dir} { + global treediropen treeheight treeparent treeindex + + set ix $treeindex($dir) + $w conf -state normal + $w delete s:$ix e:$ix + set treediropen($dir) 0 + $w image configure a:$ix -image tri-rt + $w conf -state disabled + set n [expr {1 - $treeheight($dir)}] + while {$dir ne {}} { + incr treeheight($dir) $n + set dir $treeparent($dir) + } +} + +proc treeopendir {w dir} { + global treediropen treeheight treeparent treecontents treeindex + + set ix $treeindex($dir) + $w conf -state normal + $w image configure a:$ix -image tri-dn + $w mark set e:$ix s:$ix + $w mark gravity e:$ix right + set lev 0 + set str "\n" + set n [llength $treecontents($dir)] + for {set x $dir} {$x ne {}} {set x $treeparent($x)} { + incr lev + append str "\t" + incr treeheight($x) $n + } + foreach e $treecontents($dir) { + set de $dir$e + if {[string index $e end] eq "/"} { + set iy $treeindex($de) + $w mark set d:$iy e:$ix + $w mark gravity d:$iy left + $w insert e:$ix $str + set treediropen($de) 0 + $w image create e:$ix -align center -image tri-rt -padx 1 \ + -name a:$iy + $w insert e:$ix $e [highlight_tag $de] + $w mark set s:$iy e:$ix + $w mark gravity s:$iy left + set treeheight($de) 1 + } else { + $w insert e:$ix $str + $w insert e:$ix $e [highlight_tag $de] + } + } + $w mark gravity e:$ix left + $w conf -state disabled + set treediropen($dir) 1 + set top [lindex [split [$w index @0,0] .] 0] + set ht [$w cget -height] + set l [lindex [split [$w index s:$ix] .] 0] + if {$l < $top} { + $w yview $l.0 + } elseif {$l + $n + 1 > $top + $ht} { + set top [expr {$l + $n + 2 - $ht}] + if {$l < $top} { + set top $l + } + $w yview $top.0 + } +} + +proc treeclick {w x y} { + global treediropen cmitmode ctext cflist cflist_top + + if {$cmitmode ne "tree"} return + if {![info exists cflist_top]} return + set l [lindex [split [$w index "@$x,$y"] "."] 0] + $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend" + $cflist tag add highlight $l.0 "$l.0 lineend" + set cflist_top $l + if {$l == 1} { + $ctext yview 1.0 + return + } + set e [linetoelt $l] + if {[string index $e end] ne "/"} { + showfile $e + } elseif {$treediropen($e)} { + treeclosedir $w $e + } else { + treeopendir $w $e + } +} + +proc setfilelist {id} { + global treefilelist cflist + + treeview $cflist $treefilelist($id) 0 +} + +image create bitmap tri-rt -background black -foreground blue -data { + #define tri-rt_width 13 + #define tri-rt_height 13 + static unsigned char tri-rt_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00, + 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00, + 0x00, 0x00}; +} -maskdata { + #define tri-rt-mask_width 13 + #define tri-rt-mask_height 13 + static unsigned char tri-rt-mask_bits[] = { + 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01, + 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00, + 0x08, 0x00}; +} +image create bitmap tri-dn -background black -foreground blue -data { + #define tri-dn_width 13 + #define tri-dn_height 13 + static unsigned char tri-dn_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03, + 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00}; +} -maskdata { + #define tri-dn-mask_width 13 + #define tri-dn-mask_height 13 + static unsigned char tri-dn-mask_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07, + 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00}; +} + +proc init_flist {first} { + global cflist cflist_top selectedline difffilestart + + $cflist conf -state normal + $cflist delete 0.0 end + if {$first ne {}} { + $cflist insert end $first + set cflist_top 1 + $cflist tag add highlight 1.0 "1.0 lineend" + } else { + catch {unset cflist_top} + } + $cflist conf -state disabled + set difffilestart {} +} + +proc highlight_tag {f} { + global highlight_paths + + foreach p $highlight_paths { + if {[string match $p $f]} { + return "bold" + } + } + return {} +} + +proc highlight_filelist {} { + global cmitmode cflist + + $cflist conf -state normal + if {$cmitmode ne "tree"} { + set end [lindex [split [$cflist index end] .] 0] + for {set l 2} {$l < $end} {incr l} { + set line [$cflist get $l.0 "$l.0 lineend"] + if {[highlight_tag $line] ne {}} { + $cflist tag add bold $l.0 "$l.0 lineend" + } + } + } else { + highlight_tree 2 {} + } + $cflist conf -state disabled +} + +proc unhighlight_filelist {} { + global cflist + + $cflist conf -state normal + $cflist tag remove bold 1.0 end + $cflist conf -state disabled +} + +proc add_flist {fl} { + global cflist + + $cflist conf -state normal + foreach f $fl { + $cflist insert end "\n" + $cflist insert end $f [highlight_tag $f] + } + $cflist conf -state disabled +} + +proc sel_flist {w x y} { + global ctext difffilestart cflist cflist_top cmitmode + + if {$cmitmode eq "tree"} return + if {![info exists cflist_top]} return + set l [lindex [split [$w index "@$x,$y"] "."] 0] + $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend" + $cflist tag add highlight $l.0 "$l.0 lineend" + set cflist_top $l + if {$l == 1} { + $ctext yview 1.0 + } else { + catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]} + } +} + +# Functions for adding and removing shell-type quoting + +proc shellquote {str} { + if {![string match "*\['\"\\ \t]*" $str]} { + return $str + } + if {![string match "*\['\"\\]*" $str]} { + return "\"$str\"" + } + if {![string match "*'*" $str]} { + return "'$str'" + } + return "\"[string map {\" \\\" \\ \\\\} $str]\"" +} + +proc shellarglist {l} { + set str {} + foreach a $l { + if {$str ne {}} { + append str " " + } + append str [shellquote $a] + } + return $str +} + +proc shelldequote {str} { + set ret {} + set used -1 + while {1} { + incr used + if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} { + append ret [string range $str $used end] + set used [string length $str] + break + } + set first [lindex $first 0] + set ch [string index $str $first] + if {$first > $used} { + append ret [string range $str $used [expr {$first - 1}]] + set used $first + } + if {$ch eq " " || $ch eq "\t"} break + incr used + if {$ch eq "'"} { + set first [string first "'" $str $used] + if {$first < 0} { + error "unmatched single-quote" + } + append ret [string range $str $used [expr {$first - 1}]] + set used $first + continue + } + if {$ch eq "\\"} { + if {$used >= [string length $str]} { + error "trailing backslash" + } + append ret [string index $str $used] + continue + } + # here ch == "\"" + while {1} { + if {![regexp -start $used -indices "\[\"\\\\]" $str first]} { + error "unmatched double-quote" + } + set first [lindex $first 0] + set ch [string index $str $first] + if {$first > $used} { + append ret [string range $str $used [expr {$first - 1}]] + set used $first + } + if {$ch eq "\""} break + incr used + append ret [string index $str $used] + incr used + } + } + return [list $used $ret] +} + +proc shellsplit {str} { + set l {} + while {1} { + set str [string trimleft $str] + if {$str eq {}} break + set dq [shelldequote $str] + set n [lindex $dq 0] + set word [lindex $dq 1] + set str [string range $str $n end] + lappend l $word + } + return $l +} + +# Code to implement multiple views + +proc newview {ishighlight} { + global nextviewnum newviewname newviewperm uifont newishighlight + global newviewargs revtreeargs + + set newishighlight $ishighlight + set top .gitkview + if {[winfo exists $top]} { + raise $top + return + } + set newviewname($nextviewnum) "View $nextviewnum" + set newviewperm($nextviewnum) 0 + set newviewargs($nextviewnum) [shellarglist $revtreeargs] + vieweditor $top $nextviewnum "Gitk view definition" +} + +proc editview {} { + global curview + global viewname viewperm newviewname newviewperm + global viewargs newviewargs + + set top .gitkvedit-$curview + if {[winfo exists $top]} { + raise $top + return + } + set newviewname($curview) $viewname($curview) + set newviewperm($curview) $viewperm($curview) + set newviewargs($curview) [shellarglist $viewargs($curview)] + vieweditor $top $curview "Gitk: edit view $viewname($curview)" +} + +proc vieweditor {top n title} { + global newviewname newviewperm viewfiles + global uifont + + toplevel $top + wm title $top $title + label $top.nl -text "Name" -font $uifont + entry $top.name -width 20 -textvariable newviewname($n) + grid $top.nl $top.name -sticky w -pady 5 + 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):" + grid $top.al - -sticky w -pady 5 + entry $top.args -width 50 -textvariable newviewargs($n) \ + -background white + grid $top.args - -sticky ew -padx 5 + message $top.l -aspect 1000 -font $uifont \ + -text "Enter files and directories to include, one per line:" + grid $top.l - -sticky w + text $top.t -width 40 -height 10 -background white + if {[info exists viewfiles($n)]} { + foreach f $viewfiles($n) { + $top.t insert end $f + $top.t insert end "\n" + } + $top.t delete {end - 1c} end + $top.t mark set insert 0.0 + } + grid $top.t - -sticky ew -padx 5 + frame $top.buts + button $top.buts.ok -text "OK" -command [list newviewok $top $n] + button $top.buts.can -text "Cancel" -command [list destroy $top] + 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 + focus $top.t +} + +proc doviewmenu {m first cmd op argv} { + set nmenu [$m index end] + for {set i $first} {$i <= $nmenu} {incr i} { + if {[$m entrycget $i -command] eq $cmd} { + eval $m $op $i $argv + break + } + } +} + +proc allviewmenus {n op args} { + global viewhlmenu + + doviewmenu .bar.view 7 [list showview $n] $op $args + doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args +} + +proc newviewok {top n} { + global nextviewnum newviewperm newviewname newishighlight + global viewname viewfiles viewperm selectedview curview + global viewargs newviewargs viewhlmenu + + if {[catch { + set newargs [shellsplit $newviewargs($n)] + } err]} { + error_popup "Error in commit selection arguments: $err" + wm raise $top + focus $top + return + } + set files {} + foreach f [split [$top.t get 0.0 end] "\n"] { + set ft [string trim $f] + if {$ft ne {}} { + lappend files $ft + } + } + if {![info exists viewfiles($n)]} { + # creating a new view + incr nextviewnum + set viewname($n) $newviewname($n) + set viewperm($n) $newviewperm($n) + set viewfiles($n) $files + set viewargs($n) $newargs + addviewmenu $n + if {!$newishighlight} { + after idle showview $n + } else { + after idle addvhighlight $n + } + } else { + # editing an existing view + set viewperm($n) $newviewperm($n) + if {$newviewname($n) ne $viewname($n)} { + set viewname($n) $newviewname($n) + doviewmenu .bar.view 7 [list showview $n] \ + entryconf [list -label $viewname($n)] + doviewmenu $viewhlmenu 1 [list addvhighlight $n] \ + entryconf [list -label $viewname($n) -value $viewname($n)] + } + if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} { + set viewfiles($n) $files + set viewargs($n) $newargs + if {$curview == $n} { + after idle updatecommits + } + } + } + catch {destroy $top} +} + +proc delview {} { + global curview viewdata viewperm hlview selectedhlview + + if {$curview == 0} return + if {[info exists hlview] && $hlview == $curview} { + set selectedhlview None + unset hlview + } + allviewmenus $curview delete + set viewdata($curview) {} + set viewperm($curview) 0 + showview 0 +} + +proc addviewmenu {n} { + global viewname viewhlmenu + + .bar.view add radiobutton -label $viewname($n) \ + -command [list showview $n] -variable selectedview -value $n + $viewhlmenu add radiobutton -label $viewname($n) \ + -command [list addvhighlight $n] -variable selectedhlview +} + +proc flatten {var} { + global $var + + set ret {} + foreach i [array names $var] { + lappend ret $i [set $var\($i\)] + } + return $ret +} + +proc unflatten {var l} { + global $var + + catch {unset $var} + foreach {i v} $l { + set $var\($i\) $v + } +} + +proc showview {n} { + global curview viewdata viewfiles + global displayorder parentlist childlist rowidlist rowoffsets + global colormap rowtextx commitrow nextcolor canvxmax + global numcommits rowrangelist commitlisted idrowranges + global selectedline currentid canv canvy0 + global matchinglines treediffs + global pending_select phase + global commitidx rowlaidout rowoptim linesegends + global commfd nextupdate + global selectedview + global vparentlist vchildlist vdisporder vcmitlisted + global hlview selectedhlview + + if {$n == $curview} return + set selid {} + if {[info exists selectedline]} { + set selid $currentid + set y [yc $selectedline] + set ymax [lindex [$canv cget -scrollregion] 3] + set span [$canv yview] + set ytop [expr {[lindex $span 0] * $ymax}] + set ybot [expr {[lindex $span 1] * $ymax}] + if {$ytop < $y && $y < $ybot} { + set yscreen [expr {$y - $ytop}] + } else { + set yscreen [expr {($ybot - $ytop) / 2}] + } + } + unselectline + normalline + stopfindproc + if {$curview >= 0} { + set vparentlist($curview) $parentlist + set vchildlist($curview) $childlist + set vdisporder($curview) $displayorder + set vcmitlisted($curview) $commitlisted + if {$phase ne {}} { + set viewdata($curview) \ + [list $phase $rowidlist $rowoffsets $rowrangelist \ + [flatten idrowranges] [flatten idinlist] \ + $rowlaidout $rowoptim $numcommits $linesegends] + } elseif {![info exists viewdata($curview)] + || [lindex $viewdata($curview) 0] ne {}} { + set viewdata($curview) \ + [list {} $rowidlist $rowoffsets $rowrangelist] + } + } + catch {unset matchinglines} + catch {unset treediffs} + clear_display + if {[info exists hlview] && $hlview == $n} { + unset hlview + set selectedhlview None + } + + set curview $n + set selectedview $n + .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}] + .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}] + + if {![info exists viewdata($n)]} { + set pending_select $selid + getcommits + return + } + + set v $viewdata($n) + set phase [lindex $v 0] + set displayorder $vdisporder($n) + set parentlist $vparentlist($n) + set childlist $vchildlist($n) + set commitlisted $vcmitlisted($n) + set rowidlist [lindex $v 1] + set rowoffsets [lindex $v 2] + set rowrangelist [lindex $v 3] + if {$phase eq {}} { + set numcommits [llength $displayorder] + catch {unset idrowranges} + } else { + unflatten idrowranges [lindex $v 4] + unflatten idinlist [lindex $v 5] + set rowlaidout [lindex $v 6] + set rowoptim [lindex $v 7] + set numcommits [lindex $v 8] + set linesegends [lindex $v 9] + } + + catch {unset colormap} + catch {unset rowtextx} + set nextcolor 0 + set canvxmax [$canv cget -width] + set curview $n + set row 0 + setcanvscroll + set yf 0 + set row 0 + if {$selid ne {} && [info exists commitrow($n,$selid)]} { + set row $commitrow($n,$selid) + # try to get the selected row in the same position on the screen + set ymax [lindex [$canv cget -scrollregion] 3] + set ytop [expr {[yc $row] - $yscreen}] + if {$ytop < 0} { + set ytop 0 + } + set yf [expr {$ytop * 1.0 / $ymax}] + } + allcanvs yview moveto $yf + drawvisible + selectline $row 0 + if {$phase ne {}} { + if {$phase eq "getcommits"} { + show_status "Reading commits..." + } + if {[info exists commfd($n)]} { + layoutmore + } else { + finishcommits + } + } elseif {$numcommits == 0} { + show_status "No commits selected" + } +} + +# Stuff relating to the highlighting facility + +proc ishighlighted {row} { + global vhighlights fhighlights nhighlights rhighlights + + if {[info exists nhighlights($row)] && $nhighlights($row) > 0} { + return $nhighlights($row) + } + if {[info exists vhighlights($row)] && $vhighlights($row) > 0} { + return $vhighlights($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 boldrows + + lappend boldrows $row + $canv itemconf $linehtag($row) -font $font + if {[info exists selectedline] && $row == $selectedline} { + $canv delete secsel + set t [eval $canv create rect [$canv bbox $linehtag($row)] \ + -outline {{}} -tags secsel \ + -fill [$canv cget -selectbackground]] + $canv lower $t + } +} + +proc bolden_name {row font} { + global canv2 linentag selectedline boldnamerows + + lappend boldnamerows $row + $canv2 itemconf $linentag($row) -font $font + if {[info exists selectedline] && $row == $selectedline} { + $canv2 delete secsel + set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \ + -outline {{}} -tags secsel \ + -fill [$canv2 cget -selectbackground]] + $canv2 lower $t + } +} + +proc unbolden {} { + global mainfont boldrows + + set stillbold {} + foreach row $boldrows { + if {![ishighlighted $row]} { + bolden $row $mainfont + } else { + lappend stillbold $row + } + } + set boldrows $stillbold +} + +proc addvhighlight {n} { + global hlview curview viewdata vhl_done vhighlights commitidx + + if {[info exists hlview]} { + delvhighlight + } + set hlview $n + if {$n != $curview && ![info exists viewdata($n)]} { + set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}] + set vparentlist($n) {} + set vchildlist($n) {} + set vdisporder($n) {} + set vcmitlisted($n) {} + start_rev_list $n + } + set vhl_done $commitidx($hlview) + if {$vhl_done > 0} { + drawvisible + } +} + +proc delvhighlight {} { + global hlview vhighlights + + if {![info exists hlview]} return + unset hlview + catch {unset vhighlights} + unbolden +} + +proc vhighlightmore {} { + global hlview vhl_done commitidx vhighlights + global displayorder vdisporder curview mainfont + + set font [concat $mainfont bold] + set max $commitidx($hlview) + if {$hlview == $curview} { + set disp $displayorder + } else { + set disp $vdisporder($hlview) + } + set vr [visiblerows] + set r0 [lindex $vr 0] + set r1 [lindex $vr 1] + for {set i $vhl_done} {$i < $max} {incr i} { + set id [lindex $disp $i] + if {[info exists commitrow($curview,$id)]} { + set row $commitrow($curview,$id) + if {$r0 <= $row && $row <= $r1} { + if {![highlighted $row]} { + bolden $row $font + } + set vhighlights($row) 1 + } + } + } + set vhl_done $max +} + +proc askvhighlight {row id} { + global hlview vhighlights commitrow iddrawn mainfont + + if {[info exists commitrow($hlview,$id)]} { + if {[info exists iddrawn($id)] && ![ishighlighted $row]} { + bolden $row [concat $mainfont bold] + } + set vhighlights($row) 1 + } else { + set vhighlights($row) 0 + } +} + +proc hfiles_change {name ix op} { + global highlight_files filehighlight fhighlights fh_serial + global mainfont highlight_paths + + if {[info exists filehighlight]} { + # delete previous highlights + catch {close $filehighlight} + unset filehighlight + catch {unset fhighlights} + unbolden + unhighlight_filelist + } + set highlight_paths {} + after cancel do_file_hl $fh_serial + incr fh_serial + if {$highlight_files ne {}} { + after 300 do_file_hl $fh_serial + } +} + +proc makepatterns {l} { + set ret {} + foreach e $l { + set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e] + if {[string index $ee end] eq "/"} { + lappend ret "$ee*" + } else { + lappend ret $ee + lappend ret "$ee/*" + } + } + return $ret +} + +proc do_file_hl {serial} { + global highlight_files filehighlight highlight_paths gdttype fhl_list + + if {$gdttype eq "touching paths:"} { + if {[catch {set paths [shellsplit $highlight_files]}]} return + set highlight_paths [makepatterns $paths] + highlight_filelist + set gdtargs [concat -- $paths] + } else { + set gdtargs [list "-S$highlight_files"] + } + set cmd [concat | git-diff-tree -r -s --stdin $gdtargs] + set filehighlight [open $cmd r+] + fconfigure $filehighlight -blocking 0 + fileevent $filehighlight readable readfhighlight + set fhl_list {} + drawvisible + flushhighlights +} + +proc flushhighlights {} { + global filehighlight fhl_list + + if {[info exists filehighlight]} { + lappend fhl_list {} + puts $filehighlight "" + flush $filehighlight + } +} + +proc askfilehighlight {row id} { + global filehighlight fhighlights fhl_list + + lappend fhl_list $id + set fhighlights($row) -1 + puts $filehighlight $id +} + +proc readfhighlight {} { + global filehighlight fhighlights commitrow curview mainfont iddrawn + 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 + } + } + 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 + } + if {[eof $filehighlight]} { + # strange... + puts "oops, git-diff-tree died" + catch {close $filehighlight} + unset filehighlight + } + next_hlcont +} + +proc find_change {name ix op} { + global nhighlights mainfont boldnamerows + global findstring findpattern findtype + + # delete previous highlights, if any + foreach row $boldnamerows { + bolden_name $row $mainfont + } + set boldnamerows {} + catch {unset nhighlights} + unbolden + if {$findtype ne "Regexp"} { + set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \ + $findstring] + set findpattern "*$e*" + } + drawvisible +} + +proc askfindhighlight {row id} { + global nhighlights commitinfo iddrawn mainfont + global findstring findtype findloc findpattern + + if {![info exists commitinfo($id)]} { + getcommit $id + } + set info $commitinfo($id) + set isbold 0 + set fldtypes {Headline Author Date Committer CDate Comments} + foreach f $info ty $fldtypes { + if {$findloc ne "All fields" && $findloc ne $ty} { + continue + } + if {$findtype eq "Regexp"} { + set doesmatch [regexp $findstring $f] + } elseif {$findtype eq "IgnCase"} { + set doesmatch [string match -nocase $findpattern $f] + } else { + set doesmatch [string match $findpattern $f] + } + if {$doesmatch} { + if {$ty eq "Author"} { + set isbold 2 + } else { + set isbold 1 + } + } + } + if {[info exists iddrawn($id)]} { + if {$isbold && ![ishighlighted $row]} { + bolden $row [concat $mainfont bold] + } + if {$isbold >= 2} { + bolden_name $row [concat $mainfont bold] + } + } + 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} { set res {} foreach id $ids { @@ -805,20 +2192,21 @@ proc ntimes {n o} { } proc usedinrange {id l1 l2} { - global children commitrow + global children commitrow childlist curview - if {[info exists commitrow($id)]} { - set r $commitrow($id) + if {[info exists commitrow($curview,$id)]} { + set r $commitrow($curview,$id) if {$l1 <= $r && $r <= $l2} { return [expr {$r - $l1 + 1}] } + set kids [lindex $childlist $r] + } else { + set kids $children($curview,$id) } - foreach c $children($id) { - if {[info exists commitrow($c)]} { - set r $commitrow($c) - if {$l1 <= $r && $r <= $l2} { - return [expr {$r - $l1 + 1}] - } + foreach c $kids { + set r $commitrow($curview,$c) + if {$l1 <= $r && $r <= $l2} { + return [expr {$r - $l1 + 1}] } } return 0 @@ -886,18 +2274,19 @@ proc makeuparrow {oid x y z} { proc initlayout {} { global rowidlist rowoffsets displayorder commitlisted global rowlaidout rowoptim - global idinlist rowchk - global commitidx numcommits canvxmax canv + global idinlist rowchk rowrangelist idrowranges + global numcommits canvxmax canv global nextcolor global parentlist childlist children + global colormap rowtextx + global linesegends - set commitidx 0 set numcommits 0 set displayorder {} set commitlisted {} set parentlist {} set childlist {} - catch {unset children} + set rowrangelist {} set nextcolor 0 set rowidlist {{}} set rowoffsets {{}} @@ -906,6 +2295,10 @@ proc initlayout {} { set rowlaidout 0 set rowoptim 0 set canvxmax [$canv cget -width] + catch {unset colormap} + catch {unset rowtextx} + catch {unset idrowranges} + set linesegends {} } proc setcanvscroll {} { @@ -938,13 +2331,12 @@ proc visiblerows {} { proc layoutmore {} { global rowlaidout rowoptim commitidx numcommits optim_delay - global uparrowlen + global uparrowlen curview set row $rowlaidout - set rowlaidout [layoutrows $row $commitidx 0] + set rowlaidout [layoutrows $row $commitidx($curview) 0] set orow [expr {$rowlaidout - $uparrowlen - 1}] if {$orow > $rowoptim} { - checkcrossings $rowoptim $orow optimize_rows $rowoptim 0 $orow set rowoptim $orow } @@ -955,8 +2347,8 @@ proc layoutmore {} { } proc showstuff {canshow} { - global numcommits - global linesegends idrowranges idrangedrawn + global numcommits commitrow pending_select selectedline + global linesegends idrowranges idrangedrawn curview if {$numcommits == 0} { global phase @@ -969,17 +2361,16 @@ proc showstuff {canshow} { set rows [visiblerows] set r0 [lindex $rows 0] set r1 [lindex $rows 1] + set selrow -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 - } + foreach id [lindex $linesegends [expr {$r+1}]] { + set i -1 + foreach {s e} [rowranges $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 } } } @@ -991,6 +2382,14 @@ proc showstuff {canshow} { drawcmitrow $row incr row } + if {[info exists pending_select] && + [info exists commitrow($curview,$pending_select)] && + $commitrow($curview,$pending_select) < $numcommits} { + selectline $commitrow($curview,$pending_select) 1 + } + if {![info exists selectedline] && ![info exists pending_select]} { + selectline 0 1 + } } proc layoutrows {row endrow last} { @@ -998,8 +2397,8 @@ proc layoutrows {row endrow last} { global uparrowlen downarrowlen maxwidth mingaplen global childlist parentlist global idrowranges linesegends - global commitidx - global idinlist rowchk + global commitidx curview + global idinlist rowchk rowrangelist set idlist [lindex $rowidlist $row] set offs [lindex $rowoffsets $row] @@ -1014,10 +2413,12 @@ proc layoutrows {row endrow last} { lappend oldolds $p } } + set lse {} set nev [expr {[llength $idlist] + [llength $newolds] + [llength $oldolds] - $maxwidth + 1}] if {$nev > 0} { - if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break + if {!$last && + $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break for {set x [llength $idlist]} {[incr x -1] >= 0} {} { set i [lindex $idlist $x] if {![info exists rowchk($i)] || $row >= $rowchk($i)} { @@ -1029,7 +2430,7 @@ proc layoutrows {row endrow last} { set offs [incrange $offs $x 1] set idinlist($i) 0 set rm1 [expr {$row - 1}] - lappend linesegends($rm1) $i + lappend lse $i lappend idrowranges($i) $rm1 if {[incr nev -1] <= 0} break continue @@ -1040,6 +2441,7 @@ proc layoutrows {row endrow last} { lset rowidlist $row $idlist lset rowoffsets $row $offs } + lappend linesegends $lse set col [lsearch -exact $idlist $id] if {$col < 0} { set col [llength $idlist] @@ -1058,9 +2460,13 @@ proc layoutrows {row endrow last} { } else { unset idinlist($id) } + set ranges {} if {[info exists idrowranges($id)]} { - lappend idrowranges($id) $row + set ranges $idrowranges($id) + lappend ranges $row + unset idrowranges($id) } + lappend rowrangelist $ranges incr row set offs [ntimes [llength $idlist] 0] set l [llength $newolds] @@ -1101,29 +2507,28 @@ proc layoutrows {row endrow last} { proc addextraid {id row} { global displayorder commitrow commitinfo global commitidx commitlisted - global parentlist childlist children + global parentlist childlist children curview - incr commitidx + incr commitidx($curview) lappend displayorder $id lappend commitlisted 0 lappend parentlist {} - set commitrow($id) $row + set commitrow($curview,$id) $row readcommit $id if {![info exists commitinfo($id)]} { set commitinfo($id) {"No commit information available"} } - if {[info exists children($id)]} { - lappend childlist $children($id) - } else { - lappend childlist {} + if {![info exists children($curview,$id)]} { + set children($curview,$id) {} } + lappend childlist $children($curview,$id) } proc layouttail {} { - global rowidlist rowoffsets idinlist commitidx - global idrowranges + global rowidlist rowoffsets idinlist commitidx curview + global idrowranges rowrangelist - set row $commitidx + set row $commitidx($curview) set idlist [lindex $rowidlist $row] while {$idlist ne {}} { set col [expr {[llength $idlist] - 1}] @@ -1131,6 +2536,8 @@ proc layouttail {} { addextraid $id $row unset idinlist($id) lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) + unset idrowranges($id) incr row set offs [ntimes $col 0] set idlist [lreplace $idlist $col $col] @@ -1144,6 +2551,8 @@ proc layouttail {} { lset rowoffsets $row 0 makeuparrow $id 0 $row 0 lappend idrowranges($id) $row + lappend rowrangelist $idrowranges($id) + unset idrowranges($id) incr row lappend rowidlist {} lappend rowoffsets {} @@ -1160,7 +2569,7 @@ proc insert_pad {row col npad} { } proc optimize_rows {row col endrow} { - global rowidlist rowoffsets idrowranges linesegends displayorder + global rowidlist rowoffsets idrowranges displayorder for {} {$row < $endrow} {incr row} { set idlist [lindex $rowidlist $row] @@ -1179,8 +2588,8 @@ proc optimize_rows {row col endrow} { 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 ranges [rowranges $id] + if {$ranges ne {} && $y0 > [lindex $ranges 0]} { set isarrow 1 } } @@ -1238,8 +2647,8 @@ proc optimize_rows {row col endrow} { 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]} { + set ranges [rowranges $id] + if {$ranges ne {} && $row == [lindex $ranges 0]} { # it is, work out offset to child set y0 [expr {$row - 1}] set id [lindex $displayorder $y0] @@ -1293,13 +2702,36 @@ proc linewidth {id} { return $wid } +proc rowranges {id} { + global phase idrowranges commitrow rowlaidout rowrangelist curview + + set ranges {} + if {$phase eq {} || + ([info exists commitrow($curview,$id)] + && $commitrow($curview,$id) < $rowlaidout)} { + set ranges [lindex $rowrangelist $commitrow($curview,$id)] + } elseif {[info exists idrowranges($id)]} { + set ranges $idrowranges($id) + } + return $ranges +} + proc drawlineseg {id i} { - global rowoffsets rowidlist idrowranges + global rowoffsets rowidlist global displayorder global canv colormap linespc + global numcommits commitrow curview - set startrow [lindex $idrowranges($id) [expr {2 * $i}]] - set row [lindex $idrowranges($id) [expr {2 * $i + 1}]] + set ranges [rowranges $id] + set downarrow 1 + if {[info exists commitrow($curview,$id)] + && $commitrow($curview,$id) < $numcommits} { + set downarrow [expr {$i < [llength $ranges] / 2 - 1}] + } else { + set downarrow 1 + } + set startrow [lindex $ranges [expr {2 * $i}]] + set row [lindex $ranges [expr {2 * $i + 1}]] if {$startrow == $row} return assigncolor $id set coords {} @@ -1343,8 +2775,7 @@ proc drawlineseg {id i} { } } if {[llength $coords] < 4} return - set last [expr {[llength $idrowranges($id)] / 2 - 1}] - if {$i < $last} { + if {$downarrow} { # 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. @@ -1364,7 +2795,7 @@ proc drawlineseg {id i} { } } } - set arrow [expr {2 * ($i > 0) + ($i < $last)}] + set arrow [expr {2 * ($i > 0) + $downarrow}] 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] @@ -1373,7 +2804,7 @@ proc drawlineseg {id i} { } proc drawparentlinks {id row col olds} { - global rowidlist canv colormap idrowranges + global rowidlist canv colormap set row2 [expr {$row + 1}] set x [xc $row $col] @@ -1392,9 +2823,9 @@ proc drawparentlinks {id row col olds} { if {$x2 > $rmx} { set rmx $x2 } - if {[info exists idrowranges($p)] && - $row2 == [lindex $idrowranges($p) 0] && - $row2 < [lindex $idrowranges($p) 1]} { + set ranges [rowranges $p] + if {$ranges ne {} && $row2 == [lindex $ranges 0] + && $row2 < [lindex $ranges 1]} { # drawlineseg will do this one for us continue } @@ -1417,19 +2848,19 @@ proc drawparentlinks {id row col olds} { proc drawlines {id} { global colormap canv - global idrowranges idrangedrawn - global childlist iddrawn commitrow rowidlist + global idrangedrawn + global children iddrawn commitrow rowidlist curview $canv delete lines.$id - set nr [expr {[llength $idrowranges($id)] / 2}] + set nr [expr {[llength [rowranges $id]] / 2}] for {set i 0} {$i < $nr} {incr i} { if {[info exists idrangedrawn($id,$i)]} { drawlineseg $id $i } } - foreach child [lindex $childlist $commitrow($id)] { + foreach child $children($curview,$id) { if {[info exists iddrawn($child)]} { - set row $commitrow($child) + set row $commitrow($curview,$child) set col [lsearch -exact [lindex $rowidlist $row] $child] if {$col >= 0} { drawparentlinks $child $row $col [list $id] @@ -1443,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 namefont canvxmax + global mainfont canvxmax boldrows boldnamerows set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}] set x [xc $row $col] @@ -1468,11 +2899,22 @@ proc drawcmittext {id row col rmx} { set name [lindex $commitinfo($id) 1] set date [lindex $commitinfo($id) 2] set date [formatdate $date] + set font $mainfont + 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 + } + } set linehtag($row) [$canv create text $xt $y -anchor w \ - -text $headline -font $mainfont ] + -text $headline -font $font] $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id" set linentag($row) [$canv2 create text 3 $y -anchor w \ - -text $name -font $namefont] + -text $name -font $nfont] set linedtag($row) [$canv3 create text 3 $y -anchor w \ -text $date -font $mainfont] set xr [expr {$xt + [font measure $mainfont $headline]}] @@ -1484,14 +2926,17 @@ proc drawcmittext {id row col rmx} { proc drawcmitrow {row} { global displayorder rowidlist - global idrowranges idrangedrawn iddrawn + global idrangedrawn iddrawn 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] { - if {![info exists idrowranges($id)]} continue + if {$id eq {}} continue set i -1 - foreach {s e} $idrowranges($id) { + foreach {s e} [rowranges $id] { incr i if {$row < $s} continue if {$e eq {}} break @@ -1506,6 +2951,18 @@ proc drawcmitrow {row} { } set id [lindex $displayorder $row] + if {[info exists hlview] && ![info exists vhighlights($row)]} { + askvhighlight $row $id + } + if {[info exists filehighlight] && ![info exists fhighlights($row)]} { + askfilehighlight $row $id + } + 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} { @@ -1554,68 +3011,101 @@ proc drawvisible {} { proc clear_display {} { global iddrawn idrangedrawn + global vhighlights fhighlights nhighlights rhighlights allcanvs delete all catch {unset iddrawn} catch {unset idrangedrawn} + catch {unset vhighlights} + catch {unset fhighlights} + catch {unset nhighlights} + catch {unset rhighlights} +} + +proc findcrossings {id} { + global rowidlist parentlist numcommits rowoffsets displayorder + + set cross {} + set ccross {} + foreach {s e} [rowranges $id] { + if {$e >= $numcommits} { + set e [expr {$numcommits - 1}] + } + if {$e <= $s} continue + set x [lsearch -exact [lindex $rowidlist $e] $id] + if {$x < 0} { + puts "findcrossings: oops, no [shortids $id] in row $e" + continue + } + for {set row $e} {[incr row -1] >= $s} {} { + set olds [lindex $parentlist $row] + set kid [lindex $displayorder $row] + set kidx [lsearch -exact [lindex $rowidlist $row] $kid] + if {$kidx < 0} continue + set nextrow [lindex $rowidlist [expr {$row + 1}]] + foreach p $olds { + set px [lsearch -exact $nextrow $p] + if {$px < 0} continue + if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} { + if {[lsearch -exact $ccross $p] >= 0} continue + if {$x == $px + ($kidx < $px? -1: 1)} { + lappend ccross $p + } elseif {[lsearch -exact $cross $p] < 0} { + lappend cross $p + } + } + } + set inc [lindex $rowoffsets $row $x] + if {$inc eq {}} break + incr x $inc + } + } + return [concat $ccross {{}} $cross] } proc assigncolor {id} { global colormap colors nextcolor - global commitrow parentlist children childlist - global cornercrossings crossings + global commitrow parentlist children children curview if {[info exists colormap($id)]} return set ncolors [llength $colors] - if {[info exists commitrow($id)]} { - set kids [lindex $childlist $commitrow($id)] - } elseif {[info exists children($id)]} { - set kids $children($id) + if {[info exists children($curview,$id)]} { + set kids $children($curview,$id) } else { set kids {} } if {[llength $kids] == 1} { set child [lindex $kids 0] if {[info exists colormap($child)] - && [llength [lindex $parentlist $commitrow($child)]] == 1} { + && [llength [lindex $parentlist $commitrow($curview,$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) - } + set origbad {} + foreach x [findcrossings $id] { + if {$x eq {}} { + # delimiter between corner crossings and other crossings + if {[llength $badcolors] >= $ncolors - 1} break + set origbad $badcolors } - if {[llength $badcolors] >= $ncolors} { - set badcolors {} + if {[info exists colormap($x)] + && [lsearch -exact $badcolors $colormap($x)] < 0} { + lappend badcolors $colormap($x) } } - 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} { + set badcolors $origbad } + set origbad $badcolors if {[llength $badcolors] < $ncolors - 1} { foreach child $kids { if {[info exists colormap($child)] && [lsearch -exact $badcolors $colormap($child)] < 0} { lappend badcolors $colormap($child) } - foreach p [lindex $parentlist $commitrow($child)] { + foreach p [lindex $parentlist $commitrow($curview,$child)] { if {[info exists colormap($p)] && [lsearch -exact $badcolors $colormap($p)] < 0} { lappend badcolors $colormap($p) @@ -1648,7 +3138,7 @@ proc bindline {t id} { proc drawtags {id x xt y1} { global idtags idheads idotherrefs global linespc lthickness - global canv mainfont commitrow rowtextx + global canv mainfont commitrow rowtextx curview set marks {} set ntags 0 @@ -1691,7 +3181,7 @@ proc drawtags {id x xt y1} { $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}] + set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}] } else { # draw a head or other ref if {[incr nheads -1] >= 0} { @@ -1702,6 +3192,14 @@ proc drawtags {id x xt y1} { 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 + if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} { + set rwid [font measure $mainfont $remoteprefix] + set xi [expr {$x + 1}] + set yti [expr {$yt + 1}] + set xri [expr {$x + $rwid}] + $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \ + -width 0 -fill "#ffddaa" -tags tag.$id + } } set t [$canv create text $xl $y1 -anchor w -text $tag \ -font $mainfont -tags tag.$id] @@ -1712,55 +3210,6 @@ proc drawtags {id x xt y1} { return $xt } -proc checkcrossings {row endrow} { - global displayorder parentlist 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 [lindex $parentlist $row] { - 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 @@ -1773,23 +3222,25 @@ proc xcoord {i level ln} { return $x } +proc show_status {msg} { + global canv mainfont + + clear_display + $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems +} + proc finishcommits {} { - global commitidx phase + global commitidx phase curview global canv mainfont ctext maincursor textcursor - global findinprogress + global findinprogress pending_select - if {$commitidx > 0} { + if {$commitidx($curview) > 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 + show_status "No commits selected" } set phase {} + catch {unset pending_select} } # Don't change the text pane cursor if it is currently the hand cursor, @@ -1803,17 +3254,41 @@ proc settextcursor {c} { set curtextcursor $c } +proc nowbusy {what} { + global isbusy + + if {[array names isbusy] eq {}} { + . config -cursor watch + settextcursor watch + } + set isbusy($what) 1 +} + +proc notbusy {what} { + global isbusy maincursor textcursor + + catch {unset isbusy($what)} + if {[array names isbusy] eq {}} { + . config -cursor $maincursor + settextcursor $textcursor + } +} + proc drawrest {} { global numcommits global startmsecs global canvy0 numcommits linespc - global rowlaidout commitidx + global rowlaidout commitidx curview + global pending_select set row $rowlaidout - layoutrows $rowlaidout $commitidx 1 + layoutrows $rowlaidout $commitidx($curview) 1 layouttail - optimize_rows $row 0 $commitidx - showstuff $commitidx + optimize_rows $row 0 $commitidx($curview) + showstuff $commitidx($curview) + if {[info exists pending_select]} { + selectline 0 1 + } set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}] #puts "overall $drawmsecs ms for $numcommits commits" @@ -1842,18 +3317,15 @@ proc findmatches {f} { proc dofind {} { global findtype findloc findstring markedmatches commitinfo global numcommits displayorder linehtag linentag linedtag - global mainfont namefont canv canv2 canv3 selectedline + global mainfont canv canv2 canv3 selectedline global matchinglines foundstring foundstrlen matchstring global commitdata stopfindproc unmarkmatches + cancel_next_highlight focus . set matchinglines {} - if {$findloc == "Pickaxe"} { - findpatches - return - } if {$findtype == "IgnCase"} { set foundstring [string tolower $findstring] } else { @@ -1863,17 +3335,13 @@ proc dofind {} { 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 - set fldtypes {Headline Author Date Committer CDate Comment} + set fldtypes {Headline Author Date Committer CDate Comments} set l -1 foreach id $displayorder { set d $commitdata($id) @@ -1903,7 +3371,7 @@ proc dofind {} { markmatches $canv $l $f $linehtag($l) $matches $mainfont } elseif {$ty == "Author"} { drawcmitrow $l - markmatches $canv2 $l $f $linentag($l) $matches $namefont + markmatches $canv2 $l $f $linentag($l) $matches $mainfont } elseif {$ty == "Date"} { drawcmitrow $l markmatches $canv3 $l $f $linedtag($l) $matches $mainfont @@ -1976,18 +3444,6 @@ 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 @@ -2001,256 +3457,8 @@ proc stopfindproc {{done 0}} { 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 parentlist - 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 || [llength [lindex $parentlist $l]] == 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 - 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 - } - incr fdiffpos - } - incr fdiffpos - - if {![info exists treediffs($fdiffid)]} { - set treediffs($fdiffid) $fdiffs - } - if {[info exists findid] && $fdiffid eq $findid} { - unset findid - findcont - } - } -} - -proc findcont {} { - global findid treediffs parentlist - global ffileline findstartline finddidsel - global displayorder numcommits matchinglines findinprogress - global findmergefiles - - set l $ffileline - while {1} { - set id [lindex $displayorder $l] - if {$findmergefiles || [llength [lindex $parentlist $l]] == 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 - } - stopfindproc - if {!$finddidsel} { - bell - } + catch {unset findinprogress} + notbusy find } # mark a commit as matching by putting a yellow background @@ -2310,31 +3518,34 @@ proc selcanvline {w x y} { proc commit_descriptor {p} { global commitinfo + if {![info exists commitinfo($p)]} { + getcommit $p + } set l "..." - if {[info exists commitinfo($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} { - global ctext commitrow linknum +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] set e [lindex $l 1] set linkid [string range $text $s $e] - if {![info exists commitrow($linkid)]} continue + if {![info exists commitrow($curview,$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] + $ctext tag bind link$linknum <1> \ + [list selectline $commitrow($curview,$linkid) 1] incr linknum } $ctext tag conf link -foreground blue -underline 1 @@ -2358,16 +3569,77 @@ 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 <Enter> { %W configure -cursor hand2 } + $ctext tag bind $lk <Leave> { %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 global canvy0 linespc parentlist childlist - global cflist currentid sha1entry + global currentid sha1entry global commentend idtags linknum - global mergemax numcommits + global mergemax numcommits pending_select + 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] @@ -2431,12 +3703,11 @@ proc selectline {l isnew} { $sha1entry insert 0 $id $sha1entry selection from 0 $sha1entry selection to end + rhighlight_sel $id $ctext conf -state normal - $ctext delete 0.0 end + clear_ctext set linknum 0 - $ctext mark set fmark.0 0.0 - $ctext mark gravity fmark.0 left set info $commitinfo($id) set date [formatdate [lindex $info 2]] $ctext insert end "Author: [lindex $info 1] $date\n" @@ -2450,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 @@ -2461,32 +3732,60 @@ 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 $ctext conf -state disabled set commentend [$ctext index "end - 1c"] - $cflist delete 0 end - $cflist insert end "Comments" - if {[llength $olds] <= 1} { + init_flist "Comments" + if {$cmitmode eq "tree"} { + gettree $id + } elseif {[llength $olds] <= 1} { startdiff $id } else { mergediff $id $l @@ -2521,6 +3820,7 @@ proc selnextpage {dir} { set lpp 1 } allcanvs yview scroll [expr {$dir * $lpp}] units + drawvisible if {![info exists selectedline]} return set l [expr {$selectedline + $dir * $lpp}] if {$l < 0} { @@ -2533,24 +3833,36 @@ proc selnextpage {dir} { } proc unselectline {} { - global selectedline + global selectedline currentid catch {unset selectedline} + catch {unset currentid} allcanvs delete secsel + rhighlight_none + cancel_next_highlight +} + +proc reselectline {} { + global selectedline + + if {[info exists selectedline]} { + selectline $selectedline 0 + } } proc addtohistory {cmd} { - global history historyindex + global history historyindex curview + set elt [list $curview $cmd] if {$historyindex > 0 - && [lindex $history [expr {$historyindex - 1}]] == $cmd} { + && [lindex $history [expr {$historyindex - 1}]] == $elt} { return } if {$historyindex < [llength $history]} { - set history [lreplace $history $historyindex end $cmd] + set history [lreplace $history $historyindex end $elt] } else { - lappend history $cmd + lappend history $elt } incr historyindex if {$historyindex > 1} { @@ -2561,13 +3873,23 @@ proc addtohistory {cmd} { .ctop.top.bar.rightbut conf -state disabled } +proc godo {elt} { + global curview + + set view [lindex $elt 0] + set cmd [lindex $elt 1] + if {$curview != $view} { + showview $view + } + eval $cmd +} + proc goback {} { global history historyindex if {$historyindex > 1} { incr historyindex -1 - set cmd [lindex $history [expr {$historyindex - 1}]] - eval $cmd + godo [lindex $history [expr {$historyindex - 1}]] .ctop.top.bar.rightbut conf -state normal } if {$historyindex <= 1} { @@ -2581,7 +3903,7 @@ proc goforw {} { if {$historyindex < [llength $history]} { set cmd [lindex $history $historyindex] incr historyindex - eval $cmd + godo $cmd .ctop.top.bar.leftbut conf -state normal } if {$historyindex >= [llength $history]} { @@ -2589,17 +3911,104 @@ proc goforw {} { } } +proc gettree {id} { + global treefilelist treeidlist diffids diffmergeid treepending + + set diffids $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]}]} { + return + } + set treepending $id + set treefilelist($id) {} + set treeidlist($id) {} + fconfigure $gtf -blocking 0 + fileevent $gtf readable [list gettreeline $gtf $id] + } + } else { + setfilelist $id + } +} + +proc gettreeline {gtf id} { + global treefilelist treeidlist treepending cmitmode diffids + + while {[gets $gtf line] >= 0} { + if {[lindex $line 1] ne "blob"} continue + set sha1 [lindex $line 2] + set fname [lindex $line 3] + lappend treefilelist($id) $fname + lappend treeidlist($id) $sha1 + } + if {![eof $gtf]} return + close $gtf + unset treepending + if {$cmitmode ne "tree"} { + if {![info exists diffmergeid]} { + gettreediffs $diffids + } + } elseif {$id ne $diffids} { + gettree $diffids + } else { + setfilelist $id + } +} + +proc showfile {f} { + global treefilelist treeidlist diffids + global ctext commentend + + set i [lsearch -exact $treefilelist($diffids) $f] + if {$i < 0} { + puts "oops, $f not in list for id $diffids" + return + } + set blob [lindex $treeidlist($diffids) $i] + if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} { + puts "oops, error reading blob $blob: $err" + return + } + fconfigure $bf -blocking 0 + fileevent $bf readable [list getblobline $bf $diffids] + $ctext config -state normal + clear_ctext $commentend + $ctext insert end "\n" + $ctext insert end "$f\n" filesep + $ctext config -state disabled + $ctext yview $commentend +} + +proc getblobline {bf id} { + global diffids cmitmode ctext + + if {$id ne $diffids || $cmitmode ne "tree"} { + catch {close $bf} + return + } + $ctext config -state normal + while {[gets $bf line] >= 0} { + $ctext insert end "$line\n" + } + if {[eof $bf]} { + # delete last newline + $ctext delete "end - 2c" "end - 1c" + close $bf + } + $ctext config -state disabled +} + proc mergediff {id l} { global diffmergeid diffopts mdifffd - global difffilestart diffids + global diffids global parentlist 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] + 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 @@ -2631,11 +4040,8 @@ proc getmergediffline {mdf id np} { # 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 + lappend difffilestart $here + add_flist [list $fname] set l [expr {(78 - [string length $fname]) / 2}] set pad [string range "----------------------------------------" 1 $l] $ctext insert end "$pad $fname $pad\n" filesep @@ -2705,9 +4111,7 @@ proc startdiff {ids} { proc addtocflist {ids} { global treediffs cflist - foreach f $treediffs($ids) { - $cflist insert end $f - } + add_flist $treediffs($ids) getblobdiffs $ids } @@ -2716,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] @@ -2724,6 +4128,7 @@ proc gettreediffs {ids} { proc gettreediffline {gdtf ids} { global treediff treediffs treepending diffids diffmergeid + global cmitmode set n [gets $gdtf line] if {$n < 0} { @@ -2731,7 +4136,9 @@ proc gettreediffline {gdtf ids} { close $gdtf set treediffs($ids) $treediff unset treepending - if {$ids != $diffids} { + if {$cmitmode eq "tree"} { + gettree $diffids + } elseif {$ids != $diffids} { if {![info exists diffmergeid]} { gettreediffs $diffids } @@ -2746,10 +4153,10 @@ proc gettreediffline {gdtf ids} { proc getblobdiffs {ids} { global diffopts blobdifffd diffids env curdifftag curtagstart - global difffilestart nextupdate diffinhdr treediffs + 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 @@ -2759,11 +4166,23 @@ proc getblobdiffs {ids} { set blobdifffd($ids) $bdf set curdifftag Comments set curtagstart 0.0 - catch {unset difffilestart} fileevent $bdf readable [list getblobdiffline $bdf $diffids] set nextupdate [expr {[clock clicks -milliseconds] + 100}] } +proc setinlist {var i val} { + global $var + + while {[llength [set $var]] < $i} { + lappend $var {} + } + if {[llength [set $var]] == $i} { + lappend $var $val + } else { + lset $var $i $val + } +} + proc getblobdiffline {bdf ids} { global diffids blobdifffd ctext curdifftag curtagstart global diffnexthead diffnextnote difffilestart @@ -2787,23 +4206,17 @@ proc getblobdiffline {bdf ids} { # 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] + set curtagstart $here + set header $newname + set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { - set difffilestart($i) $here - incr i - $ctext mark set fmark.$i $here - $ctext mark gravity fmark.$i left + setinlist difffilestart $i $here } - if {$newname != $fname} { - set i [lsearch -exact $treediffs($diffids) $newname] + if {$newname ne $fname} { + set i [lsearch -exact $treediffs($ids) $newname] if {$i >= 0} { - set difffilestart($i) $here - incr i - $ctext mark set fmark.$i $here - $ctext mark gravity fmark.$i left + setinlist difffilestart $i $here } } set curdifftag "f:$fname" @@ -2853,26 +4266,143 @@ proc getblobdiffline {bdf ids} { 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) - } + foreach loc $difffilestart { + if {[$ctext compare $loc > $here]} { + $ctext yview $loc } } - if {[info exists pos]} { - $ctext yview $pos +} + +proc clear_ctext {{first 1.0}} { + global ctext smarktop smarkbot + + set l [lindex [split $first .] 0] + if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} { + set smarktop $l + } + if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} { + set smarkbot $l } + $ctext delete $first end } -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 incrsearch {name ix op} { + global ctext searchstring searchdirn + + $ctext tag remove found 1.0 end + if {[catch {$ctext index anchor}]} { + # no anchor set, use start of selection, or of visible area + set sel [$ctext tag ranges sel] + if {$sel ne {}} { + $ctext mark set anchor [lindex $sel 0] + } elseif {$searchdirn eq "-forwards"} { + $ctext mark set anchor @0,0 + } else { + $ctext mark set anchor @0,[winfo height $ctext] + } + } + if {$searchstring ne {}} { + set here [$ctext search $searchdirn -- $searchstring anchor] + if {$here ne {}} { + $ctext see $here + } + searchmarkvisible 1 + } +} + +proc dosearch {} { + global sstring ctext searchstring searchdirn + + focus $sstring + $sstring icursor end + set searchdirn -forwards + if {$searchstring ne {}} { + set sel [$ctext tag ranges sel] + if {$sel ne {}} { + set start "[lindex $sel 0] + 1c" + } elseif {[catch {set start [$ctext index anchor]}]} { + set start "@0,0" + } + set match [$ctext search -count mlen -- $searchstring $start] + $ctext tag remove sel 1.0 end + if {$match eq {}} { + bell + return + } + $ctext see $match + set mend "$match + $mlen c" + $ctext tag add sel $match $mend + $ctext mark unset anchor + } +} + +proc dosearchback {} { + global sstring ctext searchstring searchdirn + + focus $sstring + $sstring icursor end + set searchdirn -backwards + if {$searchstring ne {}} { + set sel [$ctext tag ranges sel] + if {$sel ne {}} { + set start [lindex $sel 0] + } elseif {[catch {set start [$ctext index anchor]}]} { + set start @0,[winfo height $ctext] + } + set match [$ctext search -backwards -count ml -- $searchstring $start] + $ctext tag remove sel 1.0 end + if {$match eq {}} { + bell + return + } + $ctext see $match + set mend "$match + $ml c" + $ctext tag add sel $match $mend + $ctext mark unset anchor + } +} + +proc searchmark {first last} { + global ctext searchstring + + set mend $first.0 + while {1} { + set match [$ctext search -count mlen -- $searchstring $mend $last.end] + if {$match eq {}} break + set mend "$match + $mlen c" + $ctext tag add found $match $mend + } +} + +proc searchmarkvisible {doall} { + global ctext smarktop smarkbot + + set topline [lindex [split [$ctext index @0,0] .] 0] + set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0] + if {$doall || $botline < $smarktop || $topline > $smarkbot} { + # no overlap with previous + searchmark $topline $botline + set smarktop $topline + set smarkbot $botline + } else { + if {$topline < $smarktop} { + searchmark $topline [expr {$smarktop-1}] + set smarktop $topline + } + if {$botline > $smarkbot} { + searchmark [expr {$smarkbot+1}] $botline + set smarkbot $botline + } + } +} + +proc scrolltext {f0 f1} { + global searchstring + + .ctop.cdet.left.sb set $f0 $f1 + if {$searchstring ne {}} { + searchmarkvisible 0 + } } proc setcoords {} { @@ -2905,11 +4435,10 @@ proc redisplay {} { } proc incrfont {inc} { - global mainfont namefont textfont ctext canv phase + global mainfont 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}]] set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] setcoords $ctext conf -font $textfont @@ -2917,7 +4446,7 @@ proc incrfont {inc} { foreach e $entries { $e conf -font $mainfont } - if {$phase == "getcommits"} { + if {$phase eq "getcommits"} { $canv itemconf textitems -font $mainfont } redisplay @@ -2948,7 +4477,7 @@ proc sha1change {n1 n2 op} { proc gotocommit {} { global sha1string currentid commitrow tagids headids - global displayorder numcommits + global displayorder numcommits curview if {$sha1string == {} || ([info exists currentid] && $sha1string == $currentid)} return @@ -2974,8 +4503,8 @@ proc gotocommit {} { } } } - if {[info exists commitrow($id)]} { - selectline $commitrow($id) 1 + if {[info exists commitrow($curview,$id)]} { + selectline $commitrow($curview,$id) 1 return } if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { @@ -3050,12 +4579,13 @@ proc linehover {} { } proc clickisonarrow {id y} { - global lthickness idrowranges + global lthickness + set ranges [rowranges $id] set thresh [expr {2 * $lthickness + 6}] - set n [expr {[llength $idrowranges($id)] - 1}] + set n [expr {[llength $ranges] - 1}] for {set i 1} {$i < $n} {incr i} { - set row [lindex $idrowranges($id) $i] + set row [lindex $ranges $i] if {abs([yc $row] - $y) < $thresh} { return $i } @@ -3064,11 +4594,11 @@ proc clickisonarrow {id y} { } proc arrowjump {id n y} { - global idrowranges canv + global canv # 1 <-> 2, 3 <-> 4, etc... set n [expr {(($n - 1) ^ 1) + 1}] - set row [lindex $idrowranges($id) $n] + set row [lindex [rowranges $id] $n] set yt [yc $row] set ymax [lindex [$canv cget -scrollregion] 3] if {$ymax eq {} || $ymax <= 0} return @@ -3082,7 +4612,7 @@ proc arrowjump {id n y} { } proc lineclick {x y id isnew} { - global ctext commitinfo childlist commitrow cflist canv thickerline + global ctext commitinfo children canv thickerline curview if {![info exists commitinfo($id)] && ![getcommit $id]} return unmarkmatches @@ -3109,7 +4639,7 @@ proc lineclick {x y id isnew} { } # fill the details pane with info about this line $ctext conf -state normal - $ctext delete 0.0 end + clear_ctext $ctext tag conf link -foreground blue -underline 1 $ctext tag bind link <Enter> { %W configure -cursor hand2 } $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } @@ -3121,7 +4651,7 @@ proc lineclick {x y id isnew} { $ctext insert end "\tAuthor:\t[lindex $info 1]\n" set date [formatdate [lindex $info 2]] $ctext insert end "\tDate:\t$date\n" - set kids [lindex $childlist $commitrow($id)] + set kids $children($curview,$id) if {$kids ne {}} { $ctext insert end "\nChildren:" set i 0 @@ -3139,8 +4669,7 @@ proc lineclick {x y id isnew} { } } $ctext conf -state disabled - - $cflist delete 0 end + init_flist {} } proc normalline {} { @@ -3153,9 +4682,9 @@ proc normalline {} { } proc selbyid {id} { - global commitrow - if {[info exists commitrow($id)]} { - selectline $commitrow($id) 1 + global commitrow curview + if {[info exists commitrow($curview,$id)]} { + selectline $commitrow($curview,$id) 1 } } @@ -3168,9 +4697,10 @@ proc mstime {} { } proc rowmenu {x y id} { - global rowctxmenu commitrow selectedline rowmenuid + global rowctxmenu commitrow selectedline rowmenuid curview - if {![info exists selectedline] || $commitrow($id) eq $selectedline} { + if {![info exists selectedline] + || $commitrow($curview,$id) eq $selectedline} { set state disabled } else { set state normal @@ -3198,15 +4728,12 @@ proc diffvssel {dirn} { } proc doseldiff {oldid newid} { - global ctext cflist + global ctext 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" + clear_ctext + init_flist "Top" $ctext insert end "From " $ctext tag conf link -foreground blue -underline 1 $ctext tag bind link <Enter> { %W configure -cursor hand2 } @@ -3298,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} @@ -3373,14 +4900,22 @@ proc domktag {} { } proc redrawtags {id} { - global canv linehtag commitrow idpos selectedline + global canv linehtag commitrow idpos selectedline curview + global mainfont - if {![info exists commitrow($id)]} return - drawcmitrow $commitrow($id) + 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($id)) $xt [lindex $idpos($id) 2] - if {[info exists selectedline] && $selectedline == $commitrow($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 } } @@ -3452,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 $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." + } } - return [list $x $y $z] +} + +# 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 {} { @@ -3491,23 +5196,41 @@ 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 cflist tagcontents tagids linknum + global ctext tagcontents tagids linknum if {$isnew} { addtohistory [list showtag $tag 0] } $ctext conf -state normal - $ctext delete 0.0 end + clear_ctext set linknum 0 if {[info exists tagcontents($tag)]} { set text $tagcontents($tag) } else { set text "Tag: $tag\nId: $tagids($tag)" } - appendwithlinks $text + appendwithlinks $text {} $ctext conf -state disabled - $cflist delete 0 end + init_flist {} } proc doquit {} { @@ -3517,8 +5240,8 @@ proc doquit {} { } proc doprefs {} { - global maxwidth maxgraphpct diffopts findmergefiles - global oldprefs prefstop + global maxwidth maxgraphpct diffopts + global oldprefs prefstop showneartags set top .gitkprefs set prefstop $top @@ -3526,7 +5249,7 @@ proc doprefs {} { raise $top return } - foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set oldprefs($v) [set $v] } toplevel $top @@ -3542,16 +5265,17 @@ proc doprefs {} { -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.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 @@ -3562,10 +5286,10 @@ proc doprefs {} { } proc prefscan {} { - global maxwidth maxgraphpct diffopts findmergefiles - global oldprefs prefstop + global maxwidth maxgraphpct diffopts + global oldprefs prefstop showneartags - foreach v {maxwidth maxgraphpct diffopts findmergefiles} { + foreach v {maxwidth maxgraphpct diffopts showneartags} { set $v $oldprefs($v) } catch {destroy $prefstop} @@ -3574,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 } } @@ -3864,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" @@ -3889,13 +5615,14 @@ set fastdate 0 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} catch {source ~/.gitk} -set namefont $mainfont - font create optionfont -family sans-serif -size -12 set revtreeargs {} @@ -3912,19 +5639,83 @@ foreach arg $argv { # check that we can find a .git directory somewhere... set gitdir [gitdir] if {![file isdirectory $gitdir]} { - error_popup "Cannot find the git directory \"$gitdir\"." + show_error {} . "Cannot find the git directory \"$gitdir\"." exit 1 } +set cmdline_files {} +set i [lsearch -exact $revtreeargs "--"] +if {$i >= 0} { + set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end] + 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 cmdline_files [split $f "\n"] + set n [llength $cmdline_files] + set revtreeargs [lrange $revtreeargs 0 end-$n] + } err]} { + # unfortunately we get both stdout and stderr in $err, + # so look for "fatal:". + set i [string first "fatal:" $err] + if {$i > 0} { + set err [string range $err [expr {$i + 6}] end] + } + show_error {} . "Bad arguments to gitk:\n$err" + exit 1 + } +} + set history {} set historyindex 0 +set fh_serial 0 +set nhl_names {} +set highlight_paths {} +set searchdirn -forwards +set boldrows {} +set boldnamerows {} set optim_delay 16 +set nextviewnum 1 +set curview 0 +set selectedview 0 +set selectedhlview None +set viewfiles(0) {} +set viewperm(0) 0 +set viewargs(0) {} + +set cmdlineok 0 set stopped 0 set stuffsaved 0 set patchnum 0 setcoords -makewindow $revtreeargs +makewindow readrefs -getcommits $revtreeargs + +if {$cmdline_files ne {} || $revtreeargs ne {}} { + # create a view for the files/dirs specified on the command line + set curview 1 + set selectedview 1 + set nextviewnum 2 + set viewname(1) "Command line" + set viewfiles(1) $cmdline_files + set viewargs(1) $revtreeargs + set viewperm(1) 0 + addviewmenu 1 + .bar.view entryconf 2 -state normal + .bar.view entryconf 3 -state normal +} + +if {[info exists permviews]} { + foreach v $permviews { + set n $nextviewnum + incr nextviewnum + set viewname($n) [lindex $v 0] + set viewfiles($n) [lindex $v 1] + set viewargs($n) [lindex $v 2] + set viewperm($n) 1 + addviewmenu $n + } +} +getcommits |