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