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 set leftover [string range $stuff $start end]
87 set cmit [string range $stuff $start [expr {$i - 1}]]
89 set cmit "$leftover$cmit"
91 set start [expr {$i + 1}]
92 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
93 error_popup "Can't parse git-rev-list output: {$cmit}"
96 set cmit [string range $cmit 41 end]
98 set commitlisted($id) 1
99 parsecommit $id $cmit 1
101 if {[clock clicks -milliseconds] >= $nextupdate} {
104 while {$redisplaying} {
108 set phase "getcommits"
109 foreach id $commits {
112 if {[clock clicks -milliseconds] >= $nextupdate} {
122 global commfd nextupdate
125 fileevent $commfd readable {}
127 fileevent $commfd readable "getcommitlines $commfd"
130 proc readcommit {id} {
131 if [catch {set contents [exec git-cat-file commit $id]}] return
132 parsecommit $id $contents 0
135 proc parsecommit {id contents listed} {
136 global commitinfo children nchildren parents nparents cdate ncleft
145 if {![info exists nchildren($id)]} {
152 foreach line [split $contents "\n"] {
157 set tag [lindex $line 0]
158 if {$tag == "parent"} {
159 set p [lindex $line 1]
160 if {![info exists nchildren($p)]} {
165 lappend parents($id) $p
167 # sometimes we get a commit that lists a parent twice...
168 if {$listed && [lsearch -exact $children($p) $id] < 0} {
169 lappend children($p) $id
173 } elseif {$tag == "author"} {
174 set x [expr {[llength $line] - 2}]
175 set audate [lindex $line $x]
176 set auname [lrange $line 1 [expr {$x - 1}]]
177 } elseif {$tag == "committer"} {
178 set x [expr {[llength $line] - 2}]
179 set comdate [lindex $line $x]
180 set comname [lrange $line 1 [expr {$x - 1}]]
184 if {$comment == {}} {
185 set headline [string trim $line]
190 # git-rev-list indents the comment by 4 spaces;
191 # if we got this via git-cat-file, add the indentation
198 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
200 if {$comdate != {}} {
201 set cdate($id) $comdate
202 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
204 set commitinfo($id) [list $headline $auname $audate \
205 $comname $comdate $comment]
209 global tagids idtags headids idheads
210 set tags [glob -nocomplain -types f .git/refs/tags/*]
215 if {[regexp {^[0-9a-f]{40}} $line id]} {
216 set direct [file tail $f]
217 set tagids($direct) $id
218 lappend idtags($id) $direct
219 set contents [split [exec git-cat-file tag $id] "\n"]
223 foreach l $contents {
225 switch -- [lindex $l 0] {
226 "object" {set obj [lindex $l 1]}
227 "type" {set type [lindex $l 1]}
228 "tag" {set tag [string range $l 4 end]}
231 if {$obj != {} && $type == "commit" && $tag != {}} {
232 set tagids($tag) $obj
233 lappend idtags($obj) $tag
239 set heads [glob -nocomplain -types f .git/refs/heads/*]
243 set line [read $fd 40]
244 if {[regexp {^[0-9a-f]{40}} $line id]} {
245 set head [file tail $f]
246 set headids($head) $line
247 lappend idheads($line) $head
254 proc error_popup msg {
258 message $w.m -text $msg -justify center -aspect 400
259 pack $w.m -side top -fill x -padx 20 -pady 20
260 button $w.ok -text OK -command "destroy $w"
261 pack $w.ok -side bottom -fill x
262 bind $w <Visibility> "grab $w; focus $w"
267 global canv canv2 canv3 linespc charspc ctext cflist textfont
268 global findtype findloc findstring fstring geometry
269 global entries sha1entry sha1string sha1but
270 global maincursor textcursor
274 .bar add cascade -label "File" -menu .bar.file
276 .bar.file add command -label "Quit" -command doquit
278 .bar add cascade -label "Help" -menu .bar.help
279 .bar.help add command -label "About gitk" -command about
280 . configure -menu .bar
282 if {![info exists geometry(canv1)]} {
283 set geometry(canv1) [expr 45 * $charspc]
284 set geometry(canv2) [expr 30 * $charspc]
285 set geometry(canv3) [expr 15 * $charspc]
286 set geometry(canvh) [expr 25 * $linespc + 4]
287 set geometry(ctextw) 80
288 set geometry(ctexth) 30
289 set geometry(cflistw) 30
291 panedwindow .ctop -orient vertical
292 if {[info exists geometry(width)]} {
293 .ctop conf -width $geometry(width) -height $geometry(height)
294 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
295 set geometry(ctexth) [expr {($texth - 8) /
296 [font metrics $textfont -linespace]}]
300 pack .ctop.top.bar -side bottom -fill x
301 set cscroll .ctop.top.csb
302 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
303 pack $cscroll -side right -fill y
304 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
305 pack .ctop.top.clist -side top -fill both -expand 1
307 set canv .ctop.top.clist.canv
308 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
310 -yscrollincr $linespc -yscrollcommand "$cscroll set"
311 .ctop.top.clist add $canv
312 set canv2 .ctop.top.clist.canv2
313 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
314 -bg white -bd 0 -yscrollincr $linespc
315 .ctop.top.clist add $canv2
316 set canv3 .ctop.top.clist.canv3
317 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
318 -bg white -bd 0 -yscrollincr $linespc
319 .ctop.top.clist add $canv3
320 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
322 set sha1entry .ctop.top.bar.sha1
323 set entries $sha1entry
324 set sha1but .ctop.top.bar.sha1label
325 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
326 -command gotocommit -width 8
327 $sha1but conf -disabledforeground [$sha1but cget -foreground]
328 pack .ctop.top.bar.sha1label -side left
329 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
330 trace add variable sha1string write sha1change
331 pack $sha1entry -side left -pady 2
332 button .ctop.top.bar.findbut -text "Find" -command dofind
333 pack .ctop.top.bar.findbut -side left
335 set fstring .ctop.top.bar.findstring
336 lappend entries $fstring
337 entry $fstring -width 30 -font $textfont -textvariable findstring
338 pack $fstring -side left -expand 1 -fill x
340 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
341 set findloc "All fields"
342 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
343 Comments Author Committer
344 pack .ctop.top.bar.findloc -side right
345 pack .ctop.top.bar.findtype -side right
347 panedwindow .ctop.cdet -orient horizontal
349 frame .ctop.cdet.left
350 set ctext .ctop.cdet.left.ctext
351 text $ctext -bg white -state disabled -font $textfont \
352 -width $geometry(ctextw) -height $geometry(ctexth) \
353 -yscrollcommand ".ctop.cdet.left.sb set"
354 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
355 pack .ctop.cdet.left.sb -side right -fill y
356 pack $ctext -side left -fill both -expand 1
357 .ctop.cdet add .ctop.cdet.left
359 $ctext tag conf filesep -font [concat $textfont bold]
360 $ctext tag conf hunksep -back blue -fore white
361 $ctext tag conf d0 -back "#ff8080"
362 $ctext tag conf d1 -back green
363 $ctext tag conf found -back yellow
365 frame .ctop.cdet.right
366 set cflist .ctop.cdet.right.cfiles
367 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
368 -yscrollcommand ".ctop.cdet.right.sb set"
369 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
370 pack .ctop.cdet.right.sb -side right -fill y
371 pack $cflist -side left -fill both -expand 1
372 .ctop.cdet add .ctop.cdet.right
373 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
375 pack .ctop -side top -fill both -expand 1
377 bindall <1> {selcanvline %W %x %y}
378 #bindall <B1-Motion> {selcanvline %W %x %y}
379 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
380 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
381 bindall <2> "allcanvs scan mark 0 %y"
382 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
383 bind . <Key-Up> "selnextline -1"
384 bind . <Key-Down> "selnextline 1"
385 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
386 bind . <Key-Next> "allcanvs yview scroll 1 pages"
387 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
388 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
389 bindkey <Key-space> "$ctext yview scroll 1 pages"
390 bindkey p "selnextline -1"
391 bindkey n "selnextline 1"
392 bindkey b "$ctext yview scroll -1 pages"
393 bindkey d "$ctext yview scroll 18 units"
394 bindkey u "$ctext yview scroll -18 units"
398 bind . <Control-q> doquit
399 bind . <Control-f> dofind
400 bind . <Control-g> findnext
401 bind . <Control-r> findprev
402 bind . <Control-equal> {incrfont 1}
403 bind . <Control-KP_Add> {incrfont 1}
404 bind . <Control-minus> {incrfont -1}
405 bind . <Control-KP_Subtract> {incrfont -1}
406 bind $cflist <<ListboxSelect>> listboxsel
407 bind . <Destroy> {savestuff %W}
408 bind . <Button-1> "click %W"
409 bind $fstring <Key-Return> dofind
410 bind $sha1entry <Key-Return> gotocommit
411 bind $sha1entry <<PasteSelection>> clearsha1
413 set maincursor [. cget -cursor]
414 set textcursor [$ctext cget -cursor]
416 set rowctxmenu .rowctxmenu
417 menu $rowctxmenu -tearoff 0
418 $rowctxmenu add command -label "Diff this -> selected" \
419 -command {diffvssel 0}
420 $rowctxmenu add command -label "Diff selected -> this" \
421 -command {diffvssel 1}
422 $rowctxmenu add command -label "Make patch" -command mkpatch
425 # when we make a key binding for the toplevel, make sure
426 # it doesn't get triggered when that key is pressed in the
427 # find string entry widget.
428 proc bindkey {ev script} {
431 set escript [bind Entry $ev]
432 if {$escript == {}} {
433 set escript [bind Entry <Key>]
436 bind $e $ev "$escript; break"
440 # set the focus back to the toplevel for any click outside
451 global canv canv2 canv3 ctext cflist mainfont textfont
453 if {$stuffsaved} return
454 if {![winfo viewable .]} return
456 set f [open "~/.gitk-new" w]
457 puts $f "set mainfont {$mainfont}"
458 puts $f "set textfont {$textfont}"
459 puts $f "set geometry(width) [winfo width .ctop]"
460 puts $f "set geometry(height) [winfo height .ctop]"
461 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
462 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
463 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
464 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
465 set wid [expr {([winfo width $ctext] - 8) \
466 / [font measure $textfont "0"]}]
467 puts $f "set geometry(ctextw) $wid"
468 set wid [expr {([winfo width $cflist] - 11) \
469 / [font measure [$cflist cget -font] "0"]}]
470 puts $f "set geometry(cflistw) $wid"
472 file rename -force "~/.gitk-new" "~/.gitk"
477 proc resizeclistpanes {win w} {
479 if [info exists oldwidth($win)] {
480 set s0 [$win sash coord 0]
481 set s1 [$win sash coord 1]
483 set sash0 [expr {int($w/2 - 2)}]
484 set sash1 [expr {int($w*5/6 - 2)}]
486 set factor [expr {1.0 * $w / $oldwidth($win)}]
487 set sash0 [expr {int($factor * [lindex $s0 0])}]
488 set sash1 [expr {int($factor * [lindex $s1 0])}]
492 if {$sash1 < $sash0 + 20} {
493 set sash1 [expr $sash0 + 20]
495 if {$sash1 > $w - 10} {
496 set sash1 [expr $w - 10]
497 if {$sash0 > $sash1 - 20} {
498 set sash0 [expr $sash1 - 20]
502 $win sash place 0 $sash0 [lindex $s0 1]
503 $win sash place 1 $sash1 [lindex $s1 1]
505 set oldwidth($win) $w
508 proc resizecdetpanes {win w} {
510 if [info exists oldwidth($win)] {
511 set s0 [$win sash coord 0]
513 set sash0 [expr {int($w*3/4 - 2)}]
515 set factor [expr {1.0 * $w / $oldwidth($win)}]
516 set sash0 [expr {int($factor * [lindex $s0 0])}]
520 if {$sash0 > $w - 15} {
521 set sash0 [expr $w - 15]
524 $win sash place 0 $sash0 [lindex $s0 1]
526 set oldwidth($win) $w
530 global canv canv2 canv3
536 proc bindall {event action} {
537 global canv canv2 canv3
538 bind $canv $event $action
539 bind $canv2 $event $action
540 bind $canv3 $event $action
545 if {[winfo exists $w]} {
550 wm title $w "About gitk"
554 Copyright © 2005 Paul Mackerras
556 Use and redistribute under the terms of the GNU General Public License} \
557 -justify center -aspect 400
558 pack $w.m -side top -fill x -padx 20 -pady 20
559 button $w.ok -text Close -command "destroy $w"
560 pack $w.ok -side bottom
563 proc assigncolor {id} {
564 global commitinfo colormap commcolors colors nextcolor
565 global parents nparents children nchildren
566 global cornercrossings crossings
568 if [info exists colormap($id)] return
569 set ncolors [llength $colors]
570 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
571 set child [lindex $children($id) 0]
572 if {[info exists colormap($child)]
573 && $nparents($child) == 1} {
574 set colormap($id) $colormap($child)
579 if {[info exists cornercrossings($id)]} {
580 foreach x $cornercrossings($id) {
581 if {[info exists colormap($x)]
582 && [lsearch -exact $badcolors $colormap($x)] < 0} {
583 lappend badcolors $colormap($x)
586 if {[llength $badcolors] >= $ncolors} {
590 set origbad $badcolors
591 if {[llength $badcolors] < $ncolors - 1} {
592 if {[info exists crossings($id)]} {
593 foreach x $crossings($id) {
594 if {[info exists colormap($x)]
595 && [lsearch -exact $badcolors $colormap($x)] < 0} {
596 lappend badcolors $colormap($x)
599 if {[llength $badcolors] >= $ncolors} {
600 set badcolors $origbad
603 set origbad $badcolors
605 if {[llength $badcolors] < $ncolors - 1} {
606 foreach child $children($id) {
607 if {[info exists colormap($child)]
608 && [lsearch -exact $badcolors $colormap($child)] < 0} {
609 lappend badcolors $colormap($child)
611 if {[info exists parents($child)]} {
612 foreach p $parents($child) {
613 if {[info exists colormap($p)]
614 && [lsearch -exact $badcolors $colormap($p)] < 0} {
615 lappend badcolors $colormap($p)
620 if {[llength $badcolors] >= $ncolors} {
621 set badcolors $origbad
624 for {set i 0} {$i <= $ncolors} {incr i} {
625 set c [lindex $colors $nextcolor]
626 if {[incr nextcolor] >= $ncolors} {
629 if {[lsearch -exact $badcolors $c]} break
635 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
636 global mainline sidelines
637 global nchildren ncleft
644 set lthickness [expr {int($linespc / 9) + 1}]
645 catch {unset mainline}
646 catch {unset sidelines}
647 foreach id [array names nchildren] {
648 set ncleft($id) $nchildren($id)
652 proc bindline {t id} {
655 $canv bind $t <Enter> "lineenter %x %y $id"
656 $canv bind $t <Motion> "linemotion %x %y $id"
657 $canv bind $t <Leave> "lineleave $id"
658 $canv bind $t <Button-1> "lineclick %x %y $id"
661 proc drawcommitline {level} {
662 global parents children nparents nchildren todo
663 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
664 global lineid linehtag linentag linedtag commitinfo
665 global colormap numcommits currentparents dupparents
666 global oldlevel oldnlines oldtodo
667 global idtags idline idheads
668 global lineno lthickness mainline sidelines
669 global commitlisted rowtextx
673 set id [lindex $todo $level]
674 set lineid($lineno) $id
675 set idline($id) $lineno
676 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
677 if {![info exists commitinfo($id)]} {
679 if {![info exists commitinfo($id)]} {
680 set commitinfo($id) {"No commit information available"}
685 set currentparents {}
687 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
688 foreach p $parents($id) {
689 if {[lsearch -exact $currentparents $p] < 0} {
690 lappend currentparents $p
692 # remember that this parent was listed twice
693 lappend dupparents $p
697 set x [expr $canvx0 + $level * $linespc]
699 set canvy [expr $canvy + $linespc]
700 allcanvs conf -scrollregion \
701 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
702 if {[info exists mainline($id)]} {
703 lappend mainline($id) $x $y1
704 set t [$canv create line $mainline($id) \
705 -width $lthickness -fill $colormap($id)]
709 if {[info exists sidelines($id)]} {
710 foreach ls $sidelines($id) {
711 set coords [lindex $ls 0]
712 set thick [lindex $ls 1]
713 set t [$canv create line $coords -fill $colormap($id) \
714 -width [expr {$thick * $lthickness}]]
719 set orad [expr {$linespc / 3}]
720 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
721 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
722 -fill $ofill -outline black -width 1]
724 $canv bind $t <1> {selcanvline {} %x %y}
725 set xt [expr $canvx0 + [llength $todo] * $linespc]
726 if {[llength $currentparents] > 2} {
727 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
729 set rowtextx($lineno) $xt
732 if {[info exists idtags($id)]} {
733 set marks $idtags($id)
734 set ntags [llength $marks]
736 if {[info exists idheads($id)]} {
737 set marks [concat $marks $idheads($id)]
740 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
741 set yt [expr $y1 - 0.5 * $linespc]
742 set yb [expr $yt + $linespc - 1]
746 set wid [font measure $mainfont $tag]
749 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
751 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
752 -width $lthickness -fill black]
754 foreach tag $marks x $xvals wid $wvals {
755 set xl [expr $x + $delta]
756 set xr [expr $x + $delta + $wid + $lthickness]
757 if {[incr ntags -1] >= 0} {
759 $canv create polygon $x [expr $yt + $delta] $xl $yt\
760 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
761 -width 1 -outline black -fill yellow
764 set xl [expr $xl - $delta/2]
765 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
766 -width 1 -outline black -fill green
768 $canv create text $xl $y1 -anchor w -text $tag \
772 set headline [lindex $commitinfo($id) 0]
773 set name [lindex $commitinfo($id) 1]
774 set date [lindex $commitinfo($id) 2]
775 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
776 -text $headline -font $mainfont ]
777 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
778 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
779 -text $name -font $namefont]
780 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
781 -text $date -font $mainfont]
784 proc updatetodo {level noshortcut} {
785 global currentparents ncleft todo
786 global mainline oldlevel oldtodo oldnlines
787 global canvx0 canvy linespc mainline
792 set oldnlines [llength $todo]
793 if {!$noshortcut && [llength $currentparents] == 1} {
794 set p [lindex $currentparents 0]
795 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
797 set x [expr $canvx0 + $level * $linespc]
798 set y [expr $canvy - $linespc]
799 set mainline($p) [list $x $y]
800 set todo [lreplace $todo $level $level $p]
805 set todo [lreplace $todo $level $level]
807 foreach p $currentparents {
809 set k [lsearch -exact $todo $p]
811 set todo [linsert $todo $i $p]
818 proc notecrossings {id lo hi corner} {
819 global oldtodo crossings cornercrossings
821 for {set i $lo} {[incr i] < $hi} {} {
822 set p [lindex $oldtodo $i]
823 if {$p == {}} continue
825 if {![info exists cornercrossings($id)]
826 || [lsearch -exact $cornercrossings($id) $p] < 0} {
827 lappend cornercrossings($id) $p
829 if {![info exists cornercrossings($p)]
830 || [lsearch -exact $cornercrossings($p) $id] < 0} {
831 lappend cornercrossings($p) $id
834 if {![info exists crossings($id)]
835 || [lsearch -exact $crossings($id) $p] < 0} {
836 lappend crossings($id) $p
838 if {![info exists crossings($p)]
839 || [lsearch -exact $crossings($p) $id] < 0} {
840 lappend crossings($p) $id
847 global canv mainline sidelines canvx0 canvy linespc
848 global oldlevel oldtodo todo currentparents dupparents
849 global lthickness linespc canvy colormap
851 set y1 [expr $canvy - $linespc]
854 foreach id $oldtodo {
856 if {$id == {}} continue
857 set xi [expr {$canvx0 + $i * $linespc}]
858 if {$i == $oldlevel} {
859 foreach p $currentparents {
860 set j [lsearch -exact $todo $p]
861 set coords [list $xi $y1]
862 set xj [expr {$canvx0 + $j * $linespc}]
864 lappend coords [expr $xj + $linespc] $y1
865 notecrossings $p $j $i [expr {$j + 1}]
866 } elseif {$j > $i + 1} {
867 lappend coords [expr $xj - $linespc] $y1
868 notecrossings $p $i $j [expr {$j - 1}]
870 if {[lsearch -exact $dupparents $p] >= 0} {
871 # draw a double-width line to indicate the doubled parent
872 lappend coords $xj $y2
873 lappend sidelines($p) [list $coords 2]
874 if {![info exists mainline($p)]} {
875 set mainline($p) [list $xj $y2]
878 # normal case, no parent duplicated
879 if {![info exists mainline($p)]} {
881 lappend coords $xj $y2
883 set mainline($p) $coords
885 lappend coords $xj $y2
886 lappend sidelines($p) [list $coords 1]
890 } elseif {[lindex $todo $i] != $id} {
891 set j [lsearch -exact $todo $id]
892 set xj [expr {$canvx0 + $j * $linespc}]
893 lappend mainline($id) $xi $y1 $xj $y2
898 proc decidenext {{noread 0}} {
899 global parents children nchildren ncleft todo
900 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
901 global datemode cdate
903 global currentparents oldlevel oldnlines oldtodo
904 global lineno lthickness
906 # remove the null entry if present
907 set nullentry [lsearch -exact $todo {}]
908 if {$nullentry >= 0} {
909 set todo [lreplace $todo $nullentry $nullentry]
912 # choose which one to do next time around
913 set todol [llength $todo]
916 for {set k $todol} {[incr k -1] >= 0} {} {
917 set p [lindex $todo $k]
918 if {$ncleft($p) == 0} {
920 if {![info exists commitinfo($p)]} {
926 if {$latest == {} || $cdate($p) > $latest} {
928 set latest $cdate($p)
938 puts "ERROR: none of the pending commits can be done yet:"
940 puts " $p ($ncleft($p))"
946 # If we are reducing, put in a null entry
947 if {$todol < $oldnlines} {
948 if {$nullentry >= 0} {
951 && [lindex $oldtodo $i] == [lindex $todo $i]} {
961 set todo [linsert $todo $i {}]
970 proc drawcommit {id} {
971 global phase todo nchildren datemode nextupdate
974 if {$phase != "incrdraw"} {
980 updatetodo 0 $datemode
982 if {$nchildren($id) == 0} {
984 lappend startcommits $id
986 set level [decidenext 1]
987 if {$level == {} || $id != [lindex $todo $level]} {
992 drawcommitline $level
993 if {[updatetodo $level $datemode]} {
994 set level [decidenext 1]
995 if {$level == {}} break
997 set id [lindex $todo $level]
998 if {![info exists commitlisted($id)]} {
1001 if {[clock clicks -milliseconds] >= $nextupdate} {
1009 proc finishcommits {} {
1012 global canv mainfont ctext maincursor textcursor
1014 if {$phase != "incrdraw"} {
1016 $canv create text 3 3 -anchor nw -text "No commits selected" \
1017 -font $mainfont -tags textitems
1021 set level [decidenext]
1022 drawrest $level [llength $startcommits]
1024 . config -cursor $maincursor
1025 $ctext config -cursor $textcursor
1029 global nextupdate startmsecs startcommits todo
1031 if {$startcommits == {}} return
1032 set startmsecs [clock clicks -milliseconds]
1033 set nextupdate [expr $startmsecs + 100]
1035 set todo [lindex $startcommits 0]
1039 proc drawrest {level startix} {
1040 global phase stopped redisplaying selectedline
1041 global datemode currentparents todo
1043 global nextupdate startmsecs startcommits idline
1047 set startid [lindex $startcommits $startix]
1049 if {$startid != {}} {
1050 set startline $idline($startid)
1054 drawcommitline $level
1055 set hard [updatetodo $level $datemode]
1056 if {$numcommits == $startline} {
1057 lappend todo $startid
1060 set startid [lindex $startcommits $startix]
1062 if {$startid != {}} {
1063 set startline $idline($startid)
1067 set level [decidenext]
1068 if {$level < 0} break
1071 if {[clock clicks -milliseconds] >= $nextupdate} {
1078 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1079 #puts "overall $drawmsecs ms for $numcommits commits"
1080 if {$redisplaying} {
1081 if {$stopped == 0 && [info exists selectedline]} {
1082 selectline $selectedline
1084 if {$stopped == 1} {
1086 after idle drawgraph
1093 proc findmatches {f} {
1094 global findtype foundstring foundstrlen
1095 if {$findtype == "Regexp"} {
1096 set matches [regexp -indices -all -inline $foundstring $f]
1098 if {$findtype == "IgnCase"} {
1099 set str [string tolower $f]
1105 while {[set j [string first $foundstring $str $i]] >= 0} {
1106 lappend matches [list $j [expr $j+$foundstrlen-1]]
1107 set i [expr $j + $foundstrlen]
1114 global findtype findloc findstring markedmatches commitinfo
1115 global numcommits lineid linehtag linentag linedtag
1116 global mainfont namefont canv canv2 canv3 selectedline
1117 global matchinglines foundstring foundstrlen
1120 set matchinglines {}
1121 set fldtypes {Headline Author Date Committer CDate Comment}
1122 if {$findtype == "IgnCase"} {
1123 set foundstring [string tolower $findstring]
1125 set foundstring $findstring
1127 set foundstrlen [string length $findstring]
1128 if {$foundstrlen == 0} return
1129 if {![info exists selectedline]} {
1132 set oldsel $selectedline
1135 for {set l 0} {$l < $numcommits} {incr l} {
1137 set info $commitinfo($id)
1139 foreach f $info ty $fldtypes {
1140 if {$findloc != "All fields" && $findloc != $ty} {
1143 set matches [findmatches $f]
1144 if {$matches == {}} continue
1146 if {$ty == "Headline"} {
1147 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1148 } elseif {$ty == "Author"} {
1149 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1150 } elseif {$ty == "Date"} {
1151 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1155 lappend matchinglines $l
1156 if {!$didsel && $l > $oldsel} {
1162 if {$matchinglines == {}} {
1164 } elseif {!$didsel} {
1165 findselectline [lindex $matchinglines 0]
1169 proc findselectline {l} {
1170 global findloc commentend ctext
1172 if {$findloc == "All fields" || $findloc == "Comments"} {
1173 # highlight the matches in the comments
1174 set f [$ctext get 1.0 $commentend]
1175 set matches [findmatches $f]
1176 foreach match $matches {
1177 set start [lindex $match 0]
1178 set end [expr [lindex $match 1] + 1]
1179 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1185 global matchinglines selectedline
1186 if {![info exists matchinglines]} {
1190 if {![info exists selectedline]} return
1191 foreach l $matchinglines {
1192 if {$l > $selectedline} {
1201 global matchinglines selectedline
1202 if {![info exists matchinglines]} {
1206 if {![info exists selectedline]} return
1208 foreach l $matchinglines {
1209 if {$l >= $selectedline} break
1213 findselectline $prev
1219 proc markmatches {canv l str tag matches font} {
1220 set bbox [$canv bbox $tag]
1221 set x0 [lindex $bbox 0]
1222 set y0 [lindex $bbox 1]
1223 set y1 [lindex $bbox 3]
1224 foreach match $matches {
1225 set start [lindex $match 0]
1226 set end [lindex $match 1]
1227 if {$start > $end} continue
1228 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1229 set xlen [font measure $font [string range $str 0 [expr $end]]]
1230 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1231 -outline {} -tags matches -fill yellow]
1236 proc unmarkmatches {} {
1237 global matchinglines
1238 allcanvs delete matches
1239 catch {unset matchinglines}
1242 proc selcanvline {w x y} {
1243 global canv canvy0 ctext linespc selectedline
1244 global lineid linehtag linentag linedtag rowtextx
1245 set ymax [lindex [$canv cget -scrollregion] 3]
1246 if {$ymax == {}} return
1247 set yfrac [lindex [$canv yview] 0]
1248 set y [expr {$y + $yfrac * $ymax}]
1249 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1254 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1260 proc selectline {l} {
1261 global canv canv2 canv3 ctext commitinfo selectedline
1262 global lineid linehtag linentag linedtag
1263 global canvy0 linespc parents nparents
1264 global cflist currentid sha1entry diffids
1265 global commentend seenfile idtags
1267 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1269 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1270 -tags secsel -fill [$canv cget -selectbackground]]
1272 $canv2 delete secsel
1273 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1274 -tags secsel -fill [$canv2 cget -selectbackground]]
1276 $canv3 delete secsel
1277 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1278 -tags secsel -fill [$canv3 cget -selectbackground]]
1280 set y [expr {$canvy0 + $l * $linespc}]
1281 set ymax [lindex [$canv cget -scrollregion] 3]
1282 set ytop [expr {$y - $linespc - 1}]
1283 set ybot [expr {$y + $linespc + 1}]
1284 set wnow [$canv yview]
1285 set wtop [expr [lindex $wnow 0] * $ymax]
1286 set wbot [expr [lindex $wnow 1] * $ymax]
1287 set wh [expr {$wbot - $wtop}]
1289 if {$ytop < $wtop} {
1290 if {$ybot < $wtop} {
1291 set newtop [expr {$y - $wh / 2.0}]
1294 if {$newtop > $wtop - $linespc} {
1295 set newtop [expr {$wtop - $linespc}]
1298 } elseif {$ybot > $wbot} {
1299 if {$ytop > $wbot} {
1300 set newtop [expr {$y - $wh / 2.0}]
1302 set newtop [expr {$ybot - $wh}]
1303 if {$newtop < $wtop + $linespc} {
1304 set newtop [expr {$wtop + $linespc}]
1308 if {$newtop != $wtop} {
1312 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1318 set diffids [concat $id $parents($id)]
1319 $sha1entry delete 0 end
1320 $sha1entry insert 0 $id
1321 $sha1entry selection from 0
1322 $sha1entry selection to end
1324 $ctext conf -state normal
1325 $ctext delete 0.0 end
1326 $ctext mark set fmark.0 0.0
1327 $ctext mark gravity fmark.0 left
1328 set info $commitinfo($id)
1329 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1330 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1331 if {[info exists idtags($id)]} {
1332 $ctext insert end "Tags:"
1333 foreach tag $idtags($id) {
1334 $ctext insert end " $tag"
1336 $ctext insert end "\n"
1338 $ctext insert end "\n"
1339 $ctext insert end [lindex $info 5]
1340 $ctext insert end "\n"
1341 $ctext tag delete Comments
1342 $ctext tag remove found 1.0 end
1343 $ctext conf -state disabled
1344 set commentend [$ctext index "end - 1c"]
1346 $cflist delete 0 end
1347 $cflist insert end "Comments"
1348 if {$nparents($id) == 1} {
1351 catch {unset seenfile}
1355 global treediffs diffids treepending
1357 if {![info exists treediffs($diffids)]} {
1358 if {![info exists treepending]} {
1359 gettreediffs $diffids
1362 addtocflist $diffids
1366 proc selnextline {dir} {
1368 if {![info exists selectedline]} return
1369 set l [expr $selectedline + $dir]
1374 proc addtocflist {ids} {
1375 global diffids treediffs cflist
1376 if {$ids != $diffids} {
1377 gettreediffs $diffids
1380 foreach f $treediffs($ids) {
1381 $cflist insert end $f
1386 proc gettreediffs {ids} {
1387 global treediffs parents treepending
1388 set treepending $ids
1389 set treediffs($ids) {}
1390 set id [lindex $ids 0]
1391 set p [lindex $ids 1]
1392 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1393 fconfigure $gdtf -blocking 0
1394 fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
1397 proc gettreediffline {gdtf ids} {
1398 global treediffs treepending
1399 set n [gets $gdtf line]
1401 if {![eof $gdtf]} return
1407 set file [lindex $line 5]
1408 lappend treediffs($ids) $file
1411 proc getblobdiffs {ids} {
1412 global diffopts blobdifffd env curdifftag curtagstart
1413 global diffindex difffilestart nextupdate
1415 set id [lindex $ids 0]
1416 set p [lindex $ids 1]
1417 set env(GIT_DIFF_OPTS) $diffopts
1418 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1419 puts "error getting diffs: $err"
1422 fconfigure $bdf -blocking 0
1423 set blobdifffd($ids) $bdf
1424 set curdifftag Comments
1427 catch {unset difffilestart}
1428 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1429 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1432 proc getblobdiffline {bdf ids} {
1433 global diffids blobdifffd ctext curdifftag curtagstart seenfile
1434 global diffnexthead diffnextnote diffindex difffilestart
1437 set n [gets $bdf line]
1441 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1442 $ctext tag add $curdifftag $curtagstart end
1443 set seenfile($curdifftag) 1
1448 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1451 $ctext conf -state normal
1452 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1453 # start of a new file
1454 $ctext insert end "\n"
1455 $ctext tag add $curdifftag $curtagstart end
1456 set seenfile($curdifftag) 1
1457 set curtagstart [$ctext index "end - 1c"]
1459 if {[info exists diffnexthead]} {
1460 set fname $diffnexthead
1461 set header "$diffnexthead ($diffnextnote)"
1464 set here [$ctext index "end - 1c"]
1465 set difffilestart($diffindex) $here
1467 # start mark names at fmark.1 for first file
1468 $ctext mark set fmark.$diffindex $here
1469 $ctext mark gravity fmark.$diffindex left
1470 set curdifftag "f:$fname"
1471 $ctext tag delete $curdifftag
1472 set l [expr {(78 - [string length $header]) / 2}]
1473 set pad [string range "----------------------------------------" 1 $l]
1474 $ctext insert end "$pad $header $pad\n" filesep
1475 } elseif {[string range $line 0 2] == "+++"} {
1476 # no need to do anything with this
1477 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1478 set diffnexthead $fn
1479 set diffnextnote "created, mode $m"
1480 } elseif {[string range $line 0 8] == "Deleted: "} {
1481 set diffnexthead [string range $line 9 end]
1482 set diffnextnote "deleted"
1483 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1484 # save the filename in case the next thing is "new file mode ..."
1485 set diffnexthead $fn
1486 set diffnextnote "modified"
1487 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1488 set diffnextnote "new file, mode $m"
1489 } elseif {[string range $line 0 11] == "deleted file"} {
1490 set diffnextnote "deleted"
1491 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1492 $line match f1l f1c f2l f2c rest]} {
1493 $ctext insert end "\t" hunksep
1494 $ctext insert end " $f1l " d0 " $f2l " d1
1495 $ctext insert end " $rest \n" hunksep
1497 set x [string range $line 0 0]
1498 if {$x == "-" || $x == "+"} {
1499 set tag [expr {$x == "+"}]
1500 set line [string range $line 1 end]
1501 $ctext insert end "$line\n" d$tag
1502 } elseif {$x == " "} {
1503 set line [string range $line 1 end]
1504 $ctext insert end "$line\n"
1505 } elseif {$x == "\\"} {
1506 # e.g. "\ No newline at end of file"
1507 $ctext insert end "$line\n" filesep
1509 # Something else we don't recognize
1510 if {$curdifftag != "Comments"} {
1511 $ctext insert end "\n"
1512 $ctext tag add $curdifftag $curtagstart end
1513 set seenfile($curdifftag) 1
1514 set curtagstart [$ctext index "end - 1c"]
1515 set curdifftag Comments
1517 $ctext insert end "$line\n" filesep
1520 $ctext conf -state disabled
1521 if {[clock clicks -milliseconds] >= $nextupdate} {
1523 fileevent $bdf readable {}
1525 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1530 global difffilestart ctext
1531 set here [$ctext index @0,0]
1532 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1533 if {[$ctext compare $difffilestart($i) > $here]} {
1534 $ctext yview $difffilestart($i)
1540 proc listboxsel {} {
1541 global ctext cflist currentid treediffs seenfile
1542 if {![info exists currentid]} return
1543 set sel [lsort [$cflist curselection]]
1544 if {$sel eq {}} return
1545 set first [lindex $sel 0]
1546 catch {$ctext yview fmark.$first}
1550 global linespc charspc canvx0 canvy0 mainfont
1551 set linespc [font metrics $mainfont -linespace]
1552 set charspc [font measure $mainfont "m"]
1553 set canvy0 [expr 3 + 0.5 * $linespc]
1554 set canvx0 [expr 3 + 0.5 * $linespc]
1558 global selectedline stopped redisplaying phase
1559 if {$stopped > 1} return
1560 if {$phase == "getcommits"} return
1562 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1569 proc incrfont {inc} {
1570 global mainfont namefont textfont selectedline ctext canv phase
1571 global stopped entries
1573 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1574 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1575 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1577 $ctext conf -font $textfont
1578 $ctext tag conf filesep -font [concat $textfont bold]
1579 foreach e $entries {
1580 $e conf -font $mainfont
1582 if {$phase == "getcommits"} {
1583 $canv itemconf textitems -font $mainfont
1589 global sha1entry sha1string
1590 if {[string length $sha1string] == 40} {
1591 $sha1entry delete 0 end
1595 proc sha1change {n1 n2 op} {
1596 global sha1string currentid sha1but
1597 if {$sha1string == {}
1598 || ([info exists currentid] && $sha1string == $currentid)} {
1603 if {[$sha1but cget -state] == $state} return
1604 if {$state == "normal"} {
1605 $sha1but conf -state normal -relief raised -text "Goto: "
1607 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1611 proc gotocommit {} {
1612 global sha1string currentid idline tagids
1613 if {$sha1string == {}
1614 || ([info exists currentid] && $sha1string == $currentid)} return
1615 if {[info exists tagids($sha1string)]} {
1616 set id $tagids($sha1string)
1618 set id [string tolower $sha1string]
1620 if {[info exists idline($id)]} {
1621 selectline $idline($id)
1624 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1629 error_popup "$type $sha1string is not known"
1632 proc lineenter {x y id} {
1633 global hoverx hovery hoverid hovertimer
1634 global commitinfo canv
1636 if {![info exists commitinfo($id)]} return
1640 if {[info exists hovertimer]} {
1641 after cancel $hovertimer
1643 set hovertimer [after 500 linehover]
1647 proc linemotion {x y id} {
1648 global hoverx hovery hoverid hovertimer
1650 if {[info exists hoverid] && $id == $hoverid} {
1653 if {[info exists hovertimer]} {
1654 after cancel $hovertimer
1656 set hovertimer [after 500 linehover]
1660 proc lineleave {id} {
1661 global hoverid hovertimer canv
1663 if {[info exists hoverid] && $id == $hoverid} {
1665 if {[info exists hovertimer]} {
1666 after cancel $hovertimer
1674 global hoverx hovery hoverid hovertimer
1675 global canv linespc lthickness
1676 global commitinfo mainfont
1678 set text [lindex $commitinfo($hoverid) 0]
1679 set ymax [lindex [$canv cget -scrollregion] 3]
1680 if {$ymax == {}} return
1681 set yfrac [lindex [$canv yview] 0]
1682 set x [expr {$hoverx + 2 * $linespc}]
1683 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1684 set x0 [expr {$x - 2 * $lthickness}]
1685 set y0 [expr {$y - 2 * $lthickness}]
1686 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1687 set y1 [expr {$y + $linespc + 2 * $lthickness}]
1688 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1689 -fill \#ffff80 -outline black -width 1 -tags hover]
1691 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1695 proc lineclick {x y id} {
1696 global ctext commitinfo children cflist canv
1700 # fill the details pane with info about this line
1701 $ctext conf -state normal
1702 $ctext delete 0.0 end
1703 $ctext insert end "Parent:\n "
1704 catch {destroy $ctext.$id}
1705 button $ctext.$id -text "Go:" -command "selbyid $id" \
1707 $ctext window create end -window $ctext.$id -align center
1708 set info $commitinfo($id)
1709 $ctext insert end "\t[lindex $info 0]\n"
1710 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
1711 $ctext insert end "\tDate:\t[lindex $info 2]\n"
1712 $ctext insert end "\tID:\t$id\n"
1713 if {[info exists children($id)]} {
1714 $ctext insert end "\nChildren:"
1715 foreach child $children($id) {
1716 $ctext insert end "\n "
1717 catch {destroy $ctext.$child}
1718 button $ctext.$child -text "Go:" -command "selbyid $child" \
1720 $ctext window create end -window $ctext.$child -align center
1721 set info $commitinfo($child)
1722 $ctext insert end "\t[lindex $info 0]"
1725 $ctext conf -state disabled
1727 $cflist delete 0 end
1732 if {[info exists idline($id)]} {
1733 selectline $idline($id)
1739 if {![info exists startmstime]} {
1740 set startmstime [clock clicks -milliseconds]
1742 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
1745 proc rowmenu {x y id} {
1746 global rowctxmenu idline selectedline rowmenuid
1748 if {![info exists selectedline] || $idline($id) eq $selectedline} {
1753 $rowctxmenu entryconfigure 0 -state $state
1754 $rowctxmenu entryconfigure 1 -state $state
1755 $rowctxmenu entryconfigure 2 -state $state
1757 tk_popup $rowctxmenu $x $y
1760 proc diffvssel {dirn} {
1761 global rowmenuid selectedline lineid
1763 global diffids commitinfo
1765 if {![info exists selectedline]} return
1767 set oldid $lineid($selectedline)
1768 set newid $rowmenuid
1770 set oldid $rowmenuid
1771 set newid $lineid($selectedline)
1773 $ctext conf -state normal
1774 $ctext delete 0.0 end
1775 $ctext mark set fmark.0 0.0
1776 $ctext mark gravity fmark.0 left
1777 $cflist delete 0 end
1778 $cflist insert end "Top"
1779 $ctext insert end "From $oldid\n "
1780 $ctext insert end [lindex $commitinfo($oldid) 0]
1781 $ctext insert end "\n\nTo $newid\n "
1782 $ctext insert end [lindex $commitinfo($newid) 0]
1783 $ctext insert end "\n"
1784 $ctext conf -state disabled
1785 $ctext tag delete Comments
1786 $ctext tag remove found 1.0 end
1787 set diffids [list $newid $oldid]
1792 global rowmenuid currentid commitinfo patchtop patchnum
1794 if {![info exists currentid]} return
1795 set oldid $currentid
1796 set oldhead [lindex $commitinfo($oldid) 0]
1797 set newid $rowmenuid
1798 set newhead [lindex $commitinfo($newid) 0]
1801 catch {destroy $top}
1803 label $top.title -text "Generate patch"
1805 label $top.from -text "From:"
1806 entry $top.fromsha1 -width 40
1807 $top.fromsha1 insert 0 $oldid
1808 $top.fromsha1 conf -state readonly
1809 grid $top.from $top.fromsha1 -sticky w
1810 entry $top.fromhead -width 60
1811 $top.fromhead insert 0 $oldhead
1812 $top.fromhead conf -state readonly
1813 grid x $top.fromhead -sticky w
1814 label $top.to -text "To:"
1815 entry $top.tosha1 -width 40
1816 $top.tosha1 insert 0 $newid
1817 $top.tosha1 conf -state readonly
1818 grid $top.to $top.tosha1 -sticky w
1819 entry $top.tohead -width 60
1820 $top.tohead insert 0 $newhead
1821 $top.tohead conf -state readonly
1822 grid x $top.tohead -sticky w
1823 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
1824 grid $top.rev x -pady 10
1825 label $top.flab -text "Output file:"
1826 entry $top.fname -width 60
1827 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
1829 grid $top.flab $top.fname
1831 button $top.buts.gen -text "Generate" -command mkpatchgo
1832 button $top.buts.can -text "Cancel" -command mkpatchcan
1833 grid $top.buts.gen $top.buts.can
1834 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1835 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1836 grid $top.buts - -pady 10 -sticky ew
1839 proc mkpatchrev {} {
1842 set oldid [$patchtop.fromsha1 get]
1843 set oldhead [$patchtop.fromhead get]
1844 set newid [$patchtop.tosha1 get]
1845 set newhead [$patchtop.tohead get]
1846 foreach e [list fromsha1 fromhead tosha1 tohead] \
1847 v [list $newid $newhead $oldid $oldhead] {
1848 $patchtop.$e conf -state normal
1849 $patchtop.$e delete 0 end
1850 $patchtop.$e insert 0 $v
1851 $patchtop.$e conf -state readonly
1858 set oldid [$patchtop.fromsha1 get]
1859 set newid [$patchtop.tosha1 get]
1860 set fname [$patchtop.fname get]
1861 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
1862 error_popup "Error creating patch: $err"
1864 catch {destroy $patchtop}
1868 proc mkpatchcan {} {
1871 catch {destroy $patchtop}
1884 set diffopts "-U 5 -p"
1886 set mainfont {Helvetica 9}
1887 set textfont {Courier 9}
1889 set colors {green red blue magenta darkgrey brown orange}
1891 catch {source ~/.gitk}
1893 set namefont $mainfont
1895 lappend namefont bold
1900 switch -regexp -- $arg {
1902 "^-b" { set boldnames 1 }
1903 "^-d" { set datemode 1 }
1905 lappend revtreeargs $arg
1917 getcommits $revtreeargs