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 {^(tags|heads)/(.*)$} $path match type name]} {
300 if {$type == "tags"} {
301 set tagids($name) $id
302 lappend idtags($id) $name
307 set commit [exec git-rev-parse "$id^0"]
308 if {"$commit" != "$id"} {
309 set tagids($name) $commit
310 lappend idtags($commit) $name
314 set tagcontents($name) [exec git-cat-file tag "$id"]
316 } elseif { $type == "heads" } {
317 set headids($name) $id
318 lappend idheads($id) $name
320 set otherrefids($name) $id
321 lappend idotherrefs($id) $name
327 proc error_popup msg {
331 message $w.m -text $msg -justify center -aspect 400
332 pack $w.m -side top -fill x -padx 20 -pady 20
333 button $w.ok -text OK -command "destroy $w"
334 pack $w.ok -side bottom -fill x
335 bind $w <Visibility> "grab $w; focus $w"
336 bind $w <Key-Return> "destroy $w"
341 global canv canv2 canv3 linespc charspc ctext cflist
342 global textfont mainfont uifont
343 global findtype findtypemenu findloc findstring fstring geometry
344 global entries sha1entry sha1string sha1but
345 global maincursor textcursor curtextcursor
346 global rowctxmenu mergemax
349 .bar add cascade -label "File" -menu .bar.file
350 .bar configure -font $uifont
352 .bar.file add command -label "Update" -command updatecommits
353 .bar.file add command -label "Reread references" -command rereadrefs
354 .bar.file add command -label "Quit" -command doquit
355 .bar.file configure -font $uifont
357 .bar add cascade -label "Edit" -menu .bar.edit
358 .bar.edit add command -label "Preferences" -command doprefs
359 .bar.edit configure -font $uifont
360 menu .bar.view -font $uifont
361 .bar add cascade -label "View" -menu .bar.view
362 .bar.view add command -label "New view..." -command newview
363 .bar.view add command -label "Edit view..." -command editview
364 .bar.view add command -label "Delete view" -command delview -state disabled
365 .bar.view add separator
366 .bar.view add radiobutton -label "All files" -command {showview 0} \
367 -variable selectedview -value 0
369 .bar add cascade -label "Help" -menu .bar.help
370 .bar.help add command -label "About gitk" -command about
371 .bar.help add command -label "Key bindings" -command keys
372 .bar.help configure -font $uifont
373 . configure -menu .bar
375 if {![info exists geometry(canv1)]} {
376 set geometry(canv1) [expr {45 * $charspc}]
377 set geometry(canv2) [expr {30 * $charspc}]
378 set geometry(canv3) [expr {15 * $charspc}]
379 set geometry(canvh) [expr {25 * $linespc + 4}]
380 set geometry(ctextw) 80
381 set geometry(ctexth) 30
382 set geometry(cflistw) 30
384 panedwindow .ctop -orient vertical
385 if {[info exists geometry(width)]} {
386 .ctop conf -width $geometry(width) -height $geometry(height)
387 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
388 set geometry(ctexth) [expr {($texth - 8) /
389 [font metrics $textfont -linespace]}]
393 pack .ctop.top.bar -side bottom -fill x
394 set cscroll .ctop.top.csb
395 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
396 pack $cscroll -side right -fill y
397 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
398 pack .ctop.top.clist -side top -fill both -expand 1
400 set canv .ctop.top.clist.canv
401 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
403 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
404 .ctop.top.clist add $canv
405 set canv2 .ctop.top.clist.canv2
406 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
407 -bg white -bd 0 -yscrollincr $linespc
408 .ctop.top.clist add $canv2
409 set canv3 .ctop.top.clist.canv3
410 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
411 -bg white -bd 0 -yscrollincr $linespc
412 .ctop.top.clist add $canv3
413 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
415 set sha1entry .ctop.top.bar.sha1
416 set entries $sha1entry
417 set sha1but .ctop.top.bar.sha1label
418 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
419 -command gotocommit -width 8 -font $uifont
420 $sha1but conf -disabledforeground [$sha1but cget -foreground]
421 pack .ctop.top.bar.sha1label -side left
422 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
423 trace add variable sha1string write sha1change
424 pack $sha1entry -side left -pady 2
426 image create bitmap bm-left -data {
427 #define left_width 16
428 #define left_height 16
429 static unsigned char left_bits[] = {
430 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
431 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
432 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
434 image create bitmap bm-right -data {
435 #define right_width 16
436 #define right_height 16
437 static unsigned char right_bits[] = {
438 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
439 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
440 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
442 button .ctop.top.bar.leftbut -image bm-left -command goback \
443 -state disabled -width 26
444 pack .ctop.top.bar.leftbut -side left -fill y
445 button .ctop.top.bar.rightbut -image bm-right -command goforw \
446 -state disabled -width 26
447 pack .ctop.top.bar.rightbut -side left -fill y
449 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
450 pack .ctop.top.bar.findbut -side left
452 set fstring .ctop.top.bar.findstring
453 lappend entries $fstring
454 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
455 pack $fstring -side left -expand 1 -fill x
457 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
458 findtype Exact IgnCase Regexp]
459 .ctop.top.bar.findtype configure -font $uifont
460 .ctop.top.bar.findtype.menu configure -font $uifont
461 set findloc "All fields"
462 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
463 Comments Author Committer Files Pickaxe
464 .ctop.top.bar.findloc configure -font $uifont
465 .ctop.top.bar.findloc.menu configure -font $uifont
467 pack .ctop.top.bar.findloc -side right
468 pack .ctop.top.bar.findtype -side right
469 # for making sure type==Exact whenever loc==Pickaxe
470 trace add variable findloc write findlocchange
472 panedwindow .ctop.cdet -orient horizontal
474 frame .ctop.cdet.left
475 set ctext .ctop.cdet.left.ctext
476 text $ctext -bg white -state disabled -font $textfont \
477 -width $geometry(ctextw) -height $geometry(ctexth) \
478 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
479 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
480 pack .ctop.cdet.left.sb -side right -fill y
481 pack $ctext -side left -fill both -expand 1
482 .ctop.cdet add .ctop.cdet.left
484 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
485 $ctext tag conf hunksep -fore blue
486 $ctext tag conf d0 -fore red
487 $ctext tag conf d1 -fore "#00a000"
488 $ctext tag conf m0 -fore red
489 $ctext tag conf m1 -fore blue
490 $ctext tag conf m2 -fore green
491 $ctext tag conf m3 -fore purple
492 $ctext tag conf m4 -fore brown
493 $ctext tag conf m5 -fore "#009090"
494 $ctext tag conf m6 -fore magenta
495 $ctext tag conf m7 -fore "#808000"
496 $ctext tag conf m8 -fore "#009000"
497 $ctext tag conf m9 -fore "#ff0080"
498 $ctext tag conf m10 -fore cyan
499 $ctext tag conf m11 -fore "#b07070"
500 $ctext tag conf m12 -fore "#70b0f0"
501 $ctext tag conf m13 -fore "#70f0b0"
502 $ctext tag conf m14 -fore "#f0b070"
503 $ctext tag conf m15 -fore "#ff70b0"
504 $ctext tag conf mmax -fore darkgrey
506 $ctext tag conf mresult -font [concat $textfont bold]
507 $ctext tag conf msep -font [concat $textfont bold]
508 $ctext tag conf found -back yellow
510 frame .ctop.cdet.right
511 set cflist .ctop.cdet.right.cfiles
512 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
513 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
514 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
515 pack .ctop.cdet.right.sb -side right -fill y
516 pack $cflist -side left -fill both -expand 1
517 .ctop.cdet add .ctop.cdet.right
518 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
520 pack .ctop -side top -fill both -expand 1
522 bindall <1> {selcanvline %W %x %y}
523 #bindall <B1-Motion> {selcanvline %W %x %y}
524 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
525 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
526 bindall <2> "canvscan mark %W %x %y"
527 bindall <B2-Motion> "canvscan dragto %W %x %y"
528 bindkey <Home> selfirstline
529 bindkey <End> sellastline
530 bind . <Key-Up> "selnextline -1"
531 bind . <Key-Down> "selnextline 1"
532 bindkey <Key-Right> "goforw"
533 bindkey <Key-Left> "goback"
534 bind . <Key-Prior> "selnextpage -1"
535 bind . <Key-Next> "selnextpage 1"
536 bind . <Control-Home> "allcanvs yview moveto 0.0"
537 bind . <Control-End> "allcanvs yview moveto 1.0"
538 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
539 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
540 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
541 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
542 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
543 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
544 bindkey <Key-space> "$ctext yview scroll 1 pages"
545 bindkey p "selnextline -1"
546 bindkey n "selnextline 1"
549 bindkey i "selnextline -1"
550 bindkey k "selnextline 1"
553 bindkey b "$ctext yview scroll -1 pages"
554 bindkey d "$ctext yview scroll 18 units"
555 bindkey u "$ctext yview scroll -18 units"
556 bindkey / {findnext 1}
557 bindkey <Key-Return> {findnext 0}
560 bind . <Control-q> doquit
561 bind . <Control-f> dofind
562 bind . <Control-g> {findnext 0}
563 bind . <Control-r> findprev
564 bind . <Control-equal> {incrfont 1}
565 bind . <Control-KP_Add> {incrfont 1}
566 bind . <Control-minus> {incrfont -1}
567 bind . <Control-KP_Subtract> {incrfont -1}
568 bind $cflist <<ListboxSelect>> listboxsel
569 bind . <Destroy> {savestuff %W}
570 bind . <Button-1> "click %W"
571 bind $fstring <Key-Return> dofind
572 bind $sha1entry <Key-Return> gotocommit
573 bind $sha1entry <<PasteSelection>> clearsha1
575 set maincursor [. cget -cursor]
576 set textcursor [$ctext cget -cursor]
577 set curtextcursor $textcursor
579 set rowctxmenu .rowctxmenu
580 menu $rowctxmenu -tearoff 0
581 $rowctxmenu add command -label "Diff this -> selected" \
582 -command {diffvssel 0}
583 $rowctxmenu add command -label "Diff selected -> this" \
584 -command {diffvssel 1}
585 $rowctxmenu add command -label "Make patch" -command mkpatch
586 $rowctxmenu add command -label "Create tag" -command mktag
587 $rowctxmenu add command -label "Write commit to file" -command writecommit
590 # mouse-2 makes all windows scan vertically, but only the one
591 # the cursor is in scans horizontally
592 proc canvscan {op w x y} {
593 global canv canv2 canv3
594 foreach c [list $canv $canv2 $canv3] {
603 proc scrollcanv {cscroll f0 f1} {
608 # when we make a key binding for the toplevel, make sure
609 # it doesn't get triggered when that key is pressed in the
610 # find string entry widget.
611 proc bindkey {ev script} {
614 set escript [bind Entry $ev]
615 if {$escript == {}} {
616 set escript [bind Entry <Key>]
619 bind $e $ev "$escript; break"
623 # set the focus back to the toplevel for any click outside
634 global canv canv2 canv3 ctext cflist mainfont textfont uifont
635 global stuffsaved findmergefiles maxgraphpct
637 global viewname viewfiles viewperm nextviewnum
639 if {$stuffsaved} return
640 if {![winfo viewable .]} return
642 set f [open "~/.gitk-new" w]
643 puts $f [list set mainfont $mainfont]
644 puts $f [list set textfont $textfont]
645 puts $f [list set uifont $uifont]
646 puts $f [list set findmergefiles $findmergefiles]
647 puts $f [list set maxgraphpct $maxgraphpct]
648 puts $f [list set maxwidth $maxwidth]
649 puts $f "set geometry(width) [winfo width .ctop]"
650 puts $f "set geometry(height) [winfo height .ctop]"
651 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
652 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
653 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
654 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
655 set wid [expr {([winfo width $ctext] - 8) \
656 / [font measure $textfont "0"]}]
657 puts $f "set geometry(ctextw) $wid"
658 set wid [expr {([winfo width $cflist] - 11) \
659 / [font measure [$cflist cget -font] "0"]}]
660 puts $f "set geometry(cflistw) $wid"
661 puts -nonewline $f "set permviews {"
662 for {set v 0} {$v < $nextviewnum} {incr v} {
664 puts $f "{[list $viewname($v) $viewfiles($v)]}"
669 file rename -force "~/.gitk-new" "~/.gitk"
674 proc resizeclistpanes {win w} {
676 if {[info exists oldwidth($win)]} {
677 set s0 [$win sash coord 0]
678 set s1 [$win sash coord 1]
680 set sash0 [expr {int($w/2 - 2)}]
681 set sash1 [expr {int($w*5/6 - 2)}]
683 set factor [expr {1.0 * $w / $oldwidth($win)}]
684 set sash0 [expr {int($factor * [lindex $s0 0])}]
685 set sash1 [expr {int($factor * [lindex $s1 0])}]
689 if {$sash1 < $sash0 + 20} {
690 set sash1 [expr {$sash0 + 20}]
692 if {$sash1 > $w - 10} {
693 set sash1 [expr {$w - 10}]
694 if {$sash0 > $sash1 - 20} {
695 set sash0 [expr {$sash1 - 20}]
699 $win sash place 0 $sash0 [lindex $s0 1]
700 $win sash place 1 $sash1 [lindex $s1 1]
702 set oldwidth($win) $w
705 proc resizecdetpanes {win w} {
707 if {[info exists oldwidth($win)]} {
708 set s0 [$win sash coord 0]
710 set sash0 [expr {int($w*3/4 - 2)}]
712 set factor [expr {1.0 * $w / $oldwidth($win)}]
713 set sash0 [expr {int($factor * [lindex $s0 0])}]
717 if {$sash0 > $w - 15} {
718 set sash0 [expr {$w - 15}]
721 $win sash place 0 $sash0 [lindex $s0 1]
723 set oldwidth($win) $w
727 global canv canv2 canv3
733 proc bindall {event action} {
734 global canv canv2 canv3
735 bind $canv $event $action
736 bind $canv2 $event $action
737 bind $canv3 $event $action
742 if {[winfo exists $w]} {
747 wm title $w "About gitk"
749 Gitk - a commit viewer for git
751 Copyright © 2005-2006 Paul Mackerras
753 Use and redistribute under the terms of the GNU General Public License} \
754 -justify center -aspect 400
755 pack $w.m -side top -fill x -padx 20 -pady 20
756 button $w.ok -text Close -command "destroy $w"
757 pack $w.ok -side bottom
762 if {[winfo exists $w]} {
767 wm title $w "Gitk key bindings"
772 <Home> Move to first commit
773 <End> Move to last commit
774 <Up>, p, i Move up one commit
775 <Down>, n, k Move down one commit
776 <Left>, z, j Go back in history list
777 <Right>, x, l Go forward in history list
778 <PageUp> Move up one page in commit list
779 <PageDown> Move down one page in commit list
780 <Ctrl-Home> Scroll to top of commit list
781 <Ctrl-End> Scroll to bottom of commit list
782 <Ctrl-Up> Scroll commit list up one line
783 <Ctrl-Down> Scroll commit list down one line
784 <Ctrl-PageUp> Scroll commit list up one page
785 <Ctrl-PageDown> Scroll commit list down one page
786 <Delete>, b Scroll diff view up one page
787 <Backspace> Scroll diff view up one page
788 <Space> Scroll diff view down one page
789 u Scroll diff view up 18 lines
790 d Scroll diff view down 18 lines
792 <Ctrl-G> Move to next find hit
793 <Ctrl-R> Move to previous find hit
794 <Return> Move to next find hit
795 / Move to next find hit, or redo find
796 ? Move to previous find hit
797 f Scroll diff view to next file
798 <Ctrl-KP+> Increase font size
799 <Ctrl-plus> Increase font size
800 <Ctrl-KP-> Decrease font size
801 <Ctrl-minus> Decrease font size
803 -justify left -bg white -border 2 -relief sunken
804 pack $w.m -side top -fill both
805 button $w.ok -text Close -command "destroy $w"
806 pack $w.ok -side bottom
810 global nextviewnum newviewname newviewperm uifont
813 if {[winfo exists $top]} {
817 set newviewname($nextviewnum) "View $nextviewnum"
818 set newviewperm($nextviewnum) 0
819 vieweditor $top $nextviewnum "Gitk view definition"
824 global viewname viewperm newviewname newviewperm
826 set top .gitkvedit-$curview
827 if {[winfo exists $top]} {
831 set newviewname($curview) $viewname($curview)
832 set newviewperm($curview) $viewperm($curview)
833 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
836 proc vieweditor {top n title} {
837 global newviewname newviewperm viewfiles
842 label $top.nl -text "Name" -font $uifont
843 entry $top.name -width 20 -textvariable newviewname($n)
844 grid $top.nl $top.name -sticky w -pady 5
845 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
846 grid $top.perm - -pady 5 -sticky w
847 message $top.l -aspect 500 -font $uifont \
848 -text "Enter files and directories to include, one per line:"
849 grid $top.l - -sticky w
850 text $top.t -width 40 -height 10 -background white
851 if {[info exists viewfiles($n)]} {
852 foreach f $viewfiles($n) {
854 $top.t insert end "\n"
856 $top.t delete {end - 1c} end
857 $top.t mark set insert 0.0
859 grid $top.t - -sticky w -padx 5
861 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
862 button $top.buts.can -text "Cancel" -command [list destroy $top]
863 grid $top.buts.ok $top.buts.can
864 grid columnconfigure $top.buts 0 -weight 1 -uniform a
865 grid columnconfigure $top.buts 1 -weight 1 -uniform a
866 grid $top.buts - -pady 10 -sticky ew
870 proc viewmenuitem {n} {
871 set nmenu [.bar.view index end]
872 set targetcmd [list showview $n]
873 for {set i 6} {$i <= $nmenu} {incr i} {
874 if {[.bar.view entrycget $i -command] eq $targetcmd} {
881 proc newviewok {top n} {
882 global nextviewnum newviewperm newviewname
883 global viewname viewfiles viewperm selectedview curview
886 foreach f [split [$top.t get 0.0 end] "\n"] {
887 set ft [string trim $f]
892 if {![info exists viewfiles($n)]} {
893 # creating a new view
895 set viewname($n) $newviewname($n)
896 set viewperm($n) $newviewperm($n)
897 set viewfiles($n) $files
898 .bar.view add radiobutton -label $viewname($n) \
899 -command [list showview $n] -variable selectedview -value $n
900 after idle showview $n
902 # editing an existing view
903 set viewperm($n) $newviewperm($n)
904 if {$newviewname($n) ne $viewname($n)} {
905 set viewname($n) $newviewname($n)
906 set i [viewmenuitem $n]
908 .bar.view entryconf $i -label $viewname($n)
911 if {$files ne $viewfiles($n)} {
912 set viewfiles($n) $files
913 if {$curview == $n} {
914 after idle updatecommits
922 global curview viewdata viewperm
924 if {$curview == 0} return
925 set i [viewmenuitem $curview]
929 set viewdata($curview) {}
930 set viewperm($curview) 0
938 foreach i [array names $var] {
939 lappend ret $i [set $var\($i\)]
944 proc unflatten {var l} {
954 global curview viewdata viewfiles
955 global displayorder parentlist childlist rowidlist rowoffsets
956 global colormap rowtextx commitrow
957 global numcommits rowrangelist commitlisted idrowranges
958 global selectedline currentid canv canvy0
959 global matchinglines treediffs
960 global pending_select phase
961 global commitidx rowlaidout rowoptim linesegends leftover
962 global commfd nextupdate
965 if {$n == $curview} return
967 if {[info exists selectedline]} {
969 set y [yc $selectedline]
970 set ymax [lindex [$canv cget -scrollregion] 3]
971 set span [$canv yview]
972 set ytop [expr {[lindex $span 0] * $ymax}]
973 set ybot [expr {[lindex $span 1] * $ymax}]
974 if {$ytop < $y && $y < $ybot} {
975 set yscreen [expr {$y - $ytop}]
977 set yscreen [expr {($ybot - $ytop) / 2}]
985 set viewdata($curview) \
986 [list $phase $displayorder $parentlist $childlist $rowidlist \
987 $rowoffsets $rowrangelist $commitlisted \
988 [flatten children] [flatten idrowranges] \
990 $commitidx $rowlaidout $rowoptim $numcommits \
991 $linesegends $leftover $commfd]
992 fileevent $commfd readable {}
993 } elseif {![info exists viewdata($curview)]
994 || [lindex $viewdata($curview) 0] ne {}} {
995 set viewdata($curview) \
996 [list {} $displayorder $parentlist $childlist $rowidlist \
997 $rowoffsets $rowrangelist $commitlisted]
1000 catch {unset matchinglines}
1001 catch {unset treediffs}
1006 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1007 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1009 if {![info exists viewdata($n)]} {
1010 set pending_select $selid
1016 set phase [lindex $v 0]
1017 set displayorder [lindex $v 1]
1018 set parentlist [lindex $v 2]
1019 set childlist [lindex $v 3]
1020 set rowidlist [lindex $v 4]
1021 set rowoffsets [lindex $v 5]
1022 set rowrangelist [lindex $v 6]
1023 set commitlisted [lindex $v 7]
1025 set numcommits [llength $displayorder]
1026 catch {unset idrowranges}
1027 catch {unset children}
1029 unflatten children [lindex $v 8]
1030 unflatten idrowranges [lindex $v 9]
1031 unflatten idinlist [lindex $v 10]
1032 set commitidx [lindex $v 11]
1033 set rowlaidout [lindex $v 12]
1034 set rowoptim [lindex $v 13]
1035 set numcommits [lindex $v 14]
1036 set linesegends [lindex $v 15]
1037 set leftover [lindex $v 16]
1038 set commfd [lindex $v 17]
1039 fileevent $commfd readable [list getcommitlines $commfd]
1040 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1043 catch {unset colormap}
1044 catch {unset rowtextx}
1045 catch {unset commitrow}
1048 foreach id $displayorder {
1049 set commitrow($id) $row
1055 if {$selid ne {} && [info exists commitrow($selid)]} {
1056 set row $commitrow($selid)
1057 # try to get the selected row in the same position on the screen
1058 set ymax [lindex [$canv cget -scrollregion] 3]
1059 set ytop [expr {[yc $row] - $yscreen}]
1063 set yf [expr {$ytop * 1.0 / $ymax}]
1065 allcanvs yview moveto $yf
1069 global maincursor textcursor
1070 . config -cursor $maincursor
1071 settextcursor $textcursor
1073 . config -cursor watch
1075 if {$phase eq "getcommits"} {
1077 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1078 -font $mainfont -tags textitems
1083 proc shortids {ids} {
1086 if {[llength $id] > 1} {
1087 lappend res [shortids $id]
1088 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1089 lappend res [string range $id 0 7]
1097 proc incrange {l x o} {
1100 set e [lindex $l $x]
1102 lset l $x [expr {$e + $o}]
1111 for {} {$n > 0} {incr n -1} {
1117 proc usedinrange {id l1 l2} {
1118 global children commitrow childlist
1120 if {[info exists commitrow($id)]} {
1121 set r $commitrow($id)
1122 if {$l1 <= $r && $r <= $l2} {
1123 return [expr {$r - $l1 + 1}]
1125 set kids [lindex $childlist $r]
1127 set kids $children($id)
1130 set r $commitrow($c)
1131 if {$l1 <= $r && $r <= $l2} {
1132 return [expr {$r - $l1 + 1}]
1138 proc sanity {row {full 0}} {
1139 global rowidlist rowoffsets
1142 set ids [lindex $rowidlist $row]
1145 if {$id eq {}} continue
1146 if {$col < [llength $ids] - 1 &&
1147 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1148 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1150 set o [lindex $rowoffsets $row $col]
1156 if {[lindex $rowidlist $y $x] != $id} {
1157 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1158 puts " id=[shortids $id] check started at row $row"
1159 for {set i $row} {$i >= $y} {incr i -1} {
1160 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1165 set o [lindex $rowoffsets $y $x]
1170 proc makeuparrow {oid x y z} {
1171 global rowidlist rowoffsets uparrowlen idrowranges
1173 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1176 set off0 [lindex $rowoffsets $y]
1177 for {set x0 $x} {1} {incr x0} {
1178 if {$x0 >= [llength $off0]} {
1179 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1182 set z [lindex $off0 $x0]
1188 set z [expr {$x0 - $x}]
1189 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1190 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1192 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1193 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1194 lappend idrowranges($oid) $y
1197 proc initlayout {} {
1198 global rowidlist rowoffsets displayorder commitlisted
1199 global rowlaidout rowoptim
1200 global idinlist rowchk rowrangelist idrowranges
1201 global commitidx numcommits canvxmax canv
1203 global parentlist childlist children
1204 global colormap rowtextx commitrow
1214 catch {unset children}
1218 catch {unset idinlist}
1219 catch {unset rowchk}
1222 set canvxmax [$canv cget -width]
1223 catch {unset colormap}
1224 catch {unset rowtextx}
1225 catch {unset commitrow}
1226 catch {unset idrowranges}
1230 proc setcanvscroll {} {
1231 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1233 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1234 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1235 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1236 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1239 proc visiblerows {} {
1240 global canv numcommits linespc
1242 set ymax [lindex [$canv cget -scrollregion] 3]
1243 if {$ymax eq {} || $ymax == 0} return
1245 set y0 [expr {int([lindex $f 0] * $ymax)}]
1246 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1250 set y1 [expr {int([lindex $f 1] * $ymax)}]
1251 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1252 if {$r1 >= $numcommits} {
1253 set r1 [expr {$numcommits - 1}]
1255 return [list $r0 $r1]
1258 proc layoutmore {} {
1259 global rowlaidout rowoptim commitidx numcommits optim_delay
1263 set rowlaidout [layoutrows $row $commitidx 0]
1264 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1265 if {$orow > $rowoptim} {
1266 optimize_rows $rowoptim 0 $orow
1269 set canshow [expr {$rowoptim - $optim_delay}]
1270 if {$canshow > $numcommits} {
1275 proc showstuff {canshow} {
1276 global numcommits commitrow pending_select selectedline
1277 global linesegends idrowranges idrangedrawn
1279 if {$numcommits == 0} {
1281 set phase "incrdraw"
1285 set numcommits $canshow
1287 set rows [visiblerows]
1288 set r0 [lindex $rows 0]
1289 set r1 [lindex $rows 1]
1291 for {set r $row} {$r < $canshow} {incr r} {
1292 foreach id [lindex $linesegends [expr {$r+1}]] {
1294 foreach {s e} [rowranges $id] {
1296 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1297 && ![info exists idrangedrawn($id,$i)]} {
1299 set idrangedrawn($id,$i) 1
1304 if {$canshow > $r1} {
1307 while {$row < $canshow} {
1311 if {[info exists pending_select] &&
1312 [info exists commitrow($pending_select)] &&
1313 $commitrow($pending_select) < $numcommits} {
1314 selectline $commitrow($pending_select) 1
1316 if {![info exists selectedline] && ![info exists pending_select]} {
1321 proc layoutrows {row endrow last} {
1322 global rowidlist rowoffsets displayorder
1323 global uparrowlen downarrowlen maxwidth mingaplen
1324 global childlist parentlist
1325 global idrowranges linesegends
1327 global idinlist rowchk rowrangelist
1329 set idlist [lindex $rowidlist $row]
1330 set offs [lindex $rowoffsets $row]
1331 while {$row < $endrow} {
1332 set id [lindex $displayorder $row]
1335 foreach p [lindex $parentlist $row] {
1336 if {![info exists idinlist($p)]} {
1338 } elseif {!$idinlist($p)} {
1343 set nev [expr {[llength $idlist] + [llength $newolds]
1344 + [llength $oldolds] - $maxwidth + 1}]
1346 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1347 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1348 set i [lindex $idlist $x]
1349 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1350 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1351 [expr {$row + $uparrowlen + $mingaplen}]]
1353 set idlist [lreplace $idlist $x $x]
1354 set offs [lreplace $offs $x $x]
1355 set offs [incrange $offs $x 1]
1357 set rm1 [expr {$row - 1}]
1359 lappend idrowranges($i) $rm1
1360 if {[incr nev -1] <= 0} break
1363 set rowchk($id) [expr {$row + $r}]
1366 lset rowidlist $row $idlist
1367 lset rowoffsets $row $offs
1369 lappend linesegends $lse
1370 set col [lsearch -exact $idlist $id]
1372 set col [llength $idlist]
1374 lset rowidlist $row $idlist
1376 if {[lindex $childlist $row] ne {}} {
1377 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1381 lset rowoffsets $row $offs
1383 makeuparrow $id $col $row $z
1389 if {[info exists idrowranges($id)]} {
1390 set ranges $idrowranges($id)
1392 unset idrowranges($id)
1394 lappend rowrangelist $ranges
1396 set offs [ntimes [llength $idlist] 0]
1397 set l [llength $newolds]
1398 set idlist [eval lreplace \$idlist $col $col $newolds]
1401 set offs [lrange $offs 0 [expr {$col - 1}]]
1402 foreach x $newolds {
1407 set tmp [expr {[llength $idlist] - [llength $offs]}]
1409 set offs [concat $offs [ntimes $tmp $o]]
1414 foreach i $newolds {
1416 set idrowranges($i) $row
1419 foreach oid $oldolds {
1420 set idinlist($oid) 1
1421 set idlist [linsert $idlist $col $oid]
1422 set offs [linsert $offs $col $o]
1423 makeuparrow $oid $col $row $o
1426 lappend rowidlist $idlist
1427 lappend rowoffsets $offs
1432 proc addextraid {id row} {
1433 global displayorder commitrow commitinfo
1434 global commitidx commitlisted
1435 global parentlist childlist children
1438 lappend displayorder $id
1439 lappend commitlisted 0
1440 lappend parentlist {}
1441 set commitrow($id) $row
1443 if {![info exists commitinfo($id)]} {
1444 set commitinfo($id) {"No commit information available"}
1446 if {[info exists children($id)]} {
1447 lappend childlist $children($id)
1450 lappend childlist {}
1454 proc layouttail {} {
1455 global rowidlist rowoffsets idinlist commitidx
1456 global idrowranges rowrangelist
1459 set idlist [lindex $rowidlist $row]
1460 while {$idlist ne {}} {
1461 set col [expr {[llength $idlist] - 1}]
1462 set id [lindex $idlist $col]
1465 lappend idrowranges($id) $row
1466 lappend rowrangelist $idrowranges($id)
1467 unset idrowranges($id)
1469 set offs [ntimes $col 0]
1470 set idlist [lreplace $idlist $col $col]
1471 lappend rowidlist $idlist
1472 lappend rowoffsets $offs
1475 foreach id [array names idinlist] {
1477 lset rowidlist $row [list $id]
1478 lset rowoffsets $row 0
1479 makeuparrow $id 0 $row 0
1480 lappend idrowranges($id) $row
1481 lappend rowrangelist $idrowranges($id)
1482 unset idrowranges($id)
1484 lappend rowidlist {}
1485 lappend rowoffsets {}
1489 proc insert_pad {row col npad} {
1490 global rowidlist rowoffsets
1492 set pad [ntimes $npad {}]
1493 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1494 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1495 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1498 proc optimize_rows {row col endrow} {
1499 global rowidlist rowoffsets idrowranges displayorder
1501 for {} {$row < $endrow} {incr row} {
1502 set idlist [lindex $rowidlist $row]
1503 set offs [lindex $rowoffsets $row]
1505 for {} {$col < [llength $offs]} {incr col} {
1506 if {[lindex $idlist $col] eq {}} {
1510 set z [lindex $offs $col]
1511 if {$z eq {}} continue
1513 set x0 [expr {$col + $z}]
1514 set y0 [expr {$row - 1}]
1515 set z0 [lindex $rowoffsets $y0 $x0]
1517 set id [lindex $idlist $col]
1518 set ranges [rowranges $id]
1519 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1523 if {$z < -1 || ($z < 0 && $isarrow)} {
1524 set npad [expr {-1 - $z + $isarrow}]
1525 set offs [incrange $offs $col $npad]
1526 insert_pad $y0 $x0 $npad
1528 optimize_rows $y0 $x0 $row
1530 set z [lindex $offs $col]
1531 set x0 [expr {$col + $z}]
1532 set z0 [lindex $rowoffsets $y0 $x0]
1533 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1534 set npad [expr {$z - 1 + $isarrow}]
1535 set y1 [expr {$row + 1}]
1536 set offs2 [lindex $rowoffsets $y1]
1540 if {$z eq {} || $x1 + $z < $col} continue
1541 if {$x1 + $z > $col} {
1544 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1547 set pad [ntimes $npad {}]
1548 set idlist [eval linsert \$idlist $col $pad]
1549 set tmp [eval linsert \$offs $col $pad]
1551 set offs [incrange $tmp $col [expr {-$npad}]]
1552 set z [lindex $offs $col]
1555 if {$z0 eq {} && !$isarrow} {
1556 # this line links to its first child on row $row-2
1557 set rm2 [expr {$row - 2}]
1558 set id [lindex $displayorder $rm2]
1559 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1561 set z0 [expr {$xc - $x0}]
1564 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1565 insert_pad $y0 $x0 1
1566 set offs [incrange $offs $col 1]
1567 optimize_rows $y0 [expr {$x0 + 1}] $row
1572 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1573 set o [lindex $offs $col]
1575 # check if this is the link to the first child
1576 set id [lindex $idlist $col]
1577 set ranges [rowranges $id]
1578 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1579 # it is, work out offset to child
1580 set y0 [expr {$row - 1}]
1581 set id [lindex $displayorder $y0]
1582 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1584 set o [expr {$x0 - $col}]
1588 if {$o eq {} || $o <= 0} break
1590 if {$o ne {} && [incr col] < [llength $idlist]} {
1591 set y1 [expr {$row + 1}]
1592 set offs2 [lindex $rowoffsets $y1]
1596 if {$z eq {} || $x1 + $z < $col} continue
1597 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1600 set idlist [linsert $idlist $col {}]
1601 set tmp [linsert $offs $col {}]
1603 set offs [incrange $tmp $col -1]
1606 lset rowidlist $row $idlist
1607 lset rowoffsets $row $offs
1613 global canvx0 linespc
1614 return [expr {$canvx0 + $col * $linespc}]
1618 global canvy0 linespc
1619 return [expr {$canvy0 + $row * $linespc}]
1622 proc linewidth {id} {
1623 global thickerline lthickness
1626 if {[info exists thickerline] && $id eq $thickerline} {
1627 set wid [expr {2 * $lthickness}]
1632 proc rowranges {id} {
1633 global phase idrowranges commitrow rowlaidout rowrangelist
1637 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1638 set ranges [lindex $rowrangelist $commitrow($id)]
1639 } elseif {[info exists idrowranges($id)]} {
1640 set ranges $idrowranges($id)
1645 proc drawlineseg {id i} {
1646 global rowoffsets rowidlist
1648 global canv colormap linespc
1649 global numcommits commitrow
1651 set ranges [rowranges $id]
1653 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1654 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1658 set startrow [lindex $ranges [expr {2 * $i}]]
1659 set row [lindex $ranges [expr {2 * $i + 1}]]
1660 if {$startrow == $row} return
1663 set col [lsearch -exact [lindex $rowidlist $row] $id]
1665 puts "oops: drawline: id $id not on row $row"
1671 set o [lindex $rowoffsets $row $col]
1674 # changing direction
1675 set x [xc $row $col]
1677 lappend coords $x $y
1683 set x [xc $row $col]
1685 lappend coords $x $y
1687 # draw the link to the first child as part of this line
1689 set child [lindex $displayorder $row]
1690 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1692 set x [xc $row $ccol]
1694 if {$ccol < $col - 1} {
1695 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1696 } elseif {$ccol > $col + 1} {
1697 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1699 lappend coords $x $y
1702 if {[llength $coords] < 4} return
1704 # This line has an arrow at the lower end: check if the arrow is
1705 # on a diagonal segment, and if so, work around the Tk 8.4
1706 # refusal to draw arrows on diagonal lines.
1707 set x0 [lindex $coords 0]
1708 set x1 [lindex $coords 2]
1710 set y0 [lindex $coords 1]
1711 set y1 [lindex $coords 3]
1712 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1713 # we have a nearby vertical segment, just trim off the diag bit
1714 set coords [lrange $coords 2 end]
1716 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1717 set xi [expr {$x0 - $slope * $linespc / 2}]
1718 set yi [expr {$y0 - $linespc / 2}]
1719 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1723 set arrow [expr {2 * ($i > 0) + $downarrow}]
1724 set arrow [lindex {none first last both} $arrow]
1725 set t [$canv create line $coords -width [linewidth $id] \
1726 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1731 proc drawparentlinks {id row col olds} {
1732 global rowidlist canv colormap
1734 set row2 [expr {$row + 1}]
1735 set x [xc $row $col]
1738 set ids [lindex $rowidlist $row2]
1739 # rmx = right-most X coord used
1742 set i [lsearch -exact $ids $p]
1744 puts "oops, parent $p of $id not in list"
1747 set x2 [xc $row2 $i]
1751 set ranges [rowranges $p]
1752 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1753 && $row2 < [lindex $ranges 1]} {
1754 # drawlineseg will do this one for us
1758 # should handle duplicated parents here...
1759 set coords [list $x $y]
1760 if {$i < $col - 1} {
1761 lappend coords [xc $row [expr {$i + 1}]] $y
1762 } elseif {$i > $col + 1} {
1763 lappend coords [xc $row [expr {$i - 1}]] $y
1765 lappend coords $x2 $y2
1766 set t [$canv create line $coords -width [linewidth $p] \
1767 -fill $colormap($p) -tags lines.$p]
1774 proc drawlines {id} {
1775 global colormap canv
1777 global childlist iddrawn commitrow rowidlist
1779 $canv delete lines.$id
1780 set nr [expr {[llength [rowranges $id]] / 2}]
1781 for {set i 0} {$i < $nr} {incr i} {
1782 if {[info exists idrangedrawn($id,$i)]} {
1786 foreach child [lindex $childlist $commitrow($id)] {
1787 if {[info exists iddrawn($child)]} {
1788 set row $commitrow($child)
1789 set col [lsearch -exact [lindex $rowidlist $row] $child]
1791 drawparentlinks $child $row $col [list $id]
1797 proc drawcmittext {id row col rmx} {
1798 global linespc canv canv2 canv3 canvy0
1799 global commitlisted commitinfo rowidlist
1800 global rowtextx idpos idtags idheads idotherrefs
1801 global linehtag linentag linedtag
1802 global mainfont namefont canvxmax
1804 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1805 set x [xc $row $col]
1807 set orad [expr {$linespc / 3}]
1808 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1809 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1810 -fill $ofill -outline black -width 1]
1812 $canv bind $t <1> {selcanvline {} %x %y}
1813 set xt [xc $row [llength [lindex $rowidlist $row]]]
1817 set rowtextx($row) $xt
1818 set idpos($id) [list $x $xt $y]
1819 if {[info exists idtags($id)] || [info exists idheads($id)]
1820 || [info exists idotherrefs($id)]} {
1821 set xt [drawtags $id $x $xt $y]
1823 set headline [lindex $commitinfo($id) 0]
1824 set name [lindex $commitinfo($id) 1]
1825 set date [lindex $commitinfo($id) 2]
1826 set date [formatdate $date]
1827 set linehtag($row) [$canv create text $xt $y -anchor w \
1828 -text $headline -font $mainfont ]
1829 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1830 set linentag($row) [$canv2 create text 3 $y -anchor w \
1831 -text $name -font $namefont]
1832 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1833 -text $date -font $mainfont]
1834 set xr [expr {$xt + [font measure $mainfont $headline]}]
1835 if {$xr > $canvxmax} {
1841 proc drawcmitrow {row} {
1842 global displayorder rowidlist
1843 global idrangedrawn iddrawn
1844 global commitinfo parentlist numcommits
1846 if {$row >= $numcommits} return
1847 foreach id [lindex $rowidlist $row] {
1848 if {$id eq {}} continue
1850 foreach {s e} [rowranges $id] {
1852 if {$row < $s} continue
1855 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1857 set idrangedrawn($id,$i) 1
1864 set id [lindex $displayorder $row]
1865 if {[info exists iddrawn($id)]} return
1866 set col [lsearch -exact [lindex $rowidlist $row] $id]
1868 puts "oops, row $row id $id not in list"
1871 if {![info exists commitinfo($id)]} {
1875 set olds [lindex $parentlist $row]
1877 set rmx [drawparentlinks $id $row $col $olds]
1881 drawcmittext $id $row $col $rmx
1885 proc drawfrac {f0 f1} {
1886 global numcommits canv
1889 set ymax [lindex [$canv cget -scrollregion] 3]
1890 if {$ymax eq {} || $ymax == 0} return
1891 set y0 [expr {int($f0 * $ymax)}]
1892 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1896 set y1 [expr {int($f1 * $ymax)}]
1897 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1898 if {$endrow >= $numcommits} {
1899 set endrow [expr {$numcommits - 1}]
1901 for {} {$row <= $endrow} {incr row} {
1906 proc drawvisible {} {
1908 eval drawfrac [$canv yview]
1911 proc clear_display {} {
1912 global iddrawn idrangedrawn
1915 catch {unset iddrawn}
1916 catch {unset idrangedrawn}
1919 proc findcrossings {id} {
1920 global rowidlist parentlist numcommits rowoffsets displayorder
1924 foreach {s e} [rowranges $id] {
1925 if {$e >= $numcommits} {
1926 set e [expr {$numcommits - 1}]
1928 if {$e <= $s} continue
1929 set x [lsearch -exact [lindex $rowidlist $e] $id]
1931 puts "findcrossings: oops, no [shortids $id] in row $e"
1934 for {set row $e} {[incr row -1] >= $s} {} {
1935 set olds [lindex $parentlist $row]
1936 set kid [lindex $displayorder $row]
1937 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1938 if {$kidx < 0} continue
1939 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1941 set px [lsearch -exact $nextrow $p]
1942 if {$px < 0} continue
1943 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1944 if {[lsearch -exact $ccross $p] >= 0} continue
1945 if {$x == $px + ($kidx < $px? -1: 1)} {
1947 } elseif {[lsearch -exact $cross $p] < 0} {
1952 set inc [lindex $rowoffsets $row $x]
1953 if {$inc eq {}} break
1957 return [concat $ccross {{}} $cross]
1960 proc assigncolor {id} {
1961 global colormap colors nextcolor
1962 global commitrow parentlist children childlist
1964 if {[info exists colormap($id)]} return
1965 set ncolors [llength $colors]
1966 if {[info exists commitrow($id)]} {
1967 set kids [lindex $childlist $commitrow($id)]
1968 } elseif {[info exists children($id)]} {
1969 set kids $children($id)
1973 if {[llength $kids] == 1} {
1974 set child [lindex $kids 0]
1975 if {[info exists colormap($child)]
1976 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1977 set colormap($id) $colormap($child)
1983 foreach x [findcrossings $id] {
1985 # delimiter between corner crossings and other crossings
1986 if {[llength $badcolors] >= $ncolors - 1} break
1987 set origbad $badcolors
1989 if {[info exists colormap($x)]
1990 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1991 lappend badcolors $colormap($x)
1994 if {[llength $badcolors] >= $ncolors} {
1995 set badcolors $origbad
1997 set origbad $badcolors
1998 if {[llength $badcolors] < $ncolors - 1} {
1999 foreach child $kids {
2000 if {[info exists colormap($child)]
2001 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2002 lappend badcolors $colormap($child)
2004 foreach p [lindex $parentlist $commitrow($child)] {
2005 if {[info exists colormap($p)]
2006 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2007 lappend badcolors $colormap($p)
2011 if {[llength $badcolors] >= $ncolors} {
2012 set badcolors $origbad
2015 for {set i 0} {$i <= $ncolors} {incr i} {
2016 set c [lindex $colors $nextcolor]
2017 if {[incr nextcolor] >= $ncolors} {
2020 if {[lsearch -exact $badcolors $c]} break
2022 set colormap($id) $c
2025 proc bindline {t id} {
2028 $canv bind $t <Enter> "lineenter %x %y $id"
2029 $canv bind $t <Motion> "linemotion %x %y $id"
2030 $canv bind $t <Leave> "lineleave $id"
2031 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2034 proc drawtags {id x xt y1} {
2035 global idtags idheads idotherrefs
2036 global linespc lthickness
2037 global canv mainfont commitrow rowtextx
2042 if {[info exists idtags($id)]} {
2043 set marks $idtags($id)
2044 set ntags [llength $marks]
2046 if {[info exists idheads($id)]} {
2047 set marks [concat $marks $idheads($id)]
2048 set nheads [llength $idheads($id)]
2050 if {[info exists idotherrefs($id)]} {
2051 set marks [concat $marks $idotherrefs($id)]
2057 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2058 set yt [expr {$y1 - 0.5 * $linespc}]
2059 set yb [expr {$yt + $linespc - 1}]
2062 foreach tag $marks {
2063 set wid [font measure $mainfont $tag]
2066 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2068 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2069 -width $lthickness -fill black -tags tag.$id]
2071 foreach tag $marks x $xvals wid $wvals {
2072 set xl [expr {$x + $delta}]
2073 set xr [expr {$x + $delta + $wid + $lthickness}]
2074 if {[incr ntags -1] >= 0} {
2076 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2077 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2078 -width 1 -outline black -fill yellow -tags tag.$id]
2079 $canv bind $t <1> [list showtag $tag 1]
2080 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2082 # draw a head or other ref
2083 if {[incr nheads -1] >= 0} {
2088 set xl [expr {$xl - $delta/2}]
2089 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2090 -width 1 -outline black -fill $col -tags tag.$id
2092 set t [$canv create text $xl $y1 -anchor w -text $tag \
2093 -font $mainfont -tags tag.$id]
2095 $canv bind $t <1> [list showtag $tag 1]
2101 proc xcoord {i level ln} {
2102 global canvx0 xspc1 xspc2
2104 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2105 if {$i > 0 && $i == $level} {
2106 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2107 } elseif {$i > $level} {
2108 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2113 proc finishcommits {} {
2114 global commitidx phase
2115 global canv mainfont ctext maincursor textcursor
2116 global findinprogress pending_select
2118 if {$commitidx > 0} {
2122 $canv create text 3 3 -anchor nw -text "No commits selected" \
2123 -font $mainfont -tags textitems
2125 if {![info exists findinprogress]} {
2126 . config -cursor $maincursor
2127 settextcursor $textcursor
2130 catch {unset pending_select}
2133 # Don't change the text pane cursor if it is currently the hand cursor,
2134 # showing that we are over a sha1 ID link.
2135 proc settextcursor {c} {
2136 global ctext curtextcursor
2138 if {[$ctext cget -cursor] == $curtextcursor} {
2139 $ctext config -cursor $c
2141 set curtextcursor $c
2147 global canvy0 numcommits linespc
2148 global rowlaidout commitidx
2149 global pending_select
2152 layoutrows $rowlaidout $commitidx 1
2154 optimize_rows $row 0 $commitidx
2155 showstuff $commitidx
2156 if {[info exists pending_select]} {
2160 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2161 #puts "overall $drawmsecs ms for $numcommits commits"
2164 proc findmatches {f} {
2165 global findtype foundstring foundstrlen
2166 if {$findtype == "Regexp"} {
2167 set matches [regexp -indices -all -inline $foundstring $f]
2169 if {$findtype == "IgnCase"} {
2170 set str [string tolower $f]
2176 while {[set j [string first $foundstring $str $i]] >= 0} {
2177 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2178 set i [expr {$j + $foundstrlen}]
2185 global findtype findloc findstring markedmatches commitinfo
2186 global numcommits displayorder linehtag linentag linedtag
2187 global mainfont namefont canv canv2 canv3 selectedline
2188 global matchinglines foundstring foundstrlen matchstring
2194 set matchinglines {}
2195 if {$findloc == "Pickaxe"} {
2199 if {$findtype == "IgnCase"} {
2200 set foundstring [string tolower $findstring]
2202 set foundstring $findstring
2204 set foundstrlen [string length $findstring]
2205 if {$foundstrlen == 0} return
2206 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2207 set matchstring "*$matchstring*"
2208 if {$findloc == "Files"} {
2212 if {![info exists selectedline]} {
2215 set oldsel $selectedline
2218 set fldtypes {Headline Author Date Committer CDate Comment}
2220 foreach id $displayorder {
2221 set d $commitdata($id)
2223 if {$findtype == "Regexp"} {
2224 set doesmatch [regexp $foundstring $d]
2225 } elseif {$findtype == "IgnCase"} {
2226 set doesmatch [string match -nocase $matchstring $d]
2228 set doesmatch [string match $matchstring $d]
2230 if {!$doesmatch} continue
2231 if {![info exists commitinfo($id)]} {
2234 set info $commitinfo($id)
2236 foreach f $info ty $fldtypes {
2237 if {$findloc != "All fields" && $findloc != $ty} {
2240 set matches [findmatches $f]
2241 if {$matches == {}} continue
2243 if {$ty == "Headline"} {
2245 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2246 } elseif {$ty == "Author"} {
2248 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2249 } elseif {$ty == "Date"} {
2251 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2255 lappend matchinglines $l
2256 if {!$didsel && $l > $oldsel} {
2262 if {$matchinglines == {}} {
2264 } elseif {!$didsel} {
2265 findselectline [lindex $matchinglines 0]
2269 proc findselectline {l} {
2270 global findloc commentend ctext
2272 if {$findloc == "All fields" || $findloc == "Comments"} {
2273 # highlight the matches in the comments
2274 set f [$ctext get 1.0 $commentend]
2275 set matches [findmatches $f]
2276 foreach match $matches {
2277 set start [lindex $match 0]
2278 set end [expr {[lindex $match 1] + 1}]
2279 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2284 proc findnext {restart} {
2285 global matchinglines selectedline
2286 if {![info exists matchinglines]} {
2292 if {![info exists selectedline]} return
2293 foreach l $matchinglines {
2294 if {$l > $selectedline} {
2303 global matchinglines selectedline
2304 if {![info exists matchinglines]} {
2308 if {![info exists selectedline]} return
2310 foreach l $matchinglines {
2311 if {$l >= $selectedline} break
2315 findselectline $prev
2321 proc findlocchange {name ix op} {
2322 global findloc findtype findtypemenu
2323 if {$findloc == "Pickaxe"} {
2329 $findtypemenu entryconf 1 -state $state
2330 $findtypemenu entryconf 2 -state $state
2333 proc stopfindproc {{done 0}} {
2334 global findprocpid findprocfile findids
2335 global ctext findoldcursor phase maincursor textcursor
2336 global findinprogress
2338 catch {unset findids}
2339 if {[info exists findprocpid]} {
2341 catch {exec kill $findprocpid}
2343 catch {close $findprocfile}
2346 if {[info exists findinprogress]} {
2347 unset findinprogress
2349 . config -cursor $maincursor
2350 settextcursor $textcursor
2355 proc findpatches {} {
2356 global findstring selectedline numcommits
2357 global findprocpid findprocfile
2358 global finddidsel ctext displayorder findinprogress
2359 global findinsertpos
2361 if {$numcommits == 0} return
2363 # make a list of all the ids to search, starting at the one
2364 # after the selected line (if any)
2365 if {[info exists selectedline]} {
2371 for {set i 0} {$i < $numcommits} {incr i} {
2372 if {[incr l] >= $numcommits} {
2375 append inputids [lindex $displayorder $l] "\n"
2379 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2382 error_popup "Error starting search process: $err"
2386 set findinsertpos end
2388 set findprocpid [pid $f]
2389 fconfigure $f -blocking 0
2390 fileevent $f readable readfindproc
2392 . config -cursor watch
2394 set findinprogress 1
2397 proc readfindproc {} {
2398 global findprocfile finddidsel
2399 global commitrow matchinglines findinsertpos
2401 set n [gets $findprocfile line]
2403 if {[eof $findprocfile]} {
2411 if {![regexp {^[0-9a-f]{40}} $line id]} {
2412 error_popup "Can't parse git-diff-tree output: $line"
2416 if {![info exists commitrow($id)]} {
2417 puts stderr "spurious id: $id"
2420 set l $commitrow($id)
2424 proc insertmatch {l id} {
2425 global matchinglines findinsertpos finddidsel
2427 if {$findinsertpos == "end"} {
2428 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2429 set matchinglines [linsert $matchinglines 0 $l]
2432 lappend matchinglines $l
2435 set matchinglines [linsert $matchinglines $findinsertpos $l]
2446 global selectedline numcommits displayorder ctext
2447 global ffileline finddidsel parentlist
2448 global findinprogress findstartline findinsertpos
2449 global treediffs fdiffid fdiffsneeded fdiffpos
2450 global findmergefiles
2452 if {$numcommits == 0} return
2454 if {[info exists selectedline]} {
2455 set l [expr {$selectedline + 1}]
2460 set findstartline $l
2464 set id [lindex $displayorder $l]
2465 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2466 if {![info exists treediffs($id)]} {
2467 append diffsneeded "$id\n"
2468 lappend fdiffsneeded $id
2471 if {[incr l] >= $numcommits} {
2474 if {$l == $findstartline} break
2477 # start off a git-diff-tree process if needed
2478 if {$diffsneeded ne {}} {
2480 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2482 error_popup "Error starting search process: $err"
2485 catch {unset fdiffid}
2487 fconfigure $df -blocking 0
2488 fileevent $df readable [list readfilediffs $df]
2492 set findinsertpos end
2493 set id [lindex $displayorder $l]
2494 . config -cursor watch
2496 set findinprogress 1
2501 proc readfilediffs {df} {
2502 global findid fdiffid fdiffs
2504 set n [gets $df line]
2508 if {[catch {close $df} err]} {
2511 error_popup "Error in git-diff-tree: $err"
2512 } elseif {[info exists findid]} {
2516 error_popup "Couldn't find diffs for $id"
2521 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2522 # start of a new string of diffs
2526 } elseif {[string match ":*" $line]} {
2527 lappend fdiffs [lindex $line 5]
2531 proc donefilediff {} {
2532 global fdiffid fdiffs treediffs findid
2533 global fdiffsneeded fdiffpos
2535 if {[info exists fdiffid]} {
2536 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2537 && $fdiffpos < [llength $fdiffsneeded]} {
2538 # git-diff-tree doesn't output anything for a commit
2539 # which doesn't change anything
2540 set nullid [lindex $fdiffsneeded $fdiffpos]
2541 set treediffs($nullid) {}
2542 if {[info exists findid] && $nullid eq $findid} {
2550 if {![info exists treediffs($fdiffid)]} {
2551 set treediffs($fdiffid) $fdiffs
2553 if {[info exists findid] && $fdiffid eq $findid} {
2561 global findid treediffs parentlist
2562 global ffileline findstartline finddidsel
2563 global displayorder numcommits matchinglines findinprogress
2564 global findmergefiles
2568 set id [lindex $displayorder $l]
2569 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2570 if {![info exists treediffs($id)]} {
2576 foreach f $treediffs($id) {
2577 set x [findmatches $f]
2587 if {[incr l] >= $numcommits} {
2590 if {$l == $findstartline} break
2598 # mark a commit as matching by putting a yellow background
2599 # behind the headline
2600 proc markheadline {l id} {
2601 global canv mainfont linehtag
2604 set bbox [$canv bbox $linehtag($l)]
2605 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2609 # mark the bits of a headline, author or date that match a find string
2610 proc markmatches {canv l str tag matches font} {
2611 set bbox [$canv bbox $tag]
2612 set x0 [lindex $bbox 0]
2613 set y0 [lindex $bbox 1]
2614 set y1 [lindex $bbox 3]
2615 foreach match $matches {
2616 set start [lindex $match 0]
2617 set end [lindex $match 1]
2618 if {$start > $end} continue
2619 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2620 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2621 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2622 [expr {$x0+$xlen+2}] $y1 \
2623 -outline {} -tags matches -fill yellow]
2628 proc unmarkmatches {} {
2629 global matchinglines findids
2630 allcanvs delete matches
2631 catch {unset matchinglines}
2632 catch {unset findids}
2635 proc selcanvline {w x y} {
2636 global canv canvy0 ctext linespc
2638 set ymax [lindex [$canv cget -scrollregion] 3]
2639 if {$ymax == {}} return
2640 set yfrac [lindex [$canv yview] 0]
2641 set y [expr {$y + $yfrac * $ymax}]
2642 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2647 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2653 proc commit_descriptor {p} {
2656 if {[info exists commitinfo($p)]} {
2657 set l [lindex $commitinfo($p) 0]
2662 # append some text to the ctext widget, and make any SHA1 ID
2663 # that we know about be a clickable link.
2664 proc appendwithlinks {text} {
2665 global ctext commitrow linknum
2667 set start [$ctext index "end - 1c"]
2668 $ctext insert end $text
2669 $ctext insert end "\n"
2670 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2674 set linkid [string range $text $s $e]
2675 if {![info exists commitrow($linkid)]} continue
2677 $ctext tag add link "$start + $s c" "$start + $e c"
2678 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2679 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2682 $ctext tag conf link -foreground blue -underline 1
2683 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2684 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2687 proc viewnextline {dir} {
2691 set ymax [lindex [$canv cget -scrollregion] 3]
2692 set wnow [$canv yview]
2693 set wtop [expr {[lindex $wnow 0] * $ymax}]
2694 set newtop [expr {$wtop + $dir * $linespc}]
2697 } elseif {$newtop > $ymax} {
2700 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2703 proc selectline {l isnew} {
2704 global canv canv2 canv3 ctext commitinfo selectedline
2705 global displayorder linehtag linentag linedtag
2706 global canvy0 linespc parentlist childlist
2707 global cflist currentid sha1entry
2708 global commentend idtags linknum
2709 global mergemax numcommits pending_select
2711 catch {unset pending_select}
2714 if {$l < 0 || $l >= $numcommits} return
2715 set y [expr {$canvy0 + $l * $linespc}]
2716 set ymax [lindex [$canv cget -scrollregion] 3]
2717 set ytop [expr {$y - $linespc - 1}]
2718 set ybot [expr {$y + $linespc + 1}]
2719 set wnow [$canv yview]
2720 set wtop [expr {[lindex $wnow 0] * $ymax}]
2721 set wbot [expr {[lindex $wnow 1] * $ymax}]
2722 set wh [expr {$wbot - $wtop}]
2724 if {$ytop < $wtop} {
2725 if {$ybot < $wtop} {
2726 set newtop [expr {$y - $wh / 2.0}]
2729 if {$newtop > $wtop - $linespc} {
2730 set newtop [expr {$wtop - $linespc}]
2733 } elseif {$ybot > $wbot} {
2734 if {$ytop > $wbot} {
2735 set newtop [expr {$y - $wh / 2.0}]
2737 set newtop [expr {$ybot - $wh}]
2738 if {$newtop < $wtop + $linespc} {
2739 set newtop [expr {$wtop + $linespc}]
2743 if {$newtop != $wtop} {
2747 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2751 if {![info exists linehtag($l)]} return
2753 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2754 -tags secsel -fill [$canv cget -selectbackground]]
2756 $canv2 delete secsel
2757 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2758 -tags secsel -fill [$canv2 cget -selectbackground]]
2760 $canv3 delete secsel
2761 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2762 -tags secsel -fill [$canv3 cget -selectbackground]]
2766 addtohistory [list selectline $l 0]
2771 set id [lindex $displayorder $l]
2773 $sha1entry delete 0 end
2774 $sha1entry insert 0 $id
2775 $sha1entry selection from 0
2776 $sha1entry selection to end
2778 $ctext conf -state normal
2779 $ctext delete 0.0 end
2781 $ctext mark set fmark.0 0.0
2782 $ctext mark gravity fmark.0 left
2783 set info $commitinfo($id)
2784 set date [formatdate [lindex $info 2]]
2785 $ctext insert end "Author: [lindex $info 1] $date\n"
2786 set date [formatdate [lindex $info 4]]
2787 $ctext insert end "Committer: [lindex $info 3] $date\n"
2788 if {[info exists idtags($id)]} {
2789 $ctext insert end "Tags:"
2790 foreach tag $idtags($id) {
2791 $ctext insert end " $tag"
2793 $ctext insert end "\n"
2797 set olds [lindex $parentlist $l]
2798 if {[llength $olds] > 1} {
2801 if {$np >= $mergemax} {
2806 $ctext insert end "Parent: " $tag
2807 appendwithlinks [commit_descriptor $p]
2812 append comment "Parent: [commit_descriptor $p]\n"
2816 foreach c [lindex $childlist $l] {
2817 append comment "Child: [commit_descriptor $c]\n"
2820 append comment [lindex $info 5]
2822 # make anything that looks like a SHA1 ID be a clickable link
2823 appendwithlinks $comment
2825 $ctext tag delete Comments
2826 $ctext tag remove found 1.0 end
2827 $ctext conf -state disabled
2828 set commentend [$ctext index "end - 1c"]
2830 $cflist delete 0 end
2831 $cflist insert end "Comments"
2832 if {[llength $olds] <= 1} {
2839 proc selfirstline {} {
2844 proc sellastline {} {
2847 set l [expr {$numcommits - 1}]
2851 proc selnextline {dir} {
2853 if {![info exists selectedline]} return
2854 set l [expr {$selectedline + $dir}]
2859 proc selnextpage {dir} {
2860 global canv linespc selectedline numcommits
2862 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2866 allcanvs yview scroll [expr {$dir * $lpp}] units
2867 if {![info exists selectedline]} return
2868 set l [expr {$selectedline + $dir * $lpp}]
2871 } elseif {$l >= $numcommits} {
2872 set l [expr $numcommits - 1]
2878 proc unselectline {} {
2879 global selectedline currentid
2881 catch {unset selectedline}
2882 catch {unset currentid}
2883 allcanvs delete secsel
2886 proc addtohistory {cmd} {
2887 global history historyindex curview
2889 set elt [list $curview $cmd]
2890 if {$historyindex > 0
2891 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2895 if {$historyindex < [llength $history]} {
2896 set history [lreplace $history $historyindex end $elt]
2898 lappend history $elt
2901 if {$historyindex > 1} {
2902 .ctop.top.bar.leftbut conf -state normal
2904 .ctop.top.bar.leftbut conf -state disabled
2906 .ctop.top.bar.rightbut conf -state disabled
2912 set view [lindex $elt 0]
2913 set cmd [lindex $elt 1]
2914 if {$curview != $view} {
2921 global history historyindex
2923 if {$historyindex > 1} {
2924 incr historyindex -1
2925 godo [lindex $history [expr {$historyindex - 1}]]
2926 .ctop.top.bar.rightbut conf -state normal
2928 if {$historyindex <= 1} {
2929 .ctop.top.bar.leftbut conf -state disabled
2934 global history historyindex
2936 if {$historyindex < [llength $history]} {
2937 set cmd [lindex $history $historyindex]
2940 .ctop.top.bar.leftbut conf -state normal
2942 if {$historyindex >= [llength $history]} {
2943 .ctop.top.bar.rightbut conf -state disabled
2947 proc mergediff {id l} {
2948 global diffmergeid diffopts mdifffd
2949 global difffilestart diffids
2954 catch {unset difffilestart}
2955 # this doesn't seem to actually affect anything...
2956 set env(GIT_DIFF_OPTS) $diffopts
2957 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2958 if {[catch {set mdf [open $cmd r]} err]} {
2959 error_popup "Error getting merge diffs: $err"
2962 fconfigure $mdf -blocking 0
2963 set mdifffd($id) $mdf
2964 set np [llength [lindex $parentlist $l]]
2965 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2966 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2969 proc getmergediffline {mdf id np} {
2970 global diffmergeid ctext cflist nextupdate mergemax
2971 global difffilestart mdifffd
2973 set n [gets $mdf line]
2980 if {![info exists diffmergeid] || $id != $diffmergeid
2981 || $mdf != $mdifffd($id)} {
2984 $ctext conf -state normal
2985 if {[regexp {^diff --cc (.*)} $line match fname]} {
2986 # start of a new file
2987 $ctext insert end "\n"
2988 set here [$ctext index "end - 1c"]
2989 set i [$cflist index end]
2990 $ctext mark set fmark.$i $here
2991 $ctext mark gravity fmark.$i left
2992 set difffilestart([expr {$i-1}]) $here
2993 $cflist insert end $fname
2994 set l [expr {(78 - [string length $fname]) / 2}]
2995 set pad [string range "----------------------------------------" 1 $l]
2996 $ctext insert end "$pad $fname $pad\n" filesep
2997 } elseif {[regexp {^@@} $line]} {
2998 $ctext insert end "$line\n" hunksep
2999 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3002 # parse the prefix - one ' ', '-' or '+' for each parent
3007 for {set j 0} {$j < $np} {incr j} {
3008 set c [string range $line $j $j]
3011 } elseif {$c == "-"} {
3013 } elseif {$c == "+"} {
3022 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3023 # line doesn't appear in result, parents in $minuses have the line
3024 set num [lindex $minuses 0]
3025 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3026 # line appears in result, parents in $pluses don't have the line
3027 lappend tags mresult
3028 set num [lindex $spaces 0]
3031 if {$num >= $mergemax} {
3036 $ctext insert end "$line\n" $tags
3038 $ctext conf -state disabled
3039 if {[clock clicks -milliseconds] >= $nextupdate} {
3041 fileevent $mdf readable {}
3043 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3047 proc startdiff {ids} {
3048 global treediffs diffids treepending diffmergeid
3051 catch {unset diffmergeid}
3052 if {![info exists treediffs($ids)]} {
3053 if {![info exists treepending]} {
3061 proc addtocflist {ids} {
3062 global treediffs cflist
3063 foreach f $treediffs($ids) {
3064 $cflist insert end $f
3069 proc gettreediffs {ids} {
3070 global treediff treepending
3071 set treepending $ids
3074 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3076 fconfigure $gdtf -blocking 0
3077 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3080 proc gettreediffline {gdtf ids} {
3081 global treediff treediffs treepending diffids diffmergeid
3083 set n [gets $gdtf line]
3085 if {![eof $gdtf]} return
3087 set treediffs($ids) $treediff
3089 if {$ids != $diffids} {
3090 if {![info exists diffmergeid]} {
3091 gettreediffs $diffids
3098 set file [lindex $line 5]
3099 lappend treediff $file
3102 proc getblobdiffs {ids} {
3103 global diffopts blobdifffd diffids env curdifftag curtagstart
3104 global difffilestart nextupdate diffinhdr treediffs
3106 set env(GIT_DIFF_OPTS) $diffopts
3107 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3108 if {[catch {set bdf [open $cmd r]} err]} {
3109 puts "error getting diffs: $err"
3113 fconfigure $bdf -blocking 0
3114 set blobdifffd($ids) $bdf
3115 set curdifftag Comments
3117 catch {unset difffilestart}
3118 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3119 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3122 proc getblobdiffline {bdf ids} {
3123 global diffids blobdifffd ctext curdifftag curtagstart
3124 global diffnexthead diffnextnote difffilestart
3125 global nextupdate diffinhdr treediffs
3127 set n [gets $bdf line]
3131 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3132 $ctext tag add $curdifftag $curtagstart end
3137 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3140 $ctext conf -state normal
3141 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3142 # start of a new file
3143 $ctext insert end "\n"
3144 $ctext tag add $curdifftag $curtagstart end
3145 set curtagstart [$ctext index "end - 1c"]
3147 set here [$ctext index "end - 1c"]
3148 set i [lsearch -exact $treediffs($diffids) $fname]
3150 set difffilestart($i) $here
3152 $ctext mark set fmark.$i $here
3153 $ctext mark gravity fmark.$i left
3155 if {$newname != $fname} {
3156 set i [lsearch -exact $treediffs($diffids) $newname]
3158 set difffilestart($i) $here
3160 $ctext mark set fmark.$i $here
3161 $ctext mark gravity fmark.$i left
3164 set curdifftag "f:$fname"
3165 $ctext tag delete $curdifftag
3166 set l [expr {(78 - [string length $header]) / 2}]
3167 set pad [string range "----------------------------------------" 1 $l]
3168 $ctext insert end "$pad $header $pad\n" filesep
3170 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3172 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3174 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3175 $line match f1l f1c f2l f2c rest]} {
3176 $ctext insert end "$line\n" hunksep
3179 set x [string range $line 0 0]
3180 if {$x == "-" || $x == "+"} {
3181 set tag [expr {$x == "+"}]
3182 $ctext insert end "$line\n" d$tag
3183 } elseif {$x == " "} {
3184 $ctext insert end "$line\n"
3185 } elseif {$diffinhdr || $x == "\\"} {
3186 # e.g. "\ No newline at end of file"
3187 $ctext insert end "$line\n" filesep
3189 # Something else we don't recognize
3190 if {$curdifftag != "Comments"} {
3191 $ctext insert end "\n"
3192 $ctext tag add $curdifftag $curtagstart end
3193 set curtagstart [$ctext index "end - 1c"]
3194 set curdifftag Comments
3196 $ctext insert end "$line\n" filesep
3199 $ctext conf -state disabled
3200 if {[clock clicks -milliseconds] >= $nextupdate} {
3202 fileevent $bdf readable {}
3204 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3209 global difffilestart ctext
3210 set here [$ctext index @0,0]
3211 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3212 if {[$ctext compare $difffilestart($i) > $here]} {
3213 if {![info exists pos]
3214 || [$ctext compare $difffilestart($i) < $pos]} {
3215 set pos $difffilestart($i)
3219 if {[info exists pos]} {
3224 proc listboxsel {} {
3225 global ctext cflist currentid
3226 if {![info exists currentid]} return
3227 set sel [lsort [$cflist curselection]]
3228 if {$sel eq {}} return
3229 set first [lindex $sel 0]
3230 catch {$ctext yview fmark.$first}
3234 global linespc charspc canvx0 canvy0 mainfont
3235 global xspc1 xspc2 lthickness
3237 set linespc [font metrics $mainfont -linespace]
3238 set charspc [font measure $mainfont "m"]
3239 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3240 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3241 set lthickness [expr {int($linespc / 9) + 1}]
3242 set xspc1(0) $linespc
3250 set ymax [lindex [$canv cget -scrollregion] 3]
3251 if {$ymax eq {} || $ymax == 0} return
3252 set span [$canv yview]
3255 allcanvs yview moveto [lindex $span 0]
3257 if {[info exists selectedline]} {
3258 selectline $selectedline 0
3262 proc incrfont {inc} {
3263 global mainfont namefont textfont ctext canv phase
3264 global stopped entries
3266 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3267 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3268 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3270 $ctext conf -font $textfont
3271 $ctext tag conf filesep -font [concat $textfont bold]
3272 foreach e $entries {
3273 $e conf -font $mainfont
3275 if {$phase eq "getcommits"} {
3276 $canv itemconf textitems -font $mainfont
3282 global sha1entry sha1string
3283 if {[string length $sha1string] == 40} {
3284 $sha1entry delete 0 end
3288 proc sha1change {n1 n2 op} {
3289 global sha1string currentid sha1but
3290 if {$sha1string == {}
3291 || ([info exists currentid] && $sha1string == $currentid)} {
3296 if {[$sha1but cget -state] == $state} return
3297 if {$state == "normal"} {
3298 $sha1but conf -state normal -relief raised -text "Goto: "
3300 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3304 proc gotocommit {} {
3305 global sha1string currentid commitrow tagids headids
3306 global displayorder numcommits
3308 if {$sha1string == {}
3309 || ([info exists currentid] && $sha1string == $currentid)} return
3310 if {[info exists tagids($sha1string)]} {
3311 set id $tagids($sha1string)
3312 } elseif {[info exists headids($sha1string)]} {
3313 set id $headids($sha1string)
3315 set id [string tolower $sha1string]
3316 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3318 foreach i $displayorder {
3319 if {[string match $id* $i]} {
3323 if {$matches ne {}} {
3324 if {[llength $matches] > 1} {
3325 error_popup "Short SHA1 id $id is ambiguous"
3328 set id [lindex $matches 0]
3332 if {[info exists commitrow($id)]} {
3333 selectline $commitrow($id) 1
3336 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3341 error_popup "$type $sha1string is not known"
3344 proc lineenter {x y id} {
3345 global hoverx hovery hoverid hovertimer
3346 global commitinfo canv
3348 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3352 if {[info exists hovertimer]} {
3353 after cancel $hovertimer
3355 set hovertimer [after 500 linehover]
3359 proc linemotion {x y id} {
3360 global hoverx hovery hoverid hovertimer
3362 if {[info exists hoverid] && $id == $hoverid} {
3365 if {[info exists hovertimer]} {
3366 after cancel $hovertimer
3368 set hovertimer [after 500 linehover]
3372 proc lineleave {id} {
3373 global hoverid hovertimer canv
3375 if {[info exists hoverid] && $id == $hoverid} {
3377 if {[info exists hovertimer]} {
3378 after cancel $hovertimer
3386 global hoverx hovery hoverid hovertimer
3387 global canv linespc lthickness
3388 global commitinfo mainfont
3390 set text [lindex $commitinfo($hoverid) 0]
3391 set ymax [lindex [$canv cget -scrollregion] 3]
3392 if {$ymax == {}} return
3393 set yfrac [lindex [$canv yview] 0]
3394 set x [expr {$hoverx + 2 * $linespc}]
3395 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3396 set x0 [expr {$x - 2 * $lthickness}]
3397 set y0 [expr {$y - 2 * $lthickness}]
3398 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3399 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3400 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3401 -fill \#ffff80 -outline black -width 1 -tags hover]
3403 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3407 proc clickisonarrow {id y} {
3410 set ranges [rowranges $id]
3411 set thresh [expr {2 * $lthickness + 6}]
3412 set n [expr {[llength $ranges] - 1}]
3413 for {set i 1} {$i < $n} {incr i} {
3414 set row [lindex $ranges $i]
3415 if {abs([yc $row] - $y) < $thresh} {
3422 proc arrowjump {id n y} {
3425 # 1 <-> 2, 3 <-> 4, etc...
3426 set n [expr {(($n - 1) ^ 1) + 1}]
3427 set row [lindex [rowranges $id] $n]
3429 set ymax [lindex [$canv cget -scrollregion] 3]
3430 if {$ymax eq {} || $ymax <= 0} return
3431 set view [$canv yview]
3432 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3433 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3437 allcanvs yview moveto $yfrac
3440 proc lineclick {x y id isnew} {
3441 global ctext commitinfo childlist commitrow cflist canv thickerline
3443 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3448 # draw this line thicker than normal
3452 set ymax [lindex [$canv cget -scrollregion] 3]
3453 if {$ymax eq {}} return
3454 set yfrac [lindex [$canv yview] 0]
3455 set y [expr {$y + $yfrac * $ymax}]
3457 set dirn [clickisonarrow $id $y]
3459 arrowjump $id $dirn $y
3464 addtohistory [list lineclick $x $y $id 0]
3466 # fill the details pane with info about this line
3467 $ctext conf -state normal
3468 $ctext delete 0.0 end
3469 $ctext tag conf link -foreground blue -underline 1
3470 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3471 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3472 $ctext insert end "Parent:\t"
3473 $ctext insert end $id [list link link0]
3474 $ctext tag bind link0 <1> [list selbyid $id]
3475 set info $commitinfo($id)
3476 $ctext insert end "\n\t[lindex $info 0]\n"
3477 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3478 set date [formatdate [lindex $info 2]]
3479 $ctext insert end "\tDate:\t$date\n"
3480 set kids [lindex $childlist $commitrow($id)]
3482 $ctext insert end "\nChildren:"
3484 foreach child $kids {
3486 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3487 set info $commitinfo($child)
3488 $ctext insert end "\n\t"
3489 $ctext insert end $child [list link link$i]
3490 $ctext tag bind link$i <1> [list selbyid $child]
3491 $ctext insert end "\n\t[lindex $info 0]"
3492 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3493 set date [formatdate [lindex $info 2]]
3494 $ctext insert end "\n\tDate:\t$date\n"
3497 $ctext conf -state disabled
3499 $cflist delete 0 end
3502 proc normalline {} {
3504 if {[info exists thickerline]} {
3513 if {[info exists commitrow($id)]} {
3514 selectline $commitrow($id) 1
3520 if {![info exists startmstime]} {
3521 set startmstime [clock clicks -milliseconds]
3523 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3526 proc rowmenu {x y id} {
3527 global rowctxmenu commitrow selectedline rowmenuid
3529 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3534 $rowctxmenu entryconfigure 0 -state $state
3535 $rowctxmenu entryconfigure 1 -state $state
3536 $rowctxmenu entryconfigure 2 -state $state
3538 tk_popup $rowctxmenu $x $y
3541 proc diffvssel {dirn} {
3542 global rowmenuid selectedline displayorder
3544 if {![info exists selectedline]} return
3546 set oldid [lindex $displayorder $selectedline]
3547 set newid $rowmenuid
3549 set oldid $rowmenuid
3550 set newid [lindex $displayorder $selectedline]
3552 addtohistory [list doseldiff $oldid $newid]
3553 doseldiff $oldid $newid
3556 proc doseldiff {oldid newid} {
3560 $ctext conf -state normal
3561 $ctext delete 0.0 end
3562 $ctext mark set fmark.0 0.0
3563 $ctext mark gravity fmark.0 left
3564 $cflist delete 0 end
3565 $cflist insert end "Top"
3566 $ctext insert end "From "
3567 $ctext tag conf link -foreground blue -underline 1
3568 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3569 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3570 $ctext tag bind link0 <1> [list selbyid $oldid]
3571 $ctext insert end $oldid [list link link0]
3572 $ctext insert end "\n "
3573 $ctext insert end [lindex $commitinfo($oldid) 0]
3574 $ctext insert end "\n\nTo "
3575 $ctext tag bind link1 <1> [list selbyid $newid]
3576 $ctext insert end $newid [list link link1]
3577 $ctext insert end "\n "
3578 $ctext insert end [lindex $commitinfo($newid) 0]
3579 $ctext insert end "\n"
3580 $ctext conf -state disabled
3581 $ctext tag delete Comments
3582 $ctext tag remove found 1.0 end
3583 startdiff [list $oldid $newid]
3587 global rowmenuid currentid commitinfo patchtop patchnum
3589 if {![info exists currentid]} return
3590 set oldid $currentid
3591 set oldhead [lindex $commitinfo($oldid) 0]
3592 set newid $rowmenuid
3593 set newhead [lindex $commitinfo($newid) 0]
3596 catch {destroy $top}
3598 label $top.title -text "Generate patch"
3599 grid $top.title - -pady 10
3600 label $top.from -text "From:"
3601 entry $top.fromsha1 -width 40 -relief flat
3602 $top.fromsha1 insert 0 $oldid
3603 $top.fromsha1 conf -state readonly
3604 grid $top.from $top.fromsha1 -sticky w
3605 entry $top.fromhead -width 60 -relief flat
3606 $top.fromhead insert 0 $oldhead
3607 $top.fromhead conf -state readonly
3608 grid x $top.fromhead -sticky w
3609 label $top.to -text "To:"
3610 entry $top.tosha1 -width 40 -relief flat
3611 $top.tosha1 insert 0 $newid
3612 $top.tosha1 conf -state readonly
3613 grid $top.to $top.tosha1 -sticky w
3614 entry $top.tohead -width 60 -relief flat
3615 $top.tohead insert 0 $newhead
3616 $top.tohead conf -state readonly
3617 grid x $top.tohead -sticky w
3618 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3619 grid $top.rev x -pady 10
3620 label $top.flab -text "Output file:"
3621 entry $top.fname -width 60
3622 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3624 grid $top.flab $top.fname -sticky w
3626 button $top.buts.gen -text "Generate" -command mkpatchgo
3627 button $top.buts.can -text "Cancel" -command mkpatchcan
3628 grid $top.buts.gen $top.buts.can
3629 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3630 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3631 grid $top.buts - -pady 10 -sticky ew
3635 proc mkpatchrev {} {
3638 set oldid [$patchtop.fromsha1 get]
3639 set oldhead [$patchtop.fromhead get]
3640 set newid [$patchtop.tosha1 get]
3641 set newhead [$patchtop.tohead get]
3642 foreach e [list fromsha1 fromhead tosha1 tohead] \
3643 v [list $newid $newhead $oldid $oldhead] {
3644 $patchtop.$e conf -state normal
3645 $patchtop.$e delete 0 end
3646 $patchtop.$e insert 0 $v
3647 $patchtop.$e conf -state readonly
3654 set oldid [$patchtop.fromsha1 get]
3655 set newid [$patchtop.tosha1 get]
3656 set fname [$patchtop.fname get]
3657 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3658 error_popup "Error creating patch: $err"
3660 catch {destroy $patchtop}
3664 proc mkpatchcan {} {
3667 catch {destroy $patchtop}
3672 global rowmenuid mktagtop commitinfo
3676 catch {destroy $top}
3678 label $top.title -text "Create tag"
3679 grid $top.title - -pady 10
3680 label $top.id -text "ID:"
3681 entry $top.sha1 -width 40 -relief flat
3682 $top.sha1 insert 0 $rowmenuid
3683 $top.sha1 conf -state readonly
3684 grid $top.id $top.sha1 -sticky w
3685 entry $top.head -width 60 -relief flat
3686 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3687 $top.head conf -state readonly
3688 grid x $top.head -sticky w
3689 label $top.tlab -text "Tag name:"
3690 entry $top.tag -width 60
3691 grid $top.tlab $top.tag -sticky w
3693 button $top.buts.gen -text "Create" -command mktaggo
3694 button $top.buts.can -text "Cancel" -command mktagcan
3695 grid $top.buts.gen $top.buts.can
3696 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3697 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3698 grid $top.buts - -pady 10 -sticky ew
3703 global mktagtop env tagids idtags
3705 set id [$mktagtop.sha1 get]
3706 set tag [$mktagtop.tag get]
3708 error_popup "No tag name specified"
3711 if {[info exists tagids($tag)]} {
3712 error_popup "Tag \"$tag\" already exists"
3717 set fname [file join $dir "refs/tags" $tag]
3718 set f [open $fname w]
3722 error_popup "Error creating tag: $err"
3726 set tagids($tag) $id
3727 lappend idtags($id) $tag
3731 proc redrawtags {id} {
3732 global canv linehtag commitrow idpos selectedline
3734 if {![info exists commitrow($id)]} return
3735 drawcmitrow $commitrow($id)
3736 $canv delete tag.$id
3737 set xt [eval drawtags $id $idpos($id)]
3738 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3739 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3740 selectline $selectedline 0
3747 catch {destroy $mktagtop}
3756 proc writecommit {} {
3757 global rowmenuid wrcomtop commitinfo wrcomcmd
3759 set top .writecommit
3761 catch {destroy $top}
3763 label $top.title -text "Write commit to file"
3764 grid $top.title - -pady 10
3765 label $top.id -text "ID:"
3766 entry $top.sha1 -width 40 -relief flat
3767 $top.sha1 insert 0 $rowmenuid
3768 $top.sha1 conf -state readonly
3769 grid $top.id $top.sha1 -sticky w
3770 entry $top.head -width 60 -relief flat
3771 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3772 $top.head conf -state readonly
3773 grid x $top.head -sticky w
3774 label $top.clab -text "Command:"
3775 entry $top.cmd -width 60 -textvariable wrcomcmd
3776 grid $top.clab $top.cmd -sticky w -pady 10
3777 label $top.flab -text "Output file:"
3778 entry $top.fname -width 60
3779 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3780 grid $top.flab $top.fname -sticky w
3782 button $top.buts.gen -text "Write" -command wrcomgo
3783 button $top.buts.can -text "Cancel" -command wrcomcan
3784 grid $top.buts.gen $top.buts.can
3785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787 grid $top.buts - -pady 10 -sticky ew
3794 set id [$wrcomtop.sha1 get]
3795 set cmd "echo $id | [$wrcomtop.cmd get]"
3796 set fname [$wrcomtop.fname get]
3797 if {[catch {exec sh -c $cmd >$fname &} err]} {
3798 error_popup "Error writing commit: $err"
3800 catch {destroy $wrcomtop}
3807 catch {destroy $wrcomtop}
3811 proc listrefs {id} {
3812 global idtags idheads idotherrefs
3815 if {[info exists idtags($id)]} {
3819 if {[info exists idheads($id)]} {
3823 if {[info exists idotherrefs($id)]} {
3824 set z $idotherrefs($id)
3826 return [list $x $y $z]
3829 proc rereadrefs {} {
3830 global idtags idheads idotherrefs
3832 set refids [concat [array names idtags] \
3833 [array names idheads] [array names idotherrefs]]
3834 foreach id $refids {
3835 if {![info exists ref($id)]} {
3836 set ref($id) [listrefs $id]
3840 set refids [lsort -unique [concat $refids [array names idtags] \
3841 [array names idheads] [array names idotherrefs]]]
3842 foreach id $refids {
3843 set v [listrefs $id]
3844 if {![info exists ref($id)] || $ref($id) != $v} {
3850 proc showtag {tag isnew} {
3851 global ctext cflist tagcontents tagids linknum
3854 addtohistory [list showtag $tag 0]
3856 $ctext conf -state normal
3857 $ctext delete 0.0 end
3859 if {[info exists tagcontents($tag)]} {
3860 set text $tagcontents($tag)
3862 set text "Tag: $tag\nId: $tagids($tag)"
3864 appendwithlinks $text
3865 $ctext conf -state disabled
3866 $cflist delete 0 end
3876 global maxwidth maxgraphpct diffopts findmergefiles
3877 global oldprefs prefstop
3881 if {[winfo exists $top]} {
3885 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3886 set oldprefs($v) [set $v]
3889 wm title $top "Gitk preferences"
3890 label $top.ldisp -text "Commit list display options"
3891 grid $top.ldisp - -sticky w -pady 10
3892 label $top.spacer -text " "
3893 label $top.maxwidthl -text "Maximum graph width (lines)" \
3895 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3896 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3897 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3899 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3900 grid x $top.maxpctl $top.maxpct -sticky w
3901 checkbutton $top.findm -variable findmergefiles
3902 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3904 grid $top.findm $top.findml - -sticky w
3905 label $top.ddisp -text "Diff display options"
3906 grid $top.ddisp - -sticky w -pady 10
3907 label $top.diffoptl -text "Options for diff program" \
3909 entry $top.diffopt -width 20 -textvariable diffopts
3910 grid x $top.diffoptl $top.diffopt -sticky w
3912 button $top.buts.ok -text "OK" -command prefsok
3913 button $top.buts.can -text "Cancel" -command prefscan
3914 grid $top.buts.ok $top.buts.can
3915 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3916 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3917 grid $top.buts - - -pady 10 -sticky ew
3921 global maxwidth maxgraphpct diffopts findmergefiles
3922 global oldprefs prefstop
3924 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3925 set $v $oldprefs($v)
3927 catch {destroy $prefstop}
3932 global maxwidth maxgraphpct
3933 global oldprefs prefstop
3935 catch {destroy $prefstop}
3937 if {$maxwidth != $oldprefs(maxwidth)
3938 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3943 proc formatdate {d} {
3944 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3947 # This list of encoding names and aliases is distilled from
3948 # http://www.iana.org/assignments/character-sets.
3949 # Not all of them are supported by Tcl.
3950 set encoding_aliases {
3951 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3952 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3953 { ISO-10646-UTF-1 csISO10646UTF1 }
3954 { ISO_646.basic:1983 ref csISO646basic1983 }
3955 { INVARIANT csINVARIANT }
3956 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3957 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3958 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3959 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3960 { NATS-DANO iso-ir-9-1 csNATSDANO }
3961 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3962 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3963 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3964 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3965 { ISO-2022-KR csISO2022KR }
3967 { ISO-2022-JP csISO2022JP }
3968 { ISO-2022-JP-2 csISO2022JP2 }
3969 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3971 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3972 { IT iso-ir-15 ISO646-IT csISO15Italian }
3973 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3974 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3975 { greek7-old iso-ir-18 csISO18Greek7Old }
3976 { latin-greek iso-ir-19 csISO19LatinGreek }
3977 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3978 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3979 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3980 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3981 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3982 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3983 { INIS iso-ir-49 csISO49INIS }
3984 { INIS-8 iso-ir-50 csISO50INIS8 }
3985 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3986 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3987 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3988 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3989 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3990 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3992 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3993 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3994 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3995 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3996 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3997 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3998 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3999 { greek7 iso-ir-88 csISO88Greek7 }
4000 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4001 { iso-ir-90 csISO90 }
4002 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4003 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4004 csISO92JISC62991984b }
4005 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4006 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4007 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4008 csISO95JIS62291984handadd }
4009 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4010 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4011 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4012 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4014 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4015 { T.61-7bit iso-ir-102 csISO102T617bit }
4016 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4017 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4018 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4019 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4020 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4021 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4022 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4023 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4024 arabic csISOLatinArabic }
4025 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4026 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4027 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4028 greek greek8 csISOLatinGreek }
4029 { T.101-G2 iso-ir-128 csISO128T101G2 }
4030 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4032 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4033 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4034 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4035 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4036 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4037 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4038 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4039 csISOLatinCyrillic }
4040 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4041 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4042 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4043 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4044 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4045 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4046 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4047 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4048 { ISO_10367-box iso-ir-155 csISO10367Box }
4049 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4050 { latin-lap lap iso-ir-158 csISO158Lap }
4051 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4052 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4055 { JIS_X0201 X0201 csHalfWidthKatakana }
4056 { KSC5636 ISO646-KR csKSC5636 }
4057 { ISO-10646-UCS-2 csUnicode }
4058 { ISO-10646-UCS-4 csUCS4 }
4059 { DEC-MCS dec csDECMCS }
4060 { hp-roman8 roman8 r8 csHPRoman8 }
4061 { macintosh mac csMacintosh }
4062 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4064 { IBM038 EBCDIC-INT cp038 csIBM038 }
4065 { IBM273 CP273 csIBM273 }
4066 { IBM274 EBCDIC-BE CP274 csIBM274 }
4067 { IBM275 EBCDIC-BR cp275 csIBM275 }
4068 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4069 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4070 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4071 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4072 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4073 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4074 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4075 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4076 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4077 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4078 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4079 { IBM437 cp437 437 csPC8CodePage437 }
4080 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4081 { IBM775 cp775 csPC775Baltic }
4082 { IBM850 cp850 850 csPC850Multilingual }
4083 { IBM851 cp851 851 csIBM851 }
4084 { IBM852 cp852 852 csPCp852 }
4085 { IBM855 cp855 855 csIBM855 }
4086 { IBM857 cp857 857 csIBM857 }
4087 { IBM860 cp860 860 csIBM860 }
4088 { IBM861 cp861 861 cp-is csIBM861 }
4089 { IBM862 cp862 862 csPC862LatinHebrew }
4090 { IBM863 cp863 863 csIBM863 }
4091 { IBM864 cp864 csIBM864 }
4092 { IBM865 cp865 865 csIBM865 }
4093 { IBM866 cp866 866 csIBM866 }
4094 { IBM868 CP868 cp-ar csIBM868 }
4095 { IBM869 cp869 869 cp-gr csIBM869 }
4096 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4097 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4098 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4099 { IBM891 cp891 csIBM891 }
4100 { IBM903 cp903 csIBM903 }
4101 { IBM904 cp904 904 csIBBM904 }
4102 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4103 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4104 { IBM1026 CP1026 csIBM1026 }
4105 { EBCDIC-AT-DE csIBMEBCDICATDE }
4106 { EBCDIC-AT-DE-A csEBCDICATDEA }
4107 { EBCDIC-CA-FR csEBCDICCAFR }
4108 { EBCDIC-DK-NO csEBCDICDKNO }
4109 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4110 { EBCDIC-FI-SE csEBCDICFISE }
4111 { EBCDIC-FI-SE-A csEBCDICFISEA }
4112 { EBCDIC-FR csEBCDICFR }
4113 { EBCDIC-IT csEBCDICIT }
4114 { EBCDIC-PT csEBCDICPT }
4115 { EBCDIC-ES csEBCDICES }
4116 { EBCDIC-ES-A csEBCDICESA }
4117 { EBCDIC-ES-S csEBCDICESS }
4118 { EBCDIC-UK csEBCDICUK }
4119 { EBCDIC-US csEBCDICUS }
4120 { UNKNOWN-8BIT csUnknown8BiT }
4121 { MNEMONIC csMnemonic }
4126 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4127 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4128 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4129 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4130 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4131 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4132 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4133 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4134 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4135 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4136 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4137 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4138 { IBM1047 IBM-1047 }
4139 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4140 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4141 { UNICODE-1-1 csUnicode11 }
4144 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4145 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4147 { ISO-8859-15 ISO_8859-15 Latin-9 }
4148 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4149 { GBK CP936 MS936 windows-936 }
4150 { JIS_Encoding csJISEncoding }
4151 { Shift_JIS MS_Kanji csShiftJIS }
4152 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4154 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4155 { ISO-10646-UCS-Basic csUnicodeASCII }
4156 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4157 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4158 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4159 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4160 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4161 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4162 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4163 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4164 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4165 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4166 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4167 { Ventura-US csVenturaUS }
4168 { Ventura-International csVenturaInternational }
4169 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4170 { PC8-Turkish csPC8Turkish }
4171 { IBM-Symbols csIBMSymbols }
4172 { IBM-Thai csIBMThai }
4173 { HP-Legal csHPLegal }
4174 { HP-Pi-font csHPPiFont }
4175 { HP-Math8 csHPMath8 }
4176 { Adobe-Symbol-Encoding csHPPSMath }
4177 { HP-DeskTop csHPDesktop }
4178 { Ventura-Math csVenturaMath }
4179 { Microsoft-Publishing csMicrosoftPublishing }
4180 { Windows-31J csWindows31J }
4185 proc tcl_encoding {enc} {
4186 global encoding_aliases
4187 set names [encoding names]
4188 set lcnames [string tolower $names]
4189 set enc [string tolower $enc]
4190 set i [lsearch -exact $lcnames $enc]
4192 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4193 if {[regsub {^iso[-_]} $enc iso encx]} {
4194 set i [lsearch -exact $lcnames $encx]
4198 foreach l $encoding_aliases {
4199 set ll [string tolower $l]
4200 if {[lsearch -exact $ll $enc] < 0} continue
4201 # look through the aliases for one that tcl knows about
4203 set i [lsearch -exact $lcnames $e]
4205 if {[regsub {^iso[-_]} $e iso ex]} {
4206 set i [lsearch -exact $lcnames $ex]
4215 return [lindex $names $i]
4222 set diffopts "-U 5 -p"
4223 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4227 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4229 if {$gitencoding == ""} {
4230 set gitencoding "utf-8"
4232 set tclencoding [tcl_encoding $gitencoding]
4233 if {$tclencoding == {}} {
4234 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4237 set mainfont {Helvetica 9}
4238 set textfont {Courier 9}
4239 set uifont {Helvetica 9 bold}
4240 set findmergefiles 0
4249 set colors {green red blue magenta darkgrey brown orange}
4251 catch {source ~/.gitk}
4253 set namefont $mainfont
4255 font create optionfont -family sans-serif -size -12
4259 switch -regexp -- $arg {
4261 "^-d" { set datemode 1 }
4263 lappend revtreeargs $arg
4268 # check that we can find a .git directory somewhere...
4270 if {![file isdirectory $gitdir]} {
4271 error_popup "Cannot find the git directory \"$gitdir\"."
4293 set cmdline_files {}
4295 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4296 set cmdline_files [split $fileargs "\n"]
4297 set n [llength $cmdline_files]
4298 set revtreeargs [lrange $revtreeargs 0 end-$n]
4300 if {[lindex $revtreeargs end] eq "--"} {
4301 set revtreeargs [lrange $revtreeargs 0 end-1]
4304 if {$cmdline_files ne {}} {
4305 # create a view for the files/dirs specified on the command line
4309 set viewname(1) "Command line"
4310 set viewfiles(1) $cmdline_files
4312 .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4313 -variable selectedview -value 1
4314 .bar.view entryconf 2 -state normal
4315 .bar.view entryconf 3 -state normal
4318 if {[info exists permviews]} {
4319 foreach v $permviews {
4322 set viewname($n) [lindex $v 0]
4323 set viewfiles($n) [lindex $v 1]
4325 .bar.view add radiobutton -label $viewname($n) \
4326 -command [list showview $n] -variable selectedview -value $n