2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "${1+$@}"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc getcommits {rargs} {
11 global commits commfd phase canv mainfont env
12 global startmsecs nextupdate
13 global ctext maincursor textcursor leftover
15 # check that we can find a .git directory somewhere...
16 if {[info exists env(GIT_DIR)]} {
17 set gitdir $env(GIT_DIR)
21 if {![file isdirectory $gitdir]} {
22 error_popup "Cannot find the git directory \"$gitdir\"."
27 set startmsecs [clock clicks -milliseconds]
28 set nextupdate [expr $startmsecs + 100]
30 set parse_args [concat --default HEAD $rargs]
31 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
33 # if git-rev-parse failed for some reason...
37 set parsed_args $rargs
40 set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
42 puts stderr "Error executing git-rev-list: $err"
46 fconfigure $commfd -blocking 0 -translation binary
47 fileevent $commfd readable "getcommitlines $commfd"
49 $canv create text 3 3 -anchor nw -text "Reading commits..." \
50 -font $mainfont -tags textitems
51 . config -cursor watch
52 $ctext config -cursor watch
55 proc getcommitlines {commfd} {
56 global commits parents cdate children nchildren
57 global commitlisted phase commitinfo nextupdate
58 global stopped redisplaying leftover
60 set stuff [read $commfd]
62 if {![eof $commfd]} return
63 # this works around what is apparently a bug in Tcl...
64 fconfigure $commfd -blocking 1
65 if {![catch {close $commfd} err]} {
66 after idle finishcommits
69 if {[string range $err 0 4] == "usage"} {
71 {Gitk: error reading commits: bad arguments to git-rev-list.
72 (Note: arguments to gitk are passed to git-rev-list
73 to allow selection of commits to be displayed.)}
75 set err "Error reading commits: $err"
82 set i [string first "\0" $stuff $start]
84 append leftover [string range $stuff $start end]
87 set cmit [string range $stuff $start [expr {$i - 1}]]
89 set cmit "$leftover$cmit"
92 set start [expr {$i + 1}]
93 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
95 if {[string length $shortcmit] > 80} {
96 set shortcmit "[string range $shortcmit 0 80]..."
98 error_popup "Can't parse git-rev-list output: {$shortcmit}"
101 set cmit [string range $cmit 41 end]
103 set commitlisted($id) 1
104 parsecommit $id $cmit 1
106 if {[clock clicks -milliseconds] >= $nextupdate} {
109 while {$redisplaying} {
113 set phase "getcommits"
114 foreach id $commits {
117 if {[clock clicks -milliseconds] >= $nextupdate} {
127 global commfd nextupdate
130 fileevent $commfd readable {}
132 fileevent $commfd readable "getcommitlines $commfd"
135 proc readcommit {id} {
136 if [catch {set contents [exec git-cat-file commit $id]}] return
137 parsecommit $id $contents 0
140 proc parsecommit {id contents listed} {
141 global commitinfo children nchildren parents nparents cdate ncleft
150 if {![info exists nchildren($id)]} {
157 foreach line [split $contents "\n"] {
162 set tag [lindex $line 0]
163 if {$tag == "parent"} {
164 set p [lindex $line 1]
165 if {![info exists nchildren($p)]} {
170 lappend parents($id) $p
172 # sometimes we get a commit that lists a parent twice...
173 if {$listed && [lsearch -exact $children($p) $id] < 0} {
174 lappend children($p) $id
178 } elseif {$tag == "author"} {
179 set x [expr {[llength $line] - 2}]
180 set audate [lindex $line $x]
181 set auname [lrange $line 1 [expr {$x - 1}]]
182 } elseif {$tag == "committer"} {
183 set x [expr {[llength $line] - 2}]
184 set comdate [lindex $line $x]
185 set comname [lrange $line 1 [expr {$x - 1}]]
189 if {$comment == {}} {
190 set headline [string trim $line]
195 # git-rev-list indents the comment by 4 spaces;
196 # if we got this via git-cat-file, add the indentation
203 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
205 if {$comdate != {}} {
206 set cdate($id) $comdate
207 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
209 set commitinfo($id) [list $headline $auname $audate \
210 $comname $comdate $comment]
214 global tagids idtags headids idheads
215 set tags [glob -nocomplain -types f .git/refs/tags/*]
220 if {[regexp {^[0-9a-f]{40}} $line id]} {
221 set direct [file tail $f]
222 set tagids($direct) $id
223 lappend idtags($id) $direct
224 set contents [split [exec git-cat-file tag $id] "\n"]
228 foreach l $contents {
230 switch -- [lindex $l 0] {
231 "object" {set obj [lindex $l 1]}
232 "type" {set type [lindex $l 1]}
233 "tag" {set tag [string range $l 4 end]}
236 if {$obj != {} && $type == "commit" && $tag != {}} {
237 set tagids($tag) $obj
238 lappend idtags($obj) $tag
244 set heads [glob -nocomplain -types f .git/refs/heads/*]
248 set line [read $fd 40]
249 if {[regexp {^[0-9a-f]{40}} $line id]} {
250 set head [file tail $f]
251 set headids($head) $line
252 lappend idheads($line) $head
259 proc error_popup msg {
263 message $w.m -text $msg -justify center -aspect 400
264 pack $w.m -side top -fill x -padx 20 -pady 20
265 button $w.ok -text OK -command "destroy $w"
266 pack $w.ok -side bottom -fill x
267 bind $w <Visibility> "grab $w; focus $w"
272 global canv canv2 canv3 linespc charspc ctext cflist textfont
273 global findtype findtypemenu findloc findstring fstring geometry
274 global entries sha1entry sha1string sha1but
275 global maincursor textcursor
279 .bar add cascade -label "File" -menu .bar.file
281 .bar.file add command -label "Quit" -command doquit
283 .bar add cascade -label "Help" -menu .bar.help
284 .bar.help add command -label "About gitk" -command about
285 . configure -menu .bar
287 if {![info exists geometry(canv1)]} {
288 set geometry(canv1) [expr 45 * $charspc]
289 set geometry(canv2) [expr 30 * $charspc]
290 set geometry(canv3) [expr 15 * $charspc]
291 set geometry(canvh) [expr 25 * $linespc + 4]
292 set geometry(ctextw) 80
293 set geometry(ctexth) 30
294 set geometry(cflistw) 30
296 panedwindow .ctop -orient vertical
297 if {[info exists geometry(width)]} {
298 .ctop conf -width $geometry(width) -height $geometry(height)
299 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
300 set geometry(ctexth) [expr {($texth - 8) /
301 [font metrics $textfont -linespace]}]
305 pack .ctop.top.bar -side bottom -fill x
306 set cscroll .ctop.top.csb
307 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
308 pack $cscroll -side right -fill y
309 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
310 pack .ctop.top.clist -side top -fill both -expand 1
312 set canv .ctop.top.clist.canv
313 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
315 -yscrollincr $linespc -yscrollcommand "$cscroll set"
316 .ctop.top.clist add $canv
317 set canv2 .ctop.top.clist.canv2
318 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
319 -bg white -bd 0 -yscrollincr $linespc
320 .ctop.top.clist add $canv2
321 set canv3 .ctop.top.clist.canv3
322 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
323 -bg white -bd 0 -yscrollincr $linespc
324 .ctop.top.clist add $canv3
325 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
327 set sha1entry .ctop.top.bar.sha1
328 set entries $sha1entry
329 set sha1but .ctop.top.bar.sha1label
330 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
331 -command gotocommit -width 8
332 $sha1but conf -disabledforeground [$sha1but cget -foreground]
333 pack .ctop.top.bar.sha1label -side left
334 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
335 trace add variable sha1string write sha1change
336 pack $sha1entry -side left -pady 2
337 button .ctop.top.bar.findbut -text "Find" -command dofind
338 pack .ctop.top.bar.findbut -side left
340 set fstring .ctop.top.bar.findstring
341 lappend entries $fstring
342 entry $fstring -width 30 -font $textfont -textvariable findstring
343 pack $fstring -side left -expand 1 -fill x
345 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
346 findtype Exact IgnCase Regexp]
347 set findloc "All fields"
348 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
349 Comments Author Committer Files Pickaxe
350 pack .ctop.top.bar.findloc -side right
351 pack .ctop.top.bar.findtype -side right
352 # for making sure type==Exact whenever loc==Pickaxe
353 trace add variable findloc write findlocchange
355 panedwindow .ctop.cdet -orient horizontal
357 frame .ctop.cdet.left
358 set ctext .ctop.cdet.left.ctext
359 text $ctext -bg white -state disabled -font $textfont \
360 -width $geometry(ctextw) -height $geometry(ctexth) \
361 -yscrollcommand ".ctop.cdet.left.sb set"
362 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
363 pack .ctop.cdet.left.sb -side right -fill y
364 pack $ctext -side left -fill both -expand 1
365 .ctop.cdet add .ctop.cdet.left
367 $ctext tag conf filesep -font [concat $textfont bold]
368 $ctext tag conf hunksep -back blue -fore white
369 $ctext tag conf d0 -back "#ff8080"
370 $ctext tag conf d1 -back green
371 $ctext tag conf found -back yellow
373 frame .ctop.cdet.right
374 set cflist .ctop.cdet.right.cfiles
375 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
376 -yscrollcommand ".ctop.cdet.right.sb set"
377 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
378 pack .ctop.cdet.right.sb -side right -fill y
379 pack $cflist -side left -fill both -expand 1
380 .ctop.cdet add .ctop.cdet.right
381 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
383 pack .ctop -side top -fill both -expand 1
385 bindall <1> {selcanvline %W %x %y}
386 #bindall <B1-Motion> {selcanvline %W %x %y}
387 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
388 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
389 bindall <2> "allcanvs scan mark 0 %y"
390 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
391 bind . <Key-Up> "selnextline -1"
392 bind . <Key-Down> "selnextline 1"
393 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
394 bind . <Key-Next> "allcanvs yview scroll 1 pages"
395 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
396 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
397 bindkey <Key-space> "$ctext yview scroll 1 pages"
398 bindkey p "selnextline -1"
399 bindkey n "selnextline 1"
400 bindkey b "$ctext yview scroll -1 pages"
401 bindkey d "$ctext yview scroll 18 units"
402 bindkey u "$ctext yview scroll -18 units"
403 bindkey / {findnext 1}
404 bindkey <Key-Return> {findnext 0}
407 bind . <Control-q> doquit
408 bind . <Control-f> dofind
409 bind . <Control-g> {findnext 0}
410 bind . <Control-r> findprev
411 bind . <Control-equal> {incrfont 1}
412 bind . <Control-KP_Add> {incrfont 1}
413 bind . <Control-minus> {incrfont -1}
414 bind . <Control-KP_Subtract> {incrfont -1}
415 bind $cflist <<ListboxSelect>> listboxsel
416 bind . <Destroy> {savestuff %W}
417 bind . <Button-1> "click %W"
418 bind $fstring <Key-Return> dofind
419 bind $sha1entry <Key-Return> gotocommit
420 bind $sha1entry <<PasteSelection>> clearsha1
422 set maincursor [. cget -cursor]
423 set textcursor [$ctext cget -cursor]
425 set rowctxmenu .rowctxmenu
426 menu $rowctxmenu -tearoff 0
427 $rowctxmenu add command -label "Diff this -> selected" \
428 -command {diffvssel 0}
429 $rowctxmenu add command -label "Diff selected -> this" \
430 -command {diffvssel 1}
431 $rowctxmenu add command -label "Make patch" -command mkpatch
432 $rowctxmenu add command -label "Create tag" -command mktag
433 $rowctxmenu add command -label "Write commit to file" -command writecommit
436 # when we make a key binding for the toplevel, make sure
437 # it doesn't get triggered when that key is pressed in the
438 # find string entry widget.
439 proc bindkey {ev script} {
442 set escript [bind Entry $ev]
443 if {$escript == {}} {
444 set escript [bind Entry <Key>]
447 bind $e $ev "$escript; break"
451 # set the focus back to the toplevel for any click outside
462 global canv canv2 canv3 ctext cflist mainfont textfont
464 if {$stuffsaved} return
465 if {![winfo viewable .]} return
467 set f [open "~/.gitk-new" w]
468 puts $f "set mainfont {$mainfont}"
469 puts $f "set textfont {$textfont}"
470 puts $f "set geometry(width) [winfo width .ctop]"
471 puts $f "set geometry(height) [winfo height .ctop]"
472 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
473 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
474 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
475 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
476 set wid [expr {([winfo width $ctext] - 8) \
477 / [font measure $textfont "0"]}]
478 puts $f "set geometry(ctextw) $wid"
479 set wid [expr {([winfo width $cflist] - 11) \
480 / [font measure [$cflist cget -font] "0"]}]
481 puts $f "set geometry(cflistw) $wid"
483 file rename -force "~/.gitk-new" "~/.gitk"
488 proc resizeclistpanes {win w} {
490 if [info exists oldwidth($win)] {
491 set s0 [$win sash coord 0]
492 set s1 [$win sash coord 1]
494 set sash0 [expr {int($w/2 - 2)}]
495 set sash1 [expr {int($w*5/6 - 2)}]
497 set factor [expr {1.0 * $w / $oldwidth($win)}]
498 set sash0 [expr {int($factor * [lindex $s0 0])}]
499 set sash1 [expr {int($factor * [lindex $s1 0])}]
503 if {$sash1 < $sash0 + 20} {
504 set sash1 [expr $sash0 + 20]
506 if {$sash1 > $w - 10} {
507 set sash1 [expr $w - 10]
508 if {$sash0 > $sash1 - 20} {
509 set sash0 [expr $sash1 - 20]
513 $win sash place 0 $sash0 [lindex $s0 1]
514 $win sash place 1 $sash1 [lindex $s1 1]
516 set oldwidth($win) $w
519 proc resizecdetpanes {win w} {
521 if [info exists oldwidth($win)] {
522 set s0 [$win sash coord 0]
524 set sash0 [expr {int($w*3/4 - 2)}]
526 set factor [expr {1.0 * $w / $oldwidth($win)}]
527 set sash0 [expr {int($factor * [lindex $s0 0])}]
531 if {$sash0 > $w - 15} {
532 set sash0 [expr $w - 15]
535 $win sash place 0 $sash0 [lindex $s0 1]
537 set oldwidth($win) $w
541 global canv canv2 canv3
547 proc bindall {event action} {
548 global canv canv2 canv3
549 bind $canv $event $action
550 bind $canv2 $event $action
551 bind $canv3 $event $action
556 if {[winfo exists $w]} {
561 wm title $w "About gitk"
565 Copyright © 2005 Paul Mackerras
567 Use and redistribute under the terms of the GNU General Public License} \
568 -justify center -aspect 400
569 pack $w.m -side top -fill x -padx 20 -pady 20
570 button $w.ok -text Close -command "destroy $w"
571 pack $w.ok -side bottom
574 proc assigncolor {id} {
575 global commitinfo colormap commcolors colors nextcolor
576 global parents nparents children nchildren
577 global cornercrossings crossings
579 if [info exists colormap($id)] return
580 set ncolors [llength $colors]
581 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
582 set child [lindex $children($id) 0]
583 if {[info exists colormap($child)]
584 && $nparents($child) == 1} {
585 set colormap($id) $colormap($child)
590 if {[info exists cornercrossings($id)]} {
591 foreach x $cornercrossings($id) {
592 if {[info exists colormap($x)]
593 && [lsearch -exact $badcolors $colormap($x)] < 0} {
594 lappend badcolors $colormap($x)
597 if {[llength $badcolors] >= $ncolors} {
601 set origbad $badcolors
602 if {[llength $badcolors] < $ncolors - 1} {
603 if {[info exists crossings($id)]} {
604 foreach x $crossings($id) {
605 if {[info exists colormap($x)]
606 && [lsearch -exact $badcolors $colormap($x)] < 0} {
607 lappend badcolors $colormap($x)
610 if {[llength $badcolors] >= $ncolors} {
611 set badcolors $origbad
614 set origbad $badcolors
616 if {[llength $badcolors] < $ncolors - 1} {
617 foreach child $children($id) {
618 if {[info exists colormap($child)]
619 && [lsearch -exact $badcolors $colormap($child)] < 0} {
620 lappend badcolors $colormap($child)
622 if {[info exists parents($child)]} {
623 foreach p $parents($child) {
624 if {[info exists colormap($p)]
625 && [lsearch -exact $badcolors $colormap($p)] < 0} {
626 lappend badcolors $colormap($p)
631 if {[llength $badcolors] >= $ncolors} {
632 set badcolors $origbad
635 for {set i 0} {$i <= $ncolors} {incr i} {
636 set c [lindex $colors $nextcolor]
637 if {[incr nextcolor] >= $ncolors} {
640 if {[lsearch -exact $badcolors $c]} break
646 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
647 global mainline sidelines
648 global nchildren ncleft
655 set lthickness [expr {int($linespc / 9) + 1}]
656 catch {unset mainline}
657 catch {unset sidelines}
658 foreach id [array names nchildren] {
659 set ncleft($id) $nchildren($id)
663 proc bindline {t id} {
666 $canv bind $t <Enter> "lineenter %x %y $id"
667 $canv bind $t <Motion> "linemotion %x %y $id"
668 $canv bind $t <Leave> "lineleave $id"
669 $canv bind $t <Button-1> "lineclick %x %y $id"
672 proc drawcommitline {level} {
673 global parents children nparents nchildren todo
674 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
675 global lineid linehtag linentag linedtag commitinfo
676 global colormap numcommits currentparents dupparents
677 global oldlevel oldnlines oldtodo
678 global idtags idline idheads
679 global lineno lthickness mainline sidelines
680 global commitlisted rowtextx idpos
684 set id [lindex $todo $level]
685 set lineid($lineno) $id
686 set idline($id) $lineno
687 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
688 if {![info exists commitinfo($id)]} {
690 if {![info exists commitinfo($id)]} {
691 set commitinfo($id) {"No commit information available"}
696 set currentparents {}
698 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
699 foreach p $parents($id) {
700 if {[lsearch -exact $currentparents $p] < 0} {
701 lappend currentparents $p
703 # remember that this parent was listed twice
704 lappend dupparents $p
708 set x [expr $canvx0 + $level * $linespc]
710 set canvy [expr $canvy + $linespc]
711 allcanvs conf -scrollregion \
712 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
713 if {[info exists mainline($id)]} {
714 lappend mainline($id) $x $y1
715 set t [$canv create line $mainline($id) \
716 -width $lthickness -fill $colormap($id)]
720 if {[info exists sidelines($id)]} {
721 foreach ls $sidelines($id) {
722 set coords [lindex $ls 0]
723 set thick [lindex $ls 1]
724 set t [$canv create line $coords -fill $colormap($id) \
725 -width [expr {$thick * $lthickness}]]
730 set orad [expr {$linespc / 3}]
731 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
732 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
733 -fill $ofill -outline black -width 1]
735 $canv bind $t <1> {selcanvline {} %x %y}
736 set xt [expr $canvx0 + [llength $todo] * $linespc]
737 if {[llength $currentparents] > 2} {
738 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
740 set rowtextx($lineno) $xt
741 set idpos($id) [list $x $xt $y1]
742 if {[info exists idtags($id)] || [info exists idheads($id)]} {
743 set xt [drawtags $id $x $xt $y1]
745 set headline [lindex $commitinfo($id) 0]
746 set name [lindex $commitinfo($id) 1]
747 set date [lindex $commitinfo($id) 2]
748 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
749 -text $headline -font $mainfont ]
750 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
751 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
752 -text $name -font $namefont]
753 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
754 -text $date -font $mainfont]
757 proc drawtags {id x xt y1} {
758 global idtags idheads
759 global linespc lthickness
764 if {[info exists idtags($id)]} {
765 set marks $idtags($id)
766 set ntags [llength $marks]
768 if {[info exists idheads($id)]} {
769 set marks [concat $marks $idheads($id)]
775 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
776 set yt [expr $y1 - 0.5 * $linespc]
777 set yb [expr $yt + $linespc - 1]
781 set wid [font measure $mainfont $tag]
784 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
786 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
787 -width $lthickness -fill black -tags tag.$id]
789 foreach tag $marks x $xvals wid $wvals {
790 set xl [expr $x + $delta]
791 set xr [expr $x + $delta + $wid + $lthickness]
792 if {[incr ntags -1] >= 0} {
794 $canv create polygon $x [expr $yt + $delta] $xl $yt\
795 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
796 -width 1 -outline black -fill yellow -tags tag.$id
799 set xl [expr $xl - $delta/2]
800 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
801 -width 1 -outline black -fill green -tags tag.$id
803 $canv create text $xl $y1 -anchor w -text $tag \
804 -font $mainfont -tags tag.$id
809 proc updatetodo {level noshortcut} {
810 global currentparents ncleft todo
811 global mainline oldlevel oldtodo oldnlines
812 global canvx0 canvy linespc mainline
817 set oldnlines [llength $todo]
818 if {!$noshortcut && [llength $currentparents] == 1} {
819 set p [lindex $currentparents 0]
820 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
822 set x [expr $canvx0 + $level * $linespc]
823 set y [expr $canvy - $linespc]
824 set mainline($p) [list $x $y]
825 set todo [lreplace $todo $level $level $p]
830 set todo [lreplace $todo $level $level]
832 foreach p $currentparents {
834 set k [lsearch -exact $todo $p]
836 set todo [linsert $todo $i $p]
843 proc notecrossings {id lo hi corner} {
844 global oldtodo crossings cornercrossings
846 for {set i $lo} {[incr i] < $hi} {} {
847 set p [lindex $oldtodo $i]
848 if {$p == {}} continue
850 if {![info exists cornercrossings($id)]
851 || [lsearch -exact $cornercrossings($id) $p] < 0} {
852 lappend cornercrossings($id) $p
854 if {![info exists cornercrossings($p)]
855 || [lsearch -exact $cornercrossings($p) $id] < 0} {
856 lappend cornercrossings($p) $id
859 if {![info exists crossings($id)]
860 || [lsearch -exact $crossings($id) $p] < 0} {
861 lappend crossings($id) $p
863 if {![info exists crossings($p)]
864 || [lsearch -exact $crossings($p) $id] < 0} {
865 lappend crossings($p) $id
872 global canv mainline sidelines canvx0 canvy linespc
873 global oldlevel oldtodo todo currentparents dupparents
874 global lthickness linespc canvy colormap
876 set y1 [expr $canvy - $linespc]
879 foreach id $oldtodo {
881 if {$id == {}} continue
882 set xi [expr {$canvx0 + $i * $linespc}]
883 if {$i == $oldlevel} {
884 foreach p $currentparents {
885 set j [lsearch -exact $todo $p]
886 set coords [list $xi $y1]
887 set xj [expr {$canvx0 + $j * $linespc}]
889 lappend coords [expr $xj + $linespc] $y1
890 notecrossings $p $j $i [expr {$j + 1}]
891 } elseif {$j > $i + 1} {
892 lappend coords [expr $xj - $linespc] $y1
893 notecrossings $p $i $j [expr {$j - 1}]
895 if {[lsearch -exact $dupparents $p] >= 0} {
896 # draw a double-width line to indicate the doubled parent
897 lappend coords $xj $y2
898 lappend sidelines($p) [list $coords 2]
899 if {![info exists mainline($p)]} {
900 set mainline($p) [list $xj $y2]
903 # normal case, no parent duplicated
904 if {![info exists mainline($p)]} {
906 lappend coords $xj $y2
908 set mainline($p) $coords
910 lappend coords $xj $y2
911 lappend sidelines($p) [list $coords 1]
915 } elseif {[lindex $todo $i] != $id} {
916 set j [lsearch -exact $todo $id]
917 set xj [expr {$canvx0 + $j * $linespc}]
918 lappend mainline($id) $xi $y1 $xj $y2
923 proc decidenext {{noread 0}} {
924 global parents children nchildren ncleft todo
925 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
926 global datemode cdate
928 global currentparents oldlevel oldnlines oldtodo
929 global lineno lthickness
931 # remove the null entry if present
932 set nullentry [lsearch -exact $todo {}]
933 if {$nullentry >= 0} {
934 set todo [lreplace $todo $nullentry $nullentry]
937 # choose which one to do next time around
938 set todol [llength $todo]
941 for {set k $todol} {[incr k -1] >= 0} {} {
942 set p [lindex $todo $k]
943 if {$ncleft($p) == 0} {
945 if {![info exists commitinfo($p)]} {
951 if {$latest == {} || $cdate($p) > $latest} {
953 set latest $cdate($p)
963 puts "ERROR: none of the pending commits can be done yet:"
965 puts " $p ($ncleft($p))"
971 # If we are reducing, put in a null entry
972 if {$todol < $oldnlines} {
973 if {$nullentry >= 0} {
976 && [lindex $oldtodo $i] == [lindex $todo $i]} {
986 set todo [linsert $todo $i {}]
995 proc drawcommit {id} {
996 global phase todo nchildren datemode nextupdate
999 if {$phase != "incrdraw"} {
1002 set startcommits $id
1005 updatetodo 0 $datemode
1007 if {$nchildren($id) == 0} {
1009 lappend startcommits $id
1011 set level [decidenext 1]
1012 if {$level == {} || $id != [lindex $todo $level]} {
1017 drawcommitline $level
1018 if {[updatetodo $level $datemode]} {
1019 set level [decidenext 1]
1020 if {$level == {}} break
1022 set id [lindex $todo $level]
1023 if {![info exists commitlisted($id)]} {
1026 if {[clock clicks -milliseconds] >= $nextupdate} {
1034 proc finishcommits {} {
1037 global canv mainfont ctext maincursor textcursor
1039 if {$phase != "incrdraw"} {
1041 $canv create text 3 3 -anchor nw -text "No commits selected" \
1042 -font $mainfont -tags textitems
1046 set level [decidenext]
1047 drawrest $level [llength $startcommits]
1049 . config -cursor $maincursor
1050 $ctext config -cursor $textcursor
1054 global nextupdate startmsecs startcommits todo
1056 if {$startcommits == {}} return
1057 set startmsecs [clock clicks -milliseconds]
1058 set nextupdate [expr $startmsecs + 100]
1060 set todo [lindex $startcommits 0]
1064 proc drawrest {level startix} {
1065 global phase stopped redisplaying selectedline
1066 global datemode currentparents todo
1068 global nextupdate startmsecs startcommits idline
1072 set startid [lindex $startcommits $startix]
1074 if {$startid != {}} {
1075 set startline $idline($startid)
1079 drawcommitline $level
1080 set hard [updatetodo $level $datemode]
1081 if {$numcommits == $startline} {
1082 lappend todo $startid
1085 set startid [lindex $startcommits $startix]
1087 if {$startid != {}} {
1088 set startline $idline($startid)
1092 set level [decidenext]
1093 if {$level < 0} break
1096 if {[clock clicks -milliseconds] >= $nextupdate} {
1103 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1104 #puts "overall $drawmsecs ms for $numcommits commits"
1105 if {$redisplaying} {
1106 if {$stopped == 0 && [info exists selectedline]} {
1107 selectline $selectedline
1109 if {$stopped == 1} {
1111 after idle drawgraph
1118 proc findmatches {f} {
1119 global findtype foundstring foundstrlen
1120 if {$findtype == "Regexp"} {
1121 set matches [regexp -indices -all -inline $foundstring $f]
1123 if {$findtype == "IgnCase"} {
1124 set str [string tolower $f]
1130 while {[set j [string first $foundstring $str $i]] >= 0} {
1131 lappend matches [list $j [expr $j+$foundstrlen-1]]
1132 set i [expr $j + $foundstrlen]
1139 global findtype findloc findstring markedmatches commitinfo
1140 global numcommits lineid linehtag linentag linedtag
1141 global mainfont namefont canv canv2 canv3 selectedline
1142 global matchinglines foundstring foundstrlen
1147 set matchinglines {}
1148 if {$findloc == "Pickaxe"} {
1152 if {$findtype == "IgnCase"} {
1153 set foundstring [string tolower $findstring]
1155 set foundstring $findstring
1157 set foundstrlen [string length $findstring]
1158 if {$foundstrlen == 0} return
1159 if {$findloc == "Files"} {
1163 if {![info exists selectedline]} {
1166 set oldsel $selectedline
1169 set fldtypes {Headline Author Date Committer CDate Comment}
1170 for {set l 0} {$l < $numcommits} {incr l} {
1172 set info $commitinfo($id)
1174 foreach f $info ty $fldtypes {
1175 if {$findloc != "All fields" && $findloc != $ty} {
1178 set matches [findmatches $f]
1179 if {$matches == {}} continue
1181 if {$ty == "Headline"} {
1182 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1183 } elseif {$ty == "Author"} {
1184 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1185 } elseif {$ty == "Date"} {
1186 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1190 lappend matchinglines $l
1191 if {!$didsel && $l > $oldsel} {
1197 if {$matchinglines == {}} {
1199 } elseif {!$didsel} {
1200 findselectline [lindex $matchinglines 0]
1204 proc findselectline {l} {
1205 global findloc commentend ctext
1207 if {$findloc == "All fields" || $findloc == "Comments"} {
1208 # highlight the matches in the comments
1209 set f [$ctext get 1.0 $commentend]
1210 set matches [findmatches $f]
1211 foreach match $matches {
1212 set start [lindex $match 0]
1213 set end [expr [lindex $match 1] + 1]
1214 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1219 proc findnext {restart} {
1220 global matchinglines selectedline
1221 if {![info exists matchinglines]} {
1227 if {![info exists selectedline]} return
1228 foreach l $matchinglines {
1229 if {$l > $selectedline} {
1238 global matchinglines selectedline
1239 if {![info exists matchinglines]} {
1243 if {![info exists selectedline]} return
1245 foreach l $matchinglines {
1246 if {$l >= $selectedline} break
1250 findselectline $prev
1256 proc findlocchange {name ix op} {
1257 global findloc findtype findtypemenu
1258 if {$findloc == "Pickaxe"} {
1264 $findtypemenu entryconf 1 -state $state
1265 $findtypemenu entryconf 2 -state $state
1268 proc stopfindproc {{done 0}} {
1269 global findprocpid findprocfile findids
1270 global ctext findoldcursor phase maincursor textcursor
1271 global findinprogress
1273 catch {unset findids}
1274 if {[info exists findprocpid]} {
1276 catch {exec kill $findprocpid}
1278 catch {close $findprocfile}
1281 if {[info exists findinprogress]} {
1282 unset findinprogress
1283 if {$phase != "incrdraw"} {
1284 . config -cursor $maincursor
1285 $ctext config -cursor $textcursor
1290 proc findpatches {} {
1291 global findstring selectedline numcommits
1292 global findprocpid findprocfile
1293 global finddidsel ctext lineid findinprogress
1294 global findinsertpos
1296 if {$numcommits == 0} return
1298 # make a list of all the ids to search, starting at the one
1299 # after the selected line (if any)
1300 if {[info exists selectedline]} {
1306 for {set i 0} {$i < $numcommits} {incr i} {
1307 if {[incr l] >= $numcommits} {
1310 append inputids $lineid($l) "\n"
1314 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1317 error_popup "Error starting search process: $err"
1321 set findinsertpos end
1323 set findprocpid [pid $f]
1324 fconfigure $f -blocking 0
1325 fileevent $f readable readfindproc
1327 . config -cursor watch
1328 $ctext config -cursor watch
1329 set findinprogress 1
1332 proc readfindproc {} {
1333 global findprocfile finddidsel
1334 global idline matchinglines findinsertpos
1336 set n [gets $findprocfile line]
1338 if {[eof $findprocfile]} {
1346 if {![regexp {^[0-9a-f]{40}} $line id]} {
1347 error_popup "Can't parse git-diff-tree output: $line"
1351 if {![info exists idline($id)]} {
1352 puts stderr "spurious id: $id"
1359 proc insertmatch {l id} {
1360 global matchinglines findinsertpos finddidsel
1362 if {$findinsertpos == "end"} {
1363 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1364 set matchinglines [linsert $matchinglines 0 $l]
1367 lappend matchinglines $l
1370 set matchinglines [linsert $matchinglines $findinsertpos $l]
1381 global selectedline numcommits lineid ctext
1382 global ffileline finddidsel parents nparents
1383 global findinprogress findstartline findinsertpos
1384 global treediffs fdiffids fdiffsneeded fdiffpos
1385 global findmergefiles
1387 if {$numcommits == 0} return
1389 if {[info exists selectedline]} {
1390 set l [expr {$selectedline + 1}]
1395 set findstartline $l
1400 if {$findmergefiles || $nparents($id) == 1} {
1401 foreach p $parents($id) {
1402 if {![info exists treediffs([list $id $p])]} {
1403 append diffsneeded "$id $p\n"
1404 lappend fdiffsneeded [list $id $p]
1408 if {[incr l] >= $numcommits} {
1411 if {$l == $findstartline} break
1414 # start off a git-diff-tree process if needed
1415 if {$diffsneeded ne {}} {
1417 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1419 error_popup "Error starting search process: $err"
1422 catch {unset fdiffids}
1424 fconfigure $df -blocking 0
1425 fileevent $df readable [list readfilediffs $df]
1429 set findinsertpos end
1431 set p [lindex $parents($id) 0]
1432 . config -cursor watch
1433 $ctext config -cursor watch
1434 set findinprogress 1
1435 findcont [list $id $p]
1439 proc readfilediffs {df} {
1440 global findids fdiffids fdiffs
1442 set n [gets $df line]
1446 if {[catch {close $df} err]} {
1449 error_popup "Error in git-diff-tree: $err"
1450 } elseif {[info exists findids]} {
1454 error_popup "Couldn't find diffs for {$ids}"
1459 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1460 # start of a new string of diffs
1462 set fdiffids [list $id $p]
1464 } elseif {[string match ":*" $line]} {
1465 lappend fdiffs [lindex $line 5]
1469 proc donefilediff {} {
1470 global fdiffids fdiffs treediffs findids
1471 global fdiffsneeded fdiffpos
1473 if {[info exists fdiffids]} {
1474 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1475 && $fdiffpos < [llength $fdiffsneeded]} {
1476 # git-diff-tree doesn't output anything for a commit
1477 # which doesn't change anything
1478 set nullids [lindex $fdiffsneeded $fdiffpos]
1479 set treediffs($nullids) {}
1480 if {[info exists findids] && $nullids eq $findids} {
1488 if {![info exists treediffs($fdiffids)]} {
1489 set treediffs($fdiffids) $fdiffs
1491 if {[info exists findids] && $fdiffids eq $findids} {
1498 proc findcont {ids} {
1499 global findids treediffs parents nparents treepending
1500 global ffileline findstartline finddidsel
1501 global lineid numcommits matchinglines findinprogress
1502 global findmergefiles
1504 set id [lindex $ids 0]
1505 set p [lindex $ids 1]
1506 set pi [lsearch -exact $parents($id) $p]
1509 if {$findmergefiles || $nparents($id) == 1} {
1510 if {![info exists treediffs($ids)]} {
1516 foreach f $treediffs($ids) {
1517 set x [findmatches $f]
1525 set pi $nparents($id)
1528 set pi $nparents($id)
1530 if {[incr pi] >= $nparents($id)} {
1532 if {[incr l] >= $numcommits} {
1535 if {$l == $findstartline} break
1538 set p [lindex $parents($id) $pi]
1539 set ids [list $id $p]
1547 # mark a commit as matching by putting a yellow background
1548 # behind the headline
1549 proc markheadline {l id} {
1550 global canv mainfont linehtag commitinfo
1552 set bbox [$canv bbox $linehtag($l)]
1553 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1557 # mark the bits of a headline, author or date that match a find string
1558 proc markmatches {canv l str tag matches font} {
1559 set bbox [$canv bbox $tag]
1560 set x0 [lindex $bbox 0]
1561 set y0 [lindex $bbox 1]
1562 set y1 [lindex $bbox 3]
1563 foreach match $matches {
1564 set start [lindex $match 0]
1565 set end [lindex $match 1]
1566 if {$start > $end} continue
1567 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1568 set xlen [font measure $font [string range $str 0 [expr $end]]]
1569 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1570 -outline {} -tags matches -fill yellow]
1575 proc unmarkmatches {} {
1576 global matchinglines findids
1577 allcanvs delete matches
1578 catch {unset matchinglines}
1579 catch {unset findids}
1582 proc selcanvline {w x y} {
1583 global canv canvy0 ctext linespc selectedline
1584 global lineid linehtag linentag linedtag rowtextx
1585 set ymax [lindex [$canv cget -scrollregion] 3]
1586 if {$ymax == {}} return
1587 set yfrac [lindex [$canv yview] 0]
1588 set y [expr {$y + $yfrac * $ymax}]
1589 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1594 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1600 proc selectline {l} {
1601 global canv canv2 canv3 ctext commitinfo selectedline
1602 global lineid linehtag linentag linedtag
1603 global canvy0 linespc parents nparents
1604 global cflist currentid sha1entry
1605 global commentend seenfile idtags
1607 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1609 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1610 -tags secsel -fill [$canv cget -selectbackground]]
1612 $canv2 delete secsel
1613 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1614 -tags secsel -fill [$canv2 cget -selectbackground]]
1616 $canv3 delete secsel
1617 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1618 -tags secsel -fill [$canv3 cget -selectbackground]]
1620 set y [expr {$canvy0 + $l * $linespc}]
1621 set ymax [lindex [$canv cget -scrollregion] 3]
1622 set ytop [expr {$y - $linespc - 1}]
1623 set ybot [expr {$y + $linespc + 1}]
1624 set wnow [$canv yview]
1625 set wtop [expr [lindex $wnow 0] * $ymax]
1626 set wbot [expr [lindex $wnow 1] * $ymax]
1627 set wh [expr {$wbot - $wtop}]
1629 if {$ytop < $wtop} {
1630 if {$ybot < $wtop} {
1631 set newtop [expr {$y - $wh / 2.0}]
1634 if {$newtop > $wtop - $linespc} {
1635 set newtop [expr {$wtop - $linespc}]
1638 } elseif {$ybot > $wbot} {
1639 if {$ytop > $wbot} {
1640 set newtop [expr {$y - $wh / 2.0}]
1642 set newtop [expr {$ybot - $wh}]
1643 if {$newtop < $wtop + $linespc} {
1644 set newtop [expr {$wtop + $linespc}]
1648 if {$newtop != $wtop} {
1652 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1658 $sha1entry delete 0 end
1659 $sha1entry insert 0 $id
1660 $sha1entry selection from 0
1661 $sha1entry selection to end
1663 $ctext conf -state normal
1664 $ctext delete 0.0 end
1665 $ctext mark set fmark.0 0.0
1666 $ctext mark gravity fmark.0 left
1667 set info $commitinfo($id)
1668 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1669 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1670 if {[info exists idtags($id)]} {
1671 $ctext insert end "Tags:"
1672 foreach tag $idtags($id) {
1673 $ctext insert end " $tag"
1675 $ctext insert end "\n"
1677 $ctext insert end "\n"
1678 $ctext insert end [lindex $info 5]
1679 $ctext insert end "\n"
1680 $ctext tag delete Comments
1681 $ctext tag remove found 1.0 end
1682 $ctext conf -state disabled
1683 set commentend [$ctext index "end - 1c"]
1685 $cflist delete 0 end
1686 $cflist insert end "Comments"
1687 startdiff $id $parents($id)
1690 proc startdiff {id vs} {
1691 global diffpending diffpindex
1692 global diffindex difffilestart seenfile
1693 global curdifftag curtagstart
1697 catch {unset seenfile}
1699 catch {unset difffilestart}
1700 set curdifftag Comments
1702 contdiff [list $id [lindex $vs 0]]
1705 proc contdiff {ids} {
1706 global treediffs diffids treepending
1708 if {![info exists treediffs($ids)]} {
1710 if {![info exists treepending]} {
1718 proc selnextline {dir} {
1720 if {![info exists selectedline]} return
1721 set l [expr $selectedline + $dir]
1726 proc addtocflist {ids} {
1727 global treediffs cflist diffpindex
1729 set colors {black blue green red cyan magenta}
1730 set color [lindex $colors [expr {$diffpindex % [llength $colors]}]]
1731 foreach f $treediffs($ids) {
1732 $cflist insert end $f
1733 $cflist itemconf end -foreground $color
1738 proc gettreediffs {ids} {
1739 global treediffs parents treepending
1740 set treepending $ids
1741 set treediffs($ids) {}
1742 set id [lindex $ids 0]
1743 set p [lindex $ids 1]
1744 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1745 fconfigure $gdtf -blocking 0
1746 fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
1749 proc gettreediffline {gdtf ids} {
1750 global treediffs treepending diffids
1751 set n [gets $gdtf line]
1753 if {![eof $gdtf]} return
1756 if {[info exists diffids]} {
1757 if {$ids != $diffids} {
1758 gettreediffs $diffids
1765 set file [lindex $line 5]
1766 lappend treediffs($ids) $file
1769 proc getblobdiffs {ids} {
1770 global diffopts blobdifffd diffids env
1773 set id [lindex $ids 0]
1774 set p [lindex $ids 1]
1775 set env(GIT_DIFF_OPTS) $diffopts
1776 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1777 puts "error getting diffs: $err"
1780 fconfigure $bdf -blocking 0
1781 set blobdifffd($ids) $bdf
1782 fileevent $bdf readable [list getblobdiffline $bdf $ids]
1783 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1786 proc getblobdiffline {bdf ids} {
1787 global diffids blobdifffd ctext curdifftag curtagstart seenfile
1788 global diffnexthead diffnextnote diffindex difffilestart
1789 global nextupdate diffpending diffpindex
1791 set n [gets $bdf line]
1795 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1796 $ctext tag add $curdifftag $curtagstart end
1797 set seenfile($curdifftag) 1
1798 if {[incr diffpindex] < [llength $diffpending]} {
1799 set id [lindex $ids 0]
1800 set p [lindex $diffpending $diffpindex]
1801 contdiff [list $id $p]
1807 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1810 $ctext conf -state normal
1811 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1812 # start of a new file
1813 $ctext insert end "\n"
1814 $ctext tag add $curdifftag $curtagstart end
1815 set seenfile($curdifftag) 1
1816 set curtagstart [$ctext index "end - 1c"]
1818 if {[info exists diffnexthead]} {
1819 set fname $diffnexthead
1820 set header "$diffnexthead ($diffnextnote)"
1823 set here [$ctext index "end - 1c"]
1824 set difffilestart($diffindex) $here
1826 # start mark names at fmark.1 for first file
1827 $ctext mark set fmark.$diffindex $here
1828 $ctext mark gravity fmark.$diffindex left
1829 set curdifftag "f:$fname"
1830 $ctext tag delete $curdifftag
1831 set l [expr {(78 - [string length $header]) / 2}]
1832 set pad [string range "----------------------------------------" 1 $l]
1833 $ctext insert end "$pad $header $pad\n" filesep
1834 } elseif {[string range $line 0 2] == "+++"} {
1835 # no need to do anything with this
1836 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1837 set diffnexthead $fn
1838 set diffnextnote "created, mode $m"
1839 } elseif {[string range $line 0 8] == "Deleted: "} {
1840 set diffnexthead [string range $line 9 end]
1841 set diffnextnote "deleted"
1842 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1843 # save the filename in case the next thing is "new file mode ..."
1844 set diffnexthead $fn
1845 set diffnextnote "modified"
1846 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1847 set diffnextnote "new file, mode $m"
1848 } elseif {[string range $line 0 11] == "deleted file"} {
1849 set diffnextnote "deleted"
1850 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1851 $line match f1l f1c f2l f2c rest]} {
1852 $ctext insert end "\t" hunksep
1853 $ctext insert end " $f1l " d0 " $f2l " d1
1854 $ctext insert end " $rest \n" hunksep
1856 set x [string range $line 0 0]
1857 if {$x == "-" || $x == "+"} {
1858 set tag [expr {$x == "+"}]
1859 set line [string range $line 1 end]
1860 $ctext insert end "$line\n" d$tag
1861 } elseif {$x == " "} {
1862 set line [string range $line 1 end]
1863 $ctext insert end "$line\n"
1864 } elseif {$x == "\\"} {
1865 # e.g. "\ No newline at end of file"
1866 $ctext insert end "$line\n" filesep
1868 # Something else we don't recognize
1869 if {$curdifftag != "Comments"} {
1870 $ctext insert end "\n"
1871 $ctext tag add $curdifftag $curtagstart end
1872 set seenfile($curdifftag) 1
1873 set curtagstart [$ctext index "end - 1c"]
1874 set curdifftag Comments
1876 $ctext insert end "$line\n" filesep
1879 $ctext conf -state disabled
1880 if {[clock clicks -milliseconds] >= $nextupdate} {
1882 fileevent $bdf readable {}
1884 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1889 global difffilestart ctext
1890 set here [$ctext index @0,0]
1891 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1892 if {[$ctext compare $difffilestart($i) > $here]} {
1893 $ctext yview $difffilestart($i)
1899 proc listboxsel {} {
1900 global ctext cflist currentid treediffs
1901 if {![info exists currentid]} return
1902 set sel [lsort [$cflist curselection]]
1903 if {$sel eq {}} return
1904 set first [lindex $sel 0]
1905 catch {$ctext yview fmark.$first}
1909 global linespc charspc canvx0 canvy0 mainfont
1910 set linespc [font metrics $mainfont -linespace]
1911 set charspc [font measure $mainfont "m"]
1912 set canvy0 [expr 3 + 0.5 * $linespc]
1913 set canvx0 [expr 3 + 0.5 * $linespc]
1917 global selectedline stopped redisplaying phase
1918 if {$stopped > 1} return
1919 if {$phase == "getcommits"} return
1921 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1928 proc incrfont {inc} {
1929 global mainfont namefont textfont selectedline ctext canv phase
1930 global stopped entries
1932 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1933 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1934 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1936 $ctext conf -font $textfont
1937 $ctext tag conf filesep -font [concat $textfont bold]
1938 foreach e $entries {
1939 $e conf -font $mainfont
1941 if {$phase == "getcommits"} {
1942 $canv itemconf textitems -font $mainfont
1948 global sha1entry sha1string
1949 if {[string length $sha1string] == 40} {
1950 $sha1entry delete 0 end
1954 proc sha1change {n1 n2 op} {
1955 global sha1string currentid sha1but
1956 if {$sha1string == {}
1957 || ([info exists currentid] && $sha1string == $currentid)} {
1962 if {[$sha1but cget -state] == $state} return
1963 if {$state == "normal"} {
1964 $sha1but conf -state normal -relief raised -text "Goto: "
1966 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1970 proc gotocommit {} {
1971 global sha1string currentid idline tagids
1972 if {$sha1string == {}
1973 || ([info exists currentid] && $sha1string == $currentid)} return
1974 if {[info exists tagids($sha1string)]} {
1975 set id $tagids($sha1string)
1977 set id [string tolower $sha1string]
1979 if {[info exists idline($id)]} {
1980 selectline $idline($id)
1983 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1988 error_popup "$type $sha1string is not known"
1991 proc lineenter {x y id} {
1992 global hoverx hovery hoverid hovertimer
1993 global commitinfo canv
1995 if {![info exists commitinfo($id)]} return
1999 if {[info exists hovertimer]} {
2000 after cancel $hovertimer
2002 set hovertimer [after 500 linehover]
2006 proc linemotion {x y id} {
2007 global hoverx hovery hoverid hovertimer
2009 if {[info exists hoverid] && $id == $hoverid} {
2012 if {[info exists hovertimer]} {
2013 after cancel $hovertimer
2015 set hovertimer [after 500 linehover]
2019 proc lineleave {id} {
2020 global hoverid hovertimer canv
2022 if {[info exists hoverid] && $id == $hoverid} {
2024 if {[info exists hovertimer]} {
2025 after cancel $hovertimer
2033 global hoverx hovery hoverid hovertimer
2034 global canv linespc lthickness
2035 global commitinfo mainfont
2037 set text [lindex $commitinfo($hoverid) 0]
2038 set ymax [lindex [$canv cget -scrollregion] 3]
2039 if {$ymax == {}} return
2040 set yfrac [lindex [$canv yview] 0]
2041 set x [expr {$hoverx + 2 * $linespc}]
2042 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2043 set x0 [expr {$x - 2 * $lthickness}]
2044 set y0 [expr {$y - 2 * $lthickness}]
2045 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2046 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2047 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2048 -fill \#ffff80 -outline black -width 1 -tags hover]
2050 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2054 proc lineclick {x y id} {
2055 global ctext commitinfo children cflist canv
2059 # fill the details pane with info about this line
2060 $ctext conf -state normal
2061 $ctext delete 0.0 end
2062 $ctext insert end "Parent:\n "
2063 catch {destroy $ctext.$id}
2064 button $ctext.$id -text "Go:" -command "selbyid $id" \
2066 $ctext window create end -window $ctext.$id -align center
2067 set info $commitinfo($id)
2068 $ctext insert end "\t[lindex $info 0]\n"
2069 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2070 $ctext insert end "\tDate:\t[lindex $info 2]\n"
2071 $ctext insert end "\tID:\t$id\n"
2072 if {[info exists children($id)]} {
2073 $ctext insert end "\nChildren:"
2074 foreach child $children($id) {
2075 $ctext insert end "\n "
2076 catch {destroy $ctext.$child}
2077 button $ctext.$child -text "Go:" -command "selbyid $child" \
2079 $ctext window create end -window $ctext.$child -align center
2080 set info $commitinfo($child)
2081 $ctext insert end "\t[lindex $info 0]"
2084 $ctext conf -state disabled
2086 $cflist delete 0 end
2091 if {[info exists idline($id)]} {
2092 selectline $idline($id)
2098 if {![info exists startmstime]} {
2099 set startmstime [clock clicks -milliseconds]
2101 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2104 proc rowmenu {x y id} {
2105 global rowctxmenu idline selectedline rowmenuid
2107 if {![info exists selectedline] || $idline($id) eq $selectedline} {
2112 $rowctxmenu entryconfigure 0 -state $state
2113 $rowctxmenu entryconfigure 1 -state $state
2114 $rowctxmenu entryconfigure 2 -state $state
2116 tk_popup $rowctxmenu $x $y
2119 proc diffvssel {dirn} {
2120 global rowmenuid selectedline lineid
2124 if {![info exists selectedline]} return
2126 set oldid $lineid($selectedline)
2127 set newid $rowmenuid
2129 set oldid $rowmenuid
2130 set newid $lineid($selectedline)
2132 $ctext conf -state normal
2133 $ctext delete 0.0 end
2134 $ctext mark set fmark.0 0.0
2135 $ctext mark gravity fmark.0 left
2136 $cflist delete 0 end
2137 $cflist insert end "Top"
2138 $ctext insert end "From $oldid\n "
2139 $ctext insert end [lindex $commitinfo($oldid) 0]
2140 $ctext insert end "\n\nTo $newid\n "
2141 $ctext insert end [lindex $commitinfo($newid) 0]
2142 $ctext insert end "\n"
2143 $ctext conf -state disabled
2144 $ctext tag delete Comments
2145 $ctext tag remove found 1.0 end
2146 startdiff [list $newid $oldid]
2150 global rowmenuid currentid commitinfo patchtop patchnum
2152 if {![info exists currentid]} return
2153 set oldid $currentid
2154 set oldhead [lindex $commitinfo($oldid) 0]
2155 set newid $rowmenuid
2156 set newhead [lindex $commitinfo($newid) 0]
2159 catch {destroy $top}
2161 label $top.title -text "Generate patch"
2162 grid $top.title - -pady 10
2163 label $top.from -text "From:"
2164 entry $top.fromsha1 -width 40 -relief flat
2165 $top.fromsha1 insert 0 $oldid
2166 $top.fromsha1 conf -state readonly
2167 grid $top.from $top.fromsha1 -sticky w
2168 entry $top.fromhead -width 60 -relief flat
2169 $top.fromhead insert 0 $oldhead
2170 $top.fromhead conf -state readonly
2171 grid x $top.fromhead -sticky w
2172 label $top.to -text "To:"
2173 entry $top.tosha1 -width 40 -relief flat
2174 $top.tosha1 insert 0 $newid
2175 $top.tosha1 conf -state readonly
2176 grid $top.to $top.tosha1 -sticky w
2177 entry $top.tohead -width 60 -relief flat
2178 $top.tohead insert 0 $newhead
2179 $top.tohead conf -state readonly
2180 grid x $top.tohead -sticky w
2181 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2182 grid $top.rev x -pady 10
2183 label $top.flab -text "Output file:"
2184 entry $top.fname -width 60
2185 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2187 grid $top.flab $top.fname -sticky w
2189 button $top.buts.gen -text "Generate" -command mkpatchgo
2190 button $top.buts.can -text "Cancel" -command mkpatchcan
2191 grid $top.buts.gen $top.buts.can
2192 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2193 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2194 grid $top.buts - -pady 10 -sticky ew
2198 proc mkpatchrev {} {
2201 set oldid [$patchtop.fromsha1 get]
2202 set oldhead [$patchtop.fromhead get]
2203 set newid [$patchtop.tosha1 get]
2204 set newhead [$patchtop.tohead get]
2205 foreach e [list fromsha1 fromhead tosha1 tohead] \
2206 v [list $newid $newhead $oldid $oldhead] {
2207 $patchtop.$e conf -state normal
2208 $patchtop.$e delete 0 end
2209 $patchtop.$e insert 0 $v
2210 $patchtop.$e conf -state readonly
2217 set oldid [$patchtop.fromsha1 get]
2218 set newid [$patchtop.tosha1 get]
2219 set fname [$patchtop.fname get]
2220 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2221 error_popup "Error creating patch: $err"
2223 catch {destroy $patchtop}
2227 proc mkpatchcan {} {
2230 catch {destroy $patchtop}
2235 global rowmenuid mktagtop commitinfo
2239 catch {destroy $top}
2241 label $top.title -text "Create tag"
2242 grid $top.title - -pady 10
2243 label $top.id -text "ID:"
2244 entry $top.sha1 -width 40 -relief flat
2245 $top.sha1 insert 0 $rowmenuid
2246 $top.sha1 conf -state readonly
2247 grid $top.id $top.sha1 -sticky w
2248 entry $top.head -width 60 -relief flat
2249 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2250 $top.head conf -state readonly
2251 grid x $top.head -sticky w
2252 label $top.tlab -text "Tag name:"
2253 entry $top.tag -width 60
2254 grid $top.tlab $top.tag -sticky w
2256 button $top.buts.gen -text "Create" -command mktaggo
2257 button $top.buts.can -text "Cancel" -command mktagcan
2258 grid $top.buts.gen $top.buts.can
2259 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2260 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2261 grid $top.buts - -pady 10 -sticky ew
2266 global mktagtop env tagids idtags
2267 global idpos idline linehtag canv selectedline
2269 set id [$mktagtop.sha1 get]
2270 set tag [$mktagtop.tag get]
2272 error_popup "No tag name specified"
2275 if {[info exists tagids($tag)]} {
2276 error_popup "Tag \"$tag\" already exists"
2281 if {[info exists env(GIT_DIR)]} {
2282 set dir $env(GIT_DIR)
2284 set fname [file join $dir "refs/tags" $tag]
2285 set f [open $fname w]
2289 error_popup "Error creating tag: $err"
2293 set tagids($tag) $id
2294 lappend idtags($id) $tag
2295 $canv delete tag.$id
2296 set xt [eval drawtags $id $idpos($id)]
2297 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2298 if {[info exists selectedline] && $selectedline == $idline($id)} {
2299 selectline $selectedline
2306 catch {destroy $mktagtop}
2315 proc writecommit {} {
2316 global rowmenuid wrcomtop commitinfo wrcomcmd
2318 set top .writecommit
2320 catch {destroy $top}
2322 label $top.title -text "Write commit to file"
2323 grid $top.title - -pady 10
2324 label $top.id -text "ID:"
2325 entry $top.sha1 -width 40 -relief flat
2326 $top.sha1 insert 0 $rowmenuid
2327 $top.sha1 conf -state readonly
2328 grid $top.id $top.sha1 -sticky w
2329 entry $top.head -width 60 -relief flat
2330 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2331 $top.head conf -state readonly
2332 grid x $top.head -sticky w
2333 label $top.clab -text "Command:"
2334 entry $top.cmd -width 60 -textvariable wrcomcmd
2335 grid $top.clab $top.cmd -sticky w -pady 10
2336 label $top.flab -text "Output file:"
2337 entry $top.fname -width 60
2338 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2339 grid $top.flab $top.fname -sticky w
2341 button $top.buts.gen -text "Write" -command wrcomgo
2342 button $top.buts.can -text "Cancel" -command wrcomcan
2343 grid $top.buts.gen $top.buts.can
2344 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2345 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2346 grid $top.buts - -pady 10 -sticky ew
2353 set id [$wrcomtop.sha1 get]
2354 set cmd "echo $id | [$wrcomtop.cmd get]"
2355 set fname [$wrcomtop.fname get]
2356 if {[catch {exec sh -c $cmd >$fname &} err]} {
2357 error_popup "Error writing commit: $err"
2359 catch {destroy $wrcomtop}
2366 catch {destroy $wrcomtop}
2379 set diffopts "-U 5 -p"
2380 set wrcomcmd "git-diff-tree --stdin -p --pretty"
2382 set mainfont {Helvetica 9}
2383 set textfont {Courier 9}
2384 set findmergefiles 0
2386 set colors {green red blue magenta darkgrey brown orange}
2388 catch {source ~/.gitk}
2390 set namefont $mainfont
2392 lappend namefont bold
2397 switch -regexp -- $arg {
2399 "^-b" { set boldnames 1 }
2400 "^-d" { set datemode 1 }
2402 lappend revtreeargs $arg
2414 getcommits $revtreeargs