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 {} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global revtreeargs curview viewfiles
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
29 if {$viewfiles($curview) ne {}} {
30 set args [concat $args "--" $viewfiles($curview)]
32 set order "--topo-order"
34 set order "--date-order"
37 set commfd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
40 puts stderr "Error executing git-rev-list: $err"
44 fconfigure $commfd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $commfd -encoding $tclencoding
48 fileevent $commfd readable [list getcommitlines $commfd]
49 . config -cursor watch
53 proc stop_rev_list {} {
56 if {![info exists commfd]} return
66 global phase canv mainfont
71 $canv create text 3 3 -anchor nw -text "Reading commits..." \
72 -font $mainfont -tags textitems
75 proc getcommitlines {commfd} {
76 global commitlisted nextupdate
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children
81 set stuff [read $commfd]
83 if {![eof $commfd]} return
84 # set it blocking so we wait for the process to terminate
85 fconfigure $commfd -blocking 1
86 if {![catch {close $commfd} err]} {
87 after idle finishcommits
90 if {[string range $err 0 4] == "usage"} {
92 "Gitk: error reading commits: bad arguments to git-rev-list.\
93 (Note: arguments to gitk are passed to git-rev-list\
94 to allow selection of commits to be displayed.)"
96 set err "Error reading commits: $err"
104 set i [string first "\0" $stuff $start]
106 append leftover [string range $stuff $start end]
111 append cmit [string range $stuff 0 [expr {$i - 1}]]
114 set cmit [string range $stuff $start [expr {$i - 1}]]
116 set start [expr {$i + 1}]
117 set j [string first "\n" $cmit]
121 set ids [string range $cmit 0 [expr {$j - 1}]]
122 if {[string range $ids 0 0] == "-"} {
124 set ids [string range $ids 1 end]
128 if {[string length $id] != 40} {
136 if {[string length $shortcmit] > 80} {
137 set shortcmit "[string range $shortcmit 0 80]..."
139 error_popup "Can't parse git-rev-list output: {$shortcmit}"
142 set id [lindex $ids 0]
144 set olds [lrange $ids 1 end]
147 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
148 lappend children($p) $id
155 lappend parentlist $olds
156 if {[info exists children($id)]} {
157 lappend childlist $children($id)
162 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
163 set commitrow($id) $commitidx
165 lappend displayorder $id
166 lappend commitlisted $listed
172 if {[clock clicks -milliseconds] >= $nextupdate} {
177 proc doupdate {reading} {
178 global commfd nextupdate numcommits ncmupdate
181 fileevent $commfd readable {}
184 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
185 if {$numcommits < 100} {
186 set ncmupdate [expr {$numcommits + 1}]
187 } elseif {$numcommits < 10000} {
188 set ncmupdate [expr {$numcommits + 10}]
190 set ncmupdate [expr {$numcommits + 100}]
193 fileevent $commfd readable [list getcommitlines $commfd]
197 proc readcommit {id} {
198 if {[catch {set contents [exec git-cat-file commit $id]}]} return
199 parsecommit $id $contents 0
202 proc updatecommits {} {
203 global viewdata curview revtreeargs phase
211 catch {unset viewdata($n)}
216 proc parsecommit {id contents listed} {
217 global commitinfo cdate
226 set hdrend [string first "\n\n" $contents]
228 # should never happen...
229 set hdrend [string length $contents]
231 set header [string range $contents 0 [expr {$hdrend - 1}]]
232 set comment [string range $contents [expr {$hdrend + 2}] end]
233 foreach line [split $header "\n"] {
234 set tag [lindex $line 0]
235 if {$tag == "author"} {
236 set audate [lindex $line end-1]
237 set auname [lrange $line 1 end-2]
238 } elseif {$tag == "committer"} {
239 set comdate [lindex $line end-1]
240 set comname [lrange $line 1 end-2]
244 # take the first line of the comment as the headline
245 set i [string first "\n" $comment]
247 set headline [string trim [string range $comment 0 $i]]
249 set headline $comment
252 # git-rev-list indents the comment by 4 spaces;
253 # if we got this via git-cat-file, add the indentation
255 foreach line [split $comment "\n"] {
256 append newcomment " "
257 append newcomment $line
258 append newcomment "\n"
260 set comment $newcomment
262 if {$comdate != {}} {
263 set cdate($id) $comdate
265 set commitinfo($id) [list $headline $auname $audate \
266 $comname $comdate $comment]
269 proc getcommit {id} {
270 global commitdata commitinfo
272 if {[info exists commitdata($id)]} {
273 parsecommit $id $commitdata($id) 1
276 if {![info exists commitinfo($id)]} {
277 set commitinfo($id) {"No commit information available"}
284 global tagids idtags headids idheads tagcontents
285 global otherrefids idotherrefs
287 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
290 set refd [open [list | git ls-remote [gitdir]] r]
291 while {0 <= [set n [gets $refd line]]} {
292 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
296 if {[regexp {^remotes/.*/HEAD$} $path match]} {
299 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
303 if {[regexp {^remotes/} $path match]} {
306 if {$type == "tags"} {
307 set tagids($name) $id
308 lappend idtags($id) $name
313 set commit [exec git-rev-parse "$id^0"]
314 if {"$commit" != "$id"} {
315 set tagids($name) $commit
316 lappend idtags($commit) $name
320 set tagcontents($name) [exec git-cat-file tag "$id"]
322 } elseif { $type == "heads" } {
323 set headids($name) $id
324 lappend idheads($id) $name
326 set otherrefids($name) $id
327 lappend idotherrefs($id) $name
333 proc error_popup msg {
337 message $w.m -text $msg -justify center -aspect 400
338 pack $w.m -side top -fill x -padx 20 -pady 20
339 button $w.ok -text OK -command "destroy $w"
340 pack $w.ok -side bottom -fill x
341 bind $w <Visibility> "grab $w; focus $w"
342 bind $w <Key-Return> "destroy $w"
347 global canv canv2 canv3 linespc charspc ctext cflist
348 global textfont mainfont uifont
349 global findtype findtypemenu findloc findstring fstring geometry
350 global entries sha1entry sha1string sha1but
351 global maincursor textcursor curtextcursor
352 global rowctxmenu mergemax
355 .bar add cascade -label "File" -menu .bar.file
356 .bar configure -font $uifont
358 .bar.file add command -label "Update" -command updatecommits
359 .bar.file add command -label "Reread references" -command rereadrefs
360 .bar.file add command -label "Quit" -command doquit
361 .bar.file configure -font $uifont
363 .bar add cascade -label "Edit" -menu .bar.edit
364 .bar.edit add command -label "Preferences" -command doprefs
365 .bar.edit configure -font $uifont
366 menu .bar.view -font $uifont
367 .bar add cascade -label "View" -menu .bar.view
368 .bar.view add command -label "New view..." -command newview
369 .bar.view add command -label "Edit view..." -command editview
370 .bar.view add command -label "Delete view" -command delview -state disabled
371 .bar.view add separator
372 .bar.view add radiobutton -label "All files" -command {showview 0} \
373 -variable selectedview -value 0
375 .bar add cascade -label "Help" -menu .bar.help
376 .bar.help add command -label "About gitk" -command about
377 .bar.help add command -label "Key bindings" -command keys
378 .bar.help configure -font $uifont
379 . configure -menu .bar
381 if {![info exists geometry(canv1)]} {
382 set geometry(canv1) [expr {45 * $charspc}]
383 set geometry(canv2) [expr {30 * $charspc}]
384 set geometry(canv3) [expr {15 * $charspc}]
385 set geometry(canvh) [expr {25 * $linespc + 4}]
386 set geometry(ctextw) 80
387 set geometry(ctexth) 30
388 set geometry(cflistw) 30
390 panedwindow .ctop -orient vertical
391 if {[info exists geometry(width)]} {
392 .ctop conf -width $geometry(width) -height $geometry(height)
393 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
394 set geometry(ctexth) [expr {($texth - 8) /
395 [font metrics $textfont -linespace]}]
399 pack .ctop.top.bar -side bottom -fill x
400 set cscroll .ctop.top.csb
401 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
402 pack $cscroll -side right -fill y
403 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
404 pack .ctop.top.clist -side top -fill both -expand 1
406 set canv .ctop.top.clist.canv
407 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
409 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
410 .ctop.top.clist add $canv
411 set canv2 .ctop.top.clist.canv2
412 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
413 -bg white -bd 0 -yscrollincr $linespc
414 .ctop.top.clist add $canv2
415 set canv3 .ctop.top.clist.canv3
416 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
417 -bg white -bd 0 -yscrollincr $linespc
418 .ctop.top.clist add $canv3
419 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
421 set sha1entry .ctop.top.bar.sha1
422 set entries $sha1entry
423 set sha1but .ctop.top.bar.sha1label
424 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
425 -command gotocommit -width 8 -font $uifont
426 $sha1but conf -disabledforeground [$sha1but cget -foreground]
427 pack .ctop.top.bar.sha1label -side left
428 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
429 trace add variable sha1string write sha1change
430 pack $sha1entry -side left -pady 2
432 image create bitmap bm-left -data {
433 #define left_width 16
434 #define left_height 16
435 static unsigned char left_bits[] = {
436 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
437 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
438 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
440 image create bitmap bm-right -data {
441 #define right_width 16
442 #define right_height 16
443 static unsigned char right_bits[] = {
444 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
445 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
446 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
448 button .ctop.top.bar.leftbut -image bm-left -command goback \
449 -state disabled -width 26
450 pack .ctop.top.bar.leftbut -side left -fill y
451 button .ctop.top.bar.rightbut -image bm-right -command goforw \
452 -state disabled -width 26
453 pack .ctop.top.bar.rightbut -side left -fill y
455 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
456 pack .ctop.top.bar.findbut -side left
458 set fstring .ctop.top.bar.findstring
459 lappend entries $fstring
460 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
461 pack $fstring -side left -expand 1 -fill x
463 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
464 findtype Exact IgnCase Regexp]
465 .ctop.top.bar.findtype configure -font $uifont
466 .ctop.top.bar.findtype.menu configure -font $uifont
467 set findloc "All fields"
468 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
469 Comments Author Committer Files Pickaxe
470 .ctop.top.bar.findloc configure -font $uifont
471 .ctop.top.bar.findloc.menu configure -font $uifont
473 pack .ctop.top.bar.findloc -side right
474 pack .ctop.top.bar.findtype -side right
475 # for making sure type==Exact whenever loc==Pickaxe
476 trace add variable findloc write findlocchange
478 panedwindow .ctop.cdet -orient horizontal
480 frame .ctop.cdet.left
481 set ctext .ctop.cdet.left.ctext
482 text $ctext -bg white -state disabled -font $textfont \
483 -width $geometry(ctextw) -height $geometry(ctexth) \
484 -yscrollcommand scrolltext -wrap none
485 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
486 pack .ctop.cdet.left.sb -side right -fill y
487 pack $ctext -side left -fill both -expand 1
488 .ctop.cdet add .ctop.cdet.left
490 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
491 $ctext tag conf hunksep -fore blue
492 $ctext tag conf d0 -fore red
493 $ctext tag conf d1 -fore "#00a000"
494 $ctext tag conf m0 -fore red
495 $ctext tag conf m1 -fore blue
496 $ctext tag conf m2 -fore green
497 $ctext tag conf m3 -fore purple
498 $ctext tag conf m4 -fore brown
499 $ctext tag conf m5 -fore "#009090"
500 $ctext tag conf m6 -fore magenta
501 $ctext tag conf m7 -fore "#808000"
502 $ctext tag conf m8 -fore "#009000"
503 $ctext tag conf m9 -fore "#ff0080"
504 $ctext tag conf m10 -fore cyan
505 $ctext tag conf m11 -fore "#b07070"
506 $ctext tag conf m12 -fore "#70b0f0"
507 $ctext tag conf m13 -fore "#70f0b0"
508 $ctext tag conf m14 -fore "#f0b070"
509 $ctext tag conf m15 -fore "#ff70b0"
510 $ctext tag conf mmax -fore darkgrey
512 $ctext tag conf mresult -font [concat $textfont bold]
513 $ctext tag conf msep -font [concat $textfont bold]
514 $ctext tag conf found -back yellow
516 frame .ctop.cdet.right
517 frame .ctop.cdet.right.mode
518 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
519 -command reselectline -variable cmitmode -value "patch"
520 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
521 -command reselectline -variable cmitmode -value "tree"
522 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
523 pack .ctop.cdet.right.mode -side top -fill x
524 set cflist .ctop.cdet.right.cfiles
525 set indent [font measure $mainfont "nn"]
526 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
527 -tabs [list $indent [expr {2 * $indent}]] \
528 -yscrollcommand ".ctop.cdet.right.sb set" \
529 -cursor [. cget -cursor] \
530 -spacing1 1 -spacing3 1
531 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
532 pack .ctop.cdet.right.sb -side right -fill y
533 pack $cflist -side left -fill both -expand 1
534 $cflist tag configure highlight -background yellow
535 .ctop.cdet add .ctop.cdet.right
536 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
538 pack .ctop -side top -fill both -expand 1
540 bindall <1> {selcanvline %W %x %y}
541 #bindall <B1-Motion> {selcanvline %W %x %y}
542 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
543 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
544 bindall <2> "canvscan mark %W %x %y"
545 bindall <B2-Motion> "canvscan dragto %W %x %y"
546 bindkey <Home> selfirstline
547 bindkey <End> sellastline
548 bind . <Key-Up> "selnextline -1"
549 bind . <Key-Down> "selnextline 1"
550 bindkey <Key-Right> "goforw"
551 bindkey <Key-Left> "goback"
552 bind . <Key-Prior> "selnextpage -1"
553 bind . <Key-Next> "selnextpage 1"
554 bind . <Control-Home> "allcanvs yview moveto 0.0"
555 bind . <Control-End> "allcanvs yview moveto 1.0"
556 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
557 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
558 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
559 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
560 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
561 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
562 bindkey <Key-space> "$ctext yview scroll 1 pages"
563 bindkey p "selnextline -1"
564 bindkey n "selnextline 1"
567 bindkey i "selnextline -1"
568 bindkey k "selnextline 1"
571 bindkey b "$ctext yview scroll -1 pages"
572 bindkey d "$ctext yview scroll 18 units"
573 bindkey u "$ctext yview scroll -18 units"
574 bindkey / {findnext 1}
575 bindkey <Key-Return> {findnext 0}
578 bind . <Control-q> doquit
579 bind . <Control-f> dofind
580 bind . <Control-g> {findnext 0}
581 bind . <Control-r> findprev
582 bind . <Control-equal> {incrfont 1}
583 bind . <Control-KP_Add> {incrfont 1}
584 bind . <Control-minus> {incrfont -1}
585 bind . <Control-KP_Subtract> {incrfont -1}
586 bind . <Destroy> {savestuff %W}
587 bind . <Button-1> "click %W"
588 bind $fstring <Key-Return> dofind
589 bind $sha1entry <Key-Return> gotocommit
590 bind $sha1entry <<PasteSelection>> clearsha1
591 bind $cflist <1> {sel_flist %W %x %y; break}
592 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
593 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
595 set maincursor [. cget -cursor]
596 set textcursor [$ctext cget -cursor]
597 set curtextcursor $textcursor
599 set rowctxmenu .rowctxmenu
600 menu $rowctxmenu -tearoff 0
601 $rowctxmenu add command -label "Diff this -> selected" \
602 -command {diffvssel 0}
603 $rowctxmenu add command -label "Diff selected -> this" \
604 -command {diffvssel 1}
605 $rowctxmenu add command -label "Make patch" -command mkpatch
606 $rowctxmenu add command -label "Create tag" -command mktag
607 $rowctxmenu add command -label "Write commit to file" -command writecommit
610 # mouse-2 makes all windows scan vertically, but only the one
611 # the cursor is in scans horizontally
612 proc canvscan {op w x y} {
613 global canv canv2 canv3
614 foreach c [list $canv $canv2 $canv3] {
623 proc scrollcanv {cscroll f0 f1} {
628 # when we make a key binding for the toplevel, make sure
629 # it doesn't get triggered when that key is pressed in the
630 # find string entry widget.
631 proc bindkey {ev script} {
634 set escript [bind Entry $ev]
635 if {$escript == {}} {
636 set escript [bind Entry <Key>]
639 bind $e $ev "$escript; break"
643 # set the focus back to the toplevel for any click outside
654 global canv canv2 canv3 ctext cflist mainfont textfont uifont
655 global stuffsaved findmergefiles maxgraphpct
657 global viewname viewfiles viewperm nextviewnum
660 if {$stuffsaved} return
661 if {![winfo viewable .]} return
663 set f [open "~/.gitk-new" w]
664 puts $f [list set mainfont $mainfont]
665 puts $f [list set textfont $textfont]
666 puts $f [list set uifont $uifont]
667 puts $f [list set findmergefiles $findmergefiles]
668 puts $f [list set maxgraphpct $maxgraphpct]
669 puts $f [list set maxwidth $maxwidth]
670 puts $f [list set cmitmode $cmitmode]
671 puts $f "set geometry(width) [winfo width .ctop]"
672 puts $f "set geometry(height) [winfo height .ctop]"
673 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
674 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
675 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
676 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
677 set wid [expr {([winfo width $ctext] - 8) \
678 / [font measure $textfont "0"]}]
679 puts $f "set geometry(ctextw) $wid"
680 set wid [expr {([winfo width $cflist] - 11) \
681 / [font measure [$cflist cget -font] "0"]}]
682 puts $f "set geometry(cflistw) $wid"
683 puts -nonewline $f "set permviews {"
684 for {set v 0} {$v < $nextviewnum} {incr v} {
686 puts $f "{[list $viewname($v) $viewfiles($v)]}"
691 file rename -force "~/.gitk-new" "~/.gitk"
696 proc resizeclistpanes {win w} {
698 if {[info exists oldwidth($win)]} {
699 set s0 [$win sash coord 0]
700 set s1 [$win sash coord 1]
702 set sash0 [expr {int($w/2 - 2)}]
703 set sash1 [expr {int($w*5/6 - 2)}]
705 set factor [expr {1.0 * $w / $oldwidth($win)}]
706 set sash0 [expr {int($factor * [lindex $s0 0])}]
707 set sash1 [expr {int($factor * [lindex $s1 0])}]
711 if {$sash1 < $sash0 + 20} {
712 set sash1 [expr {$sash0 + 20}]
714 if {$sash1 > $w - 10} {
715 set sash1 [expr {$w - 10}]
716 if {$sash0 > $sash1 - 20} {
717 set sash0 [expr {$sash1 - 20}]
721 $win sash place 0 $sash0 [lindex $s0 1]
722 $win sash place 1 $sash1 [lindex $s1 1]
724 set oldwidth($win) $w
727 proc resizecdetpanes {win w} {
729 if {[info exists oldwidth($win)]} {
730 set s0 [$win sash coord 0]
732 set sash0 [expr {int($w*3/4 - 2)}]
734 set factor [expr {1.0 * $w / $oldwidth($win)}]
735 set sash0 [expr {int($factor * [lindex $s0 0])}]
739 if {$sash0 > $w - 15} {
740 set sash0 [expr {$w - 15}]
743 $win sash place 0 $sash0 [lindex $s0 1]
745 set oldwidth($win) $w
749 global canv canv2 canv3
755 proc bindall {event action} {
756 global canv canv2 canv3
757 bind $canv $event $action
758 bind $canv2 $event $action
759 bind $canv3 $event $action
764 if {[winfo exists $w]} {
769 wm title $w "About gitk"
771 Gitk - a commit viewer for git
773 Copyright © 2005-2006 Paul Mackerras
775 Use and redistribute under the terms of the GNU General Public License} \
776 -justify center -aspect 400
777 pack $w.m -side top -fill x -padx 20 -pady 20
778 button $w.ok -text Close -command "destroy $w"
779 pack $w.ok -side bottom
784 if {[winfo exists $w]} {
789 wm title $w "Gitk key bindings"
794 <Home> Move to first commit
795 <End> Move to last commit
796 <Up>, p, i Move up one commit
797 <Down>, n, k Move down one commit
798 <Left>, z, j Go back in history list
799 <Right>, x, l Go forward in history list
800 <PageUp> Move up one page in commit list
801 <PageDown> Move down one page in commit list
802 <Ctrl-Home> Scroll to top of commit list
803 <Ctrl-End> Scroll to bottom of commit list
804 <Ctrl-Up> Scroll commit list up one line
805 <Ctrl-Down> Scroll commit list down one line
806 <Ctrl-PageUp> Scroll commit list up one page
807 <Ctrl-PageDown> Scroll commit list down one page
808 <Delete>, b Scroll diff view up one page
809 <Backspace> Scroll diff view up one page
810 <Space> Scroll diff view down one page
811 u Scroll diff view up 18 lines
812 d Scroll diff view down 18 lines
814 <Ctrl-G> Move to next find hit
815 <Ctrl-R> Move to previous find hit
816 <Return> Move to next find hit
817 / Move to next find hit, or redo find
818 ? Move to previous find hit
819 f Scroll diff view to next file
820 <Ctrl-KP+> Increase font size
821 <Ctrl-plus> Increase font size
822 <Ctrl-KP-> Decrease font size
823 <Ctrl-minus> Decrease font size
825 -justify left -bg white -border 2 -relief sunken
826 pack $w.m -side top -fill both
827 button $w.ok -text Close -command "destroy $w"
828 pack $w.ok -side bottom
831 # Procedures for manipulating the file list window at the
832 # bottom right of the overall window.
834 proc treeview {w l openlevs} {
835 global treecontents treediropen treeheight treeparent treeindex
845 set treecontents() {}
846 $w conf -state normal
848 while {[string range $f 0 $prefixend] ne $prefix} {
849 if {$lev <= $openlevs} {
850 $w mark set e:$treeindex($prefix) "end -1c"
851 $w mark gravity e:$treeindex($prefix) left
853 set treeheight($prefix) $ht
854 incr ht [lindex $htstack end]
855 set htstack [lreplace $htstack end end]
856 set prefixend [lindex $prefendstack end]
857 set prefendstack [lreplace $prefendstack end end]
858 set prefix [string range $prefix 0 $prefixend]
861 set tail [string range $f [expr {$prefixend+1}] end]
862 while {[set slash [string first "/" $tail]] >= 0} {
865 lappend prefendstack $prefixend
866 incr prefixend [expr {$slash + 1}]
867 set d [string range $tail 0 $slash]
868 lappend treecontents($prefix) $d
869 set oldprefix $prefix
871 set treecontents($prefix) {}
872 set treeindex($prefix) [incr ix]
873 set treeparent($prefix) $oldprefix
874 set tail [string range $tail [expr {$slash+1}] end]
875 if {$lev <= $openlevs} {
877 set treediropen($prefix) [expr {$lev < $openlevs}]
878 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
879 $w mark set d:$ix "end -1c"
880 $w mark gravity d:$ix left
882 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
884 $w image create end -align center -image $bm -padx 1 \
887 $w mark set s:$ix "end -1c"
888 $w mark gravity s:$ix left
893 if {$lev <= $openlevs} {
896 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
900 lappend treecontents($prefix) $tail
903 while {$htstack ne {}} {
904 set treeheight($prefix) $ht
905 incr ht [lindex $htstack end]
906 set htstack [lreplace $htstack end end]
908 $w conf -state disabled
912 global treeheight treecontents
917 foreach e $treecontents($prefix) {
922 if {[string index $e end] eq "/"} {
923 set n $treeheight($prefix$e)
935 proc treeclosedir {w dir} {
936 global treediropen treeheight treeparent treeindex
938 set ix $treeindex($dir)
939 $w conf -state normal
940 $w delete s:$ix e:$ix
941 set treediropen($dir) 0
942 $w image configure a:$ix -image tri-rt
943 $w conf -state disabled
944 set n [expr {1 - $treeheight($dir)}]
946 incr treeheight($dir) $n
947 set dir $treeparent($dir)
951 proc treeopendir {w dir} {
952 global treediropen treeheight treeparent treecontents treeindex
954 set ix $treeindex($dir)
955 $w conf -state normal
956 $w image configure a:$ix -image tri-dn
957 $w mark set e:$ix s:$ix
958 $w mark gravity e:$ix right
961 set n [llength $treecontents($dir)]
962 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
965 incr treeheight($x) $n
967 foreach e $treecontents($dir) {
968 if {[string index $e end] eq "/"} {
970 set iy $treeindex($de)
971 $w mark set d:$iy e:$ix
972 $w mark gravity d:$iy left
974 set treediropen($de) 0
975 $w image create e:$ix -align center -image tri-rt -padx 1 \
978 $w mark set s:$iy e:$ix
979 $w mark gravity s:$iy left
980 set treeheight($de) 1
986 $w mark gravity e:$ix left
987 $w conf -state disabled
988 set treediropen($dir) 1
989 set top [lindex [split [$w index @0,0] .] 0]
990 set ht [$w cget -height]
991 set l [lindex [split [$w index s:$ix] .] 0]
994 } elseif {$l + $n + 1 > $top + $ht} {
995 set top [expr {$l + $n + 2 - $ht}]
1003 proc treeclick {w x y} {
1004 global treediropen cmitmode ctext cflist cflist_top
1006 if {$cmitmode ne "tree"} return
1007 if {![info exists cflist_top]} return
1008 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1009 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1010 $cflist tag add highlight $l.0 "$l.0 lineend"
1016 set e [linetoelt $l]
1017 if {[string index $e end] ne "/"} {
1019 } elseif {$treediropen($e)} {
1026 proc setfilelist {id} {
1027 global treefilelist cflist
1029 treeview $cflist $treefilelist($id) 0
1032 image create bitmap tri-rt -background black -foreground blue -data {
1033 #define tri-rt_width 13
1034 #define tri-rt_height 13
1035 static unsigned char tri-rt_bits[] = {
1036 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1037 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1040 #define tri-rt-mask_width 13
1041 #define tri-rt-mask_height 13
1042 static unsigned char tri-rt-mask_bits[] = {
1043 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1044 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1047 image create bitmap tri-dn -background black -foreground blue -data {
1048 #define tri-dn_width 13
1049 #define tri-dn_height 13
1050 static unsigned char tri-dn_bits[] = {
1051 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1052 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1055 #define tri-dn-mask_width 13
1056 #define tri-dn-mask_height 13
1057 static unsigned char tri-dn-mask_bits[] = {
1058 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1059 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1063 proc init_flist {first} {
1064 global cflist cflist_top cflist_bot selectedline difffilestart
1066 $cflist conf -state normal
1067 $cflist delete 0.0 end
1069 $cflist insert end $first
1072 $cflist tag add highlight 1.0 "1.0 lineend"
1074 catch {unset cflist_top}
1076 $cflist conf -state disabled
1077 set difffilestart {}
1080 proc add_flist {fl} {
1081 global flistmode cflist
1083 $cflist conf -state normal
1084 if {$flistmode eq "flat"} {
1086 $cflist insert end "\n$f"
1089 $cflist conf -state disabled
1092 proc sel_flist {w x y} {
1093 global flistmode ctext difffilestart cflist cflist_top cmitmode
1095 if {$cmitmode eq "tree"} return
1096 if {![info exists cflist_top]} return
1097 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1101 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1106 proc scrolltext {f0 f1} {
1109 .ctop.cdet.left.sb set $f0 $f1
1110 if {[info exists cflist_top]} {
1111 highlight_flist $cflist_top
1115 # Given an index $tl in the $ctext window, this works out which line
1116 # of the $cflist window displays the filename whose patch is shown
1117 # at the given point in the $ctext window. $ll is a hint about which
1118 # line it might be, and is used as the starting point of the search.
1119 proc ctext_index {tl ll} {
1120 global ctext difffilestart
1122 while {$ll >= 2 && [$ctext compare $tl < \
1123 [lindex $difffilestart [expr {$ll - 2}]]]} {
1126 set nfiles [llength $difffilestart]
1127 while {$ll - 1 < $nfiles && [$ctext compare $tl >= \
1128 [lindex $difffilestart [expr {$ll - 1}]]]} {
1134 proc highlight_flist {ll} {
1135 global ctext cflist cflist_top cflist_bot difffilestart
1137 if {![info exists difffilestart] || [llength $difffilestart] == 0} return
1138 set ll [ctext_index [$ctext index @0,1] $ll]
1143 set y [expr {[winfo height $ctext] - 2}]
1144 set lb [ctext_index [$ctext index @0,$y] $lb]
1145 if {$ll != $cflist_top || $lb != $cflist_bot} {
1146 $cflist tag remove highlight $cflist_top.0 "$cflist_bot.0 lineend"
1147 for {set l $ll} {$l <= $lb} {incr l} {
1148 $cflist tag add highlight $l.0 "$l.0 lineend"
1155 # Code to implement multiple views
1158 global nextviewnum newviewname newviewperm uifont
1161 if {[winfo exists $top]} {
1165 set newviewname($nextviewnum) "View $nextviewnum"
1166 set newviewperm($nextviewnum) 0
1167 vieweditor $top $nextviewnum "Gitk view definition"
1172 global viewname viewperm newviewname newviewperm
1174 set top .gitkvedit-$curview
1175 if {[winfo exists $top]} {
1179 set newviewname($curview) $viewname($curview)
1180 set newviewperm($curview) $viewperm($curview)
1181 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1184 proc vieweditor {top n title} {
1185 global newviewname newviewperm viewfiles
1189 wm title $top $title
1190 label $top.nl -text "Name" -font $uifont
1191 entry $top.name -width 20 -textvariable newviewname($n)
1192 grid $top.nl $top.name -sticky w -pady 5
1193 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1194 grid $top.perm - -pady 5 -sticky w
1195 message $top.l -aspect 500 -font $uifont \
1196 -text "Enter files and directories to include, one per line:"
1197 grid $top.l - -sticky w
1198 text $top.t -width 40 -height 10 -background white
1199 if {[info exists viewfiles($n)]} {
1200 foreach f $viewfiles($n) {
1201 $top.t insert end $f
1202 $top.t insert end "\n"
1204 $top.t delete {end - 1c} end
1205 $top.t mark set insert 0.0
1207 grid $top.t - -sticky w -padx 5
1209 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1210 button $top.buts.can -text "Cancel" -command [list destroy $top]
1211 grid $top.buts.ok $top.buts.can
1212 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1213 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1214 grid $top.buts - -pady 10 -sticky ew
1218 proc viewmenuitem {n} {
1219 set nmenu [.bar.view index end]
1220 set targetcmd [list showview $n]
1221 for {set i 6} {$i <= $nmenu} {incr i} {
1222 if {[.bar.view entrycget $i -command] eq $targetcmd} {
1229 proc newviewok {top n} {
1230 global nextviewnum newviewperm newviewname
1231 global viewname viewfiles viewperm selectedview curview
1234 foreach f [split [$top.t get 0.0 end] "\n"] {
1235 set ft [string trim $f]
1240 if {![info exists viewfiles($n)]} {
1241 # creating a new view
1243 set viewname($n) $newviewname($n)
1244 set viewperm($n) $newviewperm($n)
1245 set viewfiles($n) $files
1246 .bar.view add radiobutton -label $viewname($n) \
1247 -command [list showview $n] -variable selectedview -value $n
1248 after idle showview $n
1250 # editing an existing view
1251 set viewperm($n) $newviewperm($n)
1252 if {$newviewname($n) ne $viewname($n)} {
1253 set viewname($n) $newviewname($n)
1254 set i [viewmenuitem $n]
1256 .bar.view entryconf $i -label $viewname($n)
1259 if {$files ne $viewfiles($n)} {
1260 set viewfiles($n) $files
1261 if {$curview == $n} {
1262 after idle updatecommits
1266 catch {destroy $top}
1270 global curview viewdata viewperm
1272 if {$curview == 0} return
1273 set i [viewmenuitem $curview]
1277 set viewdata($curview) {}
1278 set viewperm($curview) 0
1282 proc flatten {var} {
1286 foreach i [array names $var] {
1287 lappend ret $i [set $var\($i\)]
1292 proc unflatten {var l} {
1302 global curview viewdata viewfiles
1303 global displayorder parentlist childlist rowidlist rowoffsets
1304 global colormap rowtextx commitrow
1305 global numcommits rowrangelist commitlisted idrowranges
1306 global selectedline currentid canv canvy0
1307 global matchinglines treediffs
1308 global pending_select phase
1309 global commitidx rowlaidout rowoptim linesegends leftover
1310 global commfd nextupdate
1313 if {$n == $curview} return
1315 if {[info exists selectedline]} {
1316 set selid $currentid
1317 set y [yc $selectedline]
1318 set ymax [lindex [$canv cget -scrollregion] 3]
1319 set span [$canv yview]
1320 set ytop [expr {[lindex $span 0] * $ymax}]
1321 set ybot [expr {[lindex $span 1] * $ymax}]
1322 if {$ytop < $y && $y < $ybot} {
1323 set yscreen [expr {$y - $ytop}]
1325 set yscreen [expr {($ybot - $ytop) / 2}]
1331 if {$curview >= 0} {
1333 set viewdata($curview) \
1334 [list $phase $displayorder $parentlist $childlist $rowidlist \
1335 $rowoffsets $rowrangelist $commitlisted \
1336 [flatten children] [flatten idrowranges] \
1337 [flatten idinlist] \
1338 $commitidx $rowlaidout $rowoptim $numcommits \
1339 $linesegends $leftover $commfd]
1340 fileevent $commfd readable {}
1341 } elseif {![info exists viewdata($curview)]
1342 || [lindex $viewdata($curview) 0] ne {}} {
1343 set viewdata($curview) \
1344 [list {} $displayorder $parentlist $childlist $rowidlist \
1345 $rowoffsets $rowrangelist $commitlisted]
1348 catch {unset matchinglines}
1349 catch {unset treediffs}
1354 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1355 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1357 if {![info exists viewdata($n)]} {
1358 set pending_select $selid
1364 set phase [lindex $v 0]
1365 set displayorder [lindex $v 1]
1366 set parentlist [lindex $v 2]
1367 set childlist [lindex $v 3]
1368 set rowidlist [lindex $v 4]
1369 set rowoffsets [lindex $v 5]
1370 set rowrangelist [lindex $v 6]
1371 set commitlisted [lindex $v 7]
1373 set numcommits [llength $displayorder]
1374 catch {unset idrowranges}
1375 catch {unset children}
1377 unflatten children [lindex $v 8]
1378 unflatten idrowranges [lindex $v 9]
1379 unflatten idinlist [lindex $v 10]
1380 set commitidx [lindex $v 11]
1381 set rowlaidout [lindex $v 12]
1382 set rowoptim [lindex $v 13]
1383 set numcommits [lindex $v 14]
1384 set linesegends [lindex $v 15]
1385 set leftover [lindex $v 16]
1386 set commfd [lindex $v 17]
1387 fileevent $commfd readable [list getcommitlines $commfd]
1388 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1391 catch {unset colormap}
1392 catch {unset rowtextx}
1393 catch {unset commitrow}
1396 foreach id $displayorder {
1397 set commitrow($id) $row
1403 if {$selid ne {} && [info exists commitrow($selid)]} {
1404 set row $commitrow($selid)
1405 # try to get the selected row in the same position on the screen
1406 set ymax [lindex [$canv cget -scrollregion] 3]
1407 set ytop [expr {[yc $row] - $yscreen}]
1411 set yf [expr {$ytop * 1.0 / $ymax}]
1413 allcanvs yview moveto $yf
1417 global maincursor textcursor
1418 . config -cursor $maincursor
1419 settextcursor $textcursor
1421 . config -cursor watch
1423 if {$phase eq "getcommits"} {
1425 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1426 -font $mainfont -tags textitems
1431 proc shortids {ids} {
1434 if {[llength $id] > 1} {
1435 lappend res [shortids $id]
1436 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1437 lappend res [string range $id 0 7]
1445 proc incrange {l x o} {
1448 set e [lindex $l $x]
1450 lset l $x [expr {$e + $o}]
1459 for {} {$n > 0} {incr n -1} {
1465 proc usedinrange {id l1 l2} {
1466 global children commitrow childlist
1468 if {[info exists commitrow($id)]} {
1469 set r $commitrow($id)
1470 if {$l1 <= $r && $r <= $l2} {
1471 return [expr {$r - $l1 + 1}]
1473 set kids [lindex $childlist $r]
1475 set kids $children($id)
1478 set r $commitrow($c)
1479 if {$l1 <= $r && $r <= $l2} {
1480 return [expr {$r - $l1 + 1}]
1486 proc sanity {row {full 0}} {
1487 global rowidlist rowoffsets
1490 set ids [lindex $rowidlist $row]
1493 if {$id eq {}} continue
1494 if {$col < [llength $ids] - 1 &&
1495 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1496 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1498 set o [lindex $rowoffsets $row $col]
1504 if {[lindex $rowidlist $y $x] != $id} {
1505 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1506 puts " id=[shortids $id] check started at row $row"
1507 for {set i $row} {$i >= $y} {incr i -1} {
1508 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1513 set o [lindex $rowoffsets $y $x]
1518 proc makeuparrow {oid x y z} {
1519 global rowidlist rowoffsets uparrowlen idrowranges
1521 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1524 set off0 [lindex $rowoffsets $y]
1525 for {set x0 $x} {1} {incr x0} {
1526 if {$x0 >= [llength $off0]} {
1527 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1530 set z [lindex $off0 $x0]
1536 set z [expr {$x0 - $x}]
1537 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1538 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1540 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1541 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1542 lappend idrowranges($oid) $y
1545 proc initlayout {} {
1546 global rowidlist rowoffsets displayorder commitlisted
1547 global rowlaidout rowoptim
1548 global idinlist rowchk rowrangelist idrowranges
1549 global commitidx numcommits canvxmax canv
1551 global parentlist childlist children
1552 global colormap rowtextx commitrow
1562 catch {unset children}
1566 catch {unset idinlist}
1567 catch {unset rowchk}
1570 set canvxmax [$canv cget -width]
1571 catch {unset colormap}
1572 catch {unset rowtextx}
1573 catch {unset commitrow}
1574 catch {unset idrowranges}
1578 proc setcanvscroll {} {
1579 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1581 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1582 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1583 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1584 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1587 proc visiblerows {} {
1588 global canv numcommits linespc
1590 set ymax [lindex [$canv cget -scrollregion] 3]
1591 if {$ymax eq {} || $ymax == 0} return
1593 set y0 [expr {int([lindex $f 0] * $ymax)}]
1594 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1598 set y1 [expr {int([lindex $f 1] * $ymax)}]
1599 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1600 if {$r1 >= $numcommits} {
1601 set r1 [expr {$numcommits - 1}]
1603 return [list $r0 $r1]
1606 proc layoutmore {} {
1607 global rowlaidout rowoptim commitidx numcommits optim_delay
1611 set rowlaidout [layoutrows $row $commitidx 0]
1612 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1613 if {$orow > $rowoptim} {
1614 optimize_rows $rowoptim 0 $orow
1617 set canshow [expr {$rowoptim - $optim_delay}]
1618 if {$canshow > $numcommits} {
1623 proc showstuff {canshow} {
1624 global numcommits commitrow pending_select selectedline
1625 global linesegends idrowranges idrangedrawn
1627 if {$numcommits == 0} {
1629 set phase "incrdraw"
1633 set numcommits $canshow
1635 set rows [visiblerows]
1636 set r0 [lindex $rows 0]
1637 set r1 [lindex $rows 1]
1639 for {set r $row} {$r < $canshow} {incr r} {
1640 foreach id [lindex $linesegends [expr {$r+1}]] {
1642 foreach {s e} [rowranges $id] {
1644 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1645 && ![info exists idrangedrawn($id,$i)]} {
1647 set idrangedrawn($id,$i) 1
1652 if {$canshow > $r1} {
1655 while {$row < $canshow} {
1659 if {[info exists pending_select] &&
1660 [info exists commitrow($pending_select)] &&
1661 $commitrow($pending_select) < $numcommits} {
1662 selectline $commitrow($pending_select) 1
1664 if {![info exists selectedline] && ![info exists pending_select]} {
1669 proc layoutrows {row endrow last} {
1670 global rowidlist rowoffsets displayorder
1671 global uparrowlen downarrowlen maxwidth mingaplen
1672 global childlist parentlist
1673 global idrowranges linesegends
1675 global idinlist rowchk rowrangelist
1677 set idlist [lindex $rowidlist $row]
1678 set offs [lindex $rowoffsets $row]
1679 while {$row < $endrow} {
1680 set id [lindex $displayorder $row]
1683 foreach p [lindex $parentlist $row] {
1684 if {![info exists idinlist($p)]} {
1686 } elseif {!$idinlist($p)} {
1691 set nev [expr {[llength $idlist] + [llength $newolds]
1692 + [llength $oldolds] - $maxwidth + 1}]
1694 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1695 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1696 set i [lindex $idlist $x]
1697 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1698 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1699 [expr {$row + $uparrowlen + $mingaplen}]]
1701 set idlist [lreplace $idlist $x $x]
1702 set offs [lreplace $offs $x $x]
1703 set offs [incrange $offs $x 1]
1705 set rm1 [expr {$row - 1}]
1707 lappend idrowranges($i) $rm1
1708 if {[incr nev -1] <= 0} break
1711 set rowchk($id) [expr {$row + $r}]
1714 lset rowidlist $row $idlist
1715 lset rowoffsets $row $offs
1717 lappend linesegends $lse
1718 set col [lsearch -exact $idlist $id]
1720 set col [llength $idlist]
1722 lset rowidlist $row $idlist
1724 if {[lindex $childlist $row] ne {}} {
1725 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1729 lset rowoffsets $row $offs
1731 makeuparrow $id $col $row $z
1737 if {[info exists idrowranges($id)]} {
1738 set ranges $idrowranges($id)
1740 unset idrowranges($id)
1742 lappend rowrangelist $ranges
1744 set offs [ntimes [llength $idlist] 0]
1745 set l [llength $newolds]
1746 set idlist [eval lreplace \$idlist $col $col $newolds]
1749 set offs [lrange $offs 0 [expr {$col - 1}]]
1750 foreach x $newolds {
1755 set tmp [expr {[llength $idlist] - [llength $offs]}]
1757 set offs [concat $offs [ntimes $tmp $o]]
1762 foreach i $newolds {
1764 set idrowranges($i) $row
1767 foreach oid $oldolds {
1768 set idinlist($oid) 1
1769 set idlist [linsert $idlist $col $oid]
1770 set offs [linsert $offs $col $o]
1771 makeuparrow $oid $col $row $o
1774 lappend rowidlist $idlist
1775 lappend rowoffsets $offs
1780 proc addextraid {id row} {
1781 global displayorder commitrow commitinfo
1782 global commitidx commitlisted
1783 global parentlist childlist children
1786 lappend displayorder $id
1787 lappend commitlisted 0
1788 lappend parentlist {}
1789 set commitrow($id) $row
1791 if {![info exists commitinfo($id)]} {
1792 set commitinfo($id) {"No commit information available"}
1794 if {[info exists children($id)]} {
1795 lappend childlist $children($id)
1798 lappend childlist {}
1802 proc layouttail {} {
1803 global rowidlist rowoffsets idinlist commitidx
1804 global idrowranges rowrangelist
1807 set idlist [lindex $rowidlist $row]
1808 while {$idlist ne {}} {
1809 set col [expr {[llength $idlist] - 1}]
1810 set id [lindex $idlist $col]
1813 lappend idrowranges($id) $row
1814 lappend rowrangelist $idrowranges($id)
1815 unset idrowranges($id)
1817 set offs [ntimes $col 0]
1818 set idlist [lreplace $idlist $col $col]
1819 lappend rowidlist $idlist
1820 lappend rowoffsets $offs
1823 foreach id [array names idinlist] {
1825 lset rowidlist $row [list $id]
1826 lset rowoffsets $row 0
1827 makeuparrow $id 0 $row 0
1828 lappend idrowranges($id) $row
1829 lappend rowrangelist $idrowranges($id)
1830 unset idrowranges($id)
1832 lappend rowidlist {}
1833 lappend rowoffsets {}
1837 proc insert_pad {row col npad} {
1838 global rowidlist rowoffsets
1840 set pad [ntimes $npad {}]
1841 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1842 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1843 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1846 proc optimize_rows {row col endrow} {
1847 global rowidlist rowoffsets idrowranges displayorder
1849 for {} {$row < $endrow} {incr row} {
1850 set idlist [lindex $rowidlist $row]
1851 set offs [lindex $rowoffsets $row]
1853 for {} {$col < [llength $offs]} {incr col} {
1854 if {[lindex $idlist $col] eq {}} {
1858 set z [lindex $offs $col]
1859 if {$z eq {}} continue
1861 set x0 [expr {$col + $z}]
1862 set y0 [expr {$row - 1}]
1863 set z0 [lindex $rowoffsets $y0 $x0]
1865 set id [lindex $idlist $col]
1866 set ranges [rowranges $id]
1867 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1871 if {$z < -1 || ($z < 0 && $isarrow)} {
1872 set npad [expr {-1 - $z + $isarrow}]
1873 set offs [incrange $offs $col $npad]
1874 insert_pad $y0 $x0 $npad
1876 optimize_rows $y0 $x0 $row
1878 set z [lindex $offs $col]
1879 set x0 [expr {$col + $z}]
1880 set z0 [lindex $rowoffsets $y0 $x0]
1881 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1882 set npad [expr {$z - 1 + $isarrow}]
1883 set y1 [expr {$row + 1}]
1884 set offs2 [lindex $rowoffsets $y1]
1888 if {$z eq {} || $x1 + $z < $col} continue
1889 if {$x1 + $z > $col} {
1892 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1895 set pad [ntimes $npad {}]
1896 set idlist [eval linsert \$idlist $col $pad]
1897 set tmp [eval linsert \$offs $col $pad]
1899 set offs [incrange $tmp $col [expr {-$npad}]]
1900 set z [lindex $offs $col]
1903 if {$z0 eq {} && !$isarrow} {
1904 # this line links to its first child on row $row-2
1905 set rm2 [expr {$row - 2}]
1906 set id [lindex $displayorder $rm2]
1907 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1909 set z0 [expr {$xc - $x0}]
1912 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1913 insert_pad $y0 $x0 1
1914 set offs [incrange $offs $col 1]
1915 optimize_rows $y0 [expr {$x0 + 1}] $row
1920 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1921 set o [lindex $offs $col]
1923 # check if this is the link to the first child
1924 set id [lindex $idlist $col]
1925 set ranges [rowranges $id]
1926 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1927 # it is, work out offset to child
1928 set y0 [expr {$row - 1}]
1929 set id [lindex $displayorder $y0]
1930 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1932 set o [expr {$x0 - $col}]
1936 if {$o eq {} || $o <= 0} break
1938 if {$o ne {} && [incr col] < [llength $idlist]} {
1939 set y1 [expr {$row + 1}]
1940 set offs2 [lindex $rowoffsets $y1]
1944 if {$z eq {} || $x1 + $z < $col} continue
1945 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1948 set idlist [linsert $idlist $col {}]
1949 set tmp [linsert $offs $col {}]
1951 set offs [incrange $tmp $col -1]
1954 lset rowidlist $row $idlist
1955 lset rowoffsets $row $offs
1961 global canvx0 linespc
1962 return [expr {$canvx0 + $col * $linespc}]
1966 global canvy0 linespc
1967 return [expr {$canvy0 + $row * $linespc}]
1970 proc linewidth {id} {
1971 global thickerline lthickness
1974 if {[info exists thickerline] && $id eq $thickerline} {
1975 set wid [expr {2 * $lthickness}]
1980 proc rowranges {id} {
1981 global phase idrowranges commitrow rowlaidout rowrangelist
1985 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1986 set ranges [lindex $rowrangelist $commitrow($id)]
1987 } elseif {[info exists idrowranges($id)]} {
1988 set ranges $idrowranges($id)
1993 proc drawlineseg {id i} {
1994 global rowoffsets rowidlist
1996 global canv colormap linespc
1997 global numcommits commitrow
1999 set ranges [rowranges $id]
2001 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
2002 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2006 set startrow [lindex $ranges [expr {2 * $i}]]
2007 set row [lindex $ranges [expr {2 * $i + 1}]]
2008 if {$startrow == $row} return
2011 set col [lsearch -exact [lindex $rowidlist $row] $id]
2013 puts "oops: drawline: id $id not on row $row"
2019 set o [lindex $rowoffsets $row $col]
2022 # changing direction
2023 set x [xc $row $col]
2025 lappend coords $x $y
2031 set x [xc $row $col]
2033 lappend coords $x $y
2035 # draw the link to the first child as part of this line
2037 set child [lindex $displayorder $row]
2038 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2040 set x [xc $row $ccol]
2042 if {$ccol < $col - 1} {
2043 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2044 } elseif {$ccol > $col + 1} {
2045 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2047 lappend coords $x $y
2050 if {[llength $coords] < 4} return
2052 # This line has an arrow at the lower end: check if the arrow is
2053 # on a diagonal segment, and if so, work around the Tk 8.4
2054 # refusal to draw arrows on diagonal lines.
2055 set x0 [lindex $coords 0]
2056 set x1 [lindex $coords 2]
2058 set y0 [lindex $coords 1]
2059 set y1 [lindex $coords 3]
2060 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2061 # we have a nearby vertical segment, just trim off the diag bit
2062 set coords [lrange $coords 2 end]
2064 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2065 set xi [expr {$x0 - $slope * $linespc / 2}]
2066 set yi [expr {$y0 - $linespc / 2}]
2067 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2071 set arrow [expr {2 * ($i > 0) + $downarrow}]
2072 set arrow [lindex {none first last both} $arrow]
2073 set t [$canv create line $coords -width [linewidth $id] \
2074 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2079 proc drawparentlinks {id row col olds} {
2080 global rowidlist canv colormap
2082 set row2 [expr {$row + 1}]
2083 set x [xc $row $col]
2086 set ids [lindex $rowidlist $row2]
2087 # rmx = right-most X coord used
2090 set i [lsearch -exact $ids $p]
2092 puts "oops, parent $p of $id not in list"
2095 set x2 [xc $row2 $i]
2099 set ranges [rowranges $p]
2100 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2101 && $row2 < [lindex $ranges 1]} {
2102 # drawlineseg will do this one for us
2106 # should handle duplicated parents here...
2107 set coords [list $x $y]
2108 if {$i < $col - 1} {
2109 lappend coords [xc $row [expr {$i + 1}]] $y
2110 } elseif {$i > $col + 1} {
2111 lappend coords [xc $row [expr {$i - 1}]] $y
2113 lappend coords $x2 $y2
2114 set t [$canv create line $coords -width [linewidth $p] \
2115 -fill $colormap($p) -tags lines.$p]
2122 proc drawlines {id} {
2123 global colormap canv
2125 global childlist iddrawn commitrow rowidlist
2127 $canv delete lines.$id
2128 set nr [expr {[llength [rowranges $id]] / 2}]
2129 for {set i 0} {$i < $nr} {incr i} {
2130 if {[info exists idrangedrawn($id,$i)]} {
2134 foreach child [lindex $childlist $commitrow($id)] {
2135 if {[info exists iddrawn($child)]} {
2136 set row $commitrow($child)
2137 set col [lsearch -exact [lindex $rowidlist $row] $child]
2139 drawparentlinks $child $row $col [list $id]
2145 proc drawcmittext {id row col rmx} {
2146 global linespc canv canv2 canv3 canvy0
2147 global commitlisted commitinfo rowidlist
2148 global rowtextx idpos idtags idheads idotherrefs
2149 global linehtag linentag linedtag
2150 global mainfont namefont canvxmax
2152 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2153 set x [xc $row $col]
2155 set orad [expr {$linespc / 3}]
2156 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2157 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2158 -fill $ofill -outline black -width 1]
2160 $canv bind $t <1> {selcanvline {} %x %y}
2161 set xt [xc $row [llength [lindex $rowidlist $row]]]
2165 set rowtextx($row) $xt
2166 set idpos($id) [list $x $xt $y]
2167 if {[info exists idtags($id)] || [info exists idheads($id)]
2168 || [info exists idotherrefs($id)]} {
2169 set xt [drawtags $id $x $xt $y]
2171 set headline [lindex $commitinfo($id) 0]
2172 set name [lindex $commitinfo($id) 1]
2173 set date [lindex $commitinfo($id) 2]
2174 set date [formatdate $date]
2175 set linehtag($row) [$canv create text $xt $y -anchor w \
2176 -text $headline -font $mainfont ]
2177 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2178 set linentag($row) [$canv2 create text 3 $y -anchor w \
2179 -text $name -font $namefont]
2180 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2181 -text $date -font $mainfont]
2182 set xr [expr {$xt + [font measure $mainfont $headline]}]
2183 if {$xr > $canvxmax} {
2189 proc drawcmitrow {row} {
2190 global displayorder rowidlist
2191 global idrangedrawn iddrawn
2192 global commitinfo parentlist numcommits
2194 if {$row >= $numcommits} return
2195 foreach id [lindex $rowidlist $row] {
2196 if {$id eq {}} continue
2198 foreach {s e} [rowranges $id] {
2200 if {$row < $s} continue
2203 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2205 set idrangedrawn($id,$i) 1
2212 set id [lindex $displayorder $row]
2213 if {[info exists iddrawn($id)]} return
2214 set col [lsearch -exact [lindex $rowidlist $row] $id]
2216 puts "oops, row $row id $id not in list"
2219 if {![info exists commitinfo($id)]} {
2223 set olds [lindex $parentlist $row]
2225 set rmx [drawparentlinks $id $row $col $olds]
2229 drawcmittext $id $row $col $rmx
2233 proc drawfrac {f0 f1} {
2234 global numcommits canv
2237 set ymax [lindex [$canv cget -scrollregion] 3]
2238 if {$ymax eq {} || $ymax == 0} return
2239 set y0 [expr {int($f0 * $ymax)}]
2240 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2244 set y1 [expr {int($f1 * $ymax)}]
2245 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2246 if {$endrow >= $numcommits} {
2247 set endrow [expr {$numcommits - 1}]
2249 for {} {$row <= $endrow} {incr row} {
2254 proc drawvisible {} {
2256 eval drawfrac [$canv yview]
2259 proc clear_display {} {
2260 global iddrawn idrangedrawn
2263 catch {unset iddrawn}
2264 catch {unset idrangedrawn}
2267 proc findcrossings {id} {
2268 global rowidlist parentlist numcommits rowoffsets displayorder
2272 foreach {s e} [rowranges $id] {
2273 if {$e >= $numcommits} {
2274 set e [expr {$numcommits - 1}]
2276 if {$e <= $s} continue
2277 set x [lsearch -exact [lindex $rowidlist $e] $id]
2279 puts "findcrossings: oops, no [shortids $id] in row $e"
2282 for {set row $e} {[incr row -1] >= $s} {} {
2283 set olds [lindex $parentlist $row]
2284 set kid [lindex $displayorder $row]
2285 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2286 if {$kidx < 0} continue
2287 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2289 set px [lsearch -exact $nextrow $p]
2290 if {$px < 0} continue
2291 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2292 if {[lsearch -exact $ccross $p] >= 0} continue
2293 if {$x == $px + ($kidx < $px? -1: 1)} {
2295 } elseif {[lsearch -exact $cross $p] < 0} {
2300 set inc [lindex $rowoffsets $row $x]
2301 if {$inc eq {}} break
2305 return [concat $ccross {{}} $cross]
2308 proc assigncolor {id} {
2309 global colormap colors nextcolor
2310 global commitrow parentlist children childlist
2312 if {[info exists colormap($id)]} return
2313 set ncolors [llength $colors]
2314 if {[info exists commitrow($id)]} {
2315 set kids [lindex $childlist $commitrow($id)]
2316 } elseif {[info exists children($id)]} {
2317 set kids $children($id)
2321 if {[llength $kids] == 1} {
2322 set child [lindex $kids 0]
2323 if {[info exists colormap($child)]
2324 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
2325 set colormap($id) $colormap($child)
2331 foreach x [findcrossings $id] {
2333 # delimiter between corner crossings and other crossings
2334 if {[llength $badcolors] >= $ncolors - 1} break
2335 set origbad $badcolors
2337 if {[info exists colormap($x)]
2338 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2339 lappend badcolors $colormap($x)
2342 if {[llength $badcolors] >= $ncolors} {
2343 set badcolors $origbad
2345 set origbad $badcolors
2346 if {[llength $badcolors] < $ncolors - 1} {
2347 foreach child $kids {
2348 if {[info exists colormap($child)]
2349 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2350 lappend badcolors $colormap($child)
2352 foreach p [lindex $parentlist $commitrow($child)] {
2353 if {[info exists colormap($p)]
2354 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2355 lappend badcolors $colormap($p)
2359 if {[llength $badcolors] >= $ncolors} {
2360 set badcolors $origbad
2363 for {set i 0} {$i <= $ncolors} {incr i} {
2364 set c [lindex $colors $nextcolor]
2365 if {[incr nextcolor] >= $ncolors} {
2368 if {[lsearch -exact $badcolors $c]} break
2370 set colormap($id) $c
2373 proc bindline {t id} {
2376 $canv bind $t <Enter> "lineenter %x %y $id"
2377 $canv bind $t <Motion> "linemotion %x %y $id"
2378 $canv bind $t <Leave> "lineleave $id"
2379 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2382 proc drawtags {id x xt y1} {
2383 global idtags idheads idotherrefs
2384 global linespc lthickness
2385 global canv mainfont commitrow rowtextx
2390 if {[info exists idtags($id)]} {
2391 set marks $idtags($id)
2392 set ntags [llength $marks]
2394 if {[info exists idheads($id)]} {
2395 set marks [concat $marks $idheads($id)]
2396 set nheads [llength $idheads($id)]
2398 if {[info exists idotherrefs($id)]} {
2399 set marks [concat $marks $idotherrefs($id)]
2405 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2406 set yt [expr {$y1 - 0.5 * $linespc}]
2407 set yb [expr {$yt + $linespc - 1}]
2410 foreach tag $marks {
2411 set wid [font measure $mainfont $tag]
2414 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2416 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2417 -width $lthickness -fill black -tags tag.$id]
2419 foreach tag $marks x $xvals wid $wvals {
2420 set xl [expr {$x + $delta}]
2421 set xr [expr {$x + $delta + $wid + $lthickness}]
2422 if {[incr ntags -1] >= 0} {
2424 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2425 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2426 -width 1 -outline black -fill yellow -tags tag.$id]
2427 $canv bind $t <1> [list showtag $tag 1]
2428 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2430 # draw a head or other ref
2431 if {[incr nheads -1] >= 0} {
2436 set xl [expr {$xl - $delta/2}]
2437 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2438 -width 1 -outline black -fill $col -tags tag.$id
2439 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2440 set rwid [font measure $mainfont $remoteprefix]
2441 set xi [expr {$x + 1}]
2442 set yti [expr {$yt + 1}]
2443 set xri [expr {$x + $rwid}]
2444 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2445 -width 0 -fill "#ffddaa" -tags tag.$id
2448 set t [$canv create text $xl $y1 -anchor w -text $tag \
2449 -font $mainfont -tags tag.$id]
2451 $canv bind $t <1> [list showtag $tag 1]
2457 proc xcoord {i level ln} {
2458 global canvx0 xspc1 xspc2
2460 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2461 if {$i > 0 && $i == $level} {
2462 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2463 } elseif {$i > $level} {
2464 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2469 proc finishcommits {} {
2470 global commitidx phase
2471 global canv mainfont ctext maincursor textcursor
2472 global findinprogress pending_select
2474 if {$commitidx > 0} {
2478 $canv create text 3 3 -anchor nw -text "No commits selected" \
2479 -font $mainfont -tags textitems
2481 if {![info exists findinprogress]} {
2482 . config -cursor $maincursor
2483 settextcursor $textcursor
2486 catch {unset pending_select}
2489 # Don't change the text pane cursor if it is currently the hand cursor,
2490 # showing that we are over a sha1 ID link.
2491 proc settextcursor {c} {
2492 global ctext curtextcursor
2494 if {[$ctext cget -cursor] == $curtextcursor} {
2495 $ctext config -cursor $c
2497 set curtextcursor $c
2503 global canvy0 numcommits linespc
2504 global rowlaidout commitidx
2505 global pending_select
2508 layoutrows $rowlaidout $commitidx 1
2510 optimize_rows $row 0 $commitidx
2511 showstuff $commitidx
2512 if {[info exists pending_select]} {
2516 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2517 #puts "overall $drawmsecs ms for $numcommits commits"
2520 proc findmatches {f} {
2521 global findtype foundstring foundstrlen
2522 if {$findtype == "Regexp"} {
2523 set matches [regexp -indices -all -inline $foundstring $f]
2525 if {$findtype == "IgnCase"} {
2526 set str [string tolower $f]
2532 while {[set j [string first $foundstring $str $i]] >= 0} {
2533 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2534 set i [expr {$j + $foundstrlen}]
2541 global findtype findloc findstring markedmatches commitinfo
2542 global numcommits displayorder linehtag linentag linedtag
2543 global mainfont namefont canv canv2 canv3 selectedline
2544 global matchinglines foundstring foundstrlen matchstring
2550 set matchinglines {}
2551 if {$findloc == "Pickaxe"} {
2555 if {$findtype == "IgnCase"} {
2556 set foundstring [string tolower $findstring]
2558 set foundstring $findstring
2560 set foundstrlen [string length $findstring]
2561 if {$foundstrlen == 0} return
2562 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2563 set matchstring "*$matchstring*"
2564 if {$findloc == "Files"} {
2568 if {![info exists selectedline]} {
2571 set oldsel $selectedline
2574 set fldtypes {Headline Author Date Committer CDate Comment}
2576 foreach id $displayorder {
2577 set d $commitdata($id)
2579 if {$findtype == "Regexp"} {
2580 set doesmatch [regexp $foundstring $d]
2581 } elseif {$findtype == "IgnCase"} {
2582 set doesmatch [string match -nocase $matchstring $d]
2584 set doesmatch [string match $matchstring $d]
2586 if {!$doesmatch} continue
2587 if {![info exists commitinfo($id)]} {
2590 set info $commitinfo($id)
2592 foreach f $info ty $fldtypes {
2593 if {$findloc != "All fields" && $findloc != $ty} {
2596 set matches [findmatches $f]
2597 if {$matches == {}} continue
2599 if {$ty == "Headline"} {
2601 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2602 } elseif {$ty == "Author"} {
2604 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2605 } elseif {$ty == "Date"} {
2607 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2611 lappend matchinglines $l
2612 if {!$didsel && $l > $oldsel} {
2618 if {$matchinglines == {}} {
2620 } elseif {!$didsel} {
2621 findselectline [lindex $matchinglines 0]
2625 proc findselectline {l} {
2626 global findloc commentend ctext
2628 if {$findloc == "All fields" || $findloc == "Comments"} {
2629 # highlight the matches in the comments
2630 set f [$ctext get 1.0 $commentend]
2631 set matches [findmatches $f]
2632 foreach match $matches {
2633 set start [lindex $match 0]
2634 set end [expr {[lindex $match 1] + 1}]
2635 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2640 proc findnext {restart} {
2641 global matchinglines selectedline
2642 if {![info exists matchinglines]} {
2648 if {![info exists selectedline]} return
2649 foreach l $matchinglines {
2650 if {$l > $selectedline} {
2659 global matchinglines selectedline
2660 if {![info exists matchinglines]} {
2664 if {![info exists selectedline]} return
2666 foreach l $matchinglines {
2667 if {$l >= $selectedline} break
2671 findselectline $prev
2677 proc findlocchange {name ix op} {
2678 global findloc findtype findtypemenu
2679 if {$findloc == "Pickaxe"} {
2685 $findtypemenu entryconf 1 -state $state
2686 $findtypemenu entryconf 2 -state $state
2689 proc stopfindproc {{done 0}} {
2690 global findprocpid findprocfile findids
2691 global ctext findoldcursor phase maincursor textcursor
2692 global findinprogress
2694 catch {unset findids}
2695 if {[info exists findprocpid]} {
2697 catch {exec kill $findprocpid}
2699 catch {close $findprocfile}
2702 if {[info exists findinprogress]} {
2703 unset findinprogress
2705 . config -cursor $maincursor
2706 settextcursor $textcursor
2711 proc findpatches {} {
2712 global findstring selectedline numcommits
2713 global findprocpid findprocfile
2714 global finddidsel ctext displayorder findinprogress
2715 global findinsertpos
2717 if {$numcommits == 0} return
2719 # make a list of all the ids to search, starting at the one
2720 # after the selected line (if any)
2721 if {[info exists selectedline]} {
2727 for {set i 0} {$i < $numcommits} {incr i} {
2728 if {[incr l] >= $numcommits} {
2731 append inputids [lindex $displayorder $l] "\n"
2735 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2738 error_popup "Error starting search process: $err"
2742 set findinsertpos end
2744 set findprocpid [pid $f]
2745 fconfigure $f -blocking 0
2746 fileevent $f readable readfindproc
2748 . config -cursor watch
2750 set findinprogress 1
2753 proc readfindproc {} {
2754 global findprocfile finddidsel
2755 global commitrow matchinglines findinsertpos
2757 set n [gets $findprocfile line]
2759 if {[eof $findprocfile]} {
2767 if {![regexp {^[0-9a-f]{40}} $line id]} {
2768 error_popup "Can't parse git-diff-tree output: $line"
2772 if {![info exists commitrow($id)]} {
2773 puts stderr "spurious id: $id"
2776 set l $commitrow($id)
2780 proc insertmatch {l id} {
2781 global matchinglines findinsertpos finddidsel
2783 if {$findinsertpos == "end"} {
2784 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2785 set matchinglines [linsert $matchinglines 0 $l]
2788 lappend matchinglines $l
2791 set matchinglines [linsert $matchinglines $findinsertpos $l]
2802 global selectedline numcommits displayorder ctext
2803 global ffileline finddidsel parentlist
2804 global findinprogress findstartline findinsertpos
2805 global treediffs fdiffid fdiffsneeded fdiffpos
2806 global findmergefiles
2808 if {$numcommits == 0} return
2810 if {[info exists selectedline]} {
2811 set l [expr {$selectedline + 1}]
2816 set findstartline $l
2820 set id [lindex $displayorder $l]
2821 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2822 if {![info exists treediffs($id)]} {
2823 append diffsneeded "$id\n"
2824 lappend fdiffsneeded $id
2827 if {[incr l] >= $numcommits} {
2830 if {$l == $findstartline} break
2833 # start off a git-diff-tree process if needed
2834 if {$diffsneeded ne {}} {
2836 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2838 error_popup "Error starting search process: $err"
2841 catch {unset fdiffid}
2843 fconfigure $df -blocking 0
2844 fileevent $df readable [list readfilediffs $df]
2848 set findinsertpos end
2849 set id [lindex $displayorder $l]
2850 . config -cursor watch
2852 set findinprogress 1
2857 proc readfilediffs {df} {
2858 global findid fdiffid fdiffs
2860 set n [gets $df line]
2864 if {[catch {close $df} err]} {
2867 error_popup "Error in git-diff-tree: $err"
2868 } elseif {[info exists findid]} {
2872 error_popup "Couldn't find diffs for $id"
2877 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2878 # start of a new string of diffs
2882 } elseif {[string match ":*" $line]} {
2883 lappend fdiffs [lindex $line 5]
2887 proc donefilediff {} {
2888 global fdiffid fdiffs treediffs findid
2889 global fdiffsneeded fdiffpos
2891 if {[info exists fdiffid]} {
2892 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2893 && $fdiffpos < [llength $fdiffsneeded]} {
2894 # git-diff-tree doesn't output anything for a commit
2895 # which doesn't change anything
2896 set nullid [lindex $fdiffsneeded $fdiffpos]
2897 set treediffs($nullid) {}
2898 if {[info exists findid] && $nullid eq $findid} {
2906 if {![info exists treediffs($fdiffid)]} {
2907 set treediffs($fdiffid) $fdiffs
2909 if {[info exists findid] && $fdiffid eq $findid} {
2917 global findid treediffs parentlist
2918 global ffileline findstartline finddidsel
2919 global displayorder numcommits matchinglines findinprogress
2920 global findmergefiles
2924 set id [lindex $displayorder $l]
2925 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2926 if {![info exists treediffs($id)]} {
2932 foreach f $treediffs($id) {
2933 set x [findmatches $f]
2943 if {[incr l] >= $numcommits} {
2946 if {$l == $findstartline} break
2954 # mark a commit as matching by putting a yellow background
2955 # behind the headline
2956 proc markheadline {l id} {
2957 global canv mainfont linehtag
2960 set bbox [$canv bbox $linehtag($l)]
2961 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2965 # mark the bits of a headline, author or date that match a find string
2966 proc markmatches {canv l str tag matches font} {
2967 set bbox [$canv bbox $tag]
2968 set x0 [lindex $bbox 0]
2969 set y0 [lindex $bbox 1]
2970 set y1 [lindex $bbox 3]
2971 foreach match $matches {
2972 set start [lindex $match 0]
2973 set end [lindex $match 1]
2974 if {$start > $end} continue
2975 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2976 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2977 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2978 [expr {$x0+$xlen+2}] $y1 \
2979 -outline {} -tags matches -fill yellow]
2984 proc unmarkmatches {} {
2985 global matchinglines findids
2986 allcanvs delete matches
2987 catch {unset matchinglines}
2988 catch {unset findids}
2991 proc selcanvline {w x y} {
2992 global canv canvy0 ctext linespc
2994 set ymax [lindex [$canv cget -scrollregion] 3]
2995 if {$ymax == {}} return
2996 set yfrac [lindex [$canv yview] 0]
2997 set y [expr {$y + $yfrac * $ymax}]
2998 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3003 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3009 proc commit_descriptor {p} {
3012 if {[info exists commitinfo($p)]} {
3013 set l [lindex $commitinfo($p) 0]
3018 # append some text to the ctext widget, and make any SHA1 ID
3019 # that we know about be a clickable link.
3020 proc appendwithlinks {text} {
3021 global ctext commitrow linknum
3023 set start [$ctext index "end - 1c"]
3024 $ctext insert end $text
3025 $ctext insert end "\n"
3026 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3030 set linkid [string range $text $s $e]
3031 if {![info exists commitrow($linkid)]} continue
3033 $ctext tag add link "$start + $s c" "$start + $e c"
3034 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3035 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
3038 $ctext tag conf link -foreground blue -underline 1
3039 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3040 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3043 proc viewnextline {dir} {
3047 set ymax [lindex [$canv cget -scrollregion] 3]
3048 set wnow [$canv yview]
3049 set wtop [expr {[lindex $wnow 0] * $ymax}]
3050 set newtop [expr {$wtop + $dir * $linespc}]
3053 } elseif {$newtop > $ymax} {
3056 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3059 proc selectline {l isnew} {
3060 global canv canv2 canv3 ctext commitinfo selectedline
3061 global displayorder linehtag linentag linedtag
3062 global canvy0 linespc parentlist childlist
3063 global currentid sha1entry
3064 global commentend idtags linknum
3065 global mergemax numcommits pending_select
3068 catch {unset pending_select}
3071 if {$l < 0 || $l >= $numcommits} return
3072 set y [expr {$canvy0 + $l * $linespc}]
3073 set ymax [lindex [$canv cget -scrollregion] 3]
3074 set ytop [expr {$y - $linespc - 1}]
3075 set ybot [expr {$y + $linespc + 1}]
3076 set wnow [$canv yview]
3077 set wtop [expr {[lindex $wnow 0] * $ymax}]
3078 set wbot [expr {[lindex $wnow 1] * $ymax}]
3079 set wh [expr {$wbot - $wtop}]
3081 if {$ytop < $wtop} {
3082 if {$ybot < $wtop} {
3083 set newtop [expr {$y - $wh / 2.0}]
3086 if {$newtop > $wtop - $linespc} {
3087 set newtop [expr {$wtop - $linespc}]
3090 } elseif {$ybot > $wbot} {
3091 if {$ytop > $wbot} {
3092 set newtop [expr {$y - $wh / 2.0}]
3094 set newtop [expr {$ybot - $wh}]
3095 if {$newtop < $wtop + $linespc} {
3096 set newtop [expr {$wtop + $linespc}]
3100 if {$newtop != $wtop} {
3104 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3108 if {![info exists linehtag($l)]} return
3110 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3111 -tags secsel -fill [$canv cget -selectbackground]]
3113 $canv2 delete secsel
3114 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3115 -tags secsel -fill [$canv2 cget -selectbackground]]
3117 $canv3 delete secsel
3118 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3119 -tags secsel -fill [$canv3 cget -selectbackground]]
3123 addtohistory [list selectline $l 0]
3128 set id [lindex $displayorder $l]
3130 $sha1entry delete 0 end
3131 $sha1entry insert 0 $id
3132 $sha1entry selection from 0
3133 $sha1entry selection to end
3135 $ctext conf -state normal
3136 $ctext delete 0.0 end
3138 set info $commitinfo($id)
3139 set date [formatdate [lindex $info 2]]
3140 $ctext insert end "Author: [lindex $info 1] $date\n"
3141 set date [formatdate [lindex $info 4]]
3142 $ctext insert end "Committer: [lindex $info 3] $date\n"
3143 if {[info exists idtags($id)]} {
3144 $ctext insert end "Tags:"
3145 foreach tag $idtags($id) {
3146 $ctext insert end " $tag"
3148 $ctext insert end "\n"
3152 set olds [lindex $parentlist $l]
3153 if {[llength $olds] > 1} {
3156 if {$np >= $mergemax} {
3161 $ctext insert end "Parent: " $tag
3162 appendwithlinks [commit_descriptor $p]
3167 append comment "Parent: [commit_descriptor $p]\n"
3171 foreach c [lindex $childlist $l] {
3172 append comment "Child: [commit_descriptor $c]\n"
3175 append comment [lindex $info 5]
3177 # make anything that looks like a SHA1 ID be a clickable link
3178 appendwithlinks $comment
3180 $ctext tag delete Comments
3181 $ctext tag remove found 1.0 end
3182 $ctext conf -state disabled
3183 set commentend [$ctext index "end - 1c"]
3185 init_flist "Comments"
3186 if {$cmitmode eq "tree"} {
3188 } elseif {[llength $olds] <= 1} {
3195 proc selfirstline {} {
3200 proc sellastline {} {
3203 set l [expr {$numcommits - 1}]
3207 proc selnextline {dir} {
3209 if {![info exists selectedline]} return
3210 set l [expr {$selectedline + $dir}]
3215 proc selnextpage {dir} {
3216 global canv linespc selectedline numcommits
3218 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3222 allcanvs yview scroll [expr {$dir * $lpp}] units
3223 if {![info exists selectedline]} return
3224 set l [expr {$selectedline + $dir * $lpp}]
3227 } elseif {$l >= $numcommits} {
3228 set l [expr $numcommits - 1]
3234 proc unselectline {} {
3235 global selectedline currentid
3237 catch {unset selectedline}
3238 catch {unset currentid}
3239 allcanvs delete secsel
3242 proc reselectline {} {
3245 if {[info exists selectedline]} {
3246 selectline $selectedline 0
3250 proc addtohistory {cmd} {
3251 global history historyindex curview
3253 set elt [list $curview $cmd]
3254 if {$historyindex > 0
3255 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3259 if {$historyindex < [llength $history]} {
3260 set history [lreplace $history $historyindex end $elt]
3262 lappend history $elt
3265 if {$historyindex > 1} {
3266 .ctop.top.bar.leftbut conf -state normal
3268 .ctop.top.bar.leftbut conf -state disabled
3270 .ctop.top.bar.rightbut conf -state disabled
3276 set view [lindex $elt 0]
3277 set cmd [lindex $elt 1]
3278 if {$curview != $view} {
3285 global history historyindex
3287 if {$historyindex > 1} {
3288 incr historyindex -1
3289 godo [lindex $history [expr {$historyindex - 1}]]
3290 .ctop.top.bar.rightbut conf -state normal
3292 if {$historyindex <= 1} {
3293 .ctop.top.bar.leftbut conf -state disabled
3298 global history historyindex
3300 if {$historyindex < [llength $history]} {
3301 set cmd [lindex $history $historyindex]
3304 .ctop.top.bar.leftbut conf -state normal
3306 if {$historyindex >= [llength $history]} {
3307 .ctop.top.bar.rightbut conf -state disabled
3312 global treefilelist treeidlist diffids diffmergeid treepending
3315 catch {unset diffmergeid}
3316 if {![info exists treefilelist($id)]} {
3317 if {![info exists treepending]} {
3318 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3322 set treefilelist($id) {}
3323 set treeidlist($id) {}
3324 fconfigure $gtf -blocking 0
3325 fileevent $gtf readable [list gettreeline $gtf $id]
3332 proc gettreeline {gtf id} {
3333 global treefilelist treeidlist treepending cmitmode diffids
3335 while {[gets $gtf line] >= 0} {
3336 if {[lindex $line 1] ne "blob"} continue
3337 set sha1 [lindex $line 2]
3338 set fname [lindex $line 3]
3339 lappend treefilelist($id) $fname
3340 lappend treeidlist($id) $sha1
3342 if {![eof $gtf]} return
3345 if {$cmitmode ne "tree"} {
3346 if {![info exists diffmergeid]} {
3347 gettreediffs $diffids
3349 } elseif {$id ne $diffids} {
3357 global treefilelist treeidlist diffids
3358 global ctext commentend
3360 set i [lsearch -exact $treefilelist($diffids) $f]
3362 puts "oops, $f not in list for id $diffids"
3365 set blob [lindex $treeidlist($diffids) $i]
3366 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3367 puts "oops, error reading blob $blob: $err"
3370 fconfigure $bf -blocking 0
3371 fileevent $bf readable [list getblobline $bf $diffids]
3372 $ctext config -state normal
3373 $ctext delete $commentend end
3374 $ctext insert end "\n"
3375 $ctext insert end "$f\n" filesep
3376 $ctext config -state disabled
3377 $ctext yview $commentend
3380 proc getblobline {bf id} {
3381 global diffids cmitmode ctext
3383 if {$id ne $diffids || $cmitmode ne "tree"} {
3387 $ctext config -state normal
3388 while {[gets $bf line] >= 0} {
3389 $ctext insert end "$line\n"
3392 # delete last newline
3393 $ctext delete "end - 2c" "end - 1c"
3396 $ctext config -state disabled
3399 proc mergediff {id l} {
3400 global diffmergeid diffopts mdifffd
3406 # this doesn't seem to actually affect anything...
3407 set env(GIT_DIFF_OPTS) $diffopts
3408 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3409 if {[catch {set mdf [open $cmd r]} err]} {
3410 error_popup "Error getting merge diffs: $err"
3413 fconfigure $mdf -blocking 0
3414 set mdifffd($id) $mdf
3415 set np [llength [lindex $parentlist $l]]
3416 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3417 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3420 proc getmergediffline {mdf id np} {
3421 global diffmergeid ctext cflist nextupdate mergemax
3422 global difffilestart mdifffd
3424 set n [gets $mdf line]
3431 if {![info exists diffmergeid] || $id != $diffmergeid
3432 || $mdf != $mdifffd($id)} {
3435 $ctext conf -state normal
3436 if {[regexp {^diff --cc (.*)} $line match fname]} {
3437 # start of a new file
3438 $ctext insert end "\n"
3439 set here [$ctext index "end - 1c"]
3440 $ctext mark set f:$fname $here
3441 $ctext mark gravity f:$fname left
3442 lappend difffilestart $here
3443 add_flist [list $fname]
3444 set l [expr {(78 - [string length $fname]) / 2}]
3445 set pad [string range "----------------------------------------" 1 $l]
3446 $ctext insert end "$pad $fname $pad\n" filesep
3447 } elseif {[regexp {^@@} $line]} {
3448 $ctext insert end "$line\n" hunksep
3449 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3452 # parse the prefix - one ' ', '-' or '+' for each parent
3457 for {set j 0} {$j < $np} {incr j} {
3458 set c [string range $line $j $j]
3461 } elseif {$c == "-"} {
3463 } elseif {$c == "+"} {
3472 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3473 # line doesn't appear in result, parents in $minuses have the line
3474 set num [lindex $minuses 0]
3475 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3476 # line appears in result, parents in $pluses don't have the line
3477 lappend tags mresult
3478 set num [lindex $spaces 0]
3481 if {$num >= $mergemax} {
3486 $ctext insert end "$line\n" $tags
3488 $ctext conf -state disabled
3489 if {[clock clicks -milliseconds] >= $nextupdate} {
3491 fileevent $mdf readable {}
3493 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3497 proc startdiff {ids} {
3498 global treediffs diffids treepending diffmergeid
3501 catch {unset diffmergeid}
3502 if {![info exists treediffs($ids)]} {
3503 if {![info exists treepending]} {
3511 proc addtocflist {ids} {
3512 global treediffs cflist
3513 add_flist $treediffs($ids)
3517 proc gettreediffs {ids} {
3518 global treediff treepending
3519 set treepending $ids
3522 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3524 fconfigure $gdtf -blocking 0
3525 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3528 proc gettreediffline {gdtf ids} {
3529 global treediff treediffs treepending diffids diffmergeid
3532 set n [gets $gdtf line]
3534 if {![eof $gdtf]} return
3536 set treediffs($ids) $treediff
3538 if {$cmitmode eq "tree"} {
3540 } elseif {$ids != $diffids} {
3541 if {![info exists diffmergeid]} {
3542 gettreediffs $diffids
3549 set file [lindex $line 5]
3550 lappend treediff $file
3553 proc getblobdiffs {ids} {
3554 global diffopts blobdifffd diffids env curdifftag curtagstart
3555 global nextupdate diffinhdr treediffs
3557 set env(GIT_DIFF_OPTS) $diffopts
3558 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3559 if {[catch {set bdf [open $cmd r]} err]} {
3560 puts "error getting diffs: $err"
3564 fconfigure $bdf -blocking 0
3565 set blobdifffd($ids) $bdf
3566 set curdifftag Comments
3568 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3569 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3572 proc getblobdiffline {bdf ids} {
3573 global diffids blobdifffd ctext curdifftag curtagstart
3574 global diffnexthead diffnextnote difffilestart
3575 global nextupdate diffinhdr treediffs
3577 set n [gets $bdf line]
3581 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3582 $ctext tag add $curdifftag $curtagstart end
3587 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3590 $ctext conf -state normal
3591 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3592 # start of a new file
3593 $ctext insert end "\n"
3594 $ctext tag add $curdifftag $curtagstart end
3595 set here [$ctext index "end - 1c"]
3596 set curtagstart $here
3598 lappend difffilestart $here
3599 $ctext mark set f:$fname $here
3600 $ctext mark gravity f:$fname left
3601 if {$newname != $fname} {
3602 $ctext mark set f:$newfname $here
3603 $ctext mark gravity f:$newfname left
3605 set curdifftag "f:$fname"
3606 $ctext tag delete $curdifftag
3607 set l [expr {(78 - [string length $header]) / 2}]
3608 set pad [string range "----------------------------------------" 1 $l]
3609 $ctext insert end "$pad $header $pad\n" filesep
3611 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3613 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3615 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3616 $line match f1l f1c f2l f2c rest]} {
3617 $ctext insert end "$line\n" hunksep
3620 set x [string range $line 0 0]
3621 if {$x == "-" || $x == "+"} {
3622 set tag [expr {$x == "+"}]
3623 $ctext insert end "$line\n" d$tag
3624 } elseif {$x == " "} {
3625 $ctext insert end "$line\n"
3626 } elseif {$diffinhdr || $x == "\\"} {
3627 # e.g. "\ No newline at end of file"
3628 $ctext insert end "$line\n" filesep
3630 # Something else we don't recognize
3631 if {$curdifftag != "Comments"} {
3632 $ctext insert end "\n"
3633 $ctext tag add $curdifftag $curtagstart end
3634 set curtagstart [$ctext index "end - 1c"]
3635 set curdifftag Comments
3637 $ctext insert end "$line\n" filesep
3640 $ctext conf -state disabled
3641 if {[clock clicks -milliseconds] >= $nextupdate} {
3643 fileevent $bdf readable {}
3645 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3650 global difffilestart ctext
3651 set here [$ctext index @0,0]
3652 foreach loc $difffilestart {
3653 if {[$ctext compare $loc > $here]} {
3660 global linespc charspc canvx0 canvy0 mainfont
3661 global xspc1 xspc2 lthickness
3663 set linespc [font metrics $mainfont -linespace]
3664 set charspc [font measure $mainfont "m"]
3665 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3666 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3667 set lthickness [expr {int($linespc / 9) + 1}]
3668 set xspc1(0) $linespc
3676 set ymax [lindex [$canv cget -scrollregion] 3]
3677 if {$ymax eq {} || $ymax == 0} return
3678 set span [$canv yview]
3681 allcanvs yview moveto [lindex $span 0]
3683 if {[info exists selectedline]} {
3684 selectline $selectedline 0
3688 proc incrfont {inc} {
3689 global mainfont namefont textfont ctext canv phase
3690 global stopped entries
3692 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3693 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3694 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3696 $ctext conf -font $textfont
3697 $ctext tag conf filesep -font [concat $textfont bold]
3698 foreach e $entries {
3699 $e conf -font $mainfont
3701 if {$phase eq "getcommits"} {
3702 $canv itemconf textitems -font $mainfont
3708 global sha1entry sha1string
3709 if {[string length $sha1string] == 40} {
3710 $sha1entry delete 0 end
3714 proc sha1change {n1 n2 op} {
3715 global sha1string currentid sha1but
3716 if {$sha1string == {}
3717 || ([info exists currentid] && $sha1string == $currentid)} {
3722 if {[$sha1but cget -state] == $state} return
3723 if {$state == "normal"} {
3724 $sha1but conf -state normal -relief raised -text "Goto: "
3726 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3730 proc gotocommit {} {
3731 global sha1string currentid commitrow tagids headids
3732 global displayorder numcommits
3734 if {$sha1string == {}
3735 || ([info exists currentid] && $sha1string == $currentid)} return
3736 if {[info exists tagids($sha1string)]} {
3737 set id $tagids($sha1string)
3738 } elseif {[info exists headids($sha1string)]} {
3739 set id $headids($sha1string)
3741 set id [string tolower $sha1string]
3742 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3744 foreach i $displayorder {
3745 if {[string match $id* $i]} {
3749 if {$matches ne {}} {
3750 if {[llength $matches] > 1} {
3751 error_popup "Short SHA1 id $id is ambiguous"
3754 set id [lindex $matches 0]
3758 if {[info exists commitrow($id)]} {
3759 selectline $commitrow($id) 1
3762 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3767 error_popup "$type $sha1string is not known"
3770 proc lineenter {x y id} {
3771 global hoverx hovery hoverid hovertimer
3772 global commitinfo canv
3774 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3778 if {[info exists hovertimer]} {
3779 after cancel $hovertimer
3781 set hovertimer [after 500 linehover]
3785 proc linemotion {x y id} {
3786 global hoverx hovery hoverid hovertimer
3788 if {[info exists hoverid] && $id == $hoverid} {
3791 if {[info exists hovertimer]} {
3792 after cancel $hovertimer
3794 set hovertimer [after 500 linehover]
3798 proc lineleave {id} {
3799 global hoverid hovertimer canv
3801 if {[info exists hoverid] && $id == $hoverid} {
3803 if {[info exists hovertimer]} {
3804 after cancel $hovertimer
3812 global hoverx hovery hoverid hovertimer
3813 global canv linespc lthickness
3814 global commitinfo mainfont
3816 set text [lindex $commitinfo($hoverid) 0]
3817 set ymax [lindex [$canv cget -scrollregion] 3]
3818 if {$ymax == {}} return
3819 set yfrac [lindex [$canv yview] 0]
3820 set x [expr {$hoverx + 2 * $linespc}]
3821 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3822 set x0 [expr {$x - 2 * $lthickness}]
3823 set y0 [expr {$y - 2 * $lthickness}]
3824 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3825 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3826 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3827 -fill \#ffff80 -outline black -width 1 -tags hover]
3829 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3833 proc clickisonarrow {id y} {
3836 set ranges [rowranges $id]
3837 set thresh [expr {2 * $lthickness + 6}]
3838 set n [expr {[llength $ranges] - 1}]
3839 for {set i 1} {$i < $n} {incr i} {
3840 set row [lindex $ranges $i]
3841 if {abs([yc $row] - $y) < $thresh} {
3848 proc arrowjump {id n y} {
3851 # 1 <-> 2, 3 <-> 4, etc...
3852 set n [expr {(($n - 1) ^ 1) + 1}]
3853 set row [lindex [rowranges $id] $n]
3855 set ymax [lindex [$canv cget -scrollregion] 3]
3856 if {$ymax eq {} || $ymax <= 0} return
3857 set view [$canv yview]
3858 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3859 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3863 allcanvs yview moveto $yfrac
3866 proc lineclick {x y id isnew} {
3867 global ctext commitinfo childlist commitrow canv thickerline
3869 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3874 # draw this line thicker than normal
3878 set ymax [lindex [$canv cget -scrollregion] 3]
3879 if {$ymax eq {}} return
3880 set yfrac [lindex [$canv yview] 0]
3881 set y [expr {$y + $yfrac * $ymax}]
3883 set dirn [clickisonarrow $id $y]
3885 arrowjump $id $dirn $y
3890 addtohistory [list lineclick $x $y $id 0]
3892 # fill the details pane with info about this line
3893 $ctext conf -state normal
3894 $ctext delete 0.0 end
3895 $ctext tag conf link -foreground blue -underline 1
3896 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3897 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3898 $ctext insert end "Parent:\t"
3899 $ctext insert end $id [list link link0]
3900 $ctext tag bind link0 <1> [list selbyid $id]
3901 set info $commitinfo($id)
3902 $ctext insert end "\n\t[lindex $info 0]\n"
3903 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3904 set date [formatdate [lindex $info 2]]
3905 $ctext insert end "\tDate:\t$date\n"
3906 set kids [lindex $childlist $commitrow($id)]
3908 $ctext insert end "\nChildren:"
3910 foreach child $kids {
3912 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3913 set info $commitinfo($child)
3914 $ctext insert end "\n\t"
3915 $ctext insert end $child [list link link$i]
3916 $ctext tag bind link$i <1> [list selbyid $child]
3917 $ctext insert end "\n\t[lindex $info 0]"
3918 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3919 set date [formatdate [lindex $info 2]]
3920 $ctext insert end "\n\tDate:\t$date\n"
3923 $ctext conf -state disabled
3927 proc normalline {} {
3929 if {[info exists thickerline]} {
3938 if {[info exists commitrow($id)]} {
3939 selectline $commitrow($id) 1
3945 if {![info exists startmstime]} {
3946 set startmstime [clock clicks -milliseconds]
3948 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3951 proc rowmenu {x y id} {
3952 global rowctxmenu commitrow selectedline rowmenuid
3954 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3959 $rowctxmenu entryconfigure 0 -state $state
3960 $rowctxmenu entryconfigure 1 -state $state
3961 $rowctxmenu entryconfigure 2 -state $state
3963 tk_popup $rowctxmenu $x $y
3966 proc diffvssel {dirn} {
3967 global rowmenuid selectedline displayorder
3969 if {![info exists selectedline]} return
3971 set oldid [lindex $displayorder $selectedline]
3972 set newid $rowmenuid
3974 set oldid $rowmenuid
3975 set newid [lindex $displayorder $selectedline]
3977 addtohistory [list doseldiff $oldid $newid]
3978 doseldiff $oldid $newid
3981 proc doseldiff {oldid newid} {
3985 $ctext conf -state normal
3986 $ctext delete 0.0 end
3988 $ctext insert end "From "
3989 $ctext tag conf link -foreground blue -underline 1
3990 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3991 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3992 $ctext tag bind link0 <1> [list selbyid $oldid]
3993 $ctext insert end $oldid [list link link0]
3994 $ctext insert end "\n "
3995 $ctext insert end [lindex $commitinfo($oldid) 0]
3996 $ctext insert end "\n\nTo "
3997 $ctext tag bind link1 <1> [list selbyid $newid]
3998 $ctext insert end $newid [list link link1]
3999 $ctext insert end "\n "
4000 $ctext insert end [lindex $commitinfo($newid) 0]
4001 $ctext insert end "\n"
4002 $ctext conf -state disabled
4003 $ctext tag delete Comments
4004 $ctext tag remove found 1.0 end
4005 startdiff [list $oldid $newid]
4009 global rowmenuid currentid commitinfo patchtop patchnum
4011 if {![info exists currentid]} return
4012 set oldid $currentid
4013 set oldhead [lindex $commitinfo($oldid) 0]
4014 set newid $rowmenuid
4015 set newhead [lindex $commitinfo($newid) 0]
4018 catch {destroy $top}
4020 label $top.title -text "Generate patch"
4021 grid $top.title - -pady 10
4022 label $top.from -text "From:"
4023 entry $top.fromsha1 -width 40 -relief flat
4024 $top.fromsha1 insert 0 $oldid
4025 $top.fromsha1 conf -state readonly
4026 grid $top.from $top.fromsha1 -sticky w
4027 entry $top.fromhead -width 60 -relief flat
4028 $top.fromhead insert 0 $oldhead
4029 $top.fromhead conf -state readonly
4030 grid x $top.fromhead -sticky w
4031 label $top.to -text "To:"
4032 entry $top.tosha1 -width 40 -relief flat
4033 $top.tosha1 insert 0 $newid
4034 $top.tosha1 conf -state readonly
4035 grid $top.to $top.tosha1 -sticky w
4036 entry $top.tohead -width 60 -relief flat
4037 $top.tohead insert 0 $newhead
4038 $top.tohead conf -state readonly
4039 grid x $top.tohead -sticky w
4040 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4041 grid $top.rev x -pady 10
4042 label $top.flab -text "Output file:"
4043 entry $top.fname -width 60
4044 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4046 grid $top.flab $top.fname -sticky w
4048 button $top.buts.gen -text "Generate" -command mkpatchgo
4049 button $top.buts.can -text "Cancel" -command mkpatchcan
4050 grid $top.buts.gen $top.buts.can
4051 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4052 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4053 grid $top.buts - -pady 10 -sticky ew
4057 proc mkpatchrev {} {
4060 set oldid [$patchtop.fromsha1 get]
4061 set oldhead [$patchtop.fromhead get]
4062 set newid [$patchtop.tosha1 get]
4063 set newhead [$patchtop.tohead get]
4064 foreach e [list fromsha1 fromhead tosha1 tohead] \
4065 v [list $newid $newhead $oldid $oldhead] {
4066 $patchtop.$e conf -state normal
4067 $patchtop.$e delete 0 end
4068 $patchtop.$e insert 0 $v
4069 $patchtop.$e conf -state readonly
4076 set oldid [$patchtop.fromsha1 get]
4077 set newid [$patchtop.tosha1 get]
4078 set fname [$patchtop.fname get]
4079 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4080 error_popup "Error creating patch: $err"
4082 catch {destroy $patchtop}
4086 proc mkpatchcan {} {
4089 catch {destroy $patchtop}
4094 global rowmenuid mktagtop commitinfo
4098 catch {destroy $top}
4100 label $top.title -text "Create tag"
4101 grid $top.title - -pady 10
4102 label $top.id -text "ID:"
4103 entry $top.sha1 -width 40 -relief flat
4104 $top.sha1 insert 0 $rowmenuid
4105 $top.sha1 conf -state readonly
4106 grid $top.id $top.sha1 -sticky w
4107 entry $top.head -width 60 -relief flat
4108 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4109 $top.head conf -state readonly
4110 grid x $top.head -sticky w
4111 label $top.tlab -text "Tag name:"
4112 entry $top.tag -width 60
4113 grid $top.tlab $top.tag -sticky w
4115 button $top.buts.gen -text "Create" -command mktaggo
4116 button $top.buts.can -text "Cancel" -command mktagcan
4117 grid $top.buts.gen $top.buts.can
4118 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4119 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4120 grid $top.buts - -pady 10 -sticky ew
4125 global mktagtop env tagids idtags
4127 set id [$mktagtop.sha1 get]
4128 set tag [$mktagtop.tag get]
4130 error_popup "No tag name specified"
4133 if {[info exists tagids($tag)]} {
4134 error_popup "Tag \"$tag\" already exists"
4139 set fname [file join $dir "refs/tags" $tag]
4140 set f [open $fname w]
4144 error_popup "Error creating tag: $err"
4148 set tagids($tag) $id
4149 lappend idtags($id) $tag
4153 proc redrawtags {id} {
4154 global canv linehtag commitrow idpos selectedline
4156 if {![info exists commitrow($id)]} return
4157 drawcmitrow $commitrow($id)
4158 $canv delete tag.$id
4159 set xt [eval drawtags $id $idpos($id)]
4160 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
4161 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
4162 selectline $selectedline 0
4169 catch {destroy $mktagtop}
4178 proc writecommit {} {
4179 global rowmenuid wrcomtop commitinfo wrcomcmd
4181 set top .writecommit
4183 catch {destroy $top}
4185 label $top.title -text "Write commit to file"
4186 grid $top.title - -pady 10
4187 label $top.id -text "ID:"
4188 entry $top.sha1 -width 40 -relief flat
4189 $top.sha1 insert 0 $rowmenuid
4190 $top.sha1 conf -state readonly
4191 grid $top.id $top.sha1 -sticky w
4192 entry $top.head -width 60 -relief flat
4193 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4194 $top.head conf -state readonly
4195 grid x $top.head -sticky w
4196 label $top.clab -text "Command:"
4197 entry $top.cmd -width 60 -textvariable wrcomcmd
4198 grid $top.clab $top.cmd -sticky w -pady 10
4199 label $top.flab -text "Output file:"
4200 entry $top.fname -width 60
4201 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4202 grid $top.flab $top.fname -sticky w
4204 button $top.buts.gen -text "Write" -command wrcomgo
4205 button $top.buts.can -text "Cancel" -command wrcomcan
4206 grid $top.buts.gen $top.buts.can
4207 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4208 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4209 grid $top.buts - -pady 10 -sticky ew
4216 set id [$wrcomtop.sha1 get]
4217 set cmd "echo $id | [$wrcomtop.cmd get]"
4218 set fname [$wrcomtop.fname get]
4219 if {[catch {exec sh -c $cmd >$fname &} err]} {
4220 error_popup "Error writing commit: $err"
4222 catch {destroy $wrcomtop}
4229 catch {destroy $wrcomtop}
4233 proc listrefs {id} {
4234 global idtags idheads idotherrefs
4237 if {[info exists idtags($id)]} {
4241 if {[info exists idheads($id)]} {
4245 if {[info exists idotherrefs($id)]} {
4246 set z $idotherrefs($id)
4248 return [list $x $y $z]
4251 proc rereadrefs {} {
4252 global idtags idheads idotherrefs
4254 set refids [concat [array names idtags] \
4255 [array names idheads] [array names idotherrefs]]
4256 foreach id $refids {
4257 if {![info exists ref($id)]} {
4258 set ref($id) [listrefs $id]
4262 set refids [lsort -unique [concat $refids [array names idtags] \
4263 [array names idheads] [array names idotherrefs]]]
4264 foreach id $refids {
4265 set v [listrefs $id]
4266 if {![info exists ref($id)] || $ref($id) != $v} {
4272 proc showtag {tag isnew} {
4273 global ctext tagcontents tagids linknum
4276 addtohistory [list showtag $tag 0]
4278 $ctext conf -state normal
4279 $ctext delete 0.0 end
4281 if {[info exists tagcontents($tag)]} {
4282 set text $tagcontents($tag)
4284 set text "Tag: $tag\nId: $tagids($tag)"
4286 appendwithlinks $text
4287 $ctext conf -state disabled
4298 global maxwidth maxgraphpct diffopts findmergefiles
4299 global oldprefs prefstop
4303 if {[winfo exists $top]} {
4307 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4308 set oldprefs($v) [set $v]
4311 wm title $top "Gitk preferences"
4312 label $top.ldisp -text "Commit list display options"
4313 grid $top.ldisp - -sticky w -pady 10
4314 label $top.spacer -text " "
4315 label $top.maxwidthl -text "Maximum graph width (lines)" \
4317 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4318 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4319 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4321 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4322 grid x $top.maxpctl $top.maxpct -sticky w
4323 checkbutton $top.findm -variable findmergefiles
4324 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4326 grid $top.findm $top.findml - -sticky w
4327 label $top.ddisp -text "Diff display options"
4328 grid $top.ddisp - -sticky w -pady 10
4329 label $top.diffoptl -text "Options for diff program" \
4331 entry $top.diffopt -width 20 -textvariable diffopts
4332 grid x $top.diffoptl $top.diffopt -sticky w
4334 button $top.buts.ok -text "OK" -command prefsok
4335 button $top.buts.can -text "Cancel" -command prefscan
4336 grid $top.buts.ok $top.buts.can
4337 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4338 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4339 grid $top.buts - - -pady 10 -sticky ew
4343 global maxwidth maxgraphpct diffopts findmergefiles
4344 global oldprefs prefstop
4346 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4347 set $v $oldprefs($v)
4349 catch {destroy $prefstop}
4354 global maxwidth maxgraphpct
4355 global oldprefs prefstop
4357 catch {destroy $prefstop}
4359 if {$maxwidth != $oldprefs(maxwidth)
4360 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4365 proc formatdate {d} {
4366 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4369 # This list of encoding names and aliases is distilled from
4370 # http://www.iana.org/assignments/character-sets.
4371 # Not all of them are supported by Tcl.
4372 set encoding_aliases {
4373 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4374 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4375 { ISO-10646-UTF-1 csISO10646UTF1 }
4376 { ISO_646.basic:1983 ref csISO646basic1983 }
4377 { INVARIANT csINVARIANT }
4378 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4379 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4380 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4381 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4382 { NATS-DANO iso-ir-9-1 csNATSDANO }
4383 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4384 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4385 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4386 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4387 { ISO-2022-KR csISO2022KR }
4389 { ISO-2022-JP csISO2022JP }
4390 { ISO-2022-JP-2 csISO2022JP2 }
4391 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4393 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4394 { IT iso-ir-15 ISO646-IT csISO15Italian }
4395 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4396 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4397 { greek7-old iso-ir-18 csISO18Greek7Old }
4398 { latin-greek iso-ir-19 csISO19LatinGreek }
4399 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4400 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4401 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4402 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4403 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4404 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4405 { INIS iso-ir-49 csISO49INIS }
4406 { INIS-8 iso-ir-50 csISO50INIS8 }
4407 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4408 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4409 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4410 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4411 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4412 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4414 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4415 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4416 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4417 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4418 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4419 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4420 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4421 { greek7 iso-ir-88 csISO88Greek7 }
4422 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4423 { iso-ir-90 csISO90 }
4424 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4425 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4426 csISO92JISC62991984b }
4427 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4428 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4429 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4430 csISO95JIS62291984handadd }
4431 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4432 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4433 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4434 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4436 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4437 { T.61-7bit iso-ir-102 csISO102T617bit }
4438 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4439 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4440 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4441 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4442 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4443 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4444 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4445 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4446 arabic csISOLatinArabic }
4447 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4448 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4449 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4450 greek greek8 csISOLatinGreek }
4451 { T.101-G2 iso-ir-128 csISO128T101G2 }
4452 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4454 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4455 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4456 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4457 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4458 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4459 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4460 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4461 csISOLatinCyrillic }
4462 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4463 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4464 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4465 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4466 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4467 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4468 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4469 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4470 { ISO_10367-box iso-ir-155 csISO10367Box }
4471 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4472 { latin-lap lap iso-ir-158 csISO158Lap }
4473 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4474 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4477 { JIS_X0201 X0201 csHalfWidthKatakana }
4478 { KSC5636 ISO646-KR csKSC5636 }
4479 { ISO-10646-UCS-2 csUnicode }
4480 { ISO-10646-UCS-4 csUCS4 }
4481 { DEC-MCS dec csDECMCS }
4482 { hp-roman8 roman8 r8 csHPRoman8 }
4483 { macintosh mac csMacintosh }
4484 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4486 { IBM038 EBCDIC-INT cp038 csIBM038 }
4487 { IBM273 CP273 csIBM273 }
4488 { IBM274 EBCDIC-BE CP274 csIBM274 }
4489 { IBM275 EBCDIC-BR cp275 csIBM275 }
4490 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4491 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4492 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4493 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4494 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4495 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4496 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4497 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4498 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4499 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4500 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4501 { IBM437 cp437 437 csPC8CodePage437 }
4502 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4503 { IBM775 cp775 csPC775Baltic }
4504 { IBM850 cp850 850 csPC850Multilingual }
4505 { IBM851 cp851 851 csIBM851 }
4506 { IBM852 cp852 852 csPCp852 }
4507 { IBM855 cp855 855 csIBM855 }
4508 { IBM857 cp857 857 csIBM857 }
4509 { IBM860 cp860 860 csIBM860 }
4510 { IBM861 cp861 861 cp-is csIBM861 }
4511 { IBM862 cp862 862 csPC862LatinHebrew }
4512 { IBM863 cp863 863 csIBM863 }
4513 { IBM864 cp864 csIBM864 }
4514 { IBM865 cp865 865 csIBM865 }
4515 { IBM866 cp866 866 csIBM866 }
4516 { IBM868 CP868 cp-ar csIBM868 }
4517 { IBM869 cp869 869 cp-gr csIBM869 }
4518 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4519 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4520 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4521 { IBM891 cp891 csIBM891 }
4522 { IBM903 cp903 csIBM903 }
4523 { IBM904 cp904 904 csIBBM904 }
4524 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4525 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4526 { IBM1026 CP1026 csIBM1026 }
4527 { EBCDIC-AT-DE csIBMEBCDICATDE }
4528 { EBCDIC-AT-DE-A csEBCDICATDEA }
4529 { EBCDIC-CA-FR csEBCDICCAFR }
4530 { EBCDIC-DK-NO csEBCDICDKNO }
4531 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4532 { EBCDIC-FI-SE csEBCDICFISE }
4533 { EBCDIC-FI-SE-A csEBCDICFISEA }
4534 { EBCDIC-FR csEBCDICFR }
4535 { EBCDIC-IT csEBCDICIT }
4536 { EBCDIC-PT csEBCDICPT }
4537 { EBCDIC-ES csEBCDICES }
4538 { EBCDIC-ES-A csEBCDICESA }
4539 { EBCDIC-ES-S csEBCDICESS }
4540 { EBCDIC-UK csEBCDICUK }
4541 { EBCDIC-US csEBCDICUS }
4542 { UNKNOWN-8BIT csUnknown8BiT }
4543 { MNEMONIC csMnemonic }
4548 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4549 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4550 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4551 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4552 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4553 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4554 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4555 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4556 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4557 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4558 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4559 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4560 { IBM1047 IBM-1047 }
4561 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4562 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4563 { UNICODE-1-1 csUnicode11 }
4566 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4567 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4569 { ISO-8859-15 ISO_8859-15 Latin-9 }
4570 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4571 { GBK CP936 MS936 windows-936 }
4572 { JIS_Encoding csJISEncoding }
4573 { Shift_JIS MS_Kanji csShiftJIS }
4574 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4576 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4577 { ISO-10646-UCS-Basic csUnicodeASCII }
4578 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4579 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4580 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4581 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4582 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4583 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4584 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4585 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4586 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4587 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4588 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4589 { Ventura-US csVenturaUS }
4590 { Ventura-International csVenturaInternational }
4591 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4592 { PC8-Turkish csPC8Turkish }
4593 { IBM-Symbols csIBMSymbols }
4594 { IBM-Thai csIBMThai }
4595 { HP-Legal csHPLegal }
4596 { HP-Pi-font csHPPiFont }
4597 { HP-Math8 csHPMath8 }
4598 { Adobe-Symbol-Encoding csHPPSMath }
4599 { HP-DeskTop csHPDesktop }
4600 { Ventura-Math csVenturaMath }
4601 { Microsoft-Publishing csMicrosoftPublishing }
4602 { Windows-31J csWindows31J }
4607 proc tcl_encoding {enc} {
4608 global encoding_aliases
4609 set names [encoding names]
4610 set lcnames [string tolower $names]
4611 set enc [string tolower $enc]
4612 set i [lsearch -exact $lcnames $enc]
4614 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4615 if {[regsub {^iso[-_]} $enc iso encx]} {
4616 set i [lsearch -exact $lcnames $encx]
4620 foreach l $encoding_aliases {
4621 set ll [string tolower $l]
4622 if {[lsearch -exact $ll $enc] < 0} continue
4623 # look through the aliases for one that tcl knows about
4625 set i [lsearch -exact $lcnames $e]
4627 if {[regsub {^iso[-_]} $e iso ex]} {
4628 set i [lsearch -exact $lcnames $ex]
4637 return [lindex $names $i]
4644 set diffopts "-U 5 -p"
4645 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4649 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4651 if {$gitencoding == ""} {
4652 set gitencoding "utf-8"
4654 set tclencoding [tcl_encoding $gitencoding]
4655 if {$tclencoding == {}} {
4656 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4659 set mainfont {Helvetica 9}
4660 set textfont {Courier 9}
4661 set uifont {Helvetica 9 bold}
4662 set findmergefiles 0
4670 set flistmode "flat"
4671 set cmitmode "patch"
4673 set colors {green red blue magenta darkgrey brown orange}
4675 catch {source ~/.gitk}
4677 set namefont $mainfont
4679 font create optionfont -family sans-serif -size -12
4683 switch -regexp -- $arg {
4685 "^-d" { set datemode 1 }
4687 lappend revtreeargs $arg
4692 # check that we can find a .git directory somewhere...
4694 if {![file isdirectory $gitdir]} {
4695 error_popup "Cannot find the git directory \"$gitdir\"."
4717 set cmdline_files {}
4719 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4720 set cmdline_files [split $fileargs "\n"]
4721 set n [llength $cmdline_files]
4722 set revtreeargs [lrange $revtreeargs 0 end-$n]
4724 if {[lindex $revtreeargs end] eq "--"} {
4725 set revtreeargs [lrange $revtreeargs 0 end-1]
4728 if {$cmdline_files ne {}} {
4729 # create a view for the files/dirs specified on the command line
4733 set viewname(1) "Command line"
4734 set viewfiles(1) $cmdline_files
4736 .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4737 -variable selectedview -value 1
4738 .bar.view entryconf 2 -state normal
4739 .bar.view entryconf 3 -state normal
4742 if {[info exists permviews]} {
4743 foreach v $permviews {
4746 set viewname($n) [lindex $v 0]
4747 set viewfiles($n) [lindex $v 1]
4749 .bar.view add radiobutton -label $viewname($n) \
4750 -command [list showview $n] -variable selectedview -value $n