1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "${1+$@}"
4
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.
9
10proc getcommits {rargs} {
11 global commits commfd phase canv mainfont
12 global startmsecs nextupdate
13 global ctext maincursor textcursor leftover
14
15 set commits {}
16 set phase getcommits
17 set startmsecs [clock clicks -milliseconds]
18 set nextupdate [expr $startmsecs + 100]
19 if [catch {
20 set parse_args [concat --default HEAD $rargs]
21 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
22 }] {
23 # if git-rev-parse failed for some reason...
24 if {$rargs == {}} {
25 set rargs HEAD
26 }
27 set parsed_args $rargs
28 }
29 if [catch {
30 set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
31 } err] {
32 puts stderr "Error executing git-rev-list: $err"
33 exit 1
34 }
35 set leftover {}
36 fconfigure $commfd -blocking 0 -translation binary
37 fileevent $commfd readable "getcommitlines $commfd"
38 $canv delete all
39 $canv create text 3 3 -anchor nw -text "Reading commits..." \
40 -font $mainfont -tags textitems
41 . config -cursor watch
42 $ctext config -cursor watch
43}
44
45proc getcommitlines {commfd} {
46 global commits parents cdate children nchildren
47 global commitlisted phase commitinfo nextupdate
48 global stopped redisplaying leftover
49
50 set stuff [read $commfd]
51 if {$stuff == {}} {
52 if {![eof $commfd]} return
53 # this works around what is apparently a bug in Tcl...
54 fconfigure $commfd -blocking 1
55 if {![catch {close $commfd} err]} {
56 after idle finishcommits
57 return
58 }
59 if {[string range $err 0 4] == "usage"} {
60 set err \
61{Gitk: error reading commits: bad arguments to git-rev-list.
62(Note: arguments to gitk are passed to git-rev-list
63to allow selection of commits to be displayed.)}
64 } else {
65 set err "Error reading commits: $err"
66 }
67 error_popup $err
68 exit 1
69 }
70 set start 0
71 while 1 {
72 set i [string first "\0" $stuff $start]
73 if {$i < 0} {
74 set leftover [string range $stuff $start end]
75 return
76 }
77 set cmit [string range $stuff $start [expr {$i - 1}]]
78 if {$start == 0} {
79 set cmit "$leftover$cmit"
80 }
81 set start [expr {$i + 1}]
82 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
83 error_popup "Can't parse git-rev-list output: {$cmit}"
84 exit 1
85 }
86 set cmit [string range $cmit 41 end]
87 lappend commits $id
88 set commitlisted($id) 1
89 parsecommit $id $cmit 1
90 drawcommit $id
91 if {[clock clicks -milliseconds] >= $nextupdate} {
92 doupdate
93 }
94 while {$redisplaying} {
95 set redisplaying 0
96 if {$stopped == 1} {
97 set stopped 0
98 set phase "getcommits"
99 foreach id $commits {
100 drawcommit $id
101 if {$stopped} break
102 if {[clock clicks -milliseconds] >= $nextupdate} {
103 doupdate
104 }
105 }
106 }
107 }
108 }
109}
110
111proc doupdate {} {
112 global commfd nextupdate
113
114 incr nextupdate 100
115 fileevent $commfd readable {}
116 update
117 fileevent $commfd readable "getcommitlines $commfd"
118}
119
120proc readcommit {id} {
121 if [catch {set contents [exec git-cat-file commit $id]}] return
122 parsecommit $id $contents 0
123}
124
125proc parsecommit {id contents listed} {
126 global commitinfo children nchildren parents nparents cdate ncleft
127
128 set inhdr 1
129 set comment {}
130 set headline {}
131 set auname {}
132 set audate {}
133 set comname {}
134 set comdate {}
135 if {![info exists nchildren($id)]} {
136 set children($id) {}
137 set nchildren($id) 0
138 set ncleft($id) 0
139 }
140 set parents($id) {}
141 set nparents($id) 0
142 foreach line [split $contents "\n"] {
143 if {$inhdr} {
144 if {$line == {}} {
145 set inhdr 0
146 } else {
147 set tag [lindex $line 0]
148 if {$tag == "parent"} {
149 set p [lindex $line 1]
150 if {![info exists nchildren($p)]} {
151 set children($p) {}
152 set nchildren($p) 0
153 set ncleft($p) 0
154 }
155 lappend parents($id) $p
156 incr nparents($id)
157 # sometimes we get a commit that lists a parent twice...
158 if {$listed && [lsearch -exact $children($p) $id] < 0} {
159 lappend children($p) $id
160 incr nchildren($p)
161 incr ncleft($p)
162 }
163 } elseif {$tag == "author"} {
164 set x [expr {[llength $line] - 2}]
165 set audate [lindex $line $x]
166 set auname [lrange $line 1 [expr {$x - 1}]]
167 } elseif {$tag == "committer"} {
168 set x [expr {[llength $line] - 2}]
169 set comdate [lindex $line $x]
170 set comname [lrange $line 1 [expr {$x - 1}]]
171 }
172 }
173 } else {
174 if {$comment == {}} {
175 set headline [string trim $line]
176 } else {
177 append comment "\n"
178 }
179 if {!$listed} {
180 # git-rev-list indents the comment by 4 spaces;
181 # if we got this via git-cat-file, add the indentation
182 append comment " "
183 }
184 append comment $line
185 }
186 }
187 if {$audate != {}} {
188 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
189 }
190 if {$comdate != {}} {
191 set cdate($id) $comdate
192 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
193 }
194 set commitinfo($id) [list $headline $auname $audate \
195 $comname $comdate $comment]
196}
197
198proc readrefs {} {
199 global tagids idtags headids idheads
200 set tags [glob -nocomplain -types f .git/refs/tags/*]
201 foreach f $tags {
202 catch {
203 set fd [open $f r]
204 set line [read $fd]
205 if {[regexp {^[0-9a-f]{40}} $line id]} {
206 set direct [file tail $f]
207 set tagids($direct) $id
208 lappend idtags($id) $direct
209 set contents [split [exec git-cat-file tag $id] "\n"]
210 set obj {}
211 set type {}
212 set tag {}
213 foreach l $contents {
214 if {$l == {}} break
215 switch -- [lindex $l 0] {
216 "object" {set obj [lindex $l 1]}
217 "type" {set type [lindex $l 1]}
218 "tag" {set tag [string range $l 4 end]}
219 }
220 }
221 if {$obj != {} && $type == "commit" && $tag != {}} {
222 set tagids($tag) $obj
223 lappend idtags($obj) $tag
224 }
225 }
226 close $fd
227 }
228 }
229 set heads [glob -nocomplain -types f .git/refs/heads/*]
230 foreach f $heads {
231 catch {
232 set fd [open $f r]
233 set line [read $fd 40]
234 if {[regexp {^[0-9a-f]{40}} $line id]} {
235 set head [file tail $f]
236 set headids($head) $line
237 lappend idheads($line) $head
238 }
239 close $fd
240 }
241 }
242}
243
244proc error_popup msg {
245 set w .error
246 toplevel $w
247 wm transient $w .
248 message $w.m -text $msg -justify center -aspect 400
249 pack $w.m -side top -fill x -padx 20 -pady 20
250 button $w.ok -text OK -command "destroy $w"
251 pack $w.ok -side bottom -fill x
252 bind $w <Visibility> "grab $w; focus $w"
253 tkwait window $w
254}
255
256proc makewindow {} {
257 global canv canv2 canv3 linespc charspc ctext cflist textfont
258 global findtype findloc findstring fstring geometry
259 global entries sha1entry sha1string sha1but
260 global maincursor textcursor
261 global rowctxmenu
262
263 menu .bar
264 .bar add cascade -label "File" -menu .bar.file
265 menu .bar.file
266 .bar.file add command -label "Quit" -command doquit
267 menu .bar.help
268 .bar add cascade -label "Help" -menu .bar.help
269 .bar.help add command -label "About gitk" -command about
270 . configure -menu .bar
271
272 if {![info exists geometry(canv1)]} {
273 set geometry(canv1) [expr 45 * $charspc]
274 set geometry(canv2) [expr 30 * $charspc]
275 set geometry(canv3) [expr 15 * $charspc]
276 set geometry(canvh) [expr 25 * $linespc + 4]
277 set geometry(ctextw) 80
278 set geometry(ctexth) 30
279 set geometry(cflistw) 30
280 }
281 panedwindow .ctop -orient vertical
282 if {[info exists geometry(width)]} {
283 .ctop conf -width $geometry(width) -height $geometry(height)
284 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
285 set geometry(ctexth) [expr {($texth - 8) /
286 [font metrics $textfont -linespace]}]
287 }
288 frame .ctop.top
289 frame .ctop.top.bar
290 pack .ctop.top.bar -side bottom -fill x
291 set cscroll .ctop.top.csb
292 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
293 pack $cscroll -side right -fill y
294 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
295 pack .ctop.top.clist -side top -fill both -expand 1
296 .ctop add .ctop.top
297 set canv .ctop.top.clist.canv
298 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
299 -bg white -bd 0 \
300 -yscrollincr $linespc -yscrollcommand "$cscroll set"
301 .ctop.top.clist add $canv
302 set canv2 .ctop.top.clist.canv2
303 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
304 -bg white -bd 0 -yscrollincr $linespc
305 .ctop.top.clist add $canv2
306 set canv3 .ctop.top.clist.canv3
307 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
308 -bg white -bd 0 -yscrollincr $linespc
309 .ctop.top.clist add $canv3
310 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
311
312 set sha1entry .ctop.top.bar.sha1
313 set entries $sha1entry
314 set sha1but .ctop.top.bar.sha1label
315 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
316 -command gotocommit -width 8
317 $sha1but conf -disabledforeground [$sha1but cget -foreground]
318 pack .ctop.top.bar.sha1label -side left
319 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
320 trace add variable sha1string write sha1change
321 pack $sha1entry -side left -pady 2
322 button .ctop.top.bar.findbut -text "Find" -command dofind
323 pack .ctop.top.bar.findbut -side left
324 set findstring {}
325 set fstring .ctop.top.bar.findstring
326 lappend entries $fstring
327 entry $fstring -width 30 -font $textfont -textvariable findstring
328 pack $fstring -side left -expand 1 -fill x
329 set findtype Exact
330 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
331 set findloc "All fields"
332 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
333 Comments Author Committer
334 pack .ctop.top.bar.findloc -side right
335 pack .ctop.top.bar.findtype -side right
336
337 panedwindow .ctop.cdet -orient horizontal
338 .ctop add .ctop.cdet
339 frame .ctop.cdet.left
340 set ctext .ctop.cdet.left.ctext
341 text $ctext -bg white -state disabled -font $textfont \
342 -width $geometry(ctextw) -height $geometry(ctexth) \
343 -yscrollcommand ".ctop.cdet.left.sb set"
344 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
345 pack .ctop.cdet.left.sb -side right -fill y
346 pack $ctext -side left -fill both -expand 1
347 .ctop.cdet add .ctop.cdet.left
348
349 $ctext tag conf filesep -font [concat $textfont bold]
350 $ctext tag conf hunksep -back blue -fore white
351 $ctext tag conf d0 -back "#ff8080"
352 $ctext tag conf d1 -back green
353 $ctext tag conf found -back yellow
354
355 frame .ctop.cdet.right
356 set cflist .ctop.cdet.right.cfiles
357 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
358 -yscrollcommand ".ctop.cdet.right.sb set"
359 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
360 pack .ctop.cdet.right.sb -side right -fill y
361 pack $cflist -side left -fill both -expand 1
362 .ctop.cdet add .ctop.cdet.right
363 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
364
365 pack .ctop -side top -fill both -expand 1
366
367 bindall <1> {selcanvline %W %x %y}
368 #bindall <B1-Motion> {selcanvline %W %x %y}
369 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
370 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
371 bindall <2> "allcanvs scan mark 0 %y"
372 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
373 bind . <Key-Up> "selnextline -1"
374 bind . <Key-Down> "selnextline 1"
375 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
376 bind . <Key-Next> "allcanvs yview scroll 1 pages"
377 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
378 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
379 bindkey <Key-space> "$ctext yview scroll 1 pages"
380 bindkey p "selnextline -1"
381 bindkey n "selnextline 1"
382 bindkey b "$ctext yview scroll -1 pages"
383 bindkey d "$ctext yview scroll 18 units"
384 bindkey u "$ctext yview scroll -18 units"
385 bindkey / findnext
386 bindkey ? findprev
387 bindkey f nextfile
388 bind . <Control-q> doquit
389 bind . <Control-f> dofind
390 bind . <Control-g> findnext
391 bind . <Control-r> findprev
392 bind . <Control-equal> {incrfont 1}
393 bind . <Control-KP_Add> {incrfont 1}
394 bind . <Control-minus> {incrfont -1}
395 bind . <Control-KP_Subtract> {incrfont -1}
396 bind $cflist <<ListboxSelect>> listboxsel
397 bind . <Destroy> {savestuff %W}
398 bind . <Button-1> "click %W"
399 bind $fstring <Key-Return> dofind
400 bind $sha1entry <Key-Return> gotocommit
401 bind $sha1entry <<PasteSelection>> clearsha1
402
403 set maincursor [. cget -cursor]
404 set textcursor [$ctext cget -cursor]
405
406 set rowctxmenu .rowctxmenu
407 menu $rowctxmenu -tearoff 0
408 $rowctxmenu add command -label "Diff this -> selected" \
409 -command {diffvssel 0}
410 $rowctxmenu add command -label "Diff selected -> this" \
411 -command {diffvssel 1}
412}
413
414# when we make a key binding for the toplevel, make sure
415# it doesn't get triggered when that key is pressed in the
416# find string entry widget.
417proc bindkey {ev script} {
418 global entries
419 bind . $ev $script
420 set escript [bind Entry $ev]
421 if {$escript == {}} {
422 set escript [bind Entry <Key>]
423 }
424 foreach e $entries {
425 bind $e $ev "$escript; break"
426 }
427}
428
429# set the focus back to the toplevel for any click outside
430# the entry widgets
431proc click {w} {
432 global entries
433 foreach e $entries {
434 if {$w == $e} return
435 }
436 focus .
437}
438
439proc savestuff {w} {
440 global canv canv2 canv3 ctext cflist mainfont textfont
441 global stuffsaved
442 if {$stuffsaved} return
443 if {![winfo viewable .]} return
444 catch {
445 set f [open "~/.gitk-new" w]
446 puts $f "set mainfont {$mainfont}"
447 puts $f "set textfont {$textfont}"
448 puts $f "set geometry(width) [winfo width .ctop]"
449 puts $f "set geometry(height) [winfo height .ctop]"
450 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
451 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
452 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
453 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
454 set wid [expr {([winfo width $ctext] - 8) \
455 / [font measure $textfont "0"]}]
456 puts $f "set geometry(ctextw) $wid"
457 set wid [expr {([winfo width $cflist] - 11) \
458 / [font measure [$cflist cget -font] "0"]}]
459 puts $f "set geometry(cflistw) $wid"
460 close $f
461 file rename -force "~/.gitk-new" "~/.gitk"
462 }
463 set stuffsaved 1
464}
465
466proc resizeclistpanes {win w} {
467 global oldwidth
468 if [info exists oldwidth($win)] {
469 set s0 [$win sash coord 0]
470 set s1 [$win sash coord 1]
471 if {$w < 60} {
472 set sash0 [expr {int($w/2 - 2)}]
473 set sash1 [expr {int($w*5/6 - 2)}]
474 } else {
475 set factor [expr {1.0 * $w / $oldwidth($win)}]
476 set sash0 [expr {int($factor * [lindex $s0 0])}]
477 set sash1 [expr {int($factor * [lindex $s1 0])}]
478 if {$sash0 < 30} {
479 set sash0 30
480 }
481 if {$sash1 < $sash0 + 20} {
482 set sash1 [expr $sash0 + 20]
483 }
484 if {$sash1 > $w - 10} {
485 set sash1 [expr $w - 10]
486 if {$sash0 > $sash1 - 20} {
487 set sash0 [expr $sash1 - 20]
488 }
489 }
490 }
491 $win sash place 0 $sash0 [lindex $s0 1]
492 $win sash place 1 $sash1 [lindex $s1 1]
493 }
494 set oldwidth($win) $w
495}
496
497proc resizecdetpanes {win w} {
498 global oldwidth
499 if [info exists oldwidth($win)] {
500 set s0 [$win sash coord 0]
501 if {$w < 60} {
502 set sash0 [expr {int($w*3/4 - 2)}]
503 } else {
504 set factor [expr {1.0 * $w / $oldwidth($win)}]
505 set sash0 [expr {int($factor * [lindex $s0 0])}]
506 if {$sash0 < 45} {
507 set sash0 45
508 }
509 if {$sash0 > $w - 15} {
510 set sash0 [expr $w - 15]
511 }
512 }
513 $win sash place 0 $sash0 [lindex $s0 1]
514 }
515 set oldwidth($win) $w
516}
517
518proc allcanvs args {
519 global canv canv2 canv3
520 eval $canv $args
521 eval $canv2 $args
522 eval $canv3 $args
523}
524
525proc bindall {event action} {
526 global canv canv2 canv3
527 bind $canv $event $action
528 bind $canv2 $event $action
529 bind $canv3 $event $action
530}
531
532proc about {} {
533 set w .about
534 if {[winfo exists $w]} {
535 raise $w
536 return
537 }
538 toplevel $w
539 wm title $w "About gitk"
540 message $w.m -text {
541Gitk version 1.2
542
543Copyright © 2005 Paul Mackerras
544
545Use and redistribute under the terms of the GNU General Public License} \
546 -justify center -aspect 400
547 pack $w.m -side top -fill x -padx 20 -pady 20
548 button $w.ok -text Close -command "destroy $w"
549 pack $w.ok -side bottom
550}
551
552proc assigncolor {id} {
553 global commitinfo colormap commcolors colors nextcolor
554 global parents nparents children nchildren
555 global cornercrossings crossings
556
557 if [info exists colormap($id)] return
558 set ncolors [llength $colors]
559 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
560 set child [lindex $children($id) 0]
561 if {[info exists colormap($child)]
562 && $nparents($child) == 1} {
563 set colormap($id) $colormap($child)
564 return
565 }
566 }
567 set badcolors {}
568 if {[info exists cornercrossings($id)]} {
569 foreach x $cornercrossings($id) {
570 if {[info exists colormap($x)]
571 && [lsearch -exact $badcolors $colormap($x)] < 0} {
572 lappend badcolors $colormap($x)
573 }
574 }
575 if {[llength $badcolors] >= $ncolors} {
576 set badcolors {}
577 }
578 }
579 set origbad $badcolors
580 if {[llength $badcolors] < $ncolors - 1} {
581 if {[info exists crossings($id)]} {
582 foreach x $crossings($id) {
583 if {[info exists colormap($x)]
584 && [lsearch -exact $badcolors $colormap($x)] < 0} {
585 lappend badcolors $colormap($x)
586 }
587 }
588 if {[llength $badcolors] >= $ncolors} {
589 set badcolors $origbad
590 }
591 }
592 set origbad $badcolors
593 }
594 if {[llength $badcolors] < $ncolors - 1} {
595 foreach child $children($id) {
596 if {[info exists colormap($child)]
597 && [lsearch -exact $badcolors $colormap($child)] < 0} {
598 lappend badcolors $colormap($child)
599 }
600 if {[info exists parents($child)]} {
601 foreach p $parents($child) {
602 if {[info exists colormap($p)]
603 && [lsearch -exact $badcolors $colormap($p)] < 0} {
604 lappend badcolors $colormap($p)
605 }
606 }
607 }
608 }
609 if {[llength $badcolors] >= $ncolors} {
610 set badcolors $origbad
611 }
612 }
613 for {set i 0} {$i <= $ncolors} {incr i} {
614 set c [lindex $colors $nextcolor]
615 if {[incr nextcolor] >= $ncolors} {
616 set nextcolor 0
617 }
618 if {[lsearch -exact $badcolors $c]} break
619 }
620 set colormap($id) $c
621}
622
623proc initgraph {} {
624 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
625 global mainline sidelines
626 global nchildren ncleft
627
628 allcanvs delete all
629 set nextcolor 0
630 set canvy $canvy0
631 set lineno -1
632 set numcommits 0
633 set lthickness [expr {int($linespc / 9) + 1}]
634 catch {unset mainline}
635 catch {unset sidelines}
636 foreach id [array names nchildren] {
637 set ncleft($id) $nchildren($id)
638 }
639}
640
641proc bindline {t id} {
642 global canv
643
644 $canv bind $t <Enter> "lineenter %x %y $id"
645 $canv bind $t <Motion> "linemotion %x %y $id"
646 $canv bind $t <Leave> "lineleave $id"
647 $canv bind $t <Button-1> "lineclick %x %y $id"
648}
649
650proc drawcommitline {level} {
651 global parents children nparents nchildren todo
652 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
653 global lineid linehtag linentag linedtag commitinfo
654 global colormap numcommits currentparents dupparents
655 global oldlevel oldnlines oldtodo
656 global idtags idline idheads
657 global lineno lthickness mainline sidelines
658 global commitlisted rowtextx
659
660 incr numcommits
661 incr lineno
662 set id [lindex $todo $level]
663 set lineid($lineno) $id
664 set idline($id) $lineno
665 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
666 if {![info exists commitinfo($id)]} {
667 readcommit $id
668 if {![info exists commitinfo($id)]} {
669 set commitinfo($id) {"No commit information available"}
670 set nparents($id) 0
671 }
672 }
673 assigncolor $id
674 set currentparents {}
675 set dupparents {}
676 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
677 foreach p $parents($id) {
678 if {[lsearch -exact $currentparents $p] < 0} {
679 lappend currentparents $p
680 } else {
681 # remember that this parent was listed twice
682 lappend dupparents $p
683 }
684 }
685 }
686 set x [expr $canvx0 + $level * $linespc]
687 set y1 $canvy
688 set canvy [expr $canvy + $linespc]
689 allcanvs conf -scrollregion \
690 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
691 if {[info exists mainline($id)]} {
692 lappend mainline($id) $x $y1
693 set t [$canv create line $mainline($id) \
694 -width $lthickness -fill $colormap($id)]
695 $canv lower $t
696 bindline $t $id
697 }
698 if {[info exists sidelines($id)]} {
699 foreach ls $sidelines($id) {
700 set coords [lindex $ls 0]
701 set thick [lindex $ls 1]
702 set t [$canv create line $coords -fill $colormap($id) \
703 -width [expr {$thick * $lthickness}]]
704 $canv lower $t
705 bindline $t $id
706 }
707 }
708 set orad [expr {$linespc / 3}]
709 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
710 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
711 -fill $ofill -outline black -width 1]
712 $canv raise $t
713 $canv bind $t <1> {selcanvline {} %x %y}
714 set xt [expr $canvx0 + [llength $todo] * $linespc]
715 if {[llength $currentparents] > 2} {
716 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
717 }
718 set rowtextx($lineno) $xt
719 set marks {}
720 set ntags 0
721 if {[info exists idtags($id)]} {
722 set marks $idtags($id)
723 set ntags [llength $marks]
724 }
725 if {[info exists idheads($id)]} {
726 set marks [concat $marks $idheads($id)]
727 }
728 if {$marks != {}} {
729 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
730 set yt [expr $y1 - 0.5 * $linespc]
731 set yb [expr $yt + $linespc - 1]
732 set xvals {}
733 set wvals {}
734 foreach tag $marks {
735 set wid [font measure $mainfont $tag]
736 lappend xvals $xt
737 lappend wvals $wid
738 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
739 }
740 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
741 -width $lthickness -fill black]
742 $canv lower $t
743 foreach tag $marks x $xvals wid $wvals {
744 set xl [expr $x + $delta]
745 set xr [expr $x + $delta + $wid + $lthickness]
746 if {[incr ntags -1] >= 0} {
747 # draw a tag
748 $canv create polygon $x [expr $yt + $delta] $xl $yt\
749 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
750 -width 1 -outline black -fill yellow
751 } else {
752 # draw a head
753 set xl [expr $xl - $delta/2]
754 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
755 -width 1 -outline black -fill green
756 }
757 $canv create text $xl $y1 -anchor w -text $tag \
758 -font $mainfont
759 }
760 }
761 set headline [lindex $commitinfo($id) 0]
762 set name [lindex $commitinfo($id) 1]
763 set date [lindex $commitinfo($id) 2]
764 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
765 -text $headline -font $mainfont ]
766 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
767 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
768 -text $name -font $namefont]
769 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
770 -text $date -font $mainfont]
771}
772
773proc updatetodo {level noshortcut} {
774 global currentparents ncleft todo
775 global mainline oldlevel oldtodo oldnlines
776 global canvx0 canvy linespc mainline
777 global commitinfo
778
779 set oldlevel $level
780 set oldtodo $todo
781 set oldnlines [llength $todo]
782 if {!$noshortcut && [llength $currentparents] == 1} {
783 set p [lindex $currentparents 0]
784 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
785 set ncleft($p) 0
786 set x [expr $canvx0 + $level * $linespc]
787 set y [expr $canvy - $linespc]
788 set mainline($p) [list $x $y]
789 set todo [lreplace $todo $level $level $p]
790 return 0
791 }
792 }
793
794 set todo [lreplace $todo $level $level]
795 set i $level
796 foreach p $currentparents {
797 incr ncleft($p) -1
798 set k [lsearch -exact $todo $p]
799 if {$k < 0} {
800 set todo [linsert $todo $i $p]
801 incr i
802 }
803 }
804 return 1
805}
806
807proc notecrossings {id lo hi corner} {
808 global oldtodo crossings cornercrossings
809
810 for {set i $lo} {[incr i] < $hi} {} {
811 set p [lindex $oldtodo $i]
812 if {$p == {}} continue
813 if {$i == $corner} {
814 if {![info exists cornercrossings($id)]
815 || [lsearch -exact $cornercrossings($id) $p] < 0} {
816 lappend cornercrossings($id) $p
817 }
818 if {![info exists cornercrossings($p)]
819 || [lsearch -exact $cornercrossings($p) $id] < 0} {
820 lappend cornercrossings($p) $id
821 }
822 } else {
823 if {![info exists crossings($id)]
824 || [lsearch -exact $crossings($id) $p] < 0} {
825 lappend crossings($id) $p
826 }
827 if {![info exists crossings($p)]
828 || [lsearch -exact $crossings($p) $id] < 0} {
829 lappend crossings($p) $id
830 }
831 }
832 }
833}
834
835proc drawslants {} {
836 global canv mainline sidelines canvx0 canvy linespc
837 global oldlevel oldtodo todo currentparents dupparents
838 global lthickness linespc canvy colormap
839
840 set y1 [expr $canvy - $linespc]
841 set y2 $canvy
842 set i -1
843 foreach id $oldtodo {
844 incr i
845 if {$id == {}} continue
846 set xi [expr {$canvx0 + $i * $linespc}]
847 if {$i == $oldlevel} {
848 foreach p $currentparents {
849 set j [lsearch -exact $todo $p]
850 set coords [list $xi $y1]
851 set xj [expr {$canvx0 + $j * $linespc}]
852 if {$j < $i - 1} {
853 lappend coords [expr $xj + $linespc] $y1
854 notecrossings $p $j $i [expr {$j + 1}]
855 } elseif {$j > $i + 1} {
856 lappend coords [expr $xj - $linespc] $y1
857 notecrossings $p $i $j [expr {$j - 1}]
858 }
859 if {[lsearch -exact $dupparents $p] >= 0} {
860 # draw a double-width line to indicate the doubled parent
861 lappend coords $xj $y2
862 lappend sidelines($p) [list $coords 2]
863 if {![info exists mainline($p)]} {
864 set mainline($p) [list $xj $y2]
865 }
866 } else {
867 # normal case, no parent duplicated
868 if {![info exists mainline($p)]} {
869 if {$i != $j} {
870 lappend coords $xj $y2
871 }
872 set mainline($p) $coords
873 } else {
874 lappend coords $xj $y2
875 lappend sidelines($p) [list $coords 1]
876 }
877 }
878 }
879 } elseif {[lindex $todo $i] != $id} {
880 set j [lsearch -exact $todo $id]
881 set xj [expr {$canvx0 + $j * $linespc}]
882 lappend mainline($id) $xi $y1 $xj $y2
883 }
884 }
885}
886
887proc decidenext {} {
888 global parents children nchildren ncleft todo
889 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
890 global datemode cdate
891 global lineid linehtag linentag linedtag commitinfo
892 global currentparents oldlevel oldnlines oldtodo
893 global lineno lthickness
894
895 # remove the null entry if present
896 set nullentry [lsearch -exact $todo {}]
897 if {$nullentry >= 0} {
898 set todo [lreplace $todo $nullentry $nullentry]
899 }
900
901 # choose which one to do next time around
902 set todol [llength $todo]
903 set level -1
904 set latest {}
905 for {set k $todol} {[incr k -1] >= 0} {} {
906 set p [lindex $todo $k]
907 if {$ncleft($p) == 0} {
908 if {$datemode} {
909 if {$latest == {} || $cdate($p) > $latest} {
910 set level $k
911 set latest $cdate($p)
912 }
913 } else {
914 set level $k
915 break
916 }
917 }
918 }
919 if {$level < 0} {
920 if {$todo != {}} {
921 puts "ERROR: none of the pending commits can be done yet:"
922 foreach p $todo {
923 puts " $p ($ncleft($p))"
924 }
925 }
926 return -1
927 }
928
929 # If we are reducing, put in a null entry
930 if {$todol < $oldnlines} {
931 if {$nullentry >= 0} {
932 set i $nullentry
933 while {$i < $todol
934 && [lindex $oldtodo $i] == [lindex $todo $i]} {
935 incr i
936 }
937 } else {
938 set i $oldlevel
939 if {$level >= $i} {
940 incr i
941 }
942 }
943 if {$i < $todol} {
944 set todo [linsert $todo $i {}]
945 if {$level >= $i} {
946 incr level
947 }
948 }
949 }
950 return $level
951}
952
953proc drawcommit {id} {
954 global phase todo nchildren datemode nextupdate
955 global startcommits
956
957 if {$phase != "incrdraw"} {
958 set phase incrdraw
959 set todo $id
960 set startcommits $id
961 initgraph
962 drawcommitline 0
963 updatetodo 0 $datemode
964 } else {
965 if {$nchildren($id) == 0} {
966 lappend todo $id
967 lappend startcommits $id
968 }
969 set level [decidenext]
970 if {$id != [lindex $todo $level]} {
971 return
972 }
973 while 1 {
974 drawslants
975 drawcommitline $level
976 if {[updatetodo $level $datemode]} {
977 set level [decidenext]
978 }
979 set id [lindex $todo $level]
980 if {![info exists commitlisted($id)]} {
981 break
982 }
983 if {[clock clicks -milliseconds] >= $nextupdate} {
984 doupdate
985 if {$stopped} break
986 }
987 }
988 }
989}
990
991proc finishcommits {} {
992 global phase
993 global startcommits
994 global ctext maincursor textcursor
995
996 if {$phase != "incrdraw"} {
997 $canv delete all
998 $canv create text 3 3 -anchor nw -text "No commits selected" \
999 -font $mainfont -tags textitems
1000 set phase {}
1001 return
1002 }
1003 drawslants
1004 set level [decidenext]
1005 drawrest $level [llength $startcommits]
1006 . config -cursor $maincursor
1007 $ctext config -cursor $textcursor
1008}
1009
1010proc drawgraph {} {
1011 global nextupdate startmsecs startcommits todo
1012
1013 if {$startcommits == {}} return
1014 set startmsecs [clock clicks -milliseconds]
1015 set nextupdate [expr $startmsecs + 100]
1016 initgraph
1017 set todo [lindex $startcommits 0]
1018 drawrest 0 1
1019}
1020
1021proc drawrest {level startix} {
1022 global phase stopped redisplaying selectedline
1023 global datemode currentparents todo
1024 global numcommits
1025 global nextupdate startmsecs startcommits idline
1026
1027 if {$level >= 0} {
1028 set phase drawgraph
1029 set startid [lindex $startcommits $startix]
1030 set startline -1
1031 if {$startid != {}} {
1032 set startline $idline($startid)
1033 }
1034 while 1 {
1035 if {$stopped} break
1036 drawcommitline $level
1037 set hard [updatetodo $level $datemode]
1038 if {$numcommits == $startline} {
1039 lappend todo $startid
1040 set hard 1
1041 incr startix
1042 set startid [lindex $startcommits $startix]
1043 set startline -1
1044 if {$startid != {}} {
1045 set startline $idline($startid)
1046 }
1047 }
1048 if {$hard} {
1049 set level [decidenext]
1050 if {$level < 0} break
1051 drawslants
1052 }
1053 if {[clock clicks -milliseconds] >= $nextupdate} {
1054 update
1055 incr nextupdate 100
1056 }
1057 }
1058 }
1059 set phase {}
1060 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1061 #puts "overall $drawmsecs ms for $numcommits commits"
1062 if {$redisplaying} {
1063 if {$stopped == 0 && [info exists selectedline]} {
1064 selectline $selectedline
1065 }
1066 if {$stopped == 1} {
1067 set stopped 0
1068 after idle drawgraph
1069 } else {
1070 set redisplaying 0
1071 }
1072 }
1073}
1074
1075proc findmatches {f} {
1076 global findtype foundstring foundstrlen
1077 if {$findtype == "Regexp"} {
1078 set matches [regexp -indices -all -inline $foundstring $f]
1079 } else {
1080 if {$findtype == "IgnCase"} {
1081 set str [string tolower $f]
1082 } else {
1083 set str $f
1084 }
1085 set matches {}
1086 set i 0
1087 while {[set j [string first $foundstring $str $i]] >= 0} {
1088 lappend matches [list $j [expr $j+$foundstrlen-1]]
1089 set i [expr $j + $foundstrlen]
1090 }
1091 }
1092 return $matches
1093}
1094
1095proc dofind {} {
1096 global findtype findloc findstring markedmatches commitinfo
1097 global numcommits lineid linehtag linentag linedtag
1098 global mainfont namefont canv canv2 canv3 selectedline
1099 global matchinglines foundstring foundstrlen
1100 unmarkmatches
1101 focus .
1102 set matchinglines {}
1103 set fldtypes {Headline Author Date Committer CDate Comment}
1104 if {$findtype == "IgnCase"} {
1105 set foundstring [string tolower $findstring]
1106 } else {
1107 set foundstring $findstring
1108 }
1109 set foundstrlen [string length $findstring]
1110 if {$foundstrlen == 0} return
1111 if {![info exists selectedline]} {
1112 set oldsel -1
1113 } else {
1114 set oldsel $selectedline
1115 }
1116 set didsel 0
1117 for {set l 0} {$l < $numcommits} {incr l} {
1118 set id $lineid($l)
1119 set info $commitinfo($id)
1120 set doesmatch 0
1121 foreach f $info ty $fldtypes {
1122 if {$findloc != "All fields" && $findloc != $ty} {
1123 continue
1124 }
1125 set matches [findmatches $f]
1126 if {$matches == {}} continue
1127 set doesmatch 1
1128 if {$ty == "Headline"} {
1129 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1130 } elseif {$ty == "Author"} {
1131 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1132 } elseif {$ty == "Date"} {
1133 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1134 }
1135 }
1136 if {$doesmatch} {
1137 lappend matchinglines $l
1138 if {!$didsel && $l > $oldsel} {
1139 findselectline $l
1140 set didsel 1
1141 }
1142 }
1143 }
1144 if {$matchinglines == {}} {
1145 bell
1146 } elseif {!$didsel} {
1147 findselectline [lindex $matchinglines 0]
1148 }
1149}
1150
1151proc findselectline {l} {
1152 global findloc commentend ctext
1153 selectline $l
1154 if {$findloc == "All fields" || $findloc == "Comments"} {
1155 # highlight the matches in the comments
1156 set f [$ctext get 1.0 $commentend]
1157 set matches [findmatches $f]
1158 foreach match $matches {
1159 set start [lindex $match 0]
1160 set end [expr [lindex $match 1] + 1]
1161 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1162 }
1163 }
1164}
1165
1166proc findnext {} {
1167 global matchinglines selectedline
1168 if {![info exists matchinglines]} {
1169 dofind
1170 return
1171 }
1172 if {![info exists selectedline]} return
1173 foreach l $matchinglines {
1174 if {$l > $selectedline} {
1175 findselectline $l
1176 return
1177 }
1178 }
1179 bell
1180}
1181
1182proc findprev {} {
1183 global matchinglines selectedline
1184 if {![info exists matchinglines]} {
1185 dofind
1186 return
1187 }
1188 if {![info exists selectedline]} return
1189 set prev {}
1190 foreach l $matchinglines {
1191 if {$l >= $selectedline} break
1192 set prev $l
1193 }
1194 if {$prev != {}} {
1195 findselectline $prev
1196 } else {
1197 bell
1198 }
1199}
1200
1201proc markmatches {canv l str tag matches font} {
1202 set bbox [$canv bbox $tag]
1203 set x0 [lindex $bbox 0]
1204 set y0 [lindex $bbox 1]
1205 set y1 [lindex $bbox 3]
1206 foreach match $matches {
1207 set start [lindex $match 0]
1208 set end [lindex $match 1]
1209 if {$start > $end} continue
1210 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1211 set xlen [font measure $font [string range $str 0 [expr $end]]]
1212 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1213 -outline {} -tags matches -fill yellow]
1214 $canv lower $t
1215 }
1216}
1217
1218proc unmarkmatches {} {
1219 global matchinglines
1220 allcanvs delete matches
1221 catch {unset matchinglines}
1222}
1223
1224proc selcanvline {w x y} {
1225 global canv canvy0 ctext linespc selectedline
1226 global lineid linehtag linentag linedtag rowtextx
1227 set ymax [lindex [$canv cget -scrollregion] 3]
1228 if {$ymax == {}} return
1229 set yfrac [lindex [$canv yview] 0]
1230 set y [expr {$y + $yfrac * $ymax}]
1231 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1232 if {$l < 0} {
1233 set l 0
1234 }
1235 if {$w eq $canv} {
1236 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1237 }
1238 unmarkmatches
1239 selectline $l
1240}
1241
1242proc selectline {l} {
1243 global canv canv2 canv3 ctext commitinfo selectedline
1244 global lineid linehtag linentag linedtag
1245 global canvy0 linespc parents nparents
1246 global cflist currentid sha1entry diffids
1247 global commentend seenfile idtags
1248 $canv delete hover
1249 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1250 $canv delete secsel
1251 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1252 -tags secsel -fill [$canv cget -selectbackground]]
1253 $canv lower $t
1254 $canv2 delete secsel
1255 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1256 -tags secsel -fill [$canv2 cget -selectbackground]]
1257 $canv2 lower $t
1258 $canv3 delete secsel
1259 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1260 -tags secsel -fill [$canv3 cget -selectbackground]]
1261 $canv3 lower $t
1262 set y [expr {$canvy0 + $l * $linespc}]
1263 set ymax [lindex [$canv cget -scrollregion] 3]
1264 set ytop [expr {$y - $linespc - 1}]
1265 set ybot [expr {$y + $linespc + 1}]
1266 set wnow [$canv yview]
1267 set wtop [expr [lindex $wnow 0] * $ymax]
1268 set wbot [expr [lindex $wnow 1] * $ymax]
1269 set wh [expr {$wbot - $wtop}]
1270 set newtop $wtop
1271 if {$ytop < $wtop} {
1272 if {$ybot < $wtop} {
1273 set newtop [expr {$y - $wh / 2.0}]
1274 } else {
1275 set newtop $ytop
1276 if {$newtop > $wtop - $linespc} {
1277 set newtop [expr {$wtop - $linespc}]
1278 }
1279 }
1280 } elseif {$ybot > $wbot} {
1281 if {$ytop > $wbot} {
1282 set newtop [expr {$y - $wh / 2.0}]
1283 } else {
1284 set newtop [expr {$ybot - $wh}]
1285 if {$newtop < $wtop + $linespc} {
1286 set newtop [expr {$wtop + $linespc}]
1287 }
1288 }
1289 }
1290 if {$newtop != $wtop} {
1291 if {$newtop < 0} {
1292 set newtop 0
1293 }
1294 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1295 }
1296 set selectedline $l
1297
1298 set id $lineid($l)
1299 set currentid $id
1300 set diffids [concat $id $parents($id)]
1301 $sha1entry delete 0 end
1302 $sha1entry insert 0 $id
1303 $sha1entry selection from 0
1304 $sha1entry selection to end
1305
1306 $ctext conf -state normal
1307 $ctext delete 0.0 end
1308 $ctext mark set fmark.0 0.0
1309 $ctext mark gravity fmark.0 left
1310 set info $commitinfo($id)
1311 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1312 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1313 if {[info exists idtags($id)]} {
1314 $ctext insert end "Tags:"
1315 foreach tag $idtags($id) {
1316 $ctext insert end " $tag"
1317 }
1318 $ctext insert end "\n"
1319 }
1320 $ctext insert end "\n"
1321 $ctext insert end [lindex $info 5]
1322 $ctext insert end "\n"
1323 $ctext tag delete Comments
1324 $ctext tag remove found 1.0 end
1325 $ctext conf -state disabled
1326 set commentend [$ctext index "end - 1c"]
1327
1328 $cflist delete 0 end
1329 $cflist insert end "Comments"
1330 if {$nparents($id) == 1} {
1331 startdiff
1332 }
1333 catch {unset seenfile}
1334}
1335
1336proc startdiff {} {
1337 global treediffs diffids treepending
1338
1339 if {![info exists treediffs($diffids)]} {
1340 if {![info exists treepending]} {
1341 gettreediffs $diffids
1342 }
1343 } else {
1344 addtocflist $diffids
1345 }
1346}
1347
1348proc selnextline {dir} {
1349 global selectedline
1350 if {![info exists selectedline]} return
1351 set l [expr $selectedline + $dir]
1352 unmarkmatches
1353 selectline $l
1354}
1355
1356proc addtocflist {ids} {
1357 global diffids treediffs cflist
1358 if {$ids != $diffids} {
1359 gettreediffs $diffids
1360 return
1361 }
1362 foreach f $treediffs($ids) {
1363 $cflist insert end $f
1364 }
1365 getblobdiffs $ids
1366}
1367
1368proc gettreediffs {ids} {
1369 global treediffs parents treepending
1370 set treepending $ids
1371 set treediffs($ids) {}
1372 set id [lindex $ids 0]
1373 set p [lindex $ids 1]
1374 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1375 fconfigure $gdtf -blocking 0
1376 fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
1377}
1378
1379proc gettreediffline {gdtf ids} {
1380 global treediffs treepending
1381 set n [gets $gdtf line]
1382 if {$n < 0} {
1383 if {![eof $gdtf]} return
1384 close $gdtf
1385 unset treepending
1386 addtocflist $ids
1387 return
1388 }
1389 set file [lindex $line 5]
1390 lappend treediffs($ids) $file
1391}
1392
1393proc getblobdiffs {ids} {
1394 global diffopts blobdifffd env curdifftag curtagstart
1395 global diffindex difffilestart nextupdate
1396
1397 set id [lindex $ids 0]
1398 set p [lindex $ids 1]
1399 set env(GIT_DIFF_OPTS) $diffopts
1400 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1401 puts "error getting diffs: $err"
1402 return
1403 }
1404 fconfigure $bdf -blocking 0
1405 set blobdifffd($ids) $bdf
1406 set curdifftag Comments
1407 set curtagstart 0.0
1408 set diffindex 0
1409 catch {unset difffilestart}
1410 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1411 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1412}
1413
1414proc getblobdiffline {bdf ids} {
1415 global diffids blobdifffd ctext curdifftag curtagstart seenfile
1416 global diffnexthead diffnextnote diffindex difffilestart
1417 global nextupdate
1418
1419 set n [gets $bdf line]
1420 if {$n < 0} {
1421 if {[eof $bdf]} {
1422 close $bdf
1423 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1424 $ctext tag add $curdifftag $curtagstart end
1425 set seenfile($curdifftag) 1
1426 }
1427 }
1428 return
1429 }
1430 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1431 return
1432 }
1433 $ctext conf -state normal
1434 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1435 # start of a new file
1436 $ctext insert end "\n"
1437 $ctext tag add $curdifftag $curtagstart end
1438 set seenfile($curdifftag) 1
1439 set curtagstart [$ctext index "end - 1c"]
1440 set header $fname
1441 if {[info exists diffnexthead]} {
1442 set fname $diffnexthead
1443 set header "$diffnexthead ($diffnextnote)"
1444 unset diffnexthead
1445 }
1446 set here [$ctext index "end - 1c"]
1447 set difffilestart($diffindex) $here
1448 incr diffindex
1449 # start mark names at fmark.1 for first file
1450 $ctext mark set fmark.$diffindex $here
1451 $ctext mark gravity fmark.$diffindex left
1452 set curdifftag "f:$fname"
1453 $ctext tag delete $curdifftag
1454 set l [expr {(78 - [string length $header]) / 2}]
1455 set pad [string range "----------------------------------------" 1 $l]
1456 $ctext insert end "$pad $header $pad\n" filesep
1457 } elseif {[string range $line 0 2] == "+++"} {
1458 # no need to do anything with this
1459 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1460 set diffnexthead $fn
1461 set diffnextnote "created, mode $m"
1462 } elseif {[string range $line 0 8] == "Deleted: "} {
1463 set diffnexthead [string range $line 9 end]
1464 set diffnextnote "deleted"
1465 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1466 # save the filename in case the next thing is "new file mode ..."
1467 set diffnexthead $fn
1468 set diffnextnote "modified"
1469 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1470 set diffnextnote "new file, mode $m"
1471 } elseif {[string range $line 0 11] == "deleted file"} {
1472 set diffnextnote "deleted"
1473 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1474 $line match f1l f1c f2l f2c rest]} {
1475 $ctext insert end "\t" hunksep
1476 $ctext insert end " $f1l " d0 " $f2l " d1
1477 $ctext insert end " $rest \n" hunksep
1478 } else {
1479 set x [string range $line 0 0]
1480 if {$x == "-" || $x == "+"} {
1481 set tag [expr {$x == "+"}]
1482 set line [string range $line 1 end]
1483 $ctext insert end "$line\n" d$tag
1484 } elseif {$x == " "} {
1485 set line [string range $line 1 end]
1486 $ctext insert end "$line\n"
1487 } elseif {$x == "\\"} {
1488 # e.g. "\ No newline at end of file"
1489 $ctext insert end "$line\n" filesep
1490 } else {
1491 # Something else we don't recognize
1492 if {$curdifftag != "Comments"} {
1493 $ctext insert end "\n"
1494 $ctext tag add $curdifftag $curtagstart end
1495 set seenfile($curdifftag) 1
1496 set curtagstart [$ctext index "end - 1c"]
1497 set curdifftag Comments
1498 }
1499 $ctext insert end "$line\n" filesep
1500 }
1501 }
1502 $ctext conf -state disabled
1503 if {[clock clicks -milliseconds] >= $nextupdate} {
1504 incr nextupdate 100
1505 fileevent $bdf readable {}
1506 update
1507 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1508 }
1509}
1510
1511proc nextfile {} {
1512 global difffilestart ctext
1513 set here [$ctext index @0,0]
1514 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1515 if {[$ctext compare $difffilestart($i) > $here]} {
1516 $ctext yview $difffilestart($i)
1517 break
1518 }
1519 }
1520}
1521
1522proc listboxsel {} {
1523 global ctext cflist currentid treediffs seenfile
1524 if {![info exists currentid]} return
1525 set sel [lsort [$cflist curselection]]
1526 if {$sel eq {}} return
1527 set first [lindex $sel 0]
1528 catch {$ctext yview fmark.$first}
1529}
1530
1531proc setcoords {} {
1532 global linespc charspc canvx0 canvy0 mainfont
1533 set linespc [font metrics $mainfont -linespace]
1534 set charspc [font measure $mainfont "m"]
1535 set canvy0 [expr 3 + 0.5 * $linespc]
1536 set canvx0 [expr 3 + 0.5 * $linespc]
1537}
1538
1539proc redisplay {} {
1540 global selectedline stopped redisplaying phase
1541 if {$stopped > 1} return
1542 if {$phase == "getcommits"} return
1543 set redisplaying 1
1544 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1545 set stopped 1
1546 } else {
1547 drawgraph
1548 }
1549}
1550
1551proc incrfont {inc} {
1552 global mainfont namefont textfont selectedline ctext canv phase
1553 global stopped entries
1554 unmarkmatches
1555 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1556 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1557 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1558 setcoords
1559 $ctext conf -font $textfont
1560 $ctext tag conf filesep -font [concat $textfont bold]
1561 foreach e $entries {
1562 $e conf -font $mainfont
1563 }
1564 if {$phase == "getcommits"} {
1565 $canv itemconf textitems -font $mainfont
1566 }
1567 redisplay
1568}
1569
1570proc clearsha1 {} {
1571 global sha1entry sha1string
1572 if {[string length $sha1string] == 40} {
1573 $sha1entry delete 0 end
1574 }
1575}
1576
1577proc sha1change {n1 n2 op} {
1578 global sha1string currentid sha1but
1579 if {$sha1string == {}
1580 || ([info exists currentid] && $sha1string == $currentid)} {
1581 set state disabled
1582 } else {
1583 set state normal
1584 }
1585 if {[$sha1but cget -state] == $state} return
1586 if {$state == "normal"} {
1587 $sha1but conf -state normal -relief raised -text "Goto: "
1588 } else {
1589 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1590 }
1591}
1592
1593proc gotocommit {} {
1594 global sha1string currentid idline tagids
1595 if {$sha1string == {}
1596 || ([info exists currentid] && $sha1string == $currentid)} return
1597 if {[info exists tagids($sha1string)]} {
1598 set id $tagids($sha1string)
1599 } else {
1600 set id [string tolower $sha1string]
1601 }
1602 if {[info exists idline($id)]} {
1603 selectline $idline($id)
1604 return
1605 }
1606 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1607 set type "SHA1 id"
1608 } else {
1609 set type "Tag"
1610 }
1611 error_popup "$type $sha1string is not known"
1612}
1613
1614proc lineenter {x y id} {
1615 global hoverx hovery hoverid hovertimer
1616 global commitinfo canv
1617
1618 if {![info exists commitinfo($id)]} return
1619 set hoverx $x
1620 set hovery $y
1621 set hoverid $id
1622 if {[info exists hovertimer]} {
1623 after cancel $hovertimer
1624 }
1625 set hovertimer [after 500 linehover]
1626 $canv delete hover
1627}
1628
1629proc linemotion {x y id} {
1630 global hoverx hovery hoverid hovertimer
1631
1632 if {[info exists hoverid] && $id == $hoverid} {
1633 set hoverx $x
1634 set hovery $y
1635 if {[info exists hovertimer]} {
1636 after cancel $hovertimer
1637 }
1638 set hovertimer [after 500 linehover]
1639 }
1640}
1641
1642proc lineleave {id} {
1643 global hoverid hovertimer canv
1644
1645 if {[info exists hoverid] && $id == $hoverid} {
1646 $canv delete hover
1647 if {[info exists hovertimer]} {
1648 after cancel $hovertimer
1649 unset hovertimer
1650 }
1651 unset hoverid
1652 }
1653}
1654
1655proc linehover {} {
1656 global hoverx hovery hoverid hovertimer
1657 global canv linespc lthickness
1658 global commitinfo mainfont
1659
1660 set text [lindex $commitinfo($hoverid) 0]
1661 set ymax [lindex [$canv cget -scrollregion] 3]
1662 if {$ymax == {}} return
1663 set yfrac [lindex [$canv yview] 0]
1664 set x [expr {$hoverx + 2 * $linespc}]
1665 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1666 set x0 [expr {$x - 2 * $lthickness}]
1667 set y0 [expr {$y - 2 * $lthickness}]
1668 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1669 set y1 [expr {$y + $linespc + 2 * $lthickness}]
1670 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1671 -fill \#ffff80 -outline black -width 1 -tags hover]
1672 $canv raise $t
1673 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1674 $canv raise $t
1675}
1676
1677proc lineclick {x y id} {
1678 global ctext commitinfo children cflist canv
1679
1680 unmarkmatches
1681 $canv delete hover
1682 # fill the details pane with info about this line
1683 $ctext conf -state normal
1684 $ctext delete 0.0 end
1685 $ctext insert end "Parent:\n "
1686 catch {destroy $ctext.$id}
1687 button $ctext.$id -text "Go:" -command "selbyid $id" \
1688 -padx 4 -pady 0
1689 $ctext window create end -window $ctext.$id -align center
1690 set info $commitinfo($id)
1691 $ctext insert end "\t[lindex $info 0]\n"
1692 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
1693 $ctext insert end "\tDate:\t[lindex $info 2]\n"
1694 $ctext insert end "\tID:\t$id\n"
1695 if {[info exists children($id)]} {
1696 $ctext insert end "\nChildren:"
1697 foreach child $children($id) {
1698 $ctext insert end "\n "
1699 catch {destroy $ctext.$child}
1700 button $ctext.$child -text "Go:" -command "selbyid $child" \
1701 -padx 4 -pady 0
1702 $ctext window create end -window $ctext.$child -align center
1703 set info $commitinfo($child)
1704 $ctext insert end "\t[lindex $info 0]"
1705 }
1706 }
1707 $ctext conf -state disabled
1708
1709 $cflist delete 0 end
1710}
1711
1712proc selbyid {id} {
1713 global idline
1714 if {[info exists idline($id)]} {
1715 selectline $idline($id)
1716 }
1717}
1718
1719proc mstime {} {
1720 global startmstime
1721 if {![info exists startmstime]} {
1722 set startmstime [clock clicks -milliseconds]
1723 }
1724 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
1725}
1726
1727proc rowmenu {x y id} {
1728 global rowctxmenu idline selectedline rowmenuid
1729
1730 if {![info exists selectedline] || $idline($id) eq $selectedline} {
1731 set state disabled
1732 } else {
1733 set state normal
1734 }
1735 $rowctxmenu entryconfigure 0 -state $state
1736 $rowctxmenu entryconfigure 1 -state $state
1737 set rowmenuid $id
1738 tk_popup $rowctxmenu $x $y
1739}
1740
1741proc diffvssel {dirn} {
1742 global rowmenuid selectedline lineid
1743 global ctext cflist
1744 global diffids commitinfo
1745
1746 if {![info exists selectedline]} return
1747 if {$dirn} {
1748 set oldid $lineid($selectedline)
1749 set newid $rowmenuid
1750 } else {
1751 set oldid $rowmenuid
1752 set newid $lineid($selectedline)
1753 }
1754 $ctext conf -state normal
1755 $ctext delete 0.0 end
1756 $ctext mark set fmark.0 0.0
1757 $ctext mark gravity fmark.0 left
1758 $cflist delete 0 end
1759 $cflist insert end "Top"
1760 $ctext insert end "From $oldid\n "
1761 $ctext insert end [lindex $commitinfo($oldid) 0]
1762 $ctext insert end "\n\nTo $newid\n "
1763 $ctext insert end [lindex $commitinfo($newid) 0]
1764 $ctext insert end "\n"
1765 $ctext conf -state disabled
1766 $ctext tag delete Comments
1767 $ctext tag remove found 1.0 end
1768 set diffids [list $newid $oldid]
1769 startdiff
1770}
1771
1772proc doquit {} {
1773 global stopped
1774 set stopped 100
1775 destroy .
1776}
1777
1778# defaults...
1779set datemode 0
1780set boldnames 0
1781set diffopts "-U 5 -p"
1782
1783set mainfont {Helvetica 9}
1784set textfont {Courier 9}
1785
1786set colors {green red blue magenta darkgrey brown orange}
1787
1788catch {source ~/.gitk}
1789
1790set namefont $mainfont
1791if {$boldnames} {
1792 lappend namefont bold
1793}
1794
1795set revtreeargs {}
1796foreach arg $argv {
1797 switch -regexp -- $arg {
1798 "^$" { }
1799 "^-b" { set boldnames 1 }
1800 "^-d" { set datemode 1 }
1801 default {
1802 lappend revtreeargs $arg
1803 }
1804 }
1805}
1806
1807set stopped 0
1808set redisplaying 0
1809set stuffsaved 0
1810setcoords
1811makewindow
1812readrefs
1813getcommits $revtreeargs