gitk: replace parent and children arrays with lists
[git/jnareb-git.git] / gitk
blob90afec92df5c67f0a8fec32569cbdb635c05dbbf
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc parse_args {rargs} {
20 global parsed_args
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
30 set parsed_args $rargs
32 return $parsed_args
35 proc start_rev_list {rlargs} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
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"
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
54 set leftover {}
55 fconfigure $commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure $commfd -encoding $tclencoding
59 fileevent $commfd readable [list getcommitlines $commfd]
60 . config -cursor watch
61 settextcursor watch
64 proc getcommits {rargs} {
65 global phase canv mainfont
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
74 proc getcommitlines {commfd} {
75 global commitlisted nextupdate
76 global leftover
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
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
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"
97 error_popup $err
98 exit 1
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
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}]]
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]
125 set ok 1
126 foreach id $ids {
127 if {[string length $id] != 40} {
128 set ok 0
129 break
133 if {!$ok} {
134 set shortcmit $cmit
135 if {[string length $shortcmit] > 80} {
136 set shortcmit "[string range $shortcmit 0 80]..."
138 error_popup "Can't parse git-rev-list output: {$shortcmit}"
139 exit 1
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]
147 foreach p $olds {
148 lappend children($p) $id
150 } else {
151 set olds {}
153 lappend parentlist $olds
154 if {[info exists children($id)]} {
155 lappend childlist $children($id)
156 } else {
157 lappend childlist {}
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
166 if {$gotsome} {
167 layoutmore
169 if {[clock clicks -milliseconds] >= $nextupdate} {
170 doupdate 1
174 proc doupdate {reading} {
175 global commfd nextupdate numcommits ncmupdate
177 if {$reading} {
178 fileevent $commfd readable {}
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}]
189 if {$reading} {
190 fileevent $commfd readable [list getcommitlines $commfd]
194 proc readcommit {id} {
195 if {[catch {set contents [exec git-cat-file commit $id]}]} return
196 parsecommit $id $contents 0
199 proc 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}
208 allcanvs delete all
209 readrefs
210 getcommits $rargs
213 proc parsecommit {id contents listed} {
214 global commitinfo cdate
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]
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]
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
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"
257 set comment $newcomment
259 if {$comdate != {}} {
260 set cdate($id) $comdate
262 set commitinfo($id) [list $headline $auname $audate \
263 $comname $comdate $comment]
266 proc getcommit {id} {
267 global commitdata commitinfo
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"}
277 return 1
280 proc readrefs {} {
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
284 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
285 catch {unset $v}
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
293 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
294 set type others
295 set name $path
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
310 catch {
311 set tagcontents($name) [exec git-cat-file tag "$id"]
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
321 close $refd
324 proc 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
337 proc 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
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
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
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]}]
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}
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
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};
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};
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
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
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
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
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}
498 pack .ctop -side top -fill both -expand 1
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
545 set maincursor [. cget -cursor]
546 set textcursor [$ctext cget -cursor]
547 set curtextcursor $textcursor
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
560 # mouse-2 makes all windows scan vertically, but only the one
561 # the cursor is in scans horizontally
562 proc 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
573 proc scrollcanv {cscroll f0 f1} {
574 $cscroll set $f0 $f1
575 drawfrac $f0 $f1
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.
581 proc 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>]
588 foreach e $entries {
589 bind $e $ev "$escript; break"
593 # set the focus back to the toplevel for any click outside
594 # the entry widgets
595 proc click {w} {
596 global entries
597 foreach e $entries {
598 if {$w == $e} return
600 focus .
603 proc savestuff {w} {
604 global canv canv2 canv3 ctext cflist mainfont textfont
605 global stuffsaved findmergefiles maxgraphpct
606 global maxwidth
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"
632 set stuffsaved 1
635 proc 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
650 if {$sash1 < $sash0 + 20} {
651 set sash1 [expr {$sash0 + 20}]
653 if {$sash1 > $w - 10} {
654 set sash1 [expr {$w - 10}]
655 if {$sash0 > $sash1 - 20} {
656 set sash0 [expr {$sash1 - 20}]
660 $win sash place 0 $sash0 [lindex $s0 1]
661 $win sash place 1 $sash1 [lindex $s1 1]
663 set oldwidth($win) $w
666 proc 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
678 if {$sash0 > $w - 15} {
679 set sash0 [expr {$w - 15}]
682 $win sash place 0 $sash0 [lindex $s0 1]
684 set oldwidth($win) $w
687 proc allcanvs args {
688 global canv canv2 canv3
689 eval $canv $args
690 eval $canv2 $args
691 eval $canv3 $args
694 proc bindall {event action} {
695 global canv canv2 canv3
696 bind $canv $event $action
697 bind $canv2 $event $action
698 bind $canv3 $event $action
701 proc about {} {
702 set w .about
703 if {[winfo exists $w]} {
704 raise $w
705 return
707 toplevel $w
708 wm title $w "About gitk"
709 message $w.m -text {
710 Gitk - a commit viewer for git
712 Copyright © 2005-2006 Paul Mackerras
714 Use 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
721 proc 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
732 return $res
735 proc 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}]
742 incr x
744 return $l
747 proc ntimes {n o} {
748 set ret {}
749 for {} {$n > 0} {incr n -1} {
750 lappend ret $o
752 return $ret
755 proc usedinrange {id l1 l2} {
756 global children commitrow
758 if {[info exists commitrow($id)]} {
759 set r $commitrow($id)
760 if {$l1 <= $r && $r <= $l2} {
761 return [expr {$r - $l1 + 1}]
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}]
772 return 0
775 proc sanity {row {full 0}} {
776 global rowidlist rowoffsets
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]]}"
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]}"
799 break
801 if {!$full} break
802 set o [lindex $rowoffsets $y $x]
807 proc makeuparrow {oid x y z} {
808 global rowidlist rowoffsets uparrowlen idrowranges
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
819 set z [lindex $off0 $x0]
820 if {$z ne {}} {
821 incr x0 $z
822 break
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]
829 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
830 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
831 lappend idrowranges($oid) $y
834 proc 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
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]
859 proc setcanvscroll {} {
860 global canv canv2 canv3 numcommits linespc canvxmax canvy0
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]
868 proc visiblerows {} {
869 global canv numcommits linespc
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
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}]
884 return [list $r0 $r1]
887 proc layoutmore {} {
888 global rowlaidout rowoptim commitidx numcommits optim_delay
889 global uparrowlen
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
899 set canshow [expr {$rowoptim - $optim_delay}]
900 if {$canshow > $numcommits} {
901 showstuff $canshow
905 proc showstuff {canshow} {
906 global numcommits
907 global linesegends idrowranges idrangedrawn
909 if {$numcommits == 0} {
910 global phase
911 set phase "incrdraw"
912 allcanvs delete all
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
935 if {$canshow > $r1} {
936 set canshow $r1
938 while {$row < $canshow} {
939 drawcmitrow $row
940 incr row
944 proc 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
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
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
985 set rowchk($id) [expr {$row + $r}]
988 lset rowidlist $row $idlist
989 lset rowoffsets $row $offs
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)
1001 lappend offs $z
1002 lset rowoffsets $row $offs
1003 if {$z ne {}} {
1004 makeuparrow $id $col $row $z
1006 } else {
1007 unset idinlist($id)
1009 if {[info exists idrowranges($id)]} {
1010 lappend idrowranges($id) $row
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
1023 incr o
1024 set tmp [expr {[llength $idlist] - [llength $offs]}]
1025 if {$tmp > 0} {
1026 set offs [concat $offs [ntimes $tmp $o]]
1028 } else {
1029 lset offs $col {}
1031 foreach i $newolds {
1032 set idinlist($i) 1
1033 set idrowranges($i) $row
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
1043 lappend rowidlist $idlist
1044 lappend rowoffsets $offs
1046 return $row
1049 proc addextraid {id row} {
1050 global displayorder commitrow commitinfo
1051 global commitidx
1052 global parentlist childlist children
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"}
1062 if {[info exists children($id)]} {
1063 lappend childlist $children($id)
1064 } else {
1065 lappend childlist {}
1069 proc layouttail {} {
1070 global rowidlist rowoffsets idinlist commitidx
1071 global idrowranges
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
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 {}
1100 proc insert_pad {row col npad} {
1101 global rowidlist rowoffsets
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}]]
1109 proc optimize_rows {row col endrow} {
1110 global rowidlist rowoffsets idrowranges linesegends displayorder
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
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
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
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
1155 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1156 break
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
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}]
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
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}]
1199 if {$o eq {} || $o <= 0} break
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
1211 set idlist [linsert $idlist $col {}]
1212 set tmp [linsert $offs $col {}]
1213 incr col
1214 set offs [incrange $tmp $col -1]
1217 lset rowidlist $row $idlist
1218 lset rowoffsets $row $offs
1219 set col 0
1223 proc xc {row col} {
1224 global canvx0 linespc
1225 return [expr {$canvx0 + $col * $linespc}]
1228 proc yc {row} {
1229 global canvy0 linespc
1230 return [expr {$canvy0 + $row * $linespc}]
1233 proc linewidth {id} {
1234 global thickerline lthickness
1236 set wid $lthickness
1237 if {[info exists thickerline] && $id eq $thickerline} {
1238 set wid [expr {2 * $lthickness}]
1240 return $wid
1243 proc drawlineseg {id i} {
1244 global rowoffsets rowidlist idrowranges
1245 global displayorder
1246 global canv colormap linespc
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
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
1270 incr col $o
1271 incr row -1
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]
1289 lappend coords $x $y
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]
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
1322 proc drawparentlinks {id row col olds} {
1323 global rowidlist canv colormap idrowranges
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
1338 set x2 [xc $row2 $i]
1339 if {$x2 > $rmx} {
1340 set rmx $x2
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
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
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
1362 return $rmx
1365 proc drawlines {id} {
1366 global colormap canv
1367 global idrowranges idrangedrawn
1368 global childlist iddrawn commitrow rowidlist
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
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]
1388 proc 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
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
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]
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
1432 proc drawcmitrow {row} {
1433 global displayorder rowidlist
1434 global idrowranges idrangedrawn iddrawn
1435 global commitinfo commitlisted parentlist numcommits
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
1450 break
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
1462 if {![info exists commitinfo($id)]} {
1463 getcommit $id
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
1472 drawcmittext $id $row $col $rmx
1473 set iddrawn($id) 1
1476 proc drawfrac {f0 f1} {
1477 global numcommits canv
1478 global linespc
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
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}]
1492 for {} {$row <= $endrow} {incr row} {
1493 drawcmitrow $row
1497 proc drawvisible {} {
1498 global canv
1499 eval drawfrac [$canv yview]
1502 proc clear_display {} {
1503 global iddrawn idrangedrawn
1505 allcanvs delete all
1506 catch {unset iddrawn}
1507 catch {unset idrangedrawn}
1510 proc assigncolor {id} {
1511 global colormap colors nextcolor
1512 global commitrow parentlist children childlist
1513 global cornercrossings crossings
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 {}
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
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)
1540 if {[llength $badcolors] >= $ncolors} {
1541 set badcolors {}
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)
1553 if {[llength $badcolors] >= $ncolors} {
1554 set badcolors $origbad
1557 set origbad $badcolors
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)
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)
1572 if {[llength $badcolors] >= $ncolors} {
1573 set badcolors $origbad
1576 for {set i 0} {$i <= $ncolors} {incr i} {
1577 set c [lindex $colors $nextcolor]
1578 if {[incr nextcolor] >= $ncolors} {
1579 set nextcolor 0
1581 if {[lsearch -exact $badcolors $c]} break
1583 set colormap($id) $c
1586 proc bindline {t id} {
1587 global canv
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"
1595 proc drawtags {id x xt y1} {
1596 global idtags idheads idotherrefs
1597 global linespc lthickness
1598 global canv mainfont commitrow rowtextx
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]
1607 if {[info exists idheads($id)]} {
1608 set marks [concat $marks $idheads($id)]
1609 set nheads [llength $idheads($id)]
1611 if {[info exists idotherrefs($id)]} {
1612 set marks [concat $marks $idotherrefs($id)]
1614 if {$marks eq {}} {
1615 return $xt
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}]
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"
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
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]
1659 return $xt
1662 proc checkcrossings {row endrow} {
1663 global displayorder parentlist rowidlist
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}]
1683 proc notecrossings {row id lo hi corner} {
1684 global rowidlist crossings cornercrossings
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
1694 if {![info exists cornercrossings($p)]
1695 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1696 lappend cornercrossings($p) $id
1698 } else {
1699 if {![info exists crossings($id)]
1700 || [lsearch -exact $crossings($id) $p] < 0} {
1701 lappend crossings($id) $p
1703 if {![info exists crossings($p)]
1704 || [lsearch -exact $crossings($p) $id] < 0} {
1705 lappend crossings($p) $id
1711 proc xcoord {i level ln} {
1712 global canvx0 xspc1 xspc2
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)}]
1720 return $x
1723 proc finishcommits {} {
1724 global commitidx phase
1725 global canv mainfont ctext maincursor textcursor
1726 global findinprogress
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
1735 if {![info exists findinprogress]} {
1736 . config -cursor $maincursor
1737 settextcursor $textcursor
1739 set phase {}
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.
1744 proc settextcursor {c} {
1745 global ctext curtextcursor
1747 if {[$ctext cget -cursor] == $curtextcursor} {
1748 $ctext config -cursor $c
1750 set curtextcursor $c
1753 proc drawrest {} {
1754 global numcommits
1755 global startmsecs
1756 global canvy0 numcommits linespc
1757 global rowlaidout commitidx
1759 set row $rowlaidout
1760 layoutrows $rowlaidout $commitidx 1
1761 layouttail
1762 optimize_rows $row 0 $commitidx
1763 showstuff $commitidx
1765 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1766 puts "overall $drawmsecs ms for $numcommits commits"
1769 proc 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
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}]
1786 return $matches
1789 proc 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
1796 stopfindproc
1797 unmarkmatches
1798 focus .
1799 set matchinglines {}
1800 if {$findloc == "Pickaxe"} {
1801 findpatches
1802 return
1804 if {$findtype == "IgnCase"} {
1805 set foundstring [string tolower $findstring]
1806 } else {
1807 set foundstring $findstring
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
1817 if {![info exists selectedline]} {
1818 set oldsel -1
1819 } else {
1820 set oldsel $selectedline
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]
1835 if {!$doesmatch} continue
1836 if {![info exists commitinfo($id)]} {
1837 getcommit $id
1839 set info $commitinfo($id)
1840 set doesmatch 0
1841 foreach f $info ty $fldtypes {
1842 if {$findloc != "All fields" && $findloc != $ty} {
1843 continue
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
1859 if {$doesmatch} {
1860 lappend matchinglines $l
1861 if {!$didsel && $l > $oldsel} {
1862 findselectline $l
1863 set didsel 1
1867 if {$matchinglines == {}} {
1868 bell
1869 } elseif {!$didsel} {
1870 findselectline [lindex $matchinglines 0]
1874 proc 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"
1889 proc findnext {restart} {
1890 global matchinglines selectedline
1891 if {![info exists matchinglines]} {
1892 if {$restart} {
1893 dofind
1895 return
1897 if {![info exists selectedline]} return
1898 foreach l $matchinglines {
1899 if {$l > $selectedline} {
1900 findselectline $l
1901 return
1904 bell
1907 proc findprev {} {
1908 global matchinglines selectedline
1909 if {![info exists matchinglines]} {
1910 dofind
1911 return
1913 if {![info exists selectedline]} return
1914 set prev {}
1915 foreach l $matchinglines {
1916 if {$l >= $selectedline} break
1917 set prev $l
1919 if {$prev != {}} {
1920 findselectline $prev
1921 } else {
1922 bell
1926 proc 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
1934 $findtypemenu entryconf 1 -state $state
1935 $findtypemenu entryconf 2 -state $state
1938 proc stopfindproc {{done 0}} {
1939 global findprocpid findprocfile findids
1940 global ctext findoldcursor phase maincursor textcursor
1941 global findinprogress
1943 catch {unset findids}
1944 if {[info exists findprocpid]} {
1945 if {!$done} {
1946 catch {exec kill $findprocpid}
1948 catch {close $findprocfile}
1949 unset findprocpid
1951 if {[info exists findinprogress]} {
1952 unset findinprogress
1953 if {$phase != "incrdraw"} {
1954 . config -cursor $maincursor
1955 settextcursor $textcursor
1960 proc findpatches {} {
1961 global findstring selectedline numcommits
1962 global findprocpid findprocfile
1963 global finddidsel ctext displayorder findinprogress
1964 global findinsertpos
1966 if {$numcommits == 0} return
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
1975 set inputids {}
1976 for {set i 0} {$i < $numcommits} {incr i} {
1977 if {[incr l] >= $numcommits} {
1978 set l 0
1980 append inputids [lindex $displayorder $l] "\n"
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
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
2002 proc readfindproc {} {
2003 global findprocfile finddidsel
2004 global commitrow matchinglines findinsertpos
2006 set n [gets $findprocfile line]
2007 if {$n < 0} {
2008 if {[eof $findprocfile]} {
2009 stopfindproc 1
2010 if {!$finddidsel} {
2011 bell
2014 return
2016 if {![regexp {^[0-9a-f]{40}} $line id]} {
2017 error_popup "Can't parse git-diff-tree output: $line"
2018 stopfindproc
2019 return
2021 if {![info exists commitrow($id)]} {
2022 puts stderr "spurious id: $id"
2023 return
2025 set l $commitrow($id)
2026 insertmatch $l $id
2029 proc insertmatch {l id} {
2030 global matchinglines findinsertpos finddidsel
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
2039 } else {
2040 set matchinglines [linsert $matchinglines $findinsertpos $l]
2041 incr findinsertpos
2043 markheadline $l $id
2044 if {!$finddidsel} {
2045 findselectline $l
2046 set finddidsel 1
2050 proc 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
2057 if {$numcommits == 0} return
2059 if {[info exists selectedline]} {
2060 set l [expr {$selectedline + 1}]
2061 } else {
2062 set l 0
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
2076 if {[incr l] >= $numcommits} {
2077 set l 0
2079 if {$l == $findstartline} break
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
2090 catch {unset fdiffid}
2091 set fdiffpos 0
2092 fconfigure $df -blocking 0
2093 fileevent $df readable [list readfilediffs $df]
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
2106 proc readfilediffs {df} {
2107 global findid fdiffid fdiffs
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"
2124 return
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]
2136 proc donefilediff {} {
2137 global fdiffid fdiffs treediffs findid
2138 global fdiffsneeded fdiffpos
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
2151 incr fdiffpos
2153 incr fdiffpos
2155 if {![info exists treediffs($fdiffid)]} {
2156 set treediffs($fdiffid) $fdiffs
2158 if {[info exists findid] && $fdiffid eq $findid} {
2159 unset findid
2160 findcont
2165 proc findcont {id} {
2166 global findid treediffs parentlist
2167 global ffileline findstartline finddidsel
2168 global displayorder numcommits matchinglines findinprogress
2169 global findmergefiles
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
2180 set doesmatch 0
2181 foreach f $treediffs($id) {
2182 set x [findmatches $f]
2183 if {$x != {}} {
2184 set doesmatch 1
2185 break
2188 if {$doesmatch} {
2189 insertmatch $l $id
2192 if {[incr l] >= $numcommits} {
2193 set l 0
2195 if {$l == $findstartline} break
2197 stopfindproc
2198 if {!$finddidsel} {
2199 bell
2203 # mark a commit as matching by putting a yellow background
2204 # behind the headline
2205 proc markheadline {l id} {
2206 global canv mainfont linehtag
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
2214 # mark the bits of a headline, author or date that match a find string
2215 proc 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
2233 proc unmarkmatches {} {
2234 global matchinglines findids
2235 allcanvs delete matches
2236 catch {unset matchinglines}
2237 catch {unset findids}
2240 proc 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
2251 if {$w eq $canv} {
2252 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2254 unmarkmatches
2255 selectline $l 1
2258 proc commit_descriptor {p} {
2259 global commitinfo
2260 set l "..."
2261 if {[info exists commitinfo($p)]} {
2262 set l [lindex $commitinfo($p) 0]
2264 return "$p ($l)"
2267 # append some text to the ctext widget, and make any SHA1 ID
2268 # that we know about be a clickable link.
2269 proc appendwithlinks {text} {
2270 global ctext commitrow linknum
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
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 }
2292 proc 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
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}]
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}]
2331 if {$newtop != $wtop} {
2332 if {$newtop < 0} {
2333 set newtop 0
2335 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2336 drawvisible
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
2353 if {$isnew} {
2354 addtohistory [list selectline $l 0]
2357 set selectedline $l
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
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"
2381 $ctext insert end "\n"
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
2394 $ctext insert end "Parent: " $tag
2395 appendwithlinks [commit_descriptor $p]
2396 incr np
2398 } else {
2399 foreach p $olds {
2400 append comment "Parent: [commit_descriptor $p]\n"
2404 foreach c [lindex $childlist $l] {
2405 append comment "Child: [commit_descriptor $c]\n"
2407 append comment "\n"
2408 append comment [lindex $info 5]
2410 # make anything that looks like a SHA1 ID be a clickable link
2411 appendwithlinks $comment
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"]
2418 $cflist delete 0 end
2419 $cflist insert end "Comments"
2420 if {[llength $olds] <= 1} {
2421 startdiff $id
2422 } else {
2423 mergediff $id $l
2427 proc selnextline {dir} {
2428 global selectedline
2429 if {![info exists selectedline]} return
2430 set l [expr {$selectedline + $dir}]
2431 unmarkmatches
2432 selectline $l 1
2435 proc unselectline {} {
2436 global selectedline
2438 catch {unset selectedline}
2439 allcanvs delete secsel
2442 proc addtohistory {cmd} {
2443 global history historyindex
2445 if {$historyindex > 0
2446 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2447 return
2450 if {$historyindex < [llength $history]} {
2451 set history [lreplace $history $historyindex end $cmd]
2452 } else {
2453 lappend history $cmd
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
2461 .ctop.top.bar.rightbut conf -state disabled
2464 proc goback {} {
2465 global history historyindex
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
2473 if {$historyindex <= 1} {
2474 .ctop.top.bar.leftbut conf -state disabled
2478 proc goforw {} {
2479 global history historyindex
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
2487 if {$historyindex >= [llength $history]} {
2488 .ctop.top.bar.rightbut conf -state disabled
2492 proc mergediff {id l} {
2493 global diffmergeid diffopts mdifffd
2494 global difffilestart diffids
2495 global parentlist
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
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}]
2514 proc getmergediffline {mdf id np} {
2515 global diffmergeid ctext cflist nextupdate mergemax
2516 global difffilestart mdifffd
2518 set n [gets $mdf line]
2519 if {$n < 0} {
2520 if {[eof $mdf]} {
2521 close $mdf
2523 return
2525 if {![info exists diffmergeid] || $id != $diffmergeid
2526 || $mdf != $mdifffd($id)} {
2527 return
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
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]
2575 if {$num ne {}} {
2576 if {$num >= $mergemax} {
2577 set num "max"
2579 lappend tags m$num
2581 $ctext insert end "$line\n" $tags
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]
2592 proc startdiff {ids} {
2593 global treediffs diffids treepending diffmergeid
2595 set diffids $ids
2596 catch {unset diffmergeid}
2597 if {![info exists treediffs($ids)]} {
2598 if {![info exists treepending]} {
2599 gettreediffs $ids
2601 } else {
2602 addtocflist $ids
2606 proc addtocflist {ids} {
2607 global treediffs cflist
2608 foreach f $treediffs($ids) {
2609 $cflist insert end $f
2611 getblobdiffs $ids
2614 proc 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]
2625 proc gettreediffline {gdtf ids} {
2626 global treediff treediffs treepending diffids diffmergeid
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
2638 } else {
2639 addtocflist $ids
2641 return
2643 set file [lindex $line 5]
2644 lappend treediff $file
2647 proc getblobdiffs {ids} {
2648 global diffopts blobdifffd diffids env curdifftag curtagstart
2649 global difffilestart nextupdate diffinhdr treediffs
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
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}]
2667 proc getblobdiffline {bdf ids} {
2668 global diffids blobdifffd ctext curdifftag curtagstart
2669 global diffnexthead diffnextnote difffilestart
2670 global nextupdate diffinhdr treediffs
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
2680 return
2682 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2683 return
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
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
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
2741 $ctext insert end "$line\n" filesep
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}"
2753 proc 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)
2764 if {[info exists pos]} {
2765 $ctext yview $pos
2769 proc 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}
2778 proc setcoords {} {
2779 global linespc charspc canvx0 canvy0 mainfont
2780 global xspc1 xspc2 lthickness
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
2791 proc redisplay {} {
2792 global canv
2793 global selectedline
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
2807 proc 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
2820 if {$phase == "getcommits"} {
2821 $canv itemconf textitems -font $mainfont
2823 redisplay
2826 proc clearsha1 {} {
2827 global sha1entry sha1string
2828 if {[string length $sha1string] == 40} {
2829 $sha1entry delete 0 end
2833 proc 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
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: "
2849 proc gotocommit {} {
2850 global sha1string currentid commitrow tagids
2851 global displayorder numcommits
2853 if {$sha1string == {}
2854 || ([info exists currentid] && $sha1string == $currentid)} return
2855 if {[info exists tagids($sha1string)]} {
2856 set id $tagids($sha1string)
2857 } else {
2858 set id [string tolower $sha1string]
2859 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2860 set matches {}
2861 foreach i $displayorder {
2862 if {[string match $id* $i]} {
2863 lappend matches $i
2866 if {$matches ne {}} {
2867 if {[llength $matches] > 1} {
2868 error_popup "Short SHA1 id $id is ambiguous"
2869 return
2871 set id [lindex $matches 0]
2875 if {[info exists commitrow($id)]} {
2876 selectline $commitrow($id) 1
2877 return
2879 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2880 set type "SHA1 id"
2881 } else {
2882 set type "Tag"
2884 error_popup "$type $sha1string is not known"
2887 proc lineenter {x y id} {
2888 global hoverx hovery hoverid hovertimer
2889 global commitinfo canv
2891 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2892 set hoverx $x
2893 set hovery $y
2894 set hoverid $id
2895 if {[info exists hovertimer]} {
2896 after cancel $hovertimer
2898 set hovertimer [after 500 linehover]
2899 $canv delete hover
2902 proc linemotion {x y id} {
2903 global hoverx hovery hoverid hovertimer
2905 if {[info exists hoverid] && $id == $hoverid} {
2906 set hoverx $x
2907 set hovery $y
2908 if {[info exists hovertimer]} {
2909 after cancel $hovertimer
2911 set hovertimer [after 500 linehover]
2915 proc lineleave {id} {
2916 global hoverid hovertimer canv
2918 if {[info exists hoverid] && $id == $hoverid} {
2919 $canv delete hover
2920 if {[info exists hovertimer]} {
2921 after cancel $hovertimer
2922 unset hovertimer
2924 unset hoverid
2928 proc linehover {} {
2929 global hoverx hovery hoverid hovertimer
2930 global canv linespc lthickness
2931 global commitinfo mainfont
2933 set text [lindex $commitinfo($hoverid) 0]
2934 set ymax [lindex [$canv cget -scrollregion] 3]
2935 if {$ymax == {}} return
2936 set yfrac [lindex [$canv yview] 0]
2937 set x [expr {$hoverx + 2 * $linespc}]
2938 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2939 set x0 [expr {$x - 2 * $lthickness}]
2940 set y0 [expr {$y - 2 * $lthickness}]
2941 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2942 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2943 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2944 -fill \#ffff80 -outline black -width 1 -tags hover]
2945 $canv raise $t
2946 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2947 $canv raise $t
2950 proc clickisonarrow {id y} {
2951 global lthickness idrowranges
2953 set thresh [expr {2 * $lthickness + 6}]
2954 set n [expr {[llength $idrowranges($id)] - 1}]
2955 for {set i 1} {$i < $n} {incr i} {
2956 set row [lindex $idrowranges($id) $i]
2957 if {abs([yc $row] - $y) < $thresh} {
2958 return $i
2961 return {}
2964 proc arrowjump {id n y} {
2965 global idrowranges canv
2967 # 1 <-> 2, 3 <-> 4, etc...
2968 set n [expr {(($n - 1) ^ 1) + 1}]
2969 set row [lindex $idrowranges($id) $n]
2970 set yt [yc $row]
2971 set ymax [lindex [$canv cget -scrollregion] 3]
2972 if {$ymax eq {} || $ymax <= 0} return
2973 set view [$canv yview]
2974 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2975 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2976 if {$yfrac < 0} {
2977 set yfrac 0
2979 allcanvs yview moveto $yfrac
2982 proc lineclick {x y id isnew} {
2983 global ctext commitinfo childlist commitrow cflist canv thickerline
2985 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2986 unmarkmatches
2987 unselectline
2988 normalline
2989 $canv delete hover
2990 # draw this line thicker than normal
2991 set thickerline $id
2992 drawlines $id
2993 if {$isnew} {
2994 set ymax [lindex [$canv cget -scrollregion] 3]
2995 if {$ymax eq {}} return
2996 set yfrac [lindex [$canv yview] 0]
2997 set y [expr {$y + $yfrac * $ymax}]
2999 set dirn [clickisonarrow $id $y]
3000 if {$dirn ne {}} {
3001 arrowjump $id $dirn $y
3002 return
3005 if {$isnew} {
3006 addtohistory [list lineclick $x $y $id 0]
3008 # fill the details pane with info about this line
3009 $ctext conf -state normal
3010 $ctext delete 0.0 end
3011 $ctext tag conf link -foreground blue -underline 1
3012 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3013 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3014 $ctext insert end "Parent:\t"
3015 $ctext insert end $id [list link link0]
3016 $ctext tag bind link0 <1> [list selbyid $id]
3017 set info $commitinfo($id)
3018 $ctext insert end "\n\t[lindex $info 0]\n"
3019 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3020 set date [formatdate [lindex $info 2]]
3021 $ctext insert end "\tDate:\t$date\n"
3022 set kids [lindex $childlist $commitrow($id)]
3023 if {$kids ne {}} {
3024 $ctext insert end "\nChildren:"
3025 set i 0
3026 foreach child $kids {
3027 incr i
3028 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3029 set info $commitinfo($child)
3030 $ctext insert end "\n\t"
3031 $ctext insert end $child [list link link$i]
3032 $ctext tag bind link$i <1> [list selbyid $child]
3033 $ctext insert end "\n\t[lindex $info 0]"
3034 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3035 set date [formatdate [lindex $info 2]]
3036 $ctext insert end "\n\tDate:\t$date\n"
3039 $ctext conf -state disabled
3041 $cflist delete 0 end
3044 proc normalline {} {
3045 global thickerline
3046 if {[info exists thickerline]} {
3047 set id $thickerline
3048 unset thickerline
3049 drawlines $id
3053 proc selbyid {id} {
3054 global commitrow
3055 if {[info exists commitrow($id)]} {
3056 selectline $commitrow($id) 1
3060 proc mstime {} {
3061 global startmstime
3062 if {![info exists startmstime]} {
3063 set startmstime [clock clicks -milliseconds]
3065 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3068 proc rowmenu {x y id} {
3069 global rowctxmenu commitrow selectedline rowmenuid
3071 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3072 set state disabled
3073 } else {
3074 set state normal
3076 $rowctxmenu entryconfigure 0 -state $state
3077 $rowctxmenu entryconfigure 1 -state $state
3078 $rowctxmenu entryconfigure 2 -state $state
3079 set rowmenuid $id
3080 tk_popup $rowctxmenu $x $y
3083 proc diffvssel {dirn} {
3084 global rowmenuid selectedline displayorder
3086 if {![info exists selectedline]} return
3087 if {$dirn} {
3088 set oldid [lindex $displayorder $selectedline]
3089 set newid $rowmenuid
3090 } else {
3091 set oldid $rowmenuid
3092 set newid [lindex $displayorder $selectedline]
3094 addtohistory [list doseldiff $oldid $newid]
3095 doseldiff $oldid $newid
3098 proc doseldiff {oldid newid} {
3099 global ctext cflist
3100 global commitinfo
3102 $ctext conf -state normal
3103 $ctext delete 0.0 end
3104 $ctext mark set fmark.0 0.0
3105 $ctext mark gravity fmark.0 left
3106 $cflist delete 0 end
3107 $cflist insert end "Top"
3108 $ctext insert end "From "
3109 $ctext tag conf link -foreground blue -underline 1
3110 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3111 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3112 $ctext tag bind link0 <1> [list selbyid $oldid]
3113 $ctext insert end $oldid [list link link0]
3114 $ctext insert end "\n "
3115 $ctext insert end [lindex $commitinfo($oldid) 0]
3116 $ctext insert end "\n\nTo "
3117 $ctext tag bind link1 <1> [list selbyid $newid]
3118 $ctext insert end $newid [list link link1]
3119 $ctext insert end "\n "
3120 $ctext insert end [lindex $commitinfo($newid) 0]
3121 $ctext insert end "\n"
3122 $ctext conf -state disabled
3123 $ctext tag delete Comments
3124 $ctext tag remove found 1.0 end
3125 startdiff [list $oldid $newid]
3128 proc mkpatch {} {
3129 global rowmenuid currentid commitinfo patchtop patchnum
3131 if {![info exists currentid]} return
3132 set oldid $currentid
3133 set oldhead [lindex $commitinfo($oldid) 0]
3134 set newid $rowmenuid
3135 set newhead [lindex $commitinfo($newid) 0]
3136 set top .patch
3137 set patchtop $top
3138 catch {destroy $top}
3139 toplevel $top
3140 label $top.title -text "Generate patch"
3141 grid $top.title - -pady 10
3142 label $top.from -text "From:"
3143 entry $top.fromsha1 -width 40 -relief flat
3144 $top.fromsha1 insert 0 $oldid
3145 $top.fromsha1 conf -state readonly
3146 grid $top.from $top.fromsha1 -sticky w
3147 entry $top.fromhead -width 60 -relief flat
3148 $top.fromhead insert 0 $oldhead
3149 $top.fromhead conf -state readonly
3150 grid x $top.fromhead -sticky w
3151 label $top.to -text "To:"
3152 entry $top.tosha1 -width 40 -relief flat
3153 $top.tosha1 insert 0 $newid
3154 $top.tosha1 conf -state readonly
3155 grid $top.to $top.tosha1 -sticky w
3156 entry $top.tohead -width 60 -relief flat
3157 $top.tohead insert 0 $newhead
3158 $top.tohead conf -state readonly
3159 grid x $top.tohead -sticky w
3160 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3161 grid $top.rev x -pady 10
3162 label $top.flab -text "Output file:"
3163 entry $top.fname -width 60
3164 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3165 incr patchnum
3166 grid $top.flab $top.fname -sticky w
3167 frame $top.buts
3168 button $top.buts.gen -text "Generate" -command mkpatchgo
3169 button $top.buts.can -text "Cancel" -command mkpatchcan
3170 grid $top.buts.gen $top.buts.can
3171 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3172 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3173 grid $top.buts - -pady 10 -sticky ew
3174 focus $top.fname
3177 proc mkpatchrev {} {
3178 global patchtop
3180 set oldid [$patchtop.fromsha1 get]
3181 set oldhead [$patchtop.fromhead get]
3182 set newid [$patchtop.tosha1 get]
3183 set newhead [$patchtop.tohead get]
3184 foreach e [list fromsha1 fromhead tosha1 tohead] \
3185 v [list $newid $newhead $oldid $oldhead] {
3186 $patchtop.$e conf -state normal
3187 $patchtop.$e delete 0 end
3188 $patchtop.$e insert 0 $v
3189 $patchtop.$e conf -state readonly
3193 proc mkpatchgo {} {
3194 global patchtop
3196 set oldid [$patchtop.fromsha1 get]
3197 set newid [$patchtop.tosha1 get]
3198 set fname [$patchtop.fname get]
3199 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3200 error_popup "Error creating patch: $err"
3202 catch {destroy $patchtop}
3203 unset patchtop
3206 proc mkpatchcan {} {
3207 global patchtop
3209 catch {destroy $patchtop}
3210 unset patchtop
3213 proc mktag {} {
3214 global rowmenuid mktagtop commitinfo
3216 set top .maketag
3217 set mktagtop $top
3218 catch {destroy $top}
3219 toplevel $top
3220 label $top.title -text "Create tag"
3221 grid $top.title - -pady 10
3222 label $top.id -text "ID:"
3223 entry $top.sha1 -width 40 -relief flat
3224 $top.sha1 insert 0 $rowmenuid
3225 $top.sha1 conf -state readonly
3226 grid $top.id $top.sha1 -sticky w
3227 entry $top.head -width 60 -relief flat
3228 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3229 $top.head conf -state readonly
3230 grid x $top.head -sticky w
3231 label $top.tlab -text "Tag name:"
3232 entry $top.tag -width 60
3233 grid $top.tlab $top.tag -sticky w
3234 frame $top.buts
3235 button $top.buts.gen -text "Create" -command mktaggo
3236 button $top.buts.can -text "Cancel" -command mktagcan
3237 grid $top.buts.gen $top.buts.can
3238 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3239 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3240 grid $top.buts - -pady 10 -sticky ew
3241 focus $top.tag
3244 proc domktag {} {
3245 global mktagtop env tagids idtags
3247 set id [$mktagtop.sha1 get]
3248 set tag [$mktagtop.tag get]
3249 if {$tag == {}} {
3250 error_popup "No tag name specified"
3251 return
3253 if {[info exists tagids($tag)]} {
3254 error_popup "Tag \"$tag\" already exists"
3255 return
3257 if {[catch {
3258 set dir [gitdir]
3259 set fname [file join $dir "refs/tags" $tag]
3260 set f [open $fname w]
3261 puts $f $id
3262 close $f
3263 } err]} {
3264 error_popup "Error creating tag: $err"
3265 return
3268 set tagids($tag) $id
3269 lappend idtags($id) $tag
3270 redrawtags $id
3273 proc redrawtags {id} {
3274 global canv linehtag commitrow idpos selectedline
3276 if {![info exists commitrow($id)]} return
3277 drawcmitrow $commitrow($id)
3278 $canv delete tag.$id
3279 set xt [eval drawtags $id $idpos($id)]
3280 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3281 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3282 selectline $selectedline 0
3286 proc mktagcan {} {
3287 global mktagtop
3289 catch {destroy $mktagtop}
3290 unset mktagtop
3293 proc mktaggo {} {
3294 domktag
3295 mktagcan
3298 proc writecommit {} {
3299 global rowmenuid wrcomtop commitinfo wrcomcmd
3301 set top .writecommit
3302 set wrcomtop $top
3303 catch {destroy $top}
3304 toplevel $top
3305 label $top.title -text "Write commit to file"
3306 grid $top.title - -pady 10
3307 label $top.id -text "ID:"
3308 entry $top.sha1 -width 40 -relief flat
3309 $top.sha1 insert 0 $rowmenuid
3310 $top.sha1 conf -state readonly
3311 grid $top.id $top.sha1 -sticky w
3312 entry $top.head -width 60 -relief flat
3313 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3314 $top.head conf -state readonly
3315 grid x $top.head -sticky w
3316 label $top.clab -text "Command:"
3317 entry $top.cmd -width 60 -textvariable wrcomcmd
3318 grid $top.clab $top.cmd -sticky w -pady 10
3319 label $top.flab -text "Output file:"
3320 entry $top.fname -width 60
3321 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3322 grid $top.flab $top.fname -sticky w
3323 frame $top.buts
3324 button $top.buts.gen -text "Write" -command wrcomgo
3325 button $top.buts.can -text "Cancel" -command wrcomcan
3326 grid $top.buts.gen $top.buts.can
3327 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3328 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3329 grid $top.buts - -pady 10 -sticky ew
3330 focus $top.fname
3333 proc wrcomgo {} {
3334 global wrcomtop
3336 set id [$wrcomtop.sha1 get]
3337 set cmd "echo $id | [$wrcomtop.cmd get]"
3338 set fname [$wrcomtop.fname get]
3339 if {[catch {exec sh -c $cmd >$fname &} err]} {
3340 error_popup "Error writing commit: $err"
3342 catch {destroy $wrcomtop}
3343 unset wrcomtop
3346 proc wrcomcan {} {
3347 global wrcomtop
3349 catch {destroy $wrcomtop}
3350 unset wrcomtop
3353 proc listrefs {id} {
3354 global idtags idheads idotherrefs
3356 set x {}
3357 if {[info exists idtags($id)]} {
3358 set x $idtags($id)
3360 set y {}
3361 if {[info exists idheads($id)]} {
3362 set y $idheads($id)
3364 set z {}
3365 if {[info exists idotherrefs($id)]} {
3366 set z $idotherrefs($id)
3368 return [list $x $y $z]
3371 proc rereadrefs {} {
3372 global idtags idheads idotherrefs
3373 global tagids headids otherrefids
3375 set refids [concat [array names idtags] \
3376 [array names idheads] [array names idotherrefs]]
3377 foreach id $refids {
3378 if {![info exists ref($id)]} {
3379 set ref($id) [listrefs $id]
3382 readrefs
3383 set refids [lsort -unique [concat $refids [array names idtags] \
3384 [array names idheads] [array names idotherrefs]]]
3385 foreach id $refids {
3386 set v [listrefs $id]
3387 if {![info exists ref($id)] || $ref($id) != $v} {
3388 redrawtags $id
3393 proc showtag {tag isnew} {
3394 global ctext cflist tagcontents tagids linknum
3396 if {$isnew} {
3397 addtohistory [list showtag $tag 0]
3399 $ctext conf -state normal
3400 $ctext delete 0.0 end
3401 set linknum 0
3402 if {[info exists tagcontents($tag)]} {
3403 set text $tagcontents($tag)
3404 } else {
3405 set text "Tag: $tag\nId: $tagids($tag)"
3407 appendwithlinks $text
3408 $ctext conf -state disabled
3409 $cflist delete 0 end
3412 proc doquit {} {
3413 global stopped
3414 set stopped 100
3415 destroy .
3418 proc doprefs {} {
3419 global maxwidth maxgraphpct diffopts findmergefiles
3420 global oldprefs prefstop
3422 set top .gitkprefs
3423 set prefstop $top
3424 if {[winfo exists $top]} {
3425 raise $top
3426 return
3428 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3429 set oldprefs($v) [set $v]
3431 toplevel $top
3432 wm title $top "Gitk preferences"
3433 label $top.ldisp -text "Commit list display options"
3434 grid $top.ldisp - -sticky w -pady 10
3435 label $top.spacer -text " "
3436 label $top.maxwidthl -text "Maximum graph width (lines)" \
3437 -font optionfont
3438 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3439 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3440 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3441 -font optionfont
3442 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3443 grid x $top.maxpctl $top.maxpct -sticky w
3444 checkbutton $top.findm -variable findmergefiles
3445 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3446 -font optionfont
3447 grid $top.findm $top.findml - -sticky w
3448 label $top.ddisp -text "Diff display options"
3449 grid $top.ddisp - -sticky w -pady 10
3450 label $top.diffoptl -text "Options for diff program" \
3451 -font optionfont
3452 entry $top.diffopt -width 20 -textvariable diffopts
3453 grid x $top.diffoptl $top.diffopt -sticky w
3454 frame $top.buts
3455 button $top.buts.ok -text "OK" -command prefsok
3456 button $top.buts.can -text "Cancel" -command prefscan
3457 grid $top.buts.ok $top.buts.can
3458 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3459 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3460 grid $top.buts - - -pady 10 -sticky ew
3463 proc prefscan {} {
3464 global maxwidth maxgraphpct diffopts findmergefiles
3465 global oldprefs prefstop
3467 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3468 set $v $oldprefs($v)
3470 catch {destroy $prefstop}
3471 unset prefstop
3474 proc prefsok {} {
3475 global maxwidth maxgraphpct
3476 global oldprefs prefstop
3478 catch {destroy $prefstop}
3479 unset prefstop
3480 if {$maxwidth != $oldprefs(maxwidth)
3481 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3482 redisplay
3486 proc formatdate {d} {
3487 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3490 # This list of encoding names and aliases is distilled from
3491 # http://www.iana.org/assignments/character-sets.
3492 # Not all of them are supported by Tcl.
3493 set encoding_aliases {
3494 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3495 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3496 { ISO-10646-UTF-1 csISO10646UTF1 }
3497 { ISO_646.basic:1983 ref csISO646basic1983 }
3498 { INVARIANT csINVARIANT }
3499 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3500 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3501 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3502 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3503 { NATS-DANO iso-ir-9-1 csNATSDANO }
3504 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3505 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3506 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3507 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3508 { ISO-2022-KR csISO2022KR }
3509 { EUC-KR csEUCKR }
3510 { ISO-2022-JP csISO2022JP }
3511 { ISO-2022-JP-2 csISO2022JP2 }
3512 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3513 csISO13JISC6220jp }
3514 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3515 { IT iso-ir-15 ISO646-IT csISO15Italian }
3516 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3517 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3518 { greek7-old iso-ir-18 csISO18Greek7Old }
3519 { latin-greek iso-ir-19 csISO19LatinGreek }
3520 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3521 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3522 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3523 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3524 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3525 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3526 { INIS iso-ir-49 csISO49INIS }
3527 { INIS-8 iso-ir-50 csISO50INIS8 }
3528 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3529 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3530 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3531 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3532 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3533 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3534 csISO60Norwegian1 }
3535 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3536 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3537 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3538 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3539 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3540 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3541 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3542 { greek7 iso-ir-88 csISO88Greek7 }
3543 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3544 { iso-ir-90 csISO90 }
3545 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3546 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3547 csISO92JISC62991984b }
3548 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3549 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3550 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3551 csISO95JIS62291984handadd }
3552 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3553 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3554 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3555 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3556 CP819 csISOLatin1 }
3557 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3558 { T.61-7bit iso-ir-102 csISO102T617bit }
3559 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3560 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3561 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3562 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3563 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3564 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3565 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3566 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3567 arabic csISOLatinArabic }
3568 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3569 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3570 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3571 greek greek8 csISOLatinGreek }
3572 { T.101-G2 iso-ir-128 csISO128T101G2 }
3573 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3574 csISOLatinHebrew }
3575 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3576 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3577 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3578 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3579 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3580 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3581 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3582 csISOLatinCyrillic }
3583 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3584 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3585 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3586 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3587 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3588 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3589 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3590 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3591 { ISO_10367-box iso-ir-155 csISO10367Box }
3592 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3593 { latin-lap lap iso-ir-158 csISO158Lap }
3594 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3595 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3596 { us-dk csUSDK }
3597 { dk-us csDKUS }
3598 { JIS_X0201 X0201 csHalfWidthKatakana }
3599 { KSC5636 ISO646-KR csKSC5636 }
3600 { ISO-10646-UCS-2 csUnicode }
3601 { ISO-10646-UCS-4 csUCS4 }
3602 { DEC-MCS dec csDECMCS }
3603 { hp-roman8 roman8 r8 csHPRoman8 }
3604 { macintosh mac csMacintosh }
3605 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3606 csIBM037 }
3607 { IBM038 EBCDIC-INT cp038 csIBM038 }
3608 { IBM273 CP273 csIBM273 }
3609 { IBM274 EBCDIC-BE CP274 csIBM274 }
3610 { IBM275 EBCDIC-BR cp275 csIBM275 }
3611 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3612 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3613 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3614 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3615 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3616 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3617 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3618 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3619 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3620 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3621 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3622 { IBM437 cp437 437 csPC8CodePage437 }
3623 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3624 { IBM775 cp775 csPC775Baltic }
3625 { IBM850 cp850 850 csPC850Multilingual }
3626 { IBM851 cp851 851 csIBM851 }
3627 { IBM852 cp852 852 csPCp852 }
3628 { IBM855 cp855 855 csIBM855 }
3629 { IBM857 cp857 857 csIBM857 }
3630 { IBM860 cp860 860 csIBM860 }
3631 { IBM861 cp861 861 cp-is csIBM861 }
3632 { IBM862 cp862 862 csPC862LatinHebrew }
3633 { IBM863 cp863 863 csIBM863 }
3634 { IBM864 cp864 csIBM864 }
3635 { IBM865 cp865 865 csIBM865 }
3636 { IBM866 cp866 866 csIBM866 }
3637 { IBM868 CP868 cp-ar csIBM868 }
3638 { IBM869 cp869 869 cp-gr csIBM869 }
3639 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3640 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3641 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3642 { IBM891 cp891 csIBM891 }
3643 { IBM903 cp903 csIBM903 }
3644 { IBM904 cp904 904 csIBBM904 }
3645 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3646 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3647 { IBM1026 CP1026 csIBM1026 }
3648 { EBCDIC-AT-DE csIBMEBCDICATDE }
3649 { EBCDIC-AT-DE-A csEBCDICATDEA }
3650 { EBCDIC-CA-FR csEBCDICCAFR }
3651 { EBCDIC-DK-NO csEBCDICDKNO }
3652 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3653 { EBCDIC-FI-SE csEBCDICFISE }
3654 { EBCDIC-FI-SE-A csEBCDICFISEA }
3655 { EBCDIC-FR csEBCDICFR }
3656 { EBCDIC-IT csEBCDICIT }
3657 { EBCDIC-PT csEBCDICPT }
3658 { EBCDIC-ES csEBCDICES }
3659 { EBCDIC-ES-A csEBCDICESA }
3660 { EBCDIC-ES-S csEBCDICESS }
3661 { EBCDIC-UK csEBCDICUK }
3662 { EBCDIC-US csEBCDICUS }
3663 { UNKNOWN-8BIT csUnknown8BiT }
3664 { MNEMONIC csMnemonic }
3665 { MNEM csMnem }
3666 { VISCII csVISCII }
3667 { VIQR csVIQR }
3668 { KOI8-R csKOI8R }
3669 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3670 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3671 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3672 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3673 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3674 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3675 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3676 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3677 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3678 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3679 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3680 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3681 { IBM1047 IBM-1047 }
3682 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3683 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3684 { UNICODE-1-1 csUnicode11 }
3685 { CESU-8 csCESU-8 }
3686 { BOCU-1 csBOCU-1 }
3687 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3688 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3689 l8 }
3690 { ISO-8859-15 ISO_8859-15 Latin-9 }
3691 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3692 { GBK CP936 MS936 windows-936 }
3693 { JIS_Encoding csJISEncoding }
3694 { Shift_JIS MS_Kanji csShiftJIS }
3695 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3696 EUC-JP }
3697 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3698 { ISO-10646-UCS-Basic csUnicodeASCII }
3699 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3700 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3701 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3702 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3703 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3704 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3705 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3706 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3707 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3708 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3709 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3710 { Ventura-US csVenturaUS }
3711 { Ventura-International csVenturaInternational }
3712 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3713 { PC8-Turkish csPC8Turkish }
3714 { IBM-Symbols csIBMSymbols }
3715 { IBM-Thai csIBMThai }
3716 { HP-Legal csHPLegal }
3717 { HP-Pi-font csHPPiFont }
3718 { HP-Math8 csHPMath8 }
3719 { Adobe-Symbol-Encoding csHPPSMath }
3720 { HP-DeskTop csHPDesktop }
3721 { Ventura-Math csVenturaMath }
3722 { Microsoft-Publishing csMicrosoftPublishing }
3723 { Windows-31J csWindows31J }
3724 { GB2312 csGB2312 }
3725 { Big5 csBig5 }
3728 proc tcl_encoding {enc} {
3729 global encoding_aliases
3730 set names [encoding names]
3731 set lcnames [string tolower $names]
3732 set enc [string tolower $enc]
3733 set i [lsearch -exact $lcnames $enc]
3734 if {$i < 0} {
3735 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3736 if {[regsub {^iso[-_]} $enc iso encx]} {
3737 set i [lsearch -exact $lcnames $encx]
3740 if {$i < 0} {
3741 foreach l $encoding_aliases {
3742 set ll [string tolower $l]
3743 if {[lsearch -exact $ll $enc] < 0} continue
3744 # look through the aliases for one that tcl knows about
3745 foreach e $ll {
3746 set i [lsearch -exact $lcnames $e]
3747 if {$i < 0} {
3748 if {[regsub {^iso[-_]} $e iso ex]} {
3749 set i [lsearch -exact $lcnames $ex]
3752 if {$i >= 0} break
3754 break
3757 if {$i >= 0} {
3758 return [lindex $names $i]
3760 return {}
3763 # defaults...
3764 set datemode 0
3765 set diffopts "-U 5 -p"
3766 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3768 set gitencoding {}
3769 catch {
3770 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3772 if {$gitencoding == ""} {
3773 set gitencoding "utf-8"
3775 set tclencoding [tcl_encoding $gitencoding]
3776 if {$tclencoding == {}} {
3777 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3780 set mainfont {Helvetica 9}
3781 set textfont {Courier 9}
3782 set findmergefiles 0
3783 set maxgraphpct 50
3784 set maxwidth 16
3785 set revlistorder 0
3786 set fastdate 0
3787 set uparrowlen 7
3788 set downarrowlen 7
3789 set mingaplen 30
3791 set colors {green red blue magenta darkgrey brown orange}
3793 catch {source ~/.gitk}
3795 set namefont $mainfont
3797 font create optionfont -family sans-serif -size -12
3799 set revtreeargs {}
3800 foreach arg $argv {
3801 switch -regexp -- $arg {
3802 "^$" { }
3803 "^-d" { set datemode 1 }
3804 default {
3805 lappend revtreeargs $arg
3810 # check that we can find a .git directory somewhere...
3811 set gitdir [gitdir]
3812 if {![file isdirectory $gitdir]} {
3813 error_popup "Cannot find the git directory \"$gitdir\"."
3814 exit 1
3817 set history {}
3818 set historyindex 0
3820 set optim_delay 16
3822 set stopped 0
3823 set stuffsaved 0
3824 set patchnum 0
3825 setcoords
3826 makewindow $revtreeargs
3827 readrefs
3828 getcommits $revtreeargs