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 datemode
39 set startmsecs [clock clicks -milliseconds]
40 set nextupdate [expr {$startmsecs + 100}]
43 set order "--topo-order"
45 set order "--date-order"
48 set commfd [open [concat | git-rev-list --header $order \
49 --parents --boundary $rlargs] r]
51 puts stderr "Error executing git-rev-list: $err"
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
64 proc getcommits {rargs} {
65 global phase canv mainfont
68 start_rev_list [parse_args $rargs]
70 $canv create text 3 3 -anchor nw -text "Reading commits..." \
71 -font $mainfont -tags textitems
74 proc getcommitlines {commfd} {
75 global commitlisted nextupdate
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
80 set stuff [read $commfd]
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
89 if {[string range $err 0 4] == "usage"} {
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.)"
95 set err "Error reading commits: $err"
103 set i [string first "\0" $stuff $start]
105 append leftover [string range $stuff $start end]
110 append cmit [string range $stuff 0 [expr {$i - 1}]]
113 set cmit [string range $stuff $start [expr {$i - 1}]]
115 set start [expr {$i + 1}]
116 set j [string first "\n" $cmit]
120 set ids [string range $cmit 0 [expr {$j - 1}]]
121 if {[string range $ids 0 0] == "-"} {
123 set ids [string range $ids 1 end]
127 if {[string length $id] != 40} {
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}"
141 set id [lindex $ids 0]
143 set olds [lrange $ids 1 end]
144 if {[llength $olds] > 1} {
145 set olds [lsort -unique $olds]
148 lappend children($p) $id
153 lappend parentlist $olds
154 if {[info exists children($id)]} {
155 lappend childlist $children($id)
159 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
160 set commitrow($id) $commitidx
162 lappend displayorder $id
163 lappend commitlisted $listed
169 if {[clock clicks -milliseconds] >= $nextupdate} {
174 proc doupdate {reading} {
175 global commfd nextupdate numcommits ncmupdate
178 fileevent $commfd readable {}
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}]
187 set ncmupdate [expr {$numcommits + 100}]
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} {
201 foreach v {colormap selectedline matchinglines treediffs
202 mergefilelist currentid rowtextx commitrow
203 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
204 linesegends crossings cornercrossings} {
213 proc parsecommit {id contents listed} {
214 global commitinfo cdate
223 set hdrend [string first "\n\n" $contents]
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]
241 # take the first line of the comment as the headline
242 set i [string first "\n" $comment]
244 set headline [string trim [string range $comment 0 $i]]
246 set headline $comment
249 # git-rev-list indents the comment by 4 spaces;
250 # if we got this via git-cat-file, add the indentation
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
273 if {![info exists commitinfo($id)]} {
274 set commitinfo($id) {"No commit information available"}
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
284 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
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 \
293 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
297 if {$type == "tags"} {
298 set tagids($name) $id
299 lappend idtags($id) $name
304 set commit [exec git-rev-parse "$id^0"]
305 if {"$commit" != "$id"} {
306 set tagids($name) $commit
307 lappend idtags($commit) $name
311 set tagcontents($name) [exec git-cat-file tag "$id"]
313 } elseif { $type == "heads" } {
314 set headids($name) $id
315 lappend idheads($id) $name
317 set otherrefids($name) $id
318 lappend idotherrefs($id) $name
324 proc error_popup msg {
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"
337 proc makewindow {rargs} {
338 global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont
339 global findtype findtypemenu findloc findstring fstring geometry
340 global entries sha1entry sha1string sha1but
341 global maincursor textcursor curtextcursor
342 global rowctxmenu mergemax
345 .bar add cascade -label "File" -menu .bar.file
346 .bar configure -font $uifont
348 .bar.file add command -label "Update" -command [list updatecommits $rargs]
349 .bar.file add command -label "Reread references" -command rereadrefs
350 .bar.file add command -label "Quit" -command doquit
351 .bar.file configure -font $uifont
353 .bar add cascade -label "Edit" -menu .bar.edit
354 .bar.edit add command -label "Preferences" -command doprefs
355 .bar.edit configure -font $uifont
357 .bar add cascade -label "Help" -menu .bar.help
358 .bar.help add command -label "About gitk" -command about
359 .bar.help add command -label "Key bindings" -command keys
360 .bar.help configure -font $uifont
361 . configure -menu .bar
363 if {![info exists geometry(canv1)]} {
364 set geometry(canv1) [expr {45 * $charspc}]
365 set geometry(canv2) [expr {30 * $charspc}]
366 set geometry(canv3) [expr {15 * $charspc}]
367 set geometry(canvh) [expr {25 * $linespc + 4}]
368 set geometry(ctextw) 80
369 set geometry(ctexth) 30
370 set geometry(cflistw) 30
372 panedwindow .ctop -orient vertical
373 if {[info exists geometry(width)]} {
374 .ctop conf -width $geometry(width) -height $geometry(height)
375 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
376 set geometry(ctexth) [expr {($texth - 8) /
377 [font metrics $textfont -linespace]}]
381 pack .ctop.top.bar -side bottom -fill x
382 set cscroll .ctop.top.csb
383 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
384 pack $cscroll -side right -fill y
385 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
386 pack .ctop.top.clist -side top -fill both -expand 1
388 set canv .ctop.top.clist.canv
389 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
391 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
392 .ctop.top.clist add $canv
393 set canv2 .ctop.top.clist.canv2
394 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
395 -bg white -bd 0 -yscrollincr $linespc
396 .ctop.top.clist add $canv2
397 set canv3 .ctop.top.clist.canv3
398 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
399 -bg white -bd 0 -yscrollincr $linespc
400 .ctop.top.clist add $canv3
401 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
403 set sha1entry .ctop.top.bar.sha1
404 set entries $sha1entry
405 set sha1but .ctop.top.bar.sha1label
406 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
407 -command gotocommit -width 8 -font $uifont
408 $sha1but conf -disabledforeground [$sha1but cget -foreground]
409 pack .ctop.top.bar.sha1label -side left
410 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
411 trace add variable sha1string write sha1change
412 pack $sha1entry -side left -pady 2
414 image create bitmap bm-left -data {
415 #define left_width 16
416 #define left_height 16
417 static unsigned char left_bits[] = {
418 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
419 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
420 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
422 image create bitmap bm-right -data {
423 #define right_width 16
424 #define right_height 16
425 static unsigned char right_bits[] = {
426 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
427 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
428 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
430 button .ctop.top.bar.leftbut -image bm-left -command goback \
431 -state disabled -width 26
432 pack .ctop.top.bar.leftbut -side left -fill y
433 button .ctop.top.bar.rightbut -image bm-right -command goforw \
434 -state disabled -width 26
435 pack .ctop.top.bar.rightbut -side left -fill y
437 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
438 pack .ctop.top.bar.findbut -side left
440 set fstring .ctop.top.bar.findstring
441 lappend entries $fstring
442 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
443 pack $fstring -side left -expand 1 -fill x
445 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
446 findtype Exact IgnCase Regexp]
447 .ctop.top.bar.findtype configure -font $uifont
448 .ctop.top.bar.findtype.menu configure -font $uifont
449 set findloc "All fields"
450 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
451 Comments Author Committer Files Pickaxe
452 .ctop.top.bar.findloc configure -font $uifont
453 .ctop.top.bar.findloc.menu configure -font $uifont
455 pack .ctop.top.bar.findloc -side right
456 pack .ctop.top.bar.findtype -side right
457 # for making sure type==Exact whenever loc==Pickaxe
458 trace add variable findloc write findlocchange
460 panedwindow .ctop.cdet -orient horizontal
462 frame .ctop.cdet.left
463 set ctext .ctop.cdet.left.ctext
464 text $ctext -bg white -state disabled -font $textfont \
465 -width $geometry(ctextw) -height $geometry(ctexth) \
466 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
467 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
468 pack .ctop.cdet.left.sb -side right -fill y
469 pack $ctext -side left -fill both -expand 1
470 .ctop.cdet add .ctop.cdet.left
472 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
473 $ctext tag conf hunksep -fore blue
474 $ctext tag conf d0 -fore red
475 $ctext tag conf d1 -fore "#00a000"
476 $ctext tag conf m0 -fore red
477 $ctext tag conf m1 -fore blue
478 $ctext tag conf m2 -fore green
479 $ctext tag conf m3 -fore purple
480 $ctext tag conf m4 -fore brown
481 $ctext tag conf m5 -fore "#009090"
482 $ctext tag conf m6 -fore magenta
483 $ctext tag conf m7 -fore "#808000"
484 $ctext tag conf m8 -fore "#009000"
485 $ctext tag conf m9 -fore "#ff0080"
486 $ctext tag conf m10 -fore cyan
487 $ctext tag conf m11 -fore "#b07070"
488 $ctext tag conf m12 -fore "#70b0f0"
489 $ctext tag conf m13 -fore "#70f0b0"
490 $ctext tag conf m14 -fore "#f0b070"
491 $ctext tag conf m15 -fore "#ff70b0"
492 $ctext tag conf mmax -fore darkgrey
494 $ctext tag conf mresult -font [concat $textfont bold]
495 $ctext tag conf msep -font [concat $textfont bold]
496 $ctext tag conf found -back yellow
498 frame .ctop.cdet.right
499 set cflist .ctop.cdet.right.cfiles
500 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
501 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
502 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
503 pack .ctop.cdet.right.sb -side right -fill y
504 pack $cflist -side left -fill both -expand 1
505 .ctop.cdet add .ctop.cdet.right
506 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
508 pack .ctop -side top -fill both -expand 1
510 bindall <1> {selcanvline %W %x %y}
511 #bindall <B1-Motion> {selcanvline %W %x %y}
512 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
513 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
514 bindall <2> "canvscan mark %W %x %y"
515 bindall <B2-Motion> "canvscan dragto %W %x %y"
516 bindkey <Home> selfirstline
517 bindkey <End> sellastline
518 bind . <Key-Up> "selnextline -1"
519 bind . <Key-Down> "selnextline 1"
520 bindkey <Key-Right> "goforw"
521 bindkey <Key-Left> "goback"
522 bind . <Key-Prior> "selnextpage -1"
523 bind . <Key-Next> "selnextpage 1"
524 bind . <Control-Home> "allcanvs yview moveto 0.0"
525 bind . <Control-End> "allcanvs yview moveto 1.0"
526 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
527 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
528 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
529 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
530 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
531 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
532 bindkey <Key-space> "$ctext yview scroll 1 pages"
533 bindkey p "selnextline -1"
534 bindkey n "selnextline 1"
537 bindkey i "selnextline -1"
538 bindkey k "selnextline 1"
541 bindkey b "$ctext yview scroll -1 pages"
542 bindkey d "$ctext yview scroll 18 units"
543 bindkey u "$ctext yview scroll -18 units"
544 bindkey / {findnext 1}
545 bindkey <Key-Return> {findnext 0}
548 bind . <Control-q> doquit
549 bind . <Control-f> dofind
550 bind . <Control-g> {findnext 0}
551 bind . <Control-r> findprev
552 bind . <Control-equal> {incrfont 1}
553 bind . <Control-KP_Add> {incrfont 1}
554 bind . <Control-minus> {incrfont -1}
555 bind . <Control-KP_Subtract> {incrfont -1}
556 bind $cflist <<ListboxSelect>> listboxsel
557 bind . <Destroy> {savestuff %W}
558 bind . <Button-1> "click %W"
559 bind $fstring <Key-Return> dofind
560 bind $sha1entry <Key-Return> gotocommit
561 bind $sha1entry <<PasteSelection>> clearsha1
563 set maincursor [. cget -cursor]
564 set textcursor [$ctext cget -cursor]
565 set curtextcursor $textcursor
567 set rowctxmenu .rowctxmenu
568 menu $rowctxmenu -tearoff 0
569 $rowctxmenu add command -label "Diff this -> selected" \
570 -command {diffvssel 0}
571 $rowctxmenu add command -label "Diff selected -> this" \
572 -command {diffvssel 1}
573 $rowctxmenu add command -label "Make patch" -command mkpatch
574 $rowctxmenu add command -label "Create tag" -command mktag
575 $rowctxmenu add command -label "Write commit to file" -command writecommit
578 # mouse-2 makes all windows scan vertically, but only the one
579 # the cursor is in scans horizontally
580 proc canvscan {op w x y} {
581 global canv canv2 canv3
582 foreach c [list $canv $canv2 $canv3] {
591 proc scrollcanv {cscroll f0 f1} {
596 # when we make a key binding for the toplevel, make sure
597 # it doesn't get triggered when that key is pressed in the
598 # find string entry widget.
599 proc bindkey {ev script} {
602 set escript [bind Entry $ev]
603 if {$escript == {}} {
604 set escript [bind Entry <Key>]
607 bind $e $ev "$escript; break"
611 # set the focus back to the toplevel for any click outside
622 global canv canv2 canv3 ctext cflist mainfont textfont uifont
623 global stuffsaved findmergefiles maxgraphpct
626 if {$stuffsaved} return
627 if {![winfo viewable .]} return
629 set f [open "~/.gitk-new" w]
630 puts $f [list set mainfont $mainfont]
631 puts $f [list set textfont $textfont]
632 puts $f [list set uifont $uifont]
633 puts $f [list set findmergefiles $findmergefiles]
634 puts $f [list set maxgraphpct $maxgraphpct]
635 puts $f [list set maxwidth $maxwidth]
636 puts $f "set geometry(width) [winfo width .ctop]"
637 puts $f "set geometry(height) [winfo height .ctop]"
638 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
639 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
640 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
641 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
642 set wid [expr {([winfo width $ctext] - 8) \
643 / [font measure $textfont "0"]}]
644 puts $f "set geometry(ctextw) $wid"
645 set wid [expr {([winfo width $cflist] - 11) \
646 / [font measure [$cflist cget -font] "0"]}]
647 puts $f "set geometry(cflistw) $wid"
649 file rename -force "~/.gitk-new" "~/.gitk"
654 proc resizeclistpanes {win w} {
656 if {[info exists oldwidth($win)]} {
657 set s0 [$win sash coord 0]
658 set s1 [$win sash coord 1]
660 set sash0 [expr {int($w/2 - 2)}]
661 set sash1 [expr {int($w*5/6 - 2)}]
663 set factor [expr {1.0 * $w / $oldwidth($win)}]
664 set sash0 [expr {int($factor * [lindex $s0 0])}]
665 set sash1 [expr {int($factor * [lindex $s1 0])}]
669 if {$sash1 < $sash0 + 20} {
670 set sash1 [expr {$sash0 + 20}]
672 if {$sash1 > $w - 10} {
673 set sash1 [expr {$w - 10}]
674 if {$sash0 > $sash1 - 20} {
675 set sash0 [expr {$sash1 - 20}]
679 $win sash place 0 $sash0 [lindex $s0 1]
680 $win sash place 1 $sash1 [lindex $s1 1]
682 set oldwidth($win) $w
685 proc resizecdetpanes {win w} {
687 if {[info exists oldwidth($win)]} {
688 set s0 [$win sash coord 0]
690 set sash0 [expr {int($w*3/4 - 2)}]
692 set factor [expr {1.0 * $w / $oldwidth($win)}]
693 set sash0 [expr {int($factor * [lindex $s0 0])}]
697 if {$sash0 > $w - 15} {
698 set sash0 [expr {$w - 15}]
701 $win sash place 0 $sash0 [lindex $s0 1]
703 set oldwidth($win) $w
707 global canv canv2 canv3
713 proc bindall {event action} {
714 global canv canv2 canv3
715 bind $canv $event $action
716 bind $canv2 $event $action
717 bind $canv3 $event $action
722 if {[winfo exists $w]} {
727 wm title $w "About gitk"
729 Gitk - a commit viewer for git
731 Copyright © 2005-2006 Paul Mackerras
733 Use and redistribute under the terms of the GNU General Public License} \
734 -justify center -aspect 400
735 pack $w.m -side top -fill x -padx 20 -pady 20
736 button $w.ok -text Close -command "destroy $w"
737 pack $w.ok -side bottom
742 if {[winfo exists $w]} {
747 wm title $w "Gitk key bindings"
752 <Home> Move to first commit
753 <End> Move to last commit
754 <Up>, p, i Move up one commit
755 <Down>, n, k Move down one commit
756 <Left>, z, j Go back in history list
757 <Right>, x, l Go forward in history list
758 <PageUp> Move up one page in commit list
759 <PageDown> Move down one page in commit list
760 <Ctrl-Home> Scroll to top of commit list
761 <Ctrl-End> Scroll to bottom of commit list
762 <Ctrl-Up> Scroll commit list up one line
763 <Ctrl-Down> Scroll commit list down one line
764 <Ctrl-PageUp> Scroll commit list up one page
765 <Ctrl-PageDown> Scroll commit list down one page
766 <Delete>, b Scroll diff view up one page
767 <Backspace> Scroll diff view up one page
768 <Space> Scroll diff view down one page
769 u Scroll diff view up 18 lines
770 d Scroll diff view down 18 lines
772 <Ctrl-G> Move to next find hit
773 <Ctrl-R> Move to previous find hit
774 <Return> Move to next find hit
775 / Move to next find hit, or redo find
776 ? Move to previous find hit
777 f Scroll diff view to next file
778 <Ctrl-KP+> Increase font size
779 <Ctrl-plus> Increase font size
780 <Ctrl-KP-> Decrease font size
781 <Ctrl-minus> Decrease font size
783 -justify left -bg white -border 2 -relief sunken
784 pack $w.m -side top -fill both
785 button $w.ok -text Close -command "destroy $w"
786 pack $w.ok -side bottom
789 proc shortids {ids} {
792 if {[llength $id] > 1} {
793 lappend res [shortids $id]
794 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
795 lappend res [string range $id 0 7]
803 proc incrange {l x o} {
808 lset l $x [expr {$e + $o}]
817 for {} {$n > 0} {incr n -1} {
823 proc usedinrange {id l1 l2} {
824 global children commitrow
826 if {[info exists commitrow($id)]} {
827 set r $commitrow($id)
828 if {$l1 <= $r && $r <= $l2} {
829 return [expr {$r - $l1 + 1}]
832 foreach c $children($id) {
833 if {[info exists commitrow($c)]} {
835 if {$l1 <= $r && $r <= $l2} {
836 return [expr {$r - $l1 + 1}]
843 proc sanity {row {full 0}} {
844 global rowidlist rowoffsets
847 set ids [lindex $rowidlist $row]
850 if {$id eq {}} continue
851 if {$col < [llength $ids] - 1 &&
852 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
853 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
855 set o [lindex $rowoffsets $row $col]
861 if {[lindex $rowidlist $y $x] != $id} {
862 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
863 puts " id=[shortids $id] check started at row $row"
864 for {set i $row} {$i >= $y} {incr i -1} {
865 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
870 set o [lindex $rowoffsets $y $x]
875 proc makeuparrow {oid x y z} {
876 global rowidlist rowoffsets uparrowlen idrowranges
878 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
881 set off0 [lindex $rowoffsets $y]
882 for {set x0 $x} {1} {incr x0} {
883 if {$x0 >= [llength $off0]} {
884 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
887 set z [lindex $off0 $x0]
893 set z [expr {$x0 - $x}]
894 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
895 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
897 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
898 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
899 lappend idrowranges($oid) $y
903 global rowidlist rowoffsets displayorder commitlisted
904 global rowlaidout rowoptim
905 global idinlist rowchk
906 global commitidx numcommits canvxmax canv
908 global parentlist childlist children
916 catch {unset children}
920 catch {unset idinlist}
924 set canvxmax [$canv cget -width]
927 proc setcanvscroll {} {
928 global canv canv2 canv3 numcommits linespc canvxmax canvy0
930 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
931 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
932 $canv2 conf -scrollregion [list 0 0 0 $ymax]
933 $canv3 conf -scrollregion [list 0 0 0 $ymax]
936 proc visiblerows {} {
937 global canv numcommits linespc
939 set ymax [lindex [$canv cget -scrollregion] 3]
940 if {$ymax eq {} || $ymax == 0} return
942 set y0 [expr {int([lindex $f 0] * $ymax)}]
943 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
947 set y1 [expr {int([lindex $f 1] * $ymax)}]
948 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
949 if {$r1 >= $numcommits} {
950 set r1 [expr {$numcommits - 1}]
952 return [list $r0 $r1]
956 global rowlaidout rowoptim commitidx numcommits optim_delay
960 set rowlaidout [layoutrows $row $commitidx 0]
961 set orow [expr {$rowlaidout - $uparrowlen - 1}]
962 if {$orow > $rowoptim} {
963 checkcrossings $rowoptim $orow
964 optimize_rows $rowoptim 0 $orow
967 set canshow [expr {$rowoptim - $optim_delay}]
968 if {$canshow > $numcommits} {
973 proc showstuff {canshow} {
975 global linesegends idrowranges idrangedrawn
977 if {$numcommits == 0} {
983 set numcommits $canshow
985 set rows [visiblerows]
986 set r0 [lindex $rows 0]
987 set r1 [lindex $rows 1]
988 for {set r $row} {$r < $canshow} {incr r} {
989 if {[info exists linesegends($r)]} {
990 foreach id $linesegends($r) {
992 foreach {s e} $idrowranges($id) {
994 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
995 && ![info exists idrangedrawn($id,$i)]} {
997 set idrangedrawn($id,$i) 1
1003 if {$canshow > $r1} {
1006 while {$row < $canshow} {
1012 proc layoutrows {row endrow last} {
1013 global rowidlist rowoffsets displayorder
1014 global uparrowlen downarrowlen maxwidth mingaplen
1015 global childlist parentlist
1016 global idrowranges linesegends
1018 global idinlist rowchk
1020 set idlist [lindex $rowidlist $row]
1021 set offs [lindex $rowoffsets $row]
1022 while {$row < $endrow} {
1023 set id [lindex $displayorder $row]
1026 foreach p [lindex $parentlist $row] {
1027 if {![info exists idinlist($p)]} {
1029 } elseif {!$idinlist($p)} {
1033 set nev [expr {[llength $idlist] + [llength $newolds]
1034 + [llength $oldolds] - $maxwidth + 1}]
1036 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1037 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1038 set i [lindex $idlist $x]
1039 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1040 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1041 [expr {$row + $uparrowlen + $mingaplen}]]
1043 set idlist [lreplace $idlist $x $x]
1044 set offs [lreplace $offs $x $x]
1045 set offs [incrange $offs $x 1]
1047 set rm1 [expr {$row - 1}]
1048 lappend linesegends($rm1) $i
1049 lappend idrowranges($i) $rm1
1050 if {[incr nev -1] <= 0} break
1053 set rowchk($id) [expr {$row + $r}]
1056 lset rowidlist $row $idlist
1057 lset rowoffsets $row $offs
1059 set col [lsearch -exact $idlist $id]
1061 set col [llength $idlist]
1063 lset rowidlist $row $idlist
1065 if {[lindex $childlist $row] ne {}} {
1066 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1070 lset rowoffsets $row $offs
1072 makeuparrow $id $col $row $z
1077 if {[info exists idrowranges($id)]} {
1078 lappend idrowranges($id) $row
1081 set offs [ntimes [llength $idlist] 0]
1082 set l [llength $newolds]
1083 set idlist [eval lreplace \$idlist $col $col $newolds]
1086 set offs [lrange $offs 0 [expr {$col - 1}]]
1087 foreach x $newolds {
1092 set tmp [expr {[llength $idlist] - [llength $offs]}]
1094 set offs [concat $offs [ntimes $tmp $o]]
1099 foreach i $newolds {
1101 set idrowranges($i) $row
1104 foreach oid $oldolds {
1105 set idinlist($oid) 1
1106 set idlist [linsert $idlist $col $oid]
1107 set offs [linsert $offs $col $o]
1108 makeuparrow $oid $col $row $o
1111 lappend rowidlist $idlist
1112 lappend rowoffsets $offs
1117 proc addextraid {id row} {
1118 global displayorder commitrow commitinfo
1119 global commitidx commitlisted
1120 global parentlist childlist children
1123 lappend displayorder $id
1124 lappend commitlisted 0
1125 lappend parentlist {}
1126 set commitrow($id) $row
1128 if {![info exists commitinfo($id)]} {
1129 set commitinfo($id) {"No commit information available"}
1131 if {[info exists children($id)]} {
1132 lappend childlist $children($id)
1134 lappend childlist {}
1138 proc layouttail {} {
1139 global rowidlist rowoffsets idinlist commitidx
1143 set idlist [lindex $rowidlist $row]
1144 while {$idlist ne {}} {
1145 set col [expr {[llength $idlist] - 1}]
1146 set id [lindex $idlist $col]
1149 lappend idrowranges($id) $row
1151 set offs [ntimes $col 0]
1152 set idlist [lreplace $idlist $col $col]
1153 lappend rowidlist $idlist
1154 lappend rowoffsets $offs
1157 foreach id [array names idinlist] {
1159 lset rowidlist $row [list $id]
1160 lset rowoffsets $row 0
1161 makeuparrow $id 0 $row 0
1162 lappend idrowranges($id) $row
1164 lappend rowidlist {}
1165 lappend rowoffsets {}
1169 proc insert_pad {row col npad} {
1170 global rowidlist rowoffsets
1172 set pad [ntimes $npad {}]
1173 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1174 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1175 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1178 proc optimize_rows {row col endrow} {
1179 global rowidlist rowoffsets idrowranges linesegends displayorder
1181 for {} {$row < $endrow} {incr row} {
1182 set idlist [lindex $rowidlist $row]
1183 set offs [lindex $rowoffsets $row]
1185 for {} {$col < [llength $offs]} {incr col} {
1186 if {[lindex $idlist $col] eq {}} {
1190 set z [lindex $offs $col]
1191 if {$z eq {}} continue
1193 set x0 [expr {$col + $z}]
1194 set y0 [expr {$row - 1}]
1195 set z0 [lindex $rowoffsets $y0 $x0]
1197 set id [lindex $idlist $col]
1198 if {[info exists idrowranges($id)] &&
1199 $y0 > [lindex $idrowranges($id) 0]} {
1203 if {$z < -1 || ($z < 0 && $isarrow)} {
1204 set npad [expr {-1 - $z + $isarrow}]
1205 set offs [incrange $offs $col $npad]
1206 insert_pad $y0 $x0 $npad
1208 optimize_rows $y0 $x0 $row
1210 set z [lindex $offs $col]
1211 set x0 [expr {$col + $z}]
1212 set z0 [lindex $rowoffsets $y0 $x0]
1213 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1214 set npad [expr {$z - 1 + $isarrow}]
1215 set y1 [expr {$row + 1}]
1216 set offs2 [lindex $rowoffsets $y1]
1220 if {$z eq {} || $x1 + $z < $col} continue
1221 if {$x1 + $z > $col} {
1224 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1227 set pad [ntimes $npad {}]
1228 set idlist [eval linsert \$idlist $col $pad]
1229 set tmp [eval linsert \$offs $col $pad]
1231 set offs [incrange $tmp $col [expr {-$npad}]]
1232 set z [lindex $offs $col]
1235 if {$z0 eq {} && !$isarrow} {
1236 # this line links to its first child on row $row-2
1237 set rm2 [expr {$row - 2}]
1238 set id [lindex $displayorder $rm2]
1239 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1241 set z0 [expr {$xc - $x0}]
1244 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1245 insert_pad $y0 $x0 1
1246 set offs [incrange $offs $col 1]
1247 optimize_rows $y0 [expr {$x0 + 1}] $row
1252 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1253 set o [lindex $offs $col]
1255 # check if this is the link to the first child
1256 set id [lindex $idlist $col]
1257 if {[info exists idrowranges($id)] &&
1258 $row == [lindex $idrowranges($id) 0]} {
1259 # it is, work out offset to child
1260 set y0 [expr {$row - 1}]
1261 set id [lindex $displayorder $y0]
1262 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1264 set o [expr {$x0 - $col}]
1268 if {$o eq {} || $o <= 0} break
1270 if {$o ne {} && [incr col] < [llength $idlist]} {
1271 set y1 [expr {$row + 1}]
1272 set offs2 [lindex $rowoffsets $y1]
1276 if {$z eq {} || $x1 + $z < $col} continue
1277 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1280 set idlist [linsert $idlist $col {}]
1281 set tmp [linsert $offs $col {}]
1283 set offs [incrange $tmp $col -1]
1286 lset rowidlist $row $idlist
1287 lset rowoffsets $row $offs
1293 global canvx0 linespc
1294 return [expr {$canvx0 + $col * $linespc}]
1298 global canvy0 linespc
1299 return [expr {$canvy0 + $row * $linespc}]
1302 proc linewidth {id} {
1303 global thickerline lthickness
1306 if {[info exists thickerline] && $id eq $thickerline} {
1307 set wid [expr {2 * $lthickness}]
1312 proc drawlineseg {id i} {
1313 global rowoffsets rowidlist idrowranges
1315 global canv colormap linespc
1317 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1318 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1319 if {$startrow == $row} return
1322 set col [lsearch -exact [lindex $rowidlist $row] $id]
1324 puts "oops: drawline: id $id not on row $row"
1330 set o [lindex $rowoffsets $row $col]
1333 # changing direction
1334 set x [xc $row $col]
1336 lappend coords $x $y
1342 set x [xc $row $col]
1344 lappend coords $x $y
1346 # draw the link to the first child as part of this line
1348 set child [lindex $displayorder $row]
1349 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1351 set x [xc $row $ccol]
1353 if {$ccol < $col - 1} {
1354 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1355 } elseif {$ccol > $col + 1} {
1356 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1358 lappend coords $x $y
1361 if {[llength $coords] < 4} return
1362 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1364 # This line has an arrow at the lower end: check if the arrow is
1365 # on a diagonal segment, and if so, work around the Tk 8.4
1366 # refusal to draw arrows on diagonal lines.
1367 set x0 [lindex $coords 0]
1368 set x1 [lindex $coords 2]
1370 set y0 [lindex $coords 1]
1371 set y1 [lindex $coords 3]
1372 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1373 # we have a nearby vertical segment, just trim off the diag bit
1374 set coords [lrange $coords 2 end]
1376 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1377 set xi [expr {$x0 - $slope * $linespc / 2}]
1378 set yi [expr {$y0 - $linespc / 2}]
1379 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1383 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1384 set arrow [lindex {none first last both} $arrow]
1385 set t [$canv create line $coords -width [linewidth $id] \
1386 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1391 proc drawparentlinks {id row col olds} {
1392 global rowidlist canv colormap idrowranges
1394 set row2 [expr {$row + 1}]
1395 set x [xc $row $col]
1398 set ids [lindex $rowidlist $row2]
1399 # rmx = right-most X coord used
1402 set i [lsearch -exact $ids $p]
1404 puts "oops, parent $p of $id not in list"
1407 set x2 [xc $row2 $i]
1411 if {[info exists idrowranges($p)] &&
1412 $row2 == [lindex $idrowranges($p) 0] &&
1413 $row2 < [lindex $idrowranges($p) 1]} {
1414 # drawlineseg will do this one for us
1418 # should handle duplicated parents here...
1419 set coords [list $x $y]
1420 if {$i < $col - 1} {
1421 lappend coords [xc $row [expr {$i + 1}]] $y
1422 } elseif {$i > $col + 1} {
1423 lappend coords [xc $row [expr {$i - 1}]] $y
1425 lappend coords $x2 $y2
1426 set t [$canv create line $coords -width [linewidth $p] \
1427 -fill $colormap($p) -tags lines.$p]
1434 proc drawlines {id} {
1435 global colormap canv
1436 global idrowranges idrangedrawn
1437 global childlist iddrawn commitrow rowidlist
1439 $canv delete lines.$id
1440 set nr [expr {[llength $idrowranges($id)] / 2}]
1441 for {set i 0} {$i < $nr} {incr i} {
1442 if {[info exists idrangedrawn($id,$i)]} {
1446 foreach child [lindex $childlist $commitrow($id)] {
1447 if {[info exists iddrawn($child)]} {
1448 set row $commitrow($child)
1449 set col [lsearch -exact [lindex $rowidlist $row] $child]
1451 drawparentlinks $child $row $col [list $id]
1457 proc drawcmittext {id row col rmx} {
1458 global linespc canv canv2 canv3 canvy0
1459 global commitlisted commitinfo rowidlist
1460 global rowtextx idpos idtags idheads idotherrefs
1461 global linehtag linentag linedtag
1462 global mainfont namefont canvxmax
1464 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1465 set x [xc $row $col]
1467 set orad [expr {$linespc / 3}]
1468 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1469 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1470 -fill $ofill -outline black -width 1]
1472 $canv bind $t <1> {selcanvline {} %x %y}
1473 set xt [xc $row [llength [lindex $rowidlist $row]]]
1477 set rowtextx($row) $xt
1478 set idpos($id) [list $x $xt $y]
1479 if {[info exists idtags($id)] || [info exists idheads($id)]
1480 || [info exists idotherrefs($id)]} {
1481 set xt [drawtags $id $x $xt $y]
1483 set headline [lindex $commitinfo($id) 0]
1484 set name [lindex $commitinfo($id) 1]
1485 set date [lindex $commitinfo($id) 2]
1486 set date [formatdate $date]
1487 set linehtag($row) [$canv create text $xt $y -anchor w \
1488 -text $headline -font $mainfont ]
1489 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1490 set linentag($row) [$canv2 create text 3 $y -anchor w \
1491 -text $name -font $namefont]
1492 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1493 -text $date -font $mainfont]
1494 set xr [expr {$xt + [font measure $mainfont $headline]}]
1495 if {$xr > $canvxmax} {
1501 proc drawcmitrow {row} {
1502 global displayorder rowidlist
1503 global idrowranges idrangedrawn iddrawn
1504 global commitinfo parentlist numcommits
1506 if {$row >= $numcommits} return
1507 foreach id [lindex $rowidlist $row] {
1508 if {![info exists idrowranges($id)]} continue
1510 foreach {s e} $idrowranges($id) {
1512 if {$row < $s} continue
1515 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1517 set idrangedrawn($id,$i) 1
1524 set id [lindex $displayorder $row]
1525 if {[info exists iddrawn($id)]} return
1526 set col [lsearch -exact [lindex $rowidlist $row] $id]
1528 puts "oops, row $row id $id not in list"
1531 if {![info exists commitinfo($id)]} {
1535 set olds [lindex $parentlist $row]
1537 set rmx [drawparentlinks $id $row $col $olds]
1541 drawcmittext $id $row $col $rmx
1545 proc drawfrac {f0 f1} {
1546 global numcommits canv
1549 set ymax [lindex [$canv cget -scrollregion] 3]
1550 if {$ymax eq {} || $ymax == 0} return
1551 set y0 [expr {int($f0 * $ymax)}]
1552 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1556 set y1 [expr {int($f1 * $ymax)}]
1557 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1558 if {$endrow >= $numcommits} {
1559 set endrow [expr {$numcommits - 1}]
1561 for {} {$row <= $endrow} {incr row} {
1566 proc drawvisible {} {
1568 eval drawfrac [$canv yview]
1571 proc clear_display {} {
1572 global iddrawn idrangedrawn
1575 catch {unset iddrawn}
1576 catch {unset idrangedrawn}
1579 proc assigncolor {id} {
1580 global colormap colors nextcolor
1581 global commitrow parentlist children childlist
1582 global cornercrossings crossings
1584 if {[info exists colormap($id)]} return
1585 set ncolors [llength $colors]
1586 if {[info exists commitrow($id)]} {
1587 set kids [lindex $childlist $commitrow($id)]
1588 } elseif {[info exists children($id)]} {
1589 set kids $children($id)
1593 if {[llength $kids] == 1} {
1594 set child [lindex $kids 0]
1595 if {[info exists colormap($child)]
1596 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1597 set colormap($id) $colormap($child)
1602 if {[info exists cornercrossings($id)]} {
1603 foreach x $cornercrossings($id) {
1604 if {[info exists colormap($x)]
1605 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1606 lappend badcolors $colormap($x)
1609 if {[llength $badcolors] >= $ncolors} {
1613 set origbad $badcolors
1614 if {[llength $badcolors] < $ncolors - 1} {
1615 if {[info exists crossings($id)]} {
1616 foreach x $crossings($id) {
1617 if {[info exists colormap($x)]
1618 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1619 lappend badcolors $colormap($x)
1622 if {[llength $badcolors] >= $ncolors} {
1623 set badcolors $origbad
1626 set origbad $badcolors
1628 if {[llength $badcolors] < $ncolors - 1} {
1629 foreach child $kids {
1630 if {[info exists colormap($child)]
1631 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1632 lappend badcolors $colormap($child)
1634 foreach p [lindex $parentlist $commitrow($child)] {
1635 if {[info exists colormap($p)]
1636 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1637 lappend badcolors $colormap($p)
1641 if {[llength $badcolors] >= $ncolors} {
1642 set badcolors $origbad
1645 for {set i 0} {$i <= $ncolors} {incr i} {
1646 set c [lindex $colors $nextcolor]
1647 if {[incr nextcolor] >= $ncolors} {
1650 if {[lsearch -exact $badcolors $c]} break
1652 set colormap($id) $c
1655 proc bindline {t id} {
1658 $canv bind $t <Enter> "lineenter %x %y $id"
1659 $canv bind $t <Motion> "linemotion %x %y $id"
1660 $canv bind $t <Leave> "lineleave $id"
1661 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1664 proc drawtags {id x xt y1} {
1665 global idtags idheads idotherrefs
1666 global linespc lthickness
1667 global canv mainfont commitrow rowtextx
1672 if {[info exists idtags($id)]} {
1673 set marks $idtags($id)
1674 set ntags [llength $marks]
1676 if {[info exists idheads($id)]} {
1677 set marks [concat $marks $idheads($id)]
1678 set nheads [llength $idheads($id)]
1680 if {[info exists idotherrefs($id)]} {
1681 set marks [concat $marks $idotherrefs($id)]
1687 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1688 set yt [expr {$y1 - 0.5 * $linespc}]
1689 set yb [expr {$yt + $linespc - 1}]
1692 foreach tag $marks {
1693 set wid [font measure $mainfont $tag]
1696 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1698 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1699 -width $lthickness -fill black -tags tag.$id]
1701 foreach tag $marks x $xvals wid $wvals {
1702 set xl [expr {$x + $delta}]
1703 set xr [expr {$x + $delta + $wid + $lthickness}]
1704 if {[incr ntags -1] >= 0} {
1706 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1707 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1708 -width 1 -outline black -fill yellow -tags tag.$id]
1709 $canv bind $t <1> [list showtag $tag 1]
1710 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1712 # draw a head or other ref
1713 if {[incr nheads -1] >= 0} {
1718 set xl [expr {$xl - $delta/2}]
1719 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1720 -width 1 -outline black -fill $col -tags tag.$id
1722 set t [$canv create text $xl $y1 -anchor w -text $tag \
1723 -font $mainfont -tags tag.$id]
1725 $canv bind $t <1> [list showtag $tag 1]
1731 proc checkcrossings {row endrow} {
1732 global displayorder parentlist rowidlist
1734 for {} {$row < $endrow} {incr row} {
1735 set id [lindex $displayorder $row]
1736 set i [lsearch -exact [lindex $rowidlist $row] $id]
1737 if {$i < 0} continue
1738 set idlist [lindex $rowidlist [expr {$row+1}]]
1739 foreach p [lindex $parentlist $row] {
1740 set j [lsearch -exact $idlist $p]
1743 notecrossings $row $p $j $i [expr {$j+1}]
1744 } elseif {$j > $i + 1} {
1745 notecrossings $row $p $i $j [expr {$j-1}]
1752 proc notecrossings {row id lo hi corner} {
1753 global rowidlist crossings cornercrossings
1755 for {set i $lo} {[incr i] < $hi} {} {
1756 set p [lindex [lindex $rowidlist $row] $i]
1757 if {$p == {}} continue
1758 if {$i == $corner} {
1759 if {![info exists cornercrossings($id)]
1760 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1761 lappend cornercrossings($id) $p
1763 if {![info exists cornercrossings($p)]
1764 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1765 lappend cornercrossings($p) $id
1768 if {![info exists crossings($id)]
1769 || [lsearch -exact $crossings($id) $p] < 0} {
1770 lappend crossings($id) $p
1772 if {![info exists crossings($p)]
1773 || [lsearch -exact $crossings($p) $id] < 0} {
1774 lappend crossings($p) $id
1780 proc xcoord {i level ln} {
1781 global canvx0 xspc1 xspc2
1783 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1784 if {$i > 0 && $i == $level} {
1785 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1786 } elseif {$i > $level} {
1787 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1792 proc finishcommits {} {
1793 global commitidx phase
1794 global canv mainfont ctext maincursor textcursor
1795 global findinprogress
1797 if {$commitidx > 0} {
1801 $canv create text 3 3 -anchor nw -text "No commits selected" \
1802 -font $mainfont -tags textitems
1804 if {![info exists findinprogress]} {
1805 . config -cursor $maincursor
1806 settextcursor $textcursor
1811 # Don't change the text pane cursor if it is currently the hand cursor,
1812 # showing that we are over a sha1 ID link.
1813 proc settextcursor {c} {
1814 global ctext curtextcursor
1816 if {[$ctext cget -cursor] == $curtextcursor} {
1817 $ctext config -cursor $c
1819 set curtextcursor $c
1825 global canvy0 numcommits linespc
1826 global rowlaidout commitidx
1829 layoutrows $rowlaidout $commitidx 1
1831 optimize_rows $row 0 $commitidx
1832 showstuff $commitidx
1834 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1835 #puts "overall $drawmsecs ms for $numcommits commits"
1838 proc findmatches {f} {
1839 global findtype foundstring foundstrlen
1840 if {$findtype == "Regexp"} {
1841 set matches [regexp -indices -all -inline $foundstring $f]
1843 if {$findtype == "IgnCase"} {
1844 set str [string tolower $f]
1850 while {[set j [string first $foundstring $str $i]] >= 0} {
1851 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1852 set i [expr {$j + $foundstrlen}]
1859 global findtype findloc findstring markedmatches commitinfo
1860 global numcommits displayorder linehtag linentag linedtag
1861 global mainfont namefont canv canv2 canv3 selectedline
1862 global matchinglines foundstring foundstrlen matchstring
1868 set matchinglines {}
1869 if {$findloc == "Pickaxe"} {
1873 if {$findtype == "IgnCase"} {
1874 set foundstring [string tolower $findstring]
1876 set foundstring $findstring
1878 set foundstrlen [string length $findstring]
1879 if {$foundstrlen == 0} return
1880 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1881 set matchstring "*$matchstring*"
1882 if {$findloc == "Files"} {
1886 if {![info exists selectedline]} {
1889 set oldsel $selectedline
1892 set fldtypes {Headline Author Date Committer CDate Comment}
1894 foreach id $displayorder {
1895 set d $commitdata($id)
1897 if {$findtype == "Regexp"} {
1898 set doesmatch [regexp $foundstring $d]
1899 } elseif {$findtype == "IgnCase"} {
1900 set doesmatch [string match -nocase $matchstring $d]
1902 set doesmatch [string match $matchstring $d]
1904 if {!$doesmatch} continue
1905 if {![info exists commitinfo($id)]} {
1908 set info $commitinfo($id)
1910 foreach f $info ty $fldtypes {
1911 if {$findloc != "All fields" && $findloc != $ty} {
1914 set matches [findmatches $f]
1915 if {$matches == {}} continue
1917 if {$ty == "Headline"} {
1919 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1920 } elseif {$ty == "Author"} {
1922 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1923 } elseif {$ty == "Date"} {
1925 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1929 lappend matchinglines $l
1930 if {!$didsel && $l > $oldsel} {
1936 if {$matchinglines == {}} {
1938 } elseif {!$didsel} {
1939 findselectline [lindex $matchinglines 0]
1943 proc findselectline {l} {
1944 global findloc commentend ctext
1946 if {$findloc == "All fields" || $findloc == "Comments"} {
1947 # highlight the matches in the comments
1948 set f [$ctext get 1.0 $commentend]
1949 set matches [findmatches $f]
1950 foreach match $matches {
1951 set start [lindex $match 0]
1952 set end [expr {[lindex $match 1] + 1}]
1953 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1958 proc findnext {restart} {
1959 global matchinglines selectedline
1960 if {![info exists matchinglines]} {
1966 if {![info exists selectedline]} return
1967 foreach l $matchinglines {
1968 if {$l > $selectedline} {
1977 global matchinglines selectedline
1978 if {![info exists matchinglines]} {
1982 if {![info exists selectedline]} return
1984 foreach l $matchinglines {
1985 if {$l >= $selectedline} break
1989 findselectline $prev
1995 proc findlocchange {name ix op} {
1996 global findloc findtype findtypemenu
1997 if {$findloc == "Pickaxe"} {
2003 $findtypemenu entryconf 1 -state $state
2004 $findtypemenu entryconf 2 -state $state
2007 proc stopfindproc {{done 0}} {
2008 global findprocpid findprocfile findids
2009 global ctext findoldcursor phase maincursor textcursor
2010 global findinprogress
2012 catch {unset findids}
2013 if {[info exists findprocpid]} {
2015 catch {exec kill $findprocpid}
2017 catch {close $findprocfile}
2020 if {[info exists findinprogress]} {
2021 unset findinprogress
2022 if {$phase != "incrdraw"} {
2023 . config -cursor $maincursor
2024 settextcursor $textcursor
2029 proc findpatches {} {
2030 global findstring selectedline numcommits
2031 global findprocpid findprocfile
2032 global finddidsel ctext displayorder findinprogress
2033 global findinsertpos
2035 if {$numcommits == 0} return
2037 # make a list of all the ids to search, starting at the one
2038 # after the selected line (if any)
2039 if {[info exists selectedline]} {
2045 for {set i 0} {$i < $numcommits} {incr i} {
2046 if {[incr l] >= $numcommits} {
2049 append inputids [lindex $displayorder $l] "\n"
2053 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2056 error_popup "Error starting search process: $err"
2060 set findinsertpos end
2062 set findprocpid [pid $f]
2063 fconfigure $f -blocking 0
2064 fileevent $f readable readfindproc
2066 . config -cursor watch
2068 set findinprogress 1
2071 proc readfindproc {} {
2072 global findprocfile finddidsel
2073 global commitrow matchinglines findinsertpos
2075 set n [gets $findprocfile line]
2077 if {[eof $findprocfile]} {
2085 if {![regexp {^[0-9a-f]{40}} $line id]} {
2086 error_popup "Can't parse git-diff-tree output: $line"
2090 if {![info exists commitrow($id)]} {
2091 puts stderr "spurious id: $id"
2094 set l $commitrow($id)
2098 proc insertmatch {l id} {
2099 global matchinglines findinsertpos finddidsel
2101 if {$findinsertpos == "end"} {
2102 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2103 set matchinglines [linsert $matchinglines 0 $l]
2106 lappend matchinglines $l
2109 set matchinglines [linsert $matchinglines $findinsertpos $l]
2120 global selectedline numcommits displayorder ctext
2121 global ffileline finddidsel parentlist
2122 global findinprogress findstartline findinsertpos
2123 global treediffs fdiffid fdiffsneeded fdiffpos
2124 global findmergefiles
2126 if {$numcommits == 0} return
2128 if {[info exists selectedline]} {
2129 set l [expr {$selectedline + 1}]
2134 set findstartline $l
2138 set id [lindex $displayorder $l]
2139 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2140 if {![info exists treediffs($id)]} {
2141 append diffsneeded "$id\n"
2142 lappend fdiffsneeded $id
2145 if {[incr l] >= $numcommits} {
2148 if {$l == $findstartline} break
2151 # start off a git-diff-tree process if needed
2152 if {$diffsneeded ne {}} {
2154 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2156 error_popup "Error starting search process: $err"
2159 catch {unset fdiffid}
2161 fconfigure $df -blocking 0
2162 fileevent $df readable [list readfilediffs $df]
2166 set findinsertpos end
2167 set id [lindex $displayorder $l]
2168 . config -cursor watch
2170 set findinprogress 1
2175 proc readfilediffs {df} {
2176 global findid fdiffid fdiffs
2178 set n [gets $df line]
2182 if {[catch {close $df} err]} {
2185 error_popup "Error in git-diff-tree: $err"
2186 } elseif {[info exists findid]} {
2190 error_popup "Couldn't find diffs for $id"
2195 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2196 # start of a new string of diffs
2200 } elseif {[string match ":*" $line]} {
2201 lappend fdiffs [lindex $line 5]
2205 proc donefilediff {} {
2206 global fdiffid fdiffs treediffs findid
2207 global fdiffsneeded fdiffpos
2209 if {[info exists fdiffid]} {
2210 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2211 && $fdiffpos < [llength $fdiffsneeded]} {
2212 # git-diff-tree doesn't output anything for a commit
2213 # which doesn't change anything
2214 set nullid [lindex $fdiffsneeded $fdiffpos]
2215 set treediffs($nullid) {}
2216 if {[info exists findid] && $nullid eq $findid} {
2224 if {![info exists treediffs($fdiffid)]} {
2225 set treediffs($fdiffid) $fdiffs
2227 if {[info exists findid] && $fdiffid eq $findid} {
2235 global findid treediffs parentlist
2236 global ffileline findstartline finddidsel
2237 global displayorder numcommits matchinglines findinprogress
2238 global findmergefiles
2242 set id [lindex $displayorder $l]
2243 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2244 if {![info exists treediffs($id)]} {
2250 foreach f $treediffs($id) {
2251 set x [findmatches $f]
2261 if {[incr l] >= $numcommits} {
2264 if {$l == $findstartline} break
2272 # mark a commit as matching by putting a yellow background
2273 # behind the headline
2274 proc markheadline {l id} {
2275 global canv mainfont linehtag
2278 set bbox [$canv bbox $linehtag($l)]
2279 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2283 # mark the bits of a headline, author or date that match a find string
2284 proc markmatches {canv l str tag matches font} {
2285 set bbox [$canv bbox $tag]
2286 set x0 [lindex $bbox 0]
2287 set y0 [lindex $bbox 1]
2288 set y1 [lindex $bbox 3]
2289 foreach match $matches {
2290 set start [lindex $match 0]
2291 set end [lindex $match 1]
2292 if {$start > $end} continue
2293 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2294 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2295 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2296 [expr {$x0+$xlen+2}] $y1 \
2297 -outline {} -tags matches -fill yellow]
2302 proc unmarkmatches {} {
2303 global matchinglines findids
2304 allcanvs delete matches
2305 catch {unset matchinglines}
2306 catch {unset findids}
2309 proc selcanvline {w x y} {
2310 global canv canvy0 ctext linespc
2312 set ymax [lindex [$canv cget -scrollregion] 3]
2313 if {$ymax == {}} return
2314 set yfrac [lindex [$canv yview] 0]
2315 set y [expr {$y + $yfrac * $ymax}]
2316 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2321 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2327 proc commit_descriptor {p} {
2330 if {[info exists commitinfo($p)]} {
2331 set l [lindex $commitinfo($p) 0]
2336 # append some text to the ctext widget, and make any SHA1 ID
2337 # that we know about be a clickable link.
2338 proc appendwithlinks {text} {
2339 global ctext commitrow linknum
2341 set start [$ctext index "end - 1c"]
2342 $ctext insert end $text
2343 $ctext insert end "\n"
2344 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2348 set linkid [string range $text $s $e]
2349 if {![info exists commitrow($linkid)]} continue
2351 $ctext tag add link "$start + $s c" "$start + $e c"
2352 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2353 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2356 $ctext tag conf link -foreground blue -underline 1
2357 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2358 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2361 proc viewnextline {dir} {
2365 set ymax [lindex [$canv cget -scrollregion] 3]
2366 set wnow [$canv yview]
2367 set wtop [expr {[lindex $wnow 0] * $ymax}]
2368 set newtop [expr {$wtop + $dir * $linespc}]
2371 } elseif {$newtop > $ymax} {
2374 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2377 proc selectline {l isnew} {
2378 global canv canv2 canv3 ctext commitinfo selectedline
2379 global displayorder linehtag linentag linedtag
2380 global canvy0 linespc parentlist childlist
2381 global cflist currentid sha1entry
2382 global commentend idtags linknum
2383 global mergemax numcommits
2387 if {$l < 0 || $l >= $numcommits} return
2388 set y [expr {$canvy0 + $l * $linespc}]
2389 set ymax [lindex [$canv cget -scrollregion] 3]
2390 set ytop [expr {$y - $linespc - 1}]
2391 set ybot [expr {$y + $linespc + 1}]
2392 set wnow [$canv yview]
2393 set wtop [expr {[lindex $wnow 0] * $ymax}]
2394 set wbot [expr {[lindex $wnow 1] * $ymax}]
2395 set wh [expr {$wbot - $wtop}]
2397 if {$ytop < $wtop} {
2398 if {$ybot < $wtop} {
2399 set newtop [expr {$y - $wh / 2.0}]
2402 if {$newtop > $wtop - $linespc} {
2403 set newtop [expr {$wtop - $linespc}]
2406 } elseif {$ybot > $wbot} {
2407 if {$ytop > $wbot} {
2408 set newtop [expr {$y - $wh / 2.0}]
2410 set newtop [expr {$ybot - $wh}]
2411 if {$newtop < $wtop + $linespc} {
2412 set newtop [expr {$wtop + $linespc}]
2416 if {$newtop != $wtop} {
2420 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2424 if {![info exists linehtag($l)]} return
2426 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2427 -tags secsel -fill [$canv cget -selectbackground]]
2429 $canv2 delete secsel
2430 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2431 -tags secsel -fill [$canv2 cget -selectbackground]]
2433 $canv3 delete secsel
2434 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2435 -tags secsel -fill [$canv3 cget -selectbackground]]
2439 addtohistory [list selectline $l 0]
2444 set id [lindex $displayorder $l]
2446 $sha1entry delete 0 end
2447 $sha1entry insert 0 $id
2448 $sha1entry selection from 0
2449 $sha1entry selection to end
2451 $ctext conf -state normal
2452 $ctext delete 0.0 end
2454 $ctext mark set fmark.0 0.0
2455 $ctext mark gravity fmark.0 left
2456 set info $commitinfo($id)
2457 set date [formatdate [lindex $info 2]]
2458 $ctext insert end "Author: [lindex $info 1] $date\n"
2459 set date [formatdate [lindex $info 4]]
2460 $ctext insert end "Committer: [lindex $info 3] $date\n"
2461 if {[info exists idtags($id)]} {
2462 $ctext insert end "Tags:"
2463 foreach tag $idtags($id) {
2464 $ctext insert end " $tag"
2466 $ctext insert end "\n"
2470 set olds [lindex $parentlist $l]
2471 if {[llength $olds] > 1} {
2474 if {$np >= $mergemax} {
2479 $ctext insert end "Parent: " $tag
2480 appendwithlinks [commit_descriptor $p]
2485 append comment "Parent: [commit_descriptor $p]\n"
2489 foreach c [lindex $childlist $l] {
2490 append comment "Child: [commit_descriptor $c]\n"
2493 append comment [lindex $info 5]
2495 # make anything that looks like a SHA1 ID be a clickable link
2496 appendwithlinks $comment
2498 $ctext tag delete Comments
2499 $ctext tag remove found 1.0 end
2500 $ctext conf -state disabled
2501 set commentend [$ctext index "end - 1c"]
2503 $cflist delete 0 end
2504 $cflist insert end "Comments"
2505 if {[llength $olds] <= 1} {
2512 proc selfirstline {} {
2517 proc sellastline {} {
2520 set l [expr {$numcommits - 1}]
2524 proc selnextline {dir} {
2526 if {![info exists selectedline]} return
2527 set l [expr {$selectedline + $dir}]
2532 proc selnextpage {dir} {
2533 global canv linespc selectedline numcommits
2535 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2539 allcanvs yview scroll [expr {$dir * $lpp}] units
2540 if {![info exists selectedline]} return
2541 set l [expr {$selectedline + $dir * $lpp}]
2544 } elseif {$l >= $numcommits} {
2545 set l [expr $numcommits - 1]
2551 proc unselectline {} {
2554 catch {unset selectedline}
2555 allcanvs delete secsel
2558 proc addtohistory {cmd} {
2559 global history historyindex
2561 if {$historyindex > 0
2562 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2566 if {$historyindex < [llength $history]} {
2567 set history [lreplace $history $historyindex end $cmd]
2569 lappend history $cmd
2572 if {$historyindex > 1} {
2573 .ctop.top.bar.leftbut conf -state normal
2575 .ctop.top.bar.leftbut conf -state disabled
2577 .ctop.top.bar.rightbut conf -state disabled
2581 global history historyindex
2583 if {$historyindex > 1} {
2584 incr historyindex -1
2585 set cmd [lindex $history [expr {$historyindex - 1}]]
2587 .ctop.top.bar.rightbut conf -state normal
2589 if {$historyindex <= 1} {
2590 .ctop.top.bar.leftbut conf -state disabled
2595 global history historyindex
2597 if {$historyindex < [llength $history]} {
2598 set cmd [lindex $history $historyindex]
2601 .ctop.top.bar.leftbut conf -state normal
2603 if {$historyindex >= [llength $history]} {
2604 .ctop.top.bar.rightbut conf -state disabled
2608 proc mergediff {id l} {
2609 global diffmergeid diffopts mdifffd
2610 global difffilestart diffids
2615 catch {unset difffilestart}
2616 # this doesn't seem to actually affect anything...
2617 set env(GIT_DIFF_OPTS) $diffopts
2618 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2619 if {[catch {set mdf [open $cmd r]} err]} {
2620 error_popup "Error getting merge diffs: $err"
2623 fconfigure $mdf -blocking 0
2624 set mdifffd($id) $mdf
2625 set np [llength [lindex $parentlist $l]]
2626 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2627 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2630 proc getmergediffline {mdf id np} {
2631 global diffmergeid ctext cflist nextupdate mergemax
2632 global difffilestart mdifffd
2634 set n [gets $mdf line]
2641 if {![info exists diffmergeid] || $id != $diffmergeid
2642 || $mdf != $mdifffd($id)} {
2645 $ctext conf -state normal
2646 if {[regexp {^diff --cc (.*)} $line match fname]} {
2647 # start of a new file
2648 $ctext insert end "\n"
2649 set here [$ctext index "end - 1c"]
2650 set i [$cflist index end]
2651 $ctext mark set fmark.$i $here
2652 $ctext mark gravity fmark.$i left
2653 set difffilestart([expr {$i-1}]) $here
2654 $cflist insert end $fname
2655 set l [expr {(78 - [string length $fname]) / 2}]
2656 set pad [string range "----------------------------------------" 1 $l]
2657 $ctext insert end "$pad $fname $pad\n" filesep
2658 } elseif {[regexp {^@@} $line]} {
2659 $ctext insert end "$line\n" hunksep
2660 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2663 # parse the prefix - one ' ', '-' or '+' for each parent
2668 for {set j 0} {$j < $np} {incr j} {
2669 set c [string range $line $j $j]
2672 } elseif {$c == "-"} {
2674 } elseif {$c == "+"} {
2683 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2684 # line doesn't appear in result, parents in $minuses have the line
2685 set num [lindex $minuses 0]
2686 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2687 # line appears in result, parents in $pluses don't have the line
2688 lappend tags mresult
2689 set num [lindex $spaces 0]
2692 if {$num >= $mergemax} {
2697 $ctext insert end "$line\n" $tags
2699 $ctext conf -state disabled
2700 if {[clock clicks -milliseconds] >= $nextupdate} {
2702 fileevent $mdf readable {}
2704 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2708 proc startdiff {ids} {
2709 global treediffs diffids treepending diffmergeid
2712 catch {unset diffmergeid}
2713 if {![info exists treediffs($ids)]} {
2714 if {![info exists treepending]} {
2722 proc addtocflist {ids} {
2723 global treediffs cflist
2724 foreach f $treediffs($ids) {
2725 $cflist insert end $f
2730 proc gettreediffs {ids} {
2731 global treediff treepending
2732 set treepending $ids
2735 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2737 fconfigure $gdtf -blocking 0
2738 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2741 proc gettreediffline {gdtf ids} {
2742 global treediff treediffs treepending diffids diffmergeid
2744 set n [gets $gdtf line]
2746 if {![eof $gdtf]} return
2748 set treediffs($ids) $treediff
2750 if {$ids != $diffids} {
2751 if {![info exists diffmergeid]} {
2752 gettreediffs $diffids
2759 set file [lindex $line 5]
2760 lappend treediff $file
2763 proc getblobdiffs {ids} {
2764 global diffopts blobdifffd diffids env curdifftag curtagstart
2765 global difffilestart nextupdate diffinhdr treediffs
2767 set env(GIT_DIFF_OPTS) $diffopts
2768 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2769 if {[catch {set bdf [open $cmd r]} err]} {
2770 puts "error getting diffs: $err"
2774 fconfigure $bdf -blocking 0
2775 set blobdifffd($ids) $bdf
2776 set curdifftag Comments
2778 catch {unset difffilestart}
2779 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2780 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2783 proc getblobdiffline {bdf ids} {
2784 global diffids blobdifffd ctext curdifftag curtagstart
2785 global diffnexthead diffnextnote difffilestart
2786 global nextupdate diffinhdr treediffs
2788 set n [gets $bdf line]
2792 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2793 $ctext tag add $curdifftag $curtagstart end
2798 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2801 $ctext conf -state normal
2802 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2803 # start of a new file
2804 $ctext insert end "\n"
2805 $ctext tag add $curdifftag $curtagstart end
2806 set curtagstart [$ctext index "end - 1c"]
2808 set here [$ctext index "end - 1c"]
2809 set i [lsearch -exact $treediffs($diffids) $fname]
2811 set difffilestart($i) $here
2813 $ctext mark set fmark.$i $here
2814 $ctext mark gravity fmark.$i left
2816 if {$newname != $fname} {
2817 set i [lsearch -exact $treediffs($diffids) $newname]
2819 set difffilestart($i) $here
2821 $ctext mark set fmark.$i $here
2822 $ctext mark gravity fmark.$i left
2825 set curdifftag "f:$fname"
2826 $ctext tag delete $curdifftag
2827 set l [expr {(78 - [string length $header]) / 2}]
2828 set pad [string range "----------------------------------------" 1 $l]
2829 $ctext insert end "$pad $header $pad\n" filesep
2831 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2833 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2835 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2836 $line match f1l f1c f2l f2c rest]} {
2837 $ctext insert end "$line\n" hunksep
2840 set x [string range $line 0 0]
2841 if {$x == "-" || $x == "+"} {
2842 set tag [expr {$x == "+"}]
2843 $ctext insert end "$line\n" d$tag
2844 } elseif {$x == " "} {
2845 $ctext insert end "$line\n"
2846 } elseif {$diffinhdr || $x == "\\"} {
2847 # e.g. "\ No newline at end of file"
2848 $ctext insert end "$line\n" filesep
2850 # Something else we don't recognize
2851 if {$curdifftag != "Comments"} {
2852 $ctext insert end "\n"
2853 $ctext tag add $curdifftag $curtagstart end
2854 set curtagstart [$ctext index "end - 1c"]
2855 set curdifftag Comments
2857 $ctext insert end "$line\n" filesep
2860 $ctext conf -state disabled
2861 if {[clock clicks -milliseconds] >= $nextupdate} {
2863 fileevent $bdf readable {}
2865 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2870 global difffilestart ctext
2871 set here [$ctext index @0,0]
2872 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2873 if {[$ctext compare $difffilestart($i) > $here]} {
2874 if {![info exists pos]
2875 || [$ctext compare $difffilestart($i) < $pos]} {
2876 set pos $difffilestart($i)
2880 if {[info exists pos]} {
2885 proc listboxsel {} {
2886 global ctext cflist currentid
2887 if {![info exists currentid]} return
2888 set sel [lsort [$cflist curselection]]
2889 if {$sel eq {}} return
2890 set first [lindex $sel 0]
2891 catch {$ctext yview fmark.$first}
2895 global linespc charspc canvx0 canvy0 mainfont
2896 global xspc1 xspc2 lthickness
2898 set linespc [font metrics $mainfont -linespace]
2899 set charspc [font measure $mainfont "m"]
2900 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2901 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2902 set lthickness [expr {int($linespc / 9) + 1}]
2903 set xspc1(0) $linespc
2911 set ymax [lindex [$canv cget -scrollregion] 3]
2912 if {$ymax eq {} || $ymax == 0} return
2913 set span [$canv yview]
2916 allcanvs yview moveto [lindex $span 0]
2918 if {[info exists selectedline]} {
2919 selectline $selectedline 0
2923 proc incrfont {inc} {
2924 global mainfont namefont textfont ctext canv phase
2925 global stopped entries
2927 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2928 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2929 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2931 $ctext conf -font $textfont
2932 $ctext tag conf filesep -font [concat $textfont bold]
2933 foreach e $entries {
2934 $e conf -font $mainfont
2936 if {$phase == "getcommits"} {
2937 $canv itemconf textitems -font $mainfont
2943 global sha1entry sha1string
2944 if {[string length $sha1string] == 40} {
2945 $sha1entry delete 0 end
2949 proc sha1change {n1 n2 op} {
2950 global sha1string currentid sha1but
2951 if {$sha1string == {}
2952 || ([info exists currentid] && $sha1string == $currentid)} {
2957 if {[$sha1but cget -state] == $state} return
2958 if {$state == "normal"} {
2959 $sha1but conf -state normal -relief raised -text "Goto: "
2961 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2965 proc gotocommit {} {
2966 global sha1string currentid commitrow tagids headids
2967 global displayorder numcommits
2969 if {$sha1string == {}
2970 || ([info exists currentid] && $sha1string == $currentid)} return
2971 if {[info exists tagids($sha1string)]} {
2972 set id $tagids($sha1string)
2973 } elseif {[info exists headids($sha1string)]} {
2974 set id $headids($sha1string)
2976 set id [string tolower $sha1string]
2977 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2979 foreach i $displayorder {
2980 if {[string match $id* $i]} {
2984 if {$matches ne {}} {
2985 if {[llength $matches] > 1} {
2986 error_popup "Short SHA1 id $id is ambiguous"
2989 set id [lindex $matches 0]
2993 if {[info exists commitrow($id)]} {
2994 selectline $commitrow($id) 1
2997 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3002 error_popup "$type $sha1string is not known"
3005 proc lineenter {x y id} {
3006 global hoverx hovery hoverid hovertimer
3007 global commitinfo canv
3009 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3013 if {[info exists hovertimer]} {
3014 after cancel $hovertimer
3016 set hovertimer [after 500 linehover]
3020 proc linemotion {x y id} {
3021 global hoverx hovery hoverid hovertimer
3023 if {[info exists hoverid] && $id == $hoverid} {
3026 if {[info exists hovertimer]} {
3027 after cancel $hovertimer
3029 set hovertimer [after 500 linehover]
3033 proc lineleave {id} {
3034 global hoverid hovertimer canv
3036 if {[info exists hoverid] && $id == $hoverid} {
3038 if {[info exists hovertimer]} {
3039 after cancel $hovertimer
3047 global hoverx hovery hoverid hovertimer
3048 global canv linespc lthickness
3049 global commitinfo mainfont
3051 set text [lindex $commitinfo($hoverid) 0]
3052 set ymax [lindex [$canv cget -scrollregion] 3]
3053 if {$ymax == {}} return
3054 set yfrac [lindex [$canv yview] 0]
3055 set x [expr {$hoverx + 2 * $linespc}]
3056 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3057 set x0 [expr {$x - 2 * $lthickness}]
3058 set y0 [expr {$y - 2 * $lthickness}]
3059 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3060 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3061 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3062 -fill \#ffff80 -outline black -width 1 -tags hover]
3064 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3068 proc clickisonarrow {id y} {
3069 global lthickness idrowranges
3071 set thresh [expr {2 * $lthickness + 6}]
3072 set n [expr {[llength $idrowranges($id)] - 1}]
3073 for {set i 1} {$i < $n} {incr i} {
3074 set row [lindex $idrowranges($id) $i]
3075 if {abs([yc $row] - $y) < $thresh} {
3082 proc arrowjump {id n y} {
3083 global idrowranges canv
3085 # 1 <-> 2, 3 <-> 4, etc...
3086 set n [expr {(($n - 1) ^ 1) + 1}]
3087 set row [lindex $idrowranges($id) $n]
3089 set ymax [lindex [$canv cget -scrollregion] 3]
3090 if {$ymax eq {} || $ymax <= 0} return
3091 set view [$canv yview]
3092 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3093 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3097 allcanvs yview moveto $yfrac
3100 proc lineclick {x y id isnew} {
3101 global ctext commitinfo childlist commitrow cflist canv thickerline
3103 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3108 # draw this line thicker than normal
3112 set ymax [lindex [$canv cget -scrollregion] 3]
3113 if {$ymax eq {}} return
3114 set yfrac [lindex [$canv yview] 0]
3115 set y [expr {$y + $yfrac * $ymax}]
3117 set dirn [clickisonarrow $id $y]
3119 arrowjump $id $dirn $y
3124 addtohistory [list lineclick $x $y $id 0]
3126 # fill the details pane with info about this line
3127 $ctext conf -state normal
3128 $ctext delete 0.0 end
3129 $ctext tag conf link -foreground blue -underline 1
3130 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3131 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3132 $ctext insert end "Parent:\t"
3133 $ctext insert end $id [list link link0]
3134 $ctext tag bind link0 <1> [list selbyid $id]
3135 set info $commitinfo($id)
3136 $ctext insert end "\n\t[lindex $info 0]\n"
3137 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3138 set date [formatdate [lindex $info 2]]
3139 $ctext insert end "\tDate:\t$date\n"
3140 set kids [lindex $childlist $commitrow($id)]
3142 $ctext insert end "\nChildren:"
3144 foreach child $kids {
3146 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3147 set info $commitinfo($child)
3148 $ctext insert end "\n\t"
3149 $ctext insert end $child [list link link$i]
3150 $ctext tag bind link$i <1> [list selbyid $child]
3151 $ctext insert end "\n\t[lindex $info 0]"
3152 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3153 set date [formatdate [lindex $info 2]]
3154 $ctext insert end "\n\tDate:\t$date\n"
3157 $ctext conf -state disabled
3159 $cflist delete 0 end
3162 proc normalline {} {
3164 if {[info exists thickerline]} {
3173 if {[info exists commitrow($id)]} {
3174 selectline $commitrow($id) 1
3180 if {![info exists startmstime]} {
3181 set startmstime [clock clicks -milliseconds]
3183 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3186 proc rowmenu {x y id} {
3187 global rowctxmenu commitrow selectedline rowmenuid
3189 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3194 $rowctxmenu entryconfigure 0 -state $state
3195 $rowctxmenu entryconfigure 1 -state $state
3196 $rowctxmenu entryconfigure 2 -state $state
3198 tk_popup $rowctxmenu $x $y
3201 proc diffvssel {dirn} {
3202 global rowmenuid selectedline displayorder
3204 if {![info exists selectedline]} return
3206 set oldid [lindex $displayorder $selectedline]
3207 set newid $rowmenuid
3209 set oldid $rowmenuid
3210 set newid [lindex $displayorder $selectedline]
3212 addtohistory [list doseldiff $oldid $newid]
3213 doseldiff $oldid $newid
3216 proc doseldiff {oldid newid} {
3220 $ctext conf -state normal
3221 $ctext delete 0.0 end
3222 $ctext mark set fmark.0 0.0
3223 $ctext mark gravity fmark.0 left
3224 $cflist delete 0 end
3225 $cflist insert end "Top"
3226 $ctext insert end "From "
3227 $ctext tag conf link -foreground blue -underline 1
3228 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3229 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3230 $ctext tag bind link0 <1> [list selbyid $oldid]
3231 $ctext insert end $oldid [list link link0]
3232 $ctext insert end "\n "
3233 $ctext insert end [lindex $commitinfo($oldid) 0]
3234 $ctext insert end "\n\nTo "
3235 $ctext tag bind link1 <1> [list selbyid $newid]
3236 $ctext insert end $newid [list link link1]
3237 $ctext insert end "\n "
3238 $ctext insert end [lindex $commitinfo($newid) 0]
3239 $ctext insert end "\n"
3240 $ctext conf -state disabled
3241 $ctext tag delete Comments
3242 $ctext tag remove found 1.0 end
3243 startdiff [list $oldid $newid]
3247 global rowmenuid currentid commitinfo patchtop patchnum
3249 if {![info exists currentid]} return
3250 set oldid $currentid
3251 set oldhead [lindex $commitinfo($oldid) 0]
3252 set newid $rowmenuid
3253 set newhead [lindex $commitinfo($newid) 0]
3256 catch {destroy $top}
3258 label $top.title -text "Generate patch"
3259 grid $top.title - -pady 10
3260 label $top.from -text "From:"
3261 entry $top.fromsha1 -width 40 -relief flat
3262 $top.fromsha1 insert 0 $oldid
3263 $top.fromsha1 conf -state readonly
3264 grid $top.from $top.fromsha1 -sticky w
3265 entry $top.fromhead -width 60 -relief flat
3266 $top.fromhead insert 0 $oldhead
3267 $top.fromhead conf -state readonly
3268 grid x $top.fromhead -sticky w
3269 label $top.to -text "To:"
3270 entry $top.tosha1 -width 40 -relief flat
3271 $top.tosha1 insert 0 $newid
3272 $top.tosha1 conf -state readonly
3273 grid $top.to $top.tosha1 -sticky w
3274 entry $top.tohead -width 60 -relief flat
3275 $top.tohead insert 0 $newhead
3276 $top.tohead conf -state readonly
3277 grid x $top.tohead -sticky w
3278 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3279 grid $top.rev x -pady 10
3280 label $top.flab -text "Output file:"
3281 entry $top.fname -width 60
3282 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3284 grid $top.flab $top.fname -sticky w
3286 button $top.buts.gen -text "Generate" -command mkpatchgo
3287 button $top.buts.can -text "Cancel" -command mkpatchcan
3288 grid $top.buts.gen $top.buts.can
3289 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3290 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3291 grid $top.buts - -pady 10 -sticky ew
3295 proc mkpatchrev {} {
3298 set oldid [$patchtop.fromsha1 get]
3299 set oldhead [$patchtop.fromhead get]
3300 set newid [$patchtop.tosha1 get]
3301 set newhead [$patchtop.tohead get]
3302 foreach e [list fromsha1 fromhead tosha1 tohead] \
3303 v [list $newid $newhead $oldid $oldhead] {
3304 $patchtop.$e conf -state normal
3305 $patchtop.$e delete 0 end
3306 $patchtop.$e insert 0 $v
3307 $patchtop.$e conf -state readonly
3314 set oldid [$patchtop.fromsha1 get]
3315 set newid [$patchtop.tosha1 get]
3316 set fname [$patchtop.fname get]
3317 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3318 error_popup "Error creating patch: $err"
3320 catch {destroy $patchtop}
3324 proc mkpatchcan {} {
3327 catch {destroy $patchtop}
3332 global rowmenuid mktagtop commitinfo
3336 catch {destroy $top}
3338 label $top.title -text "Create tag"
3339 grid $top.title - -pady 10
3340 label $top.id -text "ID:"
3341 entry $top.sha1 -width 40 -relief flat
3342 $top.sha1 insert 0 $rowmenuid
3343 $top.sha1 conf -state readonly
3344 grid $top.id $top.sha1 -sticky w
3345 entry $top.head -width 60 -relief flat
3346 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3347 $top.head conf -state readonly
3348 grid x $top.head -sticky w
3349 label $top.tlab -text "Tag name:"
3350 entry $top.tag -width 60
3351 grid $top.tlab $top.tag -sticky w
3353 button $top.buts.gen -text "Create" -command mktaggo
3354 button $top.buts.can -text "Cancel" -command mktagcan
3355 grid $top.buts.gen $top.buts.can
3356 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3357 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3358 grid $top.buts - -pady 10 -sticky ew
3363 global mktagtop env tagids idtags
3365 set id [$mktagtop.sha1 get]
3366 set tag [$mktagtop.tag get]
3368 error_popup "No tag name specified"
3371 if {[info exists tagids($tag)]} {
3372 error_popup "Tag \"$tag\" already exists"
3377 set fname [file join $dir "refs/tags" $tag]
3378 set f [open $fname w]
3382 error_popup "Error creating tag: $err"
3386 set tagids($tag) $id
3387 lappend idtags($id) $tag
3391 proc redrawtags {id} {
3392 global canv linehtag commitrow idpos selectedline
3394 if {![info exists commitrow($id)]} return
3395 drawcmitrow $commitrow($id)
3396 $canv delete tag.$id
3397 set xt [eval drawtags $id $idpos($id)]
3398 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3399 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3400 selectline $selectedline 0
3407 catch {destroy $mktagtop}
3416 proc writecommit {} {
3417 global rowmenuid wrcomtop commitinfo wrcomcmd
3419 set top .writecommit
3421 catch {destroy $top}
3423 label $top.title -text "Write commit to file"
3424 grid $top.title - -pady 10
3425 label $top.id -text "ID:"
3426 entry $top.sha1 -width 40 -relief flat
3427 $top.sha1 insert 0 $rowmenuid
3428 $top.sha1 conf -state readonly
3429 grid $top.id $top.sha1 -sticky w
3430 entry $top.head -width 60 -relief flat
3431 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3432 $top.head conf -state readonly
3433 grid x $top.head -sticky w
3434 label $top.clab -text "Command:"
3435 entry $top.cmd -width 60 -textvariable wrcomcmd
3436 grid $top.clab $top.cmd -sticky w -pady 10
3437 label $top.flab -text "Output file:"
3438 entry $top.fname -width 60
3439 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3440 grid $top.flab $top.fname -sticky w
3442 button $top.buts.gen -text "Write" -command wrcomgo
3443 button $top.buts.can -text "Cancel" -command wrcomcan
3444 grid $top.buts.gen $top.buts.can
3445 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3446 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3447 grid $top.buts - -pady 10 -sticky ew
3454 set id [$wrcomtop.sha1 get]
3455 set cmd "echo $id | [$wrcomtop.cmd get]"
3456 set fname [$wrcomtop.fname get]
3457 if {[catch {exec sh -c $cmd >$fname &} err]} {
3458 error_popup "Error writing commit: $err"
3460 catch {destroy $wrcomtop}
3467 catch {destroy $wrcomtop}
3471 proc listrefs {id} {
3472 global idtags idheads idotherrefs
3475 if {[info exists idtags($id)]} {
3479 if {[info exists idheads($id)]} {
3483 if {[info exists idotherrefs($id)]} {
3484 set z $idotherrefs($id)
3486 return [list $x $y $z]
3489 proc rereadrefs {} {
3490 global idtags idheads idotherrefs
3492 set refids [concat [array names idtags] \
3493 [array names idheads] [array names idotherrefs]]
3494 foreach id $refids {
3495 if {![info exists ref($id)]} {
3496 set ref($id) [listrefs $id]
3500 set refids [lsort -unique [concat $refids [array names idtags] \
3501 [array names idheads] [array names idotherrefs]]]
3502 foreach id $refids {
3503 set v [listrefs $id]
3504 if {![info exists ref($id)] || $ref($id) != $v} {
3510 proc showtag {tag isnew} {
3511 global ctext cflist tagcontents tagids linknum
3514 addtohistory [list showtag $tag 0]
3516 $ctext conf -state normal
3517 $ctext delete 0.0 end
3519 if {[info exists tagcontents($tag)]} {
3520 set text $tagcontents($tag)
3522 set text "Tag: $tag\nId: $tagids($tag)"
3524 appendwithlinks $text
3525 $ctext conf -state disabled
3526 $cflist delete 0 end
3536 global maxwidth maxgraphpct diffopts findmergefiles
3537 global oldprefs prefstop
3541 if {[winfo exists $top]} {
3545 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3546 set oldprefs($v) [set $v]
3549 wm title $top "Gitk preferences"
3550 label $top.ldisp -text "Commit list display options"
3551 grid $top.ldisp - -sticky w -pady 10
3552 label $top.spacer -text " "
3553 label $top.maxwidthl -text "Maximum graph width (lines)" \
3555 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3556 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3557 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3559 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3560 grid x $top.maxpctl $top.maxpct -sticky w
3561 checkbutton $top.findm -variable findmergefiles
3562 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3564 grid $top.findm $top.findml - -sticky w
3565 label $top.ddisp -text "Diff display options"
3566 grid $top.ddisp - -sticky w -pady 10
3567 label $top.diffoptl -text "Options for diff program" \
3569 entry $top.diffopt -width 20 -textvariable diffopts
3570 grid x $top.diffoptl $top.diffopt -sticky w
3572 button $top.buts.ok -text "OK" -command prefsok
3573 button $top.buts.can -text "Cancel" -command prefscan
3574 grid $top.buts.ok $top.buts.can
3575 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3576 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3577 grid $top.buts - - -pady 10 -sticky ew
3581 global maxwidth maxgraphpct diffopts findmergefiles
3582 global oldprefs prefstop
3584 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3585 set $v $oldprefs($v)
3587 catch {destroy $prefstop}
3592 global maxwidth maxgraphpct
3593 global oldprefs prefstop
3595 catch {destroy $prefstop}
3597 if {$maxwidth != $oldprefs(maxwidth)
3598 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3603 proc formatdate {d} {
3604 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3607 # This list of encoding names and aliases is distilled from
3608 # http://www.iana.org/assignments/character-sets.
3609 # Not all of them are supported by Tcl.
3610 set encoding_aliases {
3611 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3612 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3613 { ISO-10646-UTF-1 csISO10646UTF1 }
3614 { ISO_646.basic:1983 ref csISO646basic1983 }
3615 { INVARIANT csINVARIANT }
3616 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3617 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3618 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3619 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3620 { NATS-DANO iso-ir-9-1 csNATSDANO }
3621 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3622 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3623 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3624 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3625 { ISO-2022-KR csISO2022KR }
3627 { ISO-2022-JP csISO2022JP }
3628 { ISO-2022-JP-2 csISO2022JP2 }
3629 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3631 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3632 { IT iso-ir-15 ISO646-IT csISO15Italian }
3633 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3634 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3635 { greek7-old iso-ir-18 csISO18Greek7Old }
3636 { latin-greek iso-ir-19 csISO19LatinGreek }
3637 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3638 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3639 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3640 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3641 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3642 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3643 { INIS iso-ir-49 csISO49INIS }
3644 { INIS-8 iso-ir-50 csISO50INIS8 }
3645 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3646 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3647 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3648 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3649 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3650 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3652 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3653 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3654 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3655 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3656 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3657 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3658 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3659 { greek7 iso-ir-88 csISO88Greek7 }
3660 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3661 { iso-ir-90 csISO90 }
3662 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3663 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3664 csISO92JISC62991984b }
3665 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3666 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3667 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3668 csISO95JIS62291984handadd }
3669 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3670 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3671 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3672 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3674 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3675 { T.61-7bit iso-ir-102 csISO102T617bit }
3676 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3677 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3678 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3679 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3680 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3681 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3682 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3683 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3684 arabic csISOLatinArabic }
3685 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3686 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3687 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3688 greek greek8 csISOLatinGreek }
3689 { T.101-G2 iso-ir-128 csISO128T101G2 }
3690 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3692 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3693 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3694 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3695 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3696 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3697 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3698 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3699 csISOLatinCyrillic }
3700 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3701 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3702 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3703 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3704 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3705 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3706 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3707 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3708 { ISO_10367-box iso-ir-155 csISO10367Box }
3709 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3710 { latin-lap lap iso-ir-158 csISO158Lap }
3711 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3712 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3715 { JIS_X0201 X0201 csHalfWidthKatakana }
3716 { KSC5636 ISO646-KR csKSC5636 }
3717 { ISO-10646-UCS-2 csUnicode }
3718 { ISO-10646-UCS-4 csUCS4 }
3719 { DEC-MCS dec csDECMCS }
3720 { hp-roman8 roman8 r8 csHPRoman8 }
3721 { macintosh mac csMacintosh }
3722 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3724 { IBM038 EBCDIC-INT cp038 csIBM038 }
3725 { IBM273 CP273 csIBM273 }
3726 { IBM274 EBCDIC-BE CP274 csIBM274 }
3727 { IBM275 EBCDIC-BR cp275 csIBM275 }
3728 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3729 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3730 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3731 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3732 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3733 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3734 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3735 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3736 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3737 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3738 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3739 { IBM437 cp437 437 csPC8CodePage437 }
3740 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3741 { IBM775 cp775 csPC775Baltic }
3742 { IBM850 cp850 850 csPC850Multilingual }
3743 { IBM851 cp851 851 csIBM851 }
3744 { IBM852 cp852 852 csPCp852 }
3745 { IBM855 cp855 855 csIBM855 }
3746 { IBM857 cp857 857 csIBM857 }
3747 { IBM860 cp860 860 csIBM860 }
3748 { IBM861 cp861 861 cp-is csIBM861 }
3749 { IBM862 cp862 862 csPC862LatinHebrew }
3750 { IBM863 cp863 863 csIBM863 }
3751 { IBM864 cp864 csIBM864 }
3752 { IBM865 cp865 865 csIBM865 }
3753 { IBM866 cp866 866 csIBM866 }
3754 { IBM868 CP868 cp-ar csIBM868 }
3755 { IBM869 cp869 869 cp-gr csIBM869 }
3756 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3757 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3758 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3759 { IBM891 cp891 csIBM891 }
3760 { IBM903 cp903 csIBM903 }
3761 { IBM904 cp904 904 csIBBM904 }
3762 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3763 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3764 { IBM1026 CP1026 csIBM1026 }
3765 { EBCDIC-AT-DE csIBMEBCDICATDE }
3766 { EBCDIC-AT-DE-A csEBCDICATDEA }
3767 { EBCDIC-CA-FR csEBCDICCAFR }
3768 { EBCDIC-DK-NO csEBCDICDKNO }
3769 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3770 { EBCDIC-FI-SE csEBCDICFISE }
3771 { EBCDIC-FI-SE-A csEBCDICFISEA }
3772 { EBCDIC-FR csEBCDICFR }
3773 { EBCDIC-IT csEBCDICIT }
3774 { EBCDIC-PT csEBCDICPT }
3775 { EBCDIC-ES csEBCDICES }
3776 { EBCDIC-ES-A csEBCDICESA }
3777 { EBCDIC-ES-S csEBCDICESS }
3778 { EBCDIC-UK csEBCDICUK }
3779 { EBCDIC-US csEBCDICUS }
3780 { UNKNOWN-8BIT csUnknown8BiT }
3781 { MNEMONIC csMnemonic }
3786 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3787 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3788 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3789 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3790 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3791 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3792 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3793 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3794 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3795 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3796 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3797 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3798 { IBM1047 IBM-1047 }
3799 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3800 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3801 { UNICODE-1-1 csUnicode11 }
3804 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3805 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3807 { ISO-8859-15 ISO_8859-15 Latin-9 }
3808 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3809 { GBK CP936 MS936 windows-936 }
3810 { JIS_Encoding csJISEncoding }
3811 { Shift_JIS MS_Kanji csShiftJIS }
3812 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3814 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3815 { ISO-10646-UCS-Basic csUnicodeASCII }
3816 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3817 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3818 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3819 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3820 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3821 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3822 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3823 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3824 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3825 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3826 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3827 { Ventura-US csVenturaUS }
3828 { Ventura-International csVenturaInternational }
3829 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3830 { PC8-Turkish csPC8Turkish }
3831 { IBM-Symbols csIBMSymbols }
3832 { IBM-Thai csIBMThai }
3833 { HP-Legal csHPLegal }
3834 { HP-Pi-font csHPPiFont }
3835 { HP-Math8 csHPMath8 }
3836 { Adobe-Symbol-Encoding csHPPSMath }
3837 { HP-DeskTop csHPDesktop }
3838 { Ventura-Math csVenturaMath }
3839 { Microsoft-Publishing csMicrosoftPublishing }
3840 { Windows-31J csWindows31J }
3845 proc tcl_encoding {enc} {
3846 global encoding_aliases
3847 set names [encoding names]
3848 set lcnames [string tolower $names]
3849 set enc [string tolower $enc]
3850 set i [lsearch -exact $lcnames $enc]
3852 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3853 if {[regsub {^iso[-_]} $enc iso encx]} {
3854 set i [lsearch -exact $lcnames $encx]
3858 foreach l $encoding_aliases {
3859 set ll [string tolower $l]
3860 if {[lsearch -exact $ll $enc] < 0} continue
3861 # look through the aliases for one that tcl knows about
3863 set i [lsearch -exact $lcnames $e]
3865 if {[regsub {^iso[-_]} $e iso ex]} {
3866 set i [lsearch -exact $lcnames $ex]
3875 return [lindex $names $i]
3882 set diffopts "-U 5 -p"
3883 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3887 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3889 if {$gitencoding == ""} {
3890 set gitencoding "utf-8"
3892 set tclencoding [tcl_encoding $gitencoding]
3893 if {$tclencoding == {}} {
3894 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3897 set mainfont {Helvetica 9}
3898 set textfont {Courier 9}
3899 set uifont {Helvetica 9 bold}
3900 set findmergefiles 0
3909 set colors {green red blue magenta darkgrey brown orange}
3911 catch {source ~/.gitk}
3913 set namefont $mainfont
3915 font create optionfont -family sans-serif -size -12
3919 switch -regexp -- $arg {
3921 "^-d" { set datemode 1 }
3923 lappend revtreeargs $arg
3928 # check that we can find a .git directory somewhere...
3930 if {![file isdirectory $gitdir]} {
3931 error_popup "Cannot find the git directory \"$gitdir\"."
3944 makewindow $revtreeargs
3946 getcommits $revtreeargs