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