dd8f1f1494bab7c83121e31927b306cec2ea564e
1 #!/bin/sh
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 gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17 }
19 proc getcommits {rargs} {
20 global commits commfd phase canv mainfont env
21 global startmsecs nextupdate
22 global ctext maincursor textcursor leftover
24 # check that we can find a .git directory somewhere...
25 set gitdir [gitdir]
26 if {![file isdirectory $gitdir]} {
27 error_popup "Cannot find the git directory \"$gitdir\"."
28 exit 1
29 }
30 set commits {}
31 set phase getcommits
32 set startmsecs [clock clicks -milliseconds]
33 set nextupdate [expr $startmsecs + 100]
34 if [catch {
35 set parse_args [concat --default HEAD $rargs]
36 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
37 }] {
38 # if git-rev-parse failed for some reason...
39 if {$rargs == {}} {
40 set rargs HEAD
41 }
42 set parsed_args $rargs
43 }
44 if [catch {
45 set commfd [open "|git-rev-list --header --topo-order $parsed_args" r]
46 } err] {
47 puts stderr "Error executing git-rev-list: $err"
48 exit 1
49 }
50 set leftover {}
51 fconfigure $commfd -blocking 0 -translation binary
52 fileevent $commfd readable "getcommitlines $commfd"
53 $canv delete all
54 $canv create text 3 3 -anchor nw -text "Reading commits..." \
55 -font $mainfont -tags textitems
56 . config -cursor watch
57 $ctext config -cursor watch
58 }
60 proc getcommitlines {commfd} {
61 global commits parents cdate children nchildren
62 global commitlisted phase commitinfo nextupdate
63 global stopped redisplaying leftover
65 set stuff [read $commfd]
66 if {$stuff == {}} {
67 if {![eof $commfd]} return
68 # set it blocking so we wait for the process to terminate
69 fconfigure $commfd -blocking 1
70 if {![catch {close $commfd} err]} {
71 after idle finishcommits
72 return
73 }
74 if {[string range $err 0 4] == "usage"} {
75 set err \
76 {Gitk: error reading commits: bad arguments to git-rev-list.
77 (Note: arguments to gitk are passed to git-rev-list
78 to allow selection of commits to be displayed.)}
79 } else {
80 set err "Error reading commits: $err"
81 }
82 error_popup $err
83 exit 1
84 }
85 set start 0
86 while 1 {
87 set i [string first "\0" $stuff $start]
88 if {$i < 0} {
89 append leftover [string range $stuff $start end]
90 return
91 }
92 set cmit [string range $stuff $start [expr {$i - 1}]]
93 if {$start == 0} {
94 set cmit "$leftover$cmit"
95 set leftover {}
96 }
97 set start [expr {$i + 1}]
98 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
99 set shortcmit $cmit
100 if {[string length $shortcmit] > 80} {
101 set shortcmit "[string range $shortcmit 0 80]..."
102 }
103 error_popup "Can't parse git-rev-list output: {$shortcmit}"
104 exit 1
105 }
106 set cmit [string range $cmit 41 end]
107 lappend commits $id
108 set commitlisted($id) 1
109 parsecommit $id $cmit 1
110 drawcommit $id
111 if {[clock clicks -milliseconds] >= $nextupdate} {
112 doupdate
113 }
114 while {$redisplaying} {
115 set redisplaying 0
116 if {$stopped == 1} {
117 set stopped 0
118 set phase "getcommits"
119 foreach id $commits {
120 drawcommit $id
121 if {$stopped} break
122 if {[clock clicks -milliseconds] >= $nextupdate} {
123 doupdate
124 }
125 }
126 }
127 }
128 }
129 }
131 proc doupdate {} {
132 global commfd nextupdate
134 incr nextupdate 100
135 fileevent $commfd readable {}
136 update
137 fileevent $commfd readable "getcommitlines $commfd"
138 }
140 proc readcommit {id} {
141 if [catch {set contents [exec git-cat-file commit $id]}] return
142 parsecommit $id $contents 0
143 }
145 proc parsecommit {id contents listed} {
146 global commitinfo children nchildren parents nparents cdate ncleft
148 set inhdr 1
149 set comment {}
150 set headline {}
151 set auname {}
152 set audate {}
153 set comname {}
154 set comdate {}
155 if {![info exists nchildren($id)]} {
156 set children($id) {}
157 set nchildren($id) 0
158 set ncleft($id) 0
159 }
160 set parents($id) {}
161 set nparents($id) 0
162 foreach line [split $contents "\n"] {
163 if {$inhdr} {
164 if {$line == {}} {
165 set inhdr 0
166 } else {
167 set tag [lindex $line 0]
168 if {$tag == "parent"} {
169 set p [lindex $line 1]
170 if {![info exists nchildren($p)]} {
171 set children($p) {}
172 set nchildren($p) 0
173 set ncleft($p) 0
174 }
175 lappend parents($id) $p
176 incr nparents($id)
177 # sometimes we get a commit that lists a parent twice...
178 if {$listed && [lsearch -exact $children($p) $id] < 0} {
179 lappend children($p) $id
180 incr nchildren($p)
181 incr ncleft($p)
182 }
183 } elseif {$tag == "author"} {
184 set x [expr {[llength $line] - 2}]
185 set audate [lindex $line $x]
186 set auname [lrange $line 1 [expr {$x - 1}]]
187 } elseif {$tag == "committer"} {
188 set x [expr {[llength $line] - 2}]
189 set comdate [lindex $line $x]
190 set comname [lrange $line 1 [expr {$x - 1}]]
191 }
192 }
193 } else {
194 if {$comment == {}} {
195 set headline [string trim $line]
196 } else {
197 append comment "\n"
198 }
199 if {!$listed} {
200 # git-rev-list indents the comment by 4 spaces;
201 # if we got this via git-cat-file, add the indentation
202 append comment " "
203 }
204 append comment $line
205 }
206 }
207 if {$audate != {}} {
208 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
209 }
210 if {$comdate != {}} {
211 set cdate($id) $comdate
212 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
213 }
214 set commitinfo($id) [list $headline $auname $audate \
215 $comname $comdate $comment]
216 }
218 proc readrefs {} {
219 global tagids idtags headids idheads
220 set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
221 foreach f $tags {
222 catch {
223 set fd [open $f r]
224 set line [read $fd]
225 if {[regexp {^[0-9a-f]{40}} $line id]} {
226 set direct [file tail $f]
227 set tagids($direct) $id
228 lappend idtags($id) $direct
229 set contents [split [exec git-cat-file tag $id] "\n"]
230 set obj {}
231 set type {}
232 set tag {}
233 foreach l $contents {
234 if {$l == {}} break
235 switch -- [lindex $l 0] {
236 "object" {set obj [lindex $l 1]}
237 "type" {set type [lindex $l 1]}
238 "tag" {set tag [string range $l 4 end]}
239 }
240 }
241 if {$obj != {} && $type == "commit" && $tag != {}} {
242 set tagids($tag) $obj
243 lappend idtags($obj) $tag
244 }
245 }
246 close $fd
247 }
248 }
249 set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
250 foreach f $heads {
251 catch {
252 set fd [open $f r]
253 set line [read $fd 40]
254 if {[regexp {^[0-9a-f]{40}} $line id]} {
255 set head [file tail $f]
256 set headids($head) $line
257 lappend idheads($line) $head
258 }
259 close $fd
260 }
261 }
262 }
264 proc error_popup msg {
265 set w .error
266 toplevel $w
267 wm transient $w .
268 message $w.m -text $msg -justify center -aspect 400
269 pack $w.m -side top -fill x -padx 20 -pady 20
270 button $w.ok -text OK -command "destroy $w"
271 pack $w.ok -side bottom -fill x
272 bind $w <Visibility> "grab $w; focus $w"
273 tkwait window $w
274 }
276 proc makewindow {} {
277 global canv canv2 canv3 linespc charspc ctext cflist textfont
278 global findtype findtypemenu findloc findstring fstring geometry
279 global entries sha1entry sha1string sha1but
280 global maincursor textcursor
281 global rowctxmenu gaudydiff mergemax
283 menu .bar
284 .bar add cascade -label "File" -menu .bar.file
285 menu .bar.file
286 .bar.file add command -label "Quit" -command doquit
287 menu .bar.help
288 .bar add cascade -label "Help" -menu .bar.help
289 .bar.help add command -label "About gitk" -command about
290 . configure -menu .bar
292 if {![info exists geometry(canv1)]} {
293 set geometry(canv1) [expr 45 * $charspc]
294 set geometry(canv2) [expr 30 * $charspc]
295 set geometry(canv3) [expr 15 * $charspc]
296 set geometry(canvh) [expr 25 * $linespc + 4]
297 set geometry(ctextw) 80
298 set geometry(ctexth) 30
299 set geometry(cflistw) 30
300 }
301 panedwindow .ctop -orient vertical
302 if {[info exists geometry(width)]} {
303 .ctop conf -width $geometry(width) -height $geometry(height)
304 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
305 set geometry(ctexth) [expr {($texth - 8) /
306 [font metrics $textfont -linespace]}]
307 }
308 frame .ctop.top
309 frame .ctop.top.bar
310 pack .ctop.top.bar -side bottom -fill x
311 set cscroll .ctop.top.csb
312 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
313 pack $cscroll -side right -fill y
314 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
315 pack .ctop.top.clist -side top -fill both -expand 1
316 .ctop add .ctop.top
317 set canv .ctop.top.clist.canv
318 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
319 -bg white -bd 0 \
320 -yscrollincr $linespc -yscrollcommand "$cscroll set"
321 .ctop.top.clist add $canv
322 set canv2 .ctop.top.clist.canv2
323 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
324 -bg white -bd 0 -yscrollincr $linespc
325 .ctop.top.clist add $canv2
326 set canv3 .ctop.top.clist.canv3
327 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
328 -bg white -bd 0 -yscrollincr $linespc
329 .ctop.top.clist add $canv3
330 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
332 set sha1entry .ctop.top.bar.sha1
333 set entries $sha1entry
334 set sha1but .ctop.top.bar.sha1label
335 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
336 -command gotocommit -width 8
337 $sha1but conf -disabledforeground [$sha1but cget -foreground]
338 pack .ctop.top.bar.sha1label -side left
339 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
340 trace add variable sha1string write sha1change
341 pack $sha1entry -side left -pady 2
342 button .ctop.top.bar.findbut -text "Find" -command dofind
343 pack .ctop.top.bar.findbut -side left
344 set findstring {}
345 set fstring .ctop.top.bar.findstring
346 lappend entries $fstring
347 entry $fstring -width 30 -font $textfont -textvariable findstring
348 pack $fstring -side left -expand 1 -fill x
349 set findtype Exact
350 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
351 findtype Exact IgnCase Regexp]
352 set findloc "All fields"
353 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
354 Comments Author Committer Files Pickaxe
355 pack .ctop.top.bar.findloc -side right
356 pack .ctop.top.bar.findtype -side right
357 # for making sure type==Exact whenever loc==Pickaxe
358 trace add variable findloc write findlocchange
360 panedwindow .ctop.cdet -orient horizontal
361 .ctop add .ctop.cdet
362 frame .ctop.cdet.left
363 set ctext .ctop.cdet.left.ctext
364 text $ctext -bg white -state disabled -font $textfont \
365 -width $geometry(ctextw) -height $geometry(ctexth) \
366 -yscrollcommand ".ctop.cdet.left.sb set"
367 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
368 pack .ctop.cdet.left.sb -side right -fill y
369 pack $ctext -side left -fill both -expand 1
370 .ctop.cdet add .ctop.cdet.left
372 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
373 if {$gaudydiff} {
374 $ctext tag conf hunksep -back blue -fore white
375 $ctext tag conf d0 -back "#ff8080"
376 $ctext tag conf d1 -back green
377 } else {
378 $ctext tag conf hunksep -fore blue
379 $ctext tag conf d0 -fore red
380 $ctext tag conf d1 -fore "#00a000"
381 $ctext tag conf m0 -fore red
382 $ctext tag conf m1 -fore blue
383 $ctext tag conf m2 -fore green
384 $ctext tag conf m3 -fore purple
385 $ctext tag conf m4 -fore brown
386 $ctext tag conf mmax -fore darkgrey
387 set mergemax 5
388 $ctext tag conf mresult -font [concat $textfont bold]
389 $ctext tag conf msep -font [concat $textfont bold]
390 $ctext tag conf found -back yellow
391 }
393 frame .ctop.cdet.right
394 set cflist .ctop.cdet.right.cfiles
395 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
396 -yscrollcommand ".ctop.cdet.right.sb set"
397 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
398 pack .ctop.cdet.right.sb -side right -fill y
399 pack $cflist -side left -fill both -expand 1
400 .ctop.cdet add .ctop.cdet.right
401 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
403 pack .ctop -side top -fill both -expand 1
405 bindall <1> {selcanvline %W %x %y}
406 #bindall <B1-Motion> {selcanvline %W %x %y}
407 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
408 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
409 bindall <2> "allcanvs scan mark 0 %y"
410 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
411 bind . <Key-Up> "selnextline -1"
412 bind . <Key-Down> "selnextline 1"
413 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
414 bind . <Key-Next> "allcanvs yview scroll 1 pages"
415 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
416 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
417 bindkey <Key-space> "$ctext yview scroll 1 pages"
418 bindkey p "selnextline -1"
419 bindkey n "selnextline 1"
420 bindkey b "$ctext yview scroll -1 pages"
421 bindkey d "$ctext yview scroll 18 units"
422 bindkey u "$ctext yview scroll -18 units"
423 bindkey / {findnext 1}
424 bindkey <Key-Return> {findnext 0}
425 bindkey ? findprev
426 bindkey f nextfile
427 bind . <Control-q> doquit
428 bind . <Control-f> dofind
429 bind . <Control-g> {findnext 0}
430 bind . <Control-r> findprev
431 bind . <Control-equal> {incrfont 1}
432 bind . <Control-KP_Add> {incrfont 1}
433 bind . <Control-minus> {incrfont -1}
434 bind . <Control-KP_Subtract> {incrfont -1}
435 bind $cflist <<ListboxSelect>> listboxsel
436 bind . <Destroy> {savestuff %W}
437 bind . <Button-1> "click %W"
438 bind $fstring <Key-Return> dofind
439 bind $sha1entry <Key-Return> gotocommit
440 bind $sha1entry <<PasteSelection>> clearsha1
442 set maincursor [. cget -cursor]
443 set textcursor [$ctext cget -cursor]
445 set rowctxmenu .rowctxmenu
446 menu $rowctxmenu -tearoff 0
447 $rowctxmenu add command -label "Diff this -> selected" \
448 -command {diffvssel 0}
449 $rowctxmenu add command -label "Diff selected -> this" \
450 -command {diffvssel 1}
451 $rowctxmenu add command -label "Make patch" -command mkpatch
452 $rowctxmenu add command -label "Create tag" -command mktag
453 $rowctxmenu add command -label "Write commit to file" -command writecommit
454 }
456 # when we make a key binding for the toplevel, make sure
457 # it doesn't get triggered when that key is pressed in the
458 # find string entry widget.
459 proc bindkey {ev script} {
460 global entries
461 bind . $ev $script
462 set escript [bind Entry $ev]
463 if {$escript == {}} {
464 set escript [bind Entry <Key>]
465 }
466 foreach e $entries {
467 bind $e $ev "$escript; break"
468 }
469 }
471 # set the focus back to the toplevel for any click outside
472 # the entry widgets
473 proc click {w} {
474 global entries
475 foreach e $entries {
476 if {$w == $e} return
477 }
478 focus .
479 }
481 proc savestuff {w} {
482 global canv canv2 canv3 ctext cflist mainfont textfont
483 global stuffsaved findmergefiles gaudydiff
485 if {$stuffsaved} return
486 if {![winfo viewable .]} return
487 catch {
488 set f [open "~/.gitk-new" w]
489 puts $f [list set mainfont $mainfont]
490 puts $f [list set textfont $textfont]
491 puts $f [list set findmergefiles $findmergefiles]
492 puts $f [list set gaudydiff $gaudydiff]
493 puts $f "set geometry(width) [winfo width .ctop]"
494 puts $f "set geometry(height) [winfo height .ctop]"
495 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
496 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
497 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
498 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
499 set wid [expr {([winfo width $ctext] - 8) \
500 / [font measure $textfont "0"]}]
501 puts $f "set geometry(ctextw) $wid"
502 set wid [expr {([winfo width $cflist] - 11) \
503 / [font measure [$cflist cget -font] "0"]}]
504 puts $f "set geometry(cflistw) $wid"
505 close $f
506 file rename -force "~/.gitk-new" "~/.gitk"
507 }
508 set stuffsaved 1
509 }
511 proc resizeclistpanes {win w} {
512 global oldwidth
513 if [info exists oldwidth($win)] {
514 set s0 [$win sash coord 0]
515 set s1 [$win sash coord 1]
516 if {$w < 60} {
517 set sash0 [expr {int($w/2 - 2)}]
518 set sash1 [expr {int($w*5/6 - 2)}]
519 } else {
520 set factor [expr {1.0 * $w / $oldwidth($win)}]
521 set sash0 [expr {int($factor * [lindex $s0 0])}]
522 set sash1 [expr {int($factor * [lindex $s1 0])}]
523 if {$sash0 < 30} {
524 set sash0 30
525 }
526 if {$sash1 < $sash0 + 20} {
527 set sash1 [expr $sash0 + 20]
528 }
529 if {$sash1 > $w - 10} {
530 set sash1 [expr $w - 10]
531 if {$sash0 > $sash1 - 20} {
532 set sash0 [expr $sash1 - 20]
533 }
534 }
535 }
536 $win sash place 0 $sash0 [lindex $s0 1]
537 $win sash place 1 $sash1 [lindex $s1 1]
538 }
539 set oldwidth($win) $w
540 }
542 proc resizecdetpanes {win w} {
543 global oldwidth
544 if [info exists oldwidth($win)] {
545 set s0 [$win sash coord 0]
546 if {$w < 60} {
547 set sash0 [expr {int($w*3/4 - 2)}]
548 } else {
549 set factor [expr {1.0 * $w / $oldwidth($win)}]
550 set sash0 [expr {int($factor * [lindex $s0 0])}]
551 if {$sash0 < 45} {
552 set sash0 45
553 }
554 if {$sash0 > $w - 15} {
555 set sash0 [expr $w - 15]
556 }
557 }
558 $win sash place 0 $sash0 [lindex $s0 1]
559 }
560 set oldwidth($win) $w
561 }
563 proc allcanvs args {
564 global canv canv2 canv3
565 eval $canv $args
566 eval $canv2 $args
567 eval $canv3 $args
568 }
570 proc bindall {event action} {
571 global canv canv2 canv3
572 bind $canv $event $action
573 bind $canv2 $event $action
574 bind $canv3 $event $action
575 }
577 proc about {} {
578 set w .about
579 if {[winfo exists $w]} {
580 raise $w
581 return
582 }
583 toplevel $w
584 wm title $w "About gitk"
585 message $w.m -text {
586 Gitk version 1.2
588 Copyright © 2005 Paul Mackerras
590 Use and redistribute under the terms of the GNU General Public License} \
591 -justify center -aspect 400
592 pack $w.m -side top -fill x -padx 20 -pady 20
593 button $w.ok -text Close -command "destroy $w"
594 pack $w.ok -side bottom
595 }
597 proc assigncolor {id} {
598 global commitinfo colormap commcolors colors nextcolor
599 global parents nparents children nchildren
600 global cornercrossings crossings
602 if [info exists colormap($id)] return
603 set ncolors [llength $colors]
604 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
605 set child [lindex $children($id) 0]
606 if {[info exists colormap($child)]
607 && $nparents($child) == 1} {
608 set colormap($id) $colormap($child)
609 return
610 }
611 }
612 set badcolors {}
613 if {[info exists cornercrossings($id)]} {
614 foreach x $cornercrossings($id) {
615 if {[info exists colormap($x)]
616 && [lsearch -exact $badcolors $colormap($x)] < 0} {
617 lappend badcolors $colormap($x)
618 }
619 }
620 if {[llength $badcolors] >= $ncolors} {
621 set badcolors {}
622 }
623 }
624 set origbad $badcolors
625 if {[llength $badcolors] < $ncolors - 1} {
626 if {[info exists crossings($id)]} {
627 foreach x $crossings($id) {
628 if {[info exists colormap($x)]
629 && [lsearch -exact $badcolors $colormap($x)] < 0} {
630 lappend badcolors $colormap($x)
631 }
632 }
633 if {[llength $badcolors] >= $ncolors} {
634 set badcolors $origbad
635 }
636 }
637 set origbad $badcolors
638 }
639 if {[llength $badcolors] < $ncolors - 1} {
640 foreach child $children($id) {
641 if {[info exists colormap($child)]
642 && [lsearch -exact $badcolors $colormap($child)] < 0} {
643 lappend badcolors $colormap($child)
644 }
645 if {[info exists parents($child)]} {
646 foreach p $parents($child) {
647 if {[info exists colormap($p)]
648 && [lsearch -exact $badcolors $colormap($p)] < 0} {
649 lappend badcolors $colormap($p)
650 }
651 }
652 }
653 }
654 if {[llength $badcolors] >= $ncolors} {
655 set badcolors $origbad
656 }
657 }
658 for {set i 0} {$i <= $ncolors} {incr i} {
659 set c [lindex $colors $nextcolor]
660 if {[incr nextcolor] >= $ncolors} {
661 set nextcolor 0
662 }
663 if {[lsearch -exact $badcolors $c]} break
664 }
665 set colormap($id) $c
666 }
668 proc initgraph {} {
669 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
670 global mainline sidelines
671 global nchildren ncleft
673 allcanvs delete all
674 set nextcolor 0
675 set canvy $canvy0
676 set lineno -1
677 set numcommits 0
678 set lthickness [expr {int($linespc / 9) + 1}]
679 catch {unset mainline}
680 catch {unset sidelines}
681 foreach id [array names nchildren] {
682 set ncleft($id) $nchildren($id)
683 }
684 }
686 proc bindline {t id} {
687 global canv
689 $canv bind $t <Enter> "lineenter %x %y $id"
690 $canv bind $t <Motion> "linemotion %x %y $id"
691 $canv bind $t <Leave> "lineleave $id"
692 $canv bind $t <Button-1> "lineclick %x %y $id"
693 }
695 proc drawcommitline {level} {
696 global parents children nparents nchildren todo
697 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
698 global lineid linehtag linentag linedtag commitinfo
699 global colormap numcommits currentparents dupparents
700 global oldlevel oldnlines oldtodo
701 global idtags idline idheads
702 global lineno lthickness mainline sidelines
703 global commitlisted rowtextx idpos
705 incr numcommits
706 incr lineno
707 set id [lindex $todo $level]
708 set lineid($lineno) $id
709 set idline($id) $lineno
710 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
711 if {![info exists commitinfo($id)]} {
712 readcommit $id
713 if {![info exists commitinfo($id)]} {
714 set commitinfo($id) {"No commit information available"}
715 set nparents($id) 0
716 }
717 }
718 assigncolor $id
719 set currentparents {}
720 set dupparents {}
721 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
722 foreach p $parents($id) {
723 if {[lsearch -exact $currentparents $p] < 0} {
724 lappend currentparents $p
725 } else {
726 # remember that this parent was listed twice
727 lappend dupparents $p
728 }
729 }
730 }
731 set x [expr $canvx0 + $level * $linespc]
732 set y1 $canvy
733 set canvy [expr $canvy + $linespc]
734 allcanvs conf -scrollregion \
735 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
736 if {[info exists mainline($id)]} {
737 lappend mainline($id) $x $y1
738 set t [$canv create line $mainline($id) \
739 -width $lthickness -fill $colormap($id)]
740 $canv lower $t
741 bindline $t $id
742 }
743 if {[info exists sidelines($id)]} {
744 foreach ls $sidelines($id) {
745 set coords [lindex $ls 0]
746 set thick [lindex $ls 1]
747 set t [$canv create line $coords -fill $colormap($id) \
748 -width [expr {$thick * $lthickness}]]
749 $canv lower $t
750 bindline $t $id
751 }
752 }
753 set orad [expr {$linespc / 3}]
754 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
755 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
756 -fill $ofill -outline black -width 1]
757 $canv raise $t
758 $canv bind $t <1> {selcanvline {} %x %y}
759 set xt [expr $canvx0 + [llength $todo] * $linespc]
760 if {[llength $currentparents] > 2} {
761 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
762 }
763 set rowtextx($lineno) $xt
764 set idpos($id) [list $x $xt $y1]
765 if {[info exists idtags($id)] || [info exists idheads($id)]} {
766 set xt [drawtags $id $x $xt $y1]
767 }
768 set headline [lindex $commitinfo($id) 0]
769 set name [lindex $commitinfo($id) 1]
770 set date [lindex $commitinfo($id) 2]
771 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
772 -text $headline -font $mainfont ]
773 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
774 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
775 -text $name -font $namefont]
776 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
777 -text $date -font $mainfont]
778 }
780 proc drawtags {id x xt y1} {
781 global idtags idheads
782 global linespc lthickness
783 global canv mainfont
785 set marks {}
786 set ntags 0
787 if {[info exists idtags($id)]} {
788 set marks $idtags($id)
789 set ntags [llength $marks]
790 }
791 if {[info exists idheads($id)]} {
792 set marks [concat $marks $idheads($id)]
793 }
794 if {$marks eq {}} {
795 return $xt
796 }
798 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
799 set yt [expr $y1 - 0.5 * $linespc]
800 set yb [expr $yt + $linespc - 1]
801 set xvals {}
802 set wvals {}
803 foreach tag $marks {
804 set wid [font measure $mainfont $tag]
805 lappend xvals $xt
806 lappend wvals $wid
807 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
808 }
809 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
810 -width $lthickness -fill black -tags tag.$id]
811 $canv lower $t
812 foreach tag $marks x $xvals wid $wvals {
813 set xl [expr $x + $delta]
814 set xr [expr $x + $delta + $wid + $lthickness]
815 if {[incr ntags -1] >= 0} {
816 # draw a tag
817 $canv create polygon $x [expr $yt + $delta] $xl $yt\
818 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
819 -width 1 -outline black -fill yellow -tags tag.$id
820 } else {
821 # draw a head
822 set xl [expr $xl - $delta/2]
823 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
824 -width 1 -outline black -fill green -tags tag.$id
825 }
826 $canv create text $xl $y1 -anchor w -text $tag \
827 -font $mainfont -tags tag.$id
828 }
829 return $xt
830 }
832 proc updatetodo {level noshortcut} {
833 global currentparents ncleft todo
834 global mainline oldlevel oldtodo oldnlines
835 global canvx0 canvy linespc mainline
836 global commitinfo
838 set oldlevel $level
839 set oldtodo $todo
840 set oldnlines [llength $todo]
841 if {!$noshortcut && [llength $currentparents] == 1} {
842 set p [lindex $currentparents 0]
843 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
844 set ncleft($p) 0
845 set x [expr $canvx0 + $level * $linespc]
846 set y [expr $canvy - $linespc]
847 set mainline($p) [list $x $y]
848 set todo [lreplace $todo $level $level $p]
849 return 0
850 }
851 }
853 set todo [lreplace $todo $level $level]
854 set i $level
855 foreach p $currentparents {
856 incr ncleft($p) -1
857 set k [lsearch -exact $todo $p]
858 if {$k < 0} {
859 set todo [linsert $todo $i $p]
860 incr i
861 }
862 }
863 return 1
864 }
866 proc notecrossings {id lo hi corner} {
867 global oldtodo crossings cornercrossings
869 for {set i $lo} {[incr i] < $hi} {} {
870 set p [lindex $oldtodo $i]
871 if {$p == {}} continue
872 if {$i == $corner} {
873 if {![info exists cornercrossings($id)]
874 || [lsearch -exact $cornercrossings($id) $p] < 0} {
875 lappend cornercrossings($id) $p
876 }
877 if {![info exists cornercrossings($p)]
878 || [lsearch -exact $cornercrossings($p) $id] < 0} {
879 lappend cornercrossings($p) $id
880 }
881 } else {
882 if {![info exists crossings($id)]
883 || [lsearch -exact $crossings($id) $p] < 0} {
884 lappend crossings($id) $p
885 }
886 if {![info exists crossings($p)]
887 || [lsearch -exact $crossings($p) $id] < 0} {
888 lappend crossings($p) $id
889 }
890 }
891 }
892 }
894 proc drawslants {} {
895 global canv mainline sidelines canvx0 canvy linespc
896 global oldlevel oldtodo todo currentparents dupparents
897 global lthickness linespc canvy colormap
899 set y1 [expr $canvy - $linespc]
900 set y2 $canvy
901 set i -1
902 foreach id $oldtodo {
903 incr i
904 if {$id == {}} continue
905 set xi [expr {$canvx0 + $i * $linespc}]
906 if {$i == $oldlevel} {
907 foreach p $currentparents {
908 set j [lsearch -exact $todo $p]
909 set coords [list $xi $y1]
910 set xj [expr {$canvx0 + $j * $linespc}]
911 if {$j < $i - 1} {
912 lappend coords [expr $xj + $linespc] $y1
913 notecrossings $p $j $i [expr {$j + 1}]
914 } elseif {$j > $i + 1} {
915 lappend coords [expr $xj - $linespc] $y1
916 notecrossings $p $i $j [expr {$j - 1}]
917 }
918 if {[lsearch -exact $dupparents $p] >= 0} {
919 # draw a double-width line to indicate the doubled parent
920 lappend coords $xj $y2
921 lappend sidelines($p) [list $coords 2]
922 if {![info exists mainline($p)]} {
923 set mainline($p) [list $xj $y2]
924 }
925 } else {
926 # normal case, no parent duplicated
927 if {![info exists mainline($p)]} {
928 if {$i != $j} {
929 lappend coords $xj $y2
930 }
931 set mainline($p) $coords
932 } else {
933 lappend coords $xj $y2
934 lappend sidelines($p) [list $coords 1]
935 }
936 }
937 }
938 } elseif {[lindex $todo $i] != $id} {
939 set j [lsearch -exact $todo $id]
940 set xj [expr {$canvx0 + $j * $linespc}]
941 lappend mainline($id) $xi $y1 $xj $y2
942 }
943 }
944 }
946 proc decidenext {{noread 0}} {
947 global parents children nchildren ncleft todo
948 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
949 global datemode cdate
950 global commitinfo
951 global currentparents oldlevel oldnlines oldtodo
952 global lineno lthickness
954 # remove the null entry if present
955 set nullentry [lsearch -exact $todo {}]
956 if {$nullentry >= 0} {
957 set todo [lreplace $todo $nullentry $nullentry]
958 }
960 # choose which one to do next time around
961 set todol [llength $todo]
962 set level -1
963 set latest {}
964 for {set k $todol} {[incr k -1] >= 0} {} {
965 set p [lindex $todo $k]
966 if {$ncleft($p) == 0} {
967 if {$datemode} {
968 if {![info exists commitinfo($p)]} {
969 if {$noread} {
970 return {}
971 }
972 readcommit $p
973 }
974 if {$latest == {} || $cdate($p) > $latest} {
975 set level $k
976 set latest $cdate($p)
977 }
978 } else {
979 set level $k
980 break
981 }
982 }
983 }
984 if {$level < 0} {
985 if {$todo != {}} {
986 puts "ERROR: none of the pending commits can be done yet:"
987 foreach p $todo {
988 puts " $p ($ncleft($p))"
989 }
990 }
991 return -1
992 }
994 # If we are reducing, put in a null entry
995 if {$todol < $oldnlines} {
996 if {$nullentry >= 0} {
997 set i $nullentry
998 while {$i < $todol
999 && [lindex $oldtodo $i] == [lindex $todo $i]} {
1000 incr i
1001 }
1002 } else {
1003 set i $oldlevel
1004 if {$level >= $i} {
1005 incr i
1006 }
1007 }
1008 if {$i < $todol} {
1009 set todo [linsert $todo $i {}]
1010 if {$level >= $i} {
1011 incr level
1012 }
1013 }
1014 }
1015 return $level
1016 }
1018 proc drawcommit {id} {
1019 global phase todo nchildren datemode nextupdate
1020 global startcommits
1022 if {$phase != "incrdraw"} {
1023 set phase incrdraw
1024 set todo $id
1025 set startcommits $id
1026 initgraph
1027 drawcommitline 0
1028 updatetodo 0 $datemode
1029 } else {
1030 if {$nchildren($id) == 0} {
1031 lappend todo $id
1032 lappend startcommits $id
1033 }
1034 set level [decidenext 1]
1035 if {$level == {} || $id != [lindex $todo $level]} {
1036 return
1037 }
1038 while 1 {
1039 drawslants
1040 drawcommitline $level
1041 if {[updatetodo $level $datemode]} {
1042 set level [decidenext 1]
1043 if {$level == {}} break
1044 }
1045 set id [lindex $todo $level]
1046 if {![info exists commitlisted($id)]} {
1047 break
1048 }
1049 if {[clock clicks -milliseconds] >= $nextupdate} {
1050 doupdate
1051 if {$stopped} break
1052 }
1053 }
1054 }
1055 }
1057 proc finishcommits {} {
1058 global phase
1059 global startcommits
1060 global canv mainfont ctext maincursor textcursor
1062 if {$phase != "incrdraw"} {
1063 $canv delete all
1064 $canv create text 3 3 -anchor nw -text "No commits selected" \
1065 -font $mainfont -tags textitems
1066 set phase {}
1067 } else {
1068 drawslants
1069 set level [decidenext]
1070 drawrest $level [llength $startcommits]
1071 }
1072 . config -cursor $maincursor
1073 $ctext config -cursor $textcursor
1074 }
1076 proc drawgraph {} {
1077 global nextupdate startmsecs startcommits todo
1079 if {$startcommits == {}} return
1080 set startmsecs [clock clicks -milliseconds]
1081 set nextupdate [expr $startmsecs + 100]
1082 initgraph
1083 set todo [lindex $startcommits 0]
1084 drawrest 0 1
1085 }
1087 proc drawrest {level startix} {
1088 global phase stopped redisplaying selectedline
1089 global datemode currentparents todo
1090 global numcommits
1091 global nextupdate startmsecs startcommits idline
1093 if {$level >= 0} {
1094 set phase drawgraph
1095 set startid [lindex $startcommits $startix]
1096 set startline -1
1097 if {$startid != {}} {
1098 set startline $idline($startid)
1099 }
1100 while 1 {
1101 if {$stopped} break
1102 drawcommitline $level
1103 set hard [updatetodo $level $datemode]
1104 if {$numcommits == $startline} {
1105 lappend todo $startid
1106 set hard 1
1107 incr startix
1108 set startid [lindex $startcommits $startix]
1109 set startline -1
1110 if {$startid != {}} {
1111 set startline $idline($startid)
1112 }
1113 }
1114 if {$hard} {
1115 set level [decidenext]
1116 if {$level < 0} break
1117 drawslants
1118 }
1119 if {[clock clicks -milliseconds] >= $nextupdate} {
1120 update
1121 incr nextupdate 100
1122 }
1123 }
1124 }
1125 set phase {}
1126 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1127 #puts "overall $drawmsecs ms for $numcommits commits"
1128 if {$redisplaying} {
1129 if {$stopped == 0 && [info exists selectedline]} {
1130 selectline $selectedline
1131 }
1132 if {$stopped == 1} {
1133 set stopped 0
1134 after idle drawgraph
1135 } else {
1136 set redisplaying 0
1137 }
1138 }
1139 }
1141 proc findmatches {f} {
1142 global findtype foundstring foundstrlen
1143 if {$findtype == "Regexp"} {
1144 set matches [regexp -indices -all -inline $foundstring $f]
1145 } else {
1146 if {$findtype == "IgnCase"} {
1147 set str [string tolower $f]
1148 } else {
1149 set str $f
1150 }
1151 set matches {}
1152 set i 0
1153 while {[set j [string first $foundstring $str $i]] >= 0} {
1154 lappend matches [list $j [expr $j+$foundstrlen-1]]
1155 set i [expr $j + $foundstrlen]
1156 }
1157 }
1158 return $matches
1159 }
1161 proc dofind {} {
1162 global findtype findloc findstring markedmatches commitinfo
1163 global numcommits lineid linehtag linentag linedtag
1164 global mainfont namefont canv canv2 canv3 selectedline
1165 global matchinglines foundstring foundstrlen
1167 stopfindproc
1168 unmarkmatches
1169 focus .
1170 set matchinglines {}
1171 if {$findloc == "Pickaxe"} {
1172 findpatches
1173 return
1174 }
1175 if {$findtype == "IgnCase"} {
1176 set foundstring [string tolower $findstring]
1177 } else {
1178 set foundstring $findstring
1179 }
1180 set foundstrlen [string length $findstring]
1181 if {$foundstrlen == 0} return
1182 if {$findloc == "Files"} {
1183 findfiles
1184 return
1185 }
1186 if {![info exists selectedline]} {
1187 set oldsel -1
1188 } else {
1189 set oldsel $selectedline
1190 }
1191 set didsel 0
1192 set fldtypes {Headline Author Date Committer CDate Comment}
1193 for {set l 0} {$l < $numcommits} {incr l} {
1194 set id $lineid($l)
1195 set info $commitinfo($id)
1196 set doesmatch 0
1197 foreach f $info ty $fldtypes {
1198 if {$findloc != "All fields" && $findloc != $ty} {
1199 continue
1200 }
1201 set matches [findmatches $f]
1202 if {$matches == {}} continue
1203 set doesmatch 1
1204 if {$ty == "Headline"} {
1205 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1206 } elseif {$ty == "Author"} {
1207 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1208 } elseif {$ty == "Date"} {
1209 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1210 }
1211 }
1212 if {$doesmatch} {
1213 lappend matchinglines $l
1214 if {!$didsel && $l > $oldsel} {
1215 findselectline $l
1216 set didsel 1
1217 }
1218 }
1219 }
1220 if {$matchinglines == {}} {
1221 bell
1222 } elseif {!$didsel} {
1223 findselectline [lindex $matchinglines 0]
1224 }
1225 }
1227 proc findselectline {l} {
1228 global findloc commentend ctext
1229 selectline $l
1230 if {$findloc == "All fields" || $findloc == "Comments"} {
1231 # highlight the matches in the comments
1232 set f [$ctext get 1.0 $commentend]
1233 set matches [findmatches $f]
1234 foreach match $matches {
1235 set start [lindex $match 0]
1236 set end [expr [lindex $match 1] + 1]
1237 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1238 }
1239 }
1240 }
1242 proc findnext {restart} {
1243 global matchinglines selectedline
1244 if {![info exists matchinglines]} {
1245 if {$restart} {
1246 dofind
1247 }
1248 return
1249 }
1250 if {![info exists selectedline]} return
1251 foreach l $matchinglines {
1252 if {$l > $selectedline} {
1253 findselectline $l
1254 return
1255 }
1256 }
1257 bell
1258 }
1260 proc findprev {} {
1261 global matchinglines selectedline
1262 if {![info exists matchinglines]} {
1263 dofind
1264 return
1265 }
1266 if {![info exists selectedline]} return
1267 set prev {}
1268 foreach l $matchinglines {
1269 if {$l >= $selectedline} break
1270 set prev $l
1271 }
1272 if {$prev != {}} {
1273 findselectline $prev
1274 } else {
1275 bell
1276 }
1277 }
1279 proc findlocchange {name ix op} {
1280 global findloc findtype findtypemenu
1281 if {$findloc == "Pickaxe"} {
1282 set findtype Exact
1283 set state disabled
1284 } else {
1285 set state normal
1286 }
1287 $findtypemenu entryconf 1 -state $state
1288 $findtypemenu entryconf 2 -state $state
1289 }
1291 proc stopfindproc {{done 0}} {
1292 global findprocpid findprocfile findids
1293 global ctext findoldcursor phase maincursor textcursor
1294 global findinprogress
1296 catch {unset findids}
1297 if {[info exists findprocpid]} {
1298 if {!$done} {
1299 catch {exec kill $findprocpid}
1300 }
1301 catch {close $findprocfile}
1302 unset findprocpid
1303 }
1304 if {[info exists findinprogress]} {
1305 unset findinprogress
1306 if {$phase != "incrdraw"} {
1307 . config -cursor $maincursor
1308 $ctext config -cursor $textcursor
1309 }
1310 }
1311 }
1313 proc findpatches {} {
1314 global findstring selectedline numcommits
1315 global findprocpid findprocfile
1316 global finddidsel ctext lineid findinprogress
1317 global findinsertpos
1319 if {$numcommits == 0} return
1321 # make a list of all the ids to search, starting at the one
1322 # after the selected line (if any)
1323 if {[info exists selectedline]} {
1324 set l $selectedline
1325 } else {
1326 set l -1
1327 }
1328 set inputids {}
1329 for {set i 0} {$i < $numcommits} {incr i} {
1330 if {[incr l] >= $numcommits} {
1331 set l 0
1332 }
1333 append inputids $lineid($l) "\n"
1334 }
1336 if {[catch {
1337 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1338 << $inputids] r]
1339 } err]} {
1340 error_popup "Error starting search process: $err"
1341 return
1342 }
1344 set findinsertpos end
1345 set findprocfile $f
1346 set findprocpid [pid $f]
1347 fconfigure $f -blocking 0
1348 fileevent $f readable readfindproc
1349 set finddidsel 0
1350 . config -cursor watch
1351 $ctext config -cursor watch
1352 set findinprogress 1
1353 }
1355 proc readfindproc {} {
1356 global findprocfile finddidsel
1357 global idline matchinglines findinsertpos
1359 set n [gets $findprocfile line]
1360 if {$n < 0} {
1361 if {[eof $findprocfile]} {
1362 stopfindproc 1
1363 if {!$finddidsel} {
1364 bell
1365 }
1366 }
1367 return
1368 }
1369 if {![regexp {^[0-9a-f]{40}} $line id]} {
1370 error_popup "Can't parse git-diff-tree output: $line"
1371 stopfindproc
1372 return
1373 }
1374 if {![info exists idline($id)]} {
1375 puts stderr "spurious id: $id"
1376 return
1377 }
1378 set l $idline($id)
1379 insertmatch $l $id
1380 }
1382 proc insertmatch {l id} {
1383 global matchinglines findinsertpos finddidsel
1385 if {$findinsertpos == "end"} {
1386 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1387 set matchinglines [linsert $matchinglines 0 $l]
1388 set findinsertpos 1
1389 } else {
1390 lappend matchinglines $l
1391 }
1392 } else {
1393 set matchinglines [linsert $matchinglines $findinsertpos $l]
1394 incr findinsertpos
1395 }
1396 markheadline $l $id
1397 if {!$finddidsel} {
1398 findselectline $l
1399 set finddidsel 1
1400 }
1401 }
1403 proc findfiles {} {
1404 global selectedline numcommits lineid ctext
1405 global ffileline finddidsel parents nparents
1406 global findinprogress findstartline findinsertpos
1407 global treediffs fdiffids fdiffsneeded fdiffpos
1408 global findmergefiles
1410 if {$numcommits == 0} return
1412 if {[info exists selectedline]} {
1413 set l [expr {$selectedline + 1}]
1414 } else {
1415 set l 0
1416 }
1417 set ffileline $l
1418 set findstartline $l
1419 set diffsneeded {}
1420 set fdiffsneeded {}
1421 while 1 {
1422 set id $lineid($l)
1423 if {$findmergefiles || $nparents($id) == 1} {
1424 foreach p $parents($id) {
1425 if {![info exists treediffs([list $id $p])]} {
1426 append diffsneeded "$id $p\n"
1427 lappend fdiffsneeded [list $id $p]
1428 }
1429 }
1430 }
1431 if {[incr l] >= $numcommits} {
1432 set l 0
1433 }
1434 if {$l == $findstartline} break
1435 }
1437 # start off a git-diff-tree process if needed
1438 if {$diffsneeded ne {}} {
1439 if {[catch {
1440 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1441 } err ]} {
1442 error_popup "Error starting search process: $err"
1443 return
1444 }
1445 catch {unset fdiffids}
1446 set fdiffpos 0
1447 fconfigure $df -blocking 0
1448 fileevent $df readable [list readfilediffs $df]
1449 }
1451 set finddidsel 0
1452 set findinsertpos end
1453 set id $lineid($l)
1454 set p [lindex $parents($id) 0]
1455 . config -cursor watch
1456 $ctext config -cursor watch
1457 set findinprogress 1
1458 findcont [list $id $p]
1459 update
1460 }
1462 proc readfilediffs {df} {
1463 global findids fdiffids fdiffs
1465 set n [gets $df line]
1466 if {$n < 0} {
1467 if {[eof $df]} {
1468 donefilediff
1469 if {[catch {close $df} err]} {
1470 stopfindproc
1471 bell
1472 error_popup "Error in git-diff-tree: $err"
1473 } elseif {[info exists findids]} {
1474 set ids $findids
1475 stopfindproc
1476 bell
1477 error_popup "Couldn't find diffs for {$ids}"
1478 }
1479 }
1480 return
1481 }
1482 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1483 # start of a new string of diffs
1484 donefilediff
1485 set fdiffids [list $id $p]
1486 set fdiffs {}
1487 } elseif {[string match ":*" $line]} {
1488 lappend fdiffs [lindex $line 5]
1489 }
1490 }
1492 proc donefilediff {} {
1493 global fdiffids fdiffs treediffs findids
1494 global fdiffsneeded fdiffpos
1496 if {[info exists fdiffids]} {
1497 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1498 && $fdiffpos < [llength $fdiffsneeded]} {
1499 # git-diff-tree doesn't output anything for a commit
1500 # which doesn't change anything
1501 set nullids [lindex $fdiffsneeded $fdiffpos]
1502 set treediffs($nullids) {}
1503 if {[info exists findids] && $nullids eq $findids} {
1504 unset findids
1505 findcont $nullids
1506 }
1507 incr fdiffpos
1508 }
1509 incr fdiffpos
1511 if {![info exists treediffs($fdiffids)]} {
1512 set treediffs($fdiffids) $fdiffs
1513 }
1514 if {[info exists findids] && $fdiffids eq $findids} {
1515 unset findids
1516 findcont $fdiffids
1517 }
1518 }
1519 }
1521 proc findcont {ids} {
1522 global findids treediffs parents nparents
1523 global ffileline findstartline finddidsel
1524 global lineid numcommits matchinglines findinprogress
1525 global findmergefiles
1527 set id [lindex $ids 0]
1528 set p [lindex $ids 1]
1529 set pi [lsearch -exact $parents($id) $p]
1530 set l $ffileline
1531 while 1 {
1532 if {$findmergefiles || $nparents($id) == 1} {
1533 if {![info exists treediffs($ids)]} {
1534 set findids $ids
1535 set ffileline $l
1536 return
1537 }
1538 set doesmatch 0
1539 foreach f $treediffs($ids) {
1540 set x [findmatches $f]
1541 if {$x != {}} {
1542 set doesmatch 1
1543 break
1544 }
1545 }
1546 if {$doesmatch} {
1547 insertmatch $l $id
1548 set pi $nparents($id)
1549 }
1550 } else {
1551 set pi $nparents($id)
1552 }
1553 if {[incr pi] >= $nparents($id)} {
1554 set pi 0
1555 if {[incr l] >= $numcommits} {
1556 set l 0
1557 }
1558 if {$l == $findstartline} break
1559 set id $lineid($l)
1560 }
1561 set p [lindex $parents($id) $pi]
1562 set ids [list $id $p]
1563 }
1564 stopfindproc
1565 if {!$finddidsel} {
1566 bell
1567 }
1568 }
1570 # mark a commit as matching by putting a yellow background
1571 # behind the headline
1572 proc markheadline {l id} {
1573 global canv mainfont linehtag commitinfo
1575 set bbox [$canv bbox $linehtag($l)]
1576 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1577 $canv lower $t
1578 }
1580 # mark the bits of a headline, author or date that match a find string
1581 proc markmatches {canv l str tag matches font} {
1582 set bbox [$canv bbox $tag]
1583 set x0 [lindex $bbox 0]
1584 set y0 [lindex $bbox 1]
1585 set y1 [lindex $bbox 3]
1586 foreach match $matches {
1587 set start [lindex $match 0]
1588 set end [lindex $match 1]
1589 if {$start > $end} continue
1590 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1591 set xlen [font measure $font [string range $str 0 [expr $end]]]
1592 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1593 -outline {} -tags matches -fill yellow]
1594 $canv lower $t
1595 }
1596 }
1598 proc unmarkmatches {} {
1599 global matchinglines findids
1600 allcanvs delete matches
1601 catch {unset matchinglines}
1602 catch {unset findids}
1603 }
1605 proc selcanvline {w x y} {
1606 global canv canvy0 ctext linespc selectedline
1607 global lineid linehtag linentag linedtag rowtextx
1608 set ymax [lindex [$canv cget -scrollregion] 3]
1609 if {$ymax == {}} return
1610 set yfrac [lindex [$canv yview] 0]
1611 set y [expr {$y + $yfrac * $ymax}]
1612 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1613 if {$l < 0} {
1614 set l 0
1615 }
1616 if {$w eq $canv} {
1617 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1618 }
1619 unmarkmatches
1620 selectline $l
1621 }
1623 proc selectline {l} {
1624 global canv canv2 canv3 ctext commitinfo selectedline
1625 global lineid linehtag linentag linedtag
1626 global canvy0 linespc parents nparents
1627 global cflist currentid sha1entry
1628 global commentend idtags
1629 $canv delete hover
1630 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1631 $canv delete secsel
1632 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1633 -tags secsel -fill [$canv cget -selectbackground]]
1634 $canv lower $t
1635 $canv2 delete secsel
1636 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1637 -tags secsel -fill [$canv2 cget -selectbackground]]
1638 $canv2 lower $t
1639 $canv3 delete secsel
1640 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1641 -tags secsel -fill [$canv3 cget -selectbackground]]
1642 $canv3 lower $t
1643 set y [expr {$canvy0 + $l * $linespc}]
1644 set ymax [lindex [$canv cget -scrollregion] 3]
1645 set ytop [expr {$y - $linespc - 1}]
1646 set ybot [expr {$y + $linespc + 1}]
1647 set wnow [$canv yview]
1648 set wtop [expr [lindex $wnow 0] * $ymax]
1649 set wbot [expr [lindex $wnow 1] * $ymax]
1650 set wh [expr {$wbot - $wtop}]
1651 set newtop $wtop
1652 if {$ytop < $wtop} {
1653 if {$ybot < $wtop} {
1654 set newtop [expr {$y - $wh / 2.0}]
1655 } else {
1656 set newtop $ytop
1657 if {$newtop > $wtop - $linespc} {
1658 set newtop [expr {$wtop - $linespc}]
1659 }
1660 }
1661 } elseif {$ybot > $wbot} {
1662 if {$ytop > $wbot} {
1663 set newtop [expr {$y - $wh / 2.0}]
1664 } else {
1665 set newtop [expr {$ybot - $wh}]
1666 if {$newtop < $wtop + $linespc} {
1667 set newtop [expr {$wtop + $linespc}]
1668 }
1669 }
1670 }
1671 if {$newtop != $wtop} {
1672 if {$newtop < 0} {
1673 set newtop 0
1674 }
1675 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1676 }
1677 set selectedline $l
1679 set id $lineid($l)
1680 set currentid $id
1681 $sha1entry delete 0 end
1682 $sha1entry insert 0 $id
1683 $sha1entry selection from 0
1684 $sha1entry selection to end
1686 $ctext conf -state normal
1687 $ctext delete 0.0 end
1688 $ctext mark set fmark.0 0.0
1689 $ctext mark gravity fmark.0 left
1690 set info $commitinfo($id)
1691 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1692 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1693 if {[info exists idtags($id)]} {
1694 $ctext insert end "Tags:"
1695 foreach tag $idtags($id) {
1696 $ctext insert end " $tag"
1697 }
1698 $ctext insert end "\n"
1699 }
1700 $ctext insert end "\n"
1701 $ctext insert end [lindex $info 5]
1702 $ctext insert end "\n"
1703 $ctext tag delete Comments
1704 $ctext tag remove found 1.0 end
1705 $ctext conf -state disabled
1706 set commentend [$ctext index "end - 1c"]
1708 $cflist delete 0 end
1709 $cflist insert end "Comments"
1710 if {$nparents($id) == 1} {
1711 startdiff [concat $id $parents($id)]
1712 } elseif {$nparents($id) > 1} {
1713 mergediff $id
1714 }
1715 }
1717 proc selnextline {dir} {
1718 global selectedline
1719 if {![info exists selectedline]} return
1720 set l [expr $selectedline + $dir]
1721 unmarkmatches
1722 selectline $l
1723 }
1725 proc mergediff {id} {
1726 global parents diffmergeid diffmergegca mergefilelist diffpindex
1728 set diffmergeid $id
1729 set diffpindex -1
1730 set diffmergegca [findgca $parents($id)]
1731 if {[info exists mergefilelist($id)]} {
1732 showmergediff
1733 } else {
1734 contmergediff {}
1735 }
1736 }
1738 proc findgca {ids} {
1739 set gca {}
1740 foreach id $ids {
1741 if {$gca eq {}} {
1742 set gca $id
1743 } else {
1744 if {[catch {
1745 set gca [exec git-merge-base $gca $id]
1746 } err]} {
1747 return {}
1748 }
1749 }
1750 }
1751 return $gca
1752 }
1754 proc contmergediff {ids} {
1755 global diffmergeid diffpindex parents nparents diffmergegca
1756 global treediffs mergefilelist diffids
1758 # diff the child against each of the parents, and diff
1759 # each of the parents against the GCA.
1760 while 1 {
1761 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
1762 set ids [list [lindex $ids 1] $diffmergegca]
1763 } else {
1764 if {[incr diffpindex] >= $nparents($diffmergeid)} break
1765 set p [lindex $parents($diffmergeid) $diffpindex]
1766 set ids [list $diffmergeid $p]
1767 }
1768 if {![info exists treediffs($ids)]} {
1769 set diffids $ids
1770 if {![info exists treepending]} {
1771 gettreediffs $ids
1772 }
1773 return
1774 }
1775 }
1777 # If a file in some parent is different from the child and also
1778 # different from the GCA, then it's interesting.
1779 # If we don't have a GCA, then a file is interesting if it is
1780 # different from the child in all the parents.
1781 if {$diffmergegca ne {}} {
1782 set files {}
1783 foreach p $parents($diffmergeid) {
1784 set gcadiffs $treediffs([list $p $diffmergegca])
1785 foreach f $treediffs([list $diffmergeid $p]) {
1786 if {[lsearch -exact $files $f] < 0
1787 && [lsearch -exact $gcadiffs $f] >= 0} {
1788 lappend files $f
1789 }
1790 }
1791 }
1792 set files [lsort $files]
1793 } else {
1794 set p [lindex $parents($diffmergeid) 0]
1795 set files $treediffs([list $diffmergeid $p])
1796 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
1797 set p [lindex $parents($diffmergeid) $i]
1798 set df $treediffs([list $diffmergeid $p])
1799 set nf {}
1800 foreach f $files {
1801 if {[lsearch -exact $df $f] >= 0} {
1802 lappend nf $f
1803 }
1804 }
1805 set files $nf
1806 }
1807 }
1809 set mergefilelist($diffmergeid) $files
1810 if {$files ne {}} {
1811 showmergediff
1812 }
1813 }
1815 proc showmergediff {} {
1816 global cflist diffmergeid mergefilelist parents
1817 global diffopts diffinhunk currentfile diffblocked
1818 global groupfilelast mergefds
1820 set files $mergefilelist($diffmergeid)
1821 foreach f $files {
1822 $cflist insert end $f
1823 }
1824 set env(GIT_DIFF_OPTS) $diffopts
1825 set flist {}
1826 catch {unset currentfile}
1827 catch {unset currenthunk}
1828 catch {unset filelines}
1829 set groupfilelast -1
1830 foreach p $parents($diffmergeid) {
1831 set cmd [list | git-diff-tree -p $p $diffmergeid]
1832 set cmd [concat $cmd $mergefilelist($diffmergeid)]
1833 if {[catch {set f [open $cmd r]} err]} {
1834 error_popup "Error getting diffs: $err"
1835 foreach f $flist {
1836 catch {close $f}
1837 }
1838 return
1839 }
1840 lappend flist $f
1841 set ids [list $diffmergeid $p]
1842 set mergefds($ids) $f
1843 set diffinhunk($ids) 0
1844 set diffblocked($ids) 0
1845 fconfigure $f -blocking 0
1846 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
1847 }
1848 }
1850 proc getmergediffline {f ids id} {
1851 global diffmergeid diffinhunk diffoldlines diffnewlines
1852 global currentfile currenthunk
1853 global diffoldstart diffnewstart diffoldlno diffnewlno
1854 global diffblocked mergefilelist
1855 global noldlines nnewlines difflcounts filelines
1857 set n [gets $f line]
1858 if {$n < 0} {
1859 if {![eof $f]} return
1860 }
1862 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
1863 if {$n < 0} {
1864 close $f
1865 }
1866 return
1867 }
1869 if {$diffinhunk($ids) != 0} {
1870 set fi $currentfile($ids)
1871 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
1872 # continuing an existing hunk
1873 set line [string range $line 1 end]
1874 set p [lindex $ids 1]
1875 if {$match eq "-" || $match eq " "} {
1876 set filelines($p,$fi,$diffoldlno($ids)) $line
1877 incr diffoldlno($ids)
1878 }
1879 if {$match eq "+" || $match eq " "} {
1880 set filelines($id,$fi,$diffnewlno($ids)) $line
1881 incr diffnewlno($ids)
1882 }
1883 if {$match eq " "} {
1884 if {$diffinhunk($ids) == 2} {
1885 lappend difflcounts($ids) \
1886 [list $noldlines($ids) $nnewlines($ids)]
1887 set noldlines($ids) 0
1888 set diffinhunk($ids) 1
1889 }
1890 incr noldlines($ids)
1891 } elseif {$match eq "-" || $match eq "+"} {
1892 if {$diffinhunk($ids) == 1} {
1893 lappend difflcounts($ids) [list $noldlines($ids)]
1894 set noldlines($ids) 0
1895 set nnewlines($ids) 0
1896 set diffinhunk($ids) 2
1897 }
1898 if {$match eq "-"} {
1899 incr noldlines($ids)
1900 } else {
1901 incr nnewlines($ids)
1902 }
1903 }
1904 # and if it's \ No newline at end of line, then what?
1905 return
1906 }
1907 # end of a hunk
1908 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
1909 lappend difflcounts($ids) [list $noldlines($ids)]
1910 } elseif {$diffinhunk($ids) == 2
1911 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
1912 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
1913 }
1914 set currenthunk($ids) [list $currentfile($ids) \
1915 $diffoldstart($ids) $diffnewstart($ids) \
1916 $diffoldlno($ids) $diffnewlno($ids) \
1917 $difflcounts($ids)]
1918 set diffinhunk($ids) 0
1919 # -1 = need to block, 0 = unblocked, 1 = is blocked
1920 set diffblocked($ids) -1
1921 processhunks
1922 if {$diffblocked($ids) == -1} {
1923 fileevent $f readable {}
1924 set diffblocked($ids) 1
1925 }
1926 }
1928 if {$n < 0} {
1929 # eof
1930 if {!$diffblocked($ids)} {
1931 close $f
1932 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
1933 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
1934 processhunks
1935 }
1936 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
1937 # start of a new file
1938 set currentfile($ids) \
1939 [lsearch -exact $mergefilelist($diffmergeid) $fname]
1940 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1941 $line match f1l f1c f2l f2c rest]} {
1942 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
1943 # start of a new hunk
1944 if {$f1l == 0 && $f1c == 0} {
1945 set f1l 1
1946 }
1947 if {$f2l == 0 && $f2c == 0} {
1948 set f2l 1
1949 }
1950 set diffinhunk($ids) 1
1951 set diffoldstart($ids) $f1l
1952 set diffnewstart($ids) $f2l
1953 set diffoldlno($ids) $f1l
1954 set diffnewlno($ids) $f2l
1955 set difflcounts($ids) {}
1956 set noldlines($ids) 0
1957 set nnewlines($ids) 0
1958 }
1959 }
1960 }
1962 proc processhunks {} {
1963 global diffmergeid parents nparents currenthunk
1964 global mergefilelist diffblocked mergefds
1965 global grouphunks grouplinestart grouplineend groupfilenum
1967 set nfiles [llength $mergefilelist($diffmergeid)]
1968 while 1 {
1969 set fi $nfiles
1970 set lno 0
1971 # look for the earliest hunk
1972 foreach p $parents($diffmergeid) {
1973 set ids [list $diffmergeid $p]
1974 if {![info exists currenthunk($ids)]} return
1975 set i [lindex $currenthunk($ids) 0]
1976 set l [lindex $currenthunk($ids) 2]
1977 if {$i < $fi || ($i == $fi && $l < $lno)} {
1978 set fi $i
1979 set lno $l
1980 set pi $p
1981 }
1982 }
1984 if {$fi < $nfiles} {
1985 set ids [list $diffmergeid $pi]
1986 set hunk $currenthunk($ids)
1987 unset currenthunk($ids)
1988 if {$diffblocked($ids) > 0} {
1989 fileevent $mergefds($ids) readable \
1990 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
1991 }
1992 set diffblocked($ids) 0
1994 if {[info exists groupfilenum] && $groupfilenum == $fi
1995 && $lno <= $grouplineend} {
1996 # add this hunk to the pending group
1997 lappend grouphunks($pi) $hunk
1998 set endln [lindex $hunk 4]
1999 if {$endln > $grouplineend} {
2000 set grouplineend $endln
2001 }
2002 continue
2003 }
2004 }
2006 # succeeding stuff doesn't belong in this group, so
2007 # process the group now
2008 if {[info exists groupfilenum]} {
2009 processgroup
2010 unset groupfilenum
2011 unset grouphunks
2012 }
2014 if {$fi >= $nfiles} break
2016 # start a new group
2017 set groupfilenum $fi
2018 set grouphunks($pi) [list $hunk]
2019 set grouplinestart $lno
2020 set grouplineend [lindex $hunk 4]
2021 }
2022 }
2024 proc processgroup {} {
2025 global groupfilelast groupfilenum difffilestart
2026 global mergefilelist diffmergeid ctext filelines
2027 global parents diffmergeid diffoffset
2028 global grouphunks grouplinestart grouplineend nparents
2029 global mergemax
2031 $ctext conf -state normal
2032 set id $diffmergeid
2033 set f $groupfilenum
2034 if {$groupfilelast != $f} {
2035 $ctext insert end "\n"
2036 set here [$ctext index "end - 1c"]
2037 set difffilestart($f) $here
2038 set mark fmark.[expr {$f + 1}]
2039 $ctext mark set $mark $here
2040 $ctext mark gravity $mark left
2041 set header [lindex $mergefilelist($id) $f]
2042 set l [expr {(78 - [string length $header]) / 2}]
2043 set pad [string range "----------------------------------------" 1 $l]
2044 $ctext insert end "$pad $header $pad\n" filesep
2045 set groupfilelast $f
2046 foreach p $parents($id) {
2047 set diffoffset($p) 0
2048 }
2049 }
2051 $ctext insert end "@@" msep
2052 set nlines [expr {$grouplineend - $grouplinestart}]
2053 set events {}
2054 set pnum 0
2055 foreach p $parents($id) {
2056 set startline [expr {$grouplinestart + $diffoffset($p)}]
2057 set offset($p) $diffoffset($p)
2058 set ol $startline
2059 set nl $grouplinestart
2060 if {[info exists grouphunks($p)]} {
2061 foreach h $grouphunks($p) {
2062 set l [lindex $h 2]
2063 if {$nl < $l} {
2064 for {} {$nl < $l} {incr nl} {
2065 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2066 incr ol
2067 }
2068 }
2069 foreach chunk [lindex $h 5] {
2070 if {[llength $chunk] == 2} {
2071 set olc [lindex $chunk 0]
2072 set nlc [lindex $chunk 1]
2073 set nnl [expr {$nl + $nlc}]
2074 lappend events [list $nl $nnl $pnum $olc $nlc]
2075 incr ol $olc
2076 set nl $nnl
2077 } else {
2078 incr ol [lindex $chunk 0]
2079 incr nl [lindex $chunk 0]
2080 }
2081 }
2082 }
2083 }
2084 if {$nl < $grouplineend} {
2085 for {} {$nl < $grouplineend} {incr nl} {
2086 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2087 incr ol
2088 }
2089 }
2090 set nlines [expr {$ol - $startline}]
2091 $ctext insert end " -$startline,$nlines" msep
2092 incr pnum
2093 }
2095 set nlines [expr {$grouplineend - $grouplinestart}]
2096 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2098 set events [lsort -integer -index 0 $events]
2099 set nevents [llength $events]
2100 set nmerge $nparents($diffmergeid)
2101 set i 0
2102 set l $grouplinestart
2103 while {$i < $nevents} {
2104 set nl [lindex $events $i 0]
2105 while {$l < $nl} {
2106 $ctext insert end " $filelines($id,$f,$l)\n"
2107 incr l
2108 }
2109 set e [lindex $events $i]
2110 set enl [lindex $e 1]
2111 set j $i
2112 set active {}
2113 while 1 {
2114 set pnum [lindex $e 2]
2115 set olc [lindex $e 3]
2116 set nlc [lindex $e 4]
2117 if {![info exists delta($pnum)]} {
2118 set delta($pnum) [expr {$olc - $nlc}]
2119 lappend active $pnum
2120 } else {
2121 incr delta($pnum) [expr {$olc - $nlc}]
2122 }
2123 if {[incr j] >= $nevents} break
2124 set e [lindex $events $j]
2125 if {[lindex $e 0] >= $enl} break
2126 if {[lindex $e 1] > $enl} {
2127 set enl [lindex $e 1]
2128 }
2129 }
2130 set nlc [expr {$enl - $l}]
2131 set ncol mresult
2132 if {[llength $active] == $nmerge - 1} {
2133 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2134 if {![info exists delta($pnum)]} {
2135 if {$pnum < $mergemax} {
2136 lappend ncol m$pnum
2137 } else {
2138 lappend ncol mmax
2139 }
2140 break
2141 }
2142 }
2143 }
2144 set pnum -1
2145 foreach p $parents($id) {
2146 incr pnum
2147 if {![info exists delta($pnum)]} continue
2148 set olc [expr {$nlc + $delta($pnum)}]
2149 set ol [expr {$l + $diffoffset($p)}]
2150 incr diffoffset($p) $delta($pnum)
2151 unset delta($pnum)
2152 for {} {$olc > 0} {incr olc -1} {
2153 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2154 incr ol
2155 }
2156 }
2157 for {} {$nlc > 0} {incr nlc -1} {
2158 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2159 incr l
2160 }
2161 set i $j
2162 }
2163 while {$l < $grouplineend} {
2164 $ctext insert end " $filelines($id,$f,$l)\n"
2165 incr l
2166 }
2167 $ctext conf -state disabled
2168 }
2170 proc startdiff {ids} {
2171 global treediffs diffids treepending diffmergeid
2173 set diffids $ids
2174 catch {unset diffmergeid}
2175 if {![info exists treediffs($ids)]} {
2176 if {![info exists treepending]} {
2177 gettreediffs $ids
2178 }
2179 } else {
2180 addtocflist $ids
2181 }
2182 }
2184 proc addtocflist {ids} {
2185 global treediffs cflist
2186 foreach f $treediffs($ids) {
2187 $cflist insert end $f
2188 }
2189 getblobdiffs $ids
2190 }
2192 proc gettreediffs {ids} {
2193 global treediff parents treepending
2194 set treepending $ids
2195 set treediff {}
2196 set id [lindex $ids 0]
2197 set p [lindex $ids 1]
2198 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2199 fconfigure $gdtf -blocking 0
2200 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2201 }
2203 proc gettreediffline {gdtf ids} {
2204 global treediff treediffs treepending diffids diffmergeid
2206 set n [gets $gdtf line]
2207 if {$n < 0} {
2208 if {![eof $gdtf]} return
2209 close $gdtf
2210 set treediffs($ids) $treediff
2211 unset treepending
2212 if {$ids != $diffids} {
2213 gettreediffs $diffids
2214 } else {
2215 if {[info exists diffmergeid]} {
2216 contmergediff $ids
2217 } else {
2218 addtocflist $ids
2219 }
2220 }
2221 return
2222 }
2223 set file [lindex $line 5]
2224 lappend treediff $file
2225 }
2227 proc getblobdiffs {ids} {
2228 global diffopts blobdifffd diffids env curdifftag curtagstart
2229 global difffilestart nextupdate diffinhdr treediffs
2231 set id [lindex $ids 0]
2232 set p [lindex $ids 1]
2233 set env(GIT_DIFF_OPTS) $diffopts
2234 set cmd [list | git-diff-tree -r -p -C $p $id]
2235 if {[catch {set bdf [open $cmd r]} err]} {
2236 puts "error getting diffs: $err"
2237 return
2238 }
2239 set diffinhdr 0
2240 fconfigure $bdf -blocking 0
2241 set blobdifffd($ids) $bdf
2242 set curdifftag Comments
2243 set curtagstart 0.0
2244 catch {unset difffilestart}
2245 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2246 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2247 }
2249 proc getblobdiffline {bdf ids} {
2250 global diffids blobdifffd ctext curdifftag curtagstart
2251 global diffnexthead diffnextnote difffilestart
2252 global nextupdate diffinhdr treediffs
2253 global gaudydiff
2255 set n [gets $bdf line]
2256 if {$n < 0} {
2257 if {[eof $bdf]} {
2258 close $bdf
2259 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2260 $ctext tag add $curdifftag $curtagstart end
2261 }
2262 }
2263 return
2264 }
2265 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2266 return
2267 }
2268 $ctext conf -state normal
2269 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2270 # start of a new file
2271 $ctext insert end "\n"
2272 $ctext tag add $curdifftag $curtagstart end
2273 set curtagstart [$ctext index "end - 1c"]
2274 set header $newname
2275 set here [$ctext index "end - 1c"]
2276 set i [lsearch -exact $treediffs($diffids) $fname]
2277 if {$i >= 0} {
2278 set difffilestart($i) $here
2279 incr i
2280 $ctext mark set fmark.$i $here
2281 $ctext mark gravity fmark.$i left
2282 }
2283 if {$newname != $fname} {
2284 set i [lsearch -exact $treediffs($diffids) $newname]
2285 if {$i >= 0} {
2286 set difffilestart($i) $here
2287 incr i
2288 $ctext mark set fmark.$i $here
2289 $ctext mark gravity fmark.$i left
2290 }
2291 }
2292 set curdifftag "f:$fname"
2293 $ctext tag delete $curdifftag
2294 set l [expr {(78 - [string length $header]) / 2}]
2295 set pad [string range "----------------------------------------" 1 $l]
2296 $ctext insert end "$pad $header $pad\n" filesep
2297 set diffinhdr 1
2298 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2299 set diffinhdr 0
2300 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2301 $line match f1l f1c f2l f2c rest]} {
2302 if {$gaudydiff} {
2303 $ctext insert end "\t" hunksep
2304 $ctext insert end " $f1l " d0 " $f2l " d1
2305 $ctext insert end " $rest \n" hunksep
2306 } else {
2307 $ctext insert end "$line\n" hunksep
2308 }
2309 set diffinhdr 0
2310 } else {
2311 set x [string range $line 0 0]
2312 if {$x == "-" || $x == "+"} {
2313 set tag [expr {$x == "+"}]
2314 if {$gaudydiff} {
2315 set line [string range $line 1 end]
2316 }
2317 $ctext insert end "$line\n" d$tag
2318 } elseif {$x == " "} {
2319 if {$gaudydiff} {
2320 set line [string range $line 1 end]
2321 }
2322 $ctext insert end "$line\n"
2323 } elseif {$diffinhdr || $x == "\\"} {
2324 # e.g. "\ No newline at end of file"
2325 $ctext insert end "$line\n" filesep
2326 } else {
2327 # Something else we don't recognize
2328 if {$curdifftag != "Comments"} {
2329 $ctext insert end "\n"
2330 $ctext tag add $curdifftag $curtagstart end
2331 set curtagstart [$ctext index "end - 1c"]
2332 set curdifftag Comments
2333 }
2334 $ctext insert end "$line\n" filesep
2335 }
2336 }
2337 $ctext conf -state disabled
2338 if {[clock clicks -milliseconds] >= $nextupdate} {
2339 incr nextupdate 100
2340 fileevent $bdf readable {}
2341 update
2342 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2343 }
2344 }
2346 proc nextfile {} {
2347 global difffilestart ctext
2348 set here [$ctext index @0,0]
2349 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2350 if {[$ctext compare $difffilestart($i) > $here]} {
2351 if {![info exists pos]
2352 || [$ctext compare $difffilestart($i) < $pos]} {
2353 set pos $difffilestart($i)
2354 }
2355 }
2356 }
2357 if {[info exists pos]} {
2358 $ctext yview $pos
2359 }
2360 }
2362 proc listboxsel {} {
2363 global ctext cflist currentid
2364 if {![info exists currentid]} return
2365 set sel [lsort [$cflist curselection]]
2366 if {$sel eq {}} return
2367 set first [lindex $sel 0]
2368 catch {$ctext yview fmark.$first}
2369 }
2371 proc setcoords {} {
2372 global linespc charspc canvx0 canvy0 mainfont
2373 set linespc [font metrics $mainfont -linespace]
2374 set charspc [font measure $mainfont "m"]
2375 set canvy0 [expr 3 + 0.5 * $linespc]
2376 set canvx0 [expr 3 + 0.5 * $linespc]
2377 }
2379 proc redisplay {} {
2380 global selectedline stopped redisplaying phase
2381 if {$stopped > 1} return
2382 if {$phase == "getcommits"} return
2383 set redisplaying 1
2384 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2385 set stopped 1
2386 } else {
2387 drawgraph
2388 }
2389 }
2391 proc incrfont {inc} {
2392 global mainfont namefont textfont selectedline ctext canv phase
2393 global stopped entries
2394 unmarkmatches
2395 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2396 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2397 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2398 setcoords
2399 $ctext conf -font $textfont
2400 $ctext tag conf filesep -font [concat $textfont bold]
2401 foreach e $entries {
2402 $e conf -font $mainfont
2403 }
2404 if {$phase == "getcommits"} {
2405 $canv itemconf textitems -font $mainfont
2406 }
2407 redisplay
2408 }
2410 proc clearsha1 {} {
2411 global sha1entry sha1string
2412 if {[string length $sha1string] == 40} {
2413 $sha1entry delete 0 end
2414 }
2415 }
2417 proc sha1change {n1 n2 op} {
2418 global sha1string currentid sha1but
2419 if {$sha1string == {}
2420 || ([info exists currentid] && $sha1string == $currentid)} {
2421 set state disabled
2422 } else {
2423 set state normal
2424 }
2425 if {[$sha1but cget -state] == $state} return
2426 if {$state == "normal"} {
2427 $sha1but conf -state normal -relief raised -text "Goto: "
2428 } else {
2429 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2430 }
2431 }
2433 proc gotocommit {} {
2434 global sha1string currentid idline tagids
2435 global lineid numcommits
2437 if {$sha1string == {}
2438 || ([info exists currentid] && $sha1string == $currentid)} return
2439 if {[info exists tagids($sha1string)]} {
2440 set id $tagids($sha1string)
2441 } else {
2442 set id [string tolower $sha1string]
2443 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2444 set matches {}
2445 for {set l 0} {$l < $numcommits} {incr l} {
2446 if {[string match $id* $lineid($l)]} {
2447 lappend matches $lineid($l)
2448 }
2449 }
2450 if {$matches ne {}} {
2451 if {[llength $matches] > 1} {
2452 error_popup "Short SHA1 id $id is ambiguous"
2453 return
2454 }
2455 set id [lindex $matches 0]
2456 }
2457 }
2458 }
2459 if {[info exists idline($id)]} {
2460 selectline $idline($id)
2461 return
2462 }
2463 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2464 set type "SHA1 id"
2465 } else {
2466 set type "Tag"
2467 }
2468 error_popup "$type $sha1string is not known"
2469 }
2471 proc lineenter {x y id} {
2472 global hoverx hovery hoverid hovertimer
2473 global commitinfo canv
2475 if {![info exists commitinfo($id)]} return
2476 set hoverx $x
2477 set hovery $y
2478 set hoverid $id
2479 if {[info exists hovertimer]} {
2480 after cancel $hovertimer
2481 }
2482 set hovertimer [after 500 linehover]
2483 $canv delete hover
2484 }
2486 proc linemotion {x y id} {
2487 global hoverx hovery hoverid hovertimer
2489 if {[info exists hoverid] && $id == $hoverid} {
2490 set hoverx $x
2491 set hovery $y
2492 if {[info exists hovertimer]} {
2493 after cancel $hovertimer
2494 }
2495 set hovertimer [after 500 linehover]
2496 }
2497 }
2499 proc lineleave {id} {
2500 global hoverid hovertimer canv
2502 if {[info exists hoverid] && $id == $hoverid} {
2503 $canv delete hover
2504 if {[info exists hovertimer]} {
2505 after cancel $hovertimer
2506 unset hovertimer
2507 }
2508 unset hoverid
2509 }
2510 }
2512 proc linehover {} {
2513 global hoverx hovery hoverid hovertimer
2514 global canv linespc lthickness
2515 global commitinfo mainfont
2517 set text [lindex $commitinfo($hoverid) 0]
2518 set ymax [lindex [$canv cget -scrollregion] 3]
2519 if {$ymax == {}} return
2520 set yfrac [lindex [$canv yview] 0]
2521 set x [expr {$hoverx + 2 * $linespc}]
2522 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2523 set x0 [expr {$x - 2 * $lthickness}]
2524 set y0 [expr {$y - 2 * $lthickness}]
2525 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2526 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2527 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2528 -fill \#ffff80 -outline black -width 1 -tags hover]
2529 $canv raise $t
2530 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2531 $canv raise $t
2532 }
2534 proc lineclick {x y id} {
2535 global ctext commitinfo children cflist canv
2537 unmarkmatches
2538 $canv delete hover
2539 # fill the details pane with info about this line
2540 $ctext conf -state normal
2541 $ctext delete 0.0 end
2542 $ctext insert end "Parent:\n "
2543 catch {destroy $ctext.$id}
2544 button $ctext.$id -text "Go:" -command "selbyid $id" \
2545 -padx 4 -pady 0
2546 $ctext window create end -window $ctext.$id -align center
2547 set info $commitinfo($id)
2548 $ctext insert end "\t[lindex $info 0]\n"
2549 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2550 $ctext insert end "\tDate:\t[lindex $info 2]\n"
2551 $ctext insert end "\tID:\t$id\n"
2552 if {[info exists children($id)]} {
2553 $ctext insert end "\nChildren:"
2554 foreach child $children($id) {
2555 $ctext insert end "\n "
2556 catch {destroy $ctext.$child}
2557 button $ctext.$child -text "Go:" -command "selbyid $child" \
2558 -padx 4 -pady 0
2559 $ctext window create end -window $ctext.$child -align center
2560 set info $commitinfo($child)
2561 $ctext insert end "\t[lindex $info 0]"
2562 }
2563 }
2564 $ctext conf -state disabled
2566 $cflist delete 0 end
2567 }
2569 proc selbyid {id} {
2570 global idline
2571 if {[info exists idline($id)]} {
2572 selectline $idline($id)
2573 }
2574 }
2576 proc mstime {} {
2577 global startmstime
2578 if {![info exists startmstime]} {
2579 set startmstime [clock clicks -milliseconds]
2580 }
2581 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2582 }
2584 proc rowmenu {x y id} {
2585 global rowctxmenu idline selectedline rowmenuid
2587 if {![info exists selectedline] || $idline($id) eq $selectedline} {
2588 set state disabled
2589 } else {
2590 set state normal
2591 }
2592 $rowctxmenu entryconfigure 0 -state $state
2593 $rowctxmenu entryconfigure 1 -state $state
2594 $rowctxmenu entryconfigure 2 -state $state
2595 set rowmenuid $id
2596 tk_popup $rowctxmenu $x $y
2597 }
2599 proc diffvssel {dirn} {
2600 global rowmenuid selectedline lineid
2601 global ctext cflist
2602 global commitinfo
2604 if {![info exists selectedline]} return
2605 if {$dirn} {
2606 set oldid $lineid($selectedline)
2607 set newid $rowmenuid
2608 } else {
2609 set oldid $rowmenuid
2610 set newid $lineid($selectedline)
2611 }
2612 $ctext conf -state normal
2613 $ctext delete 0.0 end
2614 $ctext mark set fmark.0 0.0
2615 $ctext mark gravity fmark.0 left
2616 $cflist delete 0 end
2617 $cflist insert end "Top"
2618 $ctext insert end "From $oldid\n "
2619 $ctext insert end [lindex $commitinfo($oldid) 0]
2620 $ctext insert end "\n\nTo $newid\n "
2621 $ctext insert end [lindex $commitinfo($newid) 0]
2622 $ctext insert end "\n"
2623 $ctext conf -state disabled
2624 $ctext tag delete Comments
2625 $ctext tag remove found 1.0 end
2626 startdiff $newid [list $oldid]
2627 }
2629 proc mkpatch {} {
2630 global rowmenuid currentid commitinfo patchtop patchnum
2632 if {![info exists currentid]} return
2633 set oldid $currentid
2634 set oldhead [lindex $commitinfo($oldid) 0]
2635 set newid $rowmenuid
2636 set newhead [lindex $commitinfo($newid) 0]
2637 set top .patch
2638 set patchtop $top
2639 catch {destroy $top}
2640 toplevel $top
2641 label $top.title -text "Generate patch"
2642 grid $top.title - -pady 10
2643 label $top.from -text "From:"
2644 entry $top.fromsha1 -width 40 -relief flat
2645 $top.fromsha1 insert 0 $oldid
2646 $top.fromsha1 conf -state readonly
2647 grid $top.from $top.fromsha1 -sticky w
2648 entry $top.fromhead -width 60 -relief flat
2649 $top.fromhead insert 0 $oldhead
2650 $top.fromhead conf -state readonly
2651 grid x $top.fromhead -sticky w
2652 label $top.to -text "To:"
2653 entry $top.tosha1 -width 40 -relief flat
2654 $top.tosha1 insert 0 $newid
2655 $top.tosha1 conf -state readonly
2656 grid $top.to $top.tosha1 -sticky w
2657 entry $top.tohead -width 60 -relief flat
2658 $top.tohead insert 0 $newhead
2659 $top.tohead conf -state readonly
2660 grid x $top.tohead -sticky w
2661 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2662 grid $top.rev x -pady 10
2663 label $top.flab -text "Output file:"
2664 entry $top.fname -width 60
2665 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2666 incr patchnum
2667 grid $top.flab $top.fname -sticky w
2668 frame $top.buts
2669 button $top.buts.gen -text "Generate" -command mkpatchgo
2670 button $top.buts.can -text "Cancel" -command mkpatchcan
2671 grid $top.buts.gen $top.buts.can
2672 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2673 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2674 grid $top.buts - -pady 10 -sticky ew
2675 focus $top.fname
2676 }
2678 proc mkpatchrev {} {
2679 global patchtop
2681 set oldid [$patchtop.fromsha1 get]
2682 set oldhead [$patchtop.fromhead get]
2683 set newid [$patchtop.tosha1 get]
2684 set newhead [$patchtop.tohead get]
2685 foreach e [list fromsha1 fromhead tosha1 tohead] \
2686 v [list $newid $newhead $oldid $oldhead] {
2687 $patchtop.$e conf -state normal
2688 $patchtop.$e delete 0 end
2689 $patchtop.$e insert 0 $v
2690 $patchtop.$e conf -state readonly
2691 }
2692 }
2694 proc mkpatchgo {} {
2695 global patchtop
2697 set oldid [$patchtop.fromsha1 get]
2698 set newid [$patchtop.tosha1 get]
2699 set fname [$patchtop.fname get]
2700 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2701 error_popup "Error creating patch: $err"
2702 }
2703 catch {destroy $patchtop}
2704 unset patchtop
2705 }
2707 proc mkpatchcan {} {
2708 global patchtop
2710 catch {destroy $patchtop}
2711 unset patchtop
2712 }
2714 proc mktag {} {
2715 global rowmenuid mktagtop commitinfo
2717 set top .maketag
2718 set mktagtop $top
2719 catch {destroy $top}
2720 toplevel $top
2721 label $top.title -text "Create tag"
2722 grid $top.title - -pady 10
2723 label $top.id -text "ID:"
2724 entry $top.sha1 -width 40 -relief flat
2725 $top.sha1 insert 0 $rowmenuid
2726 $top.sha1 conf -state readonly
2727 grid $top.id $top.sha1 -sticky w
2728 entry $top.head -width 60 -relief flat
2729 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2730 $top.head conf -state readonly
2731 grid x $top.head -sticky w
2732 label $top.tlab -text "Tag name:"
2733 entry $top.tag -width 60
2734 grid $top.tlab $top.tag -sticky w
2735 frame $top.buts
2736 button $top.buts.gen -text "Create" -command mktaggo
2737 button $top.buts.can -text "Cancel" -command mktagcan
2738 grid $top.buts.gen $top.buts.can
2739 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2740 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2741 grid $top.buts - -pady 10 -sticky ew
2742 focus $top.tag
2743 }
2745 proc domktag {} {
2746 global mktagtop env tagids idtags
2747 global idpos idline linehtag canv selectedline
2749 set id [$mktagtop.sha1 get]
2750 set tag [$mktagtop.tag get]
2751 if {$tag == {}} {
2752 error_popup "No tag name specified"
2753 return
2754 }
2755 if {[info exists tagids($tag)]} {
2756 error_popup "Tag \"$tag\" already exists"
2757 return
2758 }
2759 if {[catch {
2760 set dir [gitdir]
2761 set fname [file join $dir "refs/tags" $tag]
2762 set f [open $fname w]
2763 puts $f $id
2764 close $f
2765 } err]} {
2766 error_popup "Error creating tag: $err"
2767 return
2768 }
2770 set tagids($tag) $id
2771 lappend idtags($id) $tag
2772 $canv delete tag.$id
2773 set xt [eval drawtags $id $idpos($id)]
2774 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2775 if {[info exists selectedline] && $selectedline == $idline($id)} {
2776 selectline $selectedline
2777 }
2778 }
2780 proc mktagcan {} {
2781 global mktagtop
2783 catch {destroy $mktagtop}
2784 unset mktagtop
2785 }
2787 proc mktaggo {} {
2788 domktag
2789 mktagcan
2790 }
2792 proc writecommit {} {
2793 global rowmenuid wrcomtop commitinfo wrcomcmd
2795 set top .writecommit
2796 set wrcomtop $top
2797 catch {destroy $top}
2798 toplevel $top
2799 label $top.title -text "Write commit to file"
2800 grid $top.title - -pady 10
2801 label $top.id -text "ID:"
2802 entry $top.sha1 -width 40 -relief flat
2803 $top.sha1 insert 0 $rowmenuid
2804 $top.sha1 conf -state readonly
2805 grid $top.id $top.sha1 -sticky w
2806 entry $top.head -width 60 -relief flat
2807 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2808 $top.head conf -state readonly
2809 grid x $top.head -sticky w
2810 label $top.clab -text "Command:"
2811 entry $top.cmd -width 60 -textvariable wrcomcmd
2812 grid $top.clab $top.cmd -sticky w -pady 10
2813 label $top.flab -text "Output file:"
2814 entry $top.fname -width 60
2815 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2816 grid $top.flab $top.fname -sticky w
2817 frame $top.buts
2818 button $top.buts.gen -text "Write" -command wrcomgo
2819 button $top.buts.can -text "Cancel" -command wrcomcan
2820 grid $top.buts.gen $top.buts.can
2821 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2822 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2823 grid $top.buts - -pady 10 -sticky ew
2824 focus $top.fname
2825 }
2827 proc wrcomgo {} {
2828 global wrcomtop
2830 set id [$wrcomtop.sha1 get]
2831 set cmd "echo $id | [$wrcomtop.cmd get]"
2832 set fname [$wrcomtop.fname get]
2833 if {[catch {exec sh -c $cmd >$fname &} err]} {
2834 error_popup "Error writing commit: $err"
2835 }
2836 catch {destroy $wrcomtop}
2837 unset wrcomtop
2838 }
2840 proc wrcomcan {} {
2841 global wrcomtop
2843 catch {destroy $wrcomtop}
2844 unset wrcomtop
2845 }
2847 proc doquit {} {
2848 global stopped
2849 set stopped 100
2850 destroy .
2851 }
2853 # defaults...
2854 set datemode 0
2855 set boldnames 0
2856 set diffopts "-U 5 -p"
2857 set wrcomcmd "git-diff-tree --stdin -p --pretty"
2859 set mainfont {Helvetica 9}
2860 set textfont {Courier 9}
2861 set findmergefiles 0
2862 set gaudydiff 0
2864 set colors {green red blue magenta darkgrey brown orange}
2866 catch {source ~/.gitk}
2868 set namefont $mainfont
2869 if {$boldnames} {
2870 lappend namefont bold
2871 }
2873 set revtreeargs {}
2874 foreach arg $argv {
2875 switch -regexp -- $arg {
2876 "^$" { }
2877 "^-b" { set boldnames 1 }
2878 "^-d" { set datemode 1 }
2879 default {
2880 lappend revtreeargs $arg
2881 }
2882 }
2883 }
2885 set stopped 0
2886 set redisplaying 0
2887 set stuffsaved 0
2888 set patchnum 0
2889 setcoords
2890 makewindow
2891 readrefs
2892 getcommits $revtreeargs