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 start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global revtreeargs viewfiles commitidx
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
27 set commitidx($view) 0
29 if {$viewfiles($view) ne {}} {
30 set args [concat $args "--" $viewfiles($view)]
32 set order "--topo-order"
34 set order "--date-order"
37 set fd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
40 puts stderr "Error executing git-rev-list: $err"
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
49 fileevent $fd readable [list getcommitlines $fd $view]
53 proc stop_rev_list {} {
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
63 unset commfd($curview)
67 global phase canv mainfont curview
71 start_rev_list $curview
73 $canv create text 3 3 -anchor nw -text "Reading commits..." \
74 -font $mainfont -tags textitems
77 proc getcommitlines {fd view} {
78 global commitlisted nextupdate
79 global leftover commfd
80 global displayorder commitidx commitrow commitdata
81 global parentlist childlist children curview hlview
82 global vparentlist vchildlist vdisporder vcmitlisted
86 if {![eof $fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {![catch {close $fd} err]} {
92 if {$view == $curview} {
93 after idle finishcommits
97 if {[string range $err 0 4] == "usage"} {
99 "Gitk: error reading commits: bad arguments to git-rev-list.\
100 (Note: arguments to gitk are passed to git-rev-list\
101 to allow selection of commits to be displayed.)"
103 set err "Error reading commits: $err"
111 set i [string first "\0" $stuff $start]
113 append leftover($view) [string range $stuff $start end]
117 set cmit $leftover($view)
118 append cmit [string range $stuff 0 [expr {$i - 1}]]
119 set leftover($view) {}
121 set cmit [string range $stuff $start [expr {$i - 1}]]
123 set start [expr {$i + 1}]
124 set j [string first "\n" $cmit]
128 set ids [string range $cmit 0 [expr {$j - 1}]]
129 if {[string range $ids 0 0] == "-"} {
131 set ids [string range $ids 1 end]
135 if {[string length $id] != 40} {
143 if {[string length $shortcmit] > 80} {
144 set shortcmit "[string range $shortcmit 0 80]..."
146 error_popup "Can't parse git-rev-list output: {$shortcmit}"
149 set id [lindex $ids 0]
151 set olds [lrange $ids 1 end]
154 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
155 lappend children($view,$p) $id
162 if {![info exists children($view,$id)]} {
163 set children($view,$id) {}
165 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
166 set commitrow($view,$id) $commitidx($view)
167 incr commitidx($view)
168 if {$view == $curview} {
169 lappend parentlist $olds
170 lappend childlist $children($view,$id)
171 lappend displayorder $id
172 lappend commitlisted $listed
174 lappend vparentlist($view) $olds
175 lappend vchildlist($view) $children($view,$id)
176 lappend vdisporder($view) $id
177 lappend vcmitlisted($view) $listed
182 if {$view == $curview} {
184 } elseif {[info exists hlview] && $view == $hlview} {
188 if {[clock clicks -milliseconds] >= $nextupdate} {
194 global commfd nextupdate numcommits ncmupdate
196 foreach v [array names commfd] {
197 fileevent $commfd($v) readable {}
200 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
201 if {$numcommits < 100} {
202 set ncmupdate [expr {$numcommits + 1}]
203 } elseif {$numcommits < 10000} {
204 set ncmupdate [expr {$numcommits + 10}]
206 set ncmupdate [expr {$numcommits + 100}]
208 foreach v [array names commfd] {
210 fileevent $fd readable [list getcommitlines $fd $v]
214 proc readcommit {id} {
215 if {[catch {set contents [exec git-cat-file commit $id]}]} return
216 parsecommit $id $contents 0
219 proc updatecommits {} {
220 global viewdata curview revtreeargs phase displayorder
221 global children commitrow
228 foreach id $displayorder {
229 catch {unset children($n,$id)}
230 catch {unset commitrow($n,$id)}
233 catch {unset viewdata($n)}
238 proc parsecommit {id contents listed} {
239 global commitinfo cdate
248 set hdrend [string first "\n\n" $contents]
250 # should never happen...
251 set hdrend [string length $contents]
253 set header [string range $contents 0 [expr {$hdrend - 1}]]
254 set comment [string range $contents [expr {$hdrend + 2}] end]
255 foreach line [split $header "\n"] {
256 set tag [lindex $line 0]
257 if {$tag == "author"} {
258 set audate [lindex $line end-1]
259 set auname [lrange $line 1 end-2]
260 } elseif {$tag == "committer"} {
261 set comdate [lindex $line end-1]
262 set comname [lrange $line 1 end-2]
266 # take the first line of the comment as the headline
267 set i [string first "\n" $comment]
269 set headline [string trim [string range $comment 0 $i]]
271 set headline $comment
274 # git-rev-list indents the comment by 4 spaces;
275 # if we got this via git-cat-file, add the indentation
277 foreach line [split $comment "\n"] {
278 append newcomment " "
279 append newcomment $line
280 append newcomment "\n"
282 set comment $newcomment
284 if {$comdate != {}} {
285 set cdate($id) $comdate
287 set commitinfo($id) [list $headline $auname $audate \
288 $comname $comdate $comment]
291 proc getcommit {id} {
292 global commitdata commitinfo
294 if {[info exists commitdata($id)]} {
295 parsecommit $id $commitdata($id) 1
298 if {![info exists commitinfo($id)]} {
299 set commitinfo($id) {"No commit information available"}
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs
309 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
312 set refd [open [list | git ls-remote [gitdir]] r]
313 while {0 <= [set n [gets $refd line]]} {
314 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
318 if {[regexp {^remotes/.*/HEAD$} $path match]} {
321 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
325 if {[regexp {^remotes/} $path match]} {
328 if {$type == "tags"} {
329 set tagids($name) $id
330 lappend idtags($id) $name
335 set commit [exec git-rev-parse "$id^0"]
336 if {"$commit" != "$id"} {
337 set tagids($name) $commit
338 lappend idtags($commit) $name
342 set tagcontents($name) [exec git-cat-file tag "$id"]
344 } elseif { $type == "heads" } {
345 set headids($name) $id
346 lappend idheads($id) $name
348 set otherrefids($name) $id
349 lappend idotherrefs($id) $name
355 proc error_popup msg {
359 message $w.m -text $msg -justify center -aspect 400
360 pack $w.m -side top -fill x -padx 20 -pady 20
361 button $w.ok -text OK -command "destroy $w"
362 pack $w.ok -side bottom -fill x
363 bind $w <Visibility> "grab $w; focus $w"
364 bind $w <Key-Return> "destroy $w"
369 global canv canv2 canv3 linespc charspc ctext cflist
370 global textfont mainfont uifont
371 global findtype findtypemenu findloc findstring fstring geometry
372 global entries sha1entry sha1string sha1but
373 global maincursor textcursor curtextcursor
374 global rowctxmenu mergemax
377 .bar add cascade -label "File" -menu .bar.file
378 .bar configure -font $uifont
380 .bar.file add command -label "Update" -command updatecommits
381 .bar.file add command -label "Reread references" -command rereadrefs
382 .bar.file add command -label "Quit" -command doquit
383 .bar.file configure -font $uifont
385 .bar add cascade -label "Edit" -menu .bar.edit
386 .bar.edit add command -label "Preferences" -command doprefs
387 .bar.edit configure -font $uifont
389 menu .bar.view -font $uifont
390 menu .bar.view.hl -font $uifont -tearoff 0
391 .bar add cascade -label "View" -menu .bar.view
392 .bar.view add command -label "New view..." -command {newview 0}
393 .bar.view add command -label "Edit view..." -command editview \
395 .bar.view add command -label "Delete view" -command delview -state disabled
396 .bar.view add cascade -label "Highlight" -menu .bar.view.hl
397 .bar.view add separator
398 .bar.view add radiobutton -label "All files" -command {showview 0} \
399 -variable selectedview -value 0
400 .bar.view.hl add command -label "New view..." -command {newview 1}
401 .bar.view.hl add command -label "Remove" -command delhighlight \
403 .bar.view.hl add separator
406 .bar add cascade -label "Help" -menu .bar.help
407 .bar.help add command -label "About gitk" -command about
408 .bar.help add command -label "Key bindings" -command keys
409 .bar.help configure -font $uifont
410 . configure -menu .bar
412 if {![info exists geometry(canv1)]} {
413 set geometry(canv1) [expr {45 * $charspc}]
414 set geometry(canv2) [expr {30 * $charspc}]
415 set geometry(canv3) [expr {15 * $charspc}]
416 set geometry(canvh) [expr {25 * $linespc + 4}]
417 set geometry(ctextw) 80
418 set geometry(ctexth) 30
419 set geometry(cflistw) 30
421 panedwindow .ctop -orient vertical
422 if {[info exists geometry(width)]} {
423 .ctop conf -width $geometry(width) -height $geometry(height)
424 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
425 set geometry(ctexth) [expr {($texth - 8) /
426 [font metrics $textfont -linespace]}]
430 pack .ctop.top.bar -side bottom -fill x
431 set cscroll .ctop.top.csb
432 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
433 pack $cscroll -side right -fill y
434 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
435 pack .ctop.top.clist -side top -fill both -expand 1
437 set canv .ctop.top.clist.canv
438 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
440 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
441 .ctop.top.clist add $canv
442 set canv2 .ctop.top.clist.canv2
443 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
444 -bg white -bd 0 -yscrollincr $linespc
445 .ctop.top.clist add $canv2
446 set canv3 .ctop.top.clist.canv3
447 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
448 -bg white -bd 0 -yscrollincr $linespc
449 .ctop.top.clist add $canv3
450 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
452 set sha1entry .ctop.top.bar.sha1
453 set entries $sha1entry
454 set sha1but .ctop.top.bar.sha1label
455 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
456 -command gotocommit -width 8 -font $uifont
457 $sha1but conf -disabledforeground [$sha1but cget -foreground]
458 pack .ctop.top.bar.sha1label -side left
459 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
460 trace add variable sha1string write sha1change
461 pack $sha1entry -side left -pady 2
463 image create bitmap bm-left -data {
464 #define left_width 16
465 #define left_height 16
466 static unsigned char left_bits[] = {
467 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
468 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
469 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
471 image create bitmap bm-right -data {
472 #define right_width 16
473 #define right_height 16
474 static unsigned char right_bits[] = {
475 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
476 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
477 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
479 button .ctop.top.bar.leftbut -image bm-left -command goback \
480 -state disabled -width 26
481 pack .ctop.top.bar.leftbut -side left -fill y
482 button .ctop.top.bar.rightbut -image bm-right -command goforw \
483 -state disabled -width 26
484 pack .ctop.top.bar.rightbut -side left -fill y
486 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
487 pack .ctop.top.bar.findbut -side left
489 set fstring .ctop.top.bar.findstring
490 lappend entries $fstring
491 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
492 pack $fstring -side left -expand 1 -fill x
494 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
495 findtype Exact IgnCase Regexp]
496 .ctop.top.bar.findtype configure -font $uifont
497 .ctop.top.bar.findtype.menu configure -font $uifont
498 set findloc "All fields"
499 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
500 Comments Author Committer Files Pickaxe
501 .ctop.top.bar.findloc configure -font $uifont
502 .ctop.top.bar.findloc.menu configure -font $uifont
504 pack .ctop.top.bar.findloc -side right
505 pack .ctop.top.bar.findtype -side right
506 # for making sure type==Exact whenever loc==Pickaxe
507 trace add variable findloc write findlocchange
509 panedwindow .ctop.cdet -orient horizontal
511 frame .ctop.cdet.left
512 set ctext .ctop.cdet.left.ctext
513 text $ctext -bg white -state disabled -font $textfont \
514 -width $geometry(ctextw) -height $geometry(ctexth) \
515 -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
516 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
517 pack .ctop.cdet.left.sb -side right -fill y
518 pack $ctext -side left -fill both -expand 1
519 .ctop.cdet add .ctop.cdet.left
521 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
522 $ctext tag conf hunksep -fore blue
523 $ctext tag conf d0 -fore red
524 $ctext tag conf d1 -fore "#00a000"
525 $ctext tag conf m0 -fore red
526 $ctext tag conf m1 -fore blue
527 $ctext tag conf m2 -fore green
528 $ctext tag conf m3 -fore purple
529 $ctext tag conf m4 -fore brown
530 $ctext tag conf m5 -fore "#009090"
531 $ctext tag conf m6 -fore magenta
532 $ctext tag conf m7 -fore "#808000"
533 $ctext tag conf m8 -fore "#009000"
534 $ctext tag conf m9 -fore "#ff0080"
535 $ctext tag conf m10 -fore cyan
536 $ctext tag conf m11 -fore "#b07070"
537 $ctext tag conf m12 -fore "#70b0f0"
538 $ctext tag conf m13 -fore "#70f0b0"
539 $ctext tag conf m14 -fore "#f0b070"
540 $ctext tag conf m15 -fore "#ff70b0"
541 $ctext tag conf mmax -fore darkgrey
543 $ctext tag conf mresult -font [concat $textfont bold]
544 $ctext tag conf msep -font [concat $textfont bold]
545 $ctext tag conf found -back yellow
547 frame .ctop.cdet.right
548 frame .ctop.cdet.right.mode
549 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
550 -command reselectline -variable cmitmode -value "patch"
551 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
552 -command reselectline -variable cmitmode -value "tree"
553 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
554 pack .ctop.cdet.right.mode -side top -fill x
555 set cflist .ctop.cdet.right.cfiles
556 set indent [font measure $mainfont "nn"]
557 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
558 -tabs [list $indent [expr {2 * $indent}]] \
559 -yscrollcommand ".ctop.cdet.right.sb set" \
560 -cursor [. cget -cursor] \
561 -spacing1 1 -spacing3 1
562 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
563 pack .ctop.cdet.right.sb -side right -fill y
564 pack $cflist -side left -fill both -expand 1
565 $cflist tag configure highlight \
566 -background [$cflist cget -selectbackground]
567 .ctop.cdet add .ctop.cdet.right
568 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
570 pack .ctop -side top -fill both -expand 1
572 bindall <1> {selcanvline %W %x %y}
573 #bindall <B1-Motion> {selcanvline %W %x %y}
574 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
575 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
576 bindall <2> "canvscan mark %W %x %y"
577 bindall <B2-Motion> "canvscan dragto %W %x %y"
578 bindkey <Home> selfirstline
579 bindkey <End> sellastline
580 bind . <Key-Up> "selnextline -1"
581 bind . <Key-Down> "selnextline 1"
582 bindkey <Key-Right> "goforw"
583 bindkey <Key-Left> "goback"
584 bind . <Key-Prior> "selnextpage -1"
585 bind . <Key-Next> "selnextpage 1"
586 bind . <Control-Home> "allcanvs yview moveto 0.0"
587 bind . <Control-End> "allcanvs yview moveto 1.0"
588 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
589 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
590 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
591 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
592 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
593 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
594 bindkey <Key-space> "$ctext yview scroll 1 pages"
595 bindkey p "selnextline -1"
596 bindkey n "selnextline 1"
599 bindkey i "selnextline -1"
600 bindkey k "selnextline 1"
603 bindkey b "$ctext yview scroll -1 pages"
604 bindkey d "$ctext yview scroll 18 units"
605 bindkey u "$ctext yview scroll -18 units"
606 bindkey / {findnext 1}
607 bindkey <Key-Return> {findnext 0}
610 bind . <Control-q> doquit
611 bind . <Control-f> dofind
612 bind . <Control-g> {findnext 0}
613 bind . <Control-r> findprev
614 bind . <Control-equal> {incrfont 1}
615 bind . <Control-KP_Add> {incrfont 1}
616 bind . <Control-minus> {incrfont -1}
617 bind . <Control-KP_Subtract> {incrfont -1}
618 bind . <Destroy> {savestuff %W}
619 bind . <Button-1> "click %W"
620 bind $fstring <Key-Return> dofind
621 bind $sha1entry <Key-Return> gotocommit
622 bind $sha1entry <<PasteSelection>> clearsha1
623 bind $cflist <1> {sel_flist %W %x %y; break}
624 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
625 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
627 set maincursor [. cget -cursor]
628 set textcursor [$ctext cget -cursor]
629 set curtextcursor $textcursor
631 set rowctxmenu .rowctxmenu
632 menu $rowctxmenu -tearoff 0
633 $rowctxmenu add command -label "Diff this -> selected" \
634 -command {diffvssel 0}
635 $rowctxmenu add command -label "Diff selected -> this" \
636 -command {diffvssel 1}
637 $rowctxmenu add command -label "Make patch" -command mkpatch
638 $rowctxmenu add command -label "Create tag" -command mktag
639 $rowctxmenu add command -label "Write commit to file" -command writecommit
642 # mouse-2 makes all windows scan vertically, but only the one
643 # the cursor is in scans horizontally
644 proc canvscan {op w x y} {
645 global canv canv2 canv3
646 foreach c [list $canv $canv2 $canv3] {
655 proc scrollcanv {cscroll f0 f1} {
660 # when we make a key binding for the toplevel, make sure
661 # it doesn't get triggered when that key is pressed in the
662 # find string entry widget.
663 proc bindkey {ev script} {
666 set escript [bind Entry $ev]
667 if {$escript == {}} {
668 set escript [bind Entry <Key>]
671 bind $e $ev "$escript; break"
675 # set the focus back to the toplevel for any click outside
686 global canv canv2 canv3 ctext cflist mainfont textfont uifont
687 global stuffsaved findmergefiles maxgraphpct
689 global viewname viewfiles viewperm nextviewnum
692 if {$stuffsaved} return
693 if {![winfo viewable .]} return
695 set f [open "~/.gitk-new" w]
696 puts $f [list set mainfont $mainfont]
697 puts $f [list set textfont $textfont]
698 puts $f [list set uifont $uifont]
699 puts $f [list set findmergefiles $findmergefiles]
700 puts $f [list set maxgraphpct $maxgraphpct]
701 puts $f [list set maxwidth $maxwidth]
702 puts $f [list set cmitmode $cmitmode]
703 puts $f "set geometry(width) [winfo width .ctop]"
704 puts $f "set geometry(height) [winfo height .ctop]"
705 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
706 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
707 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
708 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
709 set wid [expr {([winfo width $ctext] - 8) \
710 / [font measure $textfont "0"]}]
711 puts $f "set geometry(ctextw) $wid"
712 set wid [expr {([winfo width $cflist] - 11) \
713 / [font measure [$cflist cget -font] "0"]}]
714 puts $f "set geometry(cflistw) $wid"
715 puts -nonewline $f "set permviews {"
716 for {set v 0} {$v < $nextviewnum} {incr v} {
718 puts $f "{[list $viewname($v) $viewfiles($v)]}"
723 file rename -force "~/.gitk-new" "~/.gitk"
728 proc resizeclistpanes {win w} {
730 if {[info exists oldwidth($win)]} {
731 set s0 [$win sash coord 0]
732 set s1 [$win sash coord 1]
734 set sash0 [expr {int($w/2 - 2)}]
735 set sash1 [expr {int($w*5/6 - 2)}]
737 set factor [expr {1.0 * $w / $oldwidth($win)}]
738 set sash0 [expr {int($factor * [lindex $s0 0])}]
739 set sash1 [expr {int($factor * [lindex $s1 0])}]
743 if {$sash1 < $sash0 + 20} {
744 set sash1 [expr {$sash0 + 20}]
746 if {$sash1 > $w - 10} {
747 set sash1 [expr {$w - 10}]
748 if {$sash0 > $sash1 - 20} {
749 set sash0 [expr {$sash1 - 20}]
753 $win sash place 0 $sash0 [lindex $s0 1]
754 $win sash place 1 $sash1 [lindex $s1 1]
756 set oldwidth($win) $w
759 proc resizecdetpanes {win w} {
761 if {[info exists oldwidth($win)]} {
762 set s0 [$win sash coord 0]
764 set sash0 [expr {int($w*3/4 - 2)}]
766 set factor [expr {1.0 * $w / $oldwidth($win)}]
767 set sash0 [expr {int($factor * [lindex $s0 0])}]
771 if {$sash0 > $w - 15} {
772 set sash0 [expr {$w - 15}]
775 $win sash place 0 $sash0 [lindex $s0 1]
777 set oldwidth($win) $w
781 global canv canv2 canv3
787 proc bindall {event action} {
788 global canv canv2 canv3
789 bind $canv $event $action
790 bind $canv2 $event $action
791 bind $canv3 $event $action
796 if {[winfo exists $w]} {
801 wm title $w "About gitk"
803 Gitk - a commit viewer for git
805 Copyright © 2005-2006 Paul Mackerras
807 Use and redistribute under the terms of the GNU General Public License} \
808 -justify center -aspect 400
809 pack $w.m -side top -fill x -padx 20 -pady 20
810 button $w.ok -text Close -command "destroy $w"
811 pack $w.ok -side bottom
816 if {[winfo exists $w]} {
821 wm title $w "Gitk key bindings"
826 <Home> Move to first commit
827 <End> Move to last commit
828 <Up>, p, i Move up one commit
829 <Down>, n, k Move down one commit
830 <Left>, z, j Go back in history list
831 <Right>, x, l Go forward in history list
832 <PageUp> Move up one page in commit list
833 <PageDown> Move down one page in commit list
834 <Ctrl-Home> Scroll to top of commit list
835 <Ctrl-End> Scroll to bottom of commit list
836 <Ctrl-Up> Scroll commit list up one line
837 <Ctrl-Down> Scroll commit list down one line
838 <Ctrl-PageUp> Scroll commit list up one page
839 <Ctrl-PageDown> Scroll commit list down one page
840 <Delete>, b Scroll diff view up one page
841 <Backspace> Scroll diff view up one page
842 <Space> Scroll diff view down one page
843 u Scroll diff view up 18 lines
844 d Scroll diff view down 18 lines
846 <Ctrl-G> Move to next find hit
847 <Ctrl-R> Move to previous find hit
848 <Return> Move to next find hit
849 / Move to next find hit, or redo find
850 ? Move to previous find hit
851 f Scroll diff view to next file
852 <Ctrl-KP+> Increase font size
853 <Ctrl-plus> Increase font size
854 <Ctrl-KP-> Decrease font size
855 <Ctrl-minus> Decrease font size
857 -justify left -bg white -border 2 -relief sunken
858 pack $w.m -side top -fill both
859 button $w.ok -text Close -command "destroy $w"
860 pack $w.ok -side bottom
863 # Procedures for manipulating the file list window at the
864 # bottom right of the overall window.
866 proc treeview {w l openlevs} {
867 global treecontents treediropen treeheight treeparent treeindex
877 set treecontents() {}
878 $w conf -state normal
880 while {[string range $f 0 $prefixend] ne $prefix} {
881 if {$lev <= $openlevs} {
882 $w mark set e:$treeindex($prefix) "end -1c"
883 $w mark gravity e:$treeindex($prefix) left
885 set treeheight($prefix) $ht
886 incr ht [lindex $htstack end]
887 set htstack [lreplace $htstack end end]
888 set prefixend [lindex $prefendstack end]
889 set prefendstack [lreplace $prefendstack end end]
890 set prefix [string range $prefix 0 $prefixend]
893 set tail [string range $f [expr {$prefixend+1}] end]
894 while {[set slash [string first "/" $tail]] >= 0} {
897 lappend prefendstack $prefixend
898 incr prefixend [expr {$slash + 1}]
899 set d [string range $tail 0 $slash]
900 lappend treecontents($prefix) $d
901 set oldprefix $prefix
903 set treecontents($prefix) {}
904 set treeindex($prefix) [incr ix]
905 set treeparent($prefix) $oldprefix
906 set tail [string range $tail [expr {$slash+1}] end]
907 if {$lev <= $openlevs} {
909 set treediropen($prefix) [expr {$lev < $openlevs}]
910 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
911 $w mark set d:$ix "end -1c"
912 $w mark gravity d:$ix left
914 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
916 $w image create end -align center -image $bm -padx 1 \
919 $w mark set s:$ix "end -1c"
920 $w mark gravity s:$ix left
925 if {$lev <= $openlevs} {
928 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
932 lappend treecontents($prefix) $tail
935 while {$htstack ne {}} {
936 set treeheight($prefix) $ht
937 incr ht [lindex $htstack end]
938 set htstack [lreplace $htstack end end]
940 $w conf -state disabled
944 global treeheight treecontents
949 foreach e $treecontents($prefix) {
954 if {[string index $e end] eq "/"} {
955 set n $treeheight($prefix$e)
967 proc treeclosedir {w dir} {
968 global treediropen treeheight treeparent treeindex
970 set ix $treeindex($dir)
971 $w conf -state normal
972 $w delete s:$ix e:$ix
973 set treediropen($dir) 0
974 $w image configure a:$ix -image tri-rt
975 $w conf -state disabled
976 set n [expr {1 - $treeheight($dir)}]
978 incr treeheight($dir) $n
979 set dir $treeparent($dir)
983 proc treeopendir {w dir} {
984 global treediropen treeheight treeparent treecontents treeindex
986 set ix $treeindex($dir)
987 $w conf -state normal
988 $w image configure a:$ix -image tri-dn
989 $w mark set e:$ix s:$ix
990 $w mark gravity e:$ix right
993 set n [llength $treecontents($dir)]
994 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
997 incr treeheight($x) $n
999 foreach e $treecontents($dir) {
1000 if {[string index $e end] eq "/"} {
1002 set iy $treeindex($de)
1003 $w mark set d:$iy e:$ix
1004 $w mark gravity d:$iy left
1005 $w insert e:$ix $str
1006 set treediropen($de) 0
1007 $w image create e:$ix -align center -image tri-rt -padx 1 \
1010 $w mark set s:$iy e:$ix
1011 $w mark gravity s:$iy left
1012 set treeheight($de) 1
1014 $w insert e:$ix $str
1018 $w mark gravity e:$ix left
1019 $w conf -state disabled
1020 set treediropen($dir) 1
1021 set top [lindex [split [$w index @0,0] .] 0]
1022 set ht [$w cget -height]
1023 set l [lindex [split [$w index s:$ix] .] 0]
1026 } elseif {$l + $n + 1 > $top + $ht} {
1027 set top [expr {$l + $n + 2 - $ht}]
1035 proc treeclick {w x y} {
1036 global treediropen cmitmode ctext cflist cflist_top
1038 if {$cmitmode ne "tree"} return
1039 if {![info exists cflist_top]} return
1040 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1041 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1042 $cflist tag add highlight $l.0 "$l.0 lineend"
1048 set e [linetoelt $l]
1049 if {[string index $e end] ne "/"} {
1051 } elseif {$treediropen($e)} {
1058 proc setfilelist {id} {
1059 global treefilelist cflist
1061 treeview $cflist $treefilelist($id) 0
1064 image create bitmap tri-rt -background black -foreground blue -data {
1065 #define tri-rt_width 13
1066 #define tri-rt_height 13
1067 static unsigned char tri-rt_bits[] = {
1068 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1069 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1072 #define tri-rt-mask_width 13
1073 #define tri-rt-mask_height 13
1074 static unsigned char tri-rt-mask_bits[] = {
1075 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1076 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1079 image create bitmap tri-dn -background black -foreground blue -data {
1080 #define tri-dn_width 13
1081 #define tri-dn_height 13
1082 static unsigned char tri-dn_bits[] = {
1083 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1084 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1087 #define tri-dn-mask_width 13
1088 #define tri-dn-mask_height 13
1089 static unsigned char tri-dn-mask_bits[] = {
1090 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1091 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1095 proc init_flist {first} {
1096 global cflist cflist_top selectedline difffilestart
1098 $cflist conf -state normal
1099 $cflist delete 0.0 end
1101 $cflist insert end $first
1103 $cflist tag add highlight 1.0 "1.0 lineend"
1105 catch {unset cflist_top}
1107 $cflist conf -state disabled
1108 set difffilestart {}
1111 proc add_flist {fl} {
1112 global flistmode cflist
1114 $cflist conf -state normal
1115 if {$flistmode eq "flat"} {
1117 $cflist insert end "\n$f"
1120 $cflist conf -state disabled
1123 proc sel_flist {w x y} {
1124 global flistmode ctext difffilestart cflist cflist_top cmitmode
1126 if {$cmitmode eq "tree"} return
1127 if {![info exists cflist_top]} return
1128 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1129 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1130 $cflist tag add highlight $l.0 "$l.0 lineend"
1135 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1139 # Code to implement multiple views
1141 proc newview {ishighlight} {
1142 global nextviewnum newviewname newviewperm uifont newishighlight
1144 set newishighlight $ishighlight
1146 if {[winfo exists $top]} {
1150 set newviewname($nextviewnum) "View $nextviewnum"
1151 set newviewperm($nextviewnum) 0
1152 vieweditor $top $nextviewnum "Gitk view definition"
1157 global viewname viewperm newviewname newviewperm
1159 set top .gitkvedit-$curview
1160 if {[winfo exists $top]} {
1164 set newviewname($curview) $viewname($curview)
1165 set newviewperm($curview) $viewperm($curview)
1166 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1169 proc vieweditor {top n title} {
1170 global newviewname newviewperm viewfiles
1174 wm title $top $title
1175 label $top.nl -text "Name" -font $uifont
1176 entry $top.name -width 20 -textvariable newviewname($n)
1177 grid $top.nl $top.name -sticky w -pady 5
1178 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1179 grid $top.perm - -pady 5 -sticky w
1180 message $top.l -aspect 500 -font $uifont \
1181 -text "Enter files and directories to include, one per line:"
1182 grid $top.l - -sticky w
1183 text $top.t -width 40 -height 10 -background white
1184 if {[info exists viewfiles($n)]} {
1185 foreach f $viewfiles($n) {
1186 $top.t insert end $f
1187 $top.t insert end "\n"
1189 $top.t delete {end - 1c} end
1190 $top.t mark set insert 0.0
1192 grid $top.t - -sticky w -padx 5
1194 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1195 button $top.buts.can -text "Cancel" -command [list destroy $top]
1196 grid $top.buts.ok $top.buts.can
1197 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1198 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1199 grid $top.buts - -pady 10 -sticky ew
1203 proc doviewmenu {m first cmd op args} {
1204 set nmenu [$m index end]
1205 for {set i $first} {$i <= $nmenu} {incr i} {
1206 if {[$m entrycget $i -command] eq $cmd} {
1207 eval $m $op $i $args
1213 proc allviewmenus {n op args} {
1214 doviewmenu .bar.view 6 [list showview $n] $op $args
1215 doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1218 proc newviewok {top n} {
1219 global nextviewnum newviewperm newviewname newishighlight
1220 global viewname viewfiles viewperm selectedview curview
1223 foreach f [split [$top.t get 0.0 end] "\n"] {
1224 set ft [string trim $f]
1229 if {![info exists viewfiles($n)]} {
1230 # creating a new view
1232 set viewname($n) $newviewname($n)
1233 set viewperm($n) $newviewperm($n)
1234 set viewfiles($n) $files
1236 if {!$newishighlight} {
1237 after idle showview $n
1239 after idle addhighlight $n
1242 # editing an existing view
1243 set viewperm($n) $newviewperm($n)
1244 if {$newviewname($n) ne $viewname($n)} {
1245 set viewname($n) $newviewname($n)
1246 allviewmenus $n entryconf -label $viewname($n)
1248 if {$files ne $viewfiles($n)} {
1249 set viewfiles($n) $files
1250 if {$curview == $n} {
1251 after idle updatecommits
1255 catch {destroy $top}
1259 global curview viewdata viewperm
1261 if {$curview == 0} return
1262 allviewmenus $curview delete
1263 set viewdata($curview) {}
1264 set viewperm($curview) 0
1268 proc addviewmenu {n} {
1271 .bar.view add radiobutton -label $viewname($n) \
1272 -command [list showview $n] -variable selectedview -value $n
1273 .bar.view.hl add radiobutton -label $viewname($n) \
1274 -command [list addhighlight $n] -variable selectedhlview -value $n
1277 proc flatten {var} {
1281 foreach i [array names $var] {
1282 lappend ret $i [set $var\($i\)]
1287 proc unflatten {var l} {
1297 global curview viewdata viewfiles
1298 global displayorder parentlist childlist rowidlist rowoffsets
1299 global colormap rowtextx commitrow nextcolor canvxmax
1300 global numcommits rowrangelist commitlisted idrowranges
1301 global selectedline currentid canv canvy0
1302 global matchinglines treediffs
1303 global pending_select phase
1304 global commitidx rowlaidout rowoptim linesegends
1305 global commfd nextupdate
1306 global selectedview hlview selectedhlview
1307 global vparentlist vchildlist vdisporder vcmitlisted
1309 if {$n == $curview} return
1311 if {[info exists selectedline]} {
1312 set selid $currentid
1313 set y [yc $selectedline]
1314 set ymax [lindex [$canv cget -scrollregion] 3]
1315 set span [$canv yview]
1316 set ytop [expr {[lindex $span 0] * $ymax}]
1317 set ybot [expr {[lindex $span 1] * $ymax}]
1318 if {$ytop < $y && $y < $ybot} {
1319 set yscreen [expr {$y - $ytop}]
1321 set yscreen [expr {($ybot - $ytop) / 2}]
1327 if {$curview >= 0} {
1328 set vparentlist($curview) $parentlist
1329 set vchildlist($curview) $childlist
1330 set vdisporder($curview) $displayorder
1331 set vcmitlisted($curview) $commitlisted
1333 set viewdata($curview) \
1334 [list $phase $rowidlist $rowoffsets $rowrangelist \
1335 [flatten idrowranges] [flatten idinlist] \
1336 $rowlaidout $rowoptim $numcommits $linesegends]
1337 } elseif {![info exists viewdata($curview)]
1338 || [lindex $viewdata($curview) 0] ne {}} {
1339 set viewdata($curview) \
1340 [list {} $rowidlist $rowoffsets $rowrangelist]
1343 catch {unset matchinglines}
1344 catch {unset treediffs}
1349 set selectedhlview -1
1350 .bar.view entryconf 1 -state [expr {$n == 0? "disabled": "normal"}]
1351 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1352 catch {unset hlview}
1353 .bar.view.hl entryconf 1 -state disabled
1355 if {![info exists viewdata($n)]} {
1356 set pending_select $selid
1362 set phase [lindex $v 0]
1363 set displayorder $vdisporder($n)
1364 set parentlist $vparentlist($n)
1365 set childlist $vchildlist($n)
1366 set commitlisted $vcmitlisted($n)
1367 set rowidlist [lindex $v 1]
1368 set rowoffsets [lindex $v 2]
1369 set rowrangelist [lindex $v 3]
1371 set numcommits [llength $displayorder]
1372 catch {unset idrowranges}
1374 unflatten idrowranges [lindex $v 4]
1375 unflatten idinlist [lindex $v 5]
1376 set rowlaidout [lindex $v 6]
1377 set rowoptim [lindex $v 7]
1378 set numcommits [lindex $v 8]
1379 set linesegends [lindex $v 9]
1382 catch {unset colormap}
1383 catch {unset rowtextx}
1385 set canvxmax [$canv cget -width]
1391 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1392 set row $commitrow($n,$selid)
1393 # try to get the selected row in the same position on the screen
1394 set ymax [lindex [$canv cget -scrollregion] 3]
1395 set ytop [expr {[yc $row] - $yscreen}]
1399 set yf [expr {$ytop * 1.0 / $ymax}]
1401 allcanvs yview moveto $yf
1405 if {$phase eq "getcommits"} {
1407 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1408 -font $mainfont -tags textitems
1410 if {[info exists commfd($n)]} {
1418 proc addhighlight {n} {
1419 global hlview curview viewdata highlighted highlightedrows
1420 global selectedhlview
1422 if {[info exists hlview]} {
1426 set selectedhlview $n
1427 .bar.view.hl entryconf 1 -state normal
1428 set highlighted($n) 0
1429 set highlightedrows {}
1430 if {$n != $curview && ![info exists viewdata($n)]} {
1431 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1432 set vparentlist($n) {}
1433 set vchildlist($n) {}
1434 set vdisporder($n) {}
1435 set vcmitlisted($n) {}
1442 proc delhighlight {} {
1443 global hlview highlightedrows canv linehtag mainfont
1444 global selectedhlview selectedline
1446 if {![info exists hlview]} return
1448 set selectedhlview {}
1449 .bar.view.hl entryconf 1 -state disabled
1450 foreach l $highlightedrows {
1451 $canv itemconf $linehtag($l) -font $mainfont
1452 if {$l == $selectedline} {
1454 set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1455 -outline {{}} -tags secsel \
1456 -fill [$canv cget -selectbackground]]
1462 proc highlightmore {} {
1463 global hlview highlighted commitidx highlightedrows linehtag mainfont
1464 global displayorder vdisporder curview canv commitrow selectedline
1466 set font [concat $mainfont bold]
1467 set max $commitidx($hlview)
1468 if {$hlview == $curview} {
1469 set disp $displayorder
1471 set disp $vdisporder($hlview)
1473 for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1474 set id [lindex $disp $i]
1475 if {[info exists commitrow($curview,$id)]} {
1476 set row $commitrow($curview,$id)
1477 if {[info exists linehtag($row)]} {
1478 $canv itemconf $linehtag($row) -font $font
1479 lappend highlightedrows $row
1480 if {$row == $selectedline} {
1482 set t [eval $canv create rect \
1483 [$canv bbox $linehtag($row)] \
1484 -outline {{}} -tags secsel \
1485 -fill [$canv cget -selectbackground]]
1491 set highlighted($hlview) $max
1494 # Graph layout functions
1496 proc shortids {ids} {
1499 if {[llength $id] > 1} {
1500 lappend res [shortids $id]
1501 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1502 lappend res [string range $id 0 7]
1510 proc incrange {l x o} {
1513 set e [lindex $l $x]
1515 lset l $x [expr {$e + $o}]
1524 for {} {$n > 0} {incr n -1} {
1530 proc usedinrange {id l1 l2} {
1531 global children commitrow childlist curview
1533 if {[info exists commitrow($curview,$id)]} {
1534 set r $commitrow($curview,$id)
1535 if {$l1 <= $r && $r <= $l2} {
1536 return [expr {$r - $l1 + 1}]
1538 set kids [lindex $childlist $r]
1540 set kids $children($curview,$id)
1543 set r $commitrow($curview,$c)
1544 if {$l1 <= $r && $r <= $l2} {
1545 return [expr {$r - $l1 + 1}]
1551 proc sanity {row {full 0}} {
1552 global rowidlist rowoffsets
1555 set ids [lindex $rowidlist $row]
1558 if {$id eq {}} continue
1559 if {$col < [llength $ids] - 1 &&
1560 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1561 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1563 set o [lindex $rowoffsets $row $col]
1569 if {[lindex $rowidlist $y $x] != $id} {
1570 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1571 puts " id=[shortids $id] check started at row $row"
1572 for {set i $row} {$i >= $y} {incr i -1} {
1573 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1578 set o [lindex $rowoffsets $y $x]
1583 proc makeuparrow {oid x y z} {
1584 global rowidlist rowoffsets uparrowlen idrowranges
1586 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1589 set off0 [lindex $rowoffsets $y]
1590 for {set x0 $x} {1} {incr x0} {
1591 if {$x0 >= [llength $off0]} {
1592 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1595 set z [lindex $off0 $x0]
1601 set z [expr {$x0 - $x}]
1602 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1603 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1605 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1606 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1607 lappend idrowranges($oid) $y
1610 proc initlayout {} {
1611 global rowidlist rowoffsets displayorder commitlisted
1612 global rowlaidout rowoptim
1613 global idinlist rowchk rowrangelist idrowranges
1614 global numcommits canvxmax canv
1616 global parentlist childlist children
1617 global colormap rowtextx
1629 catch {unset idinlist}
1630 catch {unset rowchk}
1633 set canvxmax [$canv cget -width]
1634 catch {unset colormap}
1635 catch {unset rowtextx}
1636 catch {unset idrowranges}
1640 proc setcanvscroll {} {
1641 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1643 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1644 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1645 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1646 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1649 proc visiblerows {} {
1650 global canv numcommits linespc
1652 set ymax [lindex [$canv cget -scrollregion] 3]
1653 if {$ymax eq {} || $ymax == 0} return
1655 set y0 [expr {int([lindex $f 0] * $ymax)}]
1656 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1660 set y1 [expr {int([lindex $f 1] * $ymax)}]
1661 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1662 if {$r1 >= $numcommits} {
1663 set r1 [expr {$numcommits - 1}]
1665 return [list $r0 $r1]
1668 proc layoutmore {} {
1669 global rowlaidout rowoptim commitidx numcommits optim_delay
1670 global uparrowlen curview
1673 set rowlaidout [layoutrows $row $commitidx($curview) 0]
1674 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1675 if {$orow > $rowoptim} {
1676 optimize_rows $rowoptim 0 $orow
1679 set canshow [expr {$rowoptim - $optim_delay}]
1680 if {$canshow > $numcommits} {
1685 proc showstuff {canshow} {
1686 global numcommits commitrow pending_select selectedline
1687 global linesegends idrowranges idrangedrawn curview
1689 if {$numcommits == 0} {
1691 set phase "incrdraw"
1695 set numcommits $canshow
1697 set rows [visiblerows]
1698 set r0 [lindex $rows 0]
1699 set r1 [lindex $rows 1]
1701 for {set r $row} {$r < $canshow} {incr r} {
1702 foreach id [lindex $linesegends [expr {$r+1}]] {
1704 foreach {s e} [rowranges $id] {
1706 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1707 && ![info exists idrangedrawn($id,$i)]} {
1709 set idrangedrawn($id,$i) 1
1714 if {$canshow > $r1} {
1717 while {$row < $canshow} {
1721 if {[info exists pending_select] &&
1722 [info exists commitrow($curview,$pending_select)] &&
1723 $commitrow($curview,$pending_select) < $numcommits} {
1724 selectline $commitrow($curview,$pending_select) 1
1726 if {![info exists selectedline] && ![info exists pending_select]} {
1731 proc layoutrows {row endrow last} {
1732 global rowidlist rowoffsets displayorder
1733 global uparrowlen downarrowlen maxwidth mingaplen
1734 global childlist parentlist
1735 global idrowranges linesegends
1736 global commitidx curview
1737 global idinlist rowchk rowrangelist
1739 set idlist [lindex $rowidlist $row]
1740 set offs [lindex $rowoffsets $row]
1741 while {$row < $endrow} {
1742 set id [lindex $displayorder $row]
1745 foreach p [lindex $parentlist $row] {
1746 if {![info exists idinlist($p)]} {
1748 } elseif {!$idinlist($p)} {
1753 set nev [expr {[llength $idlist] + [llength $newolds]
1754 + [llength $oldolds] - $maxwidth + 1}]
1757 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1758 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1759 set i [lindex $idlist $x]
1760 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1761 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1762 [expr {$row + $uparrowlen + $mingaplen}]]
1764 set idlist [lreplace $idlist $x $x]
1765 set offs [lreplace $offs $x $x]
1766 set offs [incrange $offs $x 1]
1768 set rm1 [expr {$row - 1}]
1770 lappend idrowranges($i) $rm1
1771 if {[incr nev -1] <= 0} break
1774 set rowchk($id) [expr {$row + $r}]
1777 lset rowidlist $row $idlist
1778 lset rowoffsets $row $offs
1780 lappend linesegends $lse
1781 set col [lsearch -exact $idlist $id]
1783 set col [llength $idlist]
1785 lset rowidlist $row $idlist
1787 if {[lindex $childlist $row] ne {}} {
1788 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1792 lset rowoffsets $row $offs
1794 makeuparrow $id $col $row $z
1800 if {[info exists idrowranges($id)]} {
1801 set ranges $idrowranges($id)
1803 unset idrowranges($id)
1805 lappend rowrangelist $ranges
1807 set offs [ntimes [llength $idlist] 0]
1808 set l [llength $newolds]
1809 set idlist [eval lreplace \$idlist $col $col $newolds]
1812 set offs [lrange $offs 0 [expr {$col - 1}]]
1813 foreach x $newolds {
1818 set tmp [expr {[llength $idlist] - [llength $offs]}]
1820 set offs [concat $offs [ntimes $tmp $o]]
1825 foreach i $newolds {
1827 set idrowranges($i) $row
1830 foreach oid $oldolds {
1831 set idinlist($oid) 1
1832 set idlist [linsert $idlist $col $oid]
1833 set offs [linsert $offs $col $o]
1834 makeuparrow $oid $col $row $o
1837 lappend rowidlist $idlist
1838 lappend rowoffsets $offs
1843 proc addextraid {id row} {
1844 global displayorder commitrow commitinfo
1845 global commitidx commitlisted
1846 global parentlist childlist children curview
1848 incr commitidx($curview)
1849 lappend displayorder $id
1850 lappend commitlisted 0
1851 lappend parentlist {}
1852 set commitrow($curview,$id) $row
1854 if {![info exists commitinfo($id)]} {
1855 set commitinfo($id) {"No commit information available"}
1857 if {![info exists children($curview,$id)]} {
1858 set children($curview,$id) {}
1860 lappend childlist $children($curview,$id)
1863 proc layouttail {} {
1864 global rowidlist rowoffsets idinlist commitidx curview
1865 global idrowranges rowrangelist
1867 set row $commitidx($curview)
1868 set idlist [lindex $rowidlist $row]
1869 while {$idlist ne {}} {
1870 set col [expr {[llength $idlist] - 1}]
1871 set id [lindex $idlist $col]
1874 lappend idrowranges($id) $row
1875 lappend rowrangelist $idrowranges($id)
1876 unset idrowranges($id)
1878 set offs [ntimes $col 0]
1879 set idlist [lreplace $idlist $col $col]
1880 lappend rowidlist $idlist
1881 lappend rowoffsets $offs
1884 foreach id [array names idinlist] {
1886 lset rowidlist $row [list $id]
1887 lset rowoffsets $row 0
1888 makeuparrow $id 0 $row 0
1889 lappend idrowranges($id) $row
1890 lappend rowrangelist $idrowranges($id)
1891 unset idrowranges($id)
1893 lappend rowidlist {}
1894 lappend rowoffsets {}
1898 proc insert_pad {row col npad} {
1899 global rowidlist rowoffsets
1901 set pad [ntimes $npad {}]
1902 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1903 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1904 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1907 proc optimize_rows {row col endrow} {
1908 global rowidlist rowoffsets idrowranges displayorder
1910 for {} {$row < $endrow} {incr row} {
1911 set idlist [lindex $rowidlist $row]
1912 set offs [lindex $rowoffsets $row]
1914 for {} {$col < [llength $offs]} {incr col} {
1915 if {[lindex $idlist $col] eq {}} {
1919 set z [lindex $offs $col]
1920 if {$z eq {}} continue
1922 set x0 [expr {$col + $z}]
1923 set y0 [expr {$row - 1}]
1924 set z0 [lindex $rowoffsets $y0 $x0]
1926 set id [lindex $idlist $col]
1927 set ranges [rowranges $id]
1928 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1932 if {$z < -1 || ($z < 0 && $isarrow)} {
1933 set npad [expr {-1 - $z + $isarrow}]
1934 set offs [incrange $offs $col $npad]
1935 insert_pad $y0 $x0 $npad
1937 optimize_rows $y0 $x0 $row
1939 set z [lindex $offs $col]
1940 set x0 [expr {$col + $z}]
1941 set z0 [lindex $rowoffsets $y0 $x0]
1942 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1943 set npad [expr {$z - 1 + $isarrow}]
1944 set y1 [expr {$row + 1}]
1945 set offs2 [lindex $rowoffsets $y1]
1949 if {$z eq {} || $x1 + $z < $col} continue
1950 if {$x1 + $z > $col} {
1953 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1956 set pad [ntimes $npad {}]
1957 set idlist [eval linsert \$idlist $col $pad]
1958 set tmp [eval linsert \$offs $col $pad]
1960 set offs [incrange $tmp $col [expr {-$npad}]]
1961 set z [lindex $offs $col]
1964 if {$z0 eq {} && !$isarrow} {
1965 # this line links to its first child on row $row-2
1966 set rm2 [expr {$row - 2}]
1967 set id [lindex $displayorder $rm2]
1968 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1970 set z0 [expr {$xc - $x0}]
1973 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1974 insert_pad $y0 $x0 1
1975 set offs [incrange $offs $col 1]
1976 optimize_rows $y0 [expr {$x0 + 1}] $row
1981 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1982 set o [lindex $offs $col]
1984 # check if this is the link to the first child
1985 set id [lindex $idlist $col]
1986 set ranges [rowranges $id]
1987 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1988 # it is, work out offset to child
1989 set y0 [expr {$row - 1}]
1990 set id [lindex $displayorder $y0]
1991 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1993 set o [expr {$x0 - $col}]
1997 if {$o eq {} || $o <= 0} break
1999 if {$o ne {} && [incr col] < [llength $idlist]} {
2000 set y1 [expr {$row + 1}]
2001 set offs2 [lindex $rowoffsets $y1]
2005 if {$z eq {} || $x1 + $z < $col} continue
2006 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2009 set idlist [linsert $idlist $col {}]
2010 set tmp [linsert $offs $col {}]
2012 set offs [incrange $tmp $col -1]
2015 lset rowidlist $row $idlist
2016 lset rowoffsets $row $offs
2022 global canvx0 linespc
2023 return [expr {$canvx0 + $col * $linespc}]
2027 global canvy0 linespc
2028 return [expr {$canvy0 + $row * $linespc}]
2031 proc linewidth {id} {
2032 global thickerline lthickness
2035 if {[info exists thickerline] && $id eq $thickerline} {
2036 set wid [expr {2 * $lthickness}]
2041 proc rowranges {id} {
2042 global phase idrowranges commitrow rowlaidout rowrangelist curview
2046 ([info exists commitrow($curview,$id)]
2047 && $commitrow($curview,$id) < $rowlaidout)} {
2048 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2049 } elseif {[info exists idrowranges($id)]} {
2050 set ranges $idrowranges($id)
2055 proc drawlineseg {id i} {
2056 global rowoffsets rowidlist
2058 global canv colormap linespc
2059 global numcommits commitrow curview
2061 set ranges [rowranges $id]
2063 if {[info exists commitrow($curview,$id)]
2064 && $commitrow($curview,$id) < $numcommits} {
2065 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2069 set startrow [lindex $ranges [expr {2 * $i}]]
2070 set row [lindex $ranges [expr {2 * $i + 1}]]
2071 if {$startrow == $row} return
2074 set col [lsearch -exact [lindex $rowidlist $row] $id]
2076 puts "oops: drawline: id $id not on row $row"
2082 set o [lindex $rowoffsets $row $col]
2085 # changing direction
2086 set x [xc $row $col]
2088 lappend coords $x $y
2094 set x [xc $row $col]
2096 lappend coords $x $y
2098 # draw the link to the first child as part of this line
2100 set child [lindex $displayorder $row]
2101 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2103 set x [xc $row $ccol]
2105 if {$ccol < $col - 1} {
2106 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2107 } elseif {$ccol > $col + 1} {
2108 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2110 lappend coords $x $y
2113 if {[llength $coords] < 4} return
2115 # This line has an arrow at the lower end: check if the arrow is
2116 # on a diagonal segment, and if so, work around the Tk 8.4
2117 # refusal to draw arrows on diagonal lines.
2118 set x0 [lindex $coords 0]
2119 set x1 [lindex $coords 2]
2121 set y0 [lindex $coords 1]
2122 set y1 [lindex $coords 3]
2123 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2124 # we have a nearby vertical segment, just trim off the diag bit
2125 set coords [lrange $coords 2 end]
2127 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2128 set xi [expr {$x0 - $slope * $linespc / 2}]
2129 set yi [expr {$y0 - $linespc / 2}]
2130 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2134 set arrow [expr {2 * ($i > 0) + $downarrow}]
2135 set arrow [lindex {none first last both} $arrow]
2136 set t [$canv create line $coords -width [linewidth $id] \
2137 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2142 proc drawparentlinks {id row col olds} {
2143 global rowidlist canv colormap
2145 set row2 [expr {$row + 1}]
2146 set x [xc $row $col]
2149 set ids [lindex $rowidlist $row2]
2150 # rmx = right-most X coord used
2153 set i [lsearch -exact $ids $p]
2155 puts "oops, parent $p of $id not in list"
2158 set x2 [xc $row2 $i]
2162 set ranges [rowranges $p]
2163 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2164 && $row2 < [lindex $ranges 1]} {
2165 # drawlineseg will do this one for us
2169 # should handle duplicated parents here...
2170 set coords [list $x $y]
2171 if {$i < $col - 1} {
2172 lappend coords [xc $row [expr {$i + 1}]] $y
2173 } elseif {$i > $col + 1} {
2174 lappend coords [xc $row [expr {$i - 1}]] $y
2176 lappend coords $x2 $y2
2177 set t [$canv create line $coords -width [linewidth $p] \
2178 -fill $colormap($p) -tags lines.$p]
2185 proc drawlines {id} {
2186 global colormap canv
2188 global children iddrawn commitrow rowidlist curview
2190 $canv delete lines.$id
2191 set nr [expr {[llength [rowranges $id]] / 2}]
2192 for {set i 0} {$i < $nr} {incr i} {
2193 if {[info exists idrangedrawn($id,$i)]} {
2197 foreach child $children($curview,$id) {
2198 if {[info exists iddrawn($child)]} {
2199 set row $commitrow($curview,$child)
2200 set col [lsearch -exact [lindex $rowidlist $row] $child]
2202 drawparentlinks $child $row $col [list $id]
2208 proc drawcmittext {id row col rmx} {
2209 global linespc canv canv2 canv3 canvy0
2210 global commitlisted commitinfo rowidlist
2211 global rowtextx idpos idtags idheads idotherrefs
2212 global linehtag linentag linedtag
2213 global mainfont canvxmax
2214 global hlview commitrow highlightedrows
2216 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2217 set x [xc $row $col]
2219 set orad [expr {$linespc / 3}]
2220 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2221 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2222 -fill $ofill -outline black -width 1]
2224 $canv bind $t <1> {selcanvline {} %x %y}
2225 set xt [xc $row [llength [lindex $rowidlist $row]]]
2229 set rowtextx($row) $xt
2230 set idpos($id) [list $x $xt $y]
2231 if {[info exists idtags($id)] || [info exists idheads($id)]
2232 || [info exists idotherrefs($id)]} {
2233 set xt [drawtags $id $x $xt $y]
2235 set headline [lindex $commitinfo($id) 0]
2236 set name [lindex $commitinfo($id) 1]
2237 set date [lindex $commitinfo($id) 2]
2238 set date [formatdate $date]
2240 if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2242 lappend highlightedrows $row
2244 set linehtag($row) [$canv create text $xt $y -anchor w \
2245 -text $headline -font $font]
2246 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2247 set linentag($row) [$canv2 create text 3 $y -anchor w \
2248 -text $name -font $mainfont]
2249 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2250 -text $date -font $mainfont]
2251 set xr [expr {$xt + [font measure $mainfont $headline]}]
2252 if {$xr > $canvxmax} {
2258 proc drawcmitrow {row} {
2259 global displayorder rowidlist
2260 global idrangedrawn iddrawn
2261 global commitinfo parentlist numcommits
2263 if {$row >= $numcommits} return
2264 foreach id [lindex $rowidlist $row] {
2265 if {$id eq {}} continue
2267 foreach {s e} [rowranges $id] {
2269 if {$row < $s} continue
2272 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2274 set idrangedrawn($id,$i) 1
2281 set id [lindex $displayorder $row]
2282 if {[info exists iddrawn($id)]} return
2283 set col [lsearch -exact [lindex $rowidlist $row] $id]
2285 puts "oops, row $row id $id not in list"
2288 if {![info exists commitinfo($id)]} {
2292 set olds [lindex $parentlist $row]
2294 set rmx [drawparentlinks $id $row $col $olds]
2298 drawcmittext $id $row $col $rmx
2302 proc drawfrac {f0 f1} {
2303 global numcommits canv
2306 set ymax [lindex [$canv cget -scrollregion] 3]
2307 if {$ymax eq {} || $ymax == 0} return
2308 set y0 [expr {int($f0 * $ymax)}]
2309 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2313 set y1 [expr {int($f1 * $ymax)}]
2314 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2315 if {$endrow >= $numcommits} {
2316 set endrow [expr {$numcommits - 1}]
2318 for {} {$row <= $endrow} {incr row} {
2323 proc drawvisible {} {
2325 eval drawfrac [$canv yview]
2328 proc clear_display {} {
2329 global iddrawn idrangedrawn
2332 catch {unset iddrawn}
2333 catch {unset idrangedrawn}
2336 proc findcrossings {id} {
2337 global rowidlist parentlist numcommits rowoffsets displayorder
2341 foreach {s e} [rowranges $id] {
2342 if {$e >= $numcommits} {
2343 set e [expr {$numcommits - 1}]
2345 if {$e <= $s} continue
2346 set x [lsearch -exact [lindex $rowidlist $e] $id]
2348 puts "findcrossings: oops, no [shortids $id] in row $e"
2351 for {set row $e} {[incr row -1] >= $s} {} {
2352 set olds [lindex $parentlist $row]
2353 set kid [lindex $displayorder $row]
2354 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2355 if {$kidx < 0} continue
2356 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2358 set px [lsearch -exact $nextrow $p]
2359 if {$px < 0} continue
2360 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2361 if {[lsearch -exact $ccross $p] >= 0} continue
2362 if {$x == $px + ($kidx < $px? -1: 1)} {
2364 } elseif {[lsearch -exact $cross $p] < 0} {
2369 set inc [lindex $rowoffsets $row $x]
2370 if {$inc eq {}} break
2374 return [concat $ccross {{}} $cross]
2377 proc assigncolor {id} {
2378 global colormap colors nextcolor
2379 global commitrow parentlist children children curview
2381 if {[info exists colormap($id)]} return
2382 set ncolors [llength $colors]
2383 if {[info exists children($curview,$id)]} {
2384 set kids $children($curview,$id)
2388 if {[llength $kids] == 1} {
2389 set child [lindex $kids 0]
2390 if {[info exists colormap($child)]
2391 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2392 set colormap($id) $colormap($child)
2398 foreach x [findcrossings $id] {
2400 # delimiter between corner crossings and other crossings
2401 if {[llength $badcolors] >= $ncolors - 1} break
2402 set origbad $badcolors
2404 if {[info exists colormap($x)]
2405 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2406 lappend badcolors $colormap($x)
2409 if {[llength $badcolors] >= $ncolors} {
2410 set badcolors $origbad
2412 set origbad $badcolors
2413 if {[llength $badcolors] < $ncolors - 1} {
2414 foreach child $kids {
2415 if {[info exists colormap($child)]
2416 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2417 lappend badcolors $colormap($child)
2419 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2420 if {[info exists colormap($p)]
2421 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2422 lappend badcolors $colormap($p)
2426 if {[llength $badcolors] >= $ncolors} {
2427 set badcolors $origbad
2430 for {set i 0} {$i <= $ncolors} {incr i} {
2431 set c [lindex $colors $nextcolor]
2432 if {[incr nextcolor] >= $ncolors} {
2435 if {[lsearch -exact $badcolors $c]} break
2437 set colormap($id) $c
2440 proc bindline {t id} {
2443 $canv bind $t <Enter> "lineenter %x %y $id"
2444 $canv bind $t <Motion> "linemotion %x %y $id"
2445 $canv bind $t <Leave> "lineleave $id"
2446 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2449 proc drawtags {id x xt y1} {
2450 global idtags idheads idotherrefs
2451 global linespc lthickness
2452 global canv mainfont commitrow rowtextx curview
2457 if {[info exists idtags($id)]} {
2458 set marks $idtags($id)
2459 set ntags [llength $marks]
2461 if {[info exists idheads($id)]} {
2462 set marks [concat $marks $idheads($id)]
2463 set nheads [llength $idheads($id)]
2465 if {[info exists idotherrefs($id)]} {
2466 set marks [concat $marks $idotherrefs($id)]
2472 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2473 set yt [expr {$y1 - 0.5 * $linespc}]
2474 set yb [expr {$yt + $linespc - 1}]
2477 foreach tag $marks {
2478 set wid [font measure $mainfont $tag]
2481 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2483 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2484 -width $lthickness -fill black -tags tag.$id]
2486 foreach tag $marks x $xvals wid $wvals {
2487 set xl [expr {$x + $delta}]
2488 set xr [expr {$x + $delta + $wid + $lthickness}]
2489 if {[incr ntags -1] >= 0} {
2491 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2492 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2493 -width 1 -outline black -fill yellow -tags tag.$id]
2494 $canv bind $t <1> [list showtag $tag 1]
2495 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2497 # draw a head or other ref
2498 if {[incr nheads -1] >= 0} {
2503 set xl [expr {$xl - $delta/2}]
2504 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2505 -width 1 -outline black -fill $col -tags tag.$id
2506 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2507 set rwid [font measure $mainfont $remoteprefix]
2508 set xi [expr {$x + 1}]
2509 set yti [expr {$yt + 1}]
2510 set xri [expr {$x + $rwid}]
2511 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2512 -width 0 -fill "#ffddaa" -tags tag.$id
2515 set t [$canv create text $xl $y1 -anchor w -text $tag \
2516 -font $mainfont -tags tag.$id]
2518 $canv bind $t <1> [list showtag $tag 1]
2524 proc xcoord {i level ln} {
2525 global canvx0 xspc1 xspc2
2527 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2528 if {$i > 0 && $i == $level} {
2529 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2530 } elseif {$i > $level} {
2531 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2536 proc finishcommits {} {
2537 global commitidx phase curview
2538 global canv mainfont ctext maincursor textcursor
2539 global findinprogress pending_select
2541 if {$commitidx($curview) > 0} {
2545 $canv create text 3 3 -anchor nw -text "No commits selected" \
2546 -font $mainfont -tags textitems
2549 catch {unset pending_select}
2552 # Don't change the text pane cursor if it is currently the hand cursor,
2553 # showing that we are over a sha1 ID link.
2554 proc settextcursor {c} {
2555 global ctext curtextcursor
2557 if {[$ctext cget -cursor] == $curtextcursor} {
2558 $ctext config -cursor $c
2560 set curtextcursor $c
2563 proc nowbusy {what} {
2566 if {[array names isbusy] eq {}} {
2567 . config -cursor watch
2573 proc notbusy {what} {
2574 global isbusy maincursor textcursor
2576 catch {unset isbusy($what)}
2577 if {[array names isbusy] eq {}} {
2578 . config -cursor $maincursor
2579 settextcursor $textcursor
2586 global canvy0 numcommits linespc
2587 global rowlaidout commitidx curview
2588 global pending_select
2591 layoutrows $rowlaidout $commitidx($curview) 1
2593 optimize_rows $row 0 $commitidx($curview)
2594 showstuff $commitidx($curview)
2595 if {[info exists pending_select]} {
2599 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2600 #puts "overall $drawmsecs ms for $numcommits commits"
2603 proc findmatches {f} {
2604 global findtype foundstring foundstrlen
2605 if {$findtype == "Regexp"} {
2606 set matches [regexp -indices -all -inline $foundstring $f]
2608 if {$findtype == "IgnCase"} {
2609 set str [string tolower $f]
2615 while {[set j [string first $foundstring $str $i]] >= 0} {
2616 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2617 set i [expr {$j + $foundstrlen}]
2624 global findtype findloc findstring markedmatches commitinfo
2625 global numcommits displayorder linehtag linentag linedtag
2626 global mainfont canv canv2 canv3 selectedline
2627 global matchinglines foundstring foundstrlen matchstring
2633 set matchinglines {}
2634 if {$findloc == "Pickaxe"} {
2638 if {$findtype == "IgnCase"} {
2639 set foundstring [string tolower $findstring]
2641 set foundstring $findstring
2643 set foundstrlen [string length $findstring]
2644 if {$foundstrlen == 0} return
2645 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2646 set matchstring "*$matchstring*"
2647 if {$findloc == "Files"} {
2651 if {![info exists selectedline]} {
2654 set oldsel $selectedline
2657 set fldtypes {Headline Author Date Committer CDate Comment}
2659 foreach id $displayorder {
2660 set d $commitdata($id)
2662 if {$findtype == "Regexp"} {
2663 set doesmatch [regexp $foundstring $d]
2664 } elseif {$findtype == "IgnCase"} {
2665 set doesmatch [string match -nocase $matchstring $d]
2667 set doesmatch [string match $matchstring $d]
2669 if {!$doesmatch} continue
2670 if {![info exists commitinfo($id)]} {
2673 set info $commitinfo($id)
2675 foreach f $info ty $fldtypes {
2676 if {$findloc != "All fields" && $findloc != $ty} {
2679 set matches [findmatches $f]
2680 if {$matches == {}} continue
2682 if {$ty == "Headline"} {
2684 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2685 } elseif {$ty == "Author"} {
2687 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2688 } elseif {$ty == "Date"} {
2690 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2694 lappend matchinglines $l
2695 if {!$didsel && $l > $oldsel} {
2701 if {$matchinglines == {}} {
2703 } elseif {!$didsel} {
2704 findselectline [lindex $matchinglines 0]
2708 proc findselectline {l} {
2709 global findloc commentend ctext
2711 if {$findloc == "All fields" || $findloc == "Comments"} {
2712 # highlight the matches in the comments
2713 set f [$ctext get 1.0 $commentend]
2714 set matches [findmatches $f]
2715 foreach match $matches {
2716 set start [lindex $match 0]
2717 set end [expr {[lindex $match 1] + 1}]
2718 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2723 proc findnext {restart} {
2724 global matchinglines selectedline
2725 if {![info exists matchinglines]} {
2731 if {![info exists selectedline]} return
2732 foreach l $matchinglines {
2733 if {$l > $selectedline} {
2742 global matchinglines selectedline
2743 if {![info exists matchinglines]} {
2747 if {![info exists selectedline]} return
2749 foreach l $matchinglines {
2750 if {$l >= $selectedline} break
2754 findselectline $prev
2760 proc findlocchange {name ix op} {
2761 global findloc findtype findtypemenu
2762 if {$findloc == "Pickaxe"} {
2768 $findtypemenu entryconf 1 -state $state
2769 $findtypemenu entryconf 2 -state $state
2772 proc stopfindproc {{done 0}} {
2773 global findprocpid findprocfile findids
2774 global ctext findoldcursor phase maincursor textcursor
2775 global findinprogress
2777 catch {unset findids}
2778 if {[info exists findprocpid]} {
2780 catch {exec kill $findprocpid}
2782 catch {close $findprocfile}
2785 catch {unset findinprogress}
2789 proc findpatches {} {
2790 global findstring selectedline numcommits
2791 global findprocpid findprocfile
2792 global finddidsel ctext displayorder findinprogress
2793 global findinsertpos
2795 if {$numcommits == 0} return
2797 # make a list of all the ids to search, starting at the one
2798 # after the selected line (if any)
2799 if {[info exists selectedline]} {
2805 for {set i 0} {$i < $numcommits} {incr i} {
2806 if {[incr l] >= $numcommits} {
2809 append inputids [lindex $displayorder $l] "\n"
2813 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2816 error_popup "Error starting search process: $err"
2820 set findinsertpos end
2822 set findprocpid [pid $f]
2823 fconfigure $f -blocking 0
2824 fileevent $f readable readfindproc
2827 set findinprogress 1
2830 proc readfindproc {} {
2831 global findprocfile finddidsel
2832 global commitrow matchinglines findinsertpos curview
2834 set n [gets $findprocfile line]
2836 if {[eof $findprocfile]} {
2844 if {![regexp {^[0-9a-f]{40}} $line id]} {
2845 error_popup "Can't parse git-diff-tree output: $line"
2849 if {![info exists commitrow($curview,$id)]} {
2850 puts stderr "spurious id: $id"
2853 set l $commitrow($curview,$id)
2857 proc insertmatch {l id} {
2858 global matchinglines findinsertpos finddidsel
2860 if {$findinsertpos == "end"} {
2861 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2862 set matchinglines [linsert $matchinglines 0 $l]
2865 lappend matchinglines $l
2868 set matchinglines [linsert $matchinglines $findinsertpos $l]
2879 global selectedline numcommits displayorder ctext
2880 global ffileline finddidsel parentlist
2881 global findinprogress findstartline findinsertpos
2882 global treediffs fdiffid fdiffsneeded fdiffpos
2883 global findmergefiles
2885 if {$numcommits == 0} return
2887 if {[info exists selectedline]} {
2888 set l [expr {$selectedline + 1}]
2893 set findstartline $l
2897 set id [lindex $displayorder $l]
2898 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2899 if {![info exists treediffs($id)]} {
2900 append diffsneeded "$id\n"
2901 lappend fdiffsneeded $id
2904 if {[incr l] >= $numcommits} {
2907 if {$l == $findstartline} break
2910 # start off a git-diff-tree process if needed
2911 if {$diffsneeded ne {}} {
2913 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2915 error_popup "Error starting search process: $err"
2918 catch {unset fdiffid}
2920 fconfigure $df -blocking 0
2921 fileevent $df readable [list readfilediffs $df]
2925 set findinsertpos end
2926 set id [lindex $displayorder $l]
2928 set findinprogress 1
2933 proc readfilediffs {df} {
2934 global findid fdiffid fdiffs
2936 set n [gets $df line]
2940 if {[catch {close $df} err]} {
2943 error_popup "Error in git-diff-tree: $err"
2944 } elseif {[info exists findid]} {
2948 error_popup "Couldn't find diffs for $id"
2953 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2954 # start of a new string of diffs
2958 } elseif {[string match ":*" $line]} {
2959 lappend fdiffs [lindex $line 5]
2963 proc donefilediff {} {
2964 global fdiffid fdiffs treediffs findid
2965 global fdiffsneeded fdiffpos
2967 if {[info exists fdiffid]} {
2968 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2969 && $fdiffpos < [llength $fdiffsneeded]} {
2970 # git-diff-tree doesn't output anything for a commit
2971 # which doesn't change anything
2972 set nullid [lindex $fdiffsneeded $fdiffpos]
2973 set treediffs($nullid) {}
2974 if {[info exists findid] && $nullid eq $findid} {
2982 if {![info exists treediffs($fdiffid)]} {
2983 set treediffs($fdiffid) $fdiffs
2985 if {[info exists findid] && $fdiffid eq $findid} {
2993 global findid treediffs parentlist
2994 global ffileline findstartline finddidsel
2995 global displayorder numcommits matchinglines findinprogress
2996 global findmergefiles
3000 set id [lindex $displayorder $l]
3001 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3002 if {![info exists treediffs($id)]} {
3008 foreach f $treediffs($id) {
3009 set x [findmatches $f]
3019 if {[incr l] >= $numcommits} {
3022 if {$l == $findstartline} break
3030 # mark a commit as matching by putting a yellow background
3031 # behind the headline
3032 proc markheadline {l id} {
3033 global canv mainfont linehtag
3036 set bbox [$canv bbox $linehtag($l)]
3037 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3041 # mark the bits of a headline, author or date that match a find string
3042 proc markmatches {canv l str tag matches font} {
3043 set bbox [$canv bbox $tag]
3044 set x0 [lindex $bbox 0]
3045 set y0 [lindex $bbox 1]
3046 set y1 [lindex $bbox 3]
3047 foreach match $matches {
3048 set start [lindex $match 0]
3049 set end [lindex $match 1]
3050 if {$start > $end} continue
3051 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3052 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3053 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3054 [expr {$x0+$xlen+2}] $y1 \
3055 -outline {} -tags matches -fill yellow]
3060 proc unmarkmatches {} {
3061 global matchinglines findids
3062 allcanvs delete matches
3063 catch {unset matchinglines}
3064 catch {unset findids}
3067 proc selcanvline {w x y} {
3068 global canv canvy0 ctext linespc
3070 set ymax [lindex [$canv cget -scrollregion] 3]
3071 if {$ymax == {}} return
3072 set yfrac [lindex [$canv yview] 0]
3073 set y [expr {$y + $yfrac * $ymax}]
3074 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3079 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3085 proc commit_descriptor {p} {
3088 if {[info exists commitinfo($p)]} {
3089 set l [lindex $commitinfo($p) 0]
3094 # append some text to the ctext widget, and make any SHA1 ID
3095 # that we know about be a clickable link.
3096 proc appendwithlinks {text} {
3097 global ctext commitrow linknum curview
3099 set start [$ctext index "end - 1c"]
3100 $ctext insert end $text
3101 $ctext insert end "\n"
3102 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3106 set linkid [string range $text $s $e]
3107 if {![info exists commitrow($curview,$linkid)]} continue
3109 $ctext tag add link "$start + $s c" "$start + $e c"
3110 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3111 $ctext tag bind link$linknum <1> \
3112 [list selectline $commitrow($curview,$linkid) 1]
3115 $ctext tag conf link -foreground blue -underline 1
3116 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3117 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3120 proc viewnextline {dir} {
3124 set ymax [lindex [$canv cget -scrollregion] 3]
3125 set wnow [$canv yview]
3126 set wtop [expr {[lindex $wnow 0] * $ymax}]
3127 set newtop [expr {$wtop + $dir * $linespc}]
3130 } elseif {$newtop > $ymax} {
3133 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3136 proc selectline {l isnew} {
3137 global canv canv2 canv3 ctext commitinfo selectedline
3138 global displayorder linehtag linentag linedtag
3139 global canvy0 linespc parentlist childlist
3140 global currentid sha1entry
3141 global commentend idtags linknum
3142 global mergemax numcommits pending_select
3145 catch {unset pending_select}
3148 if {$l < 0 || $l >= $numcommits} return
3149 set y [expr {$canvy0 + $l * $linespc}]
3150 set ymax [lindex [$canv cget -scrollregion] 3]
3151 set ytop [expr {$y - $linespc - 1}]
3152 set ybot [expr {$y + $linespc + 1}]
3153 set wnow [$canv yview]
3154 set wtop [expr {[lindex $wnow 0] * $ymax}]
3155 set wbot [expr {[lindex $wnow 1] * $ymax}]
3156 set wh [expr {$wbot - $wtop}]
3158 if {$ytop < $wtop} {
3159 if {$ybot < $wtop} {
3160 set newtop [expr {$y - $wh / 2.0}]
3163 if {$newtop > $wtop - $linespc} {
3164 set newtop [expr {$wtop - $linespc}]
3167 } elseif {$ybot > $wbot} {
3168 if {$ytop > $wbot} {
3169 set newtop [expr {$y - $wh / 2.0}]
3171 set newtop [expr {$ybot - $wh}]
3172 if {$newtop < $wtop + $linespc} {
3173 set newtop [expr {$wtop + $linespc}]
3177 if {$newtop != $wtop} {
3181 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3185 if {![info exists linehtag($l)]} return
3187 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3188 -tags secsel -fill [$canv cget -selectbackground]]
3190 $canv2 delete secsel
3191 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3192 -tags secsel -fill [$canv2 cget -selectbackground]]
3194 $canv3 delete secsel
3195 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3196 -tags secsel -fill [$canv3 cget -selectbackground]]
3200 addtohistory [list selectline $l 0]
3205 set id [lindex $displayorder $l]
3207 $sha1entry delete 0 end
3208 $sha1entry insert 0 $id
3209 $sha1entry selection from 0
3210 $sha1entry selection to end
3212 $ctext conf -state normal
3213 $ctext delete 0.0 end
3215 set info $commitinfo($id)
3216 set date [formatdate [lindex $info 2]]
3217 $ctext insert end "Author: [lindex $info 1] $date\n"
3218 set date [formatdate [lindex $info 4]]
3219 $ctext insert end "Committer: [lindex $info 3] $date\n"
3220 if {[info exists idtags($id)]} {
3221 $ctext insert end "Tags:"
3222 foreach tag $idtags($id) {
3223 $ctext insert end " $tag"
3225 $ctext insert end "\n"
3229 set olds [lindex $parentlist $l]
3230 if {[llength $olds] > 1} {
3233 if {$np >= $mergemax} {
3238 $ctext insert end "Parent: " $tag
3239 appendwithlinks [commit_descriptor $p]
3244 append comment "Parent: [commit_descriptor $p]\n"
3248 foreach c [lindex $childlist $l] {
3249 append comment "Child: [commit_descriptor $c]\n"
3252 append comment [lindex $info 5]
3254 # make anything that looks like a SHA1 ID be a clickable link
3255 appendwithlinks $comment
3257 $ctext tag delete Comments
3258 $ctext tag remove found 1.0 end
3259 $ctext conf -state disabled
3260 set commentend [$ctext index "end - 1c"]
3262 init_flist "Comments"
3263 if {$cmitmode eq "tree"} {
3265 } elseif {[llength $olds] <= 1} {
3272 proc selfirstline {} {
3277 proc sellastline {} {
3280 set l [expr {$numcommits - 1}]
3284 proc selnextline {dir} {
3286 if {![info exists selectedline]} return
3287 set l [expr {$selectedline + $dir}]
3292 proc selnextpage {dir} {
3293 global canv linespc selectedline numcommits
3295 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3299 allcanvs yview scroll [expr {$dir * $lpp}] units
3300 if {![info exists selectedline]} return
3301 set l [expr {$selectedline + $dir * $lpp}]
3304 } elseif {$l >= $numcommits} {
3305 set l [expr $numcommits - 1]
3311 proc unselectline {} {
3312 global selectedline currentid
3314 catch {unset selectedline}
3315 catch {unset currentid}
3316 allcanvs delete secsel
3319 proc reselectline {} {
3322 if {[info exists selectedline]} {
3323 selectline $selectedline 0
3327 proc addtohistory {cmd} {
3328 global history historyindex curview
3330 set elt [list $curview $cmd]
3331 if {$historyindex > 0
3332 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3336 if {$historyindex < [llength $history]} {
3337 set history [lreplace $history $historyindex end $elt]
3339 lappend history $elt
3342 if {$historyindex > 1} {
3343 .ctop.top.bar.leftbut conf -state normal
3345 .ctop.top.bar.leftbut conf -state disabled
3347 .ctop.top.bar.rightbut conf -state disabled
3353 set view [lindex $elt 0]
3354 set cmd [lindex $elt 1]
3355 if {$curview != $view} {
3362 global history historyindex
3364 if {$historyindex > 1} {
3365 incr historyindex -1
3366 godo [lindex $history [expr {$historyindex - 1}]]
3367 .ctop.top.bar.rightbut conf -state normal
3369 if {$historyindex <= 1} {
3370 .ctop.top.bar.leftbut conf -state disabled
3375 global history historyindex
3377 if {$historyindex < [llength $history]} {
3378 set cmd [lindex $history $historyindex]
3381 .ctop.top.bar.leftbut conf -state normal
3383 if {$historyindex >= [llength $history]} {
3384 .ctop.top.bar.rightbut conf -state disabled
3389 global treefilelist treeidlist diffids diffmergeid treepending
3392 catch {unset diffmergeid}
3393 if {![info exists treefilelist($id)]} {
3394 if {![info exists treepending]} {
3395 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3399 set treefilelist($id) {}
3400 set treeidlist($id) {}
3401 fconfigure $gtf -blocking 0
3402 fileevent $gtf readable [list gettreeline $gtf $id]
3409 proc gettreeline {gtf id} {
3410 global treefilelist treeidlist treepending cmitmode diffids
3412 while {[gets $gtf line] >= 0} {
3413 if {[lindex $line 1] ne "blob"} continue
3414 set sha1 [lindex $line 2]
3415 set fname [lindex $line 3]
3416 lappend treefilelist($id) $fname
3417 lappend treeidlist($id) $sha1
3419 if {![eof $gtf]} return
3422 if {$cmitmode ne "tree"} {
3423 if {![info exists diffmergeid]} {
3424 gettreediffs $diffids
3426 } elseif {$id ne $diffids} {
3434 global treefilelist treeidlist diffids
3435 global ctext commentend
3437 set i [lsearch -exact $treefilelist($diffids) $f]
3439 puts "oops, $f not in list for id $diffids"
3442 set blob [lindex $treeidlist($diffids) $i]
3443 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3444 puts "oops, error reading blob $blob: $err"
3447 fconfigure $bf -blocking 0
3448 fileevent $bf readable [list getblobline $bf $diffids]
3449 $ctext config -state normal
3450 $ctext delete $commentend end
3451 $ctext insert end "\n"
3452 $ctext insert end "$f\n" filesep
3453 $ctext config -state disabled
3454 $ctext yview $commentend
3457 proc getblobline {bf id} {
3458 global diffids cmitmode ctext
3460 if {$id ne $diffids || $cmitmode ne "tree"} {
3464 $ctext config -state normal
3465 while {[gets $bf line] >= 0} {
3466 $ctext insert end "$line\n"
3469 # delete last newline
3470 $ctext delete "end - 2c" "end - 1c"
3473 $ctext config -state disabled
3476 proc mergediff {id l} {
3477 global diffmergeid diffopts mdifffd
3483 # this doesn't seem to actually affect anything...
3484 set env(GIT_DIFF_OPTS) $diffopts
3485 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3486 if {[catch {set mdf [open $cmd r]} err]} {
3487 error_popup "Error getting merge diffs: $err"
3490 fconfigure $mdf -blocking 0
3491 set mdifffd($id) $mdf
3492 set np [llength [lindex $parentlist $l]]
3493 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3494 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3497 proc getmergediffline {mdf id np} {
3498 global diffmergeid ctext cflist nextupdate mergemax
3499 global difffilestart mdifffd
3501 set n [gets $mdf line]
3508 if {![info exists diffmergeid] || $id != $diffmergeid
3509 || $mdf != $mdifffd($id)} {
3512 $ctext conf -state normal
3513 if {[regexp {^diff --cc (.*)} $line match fname]} {
3514 # start of a new file
3515 $ctext insert end "\n"
3516 set here [$ctext index "end - 1c"]
3517 lappend difffilestart $here
3518 add_flist [list $fname]
3519 set l [expr {(78 - [string length $fname]) / 2}]
3520 set pad [string range "----------------------------------------" 1 $l]
3521 $ctext insert end "$pad $fname $pad\n" filesep
3522 } elseif {[regexp {^@@} $line]} {
3523 $ctext insert end "$line\n" hunksep
3524 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3527 # parse the prefix - one ' ', '-' or '+' for each parent
3532 for {set j 0} {$j < $np} {incr j} {
3533 set c [string range $line $j $j]
3536 } elseif {$c == "-"} {
3538 } elseif {$c == "+"} {
3547 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3548 # line doesn't appear in result, parents in $minuses have the line
3549 set num [lindex $minuses 0]
3550 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3551 # line appears in result, parents in $pluses don't have the line
3552 lappend tags mresult
3553 set num [lindex $spaces 0]
3556 if {$num >= $mergemax} {
3561 $ctext insert end "$line\n" $tags
3563 $ctext conf -state disabled
3564 if {[clock clicks -milliseconds] >= $nextupdate} {
3566 fileevent $mdf readable {}
3568 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3572 proc startdiff {ids} {
3573 global treediffs diffids treepending diffmergeid
3576 catch {unset diffmergeid}
3577 if {![info exists treediffs($ids)]} {
3578 if {![info exists treepending]} {
3586 proc addtocflist {ids} {
3587 global treediffs cflist
3588 add_flist $treediffs($ids)
3592 proc gettreediffs {ids} {
3593 global treediff treepending
3594 set treepending $ids
3597 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3599 fconfigure $gdtf -blocking 0
3600 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3603 proc gettreediffline {gdtf ids} {
3604 global treediff treediffs treepending diffids diffmergeid
3607 set n [gets $gdtf line]
3609 if {![eof $gdtf]} return
3611 set treediffs($ids) $treediff
3613 if {$cmitmode eq "tree"} {
3615 } elseif {$ids != $diffids} {
3616 if {![info exists diffmergeid]} {
3617 gettreediffs $diffids
3624 set file [lindex $line 5]
3625 lappend treediff $file
3628 proc getblobdiffs {ids} {
3629 global diffopts blobdifffd diffids env curdifftag curtagstart
3630 global nextupdate diffinhdr treediffs
3632 set env(GIT_DIFF_OPTS) $diffopts
3633 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3634 if {[catch {set bdf [open $cmd r]} err]} {
3635 puts "error getting diffs: $err"
3639 fconfigure $bdf -blocking 0
3640 set blobdifffd($ids) $bdf
3641 set curdifftag Comments
3643 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3644 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3647 proc setinlist {var i val} {
3650 while {[llength [set $var]] < $i} {
3653 if {[llength [set $var]] == $i} {
3660 proc getblobdiffline {bdf ids} {
3661 global diffids blobdifffd ctext curdifftag curtagstart
3662 global diffnexthead diffnextnote difffilestart
3663 global nextupdate diffinhdr treediffs
3665 set n [gets $bdf line]
3669 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3670 $ctext tag add $curdifftag $curtagstart end
3675 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3678 $ctext conf -state normal
3679 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3680 # start of a new file
3681 $ctext insert end "\n"
3682 $ctext tag add $curdifftag $curtagstart end
3683 set here [$ctext index "end - 1c"]
3684 set curtagstart $here
3686 set i [lsearch -exact $treediffs($ids) $fname]
3688 setinlist difffilestart $i $here
3690 if {$newname ne $fname} {
3691 set i [lsearch -exact $treediffs($ids) $newname]
3693 setinlist difffilestart $i $here
3696 set curdifftag "f:$fname"
3697 $ctext tag delete $curdifftag
3698 set l [expr {(78 - [string length $header]) / 2}]
3699 set pad [string range "----------------------------------------" 1 $l]
3700 $ctext insert end "$pad $header $pad\n" filesep
3702 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3704 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3706 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3707 $line match f1l f1c f2l f2c rest]} {
3708 $ctext insert end "$line\n" hunksep
3711 set x [string range $line 0 0]
3712 if {$x == "-" || $x == "+"} {
3713 set tag [expr {$x == "+"}]
3714 $ctext insert end "$line\n" d$tag
3715 } elseif {$x == " "} {
3716 $ctext insert end "$line\n"
3717 } elseif {$diffinhdr || $x == "\\"} {
3718 # e.g. "\ No newline at end of file"
3719 $ctext insert end "$line\n" filesep
3721 # Something else we don't recognize
3722 if {$curdifftag != "Comments"} {
3723 $ctext insert end "\n"
3724 $ctext tag add $curdifftag $curtagstart end
3725 set curtagstart [$ctext index "end - 1c"]
3726 set curdifftag Comments
3728 $ctext insert end "$line\n" filesep
3731 $ctext conf -state disabled
3732 if {[clock clicks -milliseconds] >= $nextupdate} {
3734 fileevent $bdf readable {}
3736 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3741 global difffilestart ctext
3742 set here [$ctext index @0,0]
3743 foreach loc $difffilestart {
3744 if {[$ctext compare $loc > $here]} {
3751 global linespc charspc canvx0 canvy0 mainfont
3752 global xspc1 xspc2 lthickness
3754 set linespc [font metrics $mainfont -linespace]
3755 set charspc [font measure $mainfont "m"]
3756 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3757 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3758 set lthickness [expr {int($linespc / 9) + 1}]
3759 set xspc1(0) $linespc
3767 set ymax [lindex [$canv cget -scrollregion] 3]
3768 if {$ymax eq {} || $ymax == 0} return
3769 set span [$canv yview]
3772 allcanvs yview moveto [lindex $span 0]
3774 if {[info exists selectedline]} {
3775 selectline $selectedline 0
3779 proc incrfont {inc} {
3780 global mainfont textfont ctext canv phase
3781 global stopped entries
3783 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3784 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3786 $ctext conf -font $textfont
3787 $ctext tag conf filesep -font [concat $textfont bold]
3788 foreach e $entries {
3789 $e conf -font $mainfont
3791 if {$phase eq "getcommits"} {
3792 $canv itemconf textitems -font $mainfont
3798 global sha1entry sha1string
3799 if {[string length $sha1string] == 40} {
3800 $sha1entry delete 0 end
3804 proc sha1change {n1 n2 op} {
3805 global sha1string currentid sha1but
3806 if {$sha1string == {}
3807 || ([info exists currentid] && $sha1string == $currentid)} {
3812 if {[$sha1but cget -state] == $state} return
3813 if {$state == "normal"} {
3814 $sha1but conf -state normal -relief raised -text "Goto: "
3816 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3820 proc gotocommit {} {
3821 global sha1string currentid commitrow tagids headids
3822 global displayorder numcommits curview
3824 if {$sha1string == {}
3825 || ([info exists currentid] && $sha1string == $currentid)} return
3826 if {[info exists tagids($sha1string)]} {
3827 set id $tagids($sha1string)
3828 } elseif {[info exists headids($sha1string)]} {
3829 set id $headids($sha1string)
3831 set id [string tolower $sha1string]
3832 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3834 foreach i $displayorder {
3835 if {[string match $id* $i]} {
3839 if {$matches ne {}} {
3840 if {[llength $matches] > 1} {
3841 error_popup "Short SHA1 id $id is ambiguous"
3844 set id [lindex $matches 0]
3848 if {[info exists commitrow($curview,$id)]} {
3849 selectline $commitrow($curview,$id) 1
3852 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3857 error_popup "$type $sha1string is not known"
3860 proc lineenter {x y id} {
3861 global hoverx hovery hoverid hovertimer
3862 global commitinfo canv
3864 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3868 if {[info exists hovertimer]} {
3869 after cancel $hovertimer
3871 set hovertimer [after 500 linehover]
3875 proc linemotion {x y id} {
3876 global hoverx hovery hoverid hovertimer
3878 if {[info exists hoverid] && $id == $hoverid} {
3881 if {[info exists hovertimer]} {
3882 after cancel $hovertimer
3884 set hovertimer [after 500 linehover]
3888 proc lineleave {id} {
3889 global hoverid hovertimer canv
3891 if {[info exists hoverid] && $id == $hoverid} {
3893 if {[info exists hovertimer]} {
3894 after cancel $hovertimer
3902 global hoverx hovery hoverid hovertimer
3903 global canv linespc lthickness
3904 global commitinfo mainfont
3906 set text [lindex $commitinfo($hoverid) 0]
3907 set ymax [lindex [$canv cget -scrollregion] 3]
3908 if {$ymax == {}} return
3909 set yfrac [lindex [$canv yview] 0]
3910 set x [expr {$hoverx + 2 * $linespc}]
3911 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3912 set x0 [expr {$x - 2 * $lthickness}]
3913 set y0 [expr {$y - 2 * $lthickness}]
3914 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3915 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3916 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3917 -fill \#ffff80 -outline black -width 1 -tags hover]
3919 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3923 proc clickisonarrow {id y} {
3926 set ranges [rowranges $id]
3927 set thresh [expr {2 * $lthickness + 6}]
3928 set n [expr {[llength $ranges] - 1}]
3929 for {set i 1} {$i < $n} {incr i} {
3930 set row [lindex $ranges $i]
3931 if {abs([yc $row] - $y) < $thresh} {
3938 proc arrowjump {id n y} {
3941 # 1 <-> 2, 3 <-> 4, etc...
3942 set n [expr {(($n - 1) ^ 1) + 1}]
3943 set row [lindex [rowranges $id] $n]
3945 set ymax [lindex [$canv cget -scrollregion] 3]
3946 if {$ymax eq {} || $ymax <= 0} return
3947 set view [$canv yview]
3948 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3949 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3953 allcanvs yview moveto $yfrac
3956 proc lineclick {x y id isnew} {
3957 global ctext commitinfo children canv thickerline curview
3959 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3964 # draw this line thicker than normal
3968 set ymax [lindex [$canv cget -scrollregion] 3]
3969 if {$ymax eq {}} return
3970 set yfrac [lindex [$canv yview] 0]
3971 set y [expr {$y + $yfrac * $ymax}]
3973 set dirn [clickisonarrow $id $y]
3975 arrowjump $id $dirn $y
3980 addtohistory [list lineclick $x $y $id 0]
3982 # fill the details pane with info about this line
3983 $ctext conf -state normal
3984 $ctext delete 0.0 end
3985 $ctext tag conf link -foreground blue -underline 1
3986 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3987 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3988 $ctext insert end "Parent:\t"
3989 $ctext insert end $id [list link link0]
3990 $ctext tag bind link0 <1> [list selbyid $id]
3991 set info $commitinfo($id)
3992 $ctext insert end "\n\t[lindex $info 0]\n"
3993 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3994 set date [formatdate [lindex $info 2]]
3995 $ctext insert end "\tDate:\t$date\n"
3996 set kids $children($curview,$id)
3998 $ctext insert end "\nChildren:"
4000 foreach child $kids {
4002 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4003 set info $commitinfo($child)
4004 $ctext insert end "\n\t"
4005 $ctext insert end $child [list link link$i]
4006 $ctext tag bind link$i <1> [list selbyid $child]
4007 $ctext insert end "\n\t[lindex $info 0]"
4008 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4009 set date [formatdate [lindex $info 2]]
4010 $ctext insert end "\n\tDate:\t$date\n"
4013 $ctext conf -state disabled
4017 proc normalline {} {
4019 if {[info exists thickerline]} {
4027 global commitrow curview
4028 if {[info exists commitrow($curview,$id)]} {
4029 selectline $commitrow($curview,$id) 1
4035 if {![info exists startmstime]} {
4036 set startmstime [clock clicks -milliseconds]
4038 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4041 proc rowmenu {x y id} {
4042 global rowctxmenu commitrow selectedline rowmenuid curview
4044 if {![info exists selectedline]
4045 || $commitrow($curview,$id) eq $selectedline} {
4050 $rowctxmenu entryconfigure 0 -state $state
4051 $rowctxmenu entryconfigure 1 -state $state
4052 $rowctxmenu entryconfigure 2 -state $state
4054 tk_popup $rowctxmenu $x $y
4057 proc diffvssel {dirn} {
4058 global rowmenuid selectedline displayorder
4060 if {![info exists selectedline]} return
4062 set oldid [lindex $displayorder $selectedline]
4063 set newid $rowmenuid
4065 set oldid $rowmenuid
4066 set newid [lindex $displayorder $selectedline]
4068 addtohistory [list doseldiff $oldid $newid]
4069 doseldiff $oldid $newid
4072 proc doseldiff {oldid newid} {
4076 $ctext conf -state normal
4077 $ctext delete 0.0 end
4079 $ctext insert end "From "
4080 $ctext tag conf link -foreground blue -underline 1
4081 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4082 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4083 $ctext tag bind link0 <1> [list selbyid $oldid]
4084 $ctext insert end $oldid [list link link0]
4085 $ctext insert end "\n "
4086 $ctext insert end [lindex $commitinfo($oldid) 0]
4087 $ctext insert end "\n\nTo "
4088 $ctext tag bind link1 <1> [list selbyid $newid]
4089 $ctext insert end $newid [list link link1]
4090 $ctext insert end "\n "
4091 $ctext insert end [lindex $commitinfo($newid) 0]
4092 $ctext insert end "\n"
4093 $ctext conf -state disabled
4094 $ctext tag delete Comments
4095 $ctext tag remove found 1.0 end
4096 startdiff [list $oldid $newid]
4100 global rowmenuid currentid commitinfo patchtop patchnum
4102 if {![info exists currentid]} return
4103 set oldid $currentid
4104 set oldhead [lindex $commitinfo($oldid) 0]
4105 set newid $rowmenuid
4106 set newhead [lindex $commitinfo($newid) 0]
4109 catch {destroy $top}
4111 label $top.title -text "Generate patch"
4112 grid $top.title - -pady 10
4113 label $top.from -text "From:"
4114 entry $top.fromsha1 -width 40 -relief flat
4115 $top.fromsha1 insert 0 $oldid
4116 $top.fromsha1 conf -state readonly
4117 grid $top.from $top.fromsha1 -sticky w
4118 entry $top.fromhead -width 60 -relief flat
4119 $top.fromhead insert 0 $oldhead
4120 $top.fromhead conf -state readonly
4121 grid x $top.fromhead -sticky w
4122 label $top.to -text "To:"
4123 entry $top.tosha1 -width 40 -relief flat
4124 $top.tosha1 insert 0 $newid
4125 $top.tosha1 conf -state readonly
4126 grid $top.to $top.tosha1 -sticky w
4127 entry $top.tohead -width 60 -relief flat
4128 $top.tohead insert 0 $newhead
4129 $top.tohead conf -state readonly
4130 grid x $top.tohead -sticky w
4131 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4132 grid $top.rev x -pady 10
4133 label $top.flab -text "Output file:"
4134 entry $top.fname -width 60
4135 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4137 grid $top.flab $top.fname -sticky w
4139 button $top.buts.gen -text "Generate" -command mkpatchgo
4140 button $top.buts.can -text "Cancel" -command mkpatchcan
4141 grid $top.buts.gen $top.buts.can
4142 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4143 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4144 grid $top.buts - -pady 10 -sticky ew
4148 proc mkpatchrev {} {
4151 set oldid [$patchtop.fromsha1 get]
4152 set oldhead [$patchtop.fromhead get]
4153 set newid [$patchtop.tosha1 get]
4154 set newhead [$patchtop.tohead get]
4155 foreach e [list fromsha1 fromhead tosha1 tohead] \
4156 v [list $newid $newhead $oldid $oldhead] {
4157 $patchtop.$e conf -state normal
4158 $patchtop.$e delete 0 end
4159 $patchtop.$e insert 0 $v
4160 $patchtop.$e conf -state readonly
4167 set oldid [$patchtop.fromsha1 get]
4168 set newid [$patchtop.tosha1 get]
4169 set fname [$patchtop.fname get]
4170 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4171 error_popup "Error creating patch: $err"
4173 catch {destroy $patchtop}
4177 proc mkpatchcan {} {
4180 catch {destroy $patchtop}
4185 global rowmenuid mktagtop commitinfo
4189 catch {destroy $top}
4191 label $top.title -text "Create tag"
4192 grid $top.title - -pady 10
4193 label $top.id -text "ID:"
4194 entry $top.sha1 -width 40 -relief flat
4195 $top.sha1 insert 0 $rowmenuid
4196 $top.sha1 conf -state readonly
4197 grid $top.id $top.sha1 -sticky w
4198 entry $top.head -width 60 -relief flat
4199 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4200 $top.head conf -state readonly
4201 grid x $top.head -sticky w
4202 label $top.tlab -text "Tag name:"
4203 entry $top.tag -width 60
4204 grid $top.tlab $top.tag -sticky w
4206 button $top.buts.gen -text "Create" -command mktaggo
4207 button $top.buts.can -text "Cancel" -command mktagcan
4208 grid $top.buts.gen $top.buts.can
4209 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4210 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4211 grid $top.buts - -pady 10 -sticky ew
4216 global mktagtop env tagids idtags
4218 set id [$mktagtop.sha1 get]
4219 set tag [$mktagtop.tag get]
4221 error_popup "No tag name specified"
4224 if {[info exists tagids($tag)]} {
4225 error_popup "Tag \"$tag\" already exists"
4230 set fname [file join $dir "refs/tags" $tag]
4231 set f [open $fname w]
4235 error_popup "Error creating tag: $err"
4239 set tagids($tag) $id
4240 lappend idtags($id) $tag
4244 proc redrawtags {id} {
4245 global canv linehtag commitrow idpos selectedline curview
4247 if {![info exists commitrow($curview,$id)]} return
4248 drawcmitrow $commitrow($curview,$id)
4249 $canv delete tag.$id
4250 set xt [eval drawtags $id $idpos($id)]
4251 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4252 if {[info exists selectedline]
4253 && $selectedline == $commitrow($curview,$id)} {
4254 selectline $selectedline 0
4261 catch {destroy $mktagtop}
4270 proc writecommit {} {
4271 global rowmenuid wrcomtop commitinfo wrcomcmd
4273 set top .writecommit
4275 catch {destroy $top}
4277 label $top.title -text "Write commit to file"
4278 grid $top.title - -pady 10
4279 label $top.id -text "ID:"
4280 entry $top.sha1 -width 40 -relief flat
4281 $top.sha1 insert 0 $rowmenuid
4282 $top.sha1 conf -state readonly
4283 grid $top.id $top.sha1 -sticky w
4284 entry $top.head -width 60 -relief flat
4285 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4286 $top.head conf -state readonly
4287 grid x $top.head -sticky w
4288 label $top.clab -text "Command:"
4289 entry $top.cmd -width 60 -textvariable wrcomcmd
4290 grid $top.clab $top.cmd -sticky w -pady 10
4291 label $top.flab -text "Output file:"
4292 entry $top.fname -width 60
4293 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4294 grid $top.flab $top.fname -sticky w
4296 button $top.buts.gen -text "Write" -command wrcomgo
4297 button $top.buts.can -text "Cancel" -command wrcomcan
4298 grid $top.buts.gen $top.buts.can
4299 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4300 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4301 grid $top.buts - -pady 10 -sticky ew
4308 set id [$wrcomtop.sha1 get]
4309 set cmd "echo $id | [$wrcomtop.cmd get]"
4310 set fname [$wrcomtop.fname get]
4311 if {[catch {exec sh -c $cmd >$fname &} err]} {
4312 error_popup "Error writing commit: $err"
4314 catch {destroy $wrcomtop}
4321 catch {destroy $wrcomtop}
4325 proc listrefs {id} {
4326 global idtags idheads idotherrefs
4329 if {[info exists idtags($id)]} {
4333 if {[info exists idheads($id)]} {
4337 if {[info exists idotherrefs($id)]} {
4338 set z $idotherrefs($id)
4340 return [list $x $y $z]
4343 proc rereadrefs {} {
4344 global idtags idheads idotherrefs
4346 set refids [concat [array names idtags] \
4347 [array names idheads] [array names idotherrefs]]
4348 foreach id $refids {
4349 if {![info exists ref($id)]} {
4350 set ref($id) [listrefs $id]
4354 set refids [lsort -unique [concat $refids [array names idtags] \
4355 [array names idheads] [array names idotherrefs]]]
4356 foreach id $refids {
4357 set v [listrefs $id]
4358 if {![info exists ref($id)] || $ref($id) != $v} {
4364 proc showtag {tag isnew} {
4365 global ctext tagcontents tagids linknum
4368 addtohistory [list showtag $tag 0]
4370 $ctext conf -state normal
4371 $ctext delete 0.0 end
4373 if {[info exists tagcontents($tag)]} {
4374 set text $tagcontents($tag)
4376 set text "Tag: $tag\nId: $tagids($tag)"
4378 appendwithlinks $text
4379 $ctext conf -state disabled
4390 global maxwidth maxgraphpct diffopts findmergefiles
4391 global oldprefs prefstop
4395 if {[winfo exists $top]} {
4399 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4400 set oldprefs($v) [set $v]
4403 wm title $top "Gitk preferences"
4404 label $top.ldisp -text "Commit list display options"
4405 grid $top.ldisp - -sticky w -pady 10
4406 label $top.spacer -text " "
4407 label $top.maxwidthl -text "Maximum graph width (lines)" \
4409 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4410 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4411 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4413 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4414 grid x $top.maxpctl $top.maxpct -sticky w
4415 checkbutton $top.findm -variable findmergefiles
4416 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4418 grid $top.findm $top.findml - -sticky w
4419 label $top.ddisp -text "Diff display options"
4420 grid $top.ddisp - -sticky w -pady 10
4421 label $top.diffoptl -text "Options for diff program" \
4423 entry $top.diffopt -width 20 -textvariable diffopts
4424 grid x $top.diffoptl $top.diffopt -sticky w
4426 button $top.buts.ok -text "OK" -command prefsok
4427 button $top.buts.can -text "Cancel" -command prefscan
4428 grid $top.buts.ok $top.buts.can
4429 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4430 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4431 grid $top.buts - - -pady 10 -sticky ew
4435 global maxwidth maxgraphpct diffopts findmergefiles
4436 global oldprefs prefstop
4438 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4439 set $v $oldprefs($v)
4441 catch {destroy $prefstop}
4446 global maxwidth maxgraphpct
4447 global oldprefs prefstop
4449 catch {destroy $prefstop}
4451 if {$maxwidth != $oldprefs(maxwidth)
4452 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4457 proc formatdate {d} {
4458 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4461 # This list of encoding names and aliases is distilled from
4462 # http://www.iana.org/assignments/character-sets.
4463 # Not all of them are supported by Tcl.
4464 set encoding_aliases {
4465 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4466 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4467 { ISO-10646-UTF-1 csISO10646UTF1 }
4468 { ISO_646.basic:1983 ref csISO646basic1983 }
4469 { INVARIANT csINVARIANT }
4470 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4471 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4472 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4473 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4474 { NATS-DANO iso-ir-9-1 csNATSDANO }
4475 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4476 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4477 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4478 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4479 { ISO-2022-KR csISO2022KR }
4481 { ISO-2022-JP csISO2022JP }
4482 { ISO-2022-JP-2 csISO2022JP2 }
4483 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4485 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4486 { IT iso-ir-15 ISO646-IT csISO15Italian }
4487 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4488 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4489 { greek7-old iso-ir-18 csISO18Greek7Old }
4490 { latin-greek iso-ir-19 csISO19LatinGreek }
4491 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4492 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4493 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4494 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4495 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4496 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4497 { INIS iso-ir-49 csISO49INIS }
4498 { INIS-8 iso-ir-50 csISO50INIS8 }
4499 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4500 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4501 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4502 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4503 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4504 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4506 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4507 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4508 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4509 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4510 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4511 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4512 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4513 { greek7 iso-ir-88 csISO88Greek7 }
4514 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4515 { iso-ir-90 csISO90 }
4516 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4517 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4518 csISO92JISC62991984b }
4519 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4520 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4521 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4522 csISO95JIS62291984handadd }
4523 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4524 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4525 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4526 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4528 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4529 { T.61-7bit iso-ir-102 csISO102T617bit }
4530 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4531 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4532 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4533 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4534 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4535 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4536 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4537 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4538 arabic csISOLatinArabic }
4539 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4540 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4541 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4542 greek greek8 csISOLatinGreek }
4543 { T.101-G2 iso-ir-128 csISO128T101G2 }
4544 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4546 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4547 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4548 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4549 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4550 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4551 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4552 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4553 csISOLatinCyrillic }
4554 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4555 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4556 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4557 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4558 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4559 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4560 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4561 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4562 { ISO_10367-box iso-ir-155 csISO10367Box }
4563 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4564 { latin-lap lap iso-ir-158 csISO158Lap }
4565 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4566 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4569 { JIS_X0201 X0201 csHalfWidthKatakana }
4570 { KSC5636 ISO646-KR csKSC5636 }
4571 { ISO-10646-UCS-2 csUnicode }
4572 { ISO-10646-UCS-4 csUCS4 }
4573 { DEC-MCS dec csDECMCS }
4574 { hp-roman8 roman8 r8 csHPRoman8 }
4575 { macintosh mac csMacintosh }
4576 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4578 { IBM038 EBCDIC-INT cp038 csIBM038 }
4579 { IBM273 CP273 csIBM273 }
4580 { IBM274 EBCDIC-BE CP274 csIBM274 }
4581 { IBM275 EBCDIC-BR cp275 csIBM275 }
4582 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4583 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4584 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4585 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4586 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4587 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4588 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4589 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4590 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4591 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4592 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4593 { IBM437 cp437 437 csPC8CodePage437 }
4594 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4595 { IBM775 cp775 csPC775Baltic }
4596 { IBM850 cp850 850 csPC850Multilingual }
4597 { IBM851 cp851 851 csIBM851 }
4598 { IBM852 cp852 852 csPCp852 }
4599 { IBM855 cp855 855 csIBM855 }
4600 { IBM857 cp857 857 csIBM857 }
4601 { IBM860 cp860 860 csIBM860 }
4602 { IBM861 cp861 861 cp-is csIBM861 }
4603 { IBM862 cp862 862 csPC862LatinHebrew }
4604 { IBM863 cp863 863 csIBM863 }
4605 { IBM864 cp864 csIBM864 }
4606 { IBM865 cp865 865 csIBM865 }
4607 { IBM866 cp866 866 csIBM866 }
4608 { IBM868 CP868 cp-ar csIBM868 }
4609 { IBM869 cp869 869 cp-gr csIBM869 }
4610 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4611 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4612 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4613 { IBM891 cp891 csIBM891 }
4614 { IBM903 cp903 csIBM903 }
4615 { IBM904 cp904 904 csIBBM904 }
4616 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4617 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4618 { IBM1026 CP1026 csIBM1026 }
4619 { EBCDIC-AT-DE csIBMEBCDICATDE }
4620 { EBCDIC-AT-DE-A csEBCDICATDEA }
4621 { EBCDIC-CA-FR csEBCDICCAFR }
4622 { EBCDIC-DK-NO csEBCDICDKNO }
4623 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4624 { EBCDIC-FI-SE csEBCDICFISE }
4625 { EBCDIC-FI-SE-A csEBCDICFISEA }
4626 { EBCDIC-FR csEBCDICFR }
4627 { EBCDIC-IT csEBCDICIT }
4628 { EBCDIC-PT csEBCDICPT }
4629 { EBCDIC-ES csEBCDICES }
4630 { EBCDIC-ES-A csEBCDICESA }
4631 { EBCDIC-ES-S csEBCDICESS }
4632 { EBCDIC-UK csEBCDICUK }
4633 { EBCDIC-US csEBCDICUS }
4634 { UNKNOWN-8BIT csUnknown8BiT }
4635 { MNEMONIC csMnemonic }
4640 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4641 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4642 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4643 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4644 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4645 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4646 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4647 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4648 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4649 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4650 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4651 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4652 { IBM1047 IBM-1047 }
4653 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4654 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4655 { UNICODE-1-1 csUnicode11 }
4658 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4659 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4661 { ISO-8859-15 ISO_8859-15 Latin-9 }
4662 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4663 { GBK CP936 MS936 windows-936 }
4664 { JIS_Encoding csJISEncoding }
4665 { Shift_JIS MS_Kanji csShiftJIS }
4666 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4668 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4669 { ISO-10646-UCS-Basic csUnicodeASCII }
4670 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4671 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4672 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4673 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4674 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4675 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4676 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4677 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4678 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4679 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4680 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4681 { Ventura-US csVenturaUS }
4682 { Ventura-International csVenturaInternational }
4683 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4684 { PC8-Turkish csPC8Turkish }
4685 { IBM-Symbols csIBMSymbols }
4686 { IBM-Thai csIBMThai }
4687 { HP-Legal csHPLegal }
4688 { HP-Pi-font csHPPiFont }
4689 { HP-Math8 csHPMath8 }
4690 { Adobe-Symbol-Encoding csHPPSMath }
4691 { HP-DeskTop csHPDesktop }
4692 { Ventura-Math csVenturaMath }
4693 { Microsoft-Publishing csMicrosoftPublishing }
4694 { Windows-31J csWindows31J }
4699 proc tcl_encoding {enc} {
4700 global encoding_aliases
4701 set names [encoding names]
4702 set lcnames [string tolower $names]
4703 set enc [string tolower $enc]
4704 set i [lsearch -exact $lcnames $enc]
4706 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4707 if {[regsub {^iso[-_]} $enc iso encx]} {
4708 set i [lsearch -exact $lcnames $encx]
4712 foreach l $encoding_aliases {
4713 set ll [string tolower $l]
4714 if {[lsearch -exact $ll $enc] < 0} continue
4715 # look through the aliases for one that tcl knows about
4717 set i [lsearch -exact $lcnames $e]
4719 if {[regsub {^iso[-_]} $e iso ex]} {
4720 set i [lsearch -exact $lcnames $ex]
4729 return [lindex $names $i]
4736 set diffopts "-U 5 -p"
4737 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4741 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4743 if {$gitencoding == ""} {
4744 set gitencoding "utf-8"
4746 set tclencoding [tcl_encoding $gitencoding]
4747 if {$tclencoding == {}} {
4748 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4751 set mainfont {Helvetica 9}
4752 set textfont {Courier 9}
4753 set uifont {Helvetica 9 bold}
4754 set findmergefiles 0
4762 set flistmode "flat"
4763 set cmitmode "patch"
4765 set colors {green red blue magenta darkgrey brown orange}
4767 catch {source ~/.gitk}
4769 font create optionfont -family sans-serif -size -12
4773 switch -regexp -- $arg {
4775 "^-d" { set datemode 1 }
4777 lappend revtreeargs $arg
4782 # check that we can find a .git directory somewhere...
4784 if {![file isdirectory $gitdir]} {
4785 error_popup "Cannot find the git directory \"$gitdir\"."
4797 set selectedhlview {}
4808 set cmdline_files {}
4810 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4811 set cmdline_files [split $fileargs "\n"]
4812 set n [llength $cmdline_files]
4813 set revtreeargs [lrange $revtreeargs 0 end-$n]
4815 if {[lindex $revtreeargs end] eq "--"} {
4816 set revtreeargs [lrange $revtreeargs 0 end-1]
4819 if {$cmdline_files ne {}} {
4820 # create a view for the files/dirs specified on the command line
4824 set viewname(1) "Command line"
4825 set viewfiles(1) $cmdline_files
4828 .bar.view entryconf 1 -state normal
4829 .bar.view entryconf 2 -state normal
4832 if {[info exists permviews]} {
4833 foreach v $permviews {
4836 set viewname($n) [lindex $v 0]
4837 set viewfiles($n) [lindex $v 1]