4bc7946aeef65f919f638cedcd0263874d8c11bd
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
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 gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17}
18
19proc parse_args {rargs} {
20 global parsed_args
21
22 if {[catch {
23 set parse_args [concat --default HEAD $rargs]
24 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
25 }]} {
26 # if git-rev-parse failed for some reason...
27 if {$rargs == {}} {
28 set rargs HEAD
29 }
30 set parsed_args $rargs
31 }
32 return $parsed_args
33}
34
35proc start_rev_list {rlargs} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
38
39 set startmsecs [clock clicks -milliseconds]
40 set nextupdate [expr {$startmsecs + 100}]
41 set ncmupdate 1
42 initlayout
43 set order "--topo-order"
44 if {$datemode} {
45 set order "--date-order"
46 }
47 if {[catch {
48 set commfd [open [concat | git-rev-list --header $order \
49 --parents --boundary $rlargs] r]
50 } err]} {
51 puts stderr "Error executing git-rev-list: $err"
52 exit 1
53 }
54 set leftover {}
55 fconfigure $commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure $commfd -encoding $tclencoding
58 }
59 fileevent $commfd readable [list getcommitlines $commfd]
60 . config -cursor watch
61 settextcursor watch
62}
63
64proc getcommits {rargs} {
65 global phase canv mainfont
66
67 set phase getcommits
68 start_rev_list [parse_args $rargs]
69 $canv delete all
70 $canv create text 3 3 -anchor nw -text "Reading commits..." \
71 -font $mainfont -tags textitems
72}
73
74proc getcommitlines {commfd} {
75 global commitlisted nextupdate
76 global leftover
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
79
80 set stuff [read $commfd]
81 if {$stuff == {}} {
82 if {![eof $commfd]} return
83 # set it blocking so we wait for the process to terminate
84 fconfigure $commfd -blocking 1
85 if {![catch {close $commfd} err]} {
86 after idle finishcommits
87 return
88 }
89 if {[string range $err 0 4] == "usage"} {
90 set err \
91 "Gitk: error reading commits: bad arguments to git-rev-list.\
92 (Note: arguments to gitk are passed to git-rev-list\
93 to allow selection of commits to be displayed.)"
94 } else {
95 set err "Error reading commits: $err"
96 }
97 error_popup $err
98 exit 1
99 }
100 set start 0
101 set gotsome 0
102 while 1 {
103 set i [string first "\0" $stuff $start]
104 if {$i < 0} {
105 append leftover [string range $stuff $start end]
106 break
107 }
108 if {$start == 0} {
109 set cmit $leftover
110 append cmit [string range $stuff 0 [expr {$i - 1}]]
111 set leftover {}
112 } else {
113 set cmit [string range $stuff $start [expr {$i - 1}]]
114 }
115 set start [expr {$i + 1}]
116 set j [string first "\n" $cmit]
117 set ok 0
118 set listed 1
119 if {$j >= 0} {
120 set ids [string range $cmit 0 [expr {$j - 1}]]
121 if {[string range $ids 0 0] == "-"} {
122 set listed 0
123 set ids [string range $ids 1 end]
124 }
125 set ok 1
126 foreach id $ids {
127 if {[string length $id] != 40} {
128 set ok 0
129 break
130 }
131 }
132 }
133 if {!$ok} {
134 set shortcmit $cmit
135 if {[string length $shortcmit] > 80} {
136 set shortcmit "[string range $shortcmit 0 80]..."
137 }
138 error_popup "Can't parse git-rev-list output: {$shortcmit}"
139 exit 1
140 }
141 set id [lindex $ids 0]
142 if {$listed} {
143 set olds [lrange $ids 1 end]
144 if {[llength $olds] > 1} {
145 set olds [lsort -unique $olds]
146 }
147 foreach p $olds {
148 lappend children($p) $id
149 }
150 } else {
151 set olds {}
152 }
153 lappend parentlist $olds
154 if {[info exists children($id)]} {
155 lappend childlist $children($id)
156 } else {
157 lappend childlist {}
158 }
159 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
160 set commitrow($id) $commitidx
161 incr commitidx
162 lappend displayorder $id
163 lappend commitlisted $listed
164 set gotsome 1
165 }
166 if {$gotsome} {
167 layoutmore
168 }
169 if {[clock clicks -milliseconds] >= $nextupdate} {
170 doupdate 1
171 }
172}
173
174proc doupdate {reading} {
175 global commfd nextupdate numcommits ncmupdate
176
177 if {$reading} {
178 fileevent $commfd readable {}
179 }
180 update
181 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
182 if {$numcommits < 100} {
183 set ncmupdate [expr {$numcommits + 1}]
184 } elseif {$numcommits < 10000} {
185 set ncmupdate [expr {$numcommits + 10}]
186 } else {
187 set ncmupdate [expr {$numcommits + 100}]
188 }
189 if {$reading} {
190 fileevent $commfd readable [list getcommitlines $commfd]
191 }
192}
193
194proc readcommit {id} {
195 if {[catch {set contents [exec git-cat-file commit $id]}]} return
196 parsecommit $id $contents 0
197}
198
199proc updatecommits {rargs} {
200 stopfindproc
201 foreach v {colormap selectedline matchinglines treediffs
202 mergefilelist currentid rowtextx commitrow
203 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
204 linesegends crossings cornercrossings} {
205 global $v
206 catch {unset $v}
207 }
208 allcanvs delete all
209 readrefs
210 getcommits $rargs
211}
212
213proc parsecommit {id contents listed} {
214 global commitinfo cdate
215
216 set inhdr 1
217 set comment {}
218 set headline {}
219 set auname {}
220 set audate {}
221 set comname {}
222 set comdate {}
223 set hdrend [string first "\n\n" $contents]
224 if {$hdrend < 0} {
225 # should never happen...
226 set hdrend [string length $contents]
227 }
228 set header [string range $contents 0 [expr {$hdrend - 1}]]
229 set comment [string range $contents [expr {$hdrend + 2}] end]
230 foreach line [split $header "\n"] {
231 set tag [lindex $line 0]
232 if {$tag == "author"} {
233 set audate [lindex $line end-1]
234 set auname [lrange $line 1 end-2]
235 } elseif {$tag == "committer"} {
236 set comdate [lindex $line end-1]
237 set comname [lrange $line 1 end-2]
238 }
239 }
240 set headline {}
241 # take the first line of the comment as the headline
242 set i [string first "\n" $comment]
243 if {$i >= 0} {
244 set headline [string trim [string range $comment 0 $i]]
245 } else {
246 set headline $comment
247 }
248 if {!$listed} {
249 # git-rev-list indents the comment by 4 spaces;
250 # if we got this via git-cat-file, add the indentation
251 set newcomment {}
252 foreach line [split $comment "\n"] {
253 append newcomment " "
254 append newcomment $line
255 append newcomment "\n"
256 }
257 set comment $newcomment
258 }
259 if {$comdate != {}} {
260 set cdate($id) $comdate
261 }
262 set commitinfo($id) [list $headline $auname $audate \
263 $comname $comdate $comment]
264}
265
266proc getcommit {id} {
267 global commitdata commitinfo
268
269 if {[info exists commitdata($id)]} {
270 parsecommit $id $commitdata($id) 1
271 } else {
272 readcommit $id
273 if {![info exists commitinfo($id)]} {
274 set commitinfo($id) {"No commit information available"}
275 }
276 }
277 return 1
278}
279
280proc readrefs {} {
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
283
284 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
285 catch {unset $v}
286 }
287 set refd [open [list | git-ls-remote [gitdir]] r]
288 while {0 <= [set n [gets $refd line]]} {
289 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
290 match id path]} {
291 continue
292 }
293 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
294 set type others
295 set name $path
296 }
297 if {$type == "tags"} {
298 set tagids($name) $id
299 lappend idtags($id) $name
300 set obj {}
301 set type {}
302 set tag {}
303 catch {
304 set commit [exec git-rev-parse "$id^0"]
305 if {"$commit" != "$id"} {
306 set tagids($name) $commit
307 lappend idtags($commit) $name
308 }
309 }
310 catch {
311 set tagcontents($name) [exec git-cat-file tag "$id"]
312 }
313 } elseif { $type == "heads" } {
314 set headids($name) $id
315 lappend idheads($id) $name
316 } else {
317 set otherrefids($name) $id
318 lappend idotherrefs($id) $name
319 }
320 }
321 close $refd
322}
323
324proc error_popup msg {
325 set w .error
326 toplevel $w
327 wm transient $w .
328 message $w.m -text $msg -justify center -aspect 400
329 pack $w.m -side top -fill x -padx 20 -pady 20
330 button $w.ok -text OK -command "destroy $w"
331 pack $w.ok -side bottom -fill x
332 bind $w <Visibility> "grab $w; focus $w"
333 bind $w <Key-Return> "destroy $w"
334 tkwait window $w
335}
336
337proc makewindow {rargs} {
338 global canv canv2 canv3 linespc charspc ctext cflist textfont
339 global findtype findtypemenu findloc findstring fstring geometry
340 global entries sha1entry sha1string sha1but
341 global maincursor textcursor curtextcursor
342 global rowctxmenu mergemax
343
344 menu .bar
345 .bar add cascade -label "File" -menu .bar.file
346 menu .bar.file
347 .bar.file add command -label "Update" -command [list updatecommits $rargs]
348 .bar.file add command -label "Reread references" -command rereadrefs
349 .bar.file add command -label "Quit" -command doquit
350 menu .bar.edit
351 .bar add cascade -label "Edit" -menu .bar.edit
352 .bar.edit add command -label "Preferences" -command doprefs
353 menu .bar.help
354 .bar add cascade -label "Help" -menu .bar.help
355 .bar.help add command -label "About gitk" -command about
356 . configure -menu .bar
357
358 if {![info exists geometry(canv1)]} {
359 set geometry(canv1) [expr {45 * $charspc}]
360 set geometry(canv2) [expr {30 * $charspc}]
361 set geometry(canv3) [expr {15 * $charspc}]
362 set geometry(canvh) [expr {25 * $linespc + 4}]
363 set geometry(ctextw) 80
364 set geometry(ctexth) 30
365 set geometry(cflistw) 30
366 }
367 panedwindow .ctop -orient vertical
368 if {[info exists geometry(width)]} {
369 .ctop conf -width $geometry(width) -height $geometry(height)
370 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
371 set geometry(ctexth) [expr {($texth - 8) /
372 [font metrics $textfont -linespace]}]
373 }
374 frame .ctop.top
375 frame .ctop.top.bar
376 pack .ctop.top.bar -side bottom -fill x
377 set cscroll .ctop.top.csb
378 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
379 pack $cscroll -side right -fill y
380 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
381 pack .ctop.top.clist -side top -fill both -expand 1
382 .ctop add .ctop.top
383 set canv .ctop.top.clist.canv
384 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
385 -bg white -bd 0 \
386 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
387 .ctop.top.clist add $canv
388 set canv2 .ctop.top.clist.canv2
389 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
390 -bg white -bd 0 -yscrollincr $linespc
391 .ctop.top.clist add $canv2
392 set canv3 .ctop.top.clist.canv3
393 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
394 -bg white -bd 0 -yscrollincr $linespc
395 .ctop.top.clist add $canv3
396 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
397
398 set sha1entry .ctop.top.bar.sha1
399 set entries $sha1entry
400 set sha1but .ctop.top.bar.sha1label
401 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
402 -command gotocommit -width 8
403 $sha1but conf -disabledforeground [$sha1but cget -foreground]
404 pack .ctop.top.bar.sha1label -side left
405 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
406 trace add variable sha1string write sha1change
407 pack $sha1entry -side left -pady 2
408
409 image create bitmap bm-left -data {
410 #define left_width 16
411 #define left_height 16
412 static unsigned char left_bits[] = {
413 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
414 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
415 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
416 }
417 image create bitmap bm-right -data {
418 #define right_width 16
419 #define right_height 16
420 static unsigned char right_bits[] = {
421 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
422 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
423 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
424 }
425 button .ctop.top.bar.leftbut -image bm-left -command goback \
426 -state disabled -width 26
427 pack .ctop.top.bar.leftbut -side left -fill y
428 button .ctop.top.bar.rightbut -image bm-right -command goforw \
429 -state disabled -width 26
430 pack .ctop.top.bar.rightbut -side left -fill y
431
432 button .ctop.top.bar.findbut -text "Find" -command dofind
433 pack .ctop.top.bar.findbut -side left
434 set findstring {}
435 set fstring .ctop.top.bar.findstring
436 lappend entries $fstring
437 entry $fstring -width 30 -font $textfont -textvariable findstring
438 pack $fstring -side left -expand 1 -fill x
439 set findtype Exact
440 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
441 findtype Exact IgnCase Regexp]
442 set findloc "All fields"
443 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
444 Comments Author Committer Files Pickaxe
445 pack .ctop.top.bar.findloc -side right
446 pack .ctop.top.bar.findtype -side right
447 # for making sure type==Exact whenever loc==Pickaxe
448 trace add variable findloc write findlocchange
449
450 panedwindow .ctop.cdet -orient horizontal
451 .ctop add .ctop.cdet
452 frame .ctop.cdet.left
453 set ctext .ctop.cdet.left.ctext
454 text $ctext -bg white -state disabled -font $textfont \
455 -width $geometry(ctextw) -height $geometry(ctexth) \
456 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
457 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
458 pack .ctop.cdet.left.sb -side right -fill y
459 pack $ctext -side left -fill both -expand 1
460 .ctop.cdet add .ctop.cdet.left
461
462 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
463 $ctext tag conf hunksep -fore blue
464 $ctext tag conf d0 -fore red
465 $ctext tag conf d1 -fore "#00a000"
466 $ctext tag conf m0 -fore red
467 $ctext tag conf m1 -fore blue
468 $ctext tag conf m2 -fore green
469 $ctext tag conf m3 -fore purple
470 $ctext tag conf m4 -fore brown
471 $ctext tag conf m5 -fore "#009090"
472 $ctext tag conf m6 -fore magenta
473 $ctext tag conf m7 -fore "#808000"
474 $ctext tag conf m8 -fore "#009000"
475 $ctext tag conf m9 -fore "#ff0080"
476 $ctext tag conf m10 -fore cyan
477 $ctext tag conf m11 -fore "#b07070"
478 $ctext tag conf m12 -fore "#70b0f0"
479 $ctext tag conf m13 -fore "#70f0b0"
480 $ctext tag conf m14 -fore "#f0b070"
481 $ctext tag conf m15 -fore "#ff70b0"
482 $ctext tag conf mmax -fore darkgrey
483 set mergemax 16
484 $ctext tag conf mresult -font [concat $textfont bold]
485 $ctext tag conf msep -font [concat $textfont bold]
486 $ctext tag conf found -back yellow
487
488 frame .ctop.cdet.right
489 set cflist .ctop.cdet.right.cfiles
490 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
491 -yscrollcommand ".ctop.cdet.right.sb set"
492 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
493 pack .ctop.cdet.right.sb -side right -fill y
494 pack $cflist -side left -fill both -expand 1
495 .ctop.cdet add .ctop.cdet.right
496 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
497
498 pack .ctop -side top -fill both -expand 1
499
500 bindall <1> {selcanvline %W %x %y}
501 #bindall <B1-Motion> {selcanvline %W %x %y}
502 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
503 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
504 bindall <2> "canvscan mark %W %x %y"
505 bindall <B2-Motion> "canvscan dragto %W %x %y"
506 bind . <Key-Up> "selnextline -1"
507 bind . <Key-Down> "selnextline 1"
508 bind . <Key-Right> "goforw"
509 bind . <Key-Left> "goback"
510 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
511 bind . <Key-Next> "allcanvs yview scroll 1 pages"
512 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
513 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
514 bindkey <Key-space> "$ctext yview scroll 1 pages"
515 bindkey p "selnextline -1"
516 bindkey n "selnextline 1"
517 bindkey z "goback"
518 bindkey x "goforw"
519 bindkey i "selnextline -1"
520 bindkey k "selnextline 1"
521 bindkey j "goback"
522 bindkey l "goforw"
523 bindkey b "$ctext yview scroll -1 pages"
524 bindkey d "$ctext yview scroll 18 units"
525 bindkey u "$ctext yview scroll -18 units"
526 bindkey / {findnext 1}
527 bindkey <Key-Return> {findnext 0}
528 bindkey ? findprev
529 bindkey f nextfile
530 bind . <Control-q> doquit
531 bind . <Control-f> dofind
532 bind . <Control-g> {findnext 0}
533 bind . <Control-r> findprev
534 bind . <Control-equal> {incrfont 1}
535 bind . <Control-KP_Add> {incrfont 1}
536 bind . <Control-minus> {incrfont -1}
537 bind . <Control-KP_Subtract> {incrfont -1}
538 bind $cflist <<ListboxSelect>> listboxsel
539 bind . <Destroy> {savestuff %W}
540 bind . <Button-1> "click %W"
541 bind $fstring <Key-Return> dofind
542 bind $sha1entry <Key-Return> gotocommit
543 bind $sha1entry <<PasteSelection>> clearsha1
544
545 set maincursor [. cget -cursor]
546 set textcursor [$ctext cget -cursor]
547 set curtextcursor $textcursor
548
549 set rowctxmenu .rowctxmenu
550 menu $rowctxmenu -tearoff 0
551 $rowctxmenu add command -label "Diff this -> selected" \
552 -command {diffvssel 0}
553 $rowctxmenu add command -label "Diff selected -> this" \
554 -command {diffvssel 1}
555 $rowctxmenu add command -label "Make patch" -command mkpatch
556 $rowctxmenu add command -label "Create tag" -command mktag
557 $rowctxmenu add command -label "Write commit to file" -command writecommit
558}
559
560# mouse-2 makes all windows scan vertically, but only the one
561# the cursor is in scans horizontally
562proc canvscan {op w x y} {
563 global canv canv2 canv3
564 foreach c [list $canv $canv2 $canv3] {
565 if {$c == $w} {
566 $c scan $op $x $y
567 } else {
568 $c scan $op 0 $y
569 }
570 }
571}
572
573proc scrollcanv {cscroll f0 f1} {
574 $cscroll set $f0 $f1
575 drawfrac $f0 $f1
576}
577
578# when we make a key binding for the toplevel, make sure
579# it doesn't get triggered when that key is pressed in the
580# find string entry widget.
581proc bindkey {ev script} {
582 global entries
583 bind . $ev $script
584 set escript [bind Entry $ev]
585 if {$escript == {}} {
586 set escript [bind Entry <Key>]
587 }
588 foreach e $entries {
589 bind $e $ev "$escript; break"
590 }
591}
592
593# set the focus back to the toplevel for any click outside
594# the entry widgets
595proc click {w} {
596 global entries
597 foreach e $entries {
598 if {$w == $e} return
599 }
600 focus .
601}
602
603proc savestuff {w} {
604 global canv canv2 canv3 ctext cflist mainfont textfont
605 global stuffsaved findmergefiles maxgraphpct
606 global maxwidth
607
608 if {$stuffsaved} return
609 if {![winfo viewable .]} return
610 catch {
611 set f [open "~/.gitk-new" w]
612 puts $f [list set mainfont $mainfont]
613 puts $f [list set textfont $textfont]
614 puts $f [list set findmergefiles $findmergefiles]
615 puts $f [list set maxgraphpct $maxgraphpct]
616 puts $f [list set maxwidth $maxwidth]
617 puts $f "set geometry(width) [winfo width .ctop]"
618 puts $f "set geometry(height) [winfo height .ctop]"
619 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
620 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
621 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
622 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
623 set wid [expr {([winfo width $ctext] - 8) \
624 / [font measure $textfont "0"]}]
625 puts $f "set geometry(ctextw) $wid"
626 set wid [expr {([winfo width $cflist] - 11) \
627 / [font measure [$cflist cget -font] "0"]}]
628 puts $f "set geometry(cflistw) $wid"
629 close $f
630 file rename -force "~/.gitk-new" "~/.gitk"
631 }
632 set stuffsaved 1
633}
634
635proc resizeclistpanes {win w} {
636 global oldwidth
637 if {[info exists oldwidth($win)]} {
638 set s0 [$win sash coord 0]
639 set s1 [$win sash coord 1]
640 if {$w < 60} {
641 set sash0 [expr {int($w/2 - 2)}]
642 set sash1 [expr {int($w*5/6 - 2)}]
643 } else {
644 set factor [expr {1.0 * $w / $oldwidth($win)}]
645 set sash0 [expr {int($factor * [lindex $s0 0])}]
646 set sash1 [expr {int($factor * [lindex $s1 0])}]
647 if {$sash0 < 30} {
648 set sash0 30
649 }
650 if {$sash1 < $sash0 + 20} {
651 set sash1 [expr {$sash0 + 20}]
652 }
653 if {$sash1 > $w - 10} {
654 set sash1 [expr {$w - 10}]
655 if {$sash0 > $sash1 - 20} {
656 set sash0 [expr {$sash1 - 20}]
657 }
658 }
659 }
660 $win sash place 0 $sash0 [lindex $s0 1]
661 $win sash place 1 $sash1 [lindex $s1 1]
662 }
663 set oldwidth($win) $w
664}
665
666proc resizecdetpanes {win w} {
667 global oldwidth
668 if {[info exists oldwidth($win)]} {
669 set s0 [$win sash coord 0]
670 if {$w < 60} {
671 set sash0 [expr {int($w*3/4 - 2)}]
672 } else {
673 set factor [expr {1.0 * $w / $oldwidth($win)}]
674 set sash0 [expr {int($factor * [lindex $s0 0])}]
675 if {$sash0 < 45} {
676 set sash0 45
677 }
678 if {$sash0 > $w - 15} {
679 set sash0 [expr {$w - 15}]
680 }
681 }
682 $win sash place 0 $sash0 [lindex $s0 1]
683 }
684 set oldwidth($win) $w
685}
686
687proc allcanvs args {
688 global canv canv2 canv3
689 eval $canv $args
690 eval $canv2 $args
691 eval $canv3 $args
692}
693
694proc bindall {event action} {
695 global canv canv2 canv3
696 bind $canv $event $action
697 bind $canv2 $event $action
698 bind $canv3 $event $action
699}
700
701proc about {} {
702 set w .about
703 if {[winfo exists $w]} {
704 raise $w
705 return
706 }
707 toplevel $w
708 wm title $w "About gitk"
709 message $w.m -text {
710Gitk - a commit viewer for git
711
712Copyright © 2005-2006 Paul Mackerras
713
714Use and redistribute under the terms of the GNU General Public License} \
715 -justify center -aspect 400
716 pack $w.m -side top -fill x -padx 20 -pady 20
717 button $w.ok -text Close -command "destroy $w"
718 pack $w.ok -side bottom
719}
720
721proc shortids {ids} {
722 set res {}
723 foreach id $ids {
724 if {[llength $id] > 1} {
725 lappend res [shortids $id]
726 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
727 lappend res [string range $id 0 7]
728 } else {
729 lappend res $id
730 }
731 }
732 return $res
733}
734
735proc incrange {l x o} {
736 set n [llength $l]
737 while {$x < $n} {
738 set e [lindex $l $x]
739 if {$e ne {}} {
740 lset l $x [expr {$e + $o}]
741 }
742 incr x
743 }
744 return $l
745}
746
747proc ntimes {n o} {
748 set ret {}
749 for {} {$n > 0} {incr n -1} {
750 lappend ret $o
751 }
752 return $ret
753}
754
755proc usedinrange {id l1 l2} {
756 global children commitrow
757
758 if {[info exists commitrow($id)]} {
759 set r $commitrow($id)
760 if {$l1 <= $r && $r <= $l2} {
761 return [expr {$r - $l1 + 1}]
762 }
763 }
764 foreach c $children($id) {
765 if {[info exists commitrow($c)]} {
766 set r $commitrow($c)
767 if {$l1 <= $r && $r <= $l2} {
768 return [expr {$r - $l1 + 1}]
769 }
770 }
771 }
772 return 0
773}
774
775proc sanity {row {full 0}} {
776 global rowidlist rowoffsets
777
778 set col -1
779 set ids [lindex $rowidlist $row]
780 foreach id $ids {
781 incr col
782 if {$id eq {}} continue
783 if {$col < [llength $ids] - 1 &&
784 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
785 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
786 }
787 set o [lindex $rowoffsets $row $col]
788 set y $row
789 set x $col
790 while {$o ne {}} {
791 incr y -1
792 incr x $o
793 if {[lindex $rowidlist $y $x] != $id} {
794 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
795 puts " id=[shortids $id] check started at row $row"
796 for {set i $row} {$i >= $y} {incr i -1} {
797 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
798 }
799 break
800 }
801 if {!$full} break
802 set o [lindex $rowoffsets $y $x]
803 }
804 }
805}
806
807proc makeuparrow {oid x y z} {
808 global rowidlist rowoffsets uparrowlen idrowranges
809
810 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
811 incr y -1
812 incr x $z
813 set off0 [lindex $rowoffsets $y]
814 for {set x0 $x} {1} {incr x0} {
815 if {$x0 >= [llength $off0]} {
816 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
817 break
818 }
819 set z [lindex $off0 $x0]
820 if {$z ne {}} {
821 incr x0 $z
822 break
823 }
824 }
825 set z [expr {$x0 - $x}]
826 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
827 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
828 }
829 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
830 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
831 lappend idrowranges($oid) $y
832}
833
834proc initlayout {} {
835 global rowidlist rowoffsets displayorder commitlisted
836 global rowlaidout rowoptim
837 global idinlist rowchk
838 global commitidx numcommits canvxmax canv
839 global nextcolor
840 global parentlist childlist children
841
842 set commitidx 0
843 set numcommits 0
844 set displayorder {}
845 set commitlisted {}
846 set parentlist {}
847 set childlist {}
848 catch {unset children}
849 set nextcolor 0
850 set rowidlist {{}}
851 set rowoffsets {{}}
852 catch {unset idinlist}
853 catch {unset rowchk}
854 set rowlaidout 0
855 set rowoptim 0
856 set canvxmax [$canv cget -width]
857}
858
859proc setcanvscroll {} {
860 global canv canv2 canv3 numcommits linespc canvxmax canvy0
861
862 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
863 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
864 $canv2 conf -scrollregion [list 0 0 0 $ymax]
865 $canv3 conf -scrollregion [list 0 0 0 $ymax]
866}
867
868proc visiblerows {} {
869 global canv numcommits linespc
870
871 set ymax [lindex [$canv cget -scrollregion] 3]
872 if {$ymax eq {} || $ymax == 0} return
873 set f [$canv yview]
874 set y0 [expr {int([lindex $f 0] * $ymax)}]
875 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
876 if {$r0 < 0} {
877 set r0 0
878 }
879 set y1 [expr {int([lindex $f 1] * $ymax)}]
880 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
881 if {$r1 >= $numcommits} {
882 set r1 [expr {$numcommits - 1}]
883 }
884 return [list $r0 $r1]
885}
886
887proc layoutmore {} {
888 global rowlaidout rowoptim commitidx numcommits optim_delay
889 global uparrowlen
890
891 set row $rowlaidout
892 set rowlaidout [layoutrows $row $commitidx 0]
893 set orow [expr {$rowlaidout - $uparrowlen - 1}]
894 if {$orow > $rowoptim} {
895 checkcrossings $rowoptim $orow
896 optimize_rows $rowoptim 0 $orow
897 set rowoptim $orow
898 }
899 set canshow [expr {$rowoptim - $optim_delay}]
900 if {$canshow > $numcommits} {
901 showstuff $canshow
902 }
903}
904
905proc showstuff {canshow} {
906 global numcommits
907 global linesegends idrowranges idrangedrawn
908
909 if {$numcommits == 0} {
910 global phase
911 set phase "incrdraw"
912 allcanvs delete all
913 }
914 set row $numcommits
915 set numcommits $canshow
916 setcanvscroll
917 set rows [visiblerows]
918 set r0 [lindex $rows 0]
919 set r1 [lindex $rows 1]
920 for {set r $row} {$r < $canshow} {incr r} {
921 if {[info exists linesegends($r)]} {
922 foreach id $linesegends($r) {
923 set i -1
924 foreach {s e} $idrowranges($id) {
925 incr i
926 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
927 && ![info exists idrangedrawn($id,$i)]} {
928 drawlineseg $id $i
929 set idrangedrawn($id,$i) 1
930 }
931 }
932 }
933 }
934 }
935 if {$canshow > $r1} {
936 set canshow $r1
937 }
938 while {$row < $canshow} {
939 drawcmitrow $row
940 incr row
941 }
942}
943
944proc layoutrows {row endrow last} {
945 global rowidlist rowoffsets displayorder
946 global uparrowlen downarrowlen maxwidth mingaplen
947 global childlist parentlist
948 global idrowranges linesegends
949 global commitidx
950 global idinlist rowchk
951
952 set idlist [lindex $rowidlist $row]
953 set offs [lindex $rowoffsets $row]
954 while {$row < $endrow} {
955 set id [lindex $displayorder $row]
956 set oldolds {}
957 set newolds {}
958 foreach p [lindex $parentlist $row] {
959 if {![info exists idinlist($p)]} {
960 lappend newolds $p
961 } elseif {!$idinlist($p)} {
962 lappend oldolds $p
963 }
964 }
965 set nev [expr {[llength $idlist] + [llength $newolds]
966 + [llength $oldolds] - $maxwidth + 1}]
967 if {$nev > 0} {
968 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
969 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
970 set i [lindex $idlist $x]
971 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
972 set r [usedinrange $i [expr {$row - $downarrowlen}] \
973 [expr {$row + $uparrowlen + $mingaplen}]]
974 if {$r == 0} {
975 set idlist [lreplace $idlist $x $x]
976 set offs [lreplace $offs $x $x]
977 set offs [incrange $offs $x 1]
978 set idinlist($i) 0
979 set rm1 [expr {$row - 1}]
980 lappend linesegends($rm1) $i
981 lappend idrowranges($i) $rm1
982 if {[incr nev -1] <= 0} break
983 continue
984 }
985 set rowchk($id) [expr {$row + $r}]
986 }
987 }
988 lset rowidlist $row $idlist
989 lset rowoffsets $row $offs
990 }
991 set col [lsearch -exact $idlist $id]
992 if {$col < 0} {
993 set col [llength $idlist]
994 lappend idlist $id
995 lset rowidlist $row $idlist
996 set z {}
997 if {[lindex $childlist $row] ne {}} {
998 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
999 unset idinlist($id)
1000 }
1001 lappend offs $z
1002 lset rowoffsets $row $offs
1003 if {$z ne {}} {
1004 makeuparrow $id $col $row $z
1005 }
1006 } else {
1007 unset idinlist($id)
1008 }
1009 if {[info exists idrowranges($id)]} {
1010 lappend idrowranges($id) $row
1011 }
1012 incr row
1013 set offs [ntimes [llength $idlist] 0]
1014 set l [llength $newolds]
1015 set idlist [eval lreplace \$idlist $col $col $newolds]
1016 set o 0
1017 if {$l != 1} {
1018 set offs [lrange $offs 0 [expr {$col - 1}]]
1019 foreach x $newolds {
1020 lappend offs {}
1021 incr o -1
1022 }
1023 incr o
1024 set tmp [expr {[llength $idlist] - [llength $offs]}]
1025 if {$tmp > 0} {
1026 set offs [concat $offs [ntimes $tmp $o]]
1027 }
1028 } else {
1029 lset offs $col {}
1030 }
1031 foreach i $newolds {
1032 set idinlist($i) 1
1033 set idrowranges($i) $row
1034 }
1035 incr col $l
1036 foreach oid $oldolds {
1037 set idinlist($oid) 1
1038 set idlist [linsert $idlist $col $oid]
1039 set offs [linsert $offs $col $o]
1040 makeuparrow $oid $col $row $o
1041 incr col
1042 }
1043 lappend rowidlist $idlist
1044 lappend rowoffsets $offs
1045 }
1046 return $row
1047}
1048
1049proc addextraid {id row} {
1050 global displayorder commitrow commitinfo
1051 global commitidx
1052 global parentlist childlist children
1053
1054 incr commitidx
1055 lappend displayorder $id
1056 lappend parentlist {}
1057 set commitrow($id) $row
1058 readcommit $id
1059 if {![info exists commitinfo($id)]} {
1060 set commitinfo($id) {"No commit information available"}
1061 }
1062 if {[info exists children($id)]} {
1063 lappend childlist $children($id)
1064 } else {
1065 lappend childlist {}
1066 }
1067}
1068
1069proc layouttail {} {
1070 global rowidlist rowoffsets idinlist commitidx
1071 global idrowranges
1072
1073 set row $commitidx
1074 set idlist [lindex $rowidlist $row]
1075 while {$idlist ne {}} {
1076 set col [expr {[llength $idlist] - 1}]
1077 set id [lindex $idlist $col]
1078 addextraid $id $row
1079 unset idinlist($id)
1080 lappend idrowranges($id) $row
1081 incr row
1082 set offs [ntimes $col 0]
1083 set idlist [lreplace $idlist $col $col]
1084 lappend rowidlist $idlist
1085 lappend rowoffsets $offs
1086 }
1087
1088 foreach id [array names idinlist] {
1089 addextraid $id $row
1090 lset rowidlist $row [list $id]
1091 lset rowoffsets $row 0
1092 makeuparrow $id 0 $row 0
1093 lappend idrowranges($id) $row
1094 incr row
1095 lappend rowidlist {}
1096 lappend rowoffsets {}
1097 }
1098}
1099
1100proc insert_pad {row col npad} {
1101 global rowidlist rowoffsets
1102
1103 set pad [ntimes $npad {}]
1104 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1105 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1106 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1107}
1108
1109proc optimize_rows {row col endrow} {
1110 global rowidlist rowoffsets idrowranges linesegends displayorder
1111
1112 for {} {$row < $endrow} {incr row} {
1113 set idlist [lindex $rowidlist $row]
1114 set offs [lindex $rowoffsets $row]
1115 set haspad 0
1116 for {} {$col < [llength $offs]} {incr col} {
1117 if {[lindex $idlist $col] eq {}} {
1118 set haspad 1
1119 continue
1120 }
1121 set z [lindex $offs $col]
1122 if {$z eq {}} continue
1123 set isarrow 0
1124 set x0 [expr {$col + $z}]
1125 set y0 [expr {$row - 1}]
1126 set z0 [lindex $rowoffsets $y0 $x0]
1127 if {$z0 eq {}} {
1128 set id [lindex $idlist $col]
1129 if {[info exists idrowranges($id)] &&
1130 $y0 > [lindex $idrowranges($id) 0]} {
1131 set isarrow 1
1132 }
1133 }
1134 if {$z < -1 || ($z < 0 && $isarrow)} {
1135 set npad [expr {-1 - $z + $isarrow}]
1136 set offs [incrange $offs $col $npad]
1137 insert_pad $y0 $x0 $npad
1138 if {$y0 > 0} {
1139 optimize_rows $y0 $x0 $row
1140 }
1141 set z [lindex $offs $col]
1142 set x0 [expr {$col + $z}]
1143 set z0 [lindex $rowoffsets $y0 $x0]
1144 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1145 set npad [expr {$z - 1 + $isarrow}]
1146 set y1 [expr {$row + 1}]
1147 set offs2 [lindex $rowoffsets $y1]
1148 set x1 -1
1149 foreach z $offs2 {
1150 incr x1
1151 if {$z eq {} || $x1 + $z < $col} continue
1152 if {$x1 + $z > $col} {
1153 incr npad
1154 }
1155 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1156 break
1157 }
1158 set pad [ntimes $npad {}]
1159 set idlist [eval linsert \$idlist $col $pad]
1160 set tmp [eval linsert \$offs $col $pad]
1161 incr col $npad
1162 set offs [incrange $tmp $col [expr {-$npad}]]
1163 set z [lindex $offs $col]
1164 set haspad 1
1165 }
1166 if {$z0 eq {} && !$isarrow} {
1167 # this line links to its first child on row $row-2
1168 set rm2 [expr {$row - 2}]
1169 set id [lindex $displayorder $rm2]
1170 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1171 if {$xc >= 0} {
1172 set z0 [expr {$xc - $x0}]
1173 }
1174 }
1175 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1176 insert_pad $y0 $x0 1
1177 set offs [incrange $offs $col 1]
1178 optimize_rows $y0 [expr {$x0 + 1}] $row
1179 }
1180 }
1181 if {!$haspad} {
1182 set o {}
1183 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1184 set o [lindex $offs $col]
1185 if {$o eq {}} {
1186 # check if this is the link to the first child
1187 set id [lindex $idlist $col]
1188 if {[info exists idrowranges($id)] &&
1189 $row == [lindex $idrowranges($id) 0]} {
1190 # it is, work out offset to child
1191 set y0 [expr {$row - 1}]
1192 set id [lindex $displayorder $y0]
1193 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1194 if {$x0 >= 0} {
1195 set o [expr {$x0 - $col}]
1196 }
1197 }
1198 }
1199 if {$o eq {} || $o <= 0} break
1200 }
1201 if {$o ne {} && [incr col] < [llength $idlist]} {
1202 set y1 [expr {$row + 1}]
1203 set offs2 [lindex $rowoffsets $y1]
1204 set x1 -1
1205 foreach z $offs2 {
1206 incr x1
1207 if {$z eq {} || $x1 + $z < $col} continue
1208 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1209 break
1210 }
1211 set idlist [linsert $idlist $col {}]
1212 set tmp [linsert $offs $col {}]
1213 incr col
1214 set offs [incrange $tmp $col -1]
1215 }
1216 }
1217 lset rowidlist $row $idlist
1218 lset rowoffsets $row $offs
1219 set col 0
1220 }
1221}
1222
1223proc xc {row col} {
1224 global canvx0 linespc
1225 return [expr {$canvx0 + $col * $linespc}]
1226}
1227
1228proc yc {row} {
1229 global canvy0 linespc
1230 return [expr {$canvy0 + $row * $linespc}]
1231}
1232
1233proc linewidth {id} {
1234 global thickerline lthickness
1235
1236 set wid $lthickness
1237 if {[info exists thickerline] && $id eq $thickerline} {
1238 set wid [expr {2 * $lthickness}]
1239 }
1240 return $wid
1241}
1242
1243proc drawlineseg {id i} {
1244 global rowoffsets rowidlist idrowranges
1245 global displayorder
1246 global canv colormap linespc
1247
1248 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1249 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1250 if {$startrow == $row} return
1251 assigncolor $id
1252 set coords {}
1253 set col [lsearch -exact [lindex $rowidlist $row] $id]
1254 if {$col < 0} {
1255 puts "oops: drawline: id $id not on row $row"
1256 return
1257 }
1258 set lasto {}
1259 set ns 0
1260 while {1} {
1261 set o [lindex $rowoffsets $row $col]
1262 if {$o eq {}} break
1263 if {$o ne $lasto} {
1264 # changing direction
1265 set x [xc $row $col]
1266 set y [yc $row]
1267 lappend coords $x $y
1268 set lasto $o
1269 }
1270 incr col $o
1271 incr row -1
1272 }
1273 set x [xc $row $col]
1274 set y [yc $row]
1275 lappend coords $x $y
1276 if {$i == 0} {
1277 # draw the link to the first child as part of this line
1278 incr row -1
1279 set child [lindex $displayorder $row]
1280 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1281 if {$ccol >= 0} {
1282 set x [xc $row $ccol]
1283 set y [yc $row]
1284 if {$ccol < $col - 1} {
1285 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1286 } elseif {$ccol > $col + 1} {
1287 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1288 }
1289 lappend coords $x $y
1290 }
1291 }
1292 if {[llength $coords] < 4} return
1293 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1294 if {$i < $last} {
1295 # This line has an arrow at the lower end: check if the arrow is
1296 # on a diagonal segment, and if so, work around the Tk 8.4
1297 # refusal to draw arrows on diagonal lines.
1298 set x0 [lindex $coords 0]
1299 set x1 [lindex $coords 2]
1300 if {$x0 != $x1} {
1301 set y0 [lindex $coords 1]
1302 set y1 [lindex $coords 3]
1303 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1304 # we have a nearby vertical segment, just trim off the diag bit
1305 set coords [lrange $coords 2 end]
1306 } else {
1307 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1308 set xi [expr {$x0 - $slope * $linespc / 2}]
1309 set yi [expr {$y0 - $linespc / 2}]
1310 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1311 }
1312 }
1313 }
1314 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1315 set arrow [lindex {none first last both} $arrow]
1316 set t [$canv create line $coords -width [linewidth $id] \
1317 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1318 $canv lower $t
1319 bindline $t $id
1320}
1321
1322proc drawparentlinks {id row col olds} {
1323 global rowidlist canv colormap idrowranges
1324
1325 set row2 [expr {$row + 1}]
1326 set x [xc $row $col]
1327 set y [yc $row]
1328 set y2 [yc $row2]
1329 set ids [lindex $rowidlist $row2]
1330 # rmx = right-most X coord used
1331 set rmx 0
1332 foreach p $olds {
1333 set i [lsearch -exact $ids $p]
1334 if {$i < 0} {
1335 puts "oops, parent $p of $id not in list"
1336 continue
1337 }
1338 set x2 [xc $row2 $i]
1339 if {$x2 > $rmx} {
1340 set rmx $x2
1341 }
1342 if {[info exists idrowranges($p)] &&
1343 $row2 == [lindex $idrowranges($p) 0] &&
1344 $row2 < [lindex $idrowranges($p) 1]} {
1345 # drawlineseg will do this one for us
1346 continue
1347 }
1348 assigncolor $p
1349 # should handle duplicated parents here...
1350 set coords [list $x $y]
1351 if {$i < $col - 1} {
1352 lappend coords [xc $row [expr {$i + 1}]] $y
1353 } elseif {$i > $col + 1} {
1354 lappend coords [xc $row [expr {$i - 1}]] $y
1355 }
1356 lappend coords $x2 $y2
1357 set t [$canv create line $coords -width [linewidth $p] \
1358 -fill $colormap($p) -tags lines.$p]
1359 $canv lower $t
1360 bindline $t $p
1361 }
1362 return $rmx
1363}
1364
1365proc drawlines {id} {
1366 global colormap canv
1367 global idrowranges idrangedrawn
1368 global childlist iddrawn commitrow rowidlist
1369
1370 $canv delete lines.$id
1371 set nr [expr {[llength $idrowranges($id)] / 2}]
1372 for {set i 0} {$i < $nr} {incr i} {
1373 if {[info exists idrangedrawn($id,$i)]} {
1374 drawlineseg $id $i
1375 }
1376 }
1377 foreach child [lindex $childlist $commitrow($id)] {
1378 if {[info exists iddrawn($child)]} {
1379 set row $commitrow($child)
1380 set col [lsearch -exact [lindex $rowidlist $row] $child]
1381 if {$col >= 0} {
1382 drawparentlinks $child $row $col [list $id]
1383 }
1384 }
1385 }
1386}
1387
1388proc drawcmittext {id row col rmx} {
1389 global linespc canv canv2 canv3 canvy0
1390 global commitlisted commitinfo rowidlist
1391 global rowtextx idpos idtags idheads idotherrefs
1392 global linehtag linentag linedtag
1393 global mainfont namefont canvxmax
1394
1395 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1396 set x [xc $row $col]
1397 set y [yc $row]
1398 set orad [expr {$linespc / 3}]
1399 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1400 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1401 -fill $ofill -outline black -width 1]
1402 $canv raise $t
1403 $canv bind $t <1> {selcanvline {} %x %y}
1404 set xt [xc $row [llength [lindex $rowidlist $row]]]
1405 if {$xt < $rmx} {
1406 set xt $rmx
1407 }
1408 set rowtextx($row) $xt
1409 set idpos($id) [list $x $xt $y]
1410 if {[info exists idtags($id)] || [info exists idheads($id)]
1411 || [info exists idotherrefs($id)]} {
1412 set xt [drawtags $id $x $xt $y]
1413 }
1414 set headline [lindex $commitinfo($id) 0]
1415 set name [lindex $commitinfo($id) 1]
1416 set date [lindex $commitinfo($id) 2]
1417 set date [formatdate $date]
1418 set linehtag($row) [$canv create text $xt $y -anchor w \
1419 -text $headline -font $mainfont ]
1420 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1421 set linentag($row) [$canv2 create text 3 $y -anchor w \
1422 -text $name -font $namefont]
1423 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1424 -text $date -font $mainfont]
1425 set xr [expr {$xt + [font measure $mainfont $headline]}]
1426 if {$xr > $canvxmax} {
1427 set canvxmax $xr
1428 setcanvscroll
1429 }
1430}
1431
1432proc drawcmitrow {row} {
1433 global displayorder rowidlist
1434 global idrowranges idrangedrawn iddrawn
1435 global commitinfo commitlisted parentlist numcommits
1436
1437 if {$row >= $numcommits} return
1438 foreach id [lindex $rowidlist $row] {
1439 if {![info exists idrowranges($id)]} continue
1440 set i -1
1441 foreach {s e} $idrowranges($id) {
1442 incr i
1443 if {$row < $s} continue
1444 if {$e eq {}} break
1445 if {$row <= $e} {
1446 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1447 drawlineseg $id $i
1448 set idrangedrawn($id,$i) 1
1449 }
1450 break
1451 }
1452 }
1453 }
1454
1455 set id [lindex $displayorder $row]
1456 if {[info exists iddrawn($id)]} return
1457 set col [lsearch -exact [lindex $rowidlist $row] $id]
1458 if {$col < 0} {
1459 puts "oops, row $row id $id not in list"
1460 return
1461 }
1462 if {![info exists commitinfo($id)]} {
1463 getcommit $id
1464 }
1465 assigncolor $id
1466 set olds [lindex $parentlist $row]
1467 if {$olds ne {}} {
1468 set rmx [drawparentlinks $id $row $col $olds]
1469 } else {
1470 set rmx 0
1471 }
1472 drawcmittext $id $row $col $rmx
1473 set iddrawn($id) 1
1474}
1475
1476proc drawfrac {f0 f1} {
1477 global numcommits canv
1478 global linespc
1479
1480 set ymax [lindex [$canv cget -scrollregion] 3]
1481 if {$ymax eq {} || $ymax == 0} return
1482 set y0 [expr {int($f0 * $ymax)}]
1483 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1484 if {$row < 0} {
1485 set row 0
1486 }
1487 set y1 [expr {int($f1 * $ymax)}]
1488 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1489 if {$endrow >= $numcommits} {
1490 set endrow [expr {$numcommits - 1}]
1491 }
1492 for {} {$row <= $endrow} {incr row} {
1493 drawcmitrow $row
1494 }
1495}
1496
1497proc drawvisible {} {
1498 global canv
1499 eval drawfrac [$canv yview]
1500}
1501
1502proc clear_display {} {
1503 global iddrawn idrangedrawn
1504
1505 allcanvs delete all
1506 catch {unset iddrawn}
1507 catch {unset idrangedrawn}
1508}
1509
1510proc assigncolor {id} {
1511 global colormap colors nextcolor
1512 global commitrow parentlist children childlist
1513 global cornercrossings crossings
1514
1515 if {[info exists colormap($id)]} return
1516 set ncolors [llength $colors]
1517 if {[info exists commitrow($id)]} {
1518 set kids [lindex $childlist $commitrow($id)]
1519 } elseif {[info exists children($id)]} {
1520 set kids $children($id)
1521 } else {
1522 set kids {}
1523 }
1524 if {[llength $kids] == 1} {
1525 set child [lindex $kids 0]
1526 if {[info exists colormap($child)]
1527 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1528 set colormap($id) $colormap($child)
1529 return
1530 }
1531 }
1532 set badcolors {}
1533 if {[info exists cornercrossings($id)]} {
1534 foreach x $cornercrossings($id) {
1535 if {[info exists colormap($x)]
1536 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1537 lappend badcolors $colormap($x)
1538 }
1539 }
1540 if {[llength $badcolors] >= $ncolors} {
1541 set badcolors {}
1542 }
1543 }
1544 set origbad $badcolors
1545 if {[llength $badcolors] < $ncolors - 1} {
1546 if {[info exists crossings($id)]} {
1547 foreach x $crossings($id) {
1548 if {[info exists colormap($x)]
1549 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1550 lappend badcolors $colormap($x)
1551 }
1552 }
1553 if {[llength $badcolors] >= $ncolors} {
1554 set badcolors $origbad
1555 }
1556 }
1557 set origbad $badcolors
1558 }
1559 if {[llength $badcolors] < $ncolors - 1} {
1560 foreach child $kids {
1561 if {[info exists colormap($child)]
1562 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1563 lappend badcolors $colormap($child)
1564 }
1565 foreach p [lindex $parentlist $commitrow($child)] {
1566 if {[info exists colormap($p)]
1567 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1568 lappend badcolors $colormap($p)
1569 }
1570 }
1571 }
1572 if {[llength $badcolors] >= $ncolors} {
1573 set badcolors $origbad
1574 }
1575 }
1576 for {set i 0} {$i <= $ncolors} {incr i} {
1577 set c [lindex $colors $nextcolor]
1578 if {[incr nextcolor] >= $ncolors} {
1579 set nextcolor 0
1580 }
1581 if {[lsearch -exact $badcolors $c]} break
1582 }
1583 set colormap($id) $c
1584}
1585
1586proc bindline {t id} {
1587 global canv
1588
1589 $canv bind $t <Enter> "lineenter %x %y $id"
1590 $canv bind $t <Motion> "linemotion %x %y $id"
1591 $canv bind $t <Leave> "lineleave $id"
1592 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1593}
1594
1595proc drawtags {id x xt y1} {
1596 global idtags idheads idotherrefs
1597 global linespc lthickness
1598 global canv mainfont commitrow rowtextx
1599
1600 set marks {}
1601 set ntags 0
1602 set nheads 0
1603 if {[info exists idtags($id)]} {
1604 set marks $idtags($id)
1605 set ntags [llength $marks]
1606 }
1607 if {[info exists idheads($id)]} {
1608 set marks [concat $marks $idheads($id)]
1609 set nheads [llength $idheads($id)]
1610 }
1611 if {[info exists idotherrefs($id)]} {
1612 set marks [concat $marks $idotherrefs($id)]
1613 }
1614 if {$marks eq {}} {
1615 return $xt
1616 }
1617
1618 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1619 set yt [expr {$y1 - 0.5 * $linespc}]
1620 set yb [expr {$yt + $linespc - 1}]
1621 set xvals {}
1622 set wvals {}
1623 foreach tag $marks {
1624 set wid [font measure $mainfont $tag]
1625 lappend xvals $xt
1626 lappend wvals $wid
1627 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1628 }
1629 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1630 -width $lthickness -fill black -tags tag.$id]
1631 $canv lower $t
1632 foreach tag $marks x $xvals wid $wvals {
1633 set xl [expr {$x + $delta}]
1634 set xr [expr {$x + $delta + $wid + $lthickness}]
1635 if {[incr ntags -1] >= 0} {
1636 # draw a tag
1637 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1638 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1639 -width 1 -outline black -fill yellow -tags tag.$id]
1640 $canv bind $t <1> [list showtag $tag 1]
1641 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1642 } else {
1643 # draw a head or other ref
1644 if {[incr nheads -1] >= 0} {
1645 set col green
1646 } else {
1647 set col "#ddddff"
1648 }
1649 set xl [expr {$xl - $delta/2}]
1650 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1651 -width 1 -outline black -fill $col -tags tag.$id
1652 }
1653 set t [$canv create text $xl $y1 -anchor w -text $tag \
1654 -font $mainfont -tags tag.$id]
1655 if {$ntags >= 0} {
1656 $canv bind $t <1> [list showtag $tag 1]
1657 }
1658 }
1659 return $xt
1660}
1661
1662proc checkcrossings {row endrow} {
1663 global displayorder parentlist rowidlist
1664
1665 for {} {$row < $endrow} {incr row} {
1666 set id [lindex $displayorder $row]
1667 set i [lsearch -exact [lindex $rowidlist $row] $id]
1668 if {$i < 0} continue
1669 set idlist [lindex $rowidlist [expr {$row+1}]]
1670 foreach p [lindex $parentlist $row] {
1671 set j [lsearch -exact $idlist $p]
1672 if {$j > 0} {
1673 if {$j < $i - 1} {
1674 notecrossings $row $p $j $i [expr {$j+1}]
1675 } elseif {$j > $i + 1} {
1676 notecrossings $row $p $i $j [expr {$j-1}]
1677 }
1678 }
1679 }
1680 }
1681}
1682
1683proc notecrossings {row id lo hi corner} {
1684 global rowidlist crossings cornercrossings
1685
1686 for {set i $lo} {[incr i] < $hi} {} {
1687 set p [lindex [lindex $rowidlist $row] $i]
1688 if {$p == {}} continue
1689 if {$i == $corner} {
1690 if {![info exists cornercrossings($id)]
1691 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1692 lappend cornercrossings($id) $p
1693 }
1694 if {![info exists cornercrossings($p)]
1695 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1696 lappend cornercrossings($p) $id
1697 }
1698 } else {
1699 if {![info exists crossings($id)]
1700 || [lsearch -exact $crossings($id) $p] < 0} {
1701 lappend crossings($id) $p
1702 }
1703 if {![info exists crossings($p)]
1704 || [lsearch -exact $crossings($p) $id] < 0} {
1705 lappend crossings($p) $id
1706 }
1707 }
1708 }
1709}
1710
1711proc xcoord {i level ln} {
1712 global canvx0 xspc1 xspc2
1713
1714 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1715 if {$i > 0 && $i == $level} {
1716 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1717 } elseif {$i > $level} {
1718 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1719 }
1720 return $x
1721}
1722
1723proc finishcommits {} {
1724 global commitidx phase
1725 global canv mainfont ctext maincursor textcursor
1726 global findinprogress
1727
1728 if {$commitidx > 0} {
1729 drawrest
1730 } else {
1731 $canv delete all
1732 $canv create text 3 3 -anchor nw -text "No commits selected" \
1733 -font $mainfont -tags textitems
1734 }
1735 if {![info exists findinprogress]} {
1736 . config -cursor $maincursor
1737 settextcursor $textcursor
1738 }
1739 set phase {}
1740}
1741
1742# Don't change the text pane cursor if it is currently the hand cursor,
1743# showing that we are over a sha1 ID link.
1744proc settextcursor {c} {
1745 global ctext curtextcursor
1746
1747 if {[$ctext cget -cursor] == $curtextcursor} {
1748 $ctext config -cursor $c
1749 }
1750 set curtextcursor $c
1751}
1752
1753proc drawrest {} {
1754 global numcommits
1755 global startmsecs
1756 global canvy0 numcommits linespc
1757 global rowlaidout commitidx
1758
1759 set row $rowlaidout
1760 layoutrows $rowlaidout $commitidx 1
1761 layouttail
1762 optimize_rows $row 0 $commitidx
1763 showstuff $commitidx
1764
1765 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1766 puts "overall $drawmsecs ms for $numcommits commits"
1767}
1768
1769proc findmatches {f} {
1770 global findtype foundstring foundstrlen
1771 if {$findtype == "Regexp"} {
1772 set matches [regexp -indices -all -inline $foundstring $f]
1773 } else {
1774 if {$findtype == "IgnCase"} {
1775 set str [string tolower $f]
1776 } else {
1777 set str $f
1778 }
1779 set matches {}
1780 set i 0
1781 while {[set j [string first $foundstring $str $i]] >= 0} {
1782 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1783 set i [expr {$j + $foundstrlen}]
1784 }
1785 }
1786 return $matches
1787}
1788
1789proc dofind {} {
1790 global findtype findloc findstring markedmatches commitinfo
1791 global numcommits displayorder linehtag linentag linedtag
1792 global mainfont namefont canv canv2 canv3 selectedline
1793 global matchinglines foundstring foundstrlen matchstring
1794 global commitdata
1795
1796 stopfindproc
1797 unmarkmatches
1798 focus .
1799 set matchinglines {}
1800 if {$findloc == "Pickaxe"} {
1801 findpatches
1802 return
1803 }
1804 if {$findtype == "IgnCase"} {
1805 set foundstring [string tolower $findstring]
1806 } else {
1807 set foundstring $findstring
1808 }
1809 set foundstrlen [string length $findstring]
1810 if {$foundstrlen == 0} return
1811 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1812 set matchstring "*$matchstring*"
1813 if {$findloc == "Files"} {
1814 findfiles
1815 return
1816 }
1817 if {![info exists selectedline]} {
1818 set oldsel -1
1819 } else {
1820 set oldsel $selectedline
1821 }
1822 set didsel 0
1823 set fldtypes {Headline Author Date Committer CDate Comment}
1824 set l -1
1825 foreach id $displayorder {
1826 set d $commitdata($id)
1827 incr l
1828 if {$findtype == "Regexp"} {
1829 set doesmatch [regexp $foundstring $d]
1830 } elseif {$findtype == "IgnCase"} {
1831 set doesmatch [string match -nocase $matchstring $d]
1832 } else {
1833 set doesmatch [string match $matchstring $d]
1834 }
1835 if {!$doesmatch} continue
1836 if {![info exists commitinfo($id)]} {
1837 getcommit $id
1838 }
1839 set info $commitinfo($id)
1840 set doesmatch 0
1841 foreach f $info ty $fldtypes {
1842 if {$findloc != "All fields" && $findloc != $ty} {
1843 continue
1844 }
1845 set matches [findmatches $f]
1846 if {$matches == {}} continue
1847 set doesmatch 1
1848 if {$ty == "Headline"} {
1849 drawcmitrow $l
1850 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1851 } elseif {$ty == "Author"} {
1852 drawcmitrow $l
1853 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1854 } elseif {$ty == "Date"} {
1855 drawcmitrow $l
1856 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1857 }
1858 }
1859 if {$doesmatch} {
1860 lappend matchinglines $l
1861 if {!$didsel && $l > $oldsel} {
1862 findselectline $l
1863 set didsel 1
1864 }
1865 }
1866 }
1867 if {$matchinglines == {}} {
1868 bell
1869 } elseif {!$didsel} {
1870 findselectline [lindex $matchinglines 0]
1871 }
1872}
1873
1874proc findselectline {l} {
1875 global findloc commentend ctext
1876 selectline $l 1
1877 if {$findloc == "All fields" || $findloc == "Comments"} {
1878 # highlight the matches in the comments
1879 set f [$ctext get 1.0 $commentend]
1880 set matches [findmatches $f]
1881 foreach match $matches {
1882 set start [lindex $match 0]
1883 set end [expr {[lindex $match 1] + 1}]
1884 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1885 }
1886 }
1887}
1888
1889proc findnext {restart} {
1890 global matchinglines selectedline
1891 if {![info exists matchinglines]} {
1892 if {$restart} {
1893 dofind
1894 }
1895 return
1896 }
1897 if {![info exists selectedline]} return
1898 foreach l $matchinglines {
1899 if {$l > $selectedline} {
1900 findselectline $l
1901 return
1902 }
1903 }
1904 bell
1905}
1906
1907proc findprev {} {
1908 global matchinglines selectedline
1909 if {![info exists matchinglines]} {
1910 dofind
1911 return
1912 }
1913 if {![info exists selectedline]} return
1914 set prev {}
1915 foreach l $matchinglines {
1916 if {$l >= $selectedline} break
1917 set prev $l
1918 }
1919 if {$prev != {}} {
1920 findselectline $prev
1921 } else {
1922 bell
1923 }
1924}
1925
1926proc findlocchange {name ix op} {
1927 global findloc findtype findtypemenu
1928 if {$findloc == "Pickaxe"} {
1929 set findtype Exact
1930 set state disabled
1931 } else {
1932 set state normal
1933 }
1934 $findtypemenu entryconf 1 -state $state
1935 $findtypemenu entryconf 2 -state $state
1936}
1937
1938proc stopfindproc {{done 0}} {
1939 global findprocpid findprocfile findids
1940 global ctext findoldcursor phase maincursor textcursor
1941 global findinprogress
1942
1943 catch {unset findids}
1944 if {[info exists findprocpid]} {
1945 if {!$done} {
1946 catch {exec kill $findprocpid}
1947 }
1948 catch {close $findprocfile}
1949 unset findprocpid
1950 }
1951 if {[info exists findinprogress]} {
1952 unset findinprogress
1953 if {$phase != "incrdraw"} {
1954 . config -cursor $maincursor
1955 settextcursor $textcursor
1956 }
1957 }
1958}
1959
1960proc findpatches {} {
1961 global findstring selectedline numcommits
1962 global findprocpid findprocfile
1963 global finddidsel ctext displayorder findinprogress
1964 global findinsertpos
1965
1966 if {$numcommits == 0} return
1967
1968 # make a list of all the ids to search, starting at the one
1969 # after the selected line (if any)
1970 if {[info exists selectedline]} {
1971 set l $selectedline
1972 } else {
1973 set l -1
1974 }
1975 set inputids {}
1976 for {set i 0} {$i < $numcommits} {incr i} {
1977 if {[incr l] >= $numcommits} {
1978 set l 0
1979 }
1980 append inputids [lindex $displayorder $l] "\n"
1981 }
1982
1983 if {[catch {
1984 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1985 << $inputids] r]
1986 } err]} {
1987 error_popup "Error starting search process: $err"
1988 return
1989 }
1990
1991 set findinsertpos end
1992 set findprocfile $f
1993 set findprocpid [pid $f]
1994 fconfigure $f -blocking 0
1995 fileevent $f readable readfindproc
1996 set finddidsel 0
1997 . config -cursor watch
1998 settextcursor watch
1999 set findinprogress 1
2000}
2001
2002proc readfindproc {} {
2003 global findprocfile finddidsel
2004 global commitrow matchinglines findinsertpos
2005
2006 set n [gets $findprocfile line]
2007 if {$n < 0} {
2008 if {[eof $findprocfile]} {
2009 stopfindproc 1
2010 if {!$finddidsel} {
2011 bell
2012 }
2013 }
2014 return
2015 }
2016 if {![regexp {^[0-9a-f]{40}} $line id]} {
2017 error_popup "Can't parse git-diff-tree output: $line"
2018 stopfindproc
2019 return
2020 }
2021 if {![info exists commitrow($id)]} {
2022 puts stderr "spurious id: $id"
2023 return
2024 }
2025 set l $commitrow($id)
2026 insertmatch $l $id
2027}
2028
2029proc insertmatch {l id} {
2030 global matchinglines findinsertpos finddidsel
2031
2032 if {$findinsertpos == "end"} {
2033 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2034 set matchinglines [linsert $matchinglines 0 $l]
2035 set findinsertpos 1
2036 } else {
2037 lappend matchinglines $l
2038 }
2039 } else {
2040 set matchinglines [linsert $matchinglines $findinsertpos $l]
2041 incr findinsertpos
2042 }
2043 markheadline $l $id
2044 if {!$finddidsel} {
2045 findselectline $l
2046 set finddidsel 1
2047 }
2048}
2049
2050proc findfiles {} {
2051 global selectedline numcommits displayorder ctext
2052 global ffileline finddidsel parentlist
2053 global findinprogress findstartline findinsertpos
2054 global treediffs fdiffid fdiffsneeded fdiffpos
2055 global findmergefiles
2056
2057 if {$numcommits == 0} return
2058
2059 if {[info exists selectedline]} {
2060 set l [expr {$selectedline + 1}]
2061 } else {
2062 set l 0
2063 }
2064 set ffileline $l
2065 set findstartline $l
2066 set diffsneeded {}
2067 set fdiffsneeded {}
2068 while 1 {
2069 set id [lindex $displayorder $l]
2070 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2071 if {![info exists treediffs($id)]} {
2072 append diffsneeded "$id\n"
2073 lappend fdiffsneeded $id
2074 }
2075 }
2076 if {[incr l] >= $numcommits} {
2077 set l 0
2078 }
2079 if {$l == $findstartline} break
2080 }
2081
2082 # start off a git-diff-tree process if needed
2083 if {$diffsneeded ne {}} {
2084 if {[catch {
2085 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2086 } err ]} {
2087 error_popup "Error starting search process: $err"
2088 return
2089 }
2090 catch {unset fdiffid}
2091 set fdiffpos 0
2092 fconfigure $df -blocking 0
2093 fileevent $df readable [list readfilediffs $df]
2094 }
2095
2096 set finddidsel 0
2097 set findinsertpos end
2098 set id [lindex $displayorder $l]
2099 . config -cursor watch
2100 settextcursor watch
2101 set findinprogress 1
2102 findcont
2103 update
2104}
2105
2106proc readfilediffs {df} {
2107 global findid fdiffid fdiffs
2108
2109 set n [gets $df line]
2110 if {$n < 0} {
2111 if {[eof $df]} {
2112 donefilediff
2113 if {[catch {close $df} err]} {
2114 stopfindproc
2115 bell
2116 error_popup "Error in git-diff-tree: $err"
2117 } elseif {[info exists findid]} {
2118 set id $findid
2119 stopfindproc
2120 bell
2121 error_popup "Couldn't find diffs for $id"
2122 }
2123 }
2124 return
2125 }
2126 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2127 # start of a new string of diffs
2128 donefilediff
2129 set fdiffid $id
2130 set fdiffs {}
2131 } elseif {[string match ":*" $line]} {
2132 lappend fdiffs [lindex $line 5]
2133 }
2134}
2135
2136proc donefilediff {} {
2137 global fdiffid fdiffs treediffs findid
2138 global fdiffsneeded fdiffpos
2139
2140 if {[info exists fdiffid]} {
2141 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2142 && $fdiffpos < [llength $fdiffsneeded]} {
2143 # git-diff-tree doesn't output anything for a commit
2144 # which doesn't change anything
2145 set nullid [lindex $fdiffsneeded $fdiffpos]
2146 set treediffs($nullid) {}
2147 if {[info exists findid] && $nullid eq $findid} {
2148 unset findid
2149 findcont
2150 }
2151 incr fdiffpos
2152 }
2153 incr fdiffpos
2154
2155 if {![info exists treediffs($fdiffid)]} {
2156 set treediffs($fdiffid) $fdiffs
2157 }
2158 if {[info exists findid] && $fdiffid eq $findid} {
2159 unset findid
2160 findcont
2161 }
2162 }
2163}
2164
2165proc findcont {id} {
2166 global findid treediffs parentlist
2167 global ffileline findstartline finddidsel
2168 global displayorder numcommits matchinglines findinprogress
2169 global findmergefiles
2170
2171 set l $ffileline
2172 while {1} {
2173 set id [lindex $displayorder $l]
2174 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2175 if {![info exists treediffs($id)]} {
2176 set findid $id
2177 set ffileline $l
2178 return
2179 }
2180 set doesmatch 0
2181 foreach f $treediffs($id) {
2182 set x [findmatches $f]
2183 if {$x != {}} {
2184 set doesmatch 1
2185 break
2186 }
2187 }
2188 if {$doesmatch} {
2189 insertmatch $l $id
2190 }
2191 }
2192 if {[incr l] >= $numcommits} {
2193 set l 0
2194 }
2195 if {$l == $findstartline} break
2196 }
2197 stopfindproc
2198 if {!$finddidsel} {
2199 bell
2200 }
2201}
2202
2203# mark a commit as matching by putting a yellow background
2204# behind the headline
2205proc markheadline {l id} {
2206 global canv mainfont linehtag
2207
2208 drawcmitrow $l
2209 set bbox [$canv bbox $linehtag($l)]
2210 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2211 $canv lower $t
2212}
2213
2214# mark the bits of a headline, author or date that match a find string
2215proc markmatches {canv l str tag matches font} {
2216 set bbox [$canv bbox $tag]
2217 set x0 [lindex $bbox 0]
2218 set y0 [lindex $bbox 1]
2219 set y1 [lindex $bbox 3]
2220 foreach match $matches {
2221 set start [lindex $match 0]
2222 set end [lindex $match 1]
2223 if {$start > $end} continue
2224 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2225 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2226 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2227 [expr {$x0+$xlen+2}] $y1 \
2228 -outline {} -tags matches -fill yellow]
2229 $canv lower $t
2230 }
2231}
2232
2233proc unmarkmatches {} {
2234 global matchinglines findids
2235 allcanvs delete matches
2236 catch {unset matchinglines}
2237 catch {unset findids}
2238}
2239
2240proc selcanvline {w x y} {
2241 global canv canvy0 ctext linespc
2242 global rowtextx
2243 set ymax [lindex [$canv cget -scrollregion] 3]
2244 if {$ymax == {}} return
2245 set yfrac [lindex [$canv yview] 0]
2246 set y [expr {$y + $yfrac * $ymax}]
2247 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2248 if {$l < 0} {
2249 set l 0
2250 }
2251 if {$w eq $canv} {
2252 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2253 }
2254 unmarkmatches
2255 selectline $l 1
2256}
2257
2258proc commit_descriptor {p} {
2259 global commitinfo
2260 set l "..."
2261 if {[info exists commitinfo($p)]} {
2262 set l [lindex $commitinfo($p) 0]
2263 }
2264 return "$p ($l)"
2265}
2266
2267# append some text to the ctext widget, and make any SHA1 ID
2268# that we know about be a clickable link.
2269proc appendwithlinks {text} {
2270 global ctext commitrow linknum
2271
2272 set start [$ctext index "end - 1c"]
2273 $ctext insert end $text
2274 $ctext insert end "\n"
2275 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2276 foreach l $links {
2277 set s [lindex $l 0]
2278 set e [lindex $l 1]
2279 set linkid [string range $text $s $e]
2280 if {![info exists commitrow($linkid)]} continue
2281 incr e
2282 $ctext tag add link "$start + $s c" "$start + $e c"
2283 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2284 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2285 incr linknum
2286 }
2287 $ctext tag conf link -foreground blue -underline 1
2288 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2289 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2290}
2291
2292proc selectline {l isnew} {
2293 global canv canv2 canv3 ctext commitinfo selectedline
2294 global displayorder linehtag linentag linedtag
2295 global canvy0 linespc parentlist childlist
2296 global cflist currentid sha1entry
2297 global commentend idtags linknum
2298 global mergemax numcommits
2299
2300 $canv delete hover
2301 normalline
2302 if {$l < 0 || $l >= $numcommits} return
2303 set y [expr {$canvy0 + $l * $linespc}]
2304 set ymax [lindex [$canv cget -scrollregion] 3]
2305 set ytop [expr {$y - $linespc - 1}]
2306 set ybot [expr {$y + $linespc + 1}]
2307 set wnow [$canv yview]
2308 set wtop [expr {[lindex $wnow 0] * $ymax}]
2309 set wbot [expr {[lindex $wnow 1] * $ymax}]
2310 set wh [expr {$wbot - $wtop}]
2311 set newtop $wtop
2312 if {$ytop < $wtop} {
2313 if {$ybot < $wtop} {
2314 set newtop [expr {$y - $wh / 2.0}]
2315 } else {
2316 set newtop $ytop
2317 if {$newtop > $wtop - $linespc} {
2318 set newtop [expr {$wtop - $linespc}]
2319 }
2320 }
2321 } elseif {$ybot > $wbot} {
2322 if {$ytop > $wbot} {
2323 set newtop [expr {$y - $wh / 2.0}]
2324 } else {
2325 set newtop [expr {$ybot - $wh}]
2326 if {$newtop < $wtop + $linespc} {
2327 set newtop [expr {$wtop + $linespc}]
2328 }
2329 }
2330 }
2331 if {$newtop != $wtop} {
2332 if {$newtop < 0} {
2333 set newtop 0
2334 }
2335 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2336 drawvisible
2337 }
2338
2339 if {![info exists linehtag($l)]} return
2340 $canv delete secsel
2341 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2342 -tags secsel -fill [$canv cget -selectbackground]]
2343 $canv lower $t
2344 $canv2 delete secsel
2345 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2346 -tags secsel -fill [$canv2 cget -selectbackground]]
2347 $canv2 lower $t
2348 $canv3 delete secsel
2349 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2350 -tags secsel -fill [$canv3 cget -selectbackground]]
2351 $canv3 lower $t
2352
2353 if {$isnew} {
2354 addtohistory [list selectline $l 0]
2355 }
2356
2357 set selectedline $l
2358
2359 set id [lindex $displayorder $l]
2360 set currentid $id
2361 $sha1entry delete 0 end
2362 $sha1entry insert 0 $id
2363 $sha1entry selection from 0
2364 $sha1entry selection to end
2365
2366 $ctext conf -state normal
2367 $ctext delete 0.0 end
2368 set linknum 0
2369 $ctext mark set fmark.0 0.0
2370 $ctext mark gravity fmark.0 left
2371 set info $commitinfo($id)
2372 set date [formatdate [lindex $info 2]]
2373 $ctext insert end "Author: [lindex $info 1] $date\n"
2374 set date [formatdate [lindex $info 4]]
2375 $ctext insert end "Committer: [lindex $info 3] $date\n"
2376 if {[info exists idtags($id)]} {
2377 $ctext insert end "Tags:"
2378 foreach tag $idtags($id) {
2379 $ctext insert end " $tag"
2380 }
2381 $ctext insert end "\n"
2382 }
2383
2384 set comment {}
2385 set olds [lindex $parentlist $l]
2386 if {[llength $olds] > 1} {
2387 set np 0
2388 foreach p $olds {
2389 if {$np >= $mergemax} {
2390 set tag mmax
2391 } else {
2392 set tag m$np
2393 }
2394 $ctext insert end "Parent: " $tag
2395 appendwithlinks [commit_descriptor $p]
2396 incr np
2397 }
2398 } else {
2399 foreach p $olds {
2400 append comment "Parent: [commit_descriptor $p]\n"
2401 }
2402 }
2403
2404 foreach c [lindex $childlist $l] {
2405 append comment "Child: [commit_descriptor $c]\n"
2406 }
2407 append comment "\n"
2408 append comment [lindex $info 5]
2409
2410 # make anything that looks like a SHA1 ID be a clickable link
2411 appendwithlinks $comment
2412
2413 $ctext tag delete Comments
2414 $ctext tag remove found 1.0 end
2415 $ctext conf -state disabled
2416 set commentend [$ctext index "end - 1c"]
2417
2418 $cflist delete 0 end
2419 $cflist insert end "Comments"
2420 if {[llength $olds] <= 1} {
2421 startdiff $id
2422 } else {
2423 mergediff $id $l
2424 }
2425}
2426
2427proc selnextline {dir} {
2428 global selectedline
2429 if {![info exists selectedline]} return
2430 set l [expr {$selectedline + $dir}]
2431 unmarkmatches
2432 selectline $l 1
2433}
2434
2435proc unselectline {} {
2436 global selectedline
2437
2438 catch {unset selectedline}
2439 allcanvs delete secsel
2440}
2441
2442proc addtohistory {cmd} {
2443 global history historyindex
2444
2445 if {$historyindex > 0
2446 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2447 return
2448 }
2449
2450 if {$historyindex < [llength $history]} {
2451 set history [lreplace $history $historyindex end $cmd]
2452 } else {
2453 lappend history $cmd
2454 }
2455 incr historyindex
2456 if {$historyindex > 1} {
2457 .ctop.top.bar.leftbut conf -state normal
2458 } else {
2459 .ctop.top.bar.leftbut conf -state disabled
2460 }
2461 .ctop.top.bar.rightbut conf -state disabled
2462}
2463
2464proc goback {} {
2465 global history historyindex
2466
2467 if {$historyindex > 1} {
2468 incr historyindex -1
2469 set cmd [lindex $history [expr {$historyindex - 1}]]
2470 eval $cmd
2471 .ctop.top.bar.rightbut conf -state normal
2472 }
2473 if {$historyindex <= 1} {
2474 .ctop.top.bar.leftbut conf -state disabled
2475 }
2476}
2477
2478proc goforw {} {
2479 global history historyindex
2480
2481 if {$historyindex < [llength $history]} {
2482 set cmd [lindex $history $historyindex]
2483 incr historyindex
2484 eval $cmd
2485 .ctop.top.bar.leftbut conf -state normal
2486 }
2487 if {$historyindex >= [llength $history]} {
2488 .ctop.top.bar.rightbut conf -state disabled
2489 }
2490}
2491
2492proc mergediff {id l} {
2493 global diffmergeid diffopts mdifffd
2494 global difffilestart diffids
2495 global parentlist
2496
2497 set diffmergeid $id
2498 set diffids $id
2499 catch {unset difffilestart}
2500 # this doesn't seem to actually affect anything...
2501 set env(GIT_DIFF_OPTS) $diffopts
2502 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2503 if {[catch {set mdf [open $cmd r]} err]} {
2504 error_popup "Error getting merge diffs: $err"
2505 return
2506 }
2507 fconfigure $mdf -blocking 0
2508 set mdifffd($id) $mdf
2509 set np [llength [lindex $parentlist $l]]
2510 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2511 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2512}
2513
2514proc getmergediffline {mdf id np} {
2515 global diffmergeid ctext cflist nextupdate mergemax
2516 global difffilestart mdifffd
2517
2518 set n [gets $mdf line]
2519 if {$n < 0} {
2520 if {[eof $mdf]} {
2521 close $mdf
2522 }
2523 return
2524 }
2525 if {![info exists diffmergeid] || $id != $diffmergeid
2526 || $mdf != $mdifffd($id)} {
2527 return
2528 }
2529 $ctext conf -state normal
2530 if {[regexp {^diff --cc (.*)} $line match fname]} {
2531 # start of a new file
2532 $ctext insert end "\n"
2533 set here [$ctext index "end - 1c"]
2534 set i [$cflist index end]
2535 $ctext mark set fmark.$i $here
2536 $ctext mark gravity fmark.$i left
2537 set difffilestart([expr {$i-1}]) $here
2538 $cflist insert end $fname
2539 set l [expr {(78 - [string length $fname]) / 2}]
2540 set pad [string range "----------------------------------------" 1 $l]
2541 $ctext insert end "$pad $fname $pad\n" filesep
2542 } elseif {[regexp {^@@} $line]} {
2543 $ctext insert end "$line\n" hunksep
2544 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2545 # do nothing
2546 } else {
2547 # parse the prefix - one ' ', '-' or '+' for each parent
2548 set spaces {}
2549 set minuses {}
2550 set pluses {}
2551 set isbad 0
2552 for {set j 0} {$j < $np} {incr j} {
2553 set c [string range $line $j $j]
2554 if {$c == " "} {
2555 lappend spaces $j
2556 } elseif {$c == "-"} {
2557 lappend minuses $j
2558 } elseif {$c == "+"} {
2559 lappend pluses $j
2560 } else {
2561 set isbad 1
2562 break
2563 }
2564 }
2565 set tags {}
2566 set num {}
2567 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2568 # line doesn't appear in result, parents in $minuses have the line
2569 set num [lindex $minuses 0]
2570 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2571 # line appears in result, parents in $pluses don't have the line
2572 lappend tags mresult
2573 set num [lindex $spaces 0]
2574 }
2575 if {$num ne {}} {
2576 if {$num >= $mergemax} {
2577 set num "max"
2578 }
2579 lappend tags m$num
2580 }
2581 $ctext insert end "$line\n" $tags
2582 }
2583 $ctext conf -state disabled
2584 if {[clock clicks -milliseconds] >= $nextupdate} {
2585 incr nextupdate 100
2586 fileevent $mdf readable {}
2587 update
2588 fileevent $mdf readable [list getmergediffline $mdf $id]
2589 }
2590}
2591
2592proc startdiff {ids} {
2593 global treediffs diffids treepending diffmergeid
2594
2595 set diffids $ids
2596 catch {unset diffmergeid}
2597 if {![info exists treediffs($ids)]} {
2598 if {![info exists treepending]} {
2599 gettreediffs $ids
2600 }
2601 } else {
2602 addtocflist $ids
2603 }
2604}
2605
2606proc addtocflist {ids} {
2607 global treediffs cflist
2608 foreach f $treediffs($ids) {
2609 $cflist insert end $f
2610 }
2611 getblobdiffs $ids
2612}
2613
2614proc gettreediffs {ids} {
2615 global treediff treepending
2616 set treepending $ids
2617 set treediff {}
2618 if {[catch \
2619 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2620 ]} return
2621 fconfigure $gdtf -blocking 0
2622 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2623}
2624
2625proc gettreediffline {gdtf ids} {
2626 global treediff treediffs treepending diffids diffmergeid
2627
2628 set n [gets $gdtf line]
2629 if {$n < 0} {
2630 if {![eof $gdtf]} return
2631 close $gdtf
2632 set treediffs($ids) $treediff
2633 unset treepending
2634 if {$ids != $diffids} {
2635 if {![info exists diffmergeid]} {
2636 gettreediffs $diffids
2637 }
2638 } else {
2639 addtocflist $ids
2640 }
2641 return
2642 }
2643 set file [lindex $line 5]
2644 lappend treediff $file
2645}
2646
2647proc getblobdiffs {ids} {
2648 global diffopts blobdifffd diffids env curdifftag curtagstart
2649 global difffilestart nextupdate diffinhdr treediffs
2650
2651 set env(GIT_DIFF_OPTS) $diffopts
2652 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2653 if {[catch {set bdf [open $cmd r]} err]} {
2654 puts "error getting diffs: $err"
2655 return
2656 }
2657 set diffinhdr 0
2658 fconfigure $bdf -blocking 0
2659 set blobdifffd($ids) $bdf
2660 set curdifftag Comments
2661 set curtagstart 0.0
2662 catch {unset difffilestart}
2663 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2664 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2665}
2666
2667proc getblobdiffline {bdf ids} {
2668 global diffids blobdifffd ctext curdifftag curtagstart
2669 global diffnexthead diffnextnote difffilestart
2670 global nextupdate diffinhdr treediffs
2671
2672 set n [gets $bdf line]
2673 if {$n < 0} {
2674 if {[eof $bdf]} {
2675 close $bdf
2676 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2677 $ctext tag add $curdifftag $curtagstart end
2678 }
2679 }
2680 return
2681 }
2682 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2683 return
2684 }
2685 $ctext conf -state normal
2686 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2687 # start of a new file
2688 $ctext insert end "\n"
2689 $ctext tag add $curdifftag $curtagstart end
2690 set curtagstart [$ctext index "end - 1c"]
2691 set header $newname
2692 set here [$ctext index "end - 1c"]
2693 set i [lsearch -exact $treediffs($diffids) $fname]
2694 if {$i >= 0} {
2695 set difffilestart($i) $here
2696 incr i
2697 $ctext mark set fmark.$i $here
2698 $ctext mark gravity fmark.$i left
2699 }
2700 if {$newname != $fname} {
2701 set i [lsearch -exact $treediffs($diffids) $newname]
2702 if {$i >= 0} {
2703 set difffilestart($i) $here
2704 incr i
2705 $ctext mark set fmark.$i $here
2706 $ctext mark gravity fmark.$i left
2707 }
2708 }
2709 set curdifftag "f:$fname"
2710 $ctext tag delete $curdifftag
2711 set l [expr {(78 - [string length $header]) / 2}]
2712 set pad [string range "----------------------------------------" 1 $l]
2713 $ctext insert end "$pad $header $pad\n" filesep
2714 set diffinhdr 1
2715 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2716 # do nothing
2717 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2718 set diffinhdr 0
2719 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2720 $line match f1l f1c f2l f2c rest]} {
2721 $ctext insert end "$line\n" hunksep
2722 set diffinhdr 0
2723 } else {
2724 set x [string range $line 0 0]
2725 if {$x == "-" || $x == "+"} {
2726 set tag [expr {$x == "+"}]
2727 $ctext insert end "$line\n" d$tag
2728 } elseif {$x == " "} {
2729 $ctext insert end "$line\n"
2730 } elseif {$diffinhdr || $x == "\\"} {
2731 # e.g. "\ No newline at end of file"
2732 $ctext insert end "$line\n" filesep
2733 } else {
2734 # Something else we don't recognize
2735 if {$curdifftag != "Comments"} {
2736 $ctext insert end "\n"
2737 $ctext tag add $curdifftag $curtagstart end
2738 set curtagstart [$ctext index "end - 1c"]
2739 set curdifftag Comments
2740 }
2741 $ctext insert end "$line\n" filesep
2742 }
2743 }
2744 $ctext conf -state disabled
2745 if {[clock clicks -milliseconds] >= $nextupdate} {
2746 incr nextupdate 100
2747 fileevent $bdf readable {}
2748 update
2749 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2750 }
2751}
2752
2753proc nextfile {} {
2754 global difffilestart ctext
2755 set here [$ctext index @0,0]
2756 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2757 if {[$ctext compare $difffilestart($i) > $here]} {
2758 if {![info exists pos]
2759 || [$ctext compare $difffilestart($i) < $pos]} {
2760 set pos $difffilestart($i)
2761 }
2762 }
2763 }
2764 if {[info exists pos]} {
2765 $ctext yview $pos
2766 }
2767}
2768
2769proc listboxsel {} {
2770 global ctext cflist currentid
2771 if {![info exists currentid]} return
2772 set sel [lsort [$cflist curselection]]
2773 if {$sel eq {}} return
2774 set first [lindex $sel 0]
2775 catch {$ctext yview fmark.$first}
2776}
2777
2778proc setcoords {} {
2779 global linespc charspc canvx0 canvy0 mainfont
2780 global xspc1 xspc2 lthickness
2781
2782 set linespc [font metrics $mainfont -linespace]
2783 set charspc [font measure $mainfont "m"]
2784 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2785 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2786 set lthickness [expr {int($linespc / 9) + 1}]
2787 set xspc1(0) $linespc
2788 set xspc2 $linespc
2789}
2790
2791proc redisplay {} {
2792 global canv
2793 global selectedline
2794
2795 set ymax [lindex [$canv cget -scrollregion] 3]
2796 if {$ymax eq {} || $ymax == 0} return
2797 set span [$canv yview]
2798 clear_display
2799 setcanvscroll
2800 allcanvs yview moveto [lindex $span 0]
2801 drawvisible
2802 if {[info exists selectedline]} {
2803 selectline $selectedline 0
2804 }
2805}
2806
2807proc incrfont {inc} {
2808 global mainfont namefont textfont ctext canv phase
2809 global stopped entries
2810 unmarkmatches
2811 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2812 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2813 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2814 setcoords
2815 $ctext conf -font $textfont
2816 $ctext tag conf filesep -font [concat $textfont bold]
2817 foreach e $entries {
2818 $e conf -font $mainfont
2819 }
2820 if {$phase == "getcommits"} {
2821 $canv itemconf textitems -font $mainfont
2822 }
2823 redisplay
2824}
2825
2826proc clearsha1 {} {
2827 global sha1entry sha1string
2828 if {[string length $sha1string] == 40} {
2829 $sha1entry delete 0 end
2830 }
2831}
2832
2833proc sha1change {n1 n2 op} {
2834 global sha1string currentid sha1but
2835 if {$sha1string == {}
2836 || ([info exists currentid] && $sha1string == $currentid)} {
2837 set state disabled
2838 } else {
2839 set state normal
2840 }
2841 if {[$sha1but cget -state] == $state} return
2842 if {$state == "normal"} {
2843 $sha1but conf -state normal -relief raised -text "Goto: "
2844 } else {
2845 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2846 }
2847}
2848
2849proc gotocommit {} {
2850 global sha1string currentid commitrow tagids headids
2851 global displayorder numcommits
2852
2853 if {$sha1string == {}
2854 || ([info exists currentid] && $sha1string == $currentid)} return
2855 if {[info exists tagids($sha1string)]} {
2856 set id $tagids($sha1string)
2857 } elseif {[info exists headids($sha1string)]} {
2858 set id $headids($sha1string)
2859 } else {
2860 set id [string tolower $sha1string]
2861 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2862 set matches {}
2863 foreach i $displayorder {
2864 if {[string match $id* $i]} {
2865 lappend matches $i
2866 }
2867 }
2868 if {$matches ne {}} {
2869 if {[llength $matches] > 1} {
2870 error_popup "Short SHA1 id $id is ambiguous"
2871 return
2872 }
2873 set id [lindex $matches 0]
2874 }
2875 }
2876 }
2877 if {[info exists commitrow($id)]} {
2878 selectline $commitrow($id) 1
2879 return
2880 }
2881 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2882 set type "SHA1 id"
2883 } else {
2884 set type "Tag/Head"
2885 }
2886 error_popup "$type $sha1string is not known"
2887}
2888
2889proc lineenter {x y id} {
2890 global hoverx hovery hoverid hovertimer
2891 global commitinfo canv
2892
2893 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2894 set hoverx $x
2895 set hovery $y
2896 set hoverid $id
2897 if {[info exists hovertimer]} {
2898 after cancel $hovertimer
2899 }
2900 set hovertimer [after 500 linehover]
2901 $canv delete hover
2902}
2903
2904proc linemotion {x y id} {
2905 global hoverx hovery hoverid hovertimer
2906
2907 if {[info exists hoverid] && $id == $hoverid} {
2908 set hoverx $x
2909 set hovery $y
2910 if {[info exists hovertimer]} {
2911 after cancel $hovertimer
2912 }
2913 set hovertimer [after 500 linehover]
2914 }
2915}
2916
2917proc lineleave {id} {
2918 global hoverid hovertimer canv
2919
2920 if {[info exists hoverid] && $id == $hoverid} {
2921 $canv delete hover
2922 if {[info exists hovertimer]} {
2923 after cancel $hovertimer
2924 unset hovertimer
2925 }
2926 unset hoverid
2927 }
2928}
2929
2930proc linehover {} {
2931 global hoverx hovery hoverid hovertimer
2932 global canv linespc lthickness
2933 global commitinfo mainfont
2934
2935 set text [lindex $commitinfo($hoverid) 0]
2936 set ymax [lindex [$canv cget -scrollregion] 3]
2937 if {$ymax == {}} return
2938 set yfrac [lindex [$canv yview] 0]
2939 set x [expr {$hoverx + 2 * $linespc}]
2940 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2941 set x0 [expr {$x - 2 * $lthickness}]
2942 set y0 [expr {$y - 2 * $lthickness}]
2943 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2944 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2945 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2946 -fill \#ffff80 -outline black -width 1 -tags hover]
2947 $canv raise $t
2948 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2949 $canv raise $t
2950}
2951
2952proc clickisonarrow {id y} {
2953 global lthickness idrowranges
2954
2955 set thresh [expr {2 * $lthickness + 6}]
2956 set n [expr {[llength $idrowranges($id)] - 1}]
2957 for {set i 1} {$i < $n} {incr i} {
2958 set row [lindex $idrowranges($id) $i]
2959 if {abs([yc $row] - $y) < $thresh} {
2960 return $i
2961 }
2962 }
2963 return {}
2964}
2965
2966proc arrowjump {id n y} {
2967 global idrowranges canv
2968
2969 # 1 <-> 2, 3 <-> 4, etc...
2970 set n [expr {(($n - 1) ^ 1) + 1}]
2971 set row [lindex $idrowranges($id) $n]
2972 set yt [yc $row]
2973 set ymax [lindex [$canv cget -scrollregion] 3]
2974 if {$ymax eq {} || $ymax <= 0} return
2975 set view [$canv yview]
2976 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2977 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2978 if {$yfrac < 0} {
2979 set yfrac 0
2980 }
2981 allcanvs yview moveto $yfrac
2982}
2983
2984proc lineclick {x y id isnew} {
2985 global ctext commitinfo childlist commitrow cflist canv thickerline
2986
2987 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2988 unmarkmatches
2989 unselectline
2990 normalline
2991 $canv delete hover
2992 # draw this line thicker than normal
2993 set thickerline $id
2994 drawlines $id
2995 if {$isnew} {
2996 set ymax [lindex [$canv cget -scrollregion] 3]
2997 if {$ymax eq {}} return
2998 set yfrac [lindex [$canv yview] 0]
2999 set y [expr {$y + $yfrac * $ymax}]
3000 }
3001 set dirn [clickisonarrow $id $y]
3002 if {$dirn ne {}} {
3003 arrowjump $id $dirn $y
3004 return
3005 }
3006
3007 if {$isnew} {
3008 addtohistory [list lineclick $x $y $id 0]
3009 }
3010 # fill the details pane with info about this line
3011 $ctext conf -state normal
3012 $ctext delete 0.0 end
3013 $ctext tag conf link -foreground blue -underline 1
3014 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3015 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3016 $ctext insert end "Parent:\t"
3017 $ctext insert end $id [list link link0]
3018 $ctext tag bind link0 <1> [list selbyid $id]
3019 set info $commitinfo($id)
3020 $ctext insert end "\n\t[lindex $info 0]\n"
3021 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3022 set date [formatdate [lindex $info 2]]
3023 $ctext insert end "\tDate:\t$date\n"
3024 set kids [lindex $childlist $commitrow($id)]
3025 if {$kids ne {}} {
3026 $ctext insert end "\nChildren:"
3027 set i 0
3028 foreach child $kids {
3029 incr i
3030 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3031 set info $commitinfo($child)
3032 $ctext insert end "\n\t"
3033 $ctext insert end $child [list link link$i]
3034 $ctext tag bind link$i <1> [list selbyid $child]
3035 $ctext insert end "\n\t[lindex $info 0]"
3036 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3037 set date [formatdate [lindex $info 2]]
3038 $ctext insert end "\n\tDate:\t$date\n"
3039 }
3040 }
3041 $ctext conf -state disabled
3042
3043 $cflist delete 0 end
3044}
3045
3046proc normalline {} {
3047 global thickerline
3048 if {[info exists thickerline]} {
3049 set id $thickerline
3050 unset thickerline
3051 drawlines $id
3052 }
3053}
3054
3055proc selbyid {id} {
3056 global commitrow
3057 if {[info exists commitrow($id)]} {
3058 selectline $commitrow($id) 1
3059 }
3060}
3061
3062proc mstime {} {
3063 global startmstime
3064 if {![info exists startmstime]} {
3065 set startmstime [clock clicks -milliseconds]
3066 }
3067 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3068}
3069
3070proc rowmenu {x y id} {
3071 global rowctxmenu commitrow selectedline rowmenuid
3072
3073 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3074 set state disabled
3075 } else {
3076 set state normal
3077 }
3078 $rowctxmenu entryconfigure 0 -state $state
3079 $rowctxmenu entryconfigure 1 -state $state
3080 $rowctxmenu entryconfigure 2 -state $state
3081 set rowmenuid $id
3082 tk_popup $rowctxmenu $x $y
3083}
3084
3085proc diffvssel {dirn} {
3086 global rowmenuid selectedline displayorder
3087
3088 if {![info exists selectedline]} return
3089 if {$dirn} {
3090 set oldid [lindex $displayorder $selectedline]
3091 set newid $rowmenuid
3092 } else {
3093 set oldid $rowmenuid
3094 set newid [lindex $displayorder $selectedline]
3095 }
3096 addtohistory [list doseldiff $oldid $newid]
3097 doseldiff $oldid $newid
3098}
3099
3100proc doseldiff {oldid newid} {
3101 global ctext cflist
3102 global commitinfo
3103
3104 $ctext conf -state normal
3105 $ctext delete 0.0 end
3106 $ctext mark set fmark.0 0.0
3107 $ctext mark gravity fmark.0 left
3108 $cflist delete 0 end
3109 $cflist insert end "Top"
3110 $ctext insert end "From "
3111 $ctext tag conf link -foreground blue -underline 1
3112 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3113 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3114 $ctext tag bind link0 <1> [list selbyid $oldid]
3115 $ctext insert end $oldid [list link link0]
3116 $ctext insert end "\n "
3117 $ctext insert end [lindex $commitinfo($oldid) 0]
3118 $ctext insert end "\n\nTo "
3119 $ctext tag bind link1 <1> [list selbyid $newid]
3120 $ctext insert end $newid [list link link1]
3121 $ctext insert end "\n "
3122 $ctext insert end [lindex $commitinfo($newid) 0]
3123 $ctext insert end "\n"
3124 $ctext conf -state disabled
3125 $ctext tag delete Comments
3126 $ctext tag remove found 1.0 end
3127 startdiff [list $oldid $newid]
3128}
3129
3130proc mkpatch {} {
3131 global rowmenuid currentid commitinfo patchtop patchnum
3132
3133 if {![info exists currentid]} return
3134 set oldid $currentid
3135 set oldhead [lindex $commitinfo($oldid) 0]
3136 set newid $rowmenuid
3137 set newhead [lindex $commitinfo($newid) 0]
3138 set top .patch
3139 set patchtop $top
3140 catch {destroy $top}
3141 toplevel $top
3142 label $top.title -text "Generate patch"
3143 grid $top.title - -pady 10
3144 label $top.from -text "From:"
3145 entry $top.fromsha1 -width 40 -relief flat
3146 $top.fromsha1 insert 0 $oldid
3147 $top.fromsha1 conf -state readonly
3148 grid $top.from $top.fromsha1 -sticky w
3149 entry $top.fromhead -width 60 -relief flat
3150 $top.fromhead insert 0 $oldhead
3151 $top.fromhead conf -state readonly
3152 grid x $top.fromhead -sticky w
3153 label $top.to -text "To:"
3154 entry $top.tosha1 -width 40 -relief flat
3155 $top.tosha1 insert 0 $newid
3156 $top.tosha1 conf -state readonly
3157 grid $top.to $top.tosha1 -sticky w
3158 entry $top.tohead -width 60 -relief flat
3159 $top.tohead insert 0 $newhead
3160 $top.tohead conf -state readonly
3161 grid x $top.tohead -sticky w
3162 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3163 grid $top.rev x -pady 10
3164 label $top.flab -text "Output file:"
3165 entry $top.fname -width 60
3166 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3167 incr patchnum
3168 grid $top.flab $top.fname -sticky w
3169 frame $top.buts
3170 button $top.buts.gen -text "Generate" -command mkpatchgo
3171 button $top.buts.can -text "Cancel" -command mkpatchcan
3172 grid $top.buts.gen $top.buts.can
3173 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3174 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3175 grid $top.buts - -pady 10 -sticky ew
3176 focus $top.fname
3177}
3178
3179proc mkpatchrev {} {
3180 global patchtop
3181
3182 set oldid [$patchtop.fromsha1 get]
3183 set oldhead [$patchtop.fromhead get]
3184 set newid [$patchtop.tosha1 get]
3185 set newhead [$patchtop.tohead get]
3186 foreach e [list fromsha1 fromhead tosha1 tohead] \
3187 v [list $newid $newhead $oldid $oldhead] {
3188 $patchtop.$e conf -state normal
3189 $patchtop.$e delete 0 end
3190 $patchtop.$e insert 0 $v
3191 $patchtop.$e conf -state readonly
3192 }
3193}
3194
3195proc mkpatchgo {} {
3196 global patchtop
3197
3198 set oldid [$patchtop.fromsha1 get]
3199 set newid [$patchtop.tosha1 get]
3200 set fname [$patchtop.fname get]
3201 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3202 error_popup "Error creating patch: $err"
3203 }
3204 catch {destroy $patchtop}
3205 unset patchtop
3206}
3207
3208proc mkpatchcan {} {
3209 global patchtop
3210
3211 catch {destroy $patchtop}
3212 unset patchtop
3213}
3214
3215proc mktag {} {
3216 global rowmenuid mktagtop commitinfo
3217
3218 set top .maketag
3219 set mktagtop $top
3220 catch {destroy $top}
3221 toplevel $top
3222 label $top.title -text "Create tag"
3223 grid $top.title - -pady 10
3224 label $top.id -text "ID:"
3225 entry $top.sha1 -width 40 -relief flat
3226 $top.sha1 insert 0 $rowmenuid
3227 $top.sha1 conf -state readonly
3228 grid $top.id $top.sha1 -sticky w
3229 entry $top.head -width 60 -relief flat
3230 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3231 $top.head conf -state readonly
3232 grid x $top.head -sticky w
3233 label $top.tlab -text "Tag name:"
3234 entry $top.tag -width 60
3235 grid $top.tlab $top.tag -sticky w
3236 frame $top.buts
3237 button $top.buts.gen -text "Create" -command mktaggo
3238 button $top.buts.can -text "Cancel" -command mktagcan
3239 grid $top.buts.gen $top.buts.can
3240 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3241 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3242 grid $top.buts - -pady 10 -sticky ew
3243 focus $top.tag
3244}
3245
3246proc domktag {} {
3247 global mktagtop env tagids idtags
3248
3249 set id [$mktagtop.sha1 get]
3250 set tag [$mktagtop.tag get]
3251 if {$tag == {}} {
3252 error_popup "No tag name specified"
3253 return
3254 }
3255 if {[info exists tagids($tag)]} {
3256 error_popup "Tag \"$tag\" already exists"
3257 return
3258 }
3259 if {[catch {
3260 set dir [gitdir]
3261 set fname [file join $dir "refs/tags" $tag]
3262 set f [open $fname w]
3263 puts $f $id
3264 close $f
3265 } err]} {
3266 error_popup "Error creating tag: $err"
3267 return
3268 }
3269
3270 set tagids($tag) $id
3271 lappend idtags($id) $tag
3272 redrawtags $id
3273}
3274
3275proc redrawtags {id} {
3276 global canv linehtag commitrow idpos selectedline
3277
3278 if {![info exists commitrow($id)]} return
3279 drawcmitrow $commitrow($id)
3280 $canv delete tag.$id
3281 set xt [eval drawtags $id $idpos($id)]
3282 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3283 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3284 selectline $selectedline 0
3285 }
3286}
3287
3288proc mktagcan {} {
3289 global mktagtop
3290
3291 catch {destroy $mktagtop}
3292 unset mktagtop
3293}
3294
3295proc mktaggo {} {
3296 domktag
3297 mktagcan
3298}
3299
3300proc writecommit {} {
3301 global rowmenuid wrcomtop commitinfo wrcomcmd
3302
3303 set top .writecommit
3304 set wrcomtop $top
3305 catch {destroy $top}
3306 toplevel $top
3307 label $top.title -text "Write commit to file"
3308 grid $top.title - -pady 10
3309 label $top.id -text "ID:"
3310 entry $top.sha1 -width 40 -relief flat
3311 $top.sha1 insert 0 $rowmenuid
3312 $top.sha1 conf -state readonly
3313 grid $top.id $top.sha1 -sticky w
3314 entry $top.head -width 60 -relief flat
3315 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3316 $top.head conf -state readonly
3317 grid x $top.head -sticky w
3318 label $top.clab -text "Command:"
3319 entry $top.cmd -width 60 -textvariable wrcomcmd
3320 grid $top.clab $top.cmd -sticky w -pady 10
3321 label $top.flab -text "Output file:"
3322 entry $top.fname -width 60
3323 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3324 grid $top.flab $top.fname -sticky w
3325 frame $top.buts
3326 button $top.buts.gen -text "Write" -command wrcomgo
3327 button $top.buts.can -text "Cancel" -command wrcomcan
3328 grid $top.buts.gen $top.buts.can
3329 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3330 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3331 grid $top.buts - -pady 10 -sticky ew
3332 focus $top.fname
3333}
3334
3335proc wrcomgo {} {
3336 global wrcomtop
3337
3338 set id [$wrcomtop.sha1 get]
3339 set cmd "echo $id | [$wrcomtop.cmd get]"
3340 set fname [$wrcomtop.fname get]
3341 if {[catch {exec sh -c $cmd >$fname &} err]} {
3342 error_popup "Error writing commit: $err"
3343 }
3344 catch {destroy $wrcomtop}
3345 unset wrcomtop
3346}
3347
3348proc wrcomcan {} {
3349 global wrcomtop
3350
3351 catch {destroy $wrcomtop}
3352 unset wrcomtop
3353}
3354
3355proc listrefs {id} {
3356 global idtags idheads idotherrefs
3357
3358 set x {}
3359 if {[info exists idtags($id)]} {
3360 set x $idtags($id)
3361 }
3362 set y {}
3363 if {[info exists idheads($id)]} {
3364 set y $idheads($id)
3365 }
3366 set z {}
3367 if {[info exists idotherrefs($id)]} {
3368 set z $idotherrefs($id)
3369 }
3370 return [list $x $y $z]
3371}
3372
3373proc rereadrefs {} {
3374 global idtags idheads idotherrefs
3375
3376 set refids [concat [array names idtags] \
3377 [array names idheads] [array names idotherrefs]]
3378 foreach id $refids {
3379 if {![info exists ref($id)]} {
3380 set ref($id) [listrefs $id]
3381 }
3382 }
3383 readrefs
3384 set refids [lsort -unique [concat $refids [array names idtags] \
3385 [array names idheads] [array names idotherrefs]]]
3386 foreach id $refids {
3387 set v [listrefs $id]
3388 if {![info exists ref($id)] || $ref($id) != $v} {
3389 redrawtags $id
3390 }
3391 }
3392}
3393
3394proc showtag {tag isnew} {
3395 global ctext cflist tagcontents tagids linknum
3396
3397 if {$isnew} {
3398 addtohistory [list showtag $tag 0]
3399 }
3400 $ctext conf -state normal
3401 $ctext delete 0.0 end
3402 set linknum 0
3403 if {[info exists tagcontents($tag)]} {
3404 set text $tagcontents($tag)
3405 } else {
3406 set text "Tag: $tag\nId: $tagids($tag)"
3407 }
3408 appendwithlinks $text
3409 $ctext conf -state disabled
3410 $cflist delete 0 end
3411}
3412
3413proc doquit {} {
3414 global stopped
3415 set stopped 100
3416 destroy .
3417}
3418
3419proc doprefs {} {
3420 global maxwidth maxgraphpct diffopts findmergefiles
3421 global oldprefs prefstop
3422
3423 set top .gitkprefs
3424 set prefstop $top
3425 if {[winfo exists $top]} {
3426 raise $top
3427 return
3428 }
3429 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3430 set oldprefs($v) [set $v]
3431 }
3432 toplevel $top
3433 wm title $top "Gitk preferences"
3434 label $top.ldisp -text "Commit list display options"
3435 grid $top.ldisp - -sticky w -pady 10
3436 label $top.spacer -text " "
3437 label $top.maxwidthl -text "Maximum graph width (lines)" \
3438 -font optionfont
3439 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3440 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3441 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3442 -font optionfont
3443 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3444 grid x $top.maxpctl $top.maxpct -sticky w
3445 checkbutton $top.findm -variable findmergefiles
3446 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3447 -font optionfont
3448 grid $top.findm $top.findml - -sticky w
3449 label $top.ddisp -text "Diff display options"
3450 grid $top.ddisp - -sticky w -pady 10
3451 label $top.diffoptl -text "Options for diff program" \
3452 -font optionfont
3453 entry $top.diffopt -width 20 -textvariable diffopts
3454 grid x $top.diffoptl $top.diffopt -sticky w
3455 frame $top.buts
3456 button $top.buts.ok -text "OK" -command prefsok
3457 button $top.buts.can -text "Cancel" -command prefscan
3458 grid $top.buts.ok $top.buts.can
3459 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3460 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3461 grid $top.buts - - -pady 10 -sticky ew
3462}
3463
3464proc prefscan {} {
3465 global maxwidth maxgraphpct diffopts findmergefiles
3466 global oldprefs prefstop
3467
3468 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3469 set $v $oldprefs($v)
3470 }
3471 catch {destroy $prefstop}
3472 unset prefstop
3473}
3474
3475proc prefsok {} {
3476 global maxwidth maxgraphpct
3477 global oldprefs prefstop
3478
3479 catch {destroy $prefstop}
3480 unset prefstop
3481 if {$maxwidth != $oldprefs(maxwidth)
3482 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3483 redisplay
3484 }
3485}
3486
3487proc formatdate {d} {
3488 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3489}
3490
3491# This list of encoding names and aliases is distilled from
3492# http://www.iana.org/assignments/character-sets.
3493# Not all of them are supported by Tcl.
3494set encoding_aliases {
3495 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3496 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3497 { ISO-10646-UTF-1 csISO10646UTF1 }
3498 { ISO_646.basic:1983 ref csISO646basic1983 }
3499 { INVARIANT csINVARIANT }
3500 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3501 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3502 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3503 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3504 { NATS-DANO iso-ir-9-1 csNATSDANO }
3505 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3506 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3507 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3508 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3509 { ISO-2022-KR csISO2022KR }
3510 { EUC-KR csEUCKR }
3511 { ISO-2022-JP csISO2022JP }
3512 { ISO-2022-JP-2 csISO2022JP2 }
3513 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3514 csISO13JISC6220jp }
3515 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3516 { IT iso-ir-15 ISO646-IT csISO15Italian }
3517 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3518 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3519 { greek7-old iso-ir-18 csISO18Greek7Old }
3520 { latin-greek iso-ir-19 csISO19LatinGreek }
3521 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3522 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3523 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3524 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3525 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3526 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3527 { INIS iso-ir-49 csISO49INIS }
3528 { INIS-8 iso-ir-50 csISO50INIS8 }
3529 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3530 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3531 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3532 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3533 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3534 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3535 csISO60Norwegian1 }
3536 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3537 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3538 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3539 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3540 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3541 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3542 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3543 { greek7 iso-ir-88 csISO88Greek7 }
3544 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3545 { iso-ir-90 csISO90 }
3546 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3547 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3548 csISO92JISC62991984b }
3549 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3550 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3551 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3552 csISO95JIS62291984handadd }
3553 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3554 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3555 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3556 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3557 CP819 csISOLatin1 }
3558 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3559 { T.61-7bit iso-ir-102 csISO102T617bit }
3560 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3561 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3562 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3563 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3564 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3565 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3566 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3567 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3568 arabic csISOLatinArabic }
3569 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3570 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3571 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3572 greek greek8 csISOLatinGreek }
3573 { T.101-G2 iso-ir-128 csISO128T101G2 }
3574 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3575 csISOLatinHebrew }
3576 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3577 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3578 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3579 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3580 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3581 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3582 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3583 csISOLatinCyrillic }
3584 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3585 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3586 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3587 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3588 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3589 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3590 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3591 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3592 { ISO_10367-box iso-ir-155 csISO10367Box }
3593 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3594 { latin-lap lap iso-ir-158 csISO158Lap }
3595 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3596 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3597 { us-dk csUSDK }
3598 { dk-us csDKUS }
3599 { JIS_X0201 X0201 csHalfWidthKatakana }
3600 { KSC5636 ISO646-KR csKSC5636 }
3601 { ISO-10646-UCS-2 csUnicode }
3602 { ISO-10646-UCS-4 csUCS4 }
3603 { DEC-MCS dec csDECMCS }
3604 { hp-roman8 roman8 r8 csHPRoman8 }
3605 { macintosh mac csMacintosh }
3606 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3607 csIBM037 }
3608 { IBM038 EBCDIC-INT cp038 csIBM038 }
3609 { IBM273 CP273 csIBM273 }
3610 { IBM274 EBCDIC-BE CP274 csIBM274 }
3611 { IBM275 EBCDIC-BR cp275 csIBM275 }
3612 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3613 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3614 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3615 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3616 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3617 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3618 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3619 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3620 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3621 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3622 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3623 { IBM437 cp437 437 csPC8CodePage437 }
3624 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3625 { IBM775 cp775 csPC775Baltic }
3626 { IBM850 cp850 850 csPC850Multilingual }
3627 { IBM851 cp851 851 csIBM851 }
3628 { IBM852 cp852 852 csPCp852 }
3629 { IBM855 cp855 855 csIBM855 }
3630 { IBM857 cp857 857 csIBM857 }
3631 { IBM860 cp860 860 csIBM860 }
3632 { IBM861 cp861 861 cp-is csIBM861 }
3633 { IBM862 cp862 862 csPC862LatinHebrew }
3634 { IBM863 cp863 863 csIBM863 }
3635 { IBM864 cp864 csIBM864 }
3636 { IBM865 cp865 865 csIBM865 }
3637 { IBM866 cp866 866 csIBM866 }
3638 { IBM868 CP868 cp-ar csIBM868 }
3639 { IBM869 cp869 869 cp-gr csIBM869 }
3640 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3641 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3642 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3643 { IBM891 cp891 csIBM891 }
3644 { IBM903 cp903 csIBM903 }
3645 { IBM904 cp904 904 csIBBM904 }
3646 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3647 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3648 { IBM1026 CP1026 csIBM1026 }
3649 { EBCDIC-AT-DE csIBMEBCDICATDE }
3650 { EBCDIC-AT-DE-A csEBCDICATDEA }
3651 { EBCDIC-CA-FR csEBCDICCAFR }
3652 { EBCDIC-DK-NO csEBCDICDKNO }
3653 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3654 { EBCDIC-FI-SE csEBCDICFISE }
3655 { EBCDIC-FI-SE-A csEBCDICFISEA }
3656 { EBCDIC-FR csEBCDICFR }
3657 { EBCDIC-IT csEBCDICIT }
3658 { EBCDIC-PT csEBCDICPT }
3659 { EBCDIC-ES csEBCDICES }
3660 { EBCDIC-ES-A csEBCDICESA }
3661 { EBCDIC-ES-S csEBCDICESS }
3662 { EBCDIC-UK csEBCDICUK }
3663 { EBCDIC-US csEBCDICUS }
3664 { UNKNOWN-8BIT csUnknown8BiT }
3665 { MNEMONIC csMnemonic }
3666 { MNEM csMnem }
3667 { VISCII csVISCII }
3668 { VIQR csVIQR }
3669 { KOI8-R csKOI8R }
3670 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3671 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3672 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3673 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3674 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3675 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3676 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3677 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3678 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3679 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3680 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3681 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3682 { IBM1047 IBM-1047 }
3683 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3684 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3685 { UNICODE-1-1 csUnicode11 }
3686 { CESU-8 csCESU-8 }
3687 { BOCU-1 csBOCU-1 }
3688 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3689 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3690 l8 }
3691 { ISO-8859-15 ISO_8859-15 Latin-9 }
3692 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3693 { GBK CP936 MS936 windows-936 }
3694 { JIS_Encoding csJISEncoding }
3695 { Shift_JIS MS_Kanji csShiftJIS }
3696 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3697 EUC-JP }
3698 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3699 { ISO-10646-UCS-Basic csUnicodeASCII }
3700 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3701 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3702 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3703 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3704 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3705 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3706 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3707 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3708 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3709 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3710 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3711 { Ventura-US csVenturaUS }
3712 { Ventura-International csVenturaInternational }
3713 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3714 { PC8-Turkish csPC8Turkish }
3715 { IBM-Symbols csIBMSymbols }
3716 { IBM-Thai csIBMThai }
3717 { HP-Legal csHPLegal }
3718 { HP-Pi-font csHPPiFont }
3719 { HP-Math8 csHPMath8 }
3720 { Adobe-Symbol-Encoding csHPPSMath }
3721 { HP-DeskTop csHPDesktop }
3722 { Ventura-Math csVenturaMath }
3723 { Microsoft-Publishing csMicrosoftPublishing }
3724 { Windows-31J csWindows31J }
3725 { GB2312 csGB2312 }
3726 { Big5 csBig5 }
3727}
3728
3729proc tcl_encoding {enc} {
3730 global encoding_aliases
3731 set names [encoding names]
3732 set lcnames [string tolower $names]
3733 set enc [string tolower $enc]
3734 set i [lsearch -exact $lcnames $enc]
3735 if {$i < 0} {
3736 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3737 if {[regsub {^iso[-_]} $enc iso encx]} {
3738 set i [lsearch -exact $lcnames $encx]
3739 }
3740 }
3741 if {$i < 0} {
3742 foreach l $encoding_aliases {
3743 set ll [string tolower $l]
3744 if {[lsearch -exact $ll $enc] < 0} continue
3745 # look through the aliases for one that tcl knows about
3746 foreach e $ll {
3747 set i [lsearch -exact $lcnames $e]
3748 if {$i < 0} {
3749 if {[regsub {^iso[-_]} $e iso ex]} {
3750 set i [lsearch -exact $lcnames $ex]
3751 }
3752 }
3753 if {$i >= 0} break
3754 }
3755 break
3756 }
3757 }
3758 if {$i >= 0} {
3759 return [lindex $names $i]
3760 }
3761 return {}
3762}
3763
3764# defaults...
3765set datemode 0
3766set diffopts "-U 5 -p"
3767set wrcomcmd "git-diff-tree --stdin -p --pretty"
3768
3769set gitencoding {}
3770catch {
3771 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3772}
3773if {$gitencoding == ""} {
3774 set gitencoding "utf-8"
3775}
3776set tclencoding [tcl_encoding $gitencoding]
3777if {$tclencoding == {}} {
3778 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3779}
3780
3781set mainfont {Helvetica 9}
3782set textfont {Courier 9}
3783set findmergefiles 0
3784set maxgraphpct 50
3785set maxwidth 16
3786set revlistorder 0
3787set fastdate 0
3788set uparrowlen 7
3789set downarrowlen 7
3790set mingaplen 30
3791
3792set colors {green red blue magenta darkgrey brown orange}
3793
3794catch {source ~/.gitk}
3795
3796set namefont $mainfont
3797
3798font create optionfont -family sans-serif -size -12
3799
3800set revtreeargs {}
3801foreach arg $argv {
3802 switch -regexp -- $arg {
3803 "^$" { }
3804 "^-d" { set datemode 1 }
3805 default {
3806 lappend revtreeargs $arg
3807 }
3808 }
3809}
3810
3811# check that we can find a .git directory somewhere...
3812set gitdir [gitdir]
3813if {![file isdirectory $gitdir]} {
3814 error_popup "Cannot find the git directory \"$gitdir\"."
3815 exit 1
3816}
3817
3818set history {}
3819set historyindex 0
3820
3821set optim_delay 16
3822
3823set stopped 0
3824set stuffsaved 0
3825set patchnum 0
3826setcoords
3827makewindow $revtreeargs
3828readrefs
3829getcommits $revtreeargs