2 # Tcl ignores the next line -*- tcl -*- \
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.
12 if {[info exists env(GIT_DIR)]} {
19 proc parse_args {rargs} {
23 set parse_args [concat --default HEAD $rargs]
24 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
26 # if git-rev-parse failed for some reason...
30 set parsed_args $rargs
35 proc start_rev_list {rlargs} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding
39 set startmsecs [clock clicks -milliseconds]
40 set nextupdate [expr {$startmsecs + 100}]
43 set commfd [open [concat | git-rev-list --header --topo-order \
46 puts stderr "Error executing git-rev-list: $err"
50 fconfigure $commfd -blocking 0 -translation lf
51 if {$tclencoding != {}} {
52 fconfigure $commfd -encoding $tclencoding
54 fileevent $commfd readable [list getcommitlines $commfd]
55 . config -cursor watch
59 proc getcommits {rargs} {
60 global oldcommits commits phase canv mainfont env
62 # check that we can find a .git directory somewhere...
64 if {![file isdirectory $gitdir]} {
65 error_popup "Cannot find the git directory \"$gitdir\"."
71 start_rev_list [parse_args $rargs]
73 $canv create text 3 3 -anchor nw -text "Reading commits..." \
74 -font $mainfont -tags textitems
77 proc getcommitlines {commfd} {
78 global oldcommits commits parents cdate children nchildren
79 global commitlisted phase nextupdate
80 global stopped redisplaying leftover
83 set stuff [read $commfd]
85 if {![eof $commfd]} return
86 # set it blocking so we wait for the process to terminate
87 fconfigure $commfd -blocking 1
88 if {![catch {close $commfd} err]} {
89 after idle finishcommits
92 if {[string range $err 0 4] == "usage"} {
94 "Gitk: error reading commits: bad arguments to git-rev-list.\
95 (Note: arguments to gitk are passed to git-rev-list\
96 to allow selection of commits to be displayed.)"
98 set err "Error reading commits: $err"
105 set i [string first "\0" $stuff $start]
107 append leftover [string range $stuff $start end]
110 set cmit [string range $stuff $start [expr {$i - 1}]]
112 set cmit "$leftover$cmit"
115 set start [expr {$i + 1}]
116 set j [string first "\n" $cmit]
119 set ids [string range $cmit 0 [expr {$j - 1}]]
122 if {![regexp {^[0-9a-f]{40}$} $id]} {
130 if {[string length $shortcmit] > 80} {
131 set shortcmit "[string range $shortcmit 0 80]..."
133 error_popup "Can't parse git-rev-list output: {$shortcmit}"
136 set id [lindex $ids 0]
137 set olds [lrange $ids 1 end]
138 set cmit [string range $cmit [expr {$j + 1}] end]
140 set commitlisted($id) 1
141 parsecommit $id $cmit 1 [lrange $ids 1 end]
143 if {[clock clicks -milliseconds] >= $nextupdate} {
146 while {$redisplaying} {
150 set phase "getcommits"
151 foreach id $commits {
154 if {[clock clicks -milliseconds] >= $nextupdate} {
163 proc doupdate {reading} {
164 global commfd nextupdate numcommits ncmupdate
167 fileevent $commfd readable {}
170 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
171 if {$numcommits < 100} {
172 set ncmupdate [expr {$numcommits + 1}]
173 } elseif {$numcommits < 10000} {
174 set ncmupdate [expr {$numcommits + 10}]
176 set ncmupdate [expr {$numcommits + 100}]
179 fileevent $commfd readable [list getcommitlines $commfd]
183 proc readcommit {id} {
184 if {[catch {set contents [exec git-cat-file commit $id]}]} return
185 parsecommit $id $contents 0 {}
188 proc updatecommits {rargs} {
189 global commitlisted commfd phase
190 global startmsecs nextupdate ncmupdate
191 global idtags idheads idotherrefs
195 global oldcommits commits
196 global parents nchildren children ncleft
198 set old_args $parsed_args
201 if {$phase == "getcommits" || $phase == "incrdraw"} {
202 # havent read all the old commits, just start again from scratch
206 foreach v {children nchildren parents commitlisted commitinfo
207 selectedline matchinglines treediffs
208 mergefilelist currentid rowtextx} {
213 if {$phase == "incrdraw"} {
215 $canv create text 3 3 -anchor nw -text "Reading commits..." \
216 -font $mainfont -tags textitems
219 start_rev_list $parsed_args
223 foreach id $old_args {
224 if {![regexp {^[0-9a-f]{40}$} $id]} continue
225 if {[info exists oldref($id)]} continue
227 lappend ignoreold "^$id"
229 foreach id $parsed_args {
230 if {![regexp {^[0-9a-f]{40}$} $id]} continue
231 if {[info exists ref($id)]} continue
233 lappend ignorenew "^$id"
236 foreach a $old_args {
237 if {![info exists ref($a)]} {
242 set phase updatecommits
243 set oldcommits $commits
245 set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ]
246 if {[llength $removed_commits] > 0} {
248 foreach c $removed_commits {
249 set i [lsearch -exact $oldcommits $c]
251 set oldcommits [lreplace $oldcommits $i $i]
252 unset commitlisted($c)
253 foreach p $parents($c) {
254 if {[info exists nchildren($p)]} {
255 set j [lsearch -exact $children($p) $c]
257 set children($p) [lreplace $children($p) $j $j]
258 incr nchildren($p) -1
264 set phase removecommits
268 foreach a $parsed_args {
269 if {![info exists oldref($a)]} {
275 start_rev_list [concat $ignoreold $args]
278 proc updatechildren {id olds} {
279 global children nchildren parents nparents ncleft
281 if {![info exists nchildren($id)]} {
286 set parents($id) $olds
287 set nparents($id) [llength $olds]
289 if {![info exists nchildren($p)]} {
290 set children($p) [list $id]
293 } elseif {[lsearch -exact $children($p) $id] < 0} {
294 lappend children($p) $id
301 proc parsecommit {id contents listed olds} {
302 global commitinfo cdate
311 updatechildren $id $olds
312 set hdrend [string first "\n\n" $contents]
314 # should never happen...
315 set hdrend [string length $contents]
317 set header [string range $contents 0 [expr {$hdrend - 1}]]
318 set comment [string range $contents [expr {$hdrend + 2}] end]
319 foreach line [split $header "\n"] {
320 set tag [lindex $line 0]
321 if {$tag == "author"} {
322 set audate [lindex $line end-1]
323 set auname [lrange $line 1 end-2]
324 } elseif {$tag == "committer"} {
325 set comdate [lindex $line end-1]
326 set comname [lrange $line 1 end-2]
330 # take the first line of the comment as the headline
331 set i [string first "\n" $comment]
333 set headline [string trim [string range $comment 0 $i]]
335 set headline $comment
338 # git-rev-list indents the comment by 4 spaces;
339 # if we got this via git-cat-file, add the indentation
341 foreach line [split $comment "\n"] {
342 append newcomment " "
343 append newcomment $line
344 append newcomment "\n"
346 set comment $newcomment
348 if {$comdate != {}} {
349 set cdate($id) $comdate
351 set commitinfo($id) [list $headline $auname $audate \
352 $comname $comdate $comment]
356 global tagids idtags headids idheads tagcontents
357 global otherrefids idotherrefs
359 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
362 set refd [open [list | git-ls-remote [gitdir]] r]
363 while {0 <= [set n [gets $refd line]]} {
364 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
368 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
372 if {$type == "tags"} {
373 set tagids($name) $id
374 lappend idtags($id) $name
379 set commit [exec git-rev-parse "$id^0"]
380 if {"$commit" != "$id"} {
381 set tagids($name) $commit
382 lappend idtags($commit) $name
386 set tagcontents($name) [exec git-cat-file tag "$id"]
388 } elseif { $type == "heads" } {
389 set headids($name) $id
390 lappend idheads($id) $name
392 set otherrefids($name) $id
393 lappend idotherrefs($id) $name
399 proc error_popup msg {
403 message $w.m -text $msg -justify center -aspect 400
404 pack $w.m -side top -fill x -padx 20 -pady 20
405 button $w.ok -text OK -command "destroy $w"
406 pack $w.ok -side bottom -fill x
407 bind $w <Visibility> "grab $w; focus $w"
411 proc makewindow {rargs} {
412 global canv canv2 canv3 linespc charspc ctext cflist textfont
413 global findtype findtypemenu findloc findstring fstring geometry
414 global entries sha1entry sha1string sha1but
415 global maincursor textcursor curtextcursor
416 global rowctxmenu mergemax
419 .bar add cascade -label "File" -menu .bar.file
421 .bar.file add command -label "Update" -command [list updatecommits $rargs]
422 .bar.file add command -label "Reread references" -command rereadrefs
423 .bar.file add command -label "Quit" -command doquit
425 .bar add cascade -label "Edit" -menu .bar.edit
426 .bar.edit add command -label "Preferences" -command doprefs
428 .bar add cascade -label "Help" -menu .bar.help
429 .bar.help add command -label "About gitk" -command about
430 . configure -menu .bar
432 if {![info exists geometry(canv1)]} {
433 set geometry(canv1) [expr {45 * $charspc}]
434 set geometry(canv2) [expr {30 * $charspc}]
435 set geometry(canv3) [expr {15 * $charspc}]
436 set geometry(canvh) [expr {25 * $linespc + 4}]
437 set geometry(ctextw) 80
438 set geometry(ctexth) 30
439 set geometry(cflistw) 30
441 panedwindow .ctop -orient vertical
442 if {[info exists geometry(width)]} {
443 .ctop conf -width $geometry(width) -height $geometry(height)
444 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
445 set geometry(ctexth) [expr {($texth - 8) /
446 [font metrics $textfont -linespace]}]
450 pack .ctop.top.bar -side bottom -fill x
451 set cscroll .ctop.top.csb
452 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
453 pack $cscroll -side right -fill y
454 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
455 pack .ctop.top.clist -side top -fill both -expand 1
457 set canv .ctop.top.clist.canv
458 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
460 -yscrollincr $linespc -yscrollcommand "$cscroll set"
461 .ctop.top.clist add $canv
462 set canv2 .ctop.top.clist.canv2
463 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
464 -bg white -bd 0 -yscrollincr $linespc
465 .ctop.top.clist add $canv2
466 set canv3 .ctop.top.clist.canv3
467 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
468 -bg white -bd 0 -yscrollincr $linespc
469 .ctop.top.clist add $canv3
470 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
472 set sha1entry .ctop.top.bar.sha1
473 set entries $sha1entry
474 set sha1but .ctop.top.bar.sha1label
475 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
476 -command gotocommit -width 8
477 $sha1but conf -disabledforeground [$sha1but cget -foreground]
478 pack .ctop.top.bar.sha1label -side left
479 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
480 trace add variable sha1string write sha1change
481 pack $sha1entry -side left -pady 2
483 image create bitmap bm-left -data {
484 #define left_width 16
485 #define left_height 16
486 static unsigned char left_bits[] = {
487 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
488 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
489 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
491 image create bitmap bm-right -data {
492 #define right_width 16
493 #define right_height 16
494 static unsigned char right_bits[] = {
495 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
496 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
497 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
499 button .ctop.top.bar.leftbut -image bm-left -command goback \
500 -state disabled -width 26
501 pack .ctop.top.bar.leftbut -side left -fill y
502 button .ctop.top.bar.rightbut -image bm-right -command goforw \
503 -state disabled -width 26
504 pack .ctop.top.bar.rightbut -side left -fill y
506 button .ctop.top.bar.findbut -text "Find" -command dofind
507 pack .ctop.top.bar.findbut -side left
509 set fstring .ctop.top.bar.findstring
510 lappend entries $fstring
511 entry $fstring -width 30 -font $textfont -textvariable findstring
512 pack $fstring -side left -expand 1 -fill x
514 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp]
516 set findloc "All fields"
517 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
518 Comments Author Committer Files Pickaxe
519 pack .ctop.top.bar.findloc -side right
520 pack .ctop.top.bar.findtype -side right
521 # for making sure type==Exact whenever loc==Pickaxe
522 trace add variable findloc write findlocchange
524 panedwindow .ctop.cdet -orient horizontal
526 frame .ctop.cdet.left
527 set ctext .ctop.cdet.left.ctext
528 text $ctext -bg white -state disabled -font $textfont \
529 -width $geometry(ctextw) -height $geometry(ctexth) \
530 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
531 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
532 pack .ctop.cdet.left.sb -side right -fill y
533 pack $ctext -side left -fill both -expand 1
534 .ctop.cdet add .ctop.cdet.left
536 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
537 $ctext tag conf hunksep -fore blue
538 $ctext tag conf d0 -fore red
539 $ctext tag conf d1 -fore "#00a000"
540 $ctext tag conf m0 -fore red
541 $ctext tag conf m1 -fore blue
542 $ctext tag conf m2 -fore green
543 $ctext tag conf m3 -fore purple
544 $ctext tag conf m4 -fore brown
545 $ctext tag conf m5 -fore "#009090"
546 $ctext tag conf m6 -fore magenta
547 $ctext tag conf m7 -fore "#808000"
548 $ctext tag conf m8 -fore "#009000"
549 $ctext tag conf m9 -fore "#ff0080"
550 $ctext tag conf m10 -fore cyan
551 $ctext tag conf m11 -fore "#b07070"
552 $ctext tag conf m12 -fore "#70b0f0"
553 $ctext tag conf m13 -fore "#70f0b0"
554 $ctext tag conf m14 -fore "#f0b070"
555 $ctext tag conf m15 -fore "#ff70b0"
556 $ctext tag conf mmax -fore darkgrey
558 $ctext tag conf mresult -font [concat $textfont bold]
559 $ctext tag conf msep -font [concat $textfont bold]
560 $ctext tag conf found -back yellow
562 frame .ctop.cdet.right
563 set cflist .ctop.cdet.right.cfiles
564 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
565 -yscrollcommand ".ctop.cdet.right.sb set"
566 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
567 pack .ctop.cdet.right.sb -side right -fill y
568 pack $cflist -side left -fill both -expand 1
569 .ctop.cdet add .ctop.cdet.right
570 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
572 pack .ctop -side top -fill both -expand 1
574 bindall <1> {selcanvline %W %x %y}
575 #bindall <B1-Motion> {selcanvline %W %x %y}
576 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
577 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
578 bindall <2> "allcanvs scan mark 0 %y"
579 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
580 bind . <Key-Up> "selnextline -1"
581 bind . <Key-Down> "selnextline 1"
582 bind . <Key-Right> "goforw"
583 bind . <Key-Left> "goback"
584 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
585 bind . <Key-Next> "allcanvs yview scroll 1 pages"
586 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
587 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
588 bindkey <Key-space> "$ctext yview scroll 1 pages"
589 bindkey p "selnextline -1"
590 bindkey n "selnextline 1"
593 bindkey i "selnextline -1"
594 bindkey k "selnextline 1"
597 bindkey b "$ctext yview scroll -1 pages"
598 bindkey d "$ctext yview scroll 18 units"
599 bindkey u "$ctext yview scroll -18 units"
600 bindkey / {findnext 1}
601 bindkey <Key-Return> {findnext 0}
604 bind . <Control-q> doquit
605 bind . <Control-f> dofind
606 bind . <Control-g> {findnext 0}
607 bind . <Control-r> findprev
608 bind . <Control-equal> {incrfont 1}
609 bind . <Control-KP_Add> {incrfont 1}
610 bind . <Control-minus> {incrfont -1}
611 bind . <Control-KP_Subtract> {incrfont -1}
612 bind $cflist <<ListboxSelect>> listboxsel
613 bind . <Destroy> {savestuff %W}
614 bind . <Button-1> "click %W"
615 bind $fstring <Key-Return> dofind
616 bind $sha1entry <Key-Return> gotocommit
617 bind $sha1entry <<PasteSelection>> clearsha1
619 set maincursor [. cget -cursor]
620 set textcursor [$ctext cget -cursor]
621 set curtextcursor $textcursor
623 set rowctxmenu .rowctxmenu
624 menu $rowctxmenu -tearoff 0
625 $rowctxmenu add command -label "Diff this -> selected" \
626 -command {diffvssel 0}
627 $rowctxmenu add command -label "Diff selected -> this" \
628 -command {diffvssel 1}
629 $rowctxmenu add command -label "Make patch" -command mkpatch
630 $rowctxmenu add command -label "Create tag" -command mktag
631 $rowctxmenu add command -label "Write commit to file" -command writecommit
634 # when we make a key binding for the toplevel, make sure
635 # it doesn't get triggered when that key is pressed in the
636 # find string entry widget.
637 proc bindkey {ev script} {
640 set escript [bind Entry $ev]
641 if {$escript == {}} {
642 set escript [bind Entry <Key>]
645 bind $e $ev "$escript; break"
649 # set the focus back to the toplevel for any click outside
660 global canv canv2 canv3 ctext cflist mainfont textfont
661 global stuffsaved findmergefiles maxgraphpct
664 if {$stuffsaved} return
665 if {![winfo viewable .]} return
667 set f [open "~/.gitk-new" w]
668 puts $f [list set mainfont $mainfont]
669 puts $f [list set textfont $textfont]
670 puts $f [list set findmergefiles $findmergefiles]
671 puts $f [list set maxgraphpct $maxgraphpct]
672 puts $f [list set maxwidth $maxwidth]
673 puts $f "set geometry(width) [winfo width .ctop]"
674 puts $f "set geometry(height) [winfo height .ctop]"
675 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
676 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
677 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
678 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
679 set wid [expr {([winfo width $ctext] - 8) \
680 / [font measure $textfont "0"]}]
681 puts $f "set geometry(ctextw) $wid"
682 set wid [expr {([winfo width $cflist] - 11) \
683 / [font measure [$cflist cget -font] "0"]}]
684 puts $f "set geometry(cflistw) $wid"
686 file rename -force "~/.gitk-new" "~/.gitk"
691 proc resizeclistpanes {win w} {
693 if {[info exists oldwidth($win)]} {
694 set s0 [$win sash coord 0]
695 set s1 [$win sash coord 1]
697 set sash0 [expr {int($w/2 - 2)}]
698 set sash1 [expr {int($w*5/6 - 2)}]
700 set factor [expr {1.0 * $w / $oldwidth($win)}]
701 set sash0 [expr {int($factor * [lindex $s0 0])}]
702 set sash1 [expr {int($factor * [lindex $s1 0])}]
706 if {$sash1 < $sash0 + 20} {
707 set sash1 [expr {$sash0 + 20}]
709 if {$sash1 > $w - 10} {
710 set sash1 [expr {$w - 10}]
711 if {$sash0 > $sash1 - 20} {
712 set sash0 [expr {$sash1 - 20}]
716 $win sash place 0 $sash0 [lindex $s0 1]
717 $win sash place 1 $sash1 [lindex $s1 1]
719 set oldwidth($win) $w
722 proc resizecdetpanes {win w} {
724 if {[info exists oldwidth($win)]} {
725 set s0 [$win sash coord 0]
727 set sash0 [expr {int($w*3/4 - 2)}]
729 set factor [expr {1.0 * $w / $oldwidth($win)}]
730 set sash0 [expr {int($factor * [lindex $s0 0])}]
734 if {$sash0 > $w - 15} {
735 set sash0 [expr {$w - 15}]
738 $win sash place 0 $sash0 [lindex $s0 1]
740 set oldwidth($win) $w
744 global canv canv2 canv3
750 proc bindall {event action} {
751 global canv canv2 canv3
752 bind $canv $event $action
753 bind $canv2 $event $action
754 bind $canv3 $event $action
759 if {[winfo exists $w]} {
764 wm title $w "About gitk"
768 Copyright © 2005 Paul Mackerras
770 Use and redistribute under the terms of the GNU General Public License} \
771 -justify center -aspect 400
772 pack $w.m -side top -fill x -padx 20 -pady 20
773 button $w.ok -text Close -command "destroy $w"
774 pack $w.ok -side bottom
777 proc assigncolor {id} {
778 global colormap commcolors colors nextcolor
779 global parents nparents children nchildren
780 global cornercrossings crossings
782 if {[info exists colormap($id)]} return
783 set ncolors [llength $colors]
784 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
785 set child [lindex $children($id) 0]
786 if {[info exists colormap($child)]
787 && $nparents($child) == 1} {
788 set colormap($id) $colormap($child)
793 if {[info exists cornercrossings($id)]} {
794 foreach x $cornercrossings($id) {
795 if {[info exists colormap($x)]
796 && [lsearch -exact $badcolors $colormap($x)] < 0} {
797 lappend badcolors $colormap($x)
800 if {[llength $badcolors] >= $ncolors} {
804 set origbad $badcolors
805 if {[llength $badcolors] < $ncolors - 1} {
806 if {[info exists crossings($id)]} {
807 foreach x $crossings($id) {
808 if {[info exists colormap($x)]
809 && [lsearch -exact $badcolors $colormap($x)] < 0} {
810 lappend badcolors $colormap($x)
813 if {[llength $badcolors] >= $ncolors} {
814 set badcolors $origbad
817 set origbad $badcolors
819 if {[llength $badcolors] < $ncolors - 1} {
820 foreach child $children($id) {
821 if {[info exists colormap($child)]
822 && [lsearch -exact $badcolors $colormap($child)] < 0} {
823 lappend badcolors $colormap($child)
825 if {[info exists parents($child)]} {
826 foreach p $parents($child) {
827 if {[info exists colormap($p)]
828 && [lsearch -exact $badcolors $colormap($p)] < 0} {
829 lappend badcolors $colormap($p)
834 if {[llength $badcolors] >= $ncolors} {
835 set badcolors $origbad
838 for {set i 0} {$i <= $ncolors} {incr i} {
839 set c [lindex $colors $nextcolor]
840 if {[incr nextcolor] >= $ncolors} {
843 if {[lsearch -exact $badcolors $c]} break
849 global canvy canvy0 lineno numcommits nextcolor linespc
850 global nchildren ncleft
851 global displist nhyperspace
858 foreach v {mainline mainlinearrow sidelines colormap cornercrossings
859 crossings idline lineid} {
863 foreach id [array names nchildren] {
864 set ncleft($id) $nchildren($id)
870 proc bindline {t id} {
873 $canv bind $t <Enter> "lineenter %x %y $id"
874 $canv bind $t <Motion> "linemotion %x %y $id"
875 $canv bind $t <Leave> "lineleave $id"
876 $canv bind $t <Button-1> "lineclick %x %y $id 1"
879 proc drawlines {id xtra delold} {
880 global mainline mainlinearrow sidelines lthickness colormap canv
883 $canv delete lines.$id
885 if {[info exists mainline($id)]} {
886 set t [$canv create line $mainline($id) \
887 -width [expr {($xtra + 1) * $lthickness}] \
888 -fill $colormap($id) -tags lines.$id \
889 -arrow $mainlinearrow($id)]
893 if {[info exists sidelines($id)]} {
894 foreach ls $sidelines($id) {
895 set coords [lindex $ls 0]
896 set thick [lindex $ls 1]
897 set arrow [lindex $ls 2]
898 set t [$canv create line $coords -fill $colormap($id) \
899 -width [expr {($thick + $xtra) * $lthickness}] \
900 -arrow $arrow -tags lines.$id]
907 # level here is an index in displist
908 proc drawcommitline {level} {
909 global parents children nparents displist
910 global canv canv2 canv3 mainfont namefont canvy linespc
911 global lineid linehtag linentag linedtag commitinfo
912 global colormap numcommits currentparents dupparents
913 global idtags idline idheads idotherrefs
914 global lineno lthickness mainline mainlinearrow sidelines
915 global commitlisted rowtextx idpos lastuse displist
916 global oldnlines olddlevel olddisplist
920 set id [lindex $displist $level]
921 set lastuse($id) $lineno
922 set lineid($lineno) $id
923 set idline($id) $lineno
924 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
925 if {![info exists commitinfo($id)]} {
927 if {![info exists commitinfo($id)]} {
928 set commitinfo($id) {"No commit information available"}
933 set currentparents {}
935 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
936 foreach p $parents($id) {
937 if {[lsearch -exact $currentparents $p] < 0} {
938 lappend currentparents $p
940 # remember that this parent was listed twice
941 lappend dupparents $p
945 set x [xcoord $level $level $lineno]
947 set canvy [expr {$canvy + $linespc}]
948 allcanvs conf -scrollregion \
949 [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]]
950 if {[info exists mainline($id)]} {
951 lappend mainline($id) $x $y1
952 if {$mainlinearrow($id) ne "none"} {
953 set mainline($id) [trimdiagstart $mainline($id)]
957 set orad [expr {$linespc / 3}]
958 set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \
959 [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \
960 -fill $ofill -outline black -width 1]
962 $canv bind $t <1> {selcanvline {} %x %y}
963 set xt [xcoord [llength $displist] $level $lineno]
964 if {[llength $currentparents] > 2} {
965 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
967 set rowtextx($lineno) $xt
968 set idpos($id) [list $x $xt $y1]
969 if {[info exists idtags($id)] || [info exists idheads($id)]
970 || [info exists idotherrefs($id)]} {
971 set xt [drawtags $id $x $xt $y1]
973 set headline [lindex $commitinfo($id) 0]
974 set name [lindex $commitinfo($id) 1]
975 set date [lindex $commitinfo($id) 2]
976 set date [formatdate $date]
977 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
978 -text $headline -font $mainfont ]
979 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
980 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
981 -text $name -font $namefont]
982 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
983 -text $date -font $mainfont]
986 set olddisplist $displist
987 set oldnlines [llength $displist]
990 proc drawtags {id x xt y1} {
991 global idtags idheads idotherrefs
992 global linespc lthickness
993 global canv mainfont idline rowtextx
998 if {[info exists idtags($id)]} {
999 set marks $idtags($id)
1000 set ntags [llength $marks]
1002 if {[info exists idheads($id)]} {
1003 set marks [concat $marks $idheads($id)]
1004 set nheads [llength $idheads($id)]
1006 if {[info exists idotherrefs($id)]} {
1007 set marks [concat $marks $idotherrefs($id)]
1013 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1014 set yt [expr {$y1 - 0.5 * $linespc}]
1015 set yb [expr {$yt + $linespc - 1}]
1018 foreach tag $marks {
1019 set wid [font measure $mainfont $tag]
1022 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1024 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1025 -width $lthickness -fill black -tags tag.$id]
1027 foreach tag $marks x $xvals wid $wvals {
1028 set xl [expr {$x + $delta}]
1029 set xr [expr {$x + $delta + $wid + $lthickness}]
1030 if {[incr ntags -1] >= 0} {
1032 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1033 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1034 -width 1 -outline black -fill yellow -tags tag.$id]
1035 $canv bind $t <1> [list showtag $tag 1]
1036 set rowtextx($idline($id)) [expr {$xr + $linespc}]
1038 # draw a head or other ref
1039 if {[incr nheads -1] >= 0} {
1044 set xl [expr {$xl - $delta/2}]
1045 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1046 -width 1 -outline black -fill $col -tags tag.$id
1048 set t [$canv create text $xl $y1 -anchor w -text $tag \
1049 -font $mainfont -tags tag.$id]
1051 $canv bind $t <1> [list showtag $tag 1]
1057 proc notecrossings {id lo hi corner} {
1058 global olddisplist crossings cornercrossings
1060 for {set i $lo} {[incr i] < $hi} {} {
1061 set p [lindex $olddisplist $i]
1062 if {$p == {}} continue
1063 if {$i == $corner} {
1064 if {![info exists cornercrossings($id)]
1065 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1066 lappend cornercrossings($id) $p
1068 if {![info exists cornercrossings($p)]
1069 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1070 lappend cornercrossings($p) $id
1073 if {![info exists crossings($id)]
1074 || [lsearch -exact $crossings($id) $p] < 0} {
1075 lappend crossings($id) $p
1077 if {![info exists crossings($p)]
1078 || [lsearch -exact $crossings($p) $id] < 0} {
1079 lappend crossings($p) $id
1085 proc xcoord {i level ln} {
1086 global canvx0 xspc1 xspc2
1088 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1089 if {$i > 0 && $i == $level} {
1090 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1091 } elseif {$i > $level} {
1092 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1097 # it seems Tk can't draw arrows on the end of diagonal line segments...
1098 proc trimdiagend {line} {
1099 while {[llength $line] > 4} {
1100 set x1 [lindex $line end-3]
1101 set y1 [lindex $line end-2]
1102 set x2 [lindex $line end-1]
1103 set y2 [lindex $line end]
1104 if {($x1 == $x2) != ($y1 == $y2)} break
1105 set line [lreplace $line end-1 end]
1110 proc trimdiagstart {line} {
1111 while {[llength $line] > 4} {
1112 set x1 [lindex $line 0]
1113 set y1 [lindex $line 1]
1114 set x2 [lindex $line 2]
1115 set y2 [lindex $line 3]
1116 if {($x1 == $x2) != ($y1 == $y2)} break
1117 set line [lreplace $line 0 1]
1122 proc drawslants {id needonscreen nohs} {
1123 global canv mainline mainlinearrow sidelines
1124 global canvx0 canvy xspc1 xspc2 lthickness
1125 global currentparents dupparents
1126 global lthickness linespc canvy colormap lineno geometry
1127 global maxgraphpct maxwidth
1128 global displist onscreen lastuse
1129 global parents commitlisted
1130 global oldnlines olddlevel olddisplist
1131 global nhyperspace numcommits nnewparents
1134 lappend displist $id
1139 set y1 [expr {$canvy - $linespc}]
1142 # work out what we need to get back on screen
1144 if {$onscreen($id) < 0} {
1145 # next to do isn't displayed, better get it on screen...
1146 lappend reins [list $id 0]
1148 # make sure all the previous commits's parents are on the screen
1149 foreach p $currentparents {
1150 if {$onscreen($p) < 0} {
1151 lappend reins [list $p 0]
1154 # bring back anything requested by caller
1155 if {$needonscreen ne {}} {
1156 lappend reins $needonscreen
1160 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1161 set dlevel $olddlevel
1162 set x [xcoord $dlevel $dlevel $lineno]
1163 set mainline($id) [list $x $y1]
1164 set mainlinearrow($id) none
1165 set lastuse($id) $lineno
1166 set displist [lreplace $displist $dlevel $dlevel $id]
1168 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1173 set displist [lreplace $displist $olddlevel $olddlevel]
1175 foreach p $currentparents {
1176 set lastuse($p) $lineno
1177 if {$onscreen($p) == 0} {
1178 set displist [linsert $displist $j $p]
1183 if {$onscreen($id) == 0} {
1184 lappend displist $id
1188 # remove the null entry if present
1189 set nullentry [lsearch -exact $displist {}]
1190 if {$nullentry >= 0} {
1191 set displist [lreplace $displist $nullentry $nullentry]
1194 # bring back the ones we need now (if we did it earlier
1195 # it would change displist and invalidate olddlevel)
1197 # test again in case of duplicates in reins
1198 set p [lindex $pi 0]
1199 if {$onscreen($p) < 0} {
1201 set lastuse($p) $lineno
1202 set displist [linsert $displist [lindex $pi 1] $p]
1207 set lastuse($id) $lineno
1209 # see if we need to make any lines jump off into hyperspace
1210 set displ [llength $displist]
1211 if {$displ > $maxwidth} {
1213 foreach x $displist {
1214 lappend ages [list $lastuse($x) $x]
1216 set ages [lsort -integer -index 0 $ages]
1218 while {$displ > $maxwidth} {
1219 set use [lindex $ages $k 0]
1220 set victim [lindex $ages $k 1]
1221 if {$use >= $lineno - 5} break
1223 if {[lsearch -exact $nohs $victim] >= 0} continue
1224 set i [lsearch -exact $displist $victim]
1225 set displist [lreplace $displist $i $i]
1226 set onscreen($victim) -1
1229 if {$i < $nullentry} {
1232 set x [lindex $mainline($victim) end-1]
1233 lappend mainline($victim) $x $y1
1234 set line [trimdiagend $mainline($victim)]
1236 if {$mainlinearrow($victim) ne "none"} {
1237 set line [trimdiagstart $line]
1240 lappend sidelines($victim) [list $line 1 $arrow]
1241 unset mainline($victim)
1245 set dlevel [lsearch -exact $displist $id]
1247 # If we are reducing, put in a null entry
1248 if {$displ < $oldnlines} {
1249 # does the next line look like a merge?
1250 # i.e. does it have > 1 new parent?
1251 if {$nnewparents($id) > 1} {
1252 set i [expr {$dlevel + 1}]
1253 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1255 if {$nullentry >= 0 && $nullentry < $i} {
1258 } elseif {$nullentry >= 0} {
1261 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1266 if {$dlevel >= $i} {
1271 set displist [linsert $displist $i {}]
1273 if {$dlevel >= $i} {
1279 # decide on the line spacing for the next line
1280 set lj [expr {$lineno + 1}]
1281 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1282 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1283 set xspc1($lj) $xspc2
1285 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1286 if {$xspc1($lj) < $lthickness} {
1287 set xspc1($lj) $lthickness
1291 foreach idi $reins {
1292 set id [lindex $idi 0]
1293 set j [lsearch -exact $displist $id]
1294 set xj [xcoord $j $dlevel $lj]
1295 set mainline($id) [list $xj $y2]
1296 set mainlinearrow($id) first
1300 foreach id $olddisplist {
1302 if {$id == {}} continue
1303 if {$onscreen($id) <= 0} continue
1304 set xi [xcoord $i $olddlevel $lineno]
1305 if {$i == $olddlevel} {
1306 foreach p $currentparents {
1307 set j [lsearch -exact $displist $p]
1308 set coords [list $xi $y1]
1309 set xj [xcoord $j $dlevel $lj]
1310 if {$xj < $xi - $linespc} {
1311 lappend coords [expr {$xj + $linespc}] $y1
1312 notecrossings $p $j $i [expr {$j + 1}]
1313 } elseif {$xj > $xi + $linespc} {
1314 lappend coords [expr {$xj - $linespc}] $y1
1315 notecrossings $p $i $j [expr {$j - 1}]
1317 if {[lsearch -exact $dupparents $p] >= 0} {
1318 # draw a double-width line to indicate the doubled parent
1319 lappend coords $xj $y2
1320 lappend sidelines($p) [list $coords 2 none]
1321 if {![info exists mainline($p)]} {
1322 set mainline($p) [list $xj $y2]
1323 set mainlinearrow($p) none
1326 # normal case, no parent duplicated
1328 set dx [expr {abs($xi - $xj)}]
1329 if {0 && $dx < $linespc} {
1330 set yb [expr {$y1 + $dx}]
1332 if {![info exists mainline($p)]} {
1334 lappend coords $xj $yb
1336 set mainline($p) $coords
1337 set mainlinearrow($p) none
1339 lappend coords $xj $yb
1341 lappend coords $xj $y2
1343 lappend sidelines($p) [list $coords 1 none]
1349 if {[lindex $displist $i] != $id} {
1350 set j [lsearch -exact $displist $id]
1352 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1353 || ($olddlevel < $i && $i < $dlevel)
1354 || ($dlevel < $i && $i < $olddlevel)} {
1355 set xj [xcoord $j $dlevel $lj]
1356 lappend mainline($id) $xi $y1 $xj $y2
1363 # search for x in a list of lists
1364 proc llsearch {llist x} {
1367 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1375 proc drawmore {reading} {
1376 global displayorder numcommits ncmupdate nextupdate
1377 global stopped nhyperspace parents commitlisted
1378 global maxwidth onscreen displist currentparents olddlevel
1380 set n [llength $displayorder]
1381 while {$numcommits < $n} {
1382 set id [lindex $displayorder $numcommits]
1383 set ctxend [expr {$numcommits + 10}]
1384 if {!$reading && $ctxend > $n} {
1388 if {$numcommits > 0} {
1389 set dlist [lreplace $displist $olddlevel $olddlevel]
1391 foreach p $currentparents {
1392 if {$onscreen($p) == 0} {
1393 set dlist [linsert $dlist $i $p]
1400 set isfat [expr {[llength $dlist] > $maxwidth}]
1401 if {$nhyperspace > 0 || $isfat} {
1402 if {$ctxend > $n} break
1403 # work out what to bring back and
1404 # what we want to don't want to send into hyperspace
1406 for {set k $numcommits} {$k < $ctxend} {incr k} {
1407 set x [lindex $displayorder $k]
1408 set i [llsearch $dlist $x]
1410 set i [llength $dlist]
1413 if {[lsearch -exact $nohs $x] < 0} {
1416 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1417 set reins [list $x $i]
1420 if {[info exists commitlisted($x)]} {
1422 foreach p $parents($x) {
1423 if {[llsearch $dlist $p] < 0} {
1425 if {[lsearch -exact $nohs $p] < 0} {
1428 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1429 set reins [list $p [expr {$i + $right}]]
1435 set l [lindex $dlist $i]
1436 if {[llength $l] == 1} {
1439 set j [lsearch -exact $l $x]
1440 set l [concat [lreplace $l $j $j] $newp]
1442 set dlist [lreplace $dlist $i $i $l]
1443 if {$room && $isfat && [llength $newp] <= 1} {
1449 set dlevel [drawslants $id $reins $nohs]
1450 drawcommitline $dlevel
1451 if {[clock clicks -milliseconds] >= $nextupdate
1452 && $numcommits >= $ncmupdate} {
1459 # level here is an index in todo
1460 proc updatetodo {level noshortcut} {
1461 global ncleft todo nnewparents
1462 global commitlisted parents onscreen
1464 set id [lindex $todo $level]
1466 if {[info exists commitlisted($id)]} {
1467 foreach p $parents($id) {
1468 if {[lsearch -exact $olds $p] < 0} {
1473 if {!$noshortcut && [llength $olds] == 1} {
1474 set p [lindex $olds 0]
1475 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1477 set todo [lreplace $todo $level $level $p]
1479 set nnewparents($id) 1
1484 set todo [lreplace $todo $level $level]
1489 set k [lsearch -exact $todo $p]
1491 set todo [linsert $todo $i $p]
1497 set nnewparents($id) $n
1502 proc decidenext {{noread 0}} {
1504 global datemode cdate
1507 # choose which one to do next time around
1508 set todol [llength $todo]
1511 for {set k $todol} {[incr k -1] >= 0} {} {
1512 set p [lindex $todo $k]
1513 if {$ncleft($p) == 0} {
1515 if {![info exists commitinfo($p)]} {
1521 if {$latest == {} || $cdate($p) > $latest} {
1523 set latest $cdate($p)
1535 proc drawcommit {id reading} {
1536 global phase todo nchildren datemode nextupdate revlistorder ncleft
1537 global numcommits ncmupdate displayorder todo onscreen parents
1538 global commitlisted commitordered
1540 if {$phase != "incrdraw"} {
1545 catch {unset commitordered}
1547 set commitordered($id) 1
1548 if {$nchildren($id) == 0} {
1552 if {$revlistorder} {
1553 set level [lsearch -exact $todo $id]
1555 error_popup "oops, $id isn't in todo"
1558 lappend displayorder $id
1561 set level [decidenext 1]
1562 if {$level == {} || $level < 0} return
1564 set id [lindex $todo $level]
1565 if {![info exists commitordered($id)]} {
1568 lappend displayorder [lindex $todo $level]
1569 if {[updatetodo $level $datemode]} {
1570 set level [decidenext 1]
1571 if {$level == {} || $level < 0} break
1578 proc finishcommits {} {
1579 global phase oldcommits commits
1580 global canv mainfont ctext maincursor textcursor
1581 global parents displayorder todo
1583 if {$phase == "incrdraw" || $phase == "removecommits"} {
1584 foreach id $oldcommits {
1590 } elseif {$phase == "updatecommits"} {
1591 # there were no new commits, in fact
1592 set commits $oldcommits
1597 $canv create text 3 3 -anchor nw -text "No commits selected" \
1598 -font $mainfont -tags textitems
1601 . config -cursor $maincursor
1602 settextcursor $textcursor
1605 # Don't change the text pane cursor if it is currently the hand cursor,
1606 # showing that we are over a sha1 ID link.
1607 proc settextcursor {c} {
1608 global ctext curtextcursor
1610 if {[$ctext cget -cursor] == $curtextcursor} {
1611 $ctext config -cursor $c
1613 set curtextcursor $c
1617 global nextupdate startmsecs ncmupdate
1618 global displayorder onscreen
1620 if {$displayorder == {}} return
1621 set startmsecs [clock clicks -milliseconds]
1622 set nextupdate [expr {$startmsecs + 100}]
1625 foreach id $displayorder {
1632 global phase stopped redisplaying selectedline
1633 global datemode todo displayorder ncleft
1634 global numcommits ncmupdate
1635 global nextupdate startmsecs revlistorder
1637 set level [decidenext]
1641 lappend displayorder [lindex $todo $level]
1642 set hard [updatetodo $level $datemode]
1644 set level [decidenext]
1645 if {$level < 0} break
1650 puts "ERROR: none of the pending commits can be done yet:"
1652 puts " $p ($ncleft($p))"
1658 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1659 #puts "overall $drawmsecs ms for $numcommits commits"
1660 if {$redisplaying} {
1661 if {$stopped == 0 && [info exists selectedline]} {
1662 selectline $selectedline 0
1664 if {$stopped == 1} {
1666 after idle drawgraph
1673 proc findmatches {f} {
1674 global findtype foundstring foundstrlen
1675 if {$findtype == "Regexp"} {
1676 set matches [regexp -indices -all -inline $foundstring $f]
1678 if {$findtype == "IgnCase"} {
1679 set str [string tolower $f]
1685 while {[set j [string first $foundstring $str $i]] >= 0} {
1686 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1687 set i [expr {$j + $foundstrlen}]
1694 global findtype findloc findstring markedmatches commitinfo
1695 global numcommits lineid linehtag linentag linedtag
1696 global mainfont namefont canv canv2 canv3 selectedline
1697 global matchinglines foundstring foundstrlen
1702 set matchinglines {}
1703 if {$findloc == "Pickaxe"} {
1707 if {$findtype == "IgnCase"} {
1708 set foundstring [string tolower $findstring]
1710 set foundstring $findstring
1712 set foundstrlen [string length $findstring]
1713 if {$foundstrlen == 0} return
1714 if {$findloc == "Files"} {
1718 if {![info exists selectedline]} {
1721 set oldsel $selectedline
1724 set fldtypes {Headline Author Date Committer CDate Comment}
1725 for {set l 0} {$l < $numcommits} {incr l} {
1727 set info $commitinfo($id)
1729 foreach f $info ty $fldtypes {
1730 if {$findloc != "All fields" && $findloc != $ty} {
1733 set matches [findmatches $f]
1734 if {$matches == {}} continue
1736 if {$ty == "Headline"} {
1737 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1738 } elseif {$ty == "Author"} {
1739 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1740 } elseif {$ty == "Date"} {
1741 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1745 lappend matchinglines $l
1746 if {!$didsel && $l > $oldsel} {
1752 if {$matchinglines == {}} {
1754 } elseif {!$didsel} {
1755 findselectline [lindex $matchinglines 0]
1759 proc findselectline {l} {
1760 global findloc commentend ctext
1762 if {$findloc == "All fields" || $findloc == "Comments"} {
1763 # highlight the matches in the comments
1764 set f [$ctext get 1.0 $commentend]
1765 set matches [findmatches $f]
1766 foreach match $matches {
1767 set start [lindex $match 0]
1768 set end [expr {[lindex $match 1] + 1}]
1769 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1774 proc findnext {restart} {
1775 global matchinglines selectedline
1776 if {![info exists matchinglines]} {
1782 if {![info exists selectedline]} return
1783 foreach l $matchinglines {
1784 if {$l > $selectedline} {
1793 global matchinglines selectedline
1794 if {![info exists matchinglines]} {
1798 if {![info exists selectedline]} return
1800 foreach l $matchinglines {
1801 if {$l >= $selectedline} break
1805 findselectline $prev
1811 proc findlocchange {name ix op} {
1812 global findloc findtype findtypemenu
1813 if {$findloc == "Pickaxe"} {
1819 $findtypemenu entryconf 1 -state $state
1820 $findtypemenu entryconf 2 -state $state
1823 proc stopfindproc {{done 0}} {
1824 global findprocpid findprocfile findids
1825 global ctext findoldcursor phase maincursor textcursor
1826 global findinprogress
1828 catch {unset findids}
1829 if {[info exists findprocpid]} {
1831 catch {exec kill $findprocpid}
1833 catch {close $findprocfile}
1836 if {[info exists findinprogress]} {
1837 unset findinprogress
1838 if {$phase != "incrdraw"} {
1839 . config -cursor $maincursor
1840 settextcursor $textcursor
1845 proc findpatches {} {
1846 global findstring selectedline numcommits
1847 global findprocpid findprocfile
1848 global finddidsel ctext lineid findinprogress
1849 global findinsertpos
1851 if {$numcommits == 0} return
1853 # make a list of all the ids to search, starting at the one
1854 # after the selected line (if any)
1855 if {[info exists selectedline]} {
1861 for {set i 0} {$i < $numcommits} {incr i} {
1862 if {[incr l] >= $numcommits} {
1865 append inputids $lineid($l) "\n"
1869 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1872 error_popup "Error starting search process: $err"
1876 set findinsertpos end
1878 set findprocpid [pid $f]
1879 fconfigure $f -blocking 0
1880 fileevent $f readable readfindproc
1882 . config -cursor watch
1884 set findinprogress 1
1887 proc readfindproc {} {
1888 global findprocfile finddidsel
1889 global idline matchinglines findinsertpos
1891 set n [gets $findprocfile line]
1893 if {[eof $findprocfile]} {
1901 if {![regexp {^[0-9a-f]{40}} $line id]} {
1902 error_popup "Can't parse git-diff-tree output: $line"
1906 if {![info exists idline($id)]} {
1907 puts stderr "spurious id: $id"
1914 proc insertmatch {l id} {
1915 global matchinglines findinsertpos finddidsel
1917 if {$findinsertpos == "end"} {
1918 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1919 set matchinglines [linsert $matchinglines 0 $l]
1922 lappend matchinglines $l
1925 set matchinglines [linsert $matchinglines $findinsertpos $l]
1936 global selectedline numcommits lineid ctext
1937 global ffileline finddidsel parents nparents
1938 global findinprogress findstartline findinsertpos
1939 global treediffs fdiffids fdiffsneeded fdiffpos
1940 global findmergefiles
1942 if {$numcommits == 0} return
1944 if {[info exists selectedline]} {
1945 set l [expr {$selectedline + 1}]
1950 set findstartline $l
1955 if {$findmergefiles || $nparents($id) == 1} {
1956 foreach p $parents($id) {
1957 if {![info exists treediffs([list $id $p])]} {
1958 append diffsneeded "$id $p\n"
1959 lappend fdiffsneeded [list $id $p]
1963 if {[incr l] >= $numcommits} {
1966 if {$l == $findstartline} break
1969 # start off a git-diff-tree process if needed
1970 if {$diffsneeded ne {}} {
1972 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1974 error_popup "Error starting search process: $err"
1977 catch {unset fdiffids}
1979 fconfigure $df -blocking 0
1980 fileevent $df readable [list readfilediffs $df]
1984 set findinsertpos end
1986 set p [lindex $parents($id) 0]
1987 . config -cursor watch
1989 set findinprogress 1
1990 findcont [list $id $p]
1994 proc readfilediffs {df} {
1995 global findids fdiffids fdiffs
1997 set n [gets $df line]
2001 if {[catch {close $df} err]} {
2004 error_popup "Error in git-diff-tree: $err"
2005 } elseif {[info exists findids]} {
2009 error_popup "Couldn't find diffs for {$ids}"
2014 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
2015 # start of a new string of diffs
2017 set fdiffids [list $id $p]
2019 } elseif {[string match ":*" $line]} {
2020 lappend fdiffs [lindex $line 5]
2024 proc donefilediff {} {
2025 global fdiffids fdiffs treediffs findids
2026 global fdiffsneeded fdiffpos
2028 if {[info exists fdiffids]} {
2029 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
2030 && $fdiffpos < [llength $fdiffsneeded]} {
2031 # git-diff-tree doesn't output anything for a commit
2032 # which doesn't change anything
2033 set nullids [lindex $fdiffsneeded $fdiffpos]
2034 set treediffs($nullids) {}
2035 if {[info exists findids] && $nullids eq $findids} {
2043 if {![info exists treediffs($fdiffids)]} {
2044 set treediffs($fdiffids) $fdiffs
2046 if {[info exists findids] && $fdiffids eq $findids} {
2053 proc findcont {ids} {
2054 global findids treediffs parents nparents
2055 global ffileline findstartline finddidsel
2056 global lineid numcommits matchinglines findinprogress
2057 global findmergefiles
2059 set id [lindex $ids 0]
2060 set p [lindex $ids 1]
2061 set pi [lsearch -exact $parents($id) $p]
2064 if {$findmergefiles || $nparents($id) == 1} {
2065 if {![info exists treediffs($ids)]} {
2071 foreach f $treediffs($ids) {
2072 set x [findmatches $f]
2080 set pi $nparents($id)
2083 set pi $nparents($id)
2085 if {[incr pi] >= $nparents($id)} {
2087 if {[incr l] >= $numcommits} {
2090 if {$l == $findstartline} break
2093 set p [lindex $parents($id) $pi]
2094 set ids [list $id $p]
2102 # mark a commit as matching by putting a yellow background
2103 # behind the headline
2104 proc markheadline {l id} {
2105 global canv mainfont linehtag commitinfo
2107 set bbox [$canv bbox $linehtag($l)]
2108 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2112 # mark the bits of a headline, author or date that match a find string
2113 proc markmatches {canv l str tag matches font} {
2114 set bbox [$canv bbox $tag]
2115 set x0 [lindex $bbox 0]
2116 set y0 [lindex $bbox 1]
2117 set y1 [lindex $bbox 3]
2118 foreach match $matches {
2119 set start [lindex $match 0]
2120 set end [lindex $match 1]
2121 if {$start > $end} continue
2122 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2123 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2124 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2125 [expr {$x0+$xlen+2}] $y1 \
2126 -outline {} -tags matches -fill yellow]
2131 proc unmarkmatches {} {
2132 global matchinglines findids
2133 allcanvs delete matches
2134 catch {unset matchinglines}
2135 catch {unset findids}
2138 proc selcanvline {w x y} {
2139 global canv canvy0 ctext linespc
2140 global lineid linehtag linentag linedtag rowtextx
2141 set ymax [lindex [$canv cget -scrollregion] 3]
2142 if {$ymax == {}} return
2143 set yfrac [lindex [$canv yview] 0]
2144 set y [expr {$y + $yfrac * $ymax}]
2145 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2150 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2156 proc commit_descriptor {p} {
2159 if {[info exists commitinfo($p)]} {
2160 set l [lindex $commitinfo($p) 0]
2165 # append some text to the ctext widget, and make any SHA1 ID
2166 # that we know about be a clickable link.
2167 proc appendwithlinks {text} {
2168 global ctext idline linknum
2170 set start [$ctext index "end - 1c"]
2171 $ctext insert end $text
2172 $ctext insert end "\n"
2173 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2177 set linkid [string range $text $s $e]
2178 if {![info exists idline($linkid)]} continue
2180 $ctext tag add link "$start + $s c" "$start + $e c"
2181 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2182 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2185 $ctext tag conf link -foreground blue -underline 1
2186 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2187 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2190 proc selectline {l isnew} {
2191 global canv canv2 canv3 ctext commitinfo selectedline
2192 global lineid linehtag linentag linedtag
2193 global canvy0 linespc parents nparents children
2194 global cflist currentid sha1entry
2195 global commentend idtags idline linknum
2200 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2202 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2203 -tags secsel -fill [$canv cget -selectbackground]]
2205 $canv2 delete secsel
2206 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2207 -tags secsel -fill [$canv2 cget -selectbackground]]
2209 $canv3 delete secsel
2210 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2211 -tags secsel -fill [$canv3 cget -selectbackground]]
2213 set y [expr {$canvy0 + $l * $linespc}]
2214 set ymax [lindex [$canv cget -scrollregion] 3]
2215 set ytop [expr {$y - $linespc - 1}]
2216 set ybot [expr {$y + $linespc + 1}]
2217 set wnow [$canv yview]
2218 set wtop [expr {[lindex $wnow 0] * $ymax}]
2219 set wbot [expr {[lindex $wnow 1] * $ymax}]
2220 set wh [expr {$wbot - $wtop}]
2222 if {$ytop < $wtop} {
2223 if {$ybot < $wtop} {
2224 set newtop [expr {$y - $wh / 2.0}]
2227 if {$newtop > $wtop - $linespc} {
2228 set newtop [expr {$wtop - $linespc}]
2231 } elseif {$ybot > $wbot} {
2232 if {$ytop > $wbot} {
2233 set newtop [expr {$y - $wh / 2.0}]
2235 set newtop [expr {$ybot - $wh}]
2236 if {$newtop < $wtop + $linespc} {
2237 set newtop [expr {$wtop + $linespc}]
2241 if {$newtop != $wtop} {
2245 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2249 addtohistory [list selectline $l 0]
2256 $sha1entry delete 0 end
2257 $sha1entry insert 0 $id
2258 $sha1entry selection from 0
2259 $sha1entry selection to end
2261 $ctext conf -state normal
2262 $ctext delete 0.0 end
2264 $ctext mark set fmark.0 0.0
2265 $ctext mark gravity fmark.0 left
2266 set info $commitinfo($id)
2267 set date [formatdate [lindex $info 2]]
2268 $ctext insert end "Author: [lindex $info 1] $date\n"
2269 set date [formatdate [lindex $info 4]]
2270 $ctext insert end "Committer: [lindex $info 3] $date\n"
2271 if {[info exists idtags($id)]} {
2272 $ctext insert end "Tags:"
2273 foreach tag $idtags($id) {
2274 $ctext insert end " $tag"
2276 $ctext insert end "\n"
2280 if {$nparents($id) > 1} {
2282 foreach p $parents($id) {
2283 if {$np >= $mergemax} {
2288 $ctext insert end "Parent: " $tag
2289 appendwithlinks [commit_descriptor $p]
2293 if {[info exists parents($id)]} {
2294 foreach p $parents($id) {
2295 append comment "Parent: [commit_descriptor $p]\n"
2300 if {[info exists children($id)]} {
2301 foreach c $children($id) {
2302 append comment "Child: [commit_descriptor $c]\n"
2306 append comment [lindex $info 5]
2308 # make anything that looks like a SHA1 ID be a clickable link
2309 appendwithlinks $comment
2311 $ctext tag delete Comments
2312 $ctext tag remove found 1.0 end
2313 $ctext conf -state disabled
2314 set commentend [$ctext index "end - 1c"]
2316 $cflist delete 0 end
2317 $cflist insert end "Comments"
2318 if {$nparents($id) == 1} {
2320 } elseif {$nparents($id) > 1} {
2325 proc selnextline {dir} {
2327 if {![info exists selectedline]} return
2328 set l [expr {$selectedline + $dir}]
2333 proc unselectline {} {
2336 catch {unset selectedline}
2337 allcanvs delete secsel
2340 proc addtohistory {cmd} {
2341 global history historyindex
2343 if {$historyindex > 0
2344 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2348 if {$historyindex < [llength $history]} {
2349 set history [lreplace $history $historyindex end $cmd]
2351 lappend history $cmd
2354 if {$historyindex > 1} {
2355 .ctop.top.bar.leftbut conf -state normal
2357 .ctop.top.bar.leftbut conf -state disabled
2359 .ctop.top.bar.rightbut conf -state disabled
2363 global history historyindex
2365 if {$historyindex > 1} {
2366 incr historyindex -1
2367 set cmd [lindex $history [expr {$historyindex - 1}]]
2369 .ctop.top.bar.rightbut conf -state normal
2371 if {$historyindex <= 1} {
2372 .ctop.top.bar.leftbut conf -state disabled
2377 global history historyindex
2379 if {$historyindex < [llength $history]} {
2380 set cmd [lindex $history $historyindex]
2383 .ctop.top.bar.leftbut conf -state normal
2385 if {$historyindex >= [llength $history]} {
2386 .ctop.top.bar.rightbut conf -state disabled
2390 proc mergediff {id} {
2391 global parents diffmergeid diffopts mdifffd
2392 global difffilestart
2395 catch {unset difffilestart}
2396 # this doesn't seem to actually affect anything...
2397 set env(GIT_DIFF_OPTS) $diffopts
2398 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2399 if {[catch {set mdf [open $cmd r]} err]} {
2400 error_popup "Error getting merge diffs: $err"
2403 fconfigure $mdf -blocking 0
2404 set mdifffd($id) $mdf
2405 fileevent $mdf readable [list getmergediffline $mdf $id]
2406 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2409 proc getmergediffline {mdf id} {
2410 global diffmergeid ctext cflist nextupdate nparents mergemax
2411 global difffilestart
2413 set n [gets $mdf line]
2420 if {![info exists diffmergeid] || $id != $diffmergeid} {
2423 $ctext conf -state normal
2424 if {[regexp {^diff --cc (.*)} $line match fname]} {
2425 # start of a new file
2426 $ctext insert end "\n"
2427 set here [$ctext index "end - 1c"]
2428 set i [$cflist index end]
2429 $ctext mark set fmark.$i $here
2430 $ctext mark gravity fmark.$i left
2431 set difffilestart([expr {$i-1}]) $here
2432 $cflist insert end $fname
2433 set l [expr {(78 - [string length $fname]) / 2}]
2434 set pad [string range "----------------------------------------" 1 $l]
2435 $ctext insert end "$pad $fname $pad\n" filesep
2436 } elseif {[regexp {^@@} $line]} {
2437 $ctext insert end "$line\n" hunksep
2438 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2441 # parse the prefix - one ' ', '-' or '+' for each parent
2442 set np $nparents($id)
2447 for {set j 0} {$j < $np} {incr j} {
2448 set c [string range $line $j $j]
2451 } elseif {$c == "-"} {
2453 } elseif {$c == "+"} {
2462 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2463 # line doesn't appear in result, parents in $minuses have the line
2464 set num [lindex $minuses 0]
2465 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2466 # line appears in result, parents in $pluses don't have the line
2467 lappend tags mresult
2468 set num [lindex $spaces 0]
2471 if {$num >= $mergemax} {
2476 $ctext insert end "$line\n" $tags
2478 $ctext conf -state disabled
2479 if {[clock clicks -milliseconds] >= $nextupdate} {
2481 fileevent $mdf readable {}
2483 fileevent $mdf readable [list getmergediffline $mdf $id]
2487 proc startdiff {ids} {
2488 global treediffs diffids treepending diffmergeid
2491 catch {unset diffmergeid}
2492 if {![info exists treediffs($ids)]} {
2493 if {![info exists treepending]} {
2501 proc addtocflist {ids} {
2502 global treediffs cflist
2503 foreach f $treediffs($ids) {
2504 $cflist insert end $f
2509 proc gettreediffs {ids} {
2510 global treediff parents treepending
2511 set treepending $ids
2514 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2516 fconfigure $gdtf -blocking 0
2517 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2520 proc gettreediffline {gdtf ids} {
2521 global treediff treediffs treepending diffids diffmergeid
2523 set n [gets $gdtf line]
2525 if {![eof $gdtf]} return
2527 set treediffs($ids) $treediff
2529 if {$ids != $diffids} {
2530 gettreediffs $diffids
2532 if {[info exists diffmergeid]} {
2540 set file [lindex $line 5]
2541 lappend treediff $file
2544 proc getblobdiffs {ids} {
2545 global diffopts blobdifffd diffids env curdifftag curtagstart
2546 global difffilestart nextupdate diffinhdr treediffs
2548 set env(GIT_DIFF_OPTS) $diffopts
2549 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2550 if {[catch {set bdf [open $cmd r]} err]} {
2551 puts "error getting diffs: $err"
2555 fconfigure $bdf -blocking 0
2556 set blobdifffd($ids) $bdf
2557 set curdifftag Comments
2559 catch {unset difffilestart}
2560 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2561 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2564 proc getblobdiffline {bdf ids} {
2565 global diffids blobdifffd ctext curdifftag curtagstart
2566 global diffnexthead diffnextnote difffilestart
2567 global nextupdate diffinhdr treediffs
2569 set n [gets $bdf line]
2573 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2574 $ctext tag add $curdifftag $curtagstart end
2579 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2582 $ctext conf -state normal
2583 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2584 # start of a new file
2585 $ctext insert end "\n"
2586 $ctext tag add $curdifftag $curtagstart end
2587 set curtagstart [$ctext index "end - 1c"]
2589 set here [$ctext index "end - 1c"]
2590 set i [lsearch -exact $treediffs($diffids) $fname]
2592 set difffilestart($i) $here
2594 $ctext mark set fmark.$i $here
2595 $ctext mark gravity fmark.$i left
2597 if {$newname != $fname} {
2598 set i [lsearch -exact $treediffs($diffids) $newname]
2600 set difffilestart($i) $here
2602 $ctext mark set fmark.$i $here
2603 $ctext mark gravity fmark.$i left
2606 set curdifftag "f:$fname"
2607 $ctext tag delete $curdifftag
2608 set l [expr {(78 - [string length $header]) / 2}]
2609 set pad [string range "----------------------------------------" 1 $l]
2610 $ctext insert end "$pad $header $pad\n" filesep
2612 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2614 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2615 $line match f1l f1c f2l f2c rest]} {
2616 $ctext insert end "$line\n" hunksep
2619 set x [string range $line 0 0]
2620 if {$x == "-" || $x == "+"} {
2621 set tag [expr {$x == "+"}]
2622 $ctext insert end "$line\n" d$tag
2623 } elseif {$x == " "} {
2624 $ctext insert end "$line\n"
2625 } elseif {$diffinhdr || $x == "\\"} {
2626 # e.g. "\ No newline at end of file"
2627 $ctext insert end "$line\n" filesep
2629 # Something else we don't recognize
2630 if {$curdifftag != "Comments"} {
2631 $ctext insert end "\n"
2632 $ctext tag add $curdifftag $curtagstart end
2633 set curtagstart [$ctext index "end - 1c"]
2634 set curdifftag Comments
2636 $ctext insert end "$line\n" filesep
2639 $ctext conf -state disabled
2640 if {[clock clicks -milliseconds] >= $nextupdate} {
2642 fileevent $bdf readable {}
2644 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2649 global difffilestart ctext
2650 set here [$ctext index @0,0]
2651 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2652 if {[$ctext compare $difffilestart($i) > $here]} {
2653 if {![info exists pos]
2654 || [$ctext compare $difffilestart($i) < $pos]} {
2655 set pos $difffilestart($i)
2659 if {[info exists pos]} {
2664 proc listboxsel {} {
2665 global ctext cflist currentid
2666 if {![info exists currentid]} return
2667 set sel [lsort [$cflist curselection]]
2668 if {$sel eq {}} return
2669 set first [lindex $sel 0]
2670 catch {$ctext yview fmark.$first}
2674 global linespc charspc canvx0 canvy0 mainfont
2675 global xspc1 xspc2 lthickness
2677 set linespc [font metrics $mainfont -linespace]
2678 set charspc [font measure $mainfont "m"]
2679 set canvy0 [expr {3 + 0.5 * $linespc}]
2680 set canvx0 [expr {3 + 0.5 * $linespc}]
2681 set lthickness [expr {int($linespc / 9) + 1}]
2682 set xspc1(0) $linespc
2687 global stopped redisplaying phase
2688 if {$stopped > 1} return
2689 if {$phase == "getcommits"} return
2691 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2698 proc incrfont {inc} {
2699 global mainfont namefont textfont ctext canv phase
2700 global stopped entries
2702 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2703 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2704 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2706 $ctext conf -font $textfont
2707 $ctext tag conf filesep -font [concat $textfont bold]
2708 foreach e $entries {
2709 $e conf -font $mainfont
2711 if {$phase == "getcommits"} {
2712 $canv itemconf textitems -font $mainfont
2718 global sha1entry sha1string
2719 if {[string length $sha1string] == 40} {
2720 $sha1entry delete 0 end
2724 proc sha1change {n1 n2 op} {
2725 global sha1string currentid sha1but
2726 if {$sha1string == {}
2727 || ([info exists currentid] && $sha1string == $currentid)} {
2732 if {[$sha1but cget -state] == $state} return
2733 if {$state == "normal"} {
2734 $sha1but conf -state normal -relief raised -text "Goto: "
2736 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2740 proc gotocommit {} {
2741 global sha1string currentid idline tagids
2742 global lineid numcommits
2744 if {$sha1string == {}
2745 || ([info exists currentid] && $sha1string == $currentid)} return
2746 if {[info exists tagids($sha1string)]} {
2747 set id $tagids($sha1string)
2749 set id [string tolower $sha1string]
2750 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2752 for {set l 0} {$l < $numcommits} {incr l} {
2753 if {[string match $id* $lineid($l)]} {
2754 lappend matches $lineid($l)
2757 if {$matches ne {}} {
2758 if {[llength $matches] > 1} {
2759 error_popup "Short SHA1 id $id is ambiguous"
2762 set id [lindex $matches 0]
2766 if {[info exists idline($id)]} {
2767 selectline $idline($id) 1
2770 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2775 error_popup "$type $sha1string is not known"
2778 proc lineenter {x y id} {
2779 global hoverx hovery hoverid hovertimer
2780 global commitinfo canv
2782 if {![info exists commitinfo($id)]} return
2786 if {[info exists hovertimer]} {
2787 after cancel $hovertimer
2789 set hovertimer [after 500 linehover]
2793 proc linemotion {x y id} {
2794 global hoverx hovery hoverid hovertimer
2796 if {[info exists hoverid] && $id == $hoverid} {
2799 if {[info exists hovertimer]} {
2800 after cancel $hovertimer
2802 set hovertimer [after 500 linehover]
2806 proc lineleave {id} {
2807 global hoverid hovertimer canv
2809 if {[info exists hoverid] && $id == $hoverid} {
2811 if {[info exists hovertimer]} {
2812 after cancel $hovertimer
2820 global hoverx hovery hoverid hovertimer
2821 global canv linespc lthickness
2822 global commitinfo mainfont
2824 set text [lindex $commitinfo($hoverid) 0]
2825 set ymax [lindex [$canv cget -scrollregion] 3]
2826 if {$ymax == {}} return
2827 set yfrac [lindex [$canv yview] 0]
2828 set x [expr {$hoverx + 2 * $linespc}]
2829 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2830 set x0 [expr {$x - 2 * $lthickness}]
2831 set y0 [expr {$y - 2 * $lthickness}]
2832 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2833 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2834 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2835 -fill \#ffff80 -outline black -width 1 -tags hover]
2837 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2841 proc clickisonarrow {id y} {
2842 global mainline mainlinearrow sidelines lthickness
2844 set thresh [expr {2 * $lthickness + 6}]
2845 if {[info exists mainline($id)]} {
2846 if {$mainlinearrow($id) ne "none"} {
2847 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
2852 if {[info exists sidelines($id)]} {
2853 foreach ls $sidelines($id) {
2854 set coords [lindex $ls 0]
2855 set arrow [lindex $ls 2]
2856 if {$arrow eq "first" || $arrow eq "both"} {
2857 if {abs([lindex $coords 1] - $y) < $thresh} {
2861 if {$arrow eq "last" || $arrow eq "both"} {
2862 if {abs([lindex $coords end] - $y) < $thresh} {
2871 proc arrowjump {id dirn y} {
2872 global mainline sidelines canv canv2 canv3
2875 if {$dirn eq "down"} {
2876 if {[info exists mainline($id)]} {
2877 set y1 [lindex $mainline($id) 1]
2882 if {[info exists sidelines($id)]} {
2883 foreach ls $sidelines($id) {
2884 set y1 [lindex $ls 0 1]
2885 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
2891 if {[info exists sidelines($id)]} {
2892 foreach ls $sidelines($id) {
2893 set y1 [lindex $ls 0 end]
2894 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
2900 if {$yt eq {}} return
2901 set ymax [lindex [$canv cget -scrollregion] 3]
2902 if {$ymax eq {} || $ymax <= 0} return
2903 set view [$canv yview]
2904 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2905 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2909 $canv yview moveto $yfrac
2910 $canv2 yview moveto $yfrac
2911 $canv3 yview moveto $yfrac
2914 proc lineclick {x y id isnew} {
2915 global ctext commitinfo children cflist canv thickerline
2921 # draw this line thicker than normal
2925 set ymax [lindex [$canv cget -scrollregion] 3]
2926 if {$ymax eq {}} return
2927 set yfrac [lindex [$canv yview] 0]
2928 set y [expr {$y + $yfrac * $ymax}]
2930 set dirn [clickisonarrow $id $y]
2932 arrowjump $id $dirn $y
2937 addtohistory [list lineclick $x $y $id 0]
2939 # fill the details pane with info about this line
2940 $ctext conf -state normal
2941 $ctext delete 0.0 end
2942 $ctext tag conf link -foreground blue -underline 1
2943 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2944 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2945 $ctext insert end "Parent:\t"
2946 $ctext insert end $id [list link link0]
2947 $ctext tag bind link0 <1> [list selbyid $id]
2948 set info $commitinfo($id)
2949 $ctext insert end "\n\t[lindex $info 0]\n"
2950 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2951 set date [formatdate [lindex $info 2]]
2952 $ctext insert end "\tDate:\t$date\n"
2953 if {[info exists children($id)]} {
2954 $ctext insert end "\nChildren:"
2956 foreach child $children($id) {
2958 set info $commitinfo($child)
2959 $ctext insert end "\n\t"
2960 $ctext insert end $child [list link link$i]
2961 $ctext tag bind link$i <1> [list selbyid $child]
2962 $ctext insert end "\n\t[lindex $info 0]"
2963 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2964 set date [formatdate [lindex $info 2]]
2965 $ctext insert end "\n\tDate:\t$date\n"
2968 $ctext conf -state disabled
2970 $cflist delete 0 end
2973 proc normalline {} {
2975 if {[info exists thickerline]} {
2976 drawlines $thickerline 0 1
2983 if {[info exists idline($id)]} {
2984 selectline $idline($id) 1
2990 if {![info exists startmstime]} {
2991 set startmstime [clock clicks -milliseconds]
2993 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2996 proc rowmenu {x y id} {
2997 global rowctxmenu idline selectedline rowmenuid
2999 if {![info exists selectedline] || $idline($id) eq $selectedline} {
3004 $rowctxmenu entryconfigure 0 -state $state
3005 $rowctxmenu entryconfigure 1 -state $state
3006 $rowctxmenu entryconfigure 2 -state $state
3008 tk_popup $rowctxmenu $x $y
3011 proc diffvssel {dirn} {
3012 global rowmenuid selectedline lineid
3014 if {![info exists selectedline]} return
3016 set oldid $lineid($selectedline)
3017 set newid $rowmenuid
3019 set oldid $rowmenuid
3020 set newid $lineid($selectedline)
3022 addtohistory [list doseldiff $oldid $newid]
3023 doseldiff $oldid $newid
3026 proc doseldiff {oldid newid} {
3030 $ctext conf -state normal
3031 $ctext delete 0.0 end
3032 $ctext mark set fmark.0 0.0
3033 $ctext mark gravity fmark.0 left
3034 $cflist delete 0 end
3035 $cflist insert end "Top"
3036 $ctext insert end "From "
3037 $ctext tag conf link -foreground blue -underline 1
3038 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3039 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3040 $ctext tag bind link0 <1> [list selbyid $oldid]
3041 $ctext insert end $oldid [list link link0]
3042 $ctext insert end "\n "
3043 $ctext insert end [lindex $commitinfo($oldid) 0]
3044 $ctext insert end "\n\nTo "
3045 $ctext tag bind link1 <1> [list selbyid $newid]
3046 $ctext insert end $newid [list link link1]
3047 $ctext insert end "\n "
3048 $ctext insert end [lindex $commitinfo($newid) 0]
3049 $ctext insert end "\n"
3050 $ctext conf -state disabled
3051 $ctext tag delete Comments
3052 $ctext tag remove found 1.0 end
3053 startdiff [list $oldid $newid]
3057 global rowmenuid currentid commitinfo patchtop patchnum
3059 if {![info exists currentid]} return
3060 set oldid $currentid
3061 set oldhead [lindex $commitinfo($oldid) 0]
3062 set newid $rowmenuid
3063 set newhead [lindex $commitinfo($newid) 0]
3066 catch {destroy $top}
3068 label $top.title -text "Generate patch"
3069 grid $top.title - -pady 10
3070 label $top.from -text "From:"
3071 entry $top.fromsha1 -width 40 -relief flat
3072 $top.fromsha1 insert 0 $oldid
3073 $top.fromsha1 conf -state readonly
3074 grid $top.from $top.fromsha1 -sticky w
3075 entry $top.fromhead -width 60 -relief flat
3076 $top.fromhead insert 0 $oldhead
3077 $top.fromhead conf -state readonly
3078 grid x $top.fromhead -sticky w
3079 label $top.to -text "To:"
3080 entry $top.tosha1 -width 40 -relief flat
3081 $top.tosha1 insert 0 $newid
3082 $top.tosha1 conf -state readonly
3083 grid $top.to $top.tosha1 -sticky w
3084 entry $top.tohead -width 60 -relief flat
3085 $top.tohead insert 0 $newhead
3086 $top.tohead conf -state readonly
3087 grid x $top.tohead -sticky w
3088 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3089 grid $top.rev x -pady 10
3090 label $top.flab -text "Output file:"
3091 entry $top.fname -width 60
3092 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3094 grid $top.flab $top.fname -sticky w
3096 button $top.buts.gen -text "Generate" -command mkpatchgo
3097 button $top.buts.can -text "Cancel" -command mkpatchcan
3098 grid $top.buts.gen $top.buts.can
3099 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3100 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3101 grid $top.buts - -pady 10 -sticky ew
3105 proc mkpatchrev {} {
3108 set oldid [$patchtop.fromsha1 get]
3109 set oldhead [$patchtop.fromhead get]
3110 set newid [$patchtop.tosha1 get]
3111 set newhead [$patchtop.tohead get]
3112 foreach e [list fromsha1 fromhead tosha1 tohead] \
3113 v [list $newid $newhead $oldid $oldhead] {
3114 $patchtop.$e conf -state normal
3115 $patchtop.$e delete 0 end
3116 $patchtop.$e insert 0 $v
3117 $patchtop.$e conf -state readonly
3124 set oldid [$patchtop.fromsha1 get]
3125 set newid [$patchtop.tosha1 get]
3126 set fname [$patchtop.fname get]
3127 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3128 error_popup "Error creating patch: $err"
3130 catch {destroy $patchtop}
3134 proc mkpatchcan {} {
3137 catch {destroy $patchtop}
3142 global rowmenuid mktagtop commitinfo
3146 catch {destroy $top}
3148 label $top.title -text "Create tag"
3149 grid $top.title - -pady 10
3150 label $top.id -text "ID:"
3151 entry $top.sha1 -width 40 -relief flat
3152 $top.sha1 insert 0 $rowmenuid
3153 $top.sha1 conf -state readonly
3154 grid $top.id $top.sha1 -sticky w
3155 entry $top.head -width 60 -relief flat
3156 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3157 $top.head conf -state readonly
3158 grid x $top.head -sticky w
3159 label $top.tlab -text "Tag name:"
3160 entry $top.tag -width 60
3161 grid $top.tlab $top.tag -sticky w
3163 button $top.buts.gen -text "Create" -command mktaggo
3164 button $top.buts.can -text "Cancel" -command mktagcan
3165 grid $top.buts.gen $top.buts.can
3166 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3167 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3168 grid $top.buts - -pady 10 -sticky ew
3173 global mktagtop env tagids idtags
3175 set id [$mktagtop.sha1 get]
3176 set tag [$mktagtop.tag get]
3178 error_popup "No tag name specified"
3181 if {[info exists tagids($tag)]} {
3182 error_popup "Tag \"$tag\" already exists"
3187 set fname [file join $dir "refs/tags" $tag]
3188 set f [open $fname w]
3192 error_popup "Error creating tag: $err"
3196 set tagids($tag) $id
3197 lappend idtags($id) $tag
3201 proc redrawtags {id} {
3202 global canv linehtag idline idpos selectedline
3204 if {![info exists idline($id)]} return
3205 $canv delete tag.$id
3206 set xt [eval drawtags $id $idpos($id)]
3207 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3208 if {[info exists selectedline] && $selectedline == $idline($id)} {
3209 selectline $selectedline 0
3216 catch {destroy $mktagtop}
3225 proc writecommit {} {
3226 global rowmenuid wrcomtop commitinfo wrcomcmd
3228 set top .writecommit
3230 catch {destroy $top}
3232 label $top.title -text "Write commit to file"
3233 grid $top.title - -pady 10
3234 label $top.id -text "ID:"
3235 entry $top.sha1 -width 40 -relief flat
3236 $top.sha1 insert 0 $rowmenuid
3237 $top.sha1 conf -state readonly
3238 grid $top.id $top.sha1 -sticky w
3239 entry $top.head -width 60 -relief flat
3240 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3241 $top.head conf -state readonly
3242 grid x $top.head -sticky w
3243 label $top.clab -text "Command:"
3244 entry $top.cmd -width 60 -textvariable wrcomcmd
3245 grid $top.clab $top.cmd -sticky w -pady 10
3246 label $top.flab -text "Output file:"
3247 entry $top.fname -width 60
3248 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3249 grid $top.flab $top.fname -sticky w
3251 button $top.buts.gen -text "Write" -command wrcomgo
3252 button $top.buts.can -text "Cancel" -command wrcomcan
3253 grid $top.buts.gen $top.buts.can
3254 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3255 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3256 grid $top.buts - -pady 10 -sticky ew
3263 set id [$wrcomtop.sha1 get]
3264 set cmd "echo $id | [$wrcomtop.cmd get]"
3265 set fname [$wrcomtop.fname get]
3266 if {[catch {exec sh -c $cmd >$fname &} err]} {
3267 error_popup "Error writing commit: $err"
3269 catch {destroy $wrcomtop}
3276 catch {destroy $wrcomtop}
3280 proc listrefs {id} {
3281 global idtags idheads idotherrefs
3284 if {[info exists idtags($id)]} {
3288 if {[info exists idheads($id)]} {
3292 if {[info exists idotherrefs($id)]} {
3293 set z $idotherrefs($id)
3295 return [list $x $y $z]
3298 proc rereadrefs {} {
3299 global idtags idheads idotherrefs
3300 global tagids headids otherrefids
3302 set refids [concat [array names idtags] \
3303 [array names idheads] [array names idotherrefs]]
3304 foreach id $refids {
3305 if {![info exists ref($id)]} {
3306 set ref($id) [listrefs $id]
3310 set refids [lsort -unique [concat $refids [array names idtags] \
3311 [array names idheads] [array names idotherrefs]]]
3312 foreach id $refids {
3313 set v [listrefs $id]
3314 if {![info exists ref($id)] || $ref($id) != $v} {
3320 proc showtag {tag isnew} {
3321 global ctext cflist tagcontents tagids linknum
3324 addtohistory [list showtag $tag 0]
3326 $ctext conf -state normal
3327 $ctext delete 0.0 end
3329 if {[info exists tagcontents($tag)]} {
3330 set text $tagcontents($tag)
3332 set text "Tag: $tag\nId: $tagids($tag)"
3334 appendwithlinks $text
3335 $ctext conf -state disabled
3336 $cflist delete 0 end
3346 global maxwidth maxgraphpct diffopts findmergefiles
3347 global oldprefs prefstop
3351 if {[winfo exists $top]} {
3355 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3356 set oldprefs($v) [set $v]
3359 wm title $top "Gitk preferences"
3360 label $top.ldisp -text "Commit list display options"
3361 grid $top.ldisp - -sticky w -pady 10
3362 label $top.spacer -text " "
3363 label $top.maxwidthl -text "Maximum graph width (lines)" \
3365 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3366 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3367 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3369 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3370 grid x $top.maxpctl $top.maxpct -sticky w
3371 checkbutton $top.findm -variable findmergefiles
3372 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3374 grid $top.findm $top.findml - -sticky w
3375 label $top.ddisp -text "Diff display options"
3376 grid $top.ddisp - -sticky w -pady 10
3377 label $top.diffoptl -text "Options for diff program" \
3379 entry $top.diffopt -width 20 -textvariable diffopts
3380 grid x $top.diffoptl $top.diffopt -sticky w
3382 button $top.buts.ok -text "OK" -command prefsok
3383 button $top.buts.can -text "Cancel" -command prefscan
3384 grid $top.buts.ok $top.buts.can
3385 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3386 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3387 grid $top.buts - - -pady 10 -sticky ew
3391 global maxwidth maxgraphpct diffopts findmergefiles
3392 global oldprefs prefstop
3394 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3395 set $v $oldprefs($v)
3397 catch {destroy $prefstop}
3402 global maxwidth maxgraphpct
3403 global oldprefs prefstop
3405 catch {destroy $prefstop}
3407 if {$maxwidth != $oldprefs(maxwidth)
3408 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3413 proc formatdate {d} {
3414 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3417 # This list of encoding names and aliases is distilled from
3418 # http://www.iana.org/assignments/character-sets.
3419 # Not all of them are supported by Tcl.
3420 set encoding_aliases {
3421 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3422 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3423 { ISO-10646-UTF-1 csISO10646UTF1 }
3424 { ISO_646.basic:1983 ref csISO646basic1983 }
3425 { INVARIANT csINVARIANT }
3426 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3427 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3428 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3429 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3430 { NATS-DANO iso-ir-9-1 csNATSDANO }
3431 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3432 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3433 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3434 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3435 { ISO-2022-KR csISO2022KR }
3437 { ISO-2022-JP csISO2022JP }
3438 { ISO-2022-JP-2 csISO2022JP2 }
3439 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3441 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3442 { IT iso-ir-15 ISO646-IT csISO15Italian }
3443 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3444 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3445 { greek7-old iso-ir-18 csISO18Greek7Old }
3446 { latin-greek iso-ir-19 csISO19LatinGreek }
3447 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3448 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3449 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3450 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3451 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3452 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3453 { INIS iso-ir-49 csISO49INIS }
3454 { INIS-8 iso-ir-50 csISO50INIS8 }
3455 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3456 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3457 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3458 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3459 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3460 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3462 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3463 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3464 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3465 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3466 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3467 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3468 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3469 { greek7 iso-ir-88 csISO88Greek7 }
3470 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3471 { iso-ir-90 csISO90 }
3472 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3473 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3474 csISO92JISC62991984b }
3475 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3476 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3477 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3478 csISO95JIS62291984handadd }
3479 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3480 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3481 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3482 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3484 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3485 { T.61-7bit iso-ir-102 csISO102T617bit }
3486 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3487 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3488 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3489 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3490 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3491 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3492 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3493 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3494 arabic csISOLatinArabic }
3495 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3496 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3497 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3498 greek greek8 csISOLatinGreek }
3499 { T.101-G2 iso-ir-128 csISO128T101G2 }
3500 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3502 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3503 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3504 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3505 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3506 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3507 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3508 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3509 csISOLatinCyrillic }
3510 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3511 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3512 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3513 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3514 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3515 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3516 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3517 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3518 { ISO_10367-box iso-ir-155 csISO10367Box }
3519 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3520 { latin-lap lap iso-ir-158 csISO158Lap }
3521 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3522 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3525 { JIS_X0201 X0201 csHalfWidthKatakana }
3526 { KSC5636 ISO646-KR csKSC5636 }
3527 { ISO-10646-UCS-2 csUnicode }
3528 { ISO-10646-UCS-4 csUCS4 }
3529 { DEC-MCS dec csDECMCS }
3530 { hp-roman8 roman8 r8 csHPRoman8 }
3531 { macintosh mac csMacintosh }
3532 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3534 { IBM038 EBCDIC-INT cp038 csIBM038 }
3535 { IBM273 CP273 csIBM273 }
3536 { IBM274 EBCDIC-BE CP274 csIBM274 }
3537 { IBM275 EBCDIC-BR cp275 csIBM275 }
3538 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3539 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3540 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3541 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3542 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3543 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3544 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3545 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3546 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3547 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3548 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3549 { IBM437 cp437 437 csPC8CodePage437 }
3550 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3551 { IBM775 cp775 csPC775Baltic }
3552 { IBM850 cp850 850 csPC850Multilingual }
3553 { IBM851 cp851 851 csIBM851 }
3554 { IBM852 cp852 852 csPCp852 }
3555 { IBM855 cp855 855 csIBM855 }
3556 { IBM857 cp857 857 csIBM857 }
3557 { IBM860 cp860 860 csIBM860 }
3558 { IBM861 cp861 861 cp-is csIBM861 }
3559 { IBM862 cp862 862 csPC862LatinHebrew }
3560 { IBM863 cp863 863 csIBM863 }
3561 { IBM864 cp864 csIBM864 }
3562 { IBM865 cp865 865 csIBM865 }
3563 { IBM866 cp866 866 csIBM866 }
3564 { IBM868 CP868 cp-ar csIBM868 }
3565 { IBM869 cp869 869 cp-gr csIBM869 }
3566 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3567 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3568 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3569 { IBM891 cp891 csIBM891 }
3570 { IBM903 cp903 csIBM903 }
3571 { IBM904 cp904 904 csIBBM904 }
3572 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3573 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3574 { IBM1026 CP1026 csIBM1026 }
3575 { EBCDIC-AT-DE csIBMEBCDICATDE }
3576 { EBCDIC-AT-DE-A csEBCDICATDEA }
3577 { EBCDIC-CA-FR csEBCDICCAFR }
3578 { EBCDIC-DK-NO csEBCDICDKNO }
3579 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3580 { EBCDIC-FI-SE csEBCDICFISE }
3581 { EBCDIC-FI-SE-A csEBCDICFISEA }
3582 { EBCDIC-FR csEBCDICFR }
3583 { EBCDIC-IT csEBCDICIT }
3584 { EBCDIC-PT csEBCDICPT }
3585 { EBCDIC-ES csEBCDICES }
3586 { EBCDIC-ES-A csEBCDICESA }
3587 { EBCDIC-ES-S csEBCDICESS }
3588 { EBCDIC-UK csEBCDICUK }
3589 { EBCDIC-US csEBCDICUS }
3590 { UNKNOWN-8BIT csUnknown8BiT }
3591 { MNEMONIC csMnemonic }
3596 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3597 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3598 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3599 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3600 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3601 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3602 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3603 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3604 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3605 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3606 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3607 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3608 { IBM1047 IBM-1047 }
3609 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3610 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3611 { UNICODE-1-1 csUnicode11 }
3614 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3615 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3617 { ISO-8859-15 ISO_8859-15 Latin-9 }
3618 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3619 { GBK CP936 MS936 windows-936 }
3620 { JIS_Encoding csJISEncoding }
3621 { Shift_JIS MS_Kanji csShiftJIS }
3622 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3624 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3625 { ISO-10646-UCS-Basic csUnicodeASCII }
3626 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3627 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3628 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3629 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3630 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3631 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3632 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3633 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3634 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3635 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3636 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3637 { Ventura-US csVenturaUS }
3638 { Ventura-International csVenturaInternational }
3639 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3640 { PC8-Turkish csPC8Turkish }
3641 { IBM-Symbols csIBMSymbols }
3642 { IBM-Thai csIBMThai }
3643 { HP-Legal csHPLegal }
3644 { HP-Pi-font csHPPiFont }
3645 { HP-Math8 csHPMath8 }
3646 { Adobe-Symbol-Encoding csHPPSMath }
3647 { HP-DeskTop csHPDesktop }
3648 { Ventura-Math csVenturaMath }
3649 { Microsoft-Publishing csMicrosoftPublishing }
3650 { Windows-31J csWindows31J }
3655 proc tcl_encoding {enc} {
3656 global encoding_aliases
3657 set names [encoding names]
3658 set lcnames [string tolower $names]
3659 set enc [string tolower $enc]
3660 set i [lsearch -exact $lcnames $enc]
3662 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3663 if {[regsub {^iso[-_]} $enc iso encx]} {
3664 set i [lsearch -exact $lcnames $encx]
3668 foreach l $encoding_aliases {
3669 set ll [string tolower $l]
3670 if {[lsearch -exact $ll $enc] < 0} continue
3671 # look through the aliases for one that tcl knows about
3673 set i [lsearch -exact $lcnames $e]
3675 if {[regsub {^iso[-_]} $e iso ex]} {
3676 set i [lsearch -exact $lcnames $ex]
3685 return [lindex $names $i]
3692 set diffopts "-U 5 -p"
3693 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3697 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3699 if {$gitencoding == ""} {
3700 set gitencoding "utf-8"
3702 set tclencoding [tcl_encoding $gitencoding]
3703 if {$tclencoding == {}} {
3704 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3707 set mainfont {Helvetica 9}
3708 set textfont {Courier 9}
3709 set findmergefiles 0
3715 set colors {green red blue magenta darkgrey brown orange}
3717 catch {source ~/.gitk}
3719 set namefont $mainfont
3721 font create optionfont -family sans-serif -size -12
3725 switch -regexp -- $arg {
3727 "^-d" { set datemode 1 }
3728 "^-r" { set revlistorder 1 }
3730 lappend revtreeargs $arg
3743 makewindow $revtreeargs
3745 getcommits $revtreeargs